Skip to content

Commit fbb69be

Browse files
kdermekderme
committed
Add db-sync benchmarks
1 parent a8c563e commit fbb69be

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

61 files changed

+1243
-45
lines changed

‎.gitignore‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -9,4 +9,5 @@ cabal.project.local
99
gen/
1010
/.vscode
1111

12-
cardano-chain-gen/test/testfiles/temp/
12+
cardano-chain-gen/test/testfiles/temp/
13+
cardano-chain-gen/bench/benchfiles/temp/

‎cabal.project‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -258,3 +258,11 @@ source-repository-package
258258
tag: 297cd9db5074339a2fb2e5ae7d0780debb670c63
259259
--sha256: 1zcwry3y5rmd9lgxy89wsb3k4kpffqji35dc7ghzbz603y1gy24g
260260

261+
source-repository-package
262+
type: git
263+
location: https://github.com/input-output-hk/criterion
264+
--sha256: 189brk8lpmjgsy32yin6ps0v34wvs971bkw92d5w8r4jsi7wwndc
265+
tag: 4a99389084cba4eabd3149f37adee2a394d065a9
266+
subdir:
267+
.
268+
criterion-measurement

‎cardano-chain-gen/bench/Cardano/Db/Bench.hs‎

Lines changed: 307 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,307 @@
1+
module Cardano.Db.Bench where
2+
3+
import Control.DeepSeq
4+
import Control.Monad
5+
import Control.Monad.Class.MonadSTM.Strict
6+
import qualified Data.Text.Encoding as Text
7+
import Data.List.Split
8+
import qualified Data.Map as Map
9+
import Data.Text (Text)
10+
11+
import Ouroboros.Network.Block (Point (..))
12+
13+
import Cardano.Slotting.Slot
14+
15+
import Cardano.Ledger.Address
16+
import Cardano.Ledger.BaseTypes
17+
import Cardano.Ledger.Credential
18+
import Cardano.Ledger.Mary.Value
19+
import Cardano.Ledger.Shelley.TxBody
20+
21+
import Cardano.Mock.ChainSync.Server
22+
import Cardano.Mock.Db.Config hiding (withFullConfig)
23+
import qualified Cardano.Mock.Db.Config as Config
24+
import Cardano.Mock.Db.Validate
25+
import Cardano.Mock.Forging.Interpreter
26+
import qualified Cardano.Mock.Forging.Tx.Alonzo as Alonzo
27+
import Cardano.Mock.Forging.Tx.Generic
28+
import Cardano.Mock.Forging.Types
29+
30+
import Criterion
31+
32+
benchmark :: IOManager -> [(Text, Text)] -> Benchmark
33+
benchmark iom knownMigrations =
34+
bgroup "bench"
35+
[ bgroup "empty blocks"
36+
[ bnch 3 "10 blocks" $ emptyBlocks 10
37+
, bnch 3 "50 blocks" $ emptyBlocks 50
38+
, bnch 3 "100 blocks" $ emptyBlocks 100
39+
, longBnch "500 blocks" $ emptyBlocks 500
40+
, longBnch "5000 blocks" $ emptyBlocks 5000
41+
, longBnch "10000 blocks" $ emptyBlocks 10000
42+
]
43+
, bgroup "register addresses 1000 per block"
44+
[ bnch 3 "1 block" $ registerAddressess 1
45+
, bnch 3 "10 blocks" $ registerAddressess 10
46+
, bnch 3 "100 blocks" $ registerAddressess 100
47+
, bnch 3 "200 blocks" $ registerAddressess 200
48+
]
49+
, bgroup "create UTxO. 200 per block"
50+
[ bnch 3 "1 block" $ createUTXO 1
51+
, bnch 3 "10 blocks" $ createUTXO 10
52+
, longBnch "100 blocks" $ createUTXO 100
53+
, longBnch "100 blocks" $ createUTXO 1000
54+
]
55+
, bgroup "create UTxO. 1000 per block"
56+
[ bnch 3 "1 block" $ createUTXO' 1
57+
, bnch 3 "10 blocks" $ createUTXO' 10
58+
, longBnch "100 blocks" $ createUTXO' 100
59+
, longBnch "1000 blocks" $ createUTXO' 1000
60+
]
61+
, bgroup "create multiasssets."
62+
[ bnch 3 "1 block" $ createMaTxOut 1
63+
, bnch 3 "10 blocks" $ createMaTxOut 10
64+
, longBnch "100 blocks" $ createMaTxOut 100
65+
, longBnch "500 blocks" $ createMaTxOut 500
66+
]
67+
, bgroup "delegate and send funds"
68+
[ bnch 3 "3 block" $ delegateAndSend 1
69+
, bnch 3 "30 blocks" $ delegateAndSend 10
70+
, longBnch "300 blocks" $ delegateAndSend 100
71+
, longBnch "1200 blocks" $ delegateAndSend 400
72+
]
73+
, bgroup "rollback multiassets"
74+
[ bnch 3 "1 block" $ rollbackMaTxOut 1
75+
, bnch 3 "10 blocks" $ rollbackMaTxOut 10
76+
, longBnch "100 blocks" $ rollbackMaTxOut 100
77+
, longBnch "500 blocks" $ rollbackMaTxOut 500
78+
]
79+
bgroup "rollback delegate and send funds"
80+
[ bnch 3 "3 blocks" $ rollbackDelegateAndSend 1
81+
, bnch 3 "30 blocks" $ rollbackDelegateAndSend 10
82+
, longBnch "300 blocks" $ rollbackDelegateAndSend 100
83+
, longBnch "1200 blocks" $ rollbackDelegateAndSend 400
84+
]
85+
]
86+
where
87+
_bnch' :: String -> (IOManager -> [(Text, Text)] -> Benchmarkable) -> Benchmark
88+
_bnch' str action = bench str (action iom knownMigrations)
89+
90+
bnch :: Int -> String -> (IOManager -> [(Text, Text)] -> Benchmarkable) -> Benchmark
91+
bnch n str action = bench str (fixIterations n $ action iom knownMigrations)
92+
93+
longBnch :: String -> (IOManager -> [(Text, Text)] -> Benchmarkable) -> Benchmark
94+
longBnch str = bnch 1 str
95+
96+
data BenchEnv = BenchEnv Interpreter (ServerHandle IO CardanoBlock) DBSyncEnv [CardanoBlock]
97+
98+
instance NFData BenchEnv where
99+
-- We don't really use many feautures of criterion. 'NFData' is not one of them.
100+
rnf _ = ()
101+
102+
defaultConfigDir :: FilePath
103+
defaultConfigDir = "config"
104+
105+
rootTestDir :: FilePath
106+
rootTestDir = "bench/benchfiles"
107+
108+
withFullConfig :: FilePath -> FilePath
109+
-> (Interpreter -> ServerHandle IO CardanoBlock -> DBSyncEnv -> IO ())
110+
-> IOManager -> [(Text, Text)] -> IO ()
111+
withFullConfig = Config.withFullConfig rootTestDir
112+
113+
benchmarkSyncing :: FilePath -> FilePath -> FilePath
114+
-> (Interpreter -> IO [CardanoBlock])
115+
-> IOManager -> [(Text, Text)]
116+
-> Benchmarkable
117+
benchmarkSyncing rootDir config testLabel mkBlocks iom mig =
118+
perRunEnvWithCleanup createEnv cleanupEnv runBench
119+
where
120+
createEnv :: IO BenchEnv
121+
createEnv = do
122+
(interpreter, mockServer, dbSync) <- mkFullConfig rootDir config testLabel iom mig
123+
-- first block server and then start db-sync during env creation, so that
124+
-- schema migrations doesn't affect benchmarking results.\
125+
atomically $ blockServing mockServer
126+
startDBSync dbSync
127+
blks <- mkBlocks interpreter
128+
forM_ blks $ atomically . addBlock mockServer
129+
-- This is here to wait for all migration to run before running the benchmark
130+
assertBlocksCount dbSync 2
131+
pure $ BenchEnv interpreter mockServer dbSync blks
132+
133+
cleanupEnv (BenchEnv interpreter mockServer dbSync _blks) = do
134+
cleanFullConfig (interpreter, mockServer, dbSync)
135+
136+
runBench (BenchEnv _interpreter mockServer dbSync blks) = do
137+
-- unblock the server and wait for the blocks in db.
138+
atomically $ unBlockServing mockServer
139+
assertBlockNo dbSync (Just $ length blks - 1) [1,1..]
140+
141+
142+
benchmarkRollback :: FilePath -> FilePath -> FilePath
143+
-> (Interpreter -> IO [CardanoBlock])
144+
-> IOManager -> [(Text, Text)]
145+
-> Benchmarkable
146+
benchmarkRollback rootDir config testLabel mkBlocks iom mig =
147+
perRunEnvWithCleanup createEnv cleanupEnv runBench
148+
where
149+
createEnv :: IO BenchEnv
150+
createEnv = do
151+
(interpreter, mockServer, dbSync) <- mkFullConfig rootDir config testLabel iom mig
152+
startDBSync dbSync
153+
blks <- mkBlocks interpreter
154+
forM_ blks $ atomically . addBlock mockServer
155+
-- Sync all blocks in db-sync
156+
assertBlockNo dbSync (Just $ length blks - 1) [1,1..]
157+
pure $ BenchEnv interpreter mockServer dbSync blks
158+
159+
cleanupEnv (BenchEnv interpreter mockServer dbSync _blks) = do
160+
cleanFullConfig (interpreter, mockServer, dbSync)
161+
162+
runBench (BenchEnv _interpreter mockServer dbSync _blks) = do
163+
-- unblock the server and wait for the blocks in db.
164+
atomically $ rollback mockServer (Point Origin)
165+
assertBlockNo dbSync Nothing [1,1..]
166+
167+
168+
emptyBlocks :: Int -> IOManager -> [(Text, Text)] -> Benchmarkable
169+
emptyBlocks n =
170+
benchmarkSyncing rootTestDir defaultConfigDir testLabel $ \interpreter ->
171+
replicateM n $ forgeNextFindLeader interpreter []
172+
where
173+
testLabel = "emptyBlock_" <> show n
174+
175+
registerAddressess :: Int -> IOManager -> [(Text, Text)] -> Benchmarkable
176+
registerAddressess n =
177+
benchmarkSyncing rootTestDir defaultConfigDir testLabel $
178+
registerAddressesBlocks n
179+
where
180+
testLabel = "registerAddressess_" <> show n
181+
182+
registerAddressesBlocks :: Int -> Interpreter -> IO [CardanoBlock]
183+
registerAddressesBlocks n interpreter = do
184+
forM (chunksOf 1000 creds) $ \blockCreds -> do
185+
blockTxs <- withAlonzoLedgerState interpreter $ \_st ->
186+
forM (chunksOf 10 blockCreds) $ \txCreds -> -- 10 per tx
187+
Alonzo.mkDCertTx (fmap (DCertDeleg . RegKey) txCreds) (Wdrl mempty)
188+
forgeNextFindLeader interpreter (TxAlonzo <$> blockTxs)
189+
where
190+
creds = createStakeCredentials (1000 * n)
191+
192+
createUTXO :: Int -> IOManager -> [(Text, Text)] -> Benchmarkable
193+
createUTXO n =
194+
benchmarkSyncing rootTestDir defaultConfigDir testLabel $
195+
createUTXOBlocks n
196+
where
197+
testLabel = "createUTXO_" <> show n
198+
199+
-- 200 txs per block. 1 outputs per tx
200+
createUTXOBlocks :: Int -> Interpreter -> IO [CardanoBlock]
201+
createUTXOBlocks n interpreter = do
202+
addr <- withAlonzoLedgerState interpreter $ resolveAddress (UTxOIndex 0)
203+
-- we use the change output to create the next transaction.
204+
let utxoIndex = UTxOAddress addr
205+
forM (chunksOf 200 addresses) $ \blockAddresses -> do
206+
blockTxs <- withAlonzoLedgerState interpreter $ \st ->
207+
forM blockAddresses $ \sendAddr ->
208+
Alonzo.mkPaymentTx utxoIndex (UTxOAddress sendAddr) 1 0 st
209+
forgeNextFindLeader interpreter (TxAlonzo <$> blockTxs)
210+
where
211+
addresses = fmap (\addr -> Addr Testnet addr StakeRefNull) (createPaymentCredentials (200 * n))
212+
213+
createUTXO' :: Int -> IOManager -> [(Text, Text)] -> Benchmarkable
214+
createUTXO' n =
215+
benchmarkSyncing rootTestDir defaultConfigDir testLabel $
216+
createUTXOBlocks' n
217+
where
218+
testLabel = "createUTXO'_" <> show n
219+
220+
-- 100 txs per block. 10 outputs per tx
221+
createUTXOBlocks' :: Int -> Interpreter -> IO [CardanoBlock]
222+
createUTXOBlocks' n interpreter = do
223+
addrFrom <- withAlonzoLedgerState interpreter $ resolveAddress (UTxOIndex 0)
224+
-- we use the change output to create the next transaction.
225+
let utxoIndex = UTxOAddress addrFrom
226+
forM (chunksOf 1000 addresses) $ \blockAddresses -> do
227+
blockTxs <- withAlonzoLedgerState interpreter $ \st ->
228+
forM (chunksOf 10 blockAddresses) $ \txAddresses ->
229+
Alonzo.mkPaymentTx' utxoIndex (fmap (\addr -> (UTxOAddress addr, Value 1 mempty)) txAddresses) st
230+
forgeNextFindLeader interpreter (TxAlonzo <$> blockTxs)
231+
where
232+
addresses = fmap (\addr -> Addr Testnet addr StakeRefNull) (createPaymentCredentials (1000 * n))
233+
234+
createMaTxOut :: Int -> IOManager -> [(Text, Text)] -> Benchmarkable
235+
createMaTxOut n =
236+
benchmarkSyncing rootTestDir defaultConfigDir testLabel $
237+
createMaTxOutBlocks n
238+
where
239+
testLabel = "createMaTxOut_" <> show n
240+
241+
rollbackMaTxOut :: Int -> IOManager -> [(Text, Text)] -> Benchmarkable
242+
rollbackMaTxOut n =
243+
benchmarkRollback rootTestDir defaultConfigDir testLabel $
244+
createMaTxOutBlocks n
245+
where
246+
testLabel = "rollbackMaTxOut_" <> show n
247+
248+
createMaTxOutBlocks :: Int -> Interpreter -> IO [CardanoBlock]
249+
createMaTxOutBlocks n interpreter = do
250+
addrFrom <- withAlonzoLedgerState interpreter $ resolveAddress (UTxOIndex 0)
251+
-- we use the change output to create the next transaction.
252+
let utxoIndex = UTxOAddress addrFrom
253+
forM (zip [1..n] $ chunksOf 1000 addresses) $ \(_blockId, blockAddresses) -> do
254+
blockTxs <- withAlonzoLedgerState interpreter $ \st ->
255+
forM (zip [1..100] $ chunksOf 10 blockAddresses) $ \(txId, txAddresses) ->
256+
let maMap = Map.fromList $ flip fmap [0..9] $ \maIndex ->
257+
let assets = Map.fromList $ flip fmap [0..9] $ \assetIx ->
258+
(AssetName $ Text.encodeUtf8 $ textShow (100 * assetIx + maIndex), 1)
259+
in (PolicyID (mkDummyScriptHash $ 10 * maIndex + txId `mod` 10), assets)
260+
in Alonzo.mkPaymentTx' utxoIndex (fmap (\addr -> (UTxOAddress addr, Value 1 maMap)) txAddresses) st
261+
forgeNextFindLeader interpreter (TxAlonzo <$> blockTxs)
262+
where
263+
addresses = fmap (\addr -> Addr Testnet addr StakeRefNull) (createPaymentCredentials (1000 * n))
264+
265+
delegateAndSend :: Int -> IOManager -> [(Text, Text)] -> Benchmarkable
266+
delegateAndSend n =
267+
benchmarkSyncing rootTestDir defaultConfigDir testLabel $
268+
delegateAndSendBlocks n
269+
where
270+
testLabel = "delegateAndSend_" <> show n
271+
272+
rollbackDelegateAndSend :: Int -> IOManager -> [(Text, Text)] -> Benchmarkable
273+
rollbackDelegateAndSend n =
274+
benchmarkRollback rootTestDir defaultConfigDir testLabel $
275+
delegateAndSendBlocks n
276+
where
277+
testLabel = "rollbackDelegateAndSend_" <> show n
278+
279+
delegateAndSendBlocks :: Int -> Interpreter -> IO [CardanoBlock]
280+
delegateAndSendBlocks n interpreter = do
281+
addrFrom <- withAlonzoLedgerState interpreter $ resolveAddress (UTxOIndex 0)
282+
registerBlocks <- forM (chunksOf 1000 creds) $ \blockCreds -> do
283+
blockTxs <- withAlonzoLedgerState interpreter $ \_st ->
284+
forM (chunksOf 10 blockCreds) $ \txCreds -> -- 10 per tx
285+
Alonzo.mkDCertTx (fmap (DCertDeleg . RegKey) txCreds) (Wdrl mempty)
286+
forgeNextFindLeader interpreter (TxAlonzo <$> blockTxs)
287+
288+
delegateBlocks <- forM (chunksOf 1000 creds) $ \blockCreds -> do
289+
blockTxs <- withAlonzoLedgerState interpreter $ \st ->
290+
forM (chunksOf 10 blockCreds) $ \txCreds -> --do -- 10 per tx
291+
Alonzo.mkDCertTx
292+
(fmap (\ (poolIx, cred) -> DCertDeleg $ Delegate $ Delegation cred (resolvePool (PoolIndex poolIx) st))
293+
(zip (cycle [0,1,2]) txCreds))
294+
(Wdrl mempty)
295+
forgeNextFindLeader interpreter (TxAlonzo <$> blockTxs)
296+
297+
let utxoIndex = UTxOAddress addrFrom
298+
sendBlocks <- forM (chunksOf 1000 addresses) $ \blockAddresses -> do
299+
blockTxs <- withAlonzoLedgerState interpreter $ \st ->
300+
forM (chunksOf 10 blockAddresses) $ \txAddresses ->
301+
Alonzo.mkPaymentTx' utxoIndex (fmap (\addr -> (UTxOAddress addr, Value 1 mempty)) txAddresses) st
302+
forgeNextFindLeader interpreter (TxAlonzo <$> blockTxs)
303+
pure $ registerBlocks <> delegateBlocks <> sendBlocks
304+
where
305+
creds = createStakeCredentials (1000 * n)
306+
pcreds = createPaymentCredentials (1000 * n)
307+
addresses = fmap (\(pcred, cred) -> Addr Testnet pcred (StakeRefBase cred)) (zip pcreds creds)

‎cardano-chain-gen/bench/Main.hs‎

Lines changed: 48 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,48 @@
1+
import Cardano.Prelude (Text)
2+
3+
import Prelude
4+
5+
import Control.Monad (when, (>=>))
6+
import Data.Maybe (isNothing)
7+
8+
import System.Directory (getCurrentDirectory)
9+
import System.Environment (lookupEnv, setEnv)
10+
import System.FilePath ((</>))
11+
12+
import MigrationValidations (KnownMigration (..), knownMigrations)
13+
14+
import Cardano.Mock.ChainSync.Server
15+
16+
import Criterion.Main
17+
18+
import qualified Cardano.Db.Bench as Bench
19+
20+
main :: IO ()
21+
main = do
22+
-- If the env is not set, set it to default.
23+
mPgPassFile <- lookupEnv "PGPASSFILE"
24+
when (isNothing mPgPassFile) $ do
25+
currentDir <- getCurrentDirectory
26+
setEnv "PGPASSFILE" (currentDir </> "bench/benchfiles/pgpass-bench")
27+
withIOManager $
28+
benchmarks >=> defaultMain
29+
where
30+
-- config = defaultConfig
31+
-- { resamples = 1
32+
-- , reportFile = Just "report.html"
33+
-- , csvFile = Just "report.csv"
34+
-- , jsonFile = Just "reprt.json"
35+
-- , junitFile = Just "report.junit"
36+
-- }
37+
38+
benchmarks :: IOManager -> IO [Benchmark]
39+
benchmarks iom = do
40+
pure $
41+
[ bgroup
42+
"cardano-chain"
43+
[ Bench.benchmark iom knownMigrationsPlain
44+
]
45+
]
46+
where
47+
knownMigrationsPlain :: [(Text, Text)]
48+
knownMigrationsPlain = (\x -> (hash x, filepath x)) <$> knownMigrations

0 commit comments

Comments
 (0)