Add a new analysis --count-blocks

IntersectMBO · Oct 12, 2021 · f289c6d · f289c6d
1 parent c834f35
commit f289c6d
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 0 deletions.
diff --git a/ouroboros-consensus-cardano/tools/db-analyser/Analysis.hs b/ouroboros-consensus-cardano/tools/db-analyser/Analysis.hs
@@ -61,6 +61,7 @@ data AnalysisName =
   | ShowEBBs
   | OnlyValidation
   | StoreLedgerStateAt SlotNo
+  | CountBlocks
   deriving Show
 
 runAnalysis ::
@@ -77,6 +78,7 @@ runAnalysis ShowBlockTxsSize            = showBlockTxsSize
 runAnalysis ShowEBBs                    = showEBBs
 runAnalysis OnlyValidation              = \_ -> return ()
 runAnalysis (StoreLedgerStateAt slotNo) = storeLedgerStateAt slotNo
+runAnalysis CountBlocks                 = countBlocks
 
 type Analysis blk = AnalysisEnv blk -> IO ()
 
@@ -253,6 +255,18 @@ storeLedgerStateAt slotNo (AnalysisEnv { db, registry, initLedger, cfg, limit, l
            (encodeDisk ccfg)
            (encodeDisk ccfg)
 
+countBlocks ::
+     forall blk .
+     ( HasAnalysis blk
+     )
+  => Analysis blk
+countBlocks (AnalysisEnv { db, registry, initLedger, limit }) = do
+    putStrLn $ "About to count number of blocks ..."
+    counted <- processAll db registry (GetPure ()) initLedger limit 0 process
+    putStrLn $ "Counted: " <> show counted <> " blocks."
+  where
+    process :: Int -> () -> IO Int
+    process count _ = pure $ count + 1
 {-------------------------------------------------------------------------------
   Auxiliary: processing all blocks in the DB
 -------------------------------------------------------------------------------}

diff --git a/ouroboros-consensus-cardano/tools/db-analyser/Main.hs b/ouroboros-consensus-cardano/tools/db-analyser/Main.hs
@@ -145,6 +145,10 @@ parseAnalysis = asum [
         , help "Show all EBBs and their predecessors"
         ]
     , storeLedgerParser
+    , flag' CountBlocks $ mconcat [
+          long "count-blocks"
+        , help "Count number of blocks processed"
+        ]
     , pure OnlyValidation
     ]