Rework createWallet to support different AD schemes

cardano-foundation · Apr 11, 2019 · eadb5dc · eadb5dc
1 parent c418e9e
commit eadb5dc
Show file tree

Hide file tree

Showing 11 changed files with 165 additions and 210 deletions.
diff --git a/cardano-wallet.cabal b/cardano-wallet.cabal
@@ -336,7 +336,7 @@ benchmark restore
   other-modules:
       Cardano.CLI
       Cardano.Launcher
-      Cardano.Wallet.Primitive.AddressDiscovery.Fixed
+      Cardano.Wallet.Primitive.AddressDiscovery.Any
   if os(windows)
     build-depends: Win32
     other-modules: Cardano.Launcher.Windows

diff --git a/src/Cardano/Wallet.hs b/src/Cardano/Wallet.hs
@@ -1,8 +1,10 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -19,15 +21,16 @@ module Cardano.Wallet
     (
     -- * Interface
       WalletLayer (..)
-    , NewWallet(..)
 
     -- * Errors
     , ErrNoSuchWallet(..)
     , ErrWalletAlreadyExists(..)
-    , InitState(..)
 
     -- * Construction
+    , NewWallet (..)
     , mkWalletLayer
+    , createWalletSeq
+    , initSeqState
 
     -- * Helpers
     , unsafeRunExceptT
@@ -59,7 +62,7 @@ import Cardano.Wallet.Primitive.AddressDerivation
     , publicKey
     )
 import Cardano.Wallet.Primitive.AddressDiscovery
-    ( SeqState (..), SeqStateConfig (..), mkAddressPool )
+    ( AddressPoolGap, SeqState (..), mkAddressPool )
 import Cardano.Wallet.Primitive.Model
     ( Wallet, applyBlocks, availableUTxO, getState, initWallet )
 import Cardano.Wallet.Primitive.Types
@@ -91,10 +94,16 @@ import Control.Monad.Trans.Maybe
     ( MaybeT (..), maybeToExceptT )
 import Data.Functor
     ( ($>) )
+import Data.Generics.Internal.VL.Lens
+    ( (^.) )
+import Data.Generics.Labels
+    ()
 import Data.List.NonEmpty
     ( NonEmpty )
 import Data.Time.Clock
     ( getCurrentTime )
+import GHC.Generics
+    ( Generic )
 
 import qualified Cardano.Wallet.CoinSelection.Random as CoinSelection
 import qualified Cardano.Wallet.DB as DB
@@ -105,8 +114,10 @@ import qualified Cardano.Wallet.DB as DB
 
 data WalletLayer s = WalletLayer
     { createWallet
-        :: NewWallet s
-        -> ExceptT ErrWalletAlreadyExists IO WalletId
+        :: WalletName
+        -> WalletId
+        -> s
+        -> ExceptT ErrWalletAlreadyExists IO ()
         -- ^ Initialise and store a new wallet, returning its ID.
 
     , readWallet
@@ -156,7 +167,7 @@ data WalletLayer s = WalletLayer
         -- benchmarking.
     }
 
-data NewWallet s = NewWallet
+data NewWallet = NewWallet
     { seed
         :: !(Passphrase "seed")
     , secondFactor
@@ -165,9 +176,9 @@ data NewWallet s = NewWallet
         :: !WalletName
     , passphrase
         :: !(Passphrase "encryption")
-    , addressDiscoveryConfig
-        :: AddressDiscoveryConfig s
-    }
+    , gap
+        :: !AddressPoolGap
+    } deriving (Show, Generic)
 
 -- | Errors occuring when creating an unsigned transaction
 data ErrCreateUnsignedTx
@@ -186,31 +197,9 @@ data ErrSubmitTx = forall a. NetworkError a
                                  Construction
 -------------------------------------------------------------------------------}
 
-class (IsOurs s, NFData s, Show s) => InitState s where
-    initState :: NewWallet s -> (WalletId, s)
-
-instance InitState SeqState where
-    initState w = (wid, seqState)
-      where
-        rootXPrv =
-            generateKeyFromSeed (seed w, secondFactor w) (passphrase w)
-        accXPrv =
-            deriveAccountPrivateKey mempty rootXPrv minBound
-        ad = addressDiscoveryConfig w
-        extPool =
-            mkAddressPool (publicKey accXPrv) (seqStateGap ad) ExternalChain []
-        intPool =
-            mkAddressPool (publicKey accXPrv) minBound InternalChain []
-        wid =
-            WalletId (digest $ publicKey rootXPrv)
-        seqState = SeqState
-            { externalPool = extPool
-            , internalPool = intPool
-            }
-
 -- | Create a new instance of the wallet layer.
 mkWalletLayer
-    :: forall s. InitState s
+    :: forall s. (IsOurs s, NFData s, Show s)
     => DBLayer IO s
     -> NetworkLayer IO
     -> WalletLayer s
@@ -220,17 +209,16 @@ mkWalletLayer db network = WalletLayer
                                        Wallets
     ---------------------------------------------------------------------------}
 
-    { createWallet = \w -> do
-        let (wid, s) = initState w
+    { createWallet = \walletName wid s -> do
         let checkpoint = initWallet s
         now <- liftIO getCurrentTime
         let metadata = WalletMetadata
-                { name = Cardano.Wallet.name w
+                { name = walletName
                 , passphraseInfo = WalletPassphraseInfo now
                 , status = Restoring minBound
                 , delegation = NotDelegating
                 }
-        DB.createWallet db (PrimaryKey wid) checkpoint metadata $> wid
+        DB.createWallet db (PrimaryKey wid) checkpoint metadata
 
     , readWallet = _readWallet
 
@@ -301,6 +289,40 @@ mkWalletLayer db network = WalletLayer
 
     mkStdTx = error "TODO: mkStdTx not implemented yet"
 
+-- | Initialise and store a new wallet with the sequential scheme of address
+-- derivation, returning its ID.
+createWalletSeq
+    :: WalletLayer SeqState
+    -> NewWallet
+    -> ExceptT ErrWalletAlreadyExists IO WalletId
+createWalletSeq wl nw = createWallet wl (nw ^. #name) wid st $> wid
+  where
+    (wid, st) = initSeqState (nw ^. #seed, nw ^. #secondFactor)
+                (nw ^. #passphrase) (nw ^. #gap)
+
+-- | Constructs the state specific to a sequential address derivation scheme
+-- wallet. The wallet ID and state should be passed to 'createWallet'.
+initSeqState
+    :: (Passphrase "seed", Passphrase "generation")
+    -> Passphrase "encryption"
+    -> AddressPoolGap
+    -> (WalletId, SeqState)
+initSeqState (pSeed, pSecondFactor) pEnc gap' = (wid, seqState)
+  where
+    wid = walletIdFromRootKey rootXPrv
+    rootXPrv = generateKeyFromSeed (pSeed, pSecondFactor) pEnc
+    accXPrv = deriveAccountPrivateKey mempty rootXPrv minBound
+    seqState = SeqState
+        { externalPool =
+            mkAddressPool (publicKey accXPrv) gap' ExternalChain []
+        , internalPool =
+            mkAddressPool (publicKey accXPrv) minBound InternalChain []
+        }
+
+-- | Generate a nice unique wallet ID by hashing the root public key.
+walletIdFromRootKey :: Key 'RootK XPrv -> WalletId
+walletIdFromRootKey = WalletId . digest . publicKey
+
 {-------------------------------------------------------------------------------
                                  Helpers
 -------------------------------------------------------------------------------}

diff --git a/src/Cardano/Wallet/Api/Server.hs b/src/Cardano/Wallet/Api/Server.hs
@@ -20,6 +20,7 @@ import Cardano.Wallet
     , ErrWalletAlreadyExists (..)
     , NewWallet (..)
     , WalletLayer (..)
+    , createWalletSeq
     )
 import Cardano.Wallet.Api
     ( Addresses, Api, Transactions, Wallets )
@@ -36,7 +37,7 @@ import Cardano.Wallet.Api.Types
     , getApiMnemonicT
     )
 import Cardano.Wallet.Primitive.AddressDiscovery
-    ( SeqState (..), SeqStateConfig (..), defaultAddressPoolGap )
+    ( SeqState (..), defaultAddressPoolGap )
 import Cardano.Wallet.Primitive.Model
     ( availableBalance, getState, totalBalance )
 import Cardano.Wallet.Primitive.Types
@@ -120,7 +121,7 @@ postWallet
     -> WalletPostData
     -> Handler ApiWallet
 postWallet w req = do
-    wid <- liftHandler $ createWallet w $ NewWallet
+    wid <- liftHandler $ createWalletSeq w $ NewWallet
         { seed =
             getApiMnemonicT (req ^. #mnemonicSentence)
         , secondFactor =
@@ -129,10 +130,8 @@ postWallet w req = do
             getApiT (req ^. #name)
         , passphrase =
             getApiT (req ^. #passphrase)
-        , addressDiscoveryConfig = SeqStateConfig
-            { seqStateGap =
-                maybe defaultAddressPoolGap getApiT (req ^.  #addressPoolGap)
-            }
+        , gap =
+            maybe defaultAddressPoolGap getApiT (req ^.  #addressPoolGap)
         }
     getWallet w (ApiT wid)
 

diff --git a/src/Cardano/Wallet/Primitive/AddressDiscovery.hs b/src/Cardano/Wallet/Primitive/AddressDiscovery.hs
@@ -36,7 +36,6 @@ module Cardano.Wallet.Primitive.AddressDiscovery
 
     -- ** State
     , SeqState (..)
-    , SeqStateConfig (..)
   ) where
 
 import Prelude
@@ -257,10 +256,6 @@ data SeqState = SeqState
 
 instance NFData SeqState
 
-data SeqStateConfig = SeqStateConfig
-    { seqStateGap :: !AddressPoolGap
-    } deriving stock (Generic, Show)
-
 -- NOTE
 -- We have to scan both the internal and external chain. Note that, the
 -- account discovery algorithm is only specified for the external chain so
@@ -271,8 +266,6 @@ data SeqStateConfig = SeqStateConfig
 -- that they are just created in sequence by the wallet software. Hence an
 -- address pool with a gap of 1 should be sufficient for the internal chain.
 instance IsOurs SeqState where
-    type AddressDiscoveryConfig SeqState = SeqStateConfig
-
     isOurs addr (SeqState !s1 !s2) =
         let
             (res1, !s1') = lookupAddress addr s1

diff --git a/src/Cardano/Wallet/Primitive/Types.hs b/src/Cardano/Wallet/Primitive/Types.hs
@@ -409,7 +409,6 @@ data TxWitness
 -- same time, and this little abstraction can buy us this without introducing
 -- too much overhead.
 class IsOurs s where
-    type AddressDiscoveryConfig s
     isOurs :: Address -> s -> (Bool, s)
 
 newtype Address = Address

diff --git a/test/bench/Cardano/Wallet/Primitive/AddressDiscovery/Any.hs b/test/bench/Cardano/Wallet/Primitive/AddressDiscovery/Any.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-- |
+-- Copyright: © 2018-2019 IOHK
+-- License: MIT
+--
+-- Custom address discovery schemes used for testing and benchmarking.
+--
+
+module Cardano.Wallet.Primitive.AddressDiscovery.Any
+    ( AnyAddressState (..)
+    , initAnyState
+    ) where
+
+import Prelude
+
+import Cardano.Wallet.Primitive.Types
+    ( Address (..), IsOurs (..), WalletId (..) )
+import Control.DeepSeq
+    ( NFData )
+import Crypto.Hash
+    ( hash )
+import Data.Digest.CRC32
+    ( crc32 )
+import Data.Word
+    ( Word32 )
+import GHC.Generics
+    ( Generic )
+
+import qualified Data.ByteString.Char8 as B8
+
+----------------------------------------------------------------------------
+
+-- | Any Address Derivation
+--
+-- An arbitrary fraction of addreses are recognized as "ours". This is done by
+-- looking at a checksum of the address.
+newtype AnyAddressState = AnyAddressState
+    { oursProportion :: Double
+    }
+    deriving stock (Generic, Show)
+
+instance NFData AnyAddressState
+
+instance IsOurs AnyAddressState where
+    isOurs (Address addr) s@(AnyAddressState p) = (crc32 addr < p', s)
+        where
+            p' = floor (fromIntegral (maxBound :: Word32) * p)
+
+initAnyState :: Double -> (WalletId, AnyAddressState)
+initAnyState p = (walletId cfg, cfg)
+    where cfg = AnyAddressState p
+
+walletId :: Show a => a -> WalletId
+walletId = WalletId . hash . B8.pack . show