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`. T there can
only be around 256 unqiue 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.

Abovementioned change exposed subtle performance effects of this wrap-around.
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 rather large, and that by itself has effects on.

Apart from change 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 $!! force (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
                         ]
                   )