Skip to content

[Leios prototype] Correct EB application, mempool partitioning #2047

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

Open
bladyjoker wants to merge 2 commits into
base: leios-prototype
Choose a base branch
from
Open

[Leios prototype] Correct EB application, mempool partitioning #2047

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
98d7021
leios: Prettify Shelley applyBlock
bladyjoker May 20, 2026
9abae5a
leios: Prettify Shelley applyTick
bladyjoker May 20, 2026
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
232 changes: 96 additions & 136 deletions ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,6 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
Expand Down Expand Up @@ -59,7 +58,6 @@ module Ouroboros.Consensus.Shelley.Ledger.Ledger
, toTxSeq
) where

import qualified Cardano.Ledger.BHeaderView as SL (BHeaderView)
import qualified Cardano.Ledger.BaseTypes as SL (epochInfoPure)
import Cardano.Ledger.BaseTypes.NonZero (unNonZero)
import qualified Cardano.Ledger.Binary as CB
Expand Down Expand Up @@ -101,7 +99,7 @@ import qualified Codec.CBOR.Decoding as CBOR
import Codec.CBOR.Encoding (Encoding)
import qualified Codec.CBOR.Encoding as CBOR
import Codec.Serialise (decode, encode)
import Control.Arrow (left, second)
import Control.Arrow (left)
import qualified Control.Exception as Exception
import Control.Monad.Except
import qualified Control.State.Transition.Extended as STS
Expand Down Expand Up @@ -565,35 +563,31 @@ instance ShelleyBasedEra era => IsLedger (LedgerState (ShelleyBlock proto era))
, shelleyLedgerTransition
, shelleyCumulativeTxBytes
} =
appTick globals shelleyLedgerState slotNo <&> \l' ->
TickedShelleyLedgerState
{ untickedShelleyLedgerTip = shelleyLedgerTip
, tickedShelleyLedgerTransition =
-- The voting resets each epoch
if isNewEpoch ei (shelleyTipSlotNo <$> shelleyLedgerTip) slotNo
then
ShelleyTransitionInfo{shelleyAfterVoting = 0}
else
shelleyLedgerTransition
, tickedShelleyLedgerState = l'
, -- The UTxO set is only mutated by block/transaction execution and
-- era translations, that is why we put empty tables here.
tickedShelleyLedgerTables = emptyLedgerTables
, tickedShelleyCumulativeTxBytes = shelleyCumulativeTxBytes
let
globals = shelleyLedgerGlobals cfg

ei :: EpochInfo Identity
ei = SL.epochInfoPure globals

(newEpochState, events) = case evs of
ComputeLedgerEvents -> SL.applyTick STS.EPReturn globals shelleyLedgerState slotNo
OmitLedgerEvents -> (SL.applyTickNoEvents globals shelleyLedgerState slotNo, [])
in
LedgerResult
{ lrEvents = ShelleyLedgerEventTICK <$> events
, lrResult =
TickedShelleyLedgerState
{ untickedShelleyLedgerTip = shelleyLedgerTip
, tickedShelleyLedgerTransition =
-- The voting resets each epoch
if isNewEpoch ei (shelleyTipSlotNo <$> shelleyLedgerTip) slotNo
then ShelleyTransitionInfo{shelleyAfterVoting = 0}
else shelleyLedgerTransition
, tickedShelleyLedgerState = newEpochState
, tickedShelleyLedgerTables = emptyLedgerTables
, tickedShelleyCumulativeTxBytes = shelleyCumulativeTxBytes
}
}
where
globals = shelleyLedgerGlobals cfg

ei :: EpochInfo Identity
ei = SL.epochInfoPure globals

appTick =
uncurry (flip LedgerResult) ..: case evs of
ComputeLedgerEvents ->
second (map ShelleyLedgerEventTICK)
..: SL.applyTick STS.EPReturn
OmitLedgerEvents ->
(,[]) ..: SL.applyTickNoEvents

-- | All events emitted by the Shelley ledger API
data ShelleyLedgerEvent era
Expand All @@ -616,18 +610,77 @@ instance
-- - 'updateChainDepState': executes the @PRTCL@ transition
-- + 'applyBlockLedgerResult': executes the @BBODY@ transition
--
applyBlockLedgerResultWithValidation doValidate evs =
liftEither ..: applyHelper appBlk
where
-- Apply the BBODY transition using the ticked state
appBlk =
fmap (uncurry (flip LedgerResult)) ..: case evs of
ComputeLedgerEvents ->
fmap (second (map ShelleyLedgerEventBBODY))
..: SL.applyBlockEither STS.EPReturn doValidate
OmitLedgerEvents ->
fmap (,[])
..: SL.applyBlockEitherNoEvents doValidate
applyBlockLedgerResultWithValidation doValidate evs cfg blk st = liftEither $ do
let TickedShelleyLedgerState
{ tickedShelleyLedgerTransition
, tickedShelleyLedgerState
} = stowLedgerTables st

globals = shelleyLedgerGlobals cfg
swindow = SL.stabilityWindow globals

ei :: EpochInfo Identity
ei = SL.epochInfoPure globals

-- The start of the next epoch is within the safe zone, always.
startOfNextEpoch :: SlotNo
startOfNextEpoch = runIdentity $ do
blockEpoch <- epochInfoEpoch ei (blockSlot blk)
let nextEpoch = succ blockEpoch
epochInfoFirst ei nextEpoch

-- The block must come in strictly before the voting deadline
-- See Fig 13, "Protocol Parameter Update Inference Rules", of the
-- Shelley specification.
votingDeadline :: SlotNo
votingDeadline = subSlots (2 * swindow) startOfNextEpoch

b = shelleyBlockRaw blk
block =
-- Jared Corduan explains that the " Unsafe " here ultimately only
-- means the value must not be serialized. We're only passing it to
-- 'STS.applyBlockOpts', which does not serialize it. So this is a
-- safe use.
SL.UnsafeUnserialisedBlock (mkHeaderView (SL.bheader b)) (SL.bbody b)

(newEpochState, events) <-
case evs of
ComputeLedgerEvents -> SL.applyBlockEither STS.EPReturn doValidate globals tickedShelleyLedgerState block
OmitLedgerEvents -> do
newState <- SL.applyBlockEitherNoEvents doValidate globals tickedShelleyLedgerState block
return (newState, [])

let track = calculateDifference st

return
LedgerResult
{ lrEvents = ShelleyLedgerEventBBODY <$> events
, lrResult =
trackingToDiffs $
track $
unstowLedgerTables $
ShelleyLedgerState
{ shelleyLedgerTip =
NotOrigin
ShelleyTip
{ shelleyTipBlockNo = blockNo blk
, shelleyTipSlotNo = blockSlot blk
, shelleyTipHash = blockHash blk
}
, shelleyLedgerState = newEpochState
, shelleyLedgerTransition =
ShelleyTransitionInfo
{ shelleyAfterVoting =
-- We count the number of blocks that have been applied after the
-- voting deadline has passed.
(if blockSlot blk >= votingDeadline then succ else id) $
shelleyAfterVoting tickedShelleyLedgerTransition
}
, shelleyLedgerTables = emptyLedgerTables
, shelleyCumulativeTxBytes =
tickedShelleyCumulativeTxBytes st + blockTxBytes blk
}
}

applyBlockLedgerResult = defaultApplyBlockLedgerResult

Expand All @@ -650,99 +703,6 @@ instance Show ShelleyReapplyException where

instance Exception.Exception ShelleyReapplyException

applyHelper ::
forall proto era.
ShelleyCompatible proto era =>
( SL.Globals ->
SL.NewEpochState era ->
SL.Block SL.BHeaderView era ->
Either
(SL.BlockTransitionError era)
( LedgerResult
(LedgerState (ShelleyBlock proto era))
(SL.NewEpochState era)
)
) ->
LedgerConfig (ShelleyBlock proto era) ->
ShelleyBlock proto era ->
Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK ->
Either
(SL.BlockTransitionError era)
( LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK)
)
applyHelper f cfg blk stBefore = do
let TickedShelleyLedgerState
{ tickedShelleyLedgerTransition
, tickedShelleyLedgerState
} = stowLedgerTables stBefore

ledgerResult <-
f
globals
tickedShelleyLedgerState
( let b = shelleyBlockRaw blk
h' = mkHeaderView (SL.bheader b)
in -- Jared Corduan explains that the " Unsafe " here ultimately only
-- means the value must not be serialized. We're only passing it to
-- 'STS.applyBlockOpts', which does not serialize it. So this is a
-- safe use.
SL.UnsafeUnserialisedBlock h' (SL.bbody b)
)

let track ::
LedgerState (ShelleyBlock proto era) ValuesMK ->
LedgerState (ShelleyBlock proto era) TrackingMK
track = calculateDifference stBefore

return $
ledgerResult <&> \newNewEpochState ->
trackingToDiffs $
track $
unstowLedgerTables $
ShelleyLedgerState
{ shelleyLedgerTip =
NotOrigin
ShelleyTip
{ shelleyTipBlockNo = blockNo blk
, shelleyTipSlotNo = blockSlot blk
, shelleyTipHash = blockHash blk
}
, shelleyLedgerState =
newNewEpochState
, shelleyLedgerTransition =
ShelleyTransitionInfo
{ shelleyAfterVoting =
-- We count the number of blocks that have been applied after the
-- voting deadline has passed.
(if blockSlot blk >= votingDeadline then succ else id) $
shelleyAfterVoting tickedShelleyLedgerTransition
}
, shelleyLedgerTables = emptyLedgerTables
, shelleyCumulativeTxBytes =
tickedShelleyCumulativeTxBytes stBefore + blockTxBytes blk
}
where
globals = shelleyLedgerGlobals cfg
swindow = SL.stabilityWindow globals

ei :: EpochInfo Identity
ei = SL.epochInfoPure globals

-- The start of the next epoch is within the safe zone, always.
startOfNextEpoch :: SlotNo
startOfNextEpoch = runIdentity $ do
blockEpoch <- epochInfoEpoch ei (blockSlot blk)
let nextEpoch = succ blockEpoch
epochInfoFirst ei nextEpoch

-- The block must come in strictly before the voting deadline
-- See Fig 13, "Protocol Parameter Update Inference Rules", of the
-- Shelley specification.
votingDeadline :: SlotNo
votingDeadline = subSlots (2 * swindow) startOfNextEpoch

instance HasHardForkHistory (ShelleyBlock proto era) where
type HardForkIndices (ShelleyBlock proto era) = '[ShelleyBlock proto era]
hardForkSummary =
Expand Down
Loading