Skip to content

Commit

Permalink
Process PactQueue concurrently.
Browse files Browse the repository at this point in the history
Signed-off-by: Evgenii Akentev <[email protected]>
Change-Id: Ia007a565d75c625ddb243534a546d57584ec8e7d
  • Loading branch information
Evgenii Akentev committed Mar 20, 2024
1 parent f6918ab commit 89ef494
Show file tree
Hide file tree
Showing 8 changed files with 255 additions and 159 deletions.
46 changes: 35 additions & 11 deletions bench/Chainweb/Pact/Backend/ForkingBench.hs
Original file line number Diff line number Diff line change
Expand Up @@ -54,6 +54,7 @@ import GHC.Generics hiding (from, to)
import System.Environment
import System.LogLevel
import System.Random
import System.Directory

import Text.Printf

Expand Down Expand Up @@ -87,7 +88,7 @@ import Chainweb.Pact.Backend.Compaction qualified as C
import Chainweb.Pact.Backend.Types
import Chainweb.Pact.Backend.Utils
import Chainweb.Pact.PactService
import Chainweb.Pact.Service.BlockValidation
import Chainweb.Pact.Service.BlockValidation as BlockValidation
import Chainweb.Pact.Service.PactQueue
import Chainweb.Pact.Service.Types
import Chainweb.Pact.Types
Expand Down Expand Up @@ -142,6 +143,7 @@ bench :: RocksDb -> C.Benchmark
bench rdb = C.bgroup "PactService" $
[ forkingBench
, doubleForkingBench
, queueBench
] ++ map (oneBlock defBenchConfig) [1, 10, 50, 100]
++ map (oneBlock validateCfg) [0, 1, 10, 50, 100]
++ map (oneBlock compactCfg) [0, 1, 10, 50, 100]
Expand All @@ -157,6 +159,21 @@ bench rdb = C.bgroup "PactService" $
let (T3 _ join1 _) = mainLineBlocks !! 5
void $ playLine pdb bhdb 5 join1 pactQueue nonceCounter

queueBench = withResources rdb 10 Quiet DontCompact
$ \mainLineBlocks pdb bhdb nonceCounter pactQueue _ ->
C.bench "queueBench" $ C.whnfIO $ do
let (T3 _ join1 _) = mainLineBlocks !! 5

race_ (void $ playLine pdb bhdb 100 join1 pactQueue nonceCounter) $ do
meta <- makeMeta cid
(_, _, cmds) <- unzip3 <$> createCoinAccounts testVer meta (take 30000 names)
let
txs = case traverse validateCommand cmds of
Left _ -> []
Right !txs' -> txs'

forM_ txs (\tx -> BlockValidation.local Nothing Nothing Nothing tx pactQueue)

doubleForkingBench = withResources rdb 10 Quiet DontCompact
$ \mainLineBlocks pdb bhdb nonceCounter pactQueue _ ->
C.bench "doubleForkingBench" $ C.whnfIO $ do
Expand Down Expand Up @@ -263,6 +280,7 @@ data Resources
, nonceCounter :: !(IORef Word64)
, txPerBlock :: !(IORef Int)
, sqlEnv :: !SQLiteEnv
, sqlEnv2 :: !SQLiteEnv
}

type RunPactService =
Expand Down Expand Up @@ -293,10 +311,11 @@ withResources rdb trunkLength logLevel compact f = C.envWithCleanup create destr
coinAccounts <- newMVar mempty
nonceCounter <- newIORef 1
txPerBlock <- newIORef 10
sqlEnv <- openSQLiteConnection "" {- temporary SQLite db -} chainwebBenchPragmas
sqlEnv <- openSQLiteConnection "/tmp/chainweb-bench.db" {- temporary SQLite db -} chainwebBenchPragmas
sqlEnv2 <- openSQLiteConnection "/tmp/chainweb-bench.db" {- temporary SQLite db -} chainwebBenchPragmas
mp <- testMemPoolAccess txPerBlock coinAccounts
pactService <-
startPact testVer logger blockHeaderDb payloadDb mp sqlEnv
startPact testVer logger blockHeaderDb payloadDb mp (sqlEnv, sqlEnv2)
mainTrunkBlocks <-
playLine payloadDb blockHeaderDb trunkLength genesisBlock (snd pactService) nonceCounter
when (compact == DoCompact) $ do
Expand All @@ -310,6 +329,8 @@ withResources rdb trunkLength logLevel compact f = C.envWithCleanup create destr
destroy (NoopNFData (Resources {..})) = do
stopPact pactService
stopSqliteDb sqlEnv
stopSqliteDb sqlEnv2
removeFile "/tmp/chainweb-bench.db"

pactQueueSize = 2000

Expand All @@ -320,16 +341,14 @@ withResources rdb trunkLength logLevel compact f = C.envWithCleanup create destr
a <- async $ runPactService version cid l reqQ mempool bhdb pdb sqlEnv testPactServiceConfig
{ _pactBlockGasLimit = 180_000
}

return (a, reqQ)

stopPact (a, _) = cancel a

chainwebBenchPragmas =
[ "synchronous = NORMAL"
, "journal_mode = WAL"
, "locking_mode = EXCLUSIVE"
-- this is different from the prodcution database that uses @NORMAL@
, "locking_mode = NORMAL"
, "temp_store = MEMORY"
, "auto_vacuum = NONE"
, "page_size = 1024"
Expand Down Expand Up @@ -371,7 +390,7 @@ testMemPoolAccess txsPerBlock accounts = do
getTestBlock mVarAccounts txOrigTime validate bHeight hash
| bHeight == 1 = do
meta <- setTime txOrigTime <$> makeMeta cid
(as, kss, cmds) <- unzip3 . toList <$> createCoinAccounts testVer meta
(as, kss, cmds) <- unzip3 <$> createCoinAccounts testVer meta twoNames
case traverse validateCommand cmds of
Left err -> throwM $ userError err
Right !r -> do
Expand Down Expand Up @@ -470,15 +489,20 @@ stockKey s = do
stockKeyFile :: ByteString
stockKeyFile = $(embedFile "pact/genesis/devnet/keys.yaml")

createCoinAccounts :: ChainwebVersion -> PublicMeta -> IO (NonEmpty (Account, NonEmpty (DynKeyPair, [SigCapability]), Command Text))
createCoinAccounts v meta = traverse (go <*> createCoinAccount v meta) names
createCoinAccounts :: ChainwebVersion -> PublicMeta -> [String] -> IO [(Account, NonEmpty (DynKeyPair, [SigCapability]), Command Text)]
createCoinAccounts v meta names' = traverse (go <*> createCoinAccount v meta) names'
where
go a m = do
(b,c) <- m
return (Account a,b,c)

names :: NonEmpty String
names = NEL.map safeCapitalize . NEL.fromList $ Prelude.take 2 $ words "mary elizabeth patricia jennifer linda barbara margaret susan dorothy jessica james john robert michael william david richard joseph charles thomas"
twoNames :: [String]
twoNames = take 2 names

names :: [String]
names = map safeCapitalize $ names' ++ [(n ++ show x) | n <- names', x <- [0 :: Int ..1000]]
where
names' = words "mary elizabeth patricia jennifer linda barbara margaret susan dorothy jessica james john robert michael william david richard joseph charles thomas"

formatB16PubKey :: DynKeyPair -> Text
formatB16PubKey = \case
Expand Down
1 change: 1 addition & 0 deletions chainweb.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -827,6 +827,7 @@ benchmark bench
, containers >= 0.5
, criterion
, deepseq >= 1.4
, directory >= 1.3
, exceptions >= 0.8
, file-embed >= 0.0
, lens >= 4.17
Expand Down
Loading

0 comments on commit 89ef494

Please sign in to comment.