Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Modify foldBlocks to recurse on ledger events #353

Merged
merged 1 commit into from
Nov 6, 2023
Merged

Modify foldBlocks to recurse on ledger events #353

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
45 changes: 30 additions & 15 deletions cardano-api/internal/Cardano/Api/LedgerState.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It feels that we should use an underlying monad in ClientStNext to store state instead of using IORef.

CSP.ClientStNext n BlockInMode ChainPoint ChainTip (StateT s IO) ()

would be cleaner I think.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can you open a PR after this one? I'd be interested to see what you have in mind.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I took a closer look and it does not seem to be worth the effort. My point was to be able to use state monad in the protocol client to store the state (including an error). The problem with that is the change is quite extensive: we'd have to parameterize types used in the client e.g. LocalNodeClientProtocolsForBlock by an underlying monad additionally.
Moreover, the code in consensus we use has IO hardcoded there in the function argument e.g.:

connectTo :: forall a b.
LocalSnocket
-> NetworkConnectTracers LocalAddress NodeToClientVersion
-> Versions
     NodeToClientVersion
     NodeToClientVersionData
     (OuroborosApplicationWithMinimalCtx
        'InitiatorMode LocalAddress ByteString IO a b)
-> FilePath
-> IO ()

This would require unlifting state into IO and then lifting it again, which is cumbersome.

In the end the semantics would be pretty much the same, but with more boilerplate.

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
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down