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.

Author: jorisdral

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)

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
                         ]
                   )