db-analyser: support reapplication in --benchmark-ledger-ops

Author: amesgen

ouroboros-consensus-cardano/README.md

@@ -157,6 +157,9 @@ Lastly the user can provide the analysis that should be run on the chain:
       - Ticking the [ledger state](https://github.com/IntersectMBO/ouroboros-consensus/blob/51da3876c01edc2eec250fdc998f6cb33cdc4367/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Basics.hs#L174).
       - Applying a block.
 
+    When the `--reapply` flag is specified, we measure header/block
+    *re*application instead of full application.
+
 * `--repro-mempool-and-forge NUM` populates the mempool with the transactions
   from NUM blocks every time and then runs the forging loop. Useful to inspect
   regressions in the forging loop or in the mempool adding/snapshotting logic.

ouroboros-consensus-cardano/app/DBAnalyser/Parsers.hs

@@ -150,7 +150,8 @@ parseLimit = asum [
 
 benchmarkLedgerOpsParser :: Parser AnalysisName
 benchmarkLedgerOpsParser =
-    BenchmarkLedgerOps <$> (benchmarkLedgerOpsFlagParser *> pMaybeOutputFile)
+       benchmarkLedgerOpsFlagParser
+    *> (BenchmarkLedgerOps <$> pMaybeOutputFile <*> pApplyMode)
   where
     benchmarkLedgerOpsFlagParser =
       flag' BenchmarkLedgerOps $ mconcat [
@@ -160,6 +161,12 @@ benchmarkLedgerOpsParser =
                   <> " (defaults to stdout)."
           ]
 
+    pApplyMode =
+      flag LedgerApply LedgerReapply $ mconcat [
+            long "reapply"
+          , help $ "Measure header/block *re*application instead of full application."
+          ]
+
 getBlockApplicationMetrics :: Parser AnalysisName
 getBlockApplicationMetrics =  do
   fGetBlockApplicationMetrics <- partialGetBlockApplicationMetricsParser

ouroboros-consensus-cardano/app/db-analyser.hs

@@ -12,7 +12,7 @@
 --                      [--full-ledger-validation] |
 --                      --count-blocks | --checkThunks BLOCK_COUNT |
 --                      --trace-ledger | --repro-mempool-and-forge INT |
---                      --benchmark-ledger-ops [--out-file FILE] |
+--                      --benchmark-ledger-ops [--out-file FILE] [--reapply] |
 --                      --get-block-application-metrics NUM [--out-file FILE]]
 --                    [--num-blocks-to-process INT] COMMAND
 module Main (main) where

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis.hs

@@ -49,11 +49,12 @@ import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Forecast (forecastFor)
 import           Ouroboros.Consensus.HeaderValidation (HasAnnTip (..),
-                     HeaderState (..), headerStatePoint, tickHeaderState,
-                     validateHeader)
-import           Ouroboros.Consensus.Ledger.Abstract (LedgerCfg, LedgerConfig,
-                     applyBlockLedgerResult, applyChainTick, tickThenApply,
-                     tickThenApplyLedgerResult, tickThenReapply)
+                     HeaderState (..), headerStatePoint, revalidateHeader,
+                     tickHeaderState, validateHeader)
+import           Ouroboros.Consensus.Ledger.Abstract
+                     (ApplyBlock (reapplyBlockLedgerResult), LedgerCfg,
+                     LedgerConfig, applyBlockLedgerResult, applyChainTick,
+                     tickThenApply, tickThenApplyLedgerResult, tickThenReapply)
 import           Ouroboros.Consensus.Ledger.Basics (LedgerResult (..),
                      LedgerState, getTipSlot)
 import           Ouroboros.Consensus.Ledger.Extended
@@ -112,7 +113,7 @@ runAnalysis analysisName = case go analysisName of
     go (CheckNoThunksEvery nBks)                      = mkAnalysis $ checkNoThunksEvery nBks
     go TraceLedgerProcessing                          = mkAnalysis $ traceLedgerProcessing
     go (ReproMempoolAndForge nBks)                    = mkAnalysis $ reproMempoolForge nBks
-    go (BenchmarkLedgerOps mOutfile)                  = mkAnalysis $ benchmarkLedgerOps mOutfile
+    go (BenchmarkLedgerOps mOutfile lgrAppMode)       = mkAnalysis $ benchmarkLedgerOps mOutfile lgrAppMode
     go (GetBlockApplicationMetrics nrBlocks mOutfile) = mkAnalysis $ getBlockApplicationMetrics nrBlocks mOutfile
 
     mkAnalysis ::
@@ -536,13 +537,15 @@ benchmarkLedgerOps ::
      ( HasAnalysis blk
      , LedgerSupportsProtocol blk
      )
-  => Maybe FilePath -> Analysis blk StartFromLedgerState
-benchmarkLedgerOps mOutfile AnalysisEnv {db, registry, startFrom, cfg, limit} = do
+  => Maybe FilePath
+  -> LedgerApplicationMode
+  -> Analysis blk StartFromLedgerState
+benchmarkLedgerOps mOutfile ledgerAppMode AnalysisEnv {db, registry, startFrom, cfg, limit} = do
     -- We default to CSV when the no output file is provided (and thus the results are output to stdout).
     outFormat <- F.getOutputFormat mOutfile
 
     withFile mOutfile $ \outFileHandle -> do
-      F.writeMetadata outFileHandle outFormat
+      F.writeMetadata outFileHandle outFormat ledgerAppMode
       F.writeHeader   outFileHandle outFormat
 
       void $ processAll db registry GetBlock startFrom limit initLedger (process outFileHandle outFormat)
@@ -639,10 +642,13 @@ benchmarkLedgerOps mOutfile AnalysisEnv {db, registry, startFrom, cfg, limit} =
              LedgerView (BlockProtocol blk)
           -> Ticked (HeaderState blk)
           -> IO (HeaderState blk)
-        applyTheHeader ledgerView tickedHeaderState = do
+        applyTheHeader ledgerView tickedHeaderState = case ledgerAppMode of
+          LedgerApply ->
             case runExcept $ validateHeader cfg ledgerView (getHeader blk) tickedHeaderState of
               Left err -> fail $ "benchmark doesn't support invalid headers: " <> show rp <> " " <> show err
               Right x -> pure x
+          LedgerReapply ->
+            pure $! revalidateHeader cfg ledgerView (getHeader blk) tickedHeaderState
 
         tickTheLedgerState ::
              SlotNo
@@ -654,10 +660,13 @@ benchmarkLedgerOps mOutfile AnalysisEnv {db, registry, startFrom, cfg, limit} =
         applyTheBlock ::
              Ticked (LedgerState blk)
           -> IO (LedgerState blk)
-        applyTheBlock tickedLedgerSt = do
+        applyTheBlock tickedLedgerSt = case ledgerAppMode of
+          LedgerApply ->
             case runExcept (lrResult <$> applyBlockLedgerResult lcfg blk tickedLedgerSt) of
               Left err -> fail $ "benchmark doesn't support invalid blocks: " <> show rp <> " " <> show err
               Right x  -> pure x
+          LedgerReapply ->
+            pure $! lrResult $ reapplyBlockLedgerResult lcfg blk tickedLedgerSt
 
 withFile :: Maybe FilePath -> (IO.Handle -> IO r) -> IO r
 withFile (Just outfile) = IO.withFile outfile IO.WriteMode

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis/BenchmarkLedgerOps/FileWriting.hs

@@ -16,6 +16,7 @@ import           Cardano.Tools.DBAnalyser.Analysis.BenchmarkLedgerOps.SlotDataPo
                      (SlotDataPoint)
 import qualified Cardano.Tools.DBAnalyser.Analysis.BenchmarkLedgerOps.SlotDataPoint as DP
 import qualified Cardano.Tools.DBAnalyser.CSV as CSV
+import           Cardano.Tools.DBAnalyser.Types (LedgerApplicationMode)
 import           Data.Aeson as Aeson
 import qualified Data.ByteString.Lazy as BSL
 import           System.FilePath.Posix (takeExtension)
@@ -86,10 +87,10 @@ writeDataPoint outFileHandle JSON slotDataPoint =
 
 -- | Write metadata to a JSON file if this is the selected
 -- format. Perform a no-op otherwise.
-writeMetadata :: IO.Handle -> OutputFormat -> IO ()
-writeMetadata _outFileHandle CSV  = pure ()
-writeMetadata  outFileHandle JSON =
-  BenchmarkLedgerOps.Metadata.getMetadata
+writeMetadata :: IO.Handle -> OutputFormat -> LedgerApplicationMode -> IO ()
+writeMetadata _outFileHandle CSV _lgrAppMode = pure ()
+writeMetadata  outFileHandle JSON lgrAppMode =
+  BenchmarkLedgerOps.Metadata.getMetadata lgrAppMode
   >>= BSL.hPut outFileHandle . Aeson.encode
 
 {-------------------------------------------------------------------------------

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis/BenchmarkLedgerOps/Metadata.hs

@@ -15,6 +15,7 @@ module Cardano.Tools.DBAnalyser.Analysis.BenchmarkLedgerOps.Metadata (
   , getMetadata
   ) where
 
+import           Cardano.Tools.DBAnalyser.Types (LedgerApplicationMode (..))
 import           Cardano.Tools.GitRev (gitRev)
 import           Data.Aeson (ToJSON)
 import qualified Data.Aeson as Aeson
@@ -35,13 +36,14 @@ data Metadata = Metadata {
   , operatingSystem             :: String
   , machineArchitecture         :: String
   , gitRevison                  :: String
+  , ledgerApplicationMode       :: String
   } deriving (Generic, Show, Eq)
 
 instance ToJSON Metadata where
   toEncoding = Aeson.genericToEncoding Aeson.defaultOptions
 
-getMetadata :: IO Metadata
-getMetadata = do
+getMetadata :: LedgerApplicationMode -> IO Metadata
+getMetadata lgrAppMode = do
   rtsFlags <- RTS.getRTSFlags
   pure $ Metadata {
       rtsGCMaxStkSize             = RTS.maxStkSize     $ RTS.gcFlags rtsFlags
@@ -53,4 +55,7 @@ getMetadata = do
     , operatingSystem             = System.Info.os
     , machineArchitecture         = System.Info.arch
     , gitRevison                  = T.unpack gitRev
+    , ledgerApplicationMode       = case lgrAppMode of
+        LedgerApply   -> "full-application"
+        LedgerReapply -> "reapplication"
     }

ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Types.hs

@@ -28,7 +28,7 @@ data AnalysisName =
   | CountBlocks
   | CheckNoThunksEvery Word64
   | TraceLedgerProcessing
-  | BenchmarkLedgerOps (Maybe FilePath)
+  | BenchmarkLedgerOps (Maybe FilePath) LedgerApplicationMode
   | ReproMempoolAndForge Int
     -- | Compute different block application metrics every 'NumberOfBlocks'.
     --