Skip to content

Commit a2e7828

Browse files
amesgennfrisby
amesgen
and
nfrisby
committed
HFC: generalize cross era ticking
Co-authored-by: Nicolas Frisby <[email protected]>
1 parent 05861ac commit a2e7828

File tree

16 files changed

+410
-532
lines changed

16 files changed

+410
-532
lines changed

‎ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Ledger.hs

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -83,6 +83,7 @@ import Ouroboros.Consensus.Ledger.Query
8383
import Ouroboros.Consensus.Ledger.SupportsPeerSelection
8484
import Ouroboros.Consensus.Ledger.SupportsProtocol
8585
import Ouroboros.Consensus.Protocol.PBFT
86+
import Ouroboros.Consensus.TypeFamilyWrappers
8687
import Ouroboros.Consensus.Util (ShowProxy (..), (..:))
8788

8889
{-------------------------------------------------------------------------------
@@ -164,6 +165,7 @@ getByronTip state =
164165
-- | The ticked Byron ledger state
165166
data instance Ticked (LedgerState ByronBlock) = TickedByronLedgerState {
166167
tickedByronLedgerState :: !CC.ChainValidationState
168+
, untickedByronLedgerTipBlockNo :: !(WithOrigin BlockNo)
167169
, untickedByronLedgerTransition :: !ByronTransition
168170
}
169171
deriving (Generic, NoThunks)
@@ -178,6 +180,8 @@ instance IsLedger (LedgerState ByronBlock) where
178180
TickedByronLedgerState {
179181
tickedByronLedgerState =
180182
CC.applyChainTick cfg (toByronSlotNo slotNo) byronLedgerState
183+
, untickedByronLedgerTipBlockNo =
184+
byronLedgerTipBlockNo
181185
, untickedByronLedgerTransition =
182186
byronLedgerTransition
183187
}

‎ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs

Lines changed: 45 additions & 121 deletions
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,9 @@ module Ouroboros.Consensus.Cardano.CanHardFork (
2525
-- * Re-exports of Shelley code
2626
, ShelleyPartialLedgerConfig (..)
2727
, crossEraForecastAcrossShelley
28-
, translateChainDepStateAcrossShelley
28+
, forecastAcrossShelley
29+
, tickChainDepStateAcrossShelley
30+
, tickLedgerStateAcrossShelley
2931
, translateLedgerStateByronToShelley
3032
) where
3133

@@ -53,7 +55,8 @@ import qualified Data.Map.Strict as Map
5355
import Data.Maybe (listToMaybe, mapMaybe)
5456
import Data.Proxy
5557
import Data.SOP.BasicFunctors
56-
import Data.SOP.InPairs (RequiringBoth (..), ignoringBoth)
58+
import Data.SOP.InPairs (RequiringBoth, RequiringBoth' (..),
59+
ignoringBoth)
5760
import qualified Data.SOP.Strict as SOP
5861
import Data.SOP.Tails (Tails (..))
5962
import qualified Data.SOP.Tails as Tails
@@ -68,8 +71,7 @@ import Ouroboros.Consensus.Cardano.Block
6871
import Ouroboros.Consensus.Forecast
6972
import Ouroboros.Consensus.HardFork.Combinator
7073
import Ouroboros.Consensus.HardFork.Combinator.State.Types
71-
import Ouroboros.Consensus.HardFork.History (Bound (boundSlot),
72-
addSlots)
74+
import Ouroboros.Consensus.HardFork.History (Bound (..), addSlots)
7375
import Ouroboros.Consensus.HardFork.Simple
7476
import Ouroboros.Consensus.Ledger.Abstract
7577
import Ouroboros.Consensus.Ledger.SupportsMempool (ByteSize32,
@@ -282,23 +284,23 @@ instance CardanoHardForkConstraints c => CanHardFork (CardanoEras c) where
282284
type HardForkTxMeasure (CardanoEras c) = ConwayMeasure
283285

284286
hardForkEraTranslation = EraTranslation {
285-
translateLedgerState =
286-
PCons translateLedgerStateByronToShelleyWrapper
287-
$ PCons translateLedgerStateShelleyToAllegraWrapper
288-
$ PCons translateLedgerStateAllegraToMaryWrapper
289-
$ PCons translateLedgerStateMaryToAlonzoWrapper
290-
$ PCons translateLedgerStateAlonzoToBabbageWrapper
291-
$ PCons translateLedgerStateBabbageToConwayWrapper
287+
crossEraTickLedgerState =
288+
PCons tickLedgerStateByronToShelley
289+
$ PCons tickLedgerStateAcrossShelley
290+
$ PCons tickLedgerStateAcrossShelley
291+
$ PCons tickLedgerStateAcrossShelley
292+
$ PCons tickLedgerStateAcrossShelley
293+
$ PCons tickLedgerStateAcrossShelley
292294
$ PNil
293-
, translateChainDepState =
294-
PCons translateChainDepStateByronToShelleyWrapper
295-
$ PCons translateChainDepStateAcrossShelley
296-
$ PCons translateChainDepStateAcrossShelley
297-
$ PCons translateChainDepStateAcrossShelley
298-
$ PCons translateChainDepStateAcrossShelley
299-
$ PCons translateChainDepStateAcrossShelley
295+
, crossEraTickChainDepState =
296+
PCons tickChainDepStateByronToShelley
297+
$ PCons tickChainDepStateAcrossShelley
298+
$ PCons tickChainDepStateAcrossShelley
299+
$ PCons tickChainDepStateAcrossShelley
300+
$ PCons tickChainDepStateAcrossShelley
301+
$ PCons tickChainDepStateAcrossShelley
300302
$ PNil
301-
, crossEraForecast =
303+
, crossEraForecast =
302304
PCons crossEraForecastByronToShelleyWrapper
303305
$ PCons crossEraForecastAcrossShelley
304306
$ PCons crossEraForecastAcrossShelley
@@ -324,8 +326,8 @@ instance CardanoHardForkConstraints c => CanHardFork (CardanoEras c) where
324326
translateTxAllegraToMaryWrapper
325327
translateValidatedTxAllegraToMaryWrapper
326328
)
327-
$ PCons (RequireBoth $ \_cfgMary cfgAlonzo ->
328-
let ctxt = getAlonzoTranslationContext cfgAlonzo
329+
$ PCons (RequireBoth $ \_cfgMary (WrapLedgerConfig cfgAlonzo) ->
330+
let ctxt = shelleyLedgerTranslationContext cfgAlonzo
329331
in
330332
Pair2
331333
(translateTxMaryToAlonzoWrapper ctxt)
@@ -338,8 +340,8 @@ instance CardanoHardForkConstraints c => CanHardFork (CardanoEras c) where
338340
(translateTxAlonzoToBabbageWrapper ctxt)
339341
(translateValidatedTxAlonzoToBabbageWrapper ctxt)
340342
)
341-
$ PCons (RequireBoth $ \_cfgBabbage cfgConway ->
342-
let ctxt = getConwayTranslationContext cfgConway
343+
$ PCons (RequireBoth $ \_cfgBabbage (WrapLedgerConfig cfgConway) ->
344+
let ctxt = shelleyLedgerTranslationContext cfgConway
343345
in
344346
Pair2
345347
(translateTxBabbageToConwayWrapper ctxt)
@@ -415,31 +417,34 @@ translatePointByronToShelley point bNo =
415417
_otherwise ->
416418
error "translatePointByronToShelley: invalid Byron state"
417419

418-
translateLedgerStateByronToShelleyWrapper ::
420+
tickLedgerStateByronToShelley ::
419421
( ShelleyCompatible (TPraos c) (ShelleyEra c)
420422
, HASH c ~ Blake2b_256
421423
, ADDRHASH c ~ Blake2b_224
422424
)
423425
=> RequiringBoth
424426
WrapLedgerConfig
425-
(Translate LedgerState)
427+
CrossEraTickLedgerState
426428
ByronBlock
427429
(ShelleyBlock (TPraos c) (ShelleyEra c))
428-
translateLedgerStateByronToShelleyWrapper =
429-
RequireBoth $ \_ (WrapLedgerConfig cfgShelley) -> Translate $
430-
translateLedgerStateByronToShelley
431-
(toFromByronTranslationContext (shelleyLedgerGenesis cfgShelley))
430+
tickLedgerStateByronToShelley =
431+
RequireBoth $ \_ (WrapLedgerConfig cfgShelley) ->
432+
CrossEraTickLedgerState $ \bound slot ->
433+
applyChainTickLedgerResult cfgShelley slot
434+
. translateLedgerStateByronToShelley
435+
(shelleyLedgerTranslationContext cfgShelley)
436+
bound
432437

433438
translateLedgerStateByronToShelley ::
434439
( ShelleyCompatible (TPraos c) (ShelleyEra c)
435440
, HASH c ~ Blake2b_256
436441
, ADDRHASH c ~ Blake2b_224
437442
)
438443
=> SL.FromByronTranslationContext c
439-
-> EpochNo -- ^ Start of the new era
444+
-> Bound -- ^ Start of the new era
440445
-> LedgerState ByronBlock
441446
-> LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))
442-
translateLedgerStateByronToShelley ctx epochNo ledgerByron =
447+
translateLedgerStateByronToShelley ctx bound ledgerByron =
443448
ShelleyLedgerState {
444449
shelleyLedgerTip =
445450
translatePointByronToShelley
@@ -448,23 +453,24 @@ translateLedgerStateByronToShelley ctx epochNo ledgerByron =
448453
, shelleyLedgerState =
449454
SL.translateToShelleyLedgerState
450455
ctx
451-
epochNo
456+
(boundEpoch bound)
452457
(byronLedgerState ledgerByron)
453458
, shelleyLedgerTransition =
454459
ShelleyTransitionInfo{shelleyAfterVoting = 0}
455460
}
456461

457-
translateChainDepStateByronToShelleyWrapper ::
458-
RequiringBoth
462+
tickChainDepStateByronToShelley ::
463+
ConsensusProtocol (TPraos c)
464+
=> RequiringBoth
459465
WrapConsensusConfig
460-
(Translate WrapChainDepState)
466+
CrossEraTickChainDepState
461467
ByronBlock
462468
(ShelleyBlock (TPraos c) (ShelleyEra c))
463-
translateChainDepStateByronToShelleyWrapper =
469+
tickChainDepStateByronToShelley =
464470
RequireBoth $ \_ (WrapConsensusConfig cfgShelley) ->
465-
Translate $ \_ (WrapChainDepState pbftState) ->
466-
WrapChainDepState $
467-
translateChainDepStateByronToShelley cfgShelley pbftState
471+
CrossEraTickChainDepState $ \_bound view slot ->
472+
tickChainDepState cfgShelley view slot
473+
. translateChainDepStateByronToShelley cfgShelley
468474

469475
translateChainDepStateByronToShelley ::
470476
forall bc c.
@@ -555,18 +561,6 @@ crossEraForecastByronToShelleyWrapper =
555561
Translation from Shelley to Allegra
556562
-------------------------------------------------------------------------------}
557563

558-
translateLedgerStateShelleyToAllegraWrapper ::
559-
(PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
560-
=> RequiringBoth
561-
WrapLedgerConfig
562-
(Translate LedgerState)
563-
(ShelleyBlock (TPraos c) (ShelleyEra c))
564-
(ShelleyBlock (TPraos c) (AllegraEra c))
565-
translateLedgerStateShelleyToAllegraWrapper =
566-
ignoringBoth $
567-
Translate $ \_epochNo ->
568-
unComp . SL.translateEra' SL.NoGenesis . Comp
569-
570564
translateTxShelleyToAllegraWrapper ::
571565
(PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
572566
=> InjectTx
@@ -587,18 +581,6 @@ translateValidatedTxShelleyToAllegraWrapper = InjectValidatedTx $
587581
Translation from Allegra to Mary
588582
-------------------------------------------------------------------------------}
589583

590-
translateLedgerStateAllegraToMaryWrapper ::
591-
(PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
592-
=> RequiringBoth
593-
WrapLedgerConfig
594-
(Translate LedgerState)
595-
(ShelleyBlock (TPraos c) (AllegraEra c))
596-
(ShelleyBlock (TPraos c) (MaryEra c))
597-
translateLedgerStateAllegraToMaryWrapper =
598-
ignoringBoth $
599-
Translate $ \_epochNo ->
600-
unComp . SL.translateEra' SL.NoGenesis . Comp
601-
602584
translateTxAllegraToMaryWrapper ::
603585
(PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
604586
=> InjectTx
@@ -619,24 +601,6 @@ translateValidatedTxAllegraToMaryWrapper = InjectValidatedTx $
619601
Translation from Mary to Alonzo
620602
-------------------------------------------------------------------------------}
621603

622-
translateLedgerStateMaryToAlonzoWrapper ::
623-
(PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
624-
=> RequiringBoth
625-
WrapLedgerConfig
626-
(Translate LedgerState)
627-
(ShelleyBlock (TPraos c) (MaryEra c))
628-
(ShelleyBlock (TPraos c) (AlonzoEra c))
629-
translateLedgerStateMaryToAlonzoWrapper =
630-
RequireBoth $ \_cfgMary cfgAlonzo ->
631-
Translate $ \_epochNo ->
632-
unComp . SL.translateEra' (getAlonzoTranslationContext cfgAlonzo) . Comp
633-
634-
getAlonzoTranslationContext ::
635-
WrapLedgerConfig (ShelleyBlock (TPraos c) (AlonzoEra c))
636-
-> SL.TranslationContext (AlonzoEra c)
637-
getAlonzoTranslationContext =
638-
shelleyLedgerTranslationContext . unwrapLedgerConfig
639-
640604
translateTxMaryToAlonzoWrapper ::
641605
(PraosCrypto c, DSignable c (Hash c EraIndependentTxBody))
642606
=> SL.TranslationContext (AlonzoEra c)
@@ -660,28 +624,6 @@ translateValidatedTxMaryToAlonzoWrapper ctxt = InjectValidatedTx $
660624
Translation from Alonzo to Babbage
661625
-------------------------------------------------------------------------------}
662626

663-
translateLedgerStateAlonzoToBabbageWrapper ::
664-
(Praos.PraosCrypto c, TPraos.PraosCrypto c)
665-
=> RequiringBoth
666-
WrapLedgerConfig
667-
(Translate LedgerState)
668-
(ShelleyBlock (TPraos c) (AlonzoEra c))
669-
(ShelleyBlock (Praos c) (BabbageEra c))
670-
translateLedgerStateAlonzoToBabbageWrapper =
671-
RequireBoth $ \_cfgAlonzo _cfgBabbage ->
672-
Translate $ \_epochNo ->
673-
unComp . SL.translateEra' SL.NoGenesis . Comp . transPraosLS
674-
where
675-
transPraosLS ::
676-
LedgerState (ShelleyBlock (TPraos c) (AlonzoEra c)) ->
677-
LedgerState (ShelleyBlock (Praos c) (AlonzoEra c))
678-
transPraosLS (ShelleyLedgerState wo nes st) =
679-
ShelleyLedgerState
680-
{ shelleyLedgerTip = fmap castShelleyTip wo
681-
, shelleyLedgerState = nes
682-
, shelleyLedgerTransition = st
683-
}
684-
685627
translateTxAlonzoToBabbageWrapper ::
686628
(Praos.PraosCrypto c)
687629
=> SL.TranslationContext (BabbageEra c)
@@ -722,24 +664,6 @@ translateValidatedTxAlonzoToBabbageWrapper ctxt = InjectValidatedTx $
722664
Translation from Babbage to Conway
723665
-------------------------------------------------------------------------------}
724666

725-
translateLedgerStateBabbageToConwayWrapper ::
726-
(Praos.PraosCrypto c)
727-
=> RequiringBoth
728-
WrapLedgerConfig
729-
(Translate LedgerState)
730-
(ShelleyBlock (Praos c) (BabbageEra c))
731-
(ShelleyBlock (Praos c) (ConwayEra c))
732-
translateLedgerStateBabbageToConwayWrapper =
733-
RequireBoth $ \_cfgBabbage cfgConway ->
734-
Translate $ \_epochNo ->
735-
unComp . SL.translateEra' (getConwayTranslationContext cfgConway) . Comp
736-
737-
getConwayTranslationContext ::
738-
WrapLedgerConfig (ShelleyBlock (Praos c) (ConwayEra c))
739-
-> SL.TranslationContext (ConwayEra c)
740-
getConwayTranslationContext =
741-
shelleyLedgerTranslationContext . unwrapLedgerConfig
742-
743667
translateTxBabbageToConwayWrapper ::
744668
(Praos.PraosCrypto c)
745669
=> SL.TranslationContext (ConwayEra c)

‎ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Node.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1021,12 +1021,13 @@ protocolInfoCardano paramsCardano
10211021
PNil
10221022
where
10231023
byronToShelleyTranslation =
1024-
Translate $ translateLedgerStateByronToShelley ctx
1024+
CrossEra $ \(Current bound _) ->
1025+
translateLedgerStateByronToShelley ctx bound
10251026
where
10261027
ctx = SL.toFromByronTranslationContext genesisShelley
10271028

10281029
interShelleyTranslation transitionConfig =
1029-
Translate $ \_ -> translateShelleyLedgerState ctx
1030+
CrossEra $ \_ -> translateShelleyLedgerState ctx
10301031
where
10311032
ctx = transitionConfig ^. L.tcTranslationContextL
10321033

‎ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -91,6 +91,7 @@ import Ouroboros.Consensus.Shelley.Ledger.Config
9191
import Ouroboros.Consensus.Shelley.Ledger.Protocol ()
9292
import Ouroboros.Consensus.Shelley.Protocol.Abstract
9393
(EnvelopeCheckError, envelopeChecks, mkHeaderView)
94+
import Ouroboros.Consensus.TypeFamilyWrappers
9495
import Ouroboros.Consensus.Util ((..:))
9596
import Ouroboros.Consensus.Util.CBOR (decodeWithOrigin,
9697
encodeWithOrigin)

0 commit comments

Comments
 (0)