mempool-bench: move more pre-calculation into withResource

ouroboros-consensus/bench/mempool-bench/Main.hs

@@ -54,31 +54,35 @@ main = withStdTerminalHandles $ do
           where
             benchAddNTxs n =
                 withResource
-                  (pure $!! mkNTryAddTxs n)
+                  (pure $!!
+                     let cmds = mkNTryAddTxs n
+                         sz   = sum $ map TestBlock.txSize $ getCmdsTxs cmds
+                     in (cmds, Mempool.ByteSize sz)
+                  )
                   (\_ -> pure ())
-                  (\getTxs -> do
+                  (\getCmds -> do
                       bgroup (show n <> " transactions") [
                           bench "setup mempool" $ whnfIO $ do
-                            txs <- getTxs
-                            openMempoolWithCapacityFor txs
+                            (_cmds, capacity) <- getCmds
+                            openMempoolWithCapacity capacity
                         , bench "setup mempool + benchmark" $ whnfIO $ do
-                            txs <- getTxs
-                            mempool <- openMempoolWithCapacityFor txs
-                            run mempool txs
+                            (cmds, capacity) <- getCmds
+                            mempool <- openMempoolWithCapacity capacity
+                            run mempool cmds
                         , testCase "test" $ do
-                            txs <- getTxs
-                            mempool <- openMempoolWithCapacityFor txs
-                            testAddTxs mempool txs
-                        , testCase "txs length" $ do
-                            txs <- getTxs
-                            length txs @?= n
+                            (cmds, capacity) <- getCmds
+                            mempool <- openMempoolWithCapacity capacity
+                            testAddCmds mempool cmds
+                        , testCase "cmds length" $ do
+                            (cmds, _capacity) <- getCmds
+                            length cmds @?= n
                         ]
                   )
               where
-                testAddTxs mempool txs = do
-                    run mempool txs
+                testAddCmds mempool cmds = do
+                    run mempool cmds
                     mempoolTxs <- Mocked.getTxs mempool
-                    mempoolTxs @?= getCmdsTxs txs
+                    mempoolTxs @?= getCmdsTxs cmds
 
     parseBenchmarkResults csvFilePath = do
         csvData <- BL.readFile csvFilePath
@@ -129,18 +133,17 @@ main = withStdTerminalHandles $ do
   Adding TestBlock transactions to a mempool
 -------------------------------------------------------------------------------}
 
-openMempoolWithCapacityFor :: [MempoolCmd TestBlock] ->  IO (MockedMempool IO TestBlock)
-openMempoolWithCapacityFor cmds =
-    Mocked.openMockedMempool capacityRequiredByCmds
+openMempoolWithCapacity :: Mempool.ByteSize -> IO (MockedMempool IO TestBlock)
+openMempoolWithCapacity capacity =
+    Mocked.openMockedMempool (Mempool.mkCapacityBytesOverride
+                               (Mempool.unByteSize capacity)
+                             )
                              Tracer.nullTracer
                              TestBlock.txSize
                              Mocked.MempoolAndModelParams {
                                  Mocked.immpInitialState = TestBlock.initialLedgerState
                                , Mocked.immpLedgerConfig = TestBlock.sampleLedgerConfig
                              }
-  where
-    capacityRequiredByCmds = Mempool.mkCapacityBytesOverride totalTxsSize
-      where totalTxsSize = sum $ fmap TestBlock.txSize $ getCmdsTxs cmds
 
 mkNTryAddTxs :: Int -> [MempoolCmd TestBlock.TestBlock]
 mkNTryAddTxs 0 = []

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Mempool/Capacity.hs

@@ -23,6 +23,7 @@ module Ouroboros.Consensus.Mempool.Capacity (
   , TxLimits (..)
   ) where
 
+import           Cardano.Prelude (NFData)
 import           Data.Measure (BoundedMeasure, Measure)
 import           Data.Word (Word32)
 import           NoThunks.Class
@@ -123,5 +124,5 @@ class BoundedMeasure (TxMeasure blk) => TxLimits blk where
 
 newtype ByteSize = ByteSize { unByteSize :: Word32 }
   deriving stock (Show)
-  deriving newtype (Eq, Ord)
+  deriving newtype (Eq, NFData, Ord)
   deriving newtype (BoundedMeasure, Measure)