LedgerDB: remove replayed blocks counter

It is no longer needed by the predictable snapshotting logic.

Author: amesgen

ouroboros-consensus-cardano/changelog.d/20250630_100310_alexander.esgen_predictable_snapshots.md

@@ -64,7 +64,7 @@ openLedgerDB ::
     , LedgerDB.TestInternals' IO blk
     )
 openLedgerDB lgrDbArgs@LedgerDB.LedgerDbArgs{LedgerDB.lgrFlavorArgs = LedgerDB.LedgerDbFlavorArgsV1 bss} = do
-  (ledgerDB, _, intLedgerDB) <-
+  (ledgerDB, intLedgerDB) <-
     LedgerDB.openDBInternal
       lgrDbArgs
       ( LedgerDB.V1.mkInitDb
@@ -76,7 +76,7 @@ openLedgerDB [email protected]{LedgerDB.lgrFlavorArgs = LedgerDB.L
       genesisPoint
   pure (ledgerDB, intLedgerDB)
 openLedgerDB lgrDbArgs@LedgerDB.LedgerDbArgs{LedgerDB.lgrFlavorArgs = LedgerDB.LedgerDbFlavorArgsV2 args} = do
-  (ledgerDB, _, intLedgerDB) <-
+  (ledgerDB, intLedgerDB) <-
     LedgerDB.openDBInternal
       lgrDbArgs
       ( LedgerDB.V2.mkInitDb

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

@@ -160,7 +160,7 @@ openDBInternal args launchBgTasks = runWithTempRegistry $ do
   (chainDB, testing, env) <- lift $ do
     traceWith tracer $ TraceOpenEvent (OpenedVolatileDB maxSlot)
     traceWith tracer $ TraceOpenEvent StartedOpeningLgrDB
-    (lgrDB, _replayed) <-
+    lgrDB <-
       LedgerDB.openDB
         argsLgrDb
         (ImmutableDB.streamAPI immutableDB)

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl.hs

@@ -18,7 +18,6 @@ module Ouroboros.Consensus.Storage.LedgerDB
   ) where
 
 import Data.Functor.Contravariant ((>$<))
-import Data.Word
 import Ouroboros.Consensus.Block
 import Ouroboros.Consensus.HardFork.Abstract
 import Ouroboros.Consensus.Ledger.Inspect
@@ -58,7 +57,7 @@ openDB ::
   Point blk ->
   -- | How to get blocks from the ChainDB
   ResolveBlock m blk ->
-  m (LedgerDB' m blk, Word64)
+  m (LedgerDB' m blk)
 openDB
   args
   stream
@@ -94,11 +93,9 @@ doOpenDB ::
   InitDB db m blk ->
   StreamAPI m blk blk ->
   Point blk ->
-  m (LedgerDB' m blk, Word64)
+  m (LedgerDB' m blk)
 doOpenDB args initDb stream replayGoal =
-  f <$> openDBInternal args initDb stream replayGoal
- where
-  f (ldb, replayCounter, _) = (ldb, replayCounter)
+  fst <$> openDBInternal args initDb stream replayGoal
 
 -- | Open the ledger DB and expose internals for testing purposes
 openDBInternal ::
@@ -111,10 +108,10 @@ openDBInternal ::
   InitDB db m blk ->
   StreamAPI m blk blk ->
   Point blk ->
-  m (LedgerDB' m blk, Word64, TestInternals' m blk)
+  m (LedgerDB' m blk, TestInternals' m blk)
 openDBInternal args@(LedgerDbArgs{lgrHasFS = SomeHasFS fs}) initDb stream replayGoal = do
   createDirectoryIfMissing fs True (mkFsPath [])
-  (_initLog, db, replayCounter) <-
+  (_initLog, db) <-
     initialize
       replayTracer
       snapTracer
@@ -125,7 +122,7 @@ openDBInternal args@(LedgerDbArgs{lgrHasFS = SomeHasFS fs}) initDb stream replay
       initDb
       lgrStartSnapshot
   (ledgerDb, internal) <- mkLedgerDb initDb db
-  return (ledgerDb, replayCounter, internal)
+  return (ledgerDb, internal)
  where
   LedgerDbArgs
     { lgrConfig

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB.hs

@@ -493,7 +493,7 @@ initialize ::
   Point blk ->
   InitDB db m blk ->
   Maybe DiskSnapshot ->
-  m (InitLog blk, db, Word64)
+  m (InitLog blk, db)
 initialize
   replayTracer
   snapTracer
@@ -515,7 +515,6 @@ initialize
       m
         ( InitLog blk
         , db
-        , Word64
         )
     tryNewestFirst acc [] = do
       -- We're out of snapshots. Start at genesis
@@ -536,12 +535,11 @@ initialize
         Left err -> do
           closeDb initDb
           error $ "Invariant violation: invalid immutable chain " <> show err
-        Right (db, replayed) -> do
+        Right db -> do
           db' <- pruneDb dbIface db
           return
             ( acc InitFromGenesis
             , db'
-            , replayed
             )
     tryNewestFirst acc (s : ss) = do
       eInitDb <- initFromSnapshot s
@@ -594,9 +592,9 @@ initialize
               Monad.when (diskSnapshotIsTemporary s) $ deleteSnapshot hasFS s
               closeDb initDb
               tryNewestFirst (acc . InitFailure s err) ss
-            Right (db, replayed) -> do
+            Right db -> do
               db' <- pruneDb dbIface db
-              return (acc (InitFromSnapshot s pt), db', replayed)
+              return (acc (InitFromSnapshot s pt), db')
 
     replayTracer' =
       decorateReplayTracerWithGoal
@@ -620,32 +618,27 @@ replayStartingWith ::
   db ->
   Point blk ->
   InitDB db m blk ->
-  ExceptT (SnapshotFailure blk) m (db, Word64)
+  ExceptT (SnapshotFailure blk) m db
 replayStartingWith tracer cfg stream initDb from InitDB{initReapplyBlock, currentTip} = do
   streamAll
     stream
     from
     InitFailureTooRecent
-    (initDb, 0)
+    initDb
     push
  where
-  push ::
-    blk ->
-    (db, Word64) ->
-    m (db, Word64)
-  push blk (!db, !replayed) = do
+  push :: blk -> db -> m db
+  push blk !db = do
     !db' <- initReapplyBlock cfg blk db
 
-    let !replayed' = replayed + 1
-
-        events =
+    let events =
           inspectLedger
             (getExtLedgerCfg (ledgerDbCfg cfg))
             (currentTip db)
             (currentTip db')
 
     traceWith tracer (ReplayedBlock (blockRealPoint blk) events)
-    return (db', replayed')
+    return db'
 
 {-------------------------------------------------------------------------------
   Trace replay events

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/API.hs

@@ -238,12 +238,11 @@ initLedgerDB s c = do
           , lgrStartSnapshot = Nothing
           }
   ldb <-
-    fst
-      <$> LedgerDB.openDB
-        args
-        streamAPI
-        (Chain.headPoint c)
-        (\rpt -> pure $ fromMaybe (error "impossible") $ Chain.findBlock ((rpt ==) . blockRealPoint) c)
+    LedgerDB.openDB
+      args
+      streamAPI
+      (Chain.headPoint c)
+      (\rpt -> pure $ fromMaybe (error "impossible") $ Chain.findBlock ((rpt ==) . blockRealPoint) c)
 
   result <-
     LedgerDB.validateFork

ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/LocalStateQuery/Server.hs

@@ -486,7 +486,7 @@ openLedgerDB flavArgs env cfg fs = do
           rr
           DefaultQueryBatchSize
           Nothing
-  (ldb, _, od) <- case flavArgs of
+  (ldb, od) <- case flavArgs of
     LedgerDbFlavorArgsV1 bss ->
       let initDb =
             V1.mkInitDb