@@ -33,27 +33,20 @@ import qualified Cardano.Chain.Genesis as CC.Genesis
33
33
import qualified Cardano.Chain.Update as CC.Update
34
34
import Cardano.Crypto.DSIGN (Ed25519DSIGN )
35
35
import Cardano.Crypto.Hash.Blake2b (Blake2b_224 , Blake2b_256 )
36
- import qualified Cardano.Ledger.BaseTypes as SL
37
- import qualified Cardano.Ledger.Core as Core
38
36
import Cardano.Ledger.Crypto (ADDRHASH , Crypto , DSIGN , HASH )
39
37
import qualified Cardano.Ledger.Era as SL
40
38
import qualified Cardano.Ledger.Genesis as SL
41
39
import Cardano.Ledger.Hashes (EraIndependentTxBody )
42
40
import Cardano.Ledger.Keys (DSignable , Hash )
43
41
import qualified Cardano.Ledger.Shelley.API as SL
44
- import qualified Cardano.Ledger.Shelley.LedgerState as SL
45
42
import Cardano.Ledger.Shelley.Translation
46
43
(toFromByronTranslationContext )
47
44
import qualified Cardano.Protocol.TPraos.API as SL
48
45
import qualified Cardano.Protocol.TPraos.Rules.Prtcl as SL
49
46
import qualified Cardano.Protocol.TPraos.Rules.Tickn as SL
50
- import Cardano.Slotting.EpochInfo (epochInfoFirst )
51
47
import Control.Monad
52
48
import Control.Monad.Except (runExcept , throwError )
53
- import qualified Control.State.Transition as STS
54
49
import Data.Coerce (coerce )
55
- import Data.Function ((&) )
56
- import Data.Functor.Identity
57
50
import qualified Data.Map.Strict as Map
58
51
import Data.Maybe (listToMaybe , mapMaybe )
59
52
import Data.Proxy
@@ -62,11 +55,8 @@ import Data.SOP.InPairs (RequiringBoth (..), ignoringBoth)
62
55
import qualified Data.SOP.Strict as SOP
63
56
import Data.SOP.Tails (Tails (.. ))
64
57
import qualified Data.SOP.Tails as Tails
65
- import Data.Void
66
58
import Data.Word
67
59
import GHC.Generics (Generic )
68
- import Lens.Micro ((.~) )
69
- import Lens.Micro.Extras (view )
70
60
import NoThunks.Class (NoThunks )
71
61
import Ouroboros.Consensus.Block
72
62
import Ouroboros.Consensus.Byron.Ledger
@@ -719,66 +709,16 @@ translateValidatedTxAlonzoToBabbageWrapper ctxt = InjectValidatedTx $
719
709
-------------------------------------------------------------------------------}
720
710
721
711
translateLedgerStateBabbageToConwayWrapper ::
722
- forall c . (Praos. PraosCrypto c )
712
+ (Praos. PraosCrypto c )
723
713
=> RequiringBoth
724
714
WrapLedgerConfig
725
715
(Translate LedgerState )
726
716
(ShelleyBlock (Praos c ) (BabbageEra c ))
727
717
(ShelleyBlock (Praos c ) (ConwayEra c ))
728
718
translateLedgerStateBabbageToConwayWrapper =
729
- RequireBoth $ \ cfgBabbage cfgConway ->
730
- Translate $ \ epochNo ->
731
- let -- It would be cleaner to just pass in the entire 'Bound' instead of
732
- -- just the 'EpochNo'.
733
- firstSlotNewEra = runIdentity $ epochInfoFirst ei epochNo
734
- where
735
- ei =
736
- SL. epochInfoPure
737
- $ shelleyLedgerGlobals
738
- $ unwrapLedgerConfig cfgConway
739
-
740
- -- HACK to make sure protocol parameters get properly updated on the
741
- -- era transition from Babbage to Conway. This will be replaced by a
742
- -- more principled refactoring in the future.
743
- --
744
- -- Pre-Conway, protocol parameters (like the ledger protocol
745
- -- version) were updated by the UPEC rule, which is executed while
746
- -- ticking across an epoch boundary. If sufficiently many Genesis
747
- -- keys submitted the same update proposal, it will update the
748
- -- governance state accordingly.
749
- --
750
- -- Conway has a completely different governance scheme (CIP-1694),
751
- -- and thus has no representation for pre-Conway update proposals,
752
- -- which are hence discarded by 'SL.translateEra'' below. Therefore,
753
- -- we monkey-patch the governance state by ticking across the
754
- -- era/epoch boundary using Babbage logic, and set the governance
755
- -- state to the updated one /before/ translating.
756
- patchGovState ::
757
- LedgerState (ShelleyBlock proto (BabbageEra c ))
758
- -> LedgerState (ShelleyBlock proto (BabbageEra c ))
759
- patchGovState st =
760
- st { shelleyLedgerState = shelleyLedgerState st
761
- & SL. newEpochStateGovStateL .~ newGovState
762
- }
763
- where
764
- newGovState =
765
- view SL. newEpochStateGovStateL
766
- . tickedShelleyLedgerState
767
- . applyChainTick
768
- (unwrapLedgerConfig cfgBabbage)
769
- firstSlotNewEra
770
- $ st
771
-
772
- -- The UPEC rule emits no ledger events, hence this hack is not
773
- -- swallowing anything.
774
- _upecNoLedgerEvents ::
775
- STS. Event (Core. EraRule " UPEC" (BabbageEra c )) :~: Void
776
- _upecNoLedgerEvents = Refl
777
-
778
- in unComp
779
- . SL. translateEra' (getConwayTranslationContext cfgConway)
780
- . Comp
781
- . patchGovState
719
+ RequireBoth $ \ _cfgBabbage cfgConway ->
720
+ Translate $ \ _epochNo ->
721
+ unComp . SL. translateEra' (getConwayTranslationContext cfgConway) . Comp
782
722
783
723
getConwayTranslationContext ::
784
724
WrapLedgerConfig (ShelleyBlock (Praos c ) (ConwayEra c ))
0 commit comments