From b42a40169f4bc43fd6c3f5c8f4f9024392d0d9a6 Mon Sep 17 00:00:00 2001 From: John Ky Date: Wed, 28 Jun 2023 23:15:49 +1000 Subject: [PATCH] stuff --- .../internal/Cardano/Api/LedgerState.hs | 37 +++++++++++-------- 1 file changed, 21 insertions(+), 16 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/LedgerState.hs b/cardano-api/internal/Cardano/Api/LedgerState.hs index 8752239942..1e2e477f6f 100644 --- 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. /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