From 2201276f85a5a480cc4ef7953811ac04238bed65 Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Thu, 9 May 2024 11:58:06 +0200 Subject: [PATCH 1/2] Use Haskell.gitignore --- .gitignore | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/.gitignore b/.gitignore index c9bfd69851..9614c9a46a 100644 --- a/.gitignore +++ b/.gitignore @@ -72,3 +72,28 @@ launch-* cabal.project.consensus ouroboros-consensus-cardano/test/tools-test/disk/chaindb/ + +# https://github.com/github/gitignore/blob/main/Haskell.gitignore +dist +dist-* +cabal-dev +*.o +*.hi +*.hie +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp +*.eventlog +.stack-work/ +cabal.project.local +cabal.project.local~ +.HTF/ +.ghc.environment.* \ No newline at end of file From 9f7a6ef7bf54863cd59785ac771b9d722bb506e7 Mon Sep 17 00:00:00 2001 From: Joris Dral Date: Thu, 9 May 2024 12:20:16 +0200 Subject: [PATCH 2/2] Ensure that transaction tokens are unique in the mempool benchmarks Data of type `Token` is what a mempool `TestBlock` transaction (`Tx`) consumes and produces. Previously, this token was a newtype around a `Word8`. There can only be around 256 unque `Word8` tokens, which means that its likely for this value to wrap around. In the current benchmark scenario, where we add linearly dependent transactions with only one input and output to a mempool, this wrap around was occurring and therefore the list of transaction that was being generated had many duplicates. The type of tokens is therefore changed to be a newtype around an `Int`, which won't wrap around (in a realistic benchmark). Abovementioned change exposed subtle performance effects on the mempool. Most of this can be attributed to the `Tx` type doubling as a `GenTxId`. The mempool keeps track of these identifiers in a set. Since there were only around 256 unique transactions, this set was rather small. Changing tokens to be `Int`s ensured that this set could grow much larger before becoming full, and that by itself has subtle effects on the performance of the mempool. Apart from changing the type of tokens, the mempool benchmark setup is reworked: * Transactions that are used as benchmark inputs are pre-generated and fully evaluated so that the generation work is not measured in the benchmarked function itself. * Instead of opening a mempool once and removing transactions after each benchmark run, a new mempool is opened in each benchmark run. Removing transactions proved to be prohibitively costly compared to the cost of opening a new mempool. * A new benchmark is added that measures just the mempool setup time. To obtain the cost of just adding the transactions without cost of opening the mempool, the time of this new benchmark can be manually subtracted from the full benchmark time. --- .../Bench/Consensus/Mempool/TestBlock.hs | 5 ++-- .../bench/mempool-bench/Main.hs | 30 +++++++++++-------- 2 files changed, 19 insertions(+), 16 deletions(-) diff --git a/ouroboros-consensus/bench/mempool-bench/Bench/Consensus/Mempool/TestBlock.hs b/ouroboros-consensus/bench/mempool-bench/Bench/Consensus/Mempool/TestBlock.hs index ac31aae5d0..ee089e3b93 100644 --- a/ouroboros-consensus/bench/mempool-bench/Bench/Consensus/Mempool/TestBlock.hs +++ b/ouroboros-consensus/bench/mempool-bench/Bench/Consensus/Mempool/TestBlock.hs @@ -28,7 +28,6 @@ import Control.Monad.Trans.Except (except) import Data.Set (Set, (\\)) import qualified Data.Set as Set import Data.TreeDiff (ToExpr) -import Data.Word (Word8) import GHC.Generics (Generic) import NoThunks.Class (NoThunks) import qualified Ouroboros.Consensus.Block as Block @@ -56,7 +55,7 @@ data Tx = Tx { deriving stock (Eq, Ord, Generic, Show) deriving anyclass (NoThunks, NFData) -newtype Token = Token { unToken :: Word8 } +newtype Token = Token { unToken :: Int } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NoThunks, ToExpr, Serialise, NFData) @@ -81,7 +80,7 @@ sampleLedgerConfig = testBlockLedgerConfigFrom $ -------------------------------------------------------------------------------} data TestLedgerState = TestLedgerState { - availableTokens :: Set Token + availableTokens :: !(Set Token) } deriving stock (Generic, Eq, Show) deriving anyclass (NoThunks, ToExpr, Serialise) diff --git a/ouroboros-consensus/bench/mempool-bench/Main.hs b/ouroboros-consensus/bench/mempool-bench/Main.hs index f62d1b5f26..597fab935b 100644 --- a/ouroboros-consensus/bench/mempool-bench/Main.hs +++ b/ouroboros-consensus/bench/mempool-bench/Main.hs @@ -11,7 +11,8 @@ import Bench.Consensus.Mempool import Bench.Consensus.Mempool.TestBlock (TestBlock) import qualified Bench.Consensus.Mempool.TestBlock as TestBlock import Control.Arrow (first) -import Control.Monad (unless, void) +import Control.DeepSeq +import Control.Monad (unless) import qualified Control.Tracer as Tracer import Data.Aeson import qualified Data.ByteString.Lazy as BL @@ -27,7 +28,7 @@ import qualified Test.Consensus.Mempool.Mocked as Mocked import Test.Consensus.Mempool.Mocked (MockedMempool) import Test.Tasty (withResource) import Test.Tasty.Bench (CsvPath (CsvPath), bench, benchIngredients, - bgroup, nfIO) + bgroup, whnfIO) import Test.Tasty.HUnit (testCase, (@?=)) import Test.Tasty.Options (changeOption) import Test.Tasty.Runners (parseOptions, tryIngredients) @@ -50,24 +51,27 @@ main = withStdTerminalHandles $ do where benchmarkJustAddingTransactions = bgroup "Just adding" $ - fmap benchAddNTxs [10_000, 1_000_000] + fmap benchAddNTxs [10_000, 20_000] where benchAddNTxs n = withResource - (let txs = mkNTryAddTxs n in fmap (, txs) (openMempoolWithCapacityFor txs)) + (pure $!! mkNTryAddTxs n) (\_ -> pure ()) - (\getAcquiredRes -> do - let withAcquiredMempool act = do - (mempool, txs) <- getAcquiredRes - void $ act mempool txs - -- TODO: consider adding a 'reset' command to the mempool to make sure its state is not tainted. - Mocked.removeTxs mempool $ getCmdsTxIds txs + (\getTxs -> do bgroup (show n <> " transactions") [ - bench "benchmark" $ nfIO $ withAcquiredMempool $ \mempool txs -> do + bench "setup mempool" $ whnfIO $ do + txs <- getTxs + openMempoolWithCapacityFor txs + , bench "setup mempool + benchmark" $ whnfIO $ do + txs <- getTxs + mempool <- openMempoolWithCapacityFor txs run mempool txs - , testCase "test" $ withAcquiredMempool $ \mempool txs -> + , testCase "test" $ do + txs <- getTxs + mempool <- openMempoolWithCapacityFor txs testAddTxs mempool txs - , testCase "txs length" $ withAcquiredMempool $ \_mempool txs -> do + , testCase "txs length" $ do + txs <- getTxs length txs @?= n ] )