From e666b3273ecd70d306b283829fea9b1b75c3413f Mon Sep 17 00:00:00 2001
From: Jordan Millar <jordan.millar@iohk.io>
Date: Fri, 3 Nov 2023 10:55:47 -0400
Subject: [PATCH] Modify foldBlocks to recurse on ledger events instead of
 mapping over them

---
 .../internal/Cardano/Api/LedgerState.hs       | 45 ++++++++++++-------
 1 file changed, 30 insertions(+), 15 deletions(-)

diff --git a/cardano-api/internal/Cardano/Api/LedgerState.hs b/cardano-api/internal/Cardano/Api/LedgerState.hs
index 415a09dcd1..7baee270f3 100644
--- a/cardano-api/internal/Cardano/Api/LedgerState.hs
+++ b/cardano-api/internal/Cardano/Api/LedgerState.hs
@@ -509,20 +509,39 @@ foldBlocks nodeConfigFilePath socketPath validationMode state0 accumulate = do
                       let (knownLedgerStates', committedStates) = pushLedgerState env knownLedgerStates slotNo newLedgerState blockInMode
                           newClientTip = At currBlockNo
                           newServerTip = fromChainTip serverChainTip
-                      -- TODO: We are constantly overwriting an IORef which isn't ideal.
 
-                      foldStatuses <- forM knownLedgerStates' $ \(_, (ledgerState, ledgerEvents), currBlockMay) -> case currBlockMay of
-                          Origin -> pure ContinueFold
-                          At currBlock -> do
+                          ledgerStateSingleFold
+                            :: (SlotNo, (LedgerState, [LedgerEvent]), WithOrigin BlockInMode) -- Ledger events for a single block
+                            -> IO FoldStatus
+                          ledgerStateSingleFold (_, _, Origin) = return ContinueFold
+                          ledgerStateSingleFold (_, (ledgerState, ledgerEvents), At currBlock) = do
+                            accumulatorState <- readIORef stateIORef
                             (newState, foldStatus) <- accumulate
-                              env
-                              ledgerState
-                              ledgerEvents
-                              currBlock
-                              =<< readIORef stateIORef
+                                                      env
+                                                      ledgerState
+                                                      ledgerEvents
+                                                      currBlock
+                                                      accumulatorState
                             atomicWriteIORef stateIORef newState
                             return foldStatus
-                      case foldDecision foldStatuses of
+
+                          ledgerStateRecurser
+                            :: Seq (SlotNo, LedgerStateEvents, WithOrigin BlockInMode) -- Ledger events for multiple blocks
+                            -> IO FoldStatus
+                          ledgerStateRecurser states = go (toList states) ContinueFold
+                            where
+                              go [] foldStatus = return foldStatus
+                              go (s : rest) ContinueFold = do
+                                newFoldStatus <- ledgerStateSingleFold s
+                                go rest newFoldStatus
+                              go _          StopFold    = go [] StopFold
+                              go _          DebugFold   = go [] DebugFold
+
+                      -- NB: knownLedgerStates' is the new ledger state history i.e k blocks from the tip
+                      -- or also known as the mutable blocks. We default to using the mutable blocks.
+                      finalFoldStatus <- ledgerStateRecurser knownLedgerStates'
+
+                      case finalFoldStatus of
                         StopFold ->
                           -- We return StopFold in our accumulate function if we want to terminate the fold.
                           -- This allow us to check for a specific condition in our accumulate function
@@ -557,6 +576,7 @@ foldBlocks nodeConfigFilePath socketPath validationMode state0 accumulate = do
                   return (clientIdle_RequestMoreN newClientTip newServerTip n truncatedKnownLedgerStates)
               }
 
+
           clientIdle_DoneNwithMaybeError
             :: Nat n -- Number of requests inflight.
             -> Maybe LedgerStateError -- Return value (maybe an error)
@@ -582,11 +602,6 @@ foldBlocks nodeConfigFilePath socketPath validationMode state0 accumulate = do
             ChainTipAtGenesis -> Origin
             ChainTip _ _ bno -> At bno
 
-foldDecision :: Seq FoldStatus -> FoldStatus
-foldDecision foldStatuses
-  | StopFold `List.elem` toList foldStatuses = StopFold
-  | DebugFold `List.elem` toList foldStatuses = DebugFold
-  | otherwise = ContinueFold
 
 -- | Wrap a 'ChainSyncClient' with logic that tracks the ledger state.
 chainSyncClientWithLedgerState