stuff

IntersectMBO · Jun 28, 2023 · b42a401 · b42a401
1 parent 8e490ab
commit b42a401
Showing 1 changed file with 21 additions and 16 deletions.
diff --git a/cardano-api/internal/Cardano/Api/LedgerState.hs b/cardano-api/internal/Cardano/Api/LedgerState.hs
@@ -269,7 +269,8 @@ initialLedgerState nodeConfigFile = do
 
 -- | Apply a single block to the current ledger state.
 applyBlock
-  :: Env
+  :: CardanoEra era
+  -> Env
   -- ^ The environment returned by @initialLedgerState@
   -> LedgerState
   -- ^ The current ledger state
@@ -278,7 +279,7 @@ applyBlock
   -- ^ Some block to apply
   -> Either LedgerStateError (LedgerState, [LedgerEvent era])
   -- ^ The new ledger state (or an error).
-applyBlock env oldState validationMode block
+applyBlock era env oldState validationMode block
   = applyBlock' env oldState validationMode $ case block of
       ByronBlock byronBlock -> Consensus.BlockByron byronBlock
       ShelleyBlock blockEra shelleyBlock -> case blockEra of
@@ -345,7 +346,8 @@ renderFoldBlocksError fbe = case fbe of
 -- the node's tip where @k@ is the security parameter.
 foldBlocks
   :: forall a era. ()
-  => NodeConfigFile 'In
+  => CardanoEra era
+  -> NodeConfigFile 'In
   -- ^ Path to the cardano-node config file (e.g. <path to cardano-node project>/configuration/cardano/mainnet-config.json)
   -> SocketPath
   -- ^ Path to local cardano-node socket. This is the path specified by the @--socket-path@ command line option when running the node.
@@ -372,7 +374,7 @@ foldBlocks
   -- truncating the last k blocks before the node's tip.
   -> ExceptT FoldBlocksError IO a
   -- ^ The final state
-foldBlocks nodeConfigFilePath socketPath validationMode state0 accumulate = do
+foldBlocks era nodeConfigFilePath socketPath validationMode state0 accumulate = do
   -- NOTE this was originally implemented with a non-pipelined client then
   -- changed to a pipelined client for a modest speedup:
   --  * Non-pipelined: 1h  0m  19s
@@ -456,7 +458,7 @@ foldBlocks nodeConfigFilePath socketPath validationMode state0 accumulate = do
             :: WithOrigin BlockNo
             -> WithOrigin BlockNo
             -> Nat n -- Number of requests inflight.
-            -> LedgerStateHistory
+            -> LedgerStateHistory era
             -> CSP.ClientPipelinedStIdle n (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
           clientIdle_RequestMoreN clientTip serverTip n knownLedgerStates
             = case pipelineDecisionMax pipelineSize n clientTip serverTip  of
@@ -466,12 +468,13 @@ foldBlocks nodeConfigFilePath socketPath validationMode state0 accumulate = do
 
           clientNextN
             :: Nat n -- Number of requests inflight.
-            -> LedgerStateHistory
+            -> LedgerStateHistory era
             -> CSP.ClientStNext n (BlockInMode CardanoMode) ChainPoint ChainTip IO ()
           clientNextN n knownLedgerStates =
             CSP.ClientStNext {
                 CSP.recvMsgRollForward = \blockInMode@(BlockInMode block@(Block (BlockHeader slotNo _ currBlockNo) _) _era) serverChainTip -> do
                   let newLedgerStateE = applyBlock
+                        era
                         env
                         (maybe
                           (error "Impossible! Missing Ledger state")
@@ -563,9 +566,9 @@ chainSyncClientWithLedgerState env ledgerState0 validationMode (CS.ChainSyncClie
   = CS.ChainSyncClient (goClientStIdle (Right initialLedgerStateHistory) <$> clientTop)
   where
     goClientStIdle
-      :: Either LedgerStateError (History (Either LedgerStateError LedgerStateEvents))
-      -> CS.ClientStIdle (BlockInMode CardanoMode, Either LedgerStateError (LedgerState, [LedgerEvent])) ChainPoint ChainTip m a
-      -> CS.ClientStIdle (BlockInMode CardanoMode                                                      ) ChainPoint ChainTip m a
+      :: Either LedgerStateError (History (Either LedgerStateError (LedgerStateEvents era)))
+      -> CS.ClientStIdle (BlockInMode CardanoMode, Either LedgerStateError (LedgerState, [LedgerEvent era])) ChainPoint ChainTip m a
+      -> CS.ClientStIdle (BlockInMode CardanoMode                                                          ) ChainPoint ChainTip m a
     goClientStIdle history client = case client of
       CS.SendMsgRequestNext a b -> CS.SendMsgRequestNext (goClientStNext history a) (goClientStNext history <$> b)
       CS.SendMsgFindIntersect ps a -> CS.SendMsgFindIntersect ps (goClientStIntersect history a)
@@ -574,9 +577,9 @@ chainSyncClientWithLedgerState env ledgerState0 validationMode (CS.ChainSyncClie
     -- This is where the magic happens. We intercept the blocks and rollbacks
     -- and use it to maintain the correct ledger state.
     goClientStNext
-      :: Either LedgerStateError (History (Either LedgerStateError LedgerStateEvents))
-      -> CS.ClientStNext (BlockInMode CardanoMode, Either LedgerStateError (LedgerState, [LedgerEvent])) ChainPoint ChainTip m a
-      -> CS.ClientStNext (BlockInMode CardanoMode                                                      ) ChainPoint ChainTip m a
+      :: Either LedgerStateError (History (Either LedgerStateError (LedgerStateEvents era)))
+      -> CS.ClientStNext (BlockInMode CardanoMode, Either LedgerStateError (LedgerState, [LedgerEvent era])) ChainPoint ChainTip m a
+      -> CS.ClientStNext (BlockInMode CardanoMode                                                          ) ChainPoint ChainTip m a
     goClientStNext (Left err) (CS.ClientStNext recvMsgRollForward recvMsgRollBackward) = CS.ClientStNext
       (\blkInMode tip -> CS.ChainSyncClient $
             goClientStIdle (Left err) <$> CS.runChainSyncClient
@@ -614,8 +617,8 @@ chainSyncClientWithLedgerState env ledgerState0 validationMode (CS.ChainSyncClie
 
     goClientStIntersect
       :: Either LedgerStateError (History (Either LedgerStateError (LedgerStateEvents era)))
-      -> CS.ClientStIntersect (BlockInMode CardanoMode, Either LedgerStateError (LedgerState, [LedgerEvent])) ChainPoint ChainTip m a
-      -> CS.ClientStIntersect (BlockInMode CardanoMode                                                      ) ChainPoint ChainTip m a
+      -> CS.ClientStIntersect (BlockInMode CardanoMode, Either LedgerStateError (LedgerState, [LedgerEvent era])) ChainPoint ChainTip m a
+      -> CS.ClientStIntersect (BlockInMode CardanoMode                                                          ) ChainPoint ChainTip m a
     goClientStIntersect history (CS.ClientStIntersect recvMsgIntersectFound recvMsgIntersectNotFound) = CS.ClientStIntersect
       (\point tip -> CS.ChainSyncClient (goClientStIdle history <$> CS.runChainSyncClient (recvMsgIntersectFound point tip)))
       (\tip -> CS.ChainSyncClient (goClientStIdle history <$> CS.runChainSyncClient (recvMsgIntersectNotFound tip)))
@@ -627,7 +630,8 @@ chainSyncClientWithLedgerState env ledgerState0 validationMode (CS.ChainSyncClie
 chainSyncClientPipelinedWithLedgerState
   :: forall m a era.
      Monad m
-  => Env
+  => CardanoEra era
+  -> Env
   -> LedgerState
   -> ValidationMode
   -> CSP.ChainSyncClientPipelined
@@ -642,7 +646,7 @@ chainSyncClientPipelinedWithLedgerState
                         ChainTip
                         m
                         a
-chainSyncClientPipelinedWithLedgerState env ledgerState0 validationMode (CSP.ChainSyncClientPipelined clientTop)
+chainSyncClientPipelinedWithLedgerState era env ledgerState0 validationMode (CSP.ChainSyncClientPipelined clientTop)
   = CSP.ChainSyncClientPipelined (goClientPipelinedStIdle (Right initialLedgerStateHistory) Zero <$> clientTop)
   where
     goClientPipelinedStIdle
@@ -679,6 +683,7 @@ chainSyncClientPipelinedWithLedgerState env ledgerState0 validationMode (CSP.Cha
             Nothing -> error "Impossible! History should always be non-empty"
             Just (_, Left err, _) -> Left err
             Just (_, Right (oldLedgerState, _), _) -> applyBlock
+                  era
                   env
                   oldLedgerState
                   validationMode