Skip to content

Commit 00064c4

Browse files
authored
db-analyser: support reapplication in --benchmark-ledger-ops (#1219)
The first commit is just boring refactoring.
2 parents 756a79a + 2f3ace3 commit 00064c4

File tree

7 files changed

+97
-75
lines changed

7 files changed

+97
-75
lines changed

ouroboros-consensus-cardano/README.md

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -157,6 +157,9 @@ Lastly the user can provide the analysis that should be run on the chain:
157157
- Ticking the [ledger state](https://github.com/IntersectMBO/ouroboros-consensus/blob/51da3876c01edc2eec250fdc998f6cb33cdc4367/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Basics.hs#L174).
158158
- Applying a block.
159159

160+
When the `--reapply` flag is specified, we measure header/block
161+
*re*application instead of full application.
162+
160163
* `--repro-mempool-and-forge NUM` populates the mempool with the transactions
161164
from NUM blocks every time and then runs the forging loop. Useful to inspect
162165
regressions in the forging loop or in the mempool adding/snapshotting logic.

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

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -150,7 +150,8 @@ parseLimit = asum [
150150

151151
benchmarkLedgerOpsParser :: Parser AnalysisName
152152
benchmarkLedgerOpsParser =
153-
BenchmarkLedgerOps <$> (benchmarkLedgerOpsFlagParser *> pMaybeOutputFile)
153+
benchmarkLedgerOpsFlagParser
154+
*> (BenchmarkLedgerOps <$> pMaybeOutputFile <*> pApplyMode)
154155
where
155156
benchmarkLedgerOpsFlagParser =
156157
flag' BenchmarkLedgerOps $ mconcat [
@@ -160,6 +161,12 @@ benchmarkLedgerOpsParser =
160161
<> " (defaults to stdout)."
161162
]
162163

164+
pApplyMode =
165+
flag LedgerApply LedgerReapply $ mconcat [
166+
long "reapply"
167+
, help $ "Measure header/block *re*application instead of full application."
168+
]
169+
163170
getBlockApplicationMetrics :: Parser AnalysisName
164171
getBlockApplicationMetrics = do
165172
fGetBlockApplicationMetrics <- partialGetBlockApplicationMetricsParser

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@
1212
-- [--full-ledger-validation] |
1313
-- --count-blocks | --checkThunks BLOCK_COUNT |
1414
-- --trace-ledger | --repro-mempool-and-forge INT |
15-
-- --benchmark-ledger-ops [--out-file FILE] |
15+
-- --benchmark-ledger-ops [--out-file FILE] [--reapply] |
1616
-- --get-block-application-metrics NUM [--out-file FILE]]
1717
-- [--num-blocks-to-process INT] COMMAND
1818
module Main (main) where

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

Lines changed: 33 additions & 59 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,15 @@
1-
{-# LANGUAGE BangPatterns #-}
2-
{-# LANGUAGE BlockArguments #-}
3-
{-# LANGUAGE DataKinds #-}
4-
{-# LANGUAGE FlexibleContexts #-}
5-
{-# LANGUAGE GADTs #-}
6-
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
7-
{-# LANGUAGE LambdaCase #-}
8-
{-# LANGUAGE NamedFieldPuns #-}
9-
{-# LANGUAGE OverloadedStrings #-}
10-
{-# LANGUAGE ScopedTypeVariables #-}
11-
{-# LANGUAGE TupleSections #-}
12-
{-# LANGUAGE TypeApplications #-}
13-
{-# LANGUAGE TypeFamilies #-}
1+
{-# LANGUAGE BangPatterns #-}
2+
{-# LANGUAGE BlockArguments #-}
3+
{-# LANGUAGE DataKinds #-}
4+
{-# LANGUAGE FlexibleContexts #-}
5+
{-# LANGUAGE GADTs #-}
6+
{-# LANGUAGE LambdaCase #-}
7+
{-# LANGUAGE NamedFieldPuns #-}
8+
{-# LANGUAGE OverloadedStrings #-}
9+
{-# LANGUAGE ScopedTypeVariables #-}
10+
{-# LANGUAGE TupleSections #-}
11+
{-# LANGUAGE TypeApplications #-}
12+
{-# LANGUAGE TypeFamilies #-}
1413

1514
module Cardano.Tools.DBAnalyser.Analysis (
1615
AnalysisEnv (..)
@@ -33,6 +32,7 @@ import Cardano.Tools.DBAnalyser.CSV (computeAndWriteLine,
3332
writeHeaderLine)
3433
import Cardano.Tools.DBAnalyser.HasAnalysis (HasAnalysis)
3534
import qualified Cardano.Tools.DBAnalyser.HasAnalysis as HasAnalysis
35+
import Cardano.Tools.DBAnalyser.Types
3636
import Codec.CBOR.Encoding (Encoding)
3737
import Control.Monad (unless, void, when)
3838
import Control.Monad.Except (runExcept)
@@ -49,11 +49,12 @@ import Ouroboros.Consensus.Block
4949
import Ouroboros.Consensus.Config
5050
import Ouroboros.Consensus.Forecast (forecastFor)
5151
import Ouroboros.Consensus.HeaderValidation (HasAnnTip (..),
52-
HeaderState (..), headerStatePoint, tickHeaderState,
53-
validateHeader)
54-
import Ouroboros.Consensus.Ledger.Abstract (LedgerCfg, LedgerConfig,
55-
applyBlockLedgerResult, applyChainTick, tickThenApply,
56-
tickThenApplyLedgerResult, tickThenReapply)
52+
HeaderState (..), headerStatePoint, revalidateHeader,
53+
tickHeaderState, validateHeader)
54+
import Ouroboros.Consensus.Ledger.Abstract
55+
(ApplyBlock (reapplyBlockLedgerResult), LedgerCfg,
56+
LedgerConfig, applyBlockLedgerResult, applyChainTick,
57+
tickThenApply, tickThenApplyLedgerResult, tickThenReapply)
5758
import Ouroboros.Consensus.Ledger.Basics (LedgerResult (..),
5859
LedgerState, getTipSlot)
5960
import Ouroboros.Consensus.Ledger.Extended
@@ -83,39 +84,6 @@ import qualified System.IO as IO
8384
Run the requested analysis
8485
-------------------------------------------------------------------------------}
8586

86-
data AnalysisName =
87-
ShowSlotBlockNo
88-
| CountTxOutputs
89-
| ShowBlockHeaderSize
90-
| ShowBlockTxsSize
91-
| ShowEBBs
92-
| OnlyValidation
93-
| StoreLedgerStateAt SlotNo LedgerApplicationMode
94-
| CountBlocks
95-
| CheckNoThunksEvery Word64
96-
| TraceLedgerProcessing
97-
| BenchmarkLedgerOps (Maybe FilePath)
98-
| ReproMempoolAndForge Int
99-
-- | Compute different block application metrics every 'NumberOfBlocks'.
100-
--
101-
-- The metrics will be written to the provided file path, or to
102-
-- the standard output if no file path is specified.
103-
| GetBlockApplicationMetrics NumberOfBlocks (Maybe FilePath)
104-
deriving Show
105-
106-
data AnalysisResult =
107-
ResultCountBlock Int
108-
| ResultMaxHeaderSize Word16
109-
deriving (Eq, Show)
110-
111-
newtype NumberOfBlocks = NumberOfBlocks { unNumberOfBlocks :: Word64 }
112-
deriving (Eq, Show, Num, Read)
113-
114-
-- | Whether to apply blocks to a ledger state via /reapplication/ (eg skipping
115-
-- signature checks/Plutus scripts) or full /application/ (much slower).
116-
data LedgerApplicationMode = LedgerReapply | LedgerApply
117-
deriving (Eq, Show)
118-
11987
runAnalysis ::
12088
forall blk.
12189
( HasAnalysis blk
@@ -145,7 +113,7 @@ runAnalysis analysisName = case go analysisName of
145113
go (CheckNoThunksEvery nBks) = mkAnalysis $ checkNoThunksEvery nBks
146114
go TraceLedgerProcessing = mkAnalysis $ traceLedgerProcessing
147115
go (ReproMempoolAndForge nBks) = mkAnalysis $ reproMempoolForge nBks
148-
go (BenchmarkLedgerOps mOutfile) = mkAnalysis $ benchmarkLedgerOps mOutfile
116+
go (BenchmarkLedgerOps mOutfile lgrAppMode) = mkAnalysis $ benchmarkLedgerOps mOutfile lgrAppMode
149117
go (GetBlockApplicationMetrics nrBlocks mOutfile) = mkAnalysis $ getBlockApplicationMetrics nrBlocks mOutfile
150118

151119
mkAnalysis ::
@@ -569,13 +537,15 @@ benchmarkLedgerOps ::
569537
( HasAnalysis blk
570538
, LedgerSupportsProtocol blk
571539
)
572-
=> Maybe FilePath -> Analysis blk StartFromLedgerState
573-
benchmarkLedgerOps mOutfile AnalysisEnv {db, registry, startFrom, cfg, limit} = do
540+
=> Maybe FilePath
541+
-> LedgerApplicationMode
542+
-> Analysis blk StartFromLedgerState
543+
benchmarkLedgerOps mOutfile ledgerAppMode AnalysisEnv {db, registry, startFrom, cfg, limit} = do
574544
-- We default to CSV when the no output file is provided (and thus the results are output to stdout).
575545
outFormat <- F.getOutputFormat mOutfile
576546

577547
withFile mOutfile $ \outFileHandle -> do
578-
F.writeMetadata outFileHandle outFormat
548+
F.writeMetadata outFileHandle outFormat ledgerAppMode
579549
F.writeHeader outFileHandle outFormat
580550

581551
void $ processAll db registry GetBlock startFrom limit initLedger (process outFileHandle outFormat)
@@ -672,10 +642,13 @@ benchmarkLedgerOps mOutfile AnalysisEnv {db, registry, startFrom, cfg, limit} =
672642
LedgerView (BlockProtocol blk)
673643
-> Ticked (HeaderState blk)
674644
-> IO (HeaderState blk)
675-
applyTheHeader ledgerView tickedHeaderState = do
645+
applyTheHeader ledgerView tickedHeaderState = case ledgerAppMode of
646+
LedgerApply ->
676647
case runExcept $ validateHeader cfg ledgerView (getHeader blk) tickedHeaderState of
677648
Left err -> fail $ "benchmark doesn't support invalid headers: " <> show rp <> " " <> show err
678649
Right x -> pure x
650+
LedgerReapply ->
651+
pure $! revalidateHeader cfg ledgerView (getHeader blk) tickedHeaderState
679652

680653
tickTheLedgerState ::
681654
SlotNo
@@ -687,10 +660,13 @@ benchmarkLedgerOps mOutfile AnalysisEnv {db, registry, startFrom, cfg, limit} =
687660
applyTheBlock ::
688661
Ticked (LedgerState blk)
689662
-> IO (LedgerState blk)
690-
applyTheBlock tickedLedgerSt = do
663+
applyTheBlock tickedLedgerSt = case ledgerAppMode of
664+
LedgerApply ->
691665
case runExcept (lrResult <$> applyBlockLedgerResult lcfg blk tickedLedgerSt) of
692666
Left err -> fail $ "benchmark doesn't support invalid blocks: " <> show rp <> " " <> show err
693667
Right x -> pure x
668+
LedgerReapply ->
669+
pure $! lrResult $ reapplyBlockLedgerResult lcfg blk tickedLedgerSt
694670

695671
withFile :: Maybe FilePath -> (IO.Handle -> IO r) -> IO r
696672
withFile (Just outfile) = IO.withFile outfile IO.WriteMode
@@ -877,8 +853,6 @@ reproMempoolForge numBlks env = do
877853
Auxiliary: processing all blocks in the DB
878854
-------------------------------------------------------------------------------}
879855

880-
data Limit = Limit Int | Unlimited
881-
882856
decreaseLimit :: Limit -> Maybe Limit
883857
decreaseLimit Unlimited = Just Unlimited
884858
decreaseLimit (Limit 0) = Nothing

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

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@ import Cardano.Tools.DBAnalyser.Analysis.BenchmarkLedgerOps.SlotDataPo
1616
(SlotDataPoint)
1717
import qualified Cardano.Tools.DBAnalyser.Analysis.BenchmarkLedgerOps.SlotDataPoint as DP
1818
import qualified Cardano.Tools.DBAnalyser.CSV as CSV
19+
import Cardano.Tools.DBAnalyser.Types (LedgerApplicationMode)
1920
import Data.Aeson as Aeson
2021
import qualified Data.ByteString.Lazy as BSL
2122
import System.FilePath.Posix (takeExtension)
@@ -86,10 +87,10 @@ writeDataPoint outFileHandle JSON slotDataPoint =
8687

8788
-- | Write metadata to a JSON file if this is the selected
8889
-- format. Perform a no-op otherwise.
89-
writeMetadata :: IO.Handle -> OutputFormat -> IO ()
90-
writeMetadata _outFileHandle CSV = pure ()
91-
writeMetadata outFileHandle JSON =
92-
BenchmarkLedgerOps.Metadata.getMetadata
90+
writeMetadata :: IO.Handle -> OutputFormat -> LedgerApplicationMode -> IO ()
91+
writeMetadata _outFileHandle CSV _lgrAppMode = pure ()
92+
writeMetadata outFileHandle JSON lgrAppMode =
93+
BenchmarkLedgerOps.Metadata.getMetadata lgrAppMode
9394
>>= BSL.hPut outFileHandle . Aeson.encode
9495

9596
{-------------------------------------------------------------------------------

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

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ module Cardano.Tools.DBAnalyser.Analysis.BenchmarkLedgerOps.Metadata (
1515
, getMetadata
1616
) where
1717

18+
import Cardano.Tools.DBAnalyser.Types (LedgerApplicationMode (..))
1819
import Cardano.Tools.GitRev (gitRev)
1920
import Data.Aeson (ToJSON)
2021
import qualified Data.Aeson as Aeson
@@ -35,13 +36,14 @@ data Metadata = Metadata {
3536
, operatingSystem :: String
3637
, machineArchitecture :: String
3738
, gitRevison :: String
39+
, ledgerApplicationMode :: String
3840
} deriving (Generic, Show, Eq)
3941

4042
instance ToJSON Metadata where
4143
toEncoding = Aeson.genericToEncoding Aeson.defaultOptions
4244

43-
getMetadata :: IO Metadata
44-
getMetadata = do
45+
getMetadata :: LedgerApplicationMode -> IO Metadata
46+
getMetadata lgrAppMode = do
4547
rtsFlags <- RTS.getRTSFlags
4648
pure $ Metadata {
4749
rtsGCMaxStkSize = RTS.maxStkSize $ RTS.gcFlags rtsFlags
@@ -53,4 +55,7 @@ getMetadata = do
5355
, operatingSystem = System.Info.os
5456
, machineArchitecture = System.Info.arch
5557
, gitRevison = T.unpack gitRev
58+
, ledgerApplicationMode = case lgrAppMode of
59+
LedgerApply -> "full-application"
60+
LedgerReapply -> "reapplication"
5661
}
Lines changed: 40 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,8 @@
1-
module Cardano.Tools.DBAnalyser.Types (
2-
module AnalysisTypes
3-
, module Cardano.Tools.DBAnalyser.Types
4-
) where
5-
6-
import Cardano.Tools.DBAnalyser.Analysis as AnalysisTypes
7-
(AnalysisName (..), AnalysisResult (..), Limit (..),
8-
NumberOfBlocks (..))
1+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2+
3+
module Cardano.Tools.DBAnalyser.Types (module Cardano.Tools.DBAnalyser.Types) where
4+
5+
import Data.Word
96
import Ouroboros.Consensus.Block
107

118
data SelectDB =
@@ -20,6 +17,41 @@ data DBAnalyserConfig = DBAnalyserConfig {
2017
, confLimit :: Limit
2118
}
2219

20+
data AnalysisName =
21+
ShowSlotBlockNo
22+
| CountTxOutputs
23+
| ShowBlockHeaderSize
24+
| ShowBlockTxsSize
25+
| ShowEBBs
26+
| OnlyValidation
27+
| StoreLedgerStateAt SlotNo LedgerApplicationMode
28+
| CountBlocks
29+
| CheckNoThunksEvery Word64
30+
| TraceLedgerProcessing
31+
| BenchmarkLedgerOps (Maybe FilePath) LedgerApplicationMode
32+
| ReproMempoolAndForge Int
33+
-- | Compute different block application metrics every 'NumberOfBlocks'.
34+
--
35+
-- The metrics will be written to the provided file path, or to
36+
-- the standard output if no file path is specified.
37+
| GetBlockApplicationMetrics NumberOfBlocks (Maybe FilePath)
38+
deriving Show
39+
40+
data AnalysisResult =
41+
ResultCountBlock Int
42+
| ResultMaxHeaderSize Word16
43+
deriving (Eq, Show)
44+
45+
newtype NumberOfBlocks = NumberOfBlocks { unNumberOfBlocks :: Word64 }
46+
deriving (Eq, Show, Num, Read)
47+
48+
data Limit = Limit Int | Unlimited
49+
2350
-- | The extent of the ChainDB on-disk files validation. This is completely
2451
-- unrelated to validation of the ledger rules.
2552
data ValidateBlocks = ValidateAllBlocks | MinimumBlockValidation
53+
54+
-- | Whether to apply blocks to a ledger state via /reapplication/ (eg skipping
55+
-- signature checks/Plutus scripts) or full /application/ (much slower).
56+
data LedgerApplicationMode = LedgerReapply | LedgerApply
57+
deriving (Eq, Show)

0 commit comments

Comments
 (0)