Add init functions for address discovery schemes

cardano-foundation · Apr 8, 2019 · b04b8cb · b04b8cb
1 parent 0f55468
commit b04b8cb
Show file tree

Hide file tree

Showing 9 changed files with 66 additions and 37 deletions.
diff --git a/src/Cardano/Wallet.hs b/src/Cardano/Wallet.hs
@@ -45,7 +45,7 @@ import Cardano.Wallet.Primitive.AddressDerivation
     , publicKey
     )
 import Cardano.Wallet.Primitive.AddressDiscovery
-    ( AddressPoolGap, SeqState (..), mkAddressPool )
+    ( AddressPoolGap, SeqState (..), SeqStateConfig (..), mkAddressPool )
 import Cardano.Wallet.Primitive.Model
     ( Wallet, applyBlock, initWallet )
 import Cardano.Wallet.Primitive.Types
@@ -104,9 +104,9 @@ data NewWallet s = NewWallet
         :: !WalletName
     , passphrase
         :: !(Passphrase "encryption")
-    , gap
-        :: !AddressPoolGap
-    } deriving (Show, Generic)
+    , addressDiscoveryConfig
+        :: AddressDiscoveryConfig s
+    }
 
 -- | Errors occuring when fetching a wallet
 newtype ReadWalletError
@@ -132,8 +132,9 @@ instance InitState SeqState where
                 generateKeyFromSeed (seed w, secondFactor w) (passphrase w)
             accXPrv =
                 deriveAccountPrivateKey mempty rootXPrv minBound
+            ad = addressDiscoveryConfig w
             extPool =
-                mkAddressPool (publicKey accXPrv) (gap w) ExternalChain []
+                mkAddressPool (publicKey accXPrv) (seqStateGap ad) ExternalChain []
             intPool =
                 mkAddressPool (publicKey accXPrv) minBound InternalChain []
             seqState = SeqState

diff --git a/src/Cardano/Wallet/Api/Server.hs b/src/Cardano/Wallet/Api/Server.hs
@@ -34,7 +34,7 @@ import Cardano.Wallet.Api.Types
     , getApiMnemonicT
     )
 import Cardano.Wallet.Primitive.AddressDiscovery
-    ( SeqState (..), defaultAddressPoolGap )
+    ( SeqState (..), SeqStateConfig (..), defaultAddressPoolGap )
 import Cardano.Wallet.Primitive.Model
     ( availableBalance, getState, totalBalance )
 import Cardano.Wallet.Primitive.Types
@@ -127,8 +127,10 @@ postWallet w req = do
             getApiT (req ^. #name)
         , passphrase =
             getApiT (req ^. #passphrase)
-        , gap =
-            maybe defaultAddressPoolGap getApiT (req ^.  #addressPoolGap)
+        , addressDiscoveryConfig = SeqStateConfig
+            { seqStateGap =
+                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
@@ -4,6 +4,7 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 
 -- |
 -- Copyright: © 2018-2019 IOHK
@@ -35,6 +36,7 @@ module Cardano.Wallet.Primitive.AddressDiscovery
 
     -- ** State
     , SeqState (..)
+    , SeqStateConfig (..)
   ) where
 
 import Prelude
@@ -255,6 +257,10 @@ 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
@@ -265,6 +271,8 @@ instance NFData SeqState
 -- 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/AddressDiscovery/Fixed.hs b/src/Cardano/Wallet/Primitive/AddressDiscovery/Fixed.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 
 -- |
 -- Copyright: © 2018-2019 IOHK
@@ -23,7 +24,7 @@ import Prelude
 
 import Cardano.Wallet.Primitive.Types
     ( Address(..), IsOurs (..), invariant, WalletId(..) )
-import Cardano.Wallet ( InitState(..))
+import Cardano.Wallet ( InitState(..), NewWallet (..) )
 import Data.Set
     ( Set )
 import Data.Map.Strict
@@ -62,6 +63,7 @@ data FixedAddressState = FixedAddressState
 instance NFData FixedAddressState
 
 instance IsOurs FixedAddressState where
+    type AddressDiscoveryConfig FixedAddressState = FixedAddressState
     isOurs addr s = (Set.member addr (knownAddresses s), s)
 
 
@@ -81,12 +83,15 @@ data AnyAddressState = AnyAddressState
 instance NFData AnyAddressState
 
 instance IsOurs AnyAddressState where
+    type AddressDiscoveryConfig AnyAddressState = AnyAddressState
+
     isOurs (Address addr) s@(AnyAddressState p) = (crc32 addr < p', s)
         where
             p' = floor (fromIntegral (maxBound :: Word32) * p)
 
 instance InitState AnyAddressState where
-    initState s = (walletId s, AnyAddressState 0.5)
+    initState w = (walletId cfg, cfg)
+        where cfg = addressDiscoveryConfig w
 
 walletId :: Show a => a -> WalletId
 walletId = WalletId . hash . B8.pack . show
diff --git a/src/Cardano/Wallet/Primitive/Types.hs b/src/Cardano/Wallet/Primitive/Types.hs
@@ -391,6 +391,7 @@ newtype SignedTx = SignedTx { signedTx :: ByteString }
 -- 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/Main.hs b/test/bench/Main.hs
@@ -45,10 +45,10 @@ import Cardano.Wallet.Network.HttpBridge
 import Cardano.Wallet.Primitive.AddressDerivation
     ( Passphrase (..) )
 import Cardano.Wallet.Primitive.AddressDiscovery
-    ( SeqState(..), mkAddressPoolGap )
+    ( SeqState (..), SeqStateConfig (..), mkAddressPoolGap )
 import Cardano.Wallet.Primitive.AddressDiscovery.Fixed
 import Cardano.Wallet.Primitive.Types
-    ( SlotId (..), WalletName (..), WalletId )
+    ( AddressDiscoveryConfig (..), SlotId (..), WalletName (..), WalletId )
 import Cardano.Wallet.Primitive.Model (availableBalance)
 
 import qualified Cardano.Wallet.DB.MVar as MVar
@@ -59,8 +59,8 @@ main = do
     installSignalHandlers
     mapM_ prepareNode ["testnet", "mainnet"]
     runBenchmarks
-        [ bench "restore - testnet - walletRnd" $ test1 "testnet" walletAny
-        , bench "restore - mainnet - walletRnd" $ test1 "mainnet" walletAny
+        [ bench "restore - testnet - walletRnd" $ test1 "testnet" (walletAny 1.0)
+        , bench "restore - mainnet - walletRnd" $ test1 "mainnet" (walletAny 0.2)
         , bench "restore - testnet - walletSeq" $ test1 "testnet" walletSeq
         , bench "restore - mainnet - walletSeq" $ test1 "mainnet" walletSeq
         ]
@@ -127,22 +127,22 @@ withHttpBridge netName action = bracket start stop (const (action port))
             threadDelay 1000000 -- wait for socket to be closed
 
 
-baseWallet :: NewWallet s
-baseWallet = NewWallet (Passphrase "") (Passphrase "")
-             (WalletName "") (Passphrase "") gap20
-    where Right gap20 = mkAddressPoolGap 20
+baseWallet :: AddressDiscoveryConfig s -> NewWallet s
+baseWallet cfg = NewWallet (Passphrase "") (Passphrase "")
+                 (WalletName "") (Passphrase "") cfg
 
-walletAny :: NewWallet AnyAddressState
-walletAny = baseWallet
+walletAny :: Double -> NewWallet AnyAddressState
+walletAny p = (baseWallet (AnyAddressState p))
     { seed = Passphrase "skull skin weird piece oak absorb apart above female dial drink traffic"
     , name = WalletName "Benchmark Daedalus Wallet"
     }
 
 walletSeq :: NewWallet SeqState
-walletSeq = baseWallet
+walletSeq = (baseWallet (SeqStateConfig gap20))
     { seed = Passphrase "involve key curtain arrest fortune custom lens marine before material wheel glide cause weapon wrap"
     , name = WalletName "Benchmark Yoroi Wallet"
     }
+    where Right gap20 = mkAddressPoolGap 20
 
 prepareNode :: Text -> IO ()
 prepareNode netName = do

diff --git a/test/integration/Cardano/WalletSpec.hs b/test/integration/Cardano/WalletSpec.hs
@@ -14,6 +14,8 @@ import Cardano.Wallet
     ( NewWallet (..), WalletLayer (..), mkWalletLayer, unsafeRunExceptT )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( Passphrase (..) )
+import Cardano.Wallet.Primitive.AddressDiscovery
+    ( SeqState, SeqStateConfig (..) )
 import Cardano.Wallet.Primitive.Mnemonic
     ( EntropySize, entropyToBytes, genEntropy )
 import Cardano.Wallet.Primitive.Model
@@ -35,13 +37,15 @@ spec = do
     before startBridge $ after closeBridge $ do
         it "A newly created wallet can sync with the chain" $ \(_, wallet) -> do
             bytes <- entropyToBytes <$> genEntropy @(EntropySize 15)
-            wid <- unsafeRunExceptT $ createWallet wallet NewWallet
-                { seed = Passphrase bytes
-                , secondFactor = mempty
-                , name = WalletName "My Wallet"
-                , passphrase = mempty
-                , gap = minBound
-                }
+            let wal = NewWallet
+                    { seed = Passphrase bytes
+                    , secondFactor = mempty
+                    , name = WalletName "My Wallet"
+                    , passphrase = mempty
+                    , addressDiscoveryConfig =
+                        SeqStateConfig { seqStateGap = minBound }
+                    } :: NewWallet SeqState
+            wid <- unsafeRunExceptT $ createWallet wallet wal
             handle <- async (watchWallet wallet wid)
             threadDelay 5000000
             cancel handle

diff --git a/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs b/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Cardano.Wallet.Primitive.ModelSpec
@@ -216,6 +217,7 @@ instance Semigroup WalletState where
             (\_ -> ours == ours')
 
 instance IsOurs WalletState where
+    type AddressDiscoveryConfig WalletState = ()
     isOurs addr s@(WalletState ours discovered) =
         if (ShowFmt addr) `elem` ours then
             (True, WalletState ours (Set.insert (ShowFmt addr) discovered))

diff --git a/test/unit/Cardano/WalletSpec.hs b/test/unit/Cardano/WalletSpec.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
@@ -24,7 +25,7 @@ import Cardano.Wallet.Network.HttpBridge
 import Cardano.Wallet.Primitive.AddressDerivation
     ( Passphrase (..) )
 import Cardano.Wallet.Primitive.AddressDiscovery
-    ( AddressPoolGap, SeqState )
+    ( AddressPoolGap, SeqState, SeqStateConfig (..) )
 import Cardano.Wallet.Primitive.Mnemonic
     ( Entropy
     , EntropySize
@@ -93,47 +94,47 @@ spec = do
 -------------------------------------------------------------------------------}
 
 walletCreationProp
-    :: NewWallet
+    :: NewWallet SeqState
     -> Property
 walletCreationProp newWallet = monadicIO $ liftIO $ do
     (WalletLayerFixture db _wl walletIds) <- setupFixture newWallet
     resFromDb <- readCheckpoint db (PrimaryKey $ L.head walletIds)
     resFromDb `shouldSatisfy` isJust
 
 walletDoubleCreationProp
-    :: NewWallet
+    :: NewWallet SeqState
     -> Property
 walletDoubleCreationProp newWallet = monadicIO $ liftIO $ do
     (WalletLayerFixture _db wl _walletIds) <- setupFixture newWallet
     secondTrial <- runExceptT $ createWallet wl newWallet
     secondTrial `shouldSatisfy` isLeft
 
 walletGetProp
-    :: NewWallet
+    :: NewWallet SeqState
     -> Property
 walletGetProp newWallet = monadicIO $ liftIO $ do
     (WalletLayerFixture _db wl walletIds) <- liftIO $ setupFixture newWallet
     resFromGet <- runExceptT $ readWallet wl (L.head walletIds)
     resFromGet `shouldSatisfy` isRight
 
 walletGetWrongIdProp
-    :: (NewWallet, WalletId)
+    :: (NewWallet SeqState, WalletId)
     -> Property
 walletGetWrongIdProp (newWallet, corruptedWalletId) = monadicIO $ liftIO $ do
     (WalletLayerFixture _db wl _walletIds) <- liftIO $ setupFixture newWallet
     attempt <- runExceptT $ readWallet wl corruptedWalletId
     attempt `shouldSatisfy` isLeft
 
 walletIdDeterministic
-    :: NewWallet
+    :: NewWallet SeqState
     -> Property
 walletIdDeterministic newWallet = monadicIO $ liftIO $ do
     (WalletLayerFixture _ _ widsA) <- liftIO $ setupFixture newWallet
     (WalletLayerFixture _ _ widsB) <- liftIO $ setupFixture newWallet
     widsA `shouldBe` widsB
 
 walletIdInjective
-    :: (NewWallet, NewWallet)
+    :: (NewWallet SeqState, NewWallet SeqState)
     -> Property
 walletIdInjective (walletA, walletB) = monadicIO $ liftIO $ do
     (WalletLayerFixture _ _ widsA) <- liftIO $ setupFixture walletA
@@ -151,7 +152,7 @@ data WalletLayerFixture = WalletLayerFixture {
     }
 
 setupFixture
-    :: NewWallet
+    :: NewWallet SeqState
     -> IO WalletLayerFixture
 setupFixture newWallet = do
     db <- newDBLayer
@@ -163,7 +164,9 @@ setupFixture newWallet = do
             Right walletId -> [walletId]
     pure $ WalletLayerFixture db wl wal
 
-instance Arbitrary NewWallet where
+deriving instance Show (NewWallet SeqState)
+
+instance Arbitrary (NewWallet SeqState) where
     -- No shrinking
     arbitrary = NewWallet
         <$> arbitrary
@@ -172,6 +175,9 @@ instance Arbitrary NewWallet where
         <*> arbitrary
         <*> arbitrary
 
+instance Arbitrary SeqStateConfig where
+    arbitrary = SeqStateConfig <$> arbitrary
+
 instance
     ( ValidEntropySize n
     , ValidChecksumSize n csz