diff --git a/ouroboros-consensus-cardano/changelog.d/20240906_081159_nick.frisby_db_analyser_add_blocksize.md b/ouroboros-consensus-cardano/changelog.d/20240906_081159_nick.frisby_db_analyser_add_blocksize.md new file mode 100644 index 0000000000..be35a7c285 --- /dev/null +++ b/ouroboros-consensus-cardano/changelog.d/20240906_081159_nick.frisby_db_analyser_add_blocksize.md @@ -0,0 +1,22 @@ + + + + + +### Breaking + +- Added a `blockBytes` column to the output of --benchmark-ledger-ops and --show-header-size. diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis.hs index 2e874be58d..138b838a34 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis.hs @@ -41,7 +41,7 @@ import Data.Int (Int64) import Data.List (intercalate) import qualified Data.Map.Strict as Map import Data.Singletons -import Data.Word (Word16, Word64) +import Data.Word (Word16, Word32, Word64) import qualified Debug.Trace as Debug import qualified GHC.Stats as GC import NoThunks.Class (noThunks) @@ -182,11 +182,12 @@ data TraceEvent blk = | CountedBlocksEvent Int -- ^ triggered once during CountBLocks analysis, -- when blocks were counted - | HeaderSizeEvent BlockNo SlotNo Word16 + | HeaderSizeEvent BlockNo SlotNo Word16 Word32 -- ^ triggered when header size has been measured -- * block's number -- * slot number when the block was forged -- * block's header size + -- * block's size | MaxHeaderSizeEvent Word16 -- ^ triggered once during ShowBlockTxsSize analysis, -- holding maximum encountered header size @@ -238,10 +239,11 @@ instance (HasAnalysis blk, LedgerSupportsProtocol blk) => Show (TraceEvent blk) , "Known: " <> show known ] show (CountedBlocksEvent counted) = "Counted " <> show counted <> " blocks." - show (HeaderSizeEvent bn sn headerSize) = intercalate "\t" $ [ + show (HeaderSizeEvent bn sn hSz bSz) = intercalate "\t" $ [ show bn , show sn - , "header size: " <> show headerSize + , "header size: " <> show hSz + , "block size: " <> show bSz ] show (MaxHeaderSizeEvent size) = "Maximum encountered header size = " <> show size @@ -312,15 +314,16 @@ countTxOutputs AnalysisEnv { db, registry, startFrom, limit, tracer } = do showHeaderSize :: forall blk. HasAnalysis blk => Analysis blk StartFromPoint showHeaderSize AnalysisEnv { db, registry, startFrom, limit, tracer } = do maxHeaderSize <- - processAll db registry ((,) <$> GetHeader <*> GetHeaderSize) startFrom limit 0 process + processAll db registry ((,,) <$> GetHeader <*> GetHeaderSize <*> GetBlockSize) startFrom limit 0 process traceWith tracer $ MaxHeaderSizeEvent maxHeaderSize pure $ Just $ ResultMaxHeaderSize maxHeaderSize where - process :: Word16 -> (Header blk, Word16) -> IO Word16 - process maxHeaderSize (hdr, headerSize) = do + process :: Word16 -> (Header blk, Word16, SizeInBytes) -> IO Word16 + process maxHeaderSize (hdr, headerSize, blockSize) = do let event = HeaderSizeEvent (blockNo hdr) (blockSlot hdr) headerSize + (getSizeInBytes blockSize) traceWith tracer event return $ maxHeaderSize `max` headerSize @@ -548,7 +551,14 @@ benchmarkLedgerOps mOutfile ledgerAppMode AnalysisEnv {db, registry, startFrom, F.writeMetadata outFileHandle outFormat ledgerAppMode F.writeHeader outFileHandle outFormat - void $ processAll db registry GetBlock startFrom limit initLedger (process outFileHandle outFormat) + void $ processAll + db + registry + ((,) <$> GetBlock <*> GetBlockSize) + startFrom + limit + initLedger + (process outFileHandle outFormat) pure Nothing where ccfg = topLevelConfigProtocol cfg @@ -560,9 +570,9 @@ benchmarkLedgerOps mOutfile ledgerAppMode AnalysisEnv {db, registry, startFrom, IO.Handle -> F.OutputFormat -> ExtLedgerState blk - -> blk + -> (blk, SizeInBytes) -> IO (ExtLedgerState blk) - process outFileHandle outFormat prevLedgerState blk = do + process outFileHandle outFormat prevLedgerState (blk, sz) = do prevRtsStats <- GC.getRTSStats let -- Compute how many nanoseconds the mutator used from the last @@ -604,6 +614,7 @@ benchmarkLedgerOps mOutfile ledgerAppMode AnalysisEnv {db, registry, startFrom, , DP.mut_headerApply = tHdrApp `div` 1000 , DP.mut_blockTick = tBlkTick `div` 1000 , DP.mut_blockApply = tBlkApp `div` 1000 + , DP.blockByteSize = getSizeInBytes sz , DP.blockStats = DP.BlockStats $ HasAnalysis.blockStats blk } diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis/BenchmarkLedgerOps/FileWriting.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis/BenchmarkLedgerOps/FileWriting.hs index 7d476c28ef..eedac27b88 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis/BenchmarkLedgerOps/FileWriting.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis/BenchmarkLedgerOps/FileWriting.hs @@ -112,5 +112,6 @@ dataPointCsvBuilder = , ("mut_headerApply" , decimal . DP.mut_headerApply) , ("mut_blockTick" , decimal . DP.mut_blockTick) , ("mut_blockApply" , decimal . DP.mut_blockApply) + , ("blockBytes" , decimal . DP.blockByteSize) , ("...era-specific stats" , Builder.intercalate csvSeparator . DP.unBlockStats . DP.blockStats) ] diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis/BenchmarkLedgerOps/SlotDataPoint.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis/BenchmarkLedgerOps/SlotDataPoint.hs index ea55745841..7a39388e0b 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis/BenchmarkLedgerOps/SlotDataPoint.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Analysis/BenchmarkLedgerOps/SlotDataPoint.hs @@ -55,6 +55,7 @@ data SlotDataPoint = , mut_headerApply :: !Int64 , mut_blockTick :: !Int64 , mut_blockApply :: !Int64 + , blockByteSize :: !Word32 -- | Free-form information about the block. , blockStats :: !BlockStats } deriving (Generic, Show)