Skip to content

Commit

Permalink
Sqlite: Add benchmarks for SeqState
Browse files Browse the repository at this point in the history
  • Loading branch information
@rvl
rvl committed Jun 2, 2019
1 parent ce27380 commit 86ed114
Show file tree
Hide file tree
Showing 3 changed files with 77 additions and 23 deletions.
95 changes: 75 additions & 20 deletions lib/core/bench/db/Main.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,9 +44,24 @@ import Cardano.Wallet.DB
import Cardano.Wallet.DB.Sqlite
( newDBLayer )
import Cardano.Wallet.Primitive.AddressDerivation
( KeyToAddress (..), Passphrase (..), generateKeyFromSeed, getKey )
( Depth (..)
, Key
, KeyToAddress (..)
, Passphrase (..)
, XPub
, generateKeyFromSeed
, getKey
, publicKey
, unsafeGenerateKeyFromSeed
)
import Cardano.Wallet.Primitive.AddressDiscovery
( SeqState (..), defaultAddressPoolGap, mkSeqState )
( AddressPool
, SeqState (..)
, defaultAddressPoolGap
, emptyPendingIxs
, mkAddressPool
, mkSeqState
)
import Cardano.Wallet.Primitive.Mnemonic
( EntropySize, entropyToBytes, genEntropy )
import Cardano.Wallet.Primitive.Model
Expand Down Expand Up @@ -82,14 +97,19 @@ import Data.ByteString
import qualified Data.ByteString.Char8 as B8
import Data.List.Split
( chunksOf )
import qualified Data.Map as Map
import Data.Quantity
( Quantity (..) )
import Data.Time.Clock.System
( SystemTime (..), systemToUTCTime )
import Data.Typeable
( Typeable )
import System.IO.Unsafe
( unsafePerformIO )

import qualified Data.ByteArray as BA
import qualified Data.ByteString as BS
import qualified Data.Map.Strict as Map

main :: IO ()
main = defaultMain
[ withDB $ \db -> bgroup "putTxHistory"
Expand Down Expand Up @@ -123,20 +143,27 @@ main = defaultMain
, withDB $ \db -> bgroup "putCheckpoint"
-- The very max number of checkpoints we are likely to insert per wallet
-- is k=2160.
-- A fragmented wallet will have a large number of UTxO. The coin
-- selection algorithm tries to prevent fragmentation
[ bench "1e2 x 0utxo" $ withCleanDB db $ benchPutCheckpoint 100 0
, bench "1e3 x 0utxo" $ withCleanDB db $ benchPutCheckpoint 1000 0
-- , bench "1e4" $ withCleanDB db $ benchPutCheckpoint 10000 0
, bench "1e1 x 10utxo" $ withCleanDB db $ benchPutCheckpoint 10 10
, bench "1e2 x 10utxo" $ withCleanDB db $ benchPutCheckpoint 100 10
, bench "1e3 x 10utxo" $ withCleanDB db $ benchPutCheckpoint 1000 10
, bench "1e1 x 100utxo" $ withCleanDB db $ benchPutCheckpoint 10 100
, bench "1e2 x 100utxo" $ withCleanDB db $ benchPutCheckpoint 100 100
, bench "1e3 x 100utxo" $ withCleanDB db $ benchPutCheckpoint 1000 100
, bench "1e1 x 1000utxo" $ withCleanDB db $ benchPutCheckpoint 10 1000
, bench "1e2 x 1000utxo" $ withCleanDB db $ benchPutCheckpoint 100 1000
, bench "1e3 x 1000utxo" $ withCleanDB db $ benchPutCheckpoint 1000 1000
[ bgroup "UTxO"
-- A fragmented wallet will have a large number of UTxO. The coin
-- selection algorithm tries to prevent fragmentation
[ bench "1e2 x 0utxo" $ withCleanDB db $ benchPutCheckpoint 100 0
, bench "1e3 x 0utxo" $ withCleanDB db $ benchPutCheckpoint 1000 0
-- , bench "1e4" $ withCleanDB db $ benchPutCheckpoint 10000 0
, bench "1e1 x 10utxo" $ withCleanDB db $ benchPutCheckpoint 10 10
, bench "1e2 x 10utxo" $ withCleanDB db $ benchPutCheckpoint 100 10
, bench "1e3 x 10utxo" $ withCleanDB db $ benchPutCheckpoint 1000 10
, bench "1e1 x 100utxo" $ withCleanDB db $ benchPutCheckpoint 10 100
, bench "1e2 x 100utxo" $ withCleanDB db $ benchPutCheckpoint 100 100
, bench "1e3 x 100utxo" $ withCleanDB db $ benchPutCheckpoint 1000 100
, bench "1e1 x 1000utxo" $ withCleanDB db $ benchPutCheckpoint 10 1000
, bench "1e2 x 1000utxo" $ withCleanDB db $ benchPutCheckpoint 100 1000
, bench "1e3 x 1000utxo" $ withCleanDB db $ benchPutCheckpoint 1000 1000
]
, bgroup "SeqState"
[ bench "1e2 x 10addr" $ withCleanDB db $ benchPutSeqState 100 10
, bench "1e2 x 100addr" $ withCleanDB db $ benchPutSeqState 100 100
, bench "1e2 x 1000addr" $ withCleanDB db $ benchPutSeqState 100 1000
]
]
]

Expand All @@ -146,7 +173,11 @@ main = defaultMain
withDB :: (DBLayerBench -> Benchmark) -> Benchmark
withDB = envWithCleanup (newDBLayer Nothing) (const (pure ()))

withCleanDB :: NFData b => DBLayerBench -> (DBLayerBench -> IO b) -> Benchmarkable
withCleanDB
:: NFData b
=> DBLayerBench
-> (DBLayerBench -> IO b)
-> Benchmarkable
withCleanDB db = perRunEnv $ do
void $ cleanDB db
unsafeRunExceptT $ createWallet db testPk testCp testMetadata
Expand Down Expand Up @@ -185,11 +216,31 @@ benchPutCheckpoint numCheckpoints utxoSize db = do
unsafeRunExceptT $ mapM_ (putCheckpoint db testPk) cps

mkCheckpoints :: Int -> Int -> [WalletBench]
mkCheckpoints numCheckpoints utxoSize = [ cp i | i <- [1..numCheckpoints]]
mkCheckpoints numCheckpoints utxoSize = [ cp i | i <- [1..numCheckpoints]]
where
cp i = unsafeInitWallet (UTxO utxo) mempty (fromFlatSlot $ fromIntegral i) initDummyState
cp i = unsafeInitWallet (UTxO utxo) mempty
(fromFlatSlot $ fromIntegral i)
initDummyState
utxo = Map.fromList $ zip (mkInputs utxoSize) (mkOutputs utxoSize)

----------------------------------------------------------------------------
-- SeqState Address Discovery

benchPutSeqState :: Int -> Int -> DBLayerBench -> IO ()
benchPutSeqState numCheckpoints numAddrs db =
unsafeRunExceptT $ mapM_ (putCheckpoint db testPk)
[ initWallet $ SeqState (mkPool numAddrs i) (mkPool numAddrs i)
emptyPendingIxs | i <- [1..numCheckpoints] ]

mkPool
:: forall t chain. (KeyToAddress t, Typeable chain)
=> Int -> Int -> AddressPool t chain
mkPool numAddrs i = mkAddressPool ourAccount defaultAddressPoolGap addrs
where
addrs =
[ Address (label "addr-" (show i ++ "-" ++ show j))
| j <- [1..numAddrs] ]

----------------------------------------------------------------------------
-- Mock data to use for benchmarks

Expand Down Expand Up @@ -233,6 +284,10 @@ testWid = WalletId (hash ("test" :: ByteString))
testPk :: PrimaryKey WalletId
testPk = PrimaryKey testWid

ourAccount :: Key 'AccountK XPub
ourAccount = publicKey $ unsafeGenerateKeyFromSeed (seed, mempty) mempty
where seed = Passphrase $ BA.convert $ BS.replicate 32 0

-- | Make a prefixed bytestring for use as a Hash or Address.
label :: Show n => B8.ByteString -> n -> B8.ByteString
label prefix n = prefix <> B8.pack (show n)
1 change: 1 addition & 0 deletions lib/core/cardano-wallet-core.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -185,6 +185,7 @@ benchmark db
, containers
, cryptonite
, deepseq
, memory
, time
type:
exitcode-stdio-1.0
Expand Down
4 changes: 1 addition & 3 deletions lib/core/src/Cardano/Wallet/DB.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,12 +27,10 @@ import Cardano.Wallet.Primitive.Model
( Wallet )
import Cardano.Wallet.Primitive.Types
( Hash, Tx, TxMeta, WalletId, WalletMetadata )
import Control.Monad.Trans.Except
( ExceptT )
import Data.Map.Strict
( Map )
import Control.Monad.Trans.Except
( runExceptT )
( ExceptT, runExceptT )


-- | A Database interface for storing various things in a DB. In practice,
Expand Down

0 comments on commit 86ed114

Please sign in to comment.