ouroboros-consensus: add Peras chain weight benchmark

Author: geo2a

docs/website/contents/for-developers/Benchmarks.md

@@ -20,3 +20,13 @@ To aid the refactoring of the ChainSync client, we added a benchmark for it in [
 ```sh
 cabal new-run ouroboros-consensus:ChainSync-client-bench -- 10 10
 ```
+
+## PerasCertDB Benchmark
+
+We have a microbenchmark for the boosted chain fragment weight calculation, which could be run as follows:
+
+```sh
+cabal run ouroboros-consensus:PerasCertDB-bench -- +RTS -T -A32m -RTS
+```
+
+We request GHC runtime system statistics with `-T` to get a memory usage estimate, and also request a large nursery with `-A32m` to minimise garbage collection. See `tasty-bench` [documentation](https://github.com/Bodigrim/tasty-bench?tab=readme-ov-file#troubleshooting) for more tips.

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

@@ -0,0 +1,102 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE LambdaCase #-}
+
+-- | This module contains benchmarks for Peras chain weight calculation as implemented by
+--   the by the 'Ouroboros.Consensus.Storage.PerasCertDB.API.boostedWeightForFragment'
+--   function.
+--
+--   We benchmark the calculation on a static sequence of chain fragments of increasing
+--   length, ranging from 0 to around 8640, with a sampling rate of 100. The chain fragments
+--   are instantiated with 'TestBlock', and every 5 blocks there is a booster block with
+--   weight 15. All parameters are set in 'benchmarkParams'.
+module Main (main) where
+
+import Data.List (iterate')
+import Data.Map.Strict qualified as Map
+import Numeric.Natural (Natural)
+import Ouroboros.Consensus.Block (PerasWeight (PerasWeight), SlotNo (..))
+import Ouroboros.Consensus.Storage.PerasCertDB.API
+  ( PerasWeightSnapshot (..)
+  , boostedWeightForFragment
+  )
+import Ouroboros.Network.AnchoredFragment qualified as AF
+import Test.Ouroboros.Storage.TestBlock (TestBlock (..), TestBody (..), TestHeader (..))
+import Test.Ouroboros.Storage.TestBlock qualified as TestBlock
+import Test.Tasty.Bench
+
+data BenchmarkParams = BenchmarkParams
+  { blockRate :: SlotNo
+  -- ^ How often the fragments will contain blocks, in slots
+  , fragmentLenghtSamplingRate :: Natural
+  -- ^ The rate of length increase for generate chain fragments
+  , fragmentMaxLenght :: Natural
+  -- ^ the maximum length of a fragment
+  , boostedBlockRate :: Natural
+  -- ^ How often boosted blocks occur, in blocks
+  , boostWeight :: PerasWeight
+  -- ^ The weight of the boost
+  }
+
+benchmarkParams :: BenchmarkParams
+benchmarkParams =
+  BenchmarkParams
+    { blockRate = 20
+    , fragmentLenghtSamplingRate = 100
+    , fragmentMaxLenght = 2160 + 3 * 2160
+    , boostedBlockRate = 5
+    , boostWeight = PerasWeight 15
+    }
+
+main :: IO ()
+main =
+  Test.Tasty.Bench.defaultMain $ map benchBoostedWeightForFragment inputs
+ where
+  -- NOTE: we do not use the 'env' combinator to set up the test data since
+  --       it requires 'NFData' for 'AF.AnchoredFragment'. While the necessary
+  --       instances could be provided, we do not think is necessary for this
+  --       benchmark, as the input data is rather small.
+  inputs :: [(Natural, (PerasWeightSnapshot TestBlock, AF.AnchoredFragment TestBlock))]
+  inputs =
+    getEveryN (fragmentLenghtSamplingRate benchmarkParams) $
+      take (fromIntegral $ fragmentMaxLenght benchmarkParams) $
+        zip [0 ..] $
+          zip (map uniformWeightSnapshot fragments) fragments
+
+benchBoostedWeightForFragment ::
+  (Natural, (PerasWeightSnapshot TestBlock, AF.AnchoredFragment TestBlock)) -> Benchmark
+benchBoostedWeightForFragment (i, (weightSnapshot, fragment)) =
+  bench ("boostedWeightForFragment of length " <> show i) $
+    whnf (boostedWeightForFragment weightSnapshot) fragment
+
+-- | An infinite list of chain fragments
+fragments :: [AF.AnchoredFragment TestBlock]
+fragments = iterate' addSuccessorBlock genesisFragment
+ where
+  genesisFragment :: AF.AnchoredFragment TestBlock
+  genesisFragment = AF.Empty AF.AnchorGenesis
+
+  addSuccessorBlock :: AF.AnchoredFragment TestBlock -> AF.AnchoredFragment TestBlock
+  addSuccessorBlock = \case
+    AF.Empty _ -> (AF.Empty AF.AnchorGenesis) AF.:> (TestBlock.firstBlock 0 dummyBody)
+    (xs AF.:> x) ->
+      let nextBlockSlot = blockRate benchmarkParams + (thSlotNo . testHeader $ x)
+       in (xs AF.:> x) AF.:> TestBlock.mkNextBlock x nextBlockSlot dummyBody
+
+  dummyBody :: TestBody
+  dummyBody = TestBody{tbForkNo = 0, tbIsValid = True}
+
+-- | Given a chain fragment, construct a weight snapshot where there's a boosted block every 90 slots
+uniformWeightSnapshot :: AF.AnchoredFragment TestBlock -> PerasWeightSnapshot TestBlock
+uniformWeightSnapshot fragment =
+  let pointsToBoost =
+        map snd
+          . getEveryN (boostedBlockRate benchmarkParams)
+          . zip [0 ..]
+          . map AF.blockPoint
+          . AF.toOldestFirst
+          $ fragment
+      weights = repeat (boostWeight benchmarkParams)
+   in PerasWeightSnapshot{getPerasWeightSnapshot = Map.fromList $ zip pointsToBoost weights}
+
+getEveryN :: Natural -> [(Natural, a)] -> [(Natural, a)]
+getEveryN n = filter (\(i, _) -> (i `mod` n) == 0)

ouroboros-consensus/ouroboros-consensus.cabal

@@ -837,6 +837,20 @@ benchmark ChainSync-client-bench
     unstable-consensus-testlib,
     with-utf8,
 
+benchmark PerasCertDB-bench
+  import: common-bench
+  type: exitcode-stdio-1.0
+  hs-source-dirs: bench/PerasCertDB-bench
+  main-is: Main.hs
+  other-modules:
+  build-depends:
+    base,
+    containers,
+    ouroboros-consensus,
+    ouroboros-network-api,
+    tasty-bench,
+    unstable-consensus-testlib,
+
 test-suite doctest
   import: common-test
   main-is: doctest.hs