From 9c2a3f9af3418cd1129a0e4c44e19c845fdc3f8f Mon Sep 17 00:00:00 2001 From: KtorZ Date: Wed, 26 Aug 2020 15:43:45 +0200 Subject: [PATCH 1/7] extend restoration benchmarks with a special 1% random wallet This wallet is very analogous to the existing any% wallet scheme we designed a while ago, with a subtle difference: it is built __on top of__ the 'RndState' and, as a result, does perform the same database operation and addresses management as the standard random wallets. So the benchmark results obtained from this are much closer to what an actual random wallet of the same size would look like. --- .../Primitive/AddressDiscovery/Random.hs | 10 +++---- lib/shelley/bench/Restore.hs | 26 +++---------------- 2 files changed, 8 insertions(+), 28 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs index cbaf21651ea..d359c2d79e7 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs @@ -292,9 +292,9 @@ instance KnownAddresses (RndState n) where -- it discover addresses based on an arbitrary ratio instead of decrypting the -- derivation path. -- --- The proportion is stored as a type-level parameter so that we don't have to --- alter the database schema to store it. It simply exists and depends on the --- caller creating the wallet to define it. +-- The type parameter is expected to be a ratio (between 0 and 100) of addresses +-- we ought to simply recognize as ours. So, giving @5 means that 5% of the +-- entire address space of the network will be considered ours, picked randomly. newtype RndAnyState (network :: NetworkDiscriminant) (p :: Nat) = RndAnyState { innerState :: RndState network } deriving (Generic, Show) @@ -304,8 +304,8 @@ instance NFData (RndAnyState n p) -- | Initialize the HD random address discovery state from a root key and RNG -- seed. -- --- The type parameter is expected to be a ratio (between 0 and 100) of addresses --- we ought to simply recognize as ours. So, giving @5 means that 5% of the +-- The first argument is expected to be a ratio (between 0 and 1) of addresses +-- we ought to simply recognize as ours. So, giving .5 means that 50% of the -- entire address space of the network will be considered ours, picked randomly. mkRndAnyState :: forall (p :: Nat) n. () diff --git a/lib/shelley/bench/Restore.hs b/lib/shelley/bench/Restore.hs index 8814e8908cd..8083538fb80 100644 --- a/lib/shelley/bench/Restore.hs +++ b/lib/shelley/bench/Restore.hs @@ -208,34 +208,14 @@ cardanoRestoreBench tr c socketFile = do "1-percent-rnd.timelog" (walletRnd $ mkRndAnyState @1)) - , bench ("restore " <> network <> " 0.1% any") - (bench_restoration @_ @ShelleyKey + , bench ("restore " <> network <> " 1% naked") + (bench_restoration @_ @IcarusKey networkProxy tr socketFile np vData - "0.1-percent-any.timelog" - (initAnyState "Benchmark 0.1% Wallet" 0.001)) - - , bench ("restore " <> network <> " 0.5% any") - (bench_restoration @_ @ShelleyKey - networkProxy - tr - socketFile - np - vData - "0.5-percent-any.timelog" - (initAnyState "Benchmark 0.5% Wallet" 0.005)) - - , bench ("restore " <> network <> " 1% any") - (bench_restoration @_ @ShelleyKey - networkProxy - tr - socketFile - np - vData - "1-percent-any.timelog" + "1-percent-naked.timelog" (initAnyState "Benchmark 1% Wallet" 0.01)) ] where From bb7c30751f335c0e0df076cf4fdbac35ca285702 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Thu, 27 Aug 2020 13:17:47 +0200 Subject: [PATCH 2/7] perform additional checks after restoration benchmarks In particular, we check for the time needed to list addresses on a wallet, as well as the time needed to perform a fee estimation. This gives an order of magnitude of how long these functions take on large wallets. --- .../src/Cardano/Wallet/BenchShared.hs | 29 +-- lib/core/src/Cardano/Wallet.hs | 6 +- .../Primitive/AddressDiscovery/Random.hs | 16 +- .../src/Cardano/Wallet/Primitive/Types.hs | 6 + lib/shelley/bench/Restore.hs | 174 ++++++++++++------ 5 files changed, 147 insertions(+), 84 deletions(-) diff --git a/lib/core-integration/src/Cardano/Wallet/BenchShared.hs b/lib/core-integration/src/Cardano/Wallet/BenchShared.hs index 293d096afc1..1d534f5ed55 100644 --- a/lib/core-integration/src/Cardano/Wallet/BenchShared.hs +++ b/lib/core-integration/src/Cardano/Wallet/BenchShared.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} -- | @@ -19,6 +20,7 @@ module Cardano.Wallet.BenchShared -- * Benchmark runner , runBenchmarks , bench + , Time ) where import Prelude @@ -46,7 +48,7 @@ import Cardano.Wallet.Network.Ports import Control.Concurrent ( threadDelay ) import Control.DeepSeq - ( rnf ) + ( NFData, rnf ) import Control.Exception ( evaluate ) import Control.Monad @@ -58,7 +60,9 @@ import Data.Functor import Data.Text ( Text ) import Fmt - ( fmt, (+|), (|+) ) + ( Buildable (..), nameF, pretty ) +import GHC.Generics + ( Generic ) import Options.Applicative ( HasValue , Mod @@ -204,28 +208,31 @@ getRestoreBenchArgs = do Benchmark runner -------------------------------------------------------------------------------} -runBenchmarks :: [IO (Text, Double)] -> IO () +newtype Time = Time + { unTime :: Double + } deriving (Show, Generic) + +instance Buildable Time where + build = build . secs . unTime + +runBenchmarks :: Buildable a => [IO a] -> IO () runBenchmarks bs = do initializeTime -- NOTE: Adding an artificial delay between successive runs to get a better -- output for the heap profiling. rs <- forM bs $ \io -> io <* let _2s = 2000000 in threadDelay _2s sayErr "\n\nAll results:" - mapM_ (uncurry printResult) rs + mapM_ (sayErr . pretty) rs -bench :: Text -> IO () -> IO (Text, Double) +bench :: NFData a => Text -> IO a -> IO (a, Time) bench benchName action = do sayErr $ "Running " <> benchName start <- getTime res <- action evaluate (rnf res) finish <- getTime - let dur = finish - start - printResult benchName dur - pure (benchName, dur) - -printResult :: Text -> Double -> IO () -printResult benchName dur = sayErr . fmt $ " "+|benchName|+": "+|secs dur|+"" + let t = Time $ finish - start + (res, t) <$ sayErr (pretty $ nameF (build benchName) (build t)) initBenchmarkLogging :: Severity -> IO (CM.Configuration, Trace IO Text) initBenchmarkLogging minSeverity = do diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index 69161ca9242..51f5fca5d72 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/lib/core/src/Cardano/Wallet.hs @@ -331,6 +331,8 @@ import Cardano.Wallet.Transaction ) import Cardano.Wallet.Unsafe ( unsafeXPrv ) +import Control.DeepSeq + ( NFData ) import Control.Exception ( Exception, try ) import Control.Monad @@ -1988,7 +1990,9 @@ data FeeEstimation = FeeEstimation -- ^ Most coin selections will result in a fee higher than this. , estMaxFee :: Word64 -- ^ Most coin selections will result in a fee lower than this. - } deriving (Show, Eq) + } deriving (Show, Eq, Generic) + +instance NFData FeeEstimation -- | Estimate the transaction fee for a given coin selection algorithm by -- repeatedly running it (100 times) and collecting the results. In the returned diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs index d359c2d79e7..ea38e41cb9c 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs @@ -352,18 +352,12 @@ instance IsOurs (RndAnyState n p) ChimericAccount where instance KnownNat p => IsOwned (RndAnyState n p) ByronKey where isOwned _ _ _ = Nothing -instance GenChange (RndAnyState n p) where - type ArgGenChange (RndAnyState n p) = () - genChange _ = error - "GenChange.genChange: trying to generate change for \ - \an incompatible scheme '(RndAnyState n p)'. Please don't." +instance PaymentAddress n ByronKey => GenChange (RndAnyState n p) where + type ArgGenChange (RndAnyState n p) = ArgGenChange (RndState n) + genChange a (RndAnyState s) = RndAnyState <$> genChange a s instance CompareDiscovery (RndAnyState n p) where - compareDiscovery _ _ _ = error - "CompareDiscovery.compareDiscovery: trying to generate change for \ - \an incompatible scheme '(RndAnyState n p)'. Please don't." + compareDiscovery (RndAnyState s) = compareDiscovery s instance KnownAddresses (RndAnyState n p) where - knownAddresses _ = error - "KnownAddresses.knownAddresses: trying to generate change for \ - \an incompatible scheme '(RndAnyState n p)'. Please don't." + knownAddresses (RndAnyState s) = knownAddresses s diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs index 1cffca13405..33145844b66 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types.hs @@ -1253,6 +1253,8 @@ data UTxOStatistics = UTxOStatistics , boundType :: BoundType } deriving (Show, Generic, Ord) +instance NFData UTxOStatistics + -- Example output: -- -- @ @@ -1308,12 +1310,16 @@ data HistogramBar = HistogramBar , bucketCount :: !Word64 } deriving (Show, Eq, Ord, Generic) +instance NFData HistogramBar + instance Buildable HistogramBar where build (HistogramBar k v) = tupleF (k, v) -- Buckets boundaries can be constructed in different ways data BoundType = Log10 deriving (Eq, Show, Ord, Generic) +instance NFData BoundType + -- | Smart-constructor to create bounds using a log-10 scale log10 :: BoundType log10 = Log10 diff --git a/lib/shelley/bench/Restore.hs b/lib/shelley/bench/Restore.hs index 8083538fb80..6afec1f62a0 100644 --- a/lib/shelley/bench/Restore.hs +++ b/lib/shelley/bench/Restore.hs @@ -1,13 +1,16 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} + {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Benchmark measuring how long restoration takes for different wallets. @@ -41,6 +44,7 @@ import Cardano.Wallet ( WalletLayer (..), WalletLog (..) ) import Cardano.Wallet.BenchShared ( RestoreBenchArgs (..) + , Time , argsNetworkDir , bench , execBenchWithNode @@ -58,6 +62,7 @@ import Cardano.Wallet.Primitive.AddressDerivation ( Depth (..) , NetworkDiscriminant (..) , NetworkDiscriminantVal (..) + , Passphrase (..) , PersistPrivateKey , WalletKey , digest @@ -68,7 +73,7 @@ import Cardano.Wallet.Primitive.AddressDerivation.Byron import Cardano.Wallet.Primitive.AddressDerivation.Shelley ( ShelleyKey ) import Cardano.Wallet.Primitive.AddressDiscovery - ( IsOurs, IsOwned ) + ( CompareDiscovery, IsOurs, IsOwned, KnownAddresses ) import Cardano.Wallet.Primitive.AddressDiscovery.Any ( initAnyState ) import Cardano.Wallet.Primitive.AddressDiscovery.Any.TH @@ -76,7 +81,12 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Any.TH import Cardano.Wallet.Primitive.AddressDiscovery.Random ( mkRndAnyState, mkRndState ) import Cardano.Wallet.Primitive.AddressDiscovery.Sequential - ( SeqState (..), mkAddressPoolGap, mkSeqStateFromRootXPrv ) + ( AddressPoolGap + , SeqState (..) + , mkAddressPoolGap + , mkSeqAnyState + , mkSeqStateFromRootXPrv + ) import Cardano.Wallet.Primitive.Model ( currentTip, totalUTxO ) import Cardano.Wallet.Primitive.Slotting @@ -84,7 +94,7 @@ import Cardano.Wallet.Primitive.Slotting import Cardano.Wallet.Primitive.SyncProgress ( SyncProgress (..), mkSyncTolerance, syncProgress ) import Cardano.Wallet.Primitive.Types - ( Address + ( Address (..) , Block (..) , BlockHeader (..) , ChimericAccount @@ -92,6 +102,8 @@ import Cardano.Wallet.Primitive.Types , GenesisParameters (..) , NetworkParameters (..) , SlotNo (..) + , TxOut (..) + , UTxOStatistics , WalletId (..) , WalletName (..) , computeUtxoStatistics @@ -120,9 +132,11 @@ import Control.Monad import Control.Monad.IO.Class ( MonadIO (..) ) import Control.Monad.Trans.Except - ( runExceptT ) + ( runExceptT, withExceptT ) import Control.Tracer ( Tracer (..), traceWith ) +import Data.List.NonEmpty + ( NonEmpty (..) ) import Data.Proxy ( Proxy (..) ) import Data.Quantity @@ -134,7 +148,9 @@ import Data.Time.Clock.POSIX import Database.Persist.Sql ( runMigrationSilent ) import Fmt - ( build, fmt, pretty, (+|), (+||), (|+), (||+) ) + ( Buildable, build, fmt, genericF, pretty, (+|), (+||), (|+), (||+) ) +import GHC.Generics + ( Generic ) import Say ( sayErr ) import System.FilePath @@ -148,6 +164,7 @@ import qualified Cardano.Wallet as W import qualified Cardano.Wallet.DB.Sqlite as Sqlite import qualified Cardano.Wallet.Primitive.AddressDerivation.Byron as Byron import qualified Cardano.Wallet.Primitive.AddressDerivation.Shelley as Shelley +import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 import qualified Data.List.NonEmpty as NE import qualified Data.Text as T @@ -178,78 +195,74 @@ cardanoRestoreBench tr c socketFile = do prepareNode networkProxy socketFile np vData runBenchmarks - [ bench ("restore " <> network <> " seq") - (bench_restoration @_ @ShelleyKey - networkProxy - tr - socketFile - np - vData - "seq.timelog" - (walletSeq networkProxy)) - - , bench ("restore " <> network <> " rnd") - (bench_restoration @_ @ByronKey - networkProxy - tr - socketFile - np - vData - "rnd.timelog" - (walletRnd mkRndState)) - - , bench ("restore " <> network <> " 1% rnd") - (bench_restoration @_ @ByronKey - networkProxy - tr - socketFile - np - vData - "1-percent-rnd.timelog" - (walletRnd $ mkRndAnyState @1)) - - , bench ("restore " <> network <> " 1% naked") - (bench_restoration @_ @IcarusKey - networkProxy - tr - socketFile - np - vData - "1-percent-naked.timelog" - (initAnyState "Benchmark 1% Wallet" 0.01)) + [ bench_restoration @_ @ShelleyKey + networkProxy + tr + socketFile + np + vData + "seq.timelog" + (walletSeq "Seq Empty Wallet" networkProxy mkSeqStateFromRootXPrv) + + , bench_restoration @_ @ByronKey + networkProxy + tr + socketFile + np + vData + "rnd.timelog" + (walletRnd "Rnd Empty Wallet" mkRndState) + + , bench_restoration @_ @ByronKey + networkProxy + tr + socketFile + np + vData + "1-percent-rnd.timelog" + (walletRnd "Rnd 1% Wallet" $ mkRndAnyState @1) + + , bench_restoration @_ @ShelleyKey + networkProxy + tr + socketFile + np + vData + "1-percent-seq.timelog" + (walletSeq "Seq 1% Wallet" networkProxy $ mkSeqAnyState @1) ] where walletRnd - :: (ByronKey 'RootK XPrv -> Int -> s) + :: Text + -> (ByronKey 'RootK XPrv -> Int -> s) -> (WalletId, WalletName, s) - walletRnd mk = + walletRnd wname mkState = let seed = SomeMnemonic . unsafeMkMnemonic @15 $ T.words "involve key curtain arrest fortune custom lens marine before \ \material wheel glide cause weapon wrap" xprv = Byron.generateKeyFromSeed seed mempty wid = WalletId $ digest $ publicKey xprv - wname = WalletName "Benchmark Random Wallet" rngSeed = 0 - s = mk xprv rngSeed + s = mkState xprv rngSeed in - (wid, wname, s) + (wid, WalletName wname, s) walletSeq - :: forall n. Proxy n - -> (WalletId, WalletName, SeqState n ShelleyKey) - walletSeq _ = + :: Text + -> ((ShelleyKey 'RootK XPrv, Passphrase "encryption") -> AddressPoolGap -> s) + -> (WalletId, WalletName, s) + walletSeq wname mkState = let seed = SomeMnemonic . unsafeMkMnemonic @15 $ T.words "involve key curtain arrest fortune custom lens marine before \ \material wheel glide cause weapon wrap" xprv = Shelley.generateKeyFromSeed (seed, Nothing) mempty wid = WalletId $ digest $ publicKey xprv - wname = WalletName "Benchmark Sequential Wallet" Right gap = mkAddressPoolGap 20 - s = mkSeqStateFromRootXPrv (xprv, mempty) gap + s = mkState (xprv, mempty) gap in - (wid, wname, s) + (wid, WalletName wname, s) networkDescription :: forall n. (NetworkDiscriminantVal n) => Proxy n -> Text networkDescription _ = networkDiscriminantVal @n @@ -258,6 +271,17 @@ cardanoRestoreBench tr c socketFile = do Benchmarks -------------------------------------------------------------------------------} +data BenchResults = BenchResults + { qualifier :: Text + , restorationTime :: Time + , listingAddressesTime :: Time + , estimatingFeesTime :: Time + , utxoStatistics :: UTxOStatistics + } deriving (Show, Generic) + +instance Buildable BenchResults where + build = genericF + {-# ANN bench_restoration ("HLint: ignore Use camelCase" :: String) #-} bench_restoration :: forall (n :: NetworkDiscriminant) (k :: Depth -> * -> *) s t. @@ -268,6 +292,8 @@ bench_restoration , NFData s , Show s , PersistState s + , CompareDiscovery s + , KnownAddresses s , PersistPrivateKey (k 'RootK) , NetworkDiscriminantVal n , HasNetworkId n @@ -283,7 +309,7 @@ bench_restoration -> FilePath -- ^ Log output -> (WalletId, WalletName, s) - -> IO () + -> IO BenchResults bench_restoration proxy tracer socketPath np vData progressLogFile (wid, wname, s) = do let networkText = networkDiscriminantVal @n let networkId = networkIdVal proxy @@ -310,12 +336,38 @@ bench_restoration proxy tracer socketPath np vData progressLogFile (wid, wname, db wallet <- unsafeRunExceptT $ W.createWallet w wid wname s void $ forkIO $ unsafeRunExceptT $ W.restoreWallet @_ @s @t @k w wid - waitForWalletSync w wallet gp vData - (wallet', _, pending) <- unsafeRunExceptT $ W.readWallet w wid - sayErr "Wallet restored!" - sayErr . fmt . build $ - computeUtxoStatistics log10 (totalUTxO pending wallet') + (_, restorationTime) <- bench "restoration" $ do + waitForWalletSync w wallet gp vData + + (utxoStatistics, _) <- bench "utxo statistics" $ do + (wallet', _, pending) <- unsafeRunExceptT $ W.readWallet w wid + pure $ computeUtxoStatistics log10 (totalUTxO pending wallet') + + (_, listingAddressesTime) <- bench "list addresses" $ + unsafeRunExceptT $ W.listAddresses w wid (const pure) + + (_, estimatingFeesTime) <- bench "estimate tx fee" $ do + let out = TxOut (dummyAddress @n) (Coin 1) + runExceptT $ withExceptT show $ W.estimateFeeForPayment @_ @s @t @k + w wid (out :| []) (Quantity 0) + unsafeRunExceptT $ W.deleteWallet w wid + pure BenchResults + { qualifier = getWalletName wname + , restorationTime + , listingAddressesTime + , estimatingFeesTime + , utxoStatistics + } + +dummyAddress + :: forall (n :: NetworkDiscriminant). NetworkDiscriminantVal n + => Address +dummyAddress + | networkDiscriminantVal @n == networkDiscriminantVal @'Mainnet = + Address $ BS.pack $ 0 : replicate 56 0 + | otherwise = + Address $ BS.pack $ 1 : replicate 56 0 traceProgressForPlotting :: Tracer IO Text -> Tracer IO WalletLog traceProgressForPlotting tr = Tracer $ \case From 5850559fb37df5603e5673b33b28a5beb97bb4b7 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Thu, 27 Aug 2020 14:27:35 +0200 Subject: [PATCH 3/7] define a 'SeqAnyState' analogous to the 'RndAnyState' for benchmarks This make sure that benchmarks reflects a real-setup with a bit more fidelity by also storing and retrieving the address space. --- lib/core/src/Cardano/Wallet/DB/Sqlite.hs | 6 + .../Primitive/AddressDiscovery/Sequential.hs | 118 +++++++++++++++++- lib/shelley/bench/Restore.hs | 23 +++- 3 files changed, 144 insertions(+), 3 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs index 353713ff446..bfd602b7208 100644 --- a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs +++ b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs @@ -1493,6 +1493,12 @@ class PersistState s where Sequential address discovery -------------------------------------------------------------------------------} +-- piggy-back on SeqState existing instance, to simulate the same behavior. +instance PersistState (Seq.SeqState n k) => PersistState (Seq.SeqAnyState n k p) + where + insertState (wid, sl) = insertState (wid, sl) . Seq.innerState + selectState (wid, sl) = fmap Seq.SeqAnyState <$> selectState (wid, sl) + instance ( Eq (k 'AccountK XPub) , PersistPublicKey (k 'AccountK) diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs index ce9b7c69145..0756629e064 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs @@ -57,6 +57,10 @@ module Cardano.Wallet.Primitive.AddressDiscovery.Sequential , SeqState (..) , mkSeqStateFromRootXPrv , mkSeqStateFromAccountXPub + + -- ** Benchmarking + , SeqAnyState (..) + , mkSeqAnyState ) where import Prelude @@ -87,7 +91,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery , KnownAddresses (..) ) import Cardano.Wallet.Primitive.Types - ( Address, AddressState (..), invariant ) + ( Address (..), AddressState (..), ChimericAccount (..), invariant ) import Control.Applicative ( (<|>) ) import Control.DeepSeq @@ -96,6 +100,8 @@ import Control.Monad ( unless ) import Data.Bifunctor ( first ) +import Data.Digest.CRC32 + ( crc32 ) import Data.Function ( (&) ) import Data.Map.Strict @@ -118,6 +124,8 @@ import GHC.Generics ( Generic ) import GHC.Stack ( HasCallStack ) +import GHC.TypeLits + ( KnownNat, Nat, natVal ) import qualified Data.List as L import qualified Data.Map.Strict as Map @@ -718,3 +726,111 @@ instance addresses (liftPaymentAddress @n @k) (externalPool s) in nonChangeAddresses <> changeAddresses + +-------------------------------------------------------------------------------- +-- +-- SeqAnyState +-- +-- For benchmarking and testing arbitrary large sequential wallets. + +-- | An "unsound" alternative that can be used for benchmarking and stress +-- testing. It re-uses the same underlying structure as the `SeqState` but +-- it discover addresses based on an arbitrary ratio instead of decrypting the +-- derivation path. +-- +-- The proportion is stored as a type-level parameter so that we don't have to +-- alter the database schema to store it. It simply exists and depends on the +-- caller creating the wallet to define it. +newtype SeqAnyState (network :: NetworkDiscriminant) key (p :: Nat) = SeqAnyState + { innerState :: SeqState network key + } deriving (Generic) + +deriving instance + ( Show (k 'AccountK XPub) + , Show (k 'AddressK XPub) + , Show (KeyFingerprint "payment" k) + ) => Show (SeqAnyState n k p) + +instance + ( NFData (k 'AccountK XPub) + , NFData (k 'AddressK XPub) + , NFData (KeyFingerprint "payment" k) + ) + => NFData (SeqAnyState n k p) + +-- | Initialize the HD random address discovery state from a root key and RNG +-- seed. +-- +-- The first argument is expected to be a ratio (between 0 and 1) of addresses +-- we ought to simply recognize as ours. So, giving .5 means that 50% of the +-- entire address space of the network will be considered ours, picked randomly. +mkSeqAnyState + :: forall (p :: Nat) n k. + ( SoftDerivation k + , MkKeyFingerprint k (Proxy n, k 'AddressK XPub) + , MkKeyFingerprint k Address + , WalletKey k + , Bounded (Index (AddressIndexDerivationType k) 'AddressK) + ) + => (k 'RootK XPrv, Passphrase "encryption") + -> AddressPoolGap + -> SeqAnyState n k p +mkSeqAnyState credentials poolGap = SeqAnyState + { innerState = mkSeqStateFromRootXPrv credentials poolGap + } + +instance + ( SoftDerivation k + , MkKeyFingerprint k (Proxy n, k 'AddressK XPub) + , KnownNat p + ) => IsOurs (SeqAnyState n k p) Address + where + isOurs (Address bytes) st@(SeqAnyState inner) + | crc32 bytes < p = + let + edge = Map.size (indexedKeys $ externalPool inner) + ix = toEnum (edge - fromEnum (gap $ externalPool inner)) + pool' = extendAddressPool @n ix (externalPool inner) + in + (True, SeqAnyState (inner { externalPool = pool' })) + | otherwise = + (False, st) + where + p = floor (double (maxBound :: Word32) * double (natVal (Proxy @p)) / 100) + + double :: Integral a => a -> Double + double = fromIntegral + +instance IsOurs (SeqAnyState n k p) ChimericAccount + where + isOurs _account state = (False, state) + +instance + ( SoftDerivation k + , MkKeyFingerprint k (Proxy n, k 'AddressK XPub) + , AddressIndexDerivationType k ~ 'Soft + , KnownNat p + ) => IsOwned (SeqAnyState n k p) k + where + isOwned _ _ _ = Nothing + +instance + ( SoftDerivation k + ) => GenChange (SeqAnyState n k p) + where + type ArgGenChange (SeqAnyState n k p) = ArgGenChange (SeqState n k) + genChange a (SeqAnyState s) = SeqAnyState <$> genChange a s + +instance + ( MkKeyFingerprint k (Proxy n, k 'AddressK XPub) + , MkKeyFingerprint k Address + , SoftDerivation k + ) => CompareDiscovery (SeqAnyState n k p) + where + compareDiscovery (SeqAnyState s) = compareDiscovery s + +instance + ( PaymentAddress n k + ) => KnownAddresses (SeqAnyState n k p) + where + knownAddresses (SeqAnyState s) = knownAddresses s diff --git a/lib/shelley/bench/Restore.hs b/lib/shelley/bench/Restore.hs index 6afec1f62a0..f99b67b35a6 100644 --- a/lib/shelley/bench/Restore.hs +++ b/lib/shelley/bench/Restore.hs @@ -82,6 +82,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Random ( mkRndAnyState, mkRndState ) import Cardano.Wallet.Primitive.AddressDiscovery.Sequential ( AddressPoolGap + , SeqAnyState (..) , SeqState (..) , mkAddressPoolGap , mkSeqAnyState @@ -151,6 +152,8 @@ import Fmt ( Buildable, build, fmt, genericF, pretty, (+|), (+||), (|+), (||+) ) import GHC.Generics ( Generic ) +import GHC.TypeLits + ( Nat ) import Say ( sayErr ) import System.FilePath @@ -202,7 +205,7 @@ cardanoRestoreBench tr c socketFile = do np vData "seq.timelog" - (walletSeq "Seq Empty Wallet" networkProxy mkSeqStateFromRootXPrv) + (walletSeq "Seq Empty Wallet" $ mkSeqState networkProxy) , bench_restoration @_ @ByronKey networkProxy @@ -229,7 +232,7 @@ cardanoRestoreBench tr c socketFile = do np vData "1-percent-seq.timelog" - (walletSeq "Seq 1% Wallet" networkProxy $ mkSeqAnyState @1) + (walletSeq "Seq 1% Wallet" $ mkSeqAnyState' @1 networkProxy) ] where walletRnd @@ -264,6 +267,22 @@ cardanoRestoreBench tr c socketFile = do in (wid, WalletName wname, s) + mkSeqState + :: forall (n :: NetworkDiscriminant). () + => Proxy n + -> (ShelleyKey 'RootK XPrv, Passphrase "encryption") + -> AddressPoolGap + -> SeqState n ShelleyKey + mkSeqState _ = mkSeqStateFromRootXPrv @n + + mkSeqAnyState' + :: forall (p :: Nat) (n :: NetworkDiscriminant). () + => Proxy n + -> (ShelleyKey 'RootK XPrv, Passphrase "encryption") + -> AddressPoolGap + -> SeqAnyState n ShelleyKey p + mkSeqAnyState' _ = mkSeqAnyState @p @n + networkDescription :: forall n. (NetworkDiscriminantVal n) => Proxy n -> Text networkDescription _ = networkDiscriminantVal @n From 741e74ad8e2fc924e1da0068b2813d6b7ff1fd5e Mon Sep 17 00:00:00 2001 From: KtorZ Date: Thu, 27 Aug 2020 15:25:25 +0200 Subject: [PATCH 4/7] make proportion more fine-grained to allow fractions of percent --- .../Primitive/AddressDiscovery/Random.hs | 14 ++--- .../Primitive/AddressDiscovery/Sequential.hs | 14 +++-- lib/shelley/bench/Restore.hs | 60 +++++++++++++------ 3 files changed, 57 insertions(+), 31 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs index ea38e41cb9c..ed577299522 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Random.hs @@ -292,9 +292,9 @@ instance KnownAddresses (RndState n) where -- it discover addresses based on an arbitrary ratio instead of decrypting the -- derivation path. -- --- The type parameter is expected to be a ratio (between 0 and 100) of addresses --- we ought to simply recognize as ours. So, giving @5 means that 5% of the --- entire address space of the network will be considered ours, picked randomly. +-- The proportion is stored as a type-level parameter so that we don't have to +-- alter the database schema to store it. It simply exists and depends on the +-- caller creating the wallet to define it. newtype RndAnyState (network :: NetworkDiscriminant) (p :: Nat) = RndAnyState { innerState :: RndState network } deriving (Generic, Show) @@ -304,9 +304,9 @@ instance NFData (RndAnyState n p) -- | Initialize the HD random address discovery state from a root key and RNG -- seed. -- --- The first argument is expected to be a ratio (between 0 and 1) of addresses --- we ought to simply recognize as ours. So, giving .5 means that 50% of the --- entire address space of the network will be considered ours, picked randomly. +-- The type parameter is expected to be a ratio of addresses we ought to simply +-- recognize as ours. It is expressed in tenths of percent, so "1" means 0.1%, +-- "10" means 1% and 1000 means 100%. mkRndAnyState :: forall (p :: Nat) n. () => ByronKey 'RootK XPrv @@ -341,7 +341,7 @@ instance KnownNat p => IsOurs (RndAnyState n p) Address where (False, _) -> (False, st) where - p = floor (double (maxBound :: Word32) * double (natVal (Proxy @p)) / 100) + p = floor (double (maxBound :: Word32) * double (natVal (Proxy @p)) / 1000) double :: Integral a => a -> Double double = fromIntegral diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs index 0756629e064..e2b7453c5b2 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs @@ -735,8 +735,8 @@ instance -- | An "unsound" alternative that can be used for benchmarking and stress -- testing. It re-uses the same underlying structure as the `SeqState` but --- it discover addresses based on an arbitrary ratio instead of decrypting the --- derivation path. +-- it discovers addresses based on an arbitrary ratio instead of respecting +-- BIP-44 discovery. -- -- The proportion is stored as a type-level parameter so that we don't have to -- alter the database schema to store it. It simply exists and depends on the @@ -761,9 +761,9 @@ instance -- | Initialize the HD random address discovery state from a root key and RNG -- seed. -- --- The first argument is expected to be a ratio (between 0 and 1) of addresses --- we ought to simply recognize as ours. So, giving .5 means that 50% of the --- entire address space of the network will be considered ours, picked randomly. +-- The type parameter is expected to be a ratio of addresses we ought to simply +-- recognize as ours. It is expressed in tenths of percent, so "1" means 0.1%, +-- "10" means 1% and 1000 means 100%. mkSeqAnyState :: forall (p :: Nat) n k. ( SoftDerivation k @@ -796,7 +796,9 @@ instance | otherwise = (False, st) where - p = floor (double (maxBound :: Word32) * double (natVal (Proxy @p)) / 100) + p = floor (double sup * double (natVal (Proxy @p)) / 1000) + where + sup = maxBound :: Word32 double :: Integral a => a -> Double double = fromIntegral diff --git a/lib/shelley/bench/Restore.hs b/lib/shelley/bench/Restore.hs index f99b67b35a6..fd77181172d 100644 --- a/lib/shelley/bench/Restore.hs +++ b/lib/shelley/bench/Restore.hs @@ -37,7 +37,7 @@ import Cardano.Address.Derivation import Cardano.BM.Trace ( Trace, nullTracer ) import Cardano.DB.Sqlite - ( destroyDBLayer, unsafeRunQuery ) + ( destroyDBLayer ) import Cardano.Mnemonic ( SomeMnemonic (..) ) import Cardano.Wallet @@ -74,10 +74,6 @@ import Cardano.Wallet.Primitive.AddressDerivation.Shelley ( ShelleyKey ) import Cardano.Wallet.Primitive.AddressDiscovery ( CompareDiscovery, IsOurs, IsOwned, KnownAddresses ) -import Cardano.Wallet.Primitive.AddressDiscovery.Any - ( initAnyState ) -import Cardano.Wallet.Primitive.AddressDiscovery.Any.TH - ( migrateAll ) import Cardano.Wallet.Primitive.AddressDiscovery.Random ( mkRndAnyState, mkRndState ) import Cardano.Wallet.Primitive.AddressDiscovery.Sequential @@ -146,8 +142,6 @@ import Data.Text ( Text ) import Data.Time.Clock.POSIX ( getCurrentTime, utcTimeToPOSIXSeconds ) -import Database.Persist.Sql - ( runMigrationSilent ) import Fmt ( Buildable, build, fmt, genericF, pretty, (+|), (+||), (|+), (||+) ) import GHC.Generics @@ -222,8 +216,35 @@ cardanoRestoreBench tr c socketFile = do socketFile np vData - "1-percent-rnd.timelog" - (walletRnd "Rnd 1% Wallet" $ mkRndAnyState @1) + "0.1-percent-rnd.timelog" + (walletRnd "Rnd 0.1% Wallet" $ mkRndAnyState @1) + + , bench_restoration @_ @ByronKey + networkProxy + tr + socketFile + np + vData + "0.2-percent-rnd.timelog" + (walletRnd "Rnd 0.2% Wallet" $ mkRndAnyState @2) + + , bench_restoration @_ @ByronKey + networkProxy + tr + socketFile + np + vData + "0.4-percent-rnd.timelog" + (walletRnd "Rnd 0.4% Wallet" $ mkRndAnyState @4) + + , bench_restoration @_ @ShelleyKey + networkProxy + tr + socketFile + np + vData + "0.1-percent-seq.timelog" + (walletSeq "Seq 0.1% Wallet" $ mkSeqAnyState' @1 networkProxy) , bench_restoration @_ @ShelleyKey networkProxy @@ -231,8 +252,17 @@ cardanoRestoreBench tr c socketFile = do socketFile np vData - "1-percent-seq.timelog" - (walletSeq "Seq 1% Wallet" $ mkSeqAnyState' @1 networkProxy) + "0.2-percent-seq.timelog" + (walletSeq "Seq 0.2% Wallet" $ mkSeqAnyState' @2 networkProxy) + + , bench_restoration @_ @ShelleyKey + networkProxy + tr + socketFile + np + vData + "0.4-percent-seq.timelog" + (walletSeq "Seq 0.4% Wallet" $ mkSeqAnyState' @4 networkProxy) ] where walletRnd @@ -414,9 +444,7 @@ withBenchDBLayer tr ti action = withSystemTempFile "bench.db" $ \dbFile _ -> do let before = newDBLayer (trMessageText tr) migrationDefaultValues (Just dbFile) ti let after = destroyDBLayer . fst - bracket before after $ \(ctx, db) -> do - migrateDB ctx - action db + bracket before after $ \(_ctx, db) -> action db where migrationDefaultValues = Sqlite.DefaultFieldValues { Sqlite.defaultActiveSlotCoefficient = 1 @@ -425,10 +453,6 @@ withBenchDBLayer tr ti action = , Sqlite.defaultHardforkEpoch = Nothing } - -- This tweaks the DB support the AnyAddressState. - migrateDB ctx = unsafeRunQuery ctx (void $ runMigrationSilent migrateAll) - - logChunk :: SlotNo -> IO () logChunk slot = sayErr . fmt $ "Processing "+||slot||+"" From f42602bebf436c3e0606e81bb97167b877cf7b71 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Thu, 27 Aug 2020 17:31:22 +0200 Subject: [PATCH 5/7] remove now obsolete 'Any' wallet scheme --- .weeder.yaml | 10 -- .../Wallet/Primitive/AddressDiscovery/Any.hs | 108 ------------------ .../Primitive/AddressDiscovery/Any/TH.hs | 42 ------- lib/shelley/cardano-wallet.cabal | 8 -- 4 files changed, 168 deletions(-) delete mode 100644 lib/shelley/bench/Cardano/Wallet/Primitive/AddressDiscovery/Any.hs delete mode 100644 lib/shelley/bench/Cardano/Wallet/Primitive/AddressDiscovery/Any/TH.hs diff --git a/.weeder.yaml b/.weeder.yaml index fcdc70d75ad..5180716a5bd 100644 --- a/.weeder.yaml +++ b/.weeder.yaml @@ -1,15 +1,5 @@ - package: - name: cardano-wallet - - section: - - name: bench:restore - - message: - - name: Weeds exported - - module: - - name: Cardano.Wallet.Primitive.AddressDiscovery.Any.TH - - identifier: - - AnyAddressStateId - - AnyAddressStateKey - - AnyAddressStateProportion - section: - name: test:integration bench:latency - message: diff --git a/lib/shelley/bench/Cardano/Wallet/Primitive/AddressDiscovery/Any.hs b/lib/shelley/bench/Cardano/Wallet/Primitive/AddressDiscovery/Any.hs deleted file mode 100644 index 05a537b0841..00000000000 --- a/lib/shelley/bench/Cardano/Wallet/Primitive/AddressDiscovery/Any.hs +++ /dev/null @@ -1,108 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeFamilies #-} - --- | --- Copyright: © 2018-2019 IOHK --- License: Apache-2.0 --- --- Custom address discovery schemes used for testing and benchmarking. --- - -module Cardano.Wallet.Primitive.AddressDiscovery.Any - ( AnyAddressState (..) - , initAnyState - ) where - -import Prelude - -import Cardano.Wallet.DB.Sqlite - ( PersistState (..) ) -import Cardano.Wallet.Primitive.AddressDiscovery - ( CompareDiscovery (..) - , GenChange (..) - , IsOurs (..) - , IsOwned (..) - , KnownAddresses (..) - ) -import Cardano.Wallet.Primitive.Types - ( Address (..), ChimericAccount (..), WalletId (..), WalletName (..) ) -import Control.DeepSeq - ( NFData ) -import Control.Monad.Trans.Maybe - ( MaybeT (..) ) -import Crypto.Hash - ( hash ) -import Data.Digest.CRC32 - ( crc32 ) -import Data.Text - ( Text ) -import Data.Word - ( Word32 ) -import Database.Persist.Sql - ( entityVal, insert_, selectFirst, (==.) ) -import GHC.Generics - ( Generic ) - -import qualified Cardano.Wallet.Primitive.AddressDiscovery.Any.TH as DB -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 Address where - isOurs (Address addr) s@(AnyAddressState p) = (crc32 addr < p', s) - where - p' = floor (fromIntegral (maxBound :: Word32) * p) - -instance IsOurs AnyAddressState ChimericAccount where - isOurs _ s = (False, s) - -instance IsOwned AnyAddressState key where - isOwned _ _ _ = Nothing - -instance GenChange AnyAddressState where - type ArgGenChange AnyAddressState = () - genChange _ = error - "GenChange.genChange: trying to generate change for \ - \an incompatible scheme 'AnyAddressState'. Please don't." - -instance CompareDiscovery AnyAddressState where - compareDiscovery _ _ _ = error - "CompareDiscovery.compareDiscovery: trying to generate change for \ - \an incompatible scheme 'AnyAddressState'. Please don't." - -instance KnownAddresses AnyAddressState where - knownAddresses _ = error - "KnownAddresses.knownAddresses: trying to generate change for \ - \an incompatible scheme 'AnyAddressState'. Please don't." - -instance PersistState AnyAddressState where - insertState (wid, sl) (AnyAddressState s) = - insert_ (DB.AnyAddressState wid sl s) - selectState (wid, sl) = runMaybeT $ do - DB.AnyAddressState _ _ s <- MaybeT $ fmap entityVal <$> selectFirst - [ DB.AnyAddressStateWalletId ==. wid - , DB.AnyAddressStateCheckpointSlot ==. sl - ] [] - return (AnyAddressState s) - -initAnyState :: Text -> Double -> (WalletId, WalletName, AnyAddressState) -initAnyState wname p = (walletId cfg, WalletName wname, cfg) - where cfg = AnyAddressState p - -walletId :: Show a => a -> WalletId -walletId = WalletId . hash . B8.pack . show diff --git a/lib/shelley/bench/Cardano/Wallet/Primitive/AddressDiscovery/Any/TH.hs b/lib/shelley/bench/Cardano/Wallet/Primitive/AddressDiscovery/Any/TH.hs deleted file mode 100644 index e1ff1a4292e..00000000000 --- a/lib/shelley/bench/Cardano/Wallet/Primitive/AddressDiscovery/Any/TH.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} - - --- | --- Copyright: © 2018-2019 IOHK --- License: Apache-2.0 --- --- Automatically generated code via Template-Haskell. Contains necessary --- database rows and columns declaration to work with 'AnyAddressState'. - -module Cardano.Wallet.Primitive.AddressDiscovery.Any.TH where - -import Prelude - -import Cardano.Wallet.DB.Sqlite.Types - ( sqlSettings' ) -import Database.Persist.Class - ( AtLeastOneUniqueKey (..), OnlyOneUniqueKey (..) ) -import Database.Persist.TH - ( mkDeleteCascade, mkMigrate, mkPersist, persistLowerCase, share ) - -import qualified Cardano.Wallet.Primitive.Types as W - -share - [ mkPersist sqlSettings' - , mkDeleteCascade sqlSettings' - , mkMigrate "migrateAll" - ] - [persistLowerCase| -AnyAddressState - anyAddressStateWalletId W.WalletId sql=wallet_id - anyAddressStateCheckpointSlot W.SlotNo sql=slot - anyAddressStateProportion Double sql=proportion -|] diff --git a/lib/shelley/cardano-wallet.cabal b/lib/shelley/cardano-wallet.cabal index be31e88fd2c..b856caae96b 100644 --- a/lib/shelley/cardano-wallet.cabal +++ b/lib/shelley/cardano-wallet.cabal @@ -236,15 +236,10 @@ benchmark restore , cardano-wallet-core-integration , cardano-wallet , contra-tracer - , containers - , cryptonite , deepseq - , digest , filepath , fmt , iohk-monitoring - , persistent - , persistent-template , say , temporary , text @@ -256,9 +251,6 @@ benchmark restore bench main-is: Restore.hs - other-modules: - Cardano.Wallet.Primitive.AddressDiscovery.Any - Cardano.Wallet.Primitive.AddressDiscovery.Any.TH benchmark latency default-language: From 309874f3831080eac965af5cec5754e7c1e754c3 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Wed, 2 Sep 2020 15:56:35 +0200 Subject: [PATCH 6/7] rename 'qualifier' into 'benchName' & label 'empty' wallets as 0% --- lib/shelley/bench/Restore.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/shelley/bench/Restore.hs b/lib/shelley/bench/Restore.hs index fd77181172d..ca7ed65c206 100644 --- a/lib/shelley/bench/Restore.hs +++ b/lib/shelley/bench/Restore.hs @@ -199,7 +199,7 @@ cardanoRestoreBench tr c socketFile = do np vData "seq.timelog" - (walletSeq "Seq Empty Wallet" $ mkSeqState networkProxy) + (walletSeq "Seq 0% Wallet" $ mkSeqState networkProxy) , bench_restoration @_ @ByronKey networkProxy @@ -208,7 +208,7 @@ cardanoRestoreBench tr c socketFile = do np vData "rnd.timelog" - (walletRnd "Rnd Empty Wallet" mkRndState) + (walletRnd "Rnd 0% Wallet" mkRndState) , bench_restoration @_ @ByronKey networkProxy @@ -321,7 +321,7 @@ cardanoRestoreBench tr c socketFile = do -------------------------------------------------------------------------------} data BenchResults = BenchResults - { qualifier :: Text + { benchName :: Text , restorationTime :: Time , listingAddressesTime :: Time , estimatingFeesTime :: Time @@ -402,7 +402,7 @@ bench_restoration proxy tracer socketPath np vData progressLogFile (wid, wname, unsafeRunExceptT $ W.deleteWallet w wid pure BenchResults - { qualifier = getWalletName wname + { benchName = getWalletName wname , restorationTime , listingAddressesTime , estimatingFeesTime From 9d9734bc6f788bdf011483e257184544084f225a Mon Sep 17 00:00:00 2001 From: IOHK Date: Wed, 2 Sep 2020 14:04:27 +0000 Subject: [PATCH 7/7] Regenerate nix --- nix/.stack.nix/cardano-wallet.nix | 5 ----- 1 file changed, 5 deletions(-) diff --git a/nix/.stack.nix/cardano-wallet.nix b/nix/.stack.nix/cardano-wallet.nix index ed19d922aa4..bbf9aaeb614 100644 --- a/nix/.stack.nix/cardano-wallet.nix +++ b/nix/.stack.nix/cardano-wallet.nix @@ -175,15 +175,10 @@ (hsPkgs."cardano-wallet-core-integration" or (errorHandler.buildDepError "cardano-wallet-core-integration")) (hsPkgs."cardano-wallet" or (errorHandler.buildDepError "cardano-wallet")) (hsPkgs."contra-tracer" or (errorHandler.buildDepError "contra-tracer")) - (hsPkgs."containers" or (errorHandler.buildDepError "containers")) - (hsPkgs."cryptonite" or (errorHandler.buildDepError "cryptonite")) (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq")) - (hsPkgs."digest" or (errorHandler.buildDepError "digest")) (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) (hsPkgs."fmt" or (errorHandler.buildDepError "fmt")) (hsPkgs."iohk-monitoring" or (errorHandler.buildDepError "iohk-monitoring")) - (hsPkgs."persistent" or (errorHandler.buildDepError "persistent")) - (hsPkgs."persistent-template" or (errorHandler.buildDepError "persistent-template")) (hsPkgs."say" or (errorHandler.buildDepError "say")) (hsPkgs."temporary" or (errorHandler.buildDepError "temporary")) (hsPkgs."text" or (errorHandler.buildDepError "text"))