From 647295d7ea5b0f72c8e8975a2aac6adef371709e Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Wed, 13 Apr 2022 14:48:54 +0200 Subject: [PATCH 1/2] CAD-4157: Stash AVVM to allow on-disk UTxO. This commit provides ledger support for the transition of UTxO to on-disk storage. In particular, the translation between Shelley and Allegra is currently problematic, owing to the need to remove AVVM addresses (dormant since Byron) from the UTxO. This requires a linear scan of the UTxO, which is now stored on disk and hence cannot/should not be accessed in such a way. The solution to this is a bit of a hack; since the Byron UTxO are not stored on disk, and since AVVM addresses remain untouched during the Shelley era, we instead perform the scan at the Byron/Shelley boundary, store the set of UTxO in the ledger state, only to yield them to the consensus layer at the Shelley/Allegra boundary. Thus provided with the set of addresses, consensus passes them back as the UTxO, allowing the translation function to delete them. This change is written such that, with no on-disk UTxO, the ledger functionality remains identical, other than a slight bump in memory usage during the Shelley era. As far as possible, this commit minimises ledger changes. Thus, a pattern is introduced replicating the existing `NewEpochState` constructor. Unfortunately, there are two knock-on effects related to weaknesses in pattern synonyms: - A couple of patterns matching on `NewEpochState` now seem to be failable. Since they cannot fail, we instead make them irrefutable. - Record fields associated with pattern synonyms do not play nicely with `NamedFieldPuns`. As such, we replace a couple of puns with explicit bindings. A single additional function `shelleyToAllegraAVVMsToDelete` is exported for the use of the consensus layer. Otherwise no API changes are made. This does entail a change in the ledger state serialisation format. --- .../src/Cardano/Ledger/Allegra/Translation.hs | 13 +++ .../Ledger/Shelley/API/ByronTranslation.hs | 11 +++ .../src/Cardano/Ledger/Shelley/LedgerState.hs | 81 ++++++++++++++----- .../Cardano/Ledger/Shelley/Rules/NewEpoch.hs | 17 ++-- .../src/Cardano/Ledger/Shelley/Rules/Tick.hs | 2 +- .../src/Cardano/Protocol/TPraos/API.hs | 27 +++---- 6 files changed, 107 insertions(+), 44 deletions(-) diff --git a/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra/Translation.hs b/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra/Translation.hs index 82163b6eb7b..17d599ecbf4 100644 --- a/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra/Translation.hs +++ b/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra/Translation.hs @@ -44,6 +44,14 @@ import qualified Data.Map.Strict as Map -- being total. Do not change it! -------------------------------------------------------------------------------- +-- | Return the subset of UTxO corresponding to Byron-era AVVM addresses, which +-- are to be removed on the Shelley/Allegra boundary. This set will be passed +-- _back_ to the translation functions as the UTxO, allowing these addresses to +-- be removed. This is needed because we cannot do a full scan on the UTxO at +-- this point, since it has been persisted to disk. +shelleyToAllegraAVVMsToDelete :: NewEpochState era -> StrictMaybe (UTxO era) +shelleyToAllegraAVVMsToDelete = stashedAVVMAddresses + type instance PreviousEra (AllegraEra c) = ShelleyEra c -- | Currently no context is needed to translate from Shelley to Allegra. @@ -63,6 +71,11 @@ instance Crypto c => TranslateEra (AllegraEra c) NewEpochState where nesRu = nesRu nes, nesPd = nesPd nes } + { -- At this point, the consensus layer has passed in our stashed AVVM + -- addresses as our UTxO, and we have deleted them above (with + -- 'returnRedeemAddrsToReserves'), so we may safely discard this map. + stashedAVVMAddresses = SNothing + } instance forall c. Crypto c => TranslateEra (AllegraEra c) Tx where type TranslationError (AllegraEra c) Tx = DecoderError diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs index a54e81b94b6..3a5afabcb1a 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs @@ -17,10 +17,12 @@ import qualified Cardano.Chain.Common as Byron import qualified Cardano.Chain.UTxO as Byron import qualified Cardano.Crypto.Hash as Crypto import qualified Cardano.Crypto.Hashing as Hashing +import Cardano.Ledger.Address (isBootstrapRedeemer) import Cardano.Ledger.BaseTypes (BlocksMade (..), TxIx (..)) import Cardano.Ledger.Coin (CompactForm (CompactCoin)) import Cardano.Ledger.CompactAddress (CompactAddr (UnsafeCompactAddr)) import qualified Cardano.Ledger.Crypto as CC +import Cardano.Ledger.Era (getTxOutBootstrapAddress) import Cardano.Ledger.SafeHash (unsafeMakeSafeHash) import Cardano.Ledger.Shelley (ShelleyEra) import Cardano.Ledger.Shelley.API.Types @@ -101,6 +103,15 @@ translateToShelleyLedgerState genesisShelley epochNo cvs = nesRu = SNothing, nesPd = PoolDistr Map.empty } + { -- At this point, we compute the stashed AVVM addresses, while we are able + -- to do a linear scan of the UTxO, and stash them away for use at the + -- Shelley/Allegra boundary. + stashedAVVMAddresses = + let UTxO utxo = _utxo . lsUTxOState . esLState $ epochState + redeemers = + SplitMap.filter (maybe False isBootstrapRedeemer . getTxOutBootstrapAddress) utxo + in SJust $ UTxO redeemers + } where pparams :: PParams (ShelleyEra c) pparams = sgProtocolParams genesisShelley diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs index 228fa4d603b..57c649251c4 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs @@ -13,6 +13,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} @@ -83,7 +84,8 @@ module Cardano.Ledger.Shelley.LedgerState startStep, pulseStep, completeStep, - NewEpochState (..), + NewEpochState (NewEpochState, nesEL, nesEs, nesRu, nesPd, nesBprev, nesBcur), + stashedAVVMAddresses, getGKeys, updateNES, circulation, @@ -711,22 +713,50 @@ instance pure UTxOState {_utxo, _deposited, _fees, _ppups, _stakeDistro} -- | New Epoch state and environment -data NewEpochState era = NewEpochState +data NewEpochState era = NewEpochStatePlusAVVM { -- | Last epoch - nesEL :: !EpochNo, + nesPlusEL :: !EpochNo, -- | Blocks made before current epoch - nesBprev :: !(BlocksMade (Crypto era)), + nesPlusBprev :: !(BlocksMade (Crypto era)), -- | Blocks made in current epoch - nesBcur :: !(BlocksMade (Crypto era)), + nesPlusBcur :: !(BlocksMade (Crypto era)), -- | Epoch state before current - nesEs :: !(EpochState era), + nesPlusEs :: !(EpochState era), -- | Possible reward update - nesRu :: !(StrictMaybe (PulsingRewUpdate (Crypto era))), + nesPlusRu :: !(StrictMaybe (PulsingRewUpdate (Crypto era))), -- | Stake distribution within the stake pool - nesPd :: !(PoolDistr (Crypto era)) + nesPlusPd :: !(PoolDistr (Crypto era)), + -- | AVVM addresses to be removed at the end of the Shelley era. Note that + -- the existence of this field is a hack, related to the transition of UTxO + -- to disk. We remove AVVM addresses from the UTxO on the Shelley/Allegra + -- boundary. However, by this point the UTxO will be moved to disk, and + -- hence doing a scan of the UTxO for AVVM addresses will be expensive. Our + -- solution to this is to do a scan of the UTxO on the Byron/Shelley + -- boundary (since Byron UTxO are still on disk), stash the results here, + -- and then remove them at the Shelley/Allegra boundary. + -- + -- This is very much an awkward implementation hack, and hence we hide it + -- from as many places as possible. + stashedAVVMAddresses :: !(StrictMaybe (UTxO era)) } deriving (Generic) +pattern NewEpochState :: + EpochNo -> + BlocksMade (Crypto era) -> + BlocksMade (Crypto era) -> + EpochState era -> + StrictMaybe (PulsingRewUpdate (Crypto era)) -> + PoolDistr (Crypto era) -> + NewEpochState era +pattern NewEpochState {nesEL, nesBprev, nesBcur, nesEs, nesRu, nesPd} <- + NewEpochStatePlusAVVM nesEL nesBprev nesBcur nesEs nesRu nesPd _ + where + NewEpochState el bprev bcur es ru pd = + NewEpochStatePlusAVVM el bprev bcur es ru pd SNothing + +{-# COMPLETE NewEpochState #-} + deriving stock instance ( CC.Crypto (Crypto era), Show (Core.TxOut era), @@ -771,15 +801,22 @@ instance ) => ToCBOR (NewEpochState era) where - toCBOR (NewEpochState e bp bc es ru pd) = - encodeListLen 6 <> toCBOR e <> toCBOR bp <> toCBOR bc <> toCBOR es + toCBOR (NewEpochStatePlusAVVM e bp bc es ru pd av) = + encodeListLen 7 + <> toCBOR e + <> toCBOR bp + <> toCBOR bc + <> toCBOR es <> toCBOR ru <> toCBOR pd + <> toCBOR av instance ( Era era, FromCBOR (Core.PParams era), FromSharedCBOR (Core.TxOut era), + -- This constraint is used only for the AVVM addresses + FromCBOR (Core.TxOut era), Share (Core.TxOut era) ~ Interns (Credential 'Staking (Crypto era)), FromCBOR (Core.Value era), FromCBOR (State (Core.EraRule "PPUP" era)) @@ -788,7 +825,8 @@ instance where fromCBOR = do decode $ - RecD NewEpochState + RecD NewEpochStatePlusAVVM + NewEpochState era updateNES - ( NewEpochState - eL - bprev - _ - (EpochState acnt ss _ pr pp nm) - ru - pd - ) + oldNes@( NewEpochState + _eL + _bprev + _ + (EpochState acnt ss _ pr pp nm) + _ru + _pd + ) bcur ls = - NewEpochState eL bprev bcur (EpochState acnt ss ls pr pp nm) ru pd + oldNes + { nesBcur = bcur, + nesEs = EpochState acnt ss ls pr pp nm + } returnRedeemAddrsToReserves :: forall era. diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/NewEpoch.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/NewEpoch.hs index eb033bfd992..b0a0404e470 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/NewEpoch.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/NewEpoch.hs @@ -147,7 +147,7 @@ newEpochTransition :: newEpochTransition = do TRC ( _, - src@(NewEpochState (EpochNo eL) _ bcur es ru _pd), + ~src@(NewEpochState (EpochNo eL) _ bcur es ru _pd), e@(EpochNo e_) ) <- judgmentContext @@ -175,13 +175,14 @@ newEpochTransition = do let EpochState _acnt ss _ls _pr _ _ = es''' pd' = calculatePoolDistr (_pstakeSet ss) pure $ - NewEpochState - e - bcur - (BlocksMade Map.empty) - es''' - SNothing - pd' + src + { nesEL = e, + nesBprev = bcur, + nesBcur = BlocksMade mempty, + nesEs = es''', + nesRu = SNothing, + nesPd = pd' + } -- | tell a RupdEvent as a DeltaRewardEvent only if the map is non-empty tellReward :: (Event (Core.EraRule "RUPD" era) ~ RupdEvent (Crypto era)) => NewEpochEvent era -> Rule (NEWEPOCH era) rtype () diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Tick.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Tick.hs index 1dc31460f69..95ecee81578 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Tick.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Tick.hs @@ -179,7 +179,7 @@ bheadTransition :: ) => TransitionRule (TICK era) bheadTransition = do - TRC ((), nes@(NewEpochState _ bprev _ es _ _), slot) <- + TRC ((), ~nes@(NewEpochState _ bprev _ es _ _), slot) <- judgmentContext nes' <- validatingTickTransition @TICK nes slot diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/API.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/API.hs index 3ce03feecae..c89b33a8906 100644 --- a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/API.hs +++ b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/API.hs @@ -196,19 +196,16 @@ instance CC.Crypto c => GetLedgerView (AlonzoEra c) -- because it makes it simpler to get the ledger view for Praos. instance CC.Crypto c => GetLedgerView (BabbageEra c) where currentLedgerView - NewEpochState - { nesPd, - nesEs - } = + NewEpochState {nesPd = pd, nesEs = es} = LedgerView - { lvD = getField @"_d" . esPp $ nesEs, + { lvD = getField @"_d" . esPp $ es, lvExtraEntropy = error "Extra entropy is not set in the Babbage era", - lvPoolDistr = nesPd, + lvPoolDistr = pd, lvGenDelegs = _genDelegs . dpsDState . lsDPState - $ esLState nesEs, - lvChainChecks = pparamsToChainChecksPParams . esPp $ nesEs + $ esLState es, + lvChainChecks = pparamsToChainChecksPParams . esPp $ es } futureLedgerView globals ss slot = @@ -264,18 +261,18 @@ view :: LedgerView (Crypto era) view NewEpochState - { nesPd, - nesEs + { nesPd = pd, + nesEs = es } = LedgerView - { lvD = getField @"_d" . esPp $ nesEs, - lvExtraEntropy = getField @"_extraEntropy" . esPp $ nesEs, - lvPoolDistr = nesPd, + { lvD = getField @"_d" . esPp $ es, + lvExtraEntropy = getField @"_extraEntropy" . esPp $ es, + lvPoolDistr = pd, lvGenDelegs = _genDelegs . dpsDState . lsDPState - $ esLState nesEs, - lvChainChecks = pparamsToChainChecksPParams . esPp $ nesEs + $ esLState es, + lvChainChecks = pparamsToChainChecksPParams . esPp $ es } -- $timetravel From c4c691ff0b94b6e4acb36b2ca93d9ff43c38c5ff Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Thu, 14 Apr 2022 09:24:14 +0200 Subject: [PATCH 2/2] Use type family for StashedAVVMAddresses. This also drops the use of a pattern synonym to hide the StashedAVVMAddresses from most uses. --- eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs | 1 + .../src/Cardano/Ledger/Alonzo/Translation.hs | 3 +- .../impl/src/Cardano/Ledger/Babbage.hs | 1 + .../src/Cardano/Ledger/Babbage/Translation.hs | 3 +- .../impl/src/Cardano/Ledger/Allegra.hs | 1 + .../src/Cardano/Ledger/Allegra/Translation.hs | 9 ++- .../impl/src/Cardano/Ledger/Mary.hs | 1 + .../src/Cardano/Ledger/Mary/Translation.hs | 3 +- .../Ledger/Shelley/API/ByronTranslation.hs | 7 +- .../src/Cardano/Ledger/Shelley/API/Genesis.hs | 1 + .../src/Cardano/Ledger/Shelley/LedgerState.hs | 64 +++++++++---------- .../Cardano/Ledger/Shelley/Rules/NewEpoch.hs | 7 +- .../src/Cardano/Ledger/Shelley/Rules/Tick.hs | 2 +- .../impl/src/Cardano/Ledger/Shelley/UTxO.hs | 3 +- .../test-suite/bench/BenchValidation.hs | 4 +- .../Ledger/Shelley/Examples/Consensus.hs | 9 ++- .../Cardano/Ledger/Shelley/Generator/Block.hs | 2 +- .../Ledger/Shelley/Generator/EraGen.hs | 5 +- .../Cardano/Ledger/Shelley/Rules/Chain.hs | 11 ++-- .../Serialisation/EraIndepGenerators.hs | 4 +- .../src/Test/Cardano/Ledger/Shelley/Utils.hs | 2 + .../Cardano/Ledger/Shelley/Examples/Init.hs | 6 +- .../Shelley/Serialisation/Golden/Encoding.hs | 10 +-- .../src/Cardano/Ledger/Pretty.hs | 2 +- .../Test/Cardano/Ledger/Model/Properties.hs | 19 ++++-- 25 files changed, 105 insertions(+), 75 deletions(-) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs index 963a07c5e35..c6e18ef9831 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs @@ -164,6 +164,7 @@ instance ) SNothing (PoolDistr Map.empty) + () where initialEpochNo = 0 initialUtxo = genesisUTxO sg diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs index 0518dd264c7..3c1c0704c88 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs @@ -70,7 +70,8 @@ instance nesBcur = nesBcur nes, nesEs = translateEra' ctxt $ nesEs nes, nesRu = nesRu nes, - nesPd = nesPd nes + nesPd = nesPd nes, + stashedAVVMAddresses = () } instance Crypto c => TranslateEra (AlonzoEra c) ShelleyGenesis where diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage.hs index c04588d866d..2be1062153e 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage.hs @@ -169,6 +169,7 @@ instance ) SNothing (PoolDistr Map.empty) + () where initialEpochNo = 0 initialUtxo = genesisUTxO sg diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Translation.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Translation.hs index 8b24d64b43c..fd93e4fdbe5 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Translation.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Translation.hs @@ -71,7 +71,8 @@ instance nesBcur = nesBcur nes, nesEs = translateEra' ctxt $ nesEs nes, nesRu = nesRu nes, - nesPd = nesPd nes + nesPd = nesPd nes, + stashedAVVMAddresses = () } instance Crypto c => TranslateEra (BabbageEra c) ShelleyGenesis where diff --git a/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra.hs b/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra.hs index c35d19ef1a2..b9c2685beba 100644 --- a/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra.hs +++ b/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra.hs @@ -72,6 +72,7 @@ instance ) SNothing (PoolDistr Map.empty) + () where initialEpochNo = 0 initialUtxo = genesisUTxO sg diff --git a/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra/Translation.hs b/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra/Translation.hs index 17d599ecbf4..7c2b8cabc2c 100644 --- a/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra/Translation.hs +++ b/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra/Translation.hs @@ -49,7 +49,7 @@ import qualified Data.Map.Strict as Map -- _back_ to the translation functions as the UTxO, allowing these addresses to -- be removed. This is needed because we cannot do a full scan on the UTxO at -- this point, since it has been persisted to disk. -shelleyToAllegraAVVMsToDelete :: NewEpochState era -> StrictMaybe (UTxO era) +shelleyToAllegraAVVMsToDelete :: NewEpochState (ShelleyEra c) -> UTxO (ShelleyEra c) shelleyToAllegraAVVMsToDelete = stashedAVVMAddresses type instance PreviousEra (AllegraEra c) = ShelleyEra c @@ -69,12 +69,11 @@ instance Crypto c => TranslateEra (AllegraEra c) NewEpochState where nesBcur = nesBcur nes, nesEs = translateEra' ctxt $ LS.returnRedeemAddrsToReserves . nesEs $ nes, nesRu = nesRu nes, - nesPd = nesPd nes - } - { -- At this point, the consensus layer has passed in our stashed AVVM + nesPd = nesPd nes, + -- At this point, the consensus layer has passed in our stashed AVVM -- addresses as our UTxO, and we have deleted them above (with -- 'returnRedeemAddrsToReserves'), so we may safely discard this map. - stashedAVVMAddresses = SNothing + stashedAVVMAddresses = () } instance forall c. Crypto c => TranslateEra (AllegraEra c) Tx where diff --git a/eras/shelley-ma/impl/src/Cardano/Ledger/Mary.hs b/eras/shelley-ma/impl/src/Cardano/Ledger/Mary.hs index eb7223d2051..b1c013f2e35 100644 --- a/eras/shelley-ma/impl/src/Cardano/Ledger/Mary.hs +++ b/eras/shelley-ma/impl/src/Cardano/Ledger/Mary.hs @@ -65,6 +65,7 @@ instance Crypto c => CanStartFromGenesis (MaryEra c) where ) SNothing (PoolDistr Map.empty) + () where initialEpochNo = 0 initialUtxo = genesisUTxO sg diff --git a/eras/shelley-ma/impl/src/Cardano/Ledger/Mary/Translation.hs b/eras/shelley-ma/impl/src/Cardano/Ledger/Mary/Translation.hs index 7915085c310..f140e276f13 100644 --- a/eras/shelley-ma/impl/src/Cardano/Ledger/Mary/Translation.hs +++ b/eras/shelley-ma/impl/src/Cardano/Ledger/Mary/Translation.hs @@ -67,7 +67,8 @@ instance Crypto c => TranslateEra (MaryEra c) NewEpochState where nesBcur = nesBcur nes, nesEs = translateEra' ctxt $ nesEs nes, nesRu = nesRu nes, - nesPd = nesPd nes + nesPd = nesPd nes, + stashedAVVMAddresses = () } instance Crypto c => TranslateEra (MaryEra c) Tx where diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs index 3a5afabcb1a..f39b9721682 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs @@ -101,16 +101,15 @@ translateToShelleyLedgerState genesisShelley epochNo cvs = nesBcur = BlocksMade Map.empty, nesEs = epochState, nesRu = SNothing, - nesPd = PoolDistr Map.empty - } - { -- At this point, we compute the stashed AVVM addresses, while we are able + nesPd = PoolDistr Map.empty, + -- At this point, we compute the stashed AVVM addresses, while we are able -- to do a linear scan of the UTxO, and stash them away for use at the -- Shelley/Allegra boundary. stashedAVVMAddresses = let UTxO utxo = _utxo . lsUTxOState . esLState $ epochState redeemers = SplitMap.filter (maybe False isBootstrapRedeemer . getTxOutBootstrapAddress) utxo - in SJust $ UTxO redeemers + in UTxO redeemers } where pparams :: PParams (ShelleyEra c) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Genesis.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Genesis.hs index d76eca6bbd8..7d2356e5f29 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Genesis.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Genesis.hs @@ -79,6 +79,7 @@ instance ) SNothing (PoolDistr Map.empty) + (UTxO mempty) where initialEpochNo = 0 initialUtxo = genesisUTxO sg diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs index 57c649251c4..3b7a4a22043 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs @@ -13,11 +13,12 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -- | @@ -85,6 +86,7 @@ module Cardano.Ledger.Shelley.LedgerState pulseStep, completeStep, NewEpochState (NewEpochState, nesEL, nesEs, nesRu, nesPd, nesBprev, nesBcur), + StashedAVVMAddresses, stashedAVVMAddresses, getGKeys, updateNES, @@ -140,6 +142,7 @@ import Cardano.Ledger.Keys import Cardano.Ledger.PoolDistr (PoolDistr (..)) import Cardano.Ledger.SafeHash (HashAnnotated) import Cardano.Ledger.Serialization (decodeRecordNamedT, mapFromCBOR, mapToCBOR) +import Cardano.Ledger.Shelley (ShelleyEra) import Cardano.Ledger.Shelley.Address.Bootstrap ( BootstrapWitness (..), bootstrapWitKeyHash, @@ -713,19 +716,19 @@ instance pure UTxOState {_utxo, _deposited, _fees, _ppups, _stakeDistro} -- | New Epoch state and environment -data NewEpochState era = NewEpochStatePlusAVVM +data NewEpochState era = NewEpochState { -- | Last epoch - nesPlusEL :: !EpochNo, + nesEL :: !EpochNo, -- | Blocks made before current epoch - nesPlusBprev :: !(BlocksMade (Crypto era)), + nesBprev :: !(BlocksMade (Crypto era)), -- | Blocks made in current epoch - nesPlusBcur :: !(BlocksMade (Crypto era)), + nesBcur :: !(BlocksMade (Crypto era)), -- | Epoch state before current - nesPlusEs :: !(EpochState era), + nesEs :: !(EpochState era), -- | Possible reward update - nesPlusRu :: !(StrictMaybe (PulsingRewUpdate (Crypto era))), + nesRu :: !(StrictMaybe (PulsingRewUpdate (Crypto era))), -- | Stake distribution within the stake pool - nesPlusPd :: !(PoolDistr (Crypto era)), + nesPd :: !(PoolDistr (Crypto era)), -- | AVVM addresses to be removed at the end of the Shelley era. Note that -- the existence of this field is a hack, related to the transition of UTxO -- to disk. We remove AVVM addresses from the UTxO on the Shelley/Allegra @@ -737,31 +740,20 @@ data NewEpochState era = NewEpochStatePlusAVVM -- -- This is very much an awkward implementation hack, and hence we hide it -- from as many places as possible. - stashedAVVMAddresses :: !(StrictMaybe (UTxO era)) + stashedAVVMAddresses :: !(StashedAVVMAddresses era) } deriving (Generic) -pattern NewEpochState :: - EpochNo -> - BlocksMade (Crypto era) -> - BlocksMade (Crypto era) -> - EpochState era -> - StrictMaybe (PulsingRewUpdate (Crypto era)) -> - PoolDistr (Crypto era) -> - NewEpochState era -pattern NewEpochState {nesEL, nesBprev, nesBcur, nesEs, nesRu, nesPd} <- - NewEpochStatePlusAVVM nesEL nesBprev nesBcur nesEs nesRu nesPd _ - where - NewEpochState el bprev bcur es ru pd = - NewEpochStatePlusAVVM el bprev bcur es ru pd SNothing - -{-# COMPLETE NewEpochState #-} +type family StashedAVVMAddresses era where + StashedAVVMAddresses (ShelleyEra c) = UTxO (ShelleyEra c) + StashedAVVMAddresses _ = () deriving stock instance ( CC.Crypto (Crypto era), Show (Core.TxOut era), Show (Core.PParams era), - Show (State (Core.EraRule "PPUP" era)) + Show (State (Core.EraRule "PPUP" era)), + Show (StashedAVVMAddresses era) ) => Show (NewEpochState era) @@ -769,7 +761,8 @@ deriving stock instance ( CC.Crypto (Crypto era), Eq (Core.TxOut era), Eq (Core.PParams era), - Eq (State (Core.EraRule "PPUP" era)) + Eq (State (Core.EraRule "PPUP" era)), + Eq (StashedAVVMAddresses era) ) => Eq (NewEpochState era) @@ -777,7 +770,8 @@ instance ( Era era, NFData (Core.TxOut era), NFData (Core.PParams era), - NFData (State (Core.EraRule "PPUP" era)) + NFData (State (Core.EraRule "PPUP" era)), + NFData (StashedAVVMAddresses era) ) => NFData (NewEpochState era) @@ -787,6 +781,7 @@ instance NoThunks (Core.PParams era), NoThunks (State (Core.EraRule "PPUP" era)), NoThunks (Core.Value era), + NoThunks (StashedAVVMAddresses era), ToCBOR (Core.TxBody era), ToCBOR (Core.TxOut era), ToCBOR (Core.Value era) @@ -797,11 +792,12 @@ instance ( Era era, ToCBOR (Core.TxOut era), ToCBOR (Core.PParams era), - ToCBOR (State (Core.EraRule "PPUP" era)) + ToCBOR (State (Core.EraRule "PPUP" era)), + ToCBOR (StashedAVVMAddresses era) ) => ToCBOR (NewEpochState era) where - toCBOR (NewEpochStatePlusAVVM e bp bc es ru pd av) = + toCBOR (NewEpochState e bp bc es ru pd av) = encodeListLen 7 <> toCBOR e <> toCBOR bp @@ -815,17 +811,16 @@ instance ( Era era, FromCBOR (Core.PParams era), FromSharedCBOR (Core.TxOut era), - -- This constraint is used only for the AVVM addresses - FromCBOR (Core.TxOut era), Share (Core.TxOut era) ~ Interns (Credential 'Staking (Crypto era)), FromCBOR (Core.Value era), - FromCBOR (State (Core.EraRule "PPUP" era)) + FromCBOR (State (Core.EraRule "PPUP" era)), + FromCBOR (StashedAVVMAddresses era) ) => FromCBOR (NewEpochState era) where fromCBOR = do decode $ - RecD NewEpochStatePlusAVVM + RecD NewEpochState STS (NEWEPOCH era) where @@ -121,6 +122,7 @@ instance def SNothing (PoolDistr Map.empty) + def ] transitionRules = [newEpochTransition] @@ -141,13 +143,14 @@ newEpochTransition :: UsesValue era, Default (State (Core.EraRule "PPUP" era)), Default (Core.PParams era), + Default (StashedAVVMAddresses era), Event (Core.EraRule "RUPD" era) ~ RupdEvent (Crypto era) ) => TransitionRule (NEWEPOCH era) newEpochTransition = do TRC ( _, - ~src@(NewEpochState (EpochNo eL) _ bcur es ru _pd), + src@(NewEpochState (EpochNo eL) _ bcur es ru _pd _), e@(EpochNo e_) ) <- judgmentContext diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Tick.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Tick.hs index 95ecee81578..c6e747acb94 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Tick.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Tick.hs @@ -179,7 +179,7 @@ bheadTransition :: ) => TransitionRule (TICK era) bheadTransition = do - TRC ((), ~nes@(NewEpochState _ bprev _ es _ _), slot) <- + TRC ((), nes@(NewEpochState _ bprev _ es _ _ _), slot) <- judgmentContext nes' <- validatingTickTransition @TICK nes slot diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/UTxO.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/UTxO.hs index dfc327f6039..43f1befeefc 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/UTxO.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/UTxO.hs @@ -89,6 +89,7 @@ import Data.Coders (decodeSplitMap, encodeSplitMap) import Data.Coerce (coerce) import qualified Data.Compact.SplitMap as SplitMap import Data.Constraint (Constraint) +import Data.Default.Class (Default) import Data.Foldable (foldMap', toList) import Data.Kind (Type) import Data.Map.Strict (Map) @@ -108,7 +109,7 @@ import Quiet -- | The unspent transaction outputs. newtype UTxO era = UTxO {unUTxO :: SplitMap.SplitMap (TxIn (Crypto era)) (Core.TxOut era)} - deriving (Generic, Semigroup) + deriving (Default, Generic, Semigroup) type TransUTxO (c :: Type -> Constraint) era = (c (Core.TxOut era), TransTxId c era) diff --git a/eras/shelley/test-suite/bench/BenchValidation.hs b/eras/shelley/test-suite/bench/BenchValidation.hs index bebb924ae85..129cd35d577 100644 --- a/eras/shelley/test-suite/bench/BenchValidation.hs +++ b/eras/shelley/test-suite/bench/BenchValidation.hs @@ -37,6 +37,7 @@ import Cardano.Ledger.Shelley.Bench.Gen (genBlock, genChainState) import Cardano.Ledger.Shelley.BlockChain (slotToNonce) import Cardano.Ledger.Shelley.LedgerState ( NewEpochState, + StashedAVVMAddresses, nesBcur, ) import Cardano.Ledger.Shelley.TxBody (TransTxBody, TransTxId) @@ -124,7 +125,8 @@ applyBlock :: TransTxBody NFData era, API.ApplyBlock era, NFData (Core.PParams era), - NFData (State (Core.EraRule "PPUP" era)) + NFData (State (Core.EraRule "PPUP" era)), + NFData (StashedAVVMAddresses era) ) => ValidateInput era -> Int -> diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs index 73bf5ab6941..2d7a2f9f3c5 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs @@ -111,7 +111,8 @@ defaultShelleyLedgerExamples :: PredicateFailure (Core.EraRule "DELEGS" era) ~ DelegsPredicateFailure era, Core.PParams era ~ Cardano.Ledger.Shelley.PParams.PParams era, - Core.PParamsDelta era ~ PParams' StrictMaybe era + Core.PParamsDelta era ~ PParams' StrictMaybe era, + Default (StashedAVVMAddresses era) ) => (Core.TxBody era -> KeyPairWits era -> Core.Witnesses era) -> (Tx era -> Core.Tx era) -> @@ -298,7 +299,8 @@ exampleNewEpochState :: HasField "_protocolVersion" (Core.PParams era) ProtVer, HasField "_nOpt" (Core.PParams era) Natural, HasField "_rho" (Core.PParams era) UnitInterval, - HasField "_tau" (Core.PParams era) UnitInterval + HasField "_tau" (Core.PParams era) UnitInterval, + Default (StashedAVVMAddresses era) ) => Core.Value era -> Core.PParams era -> @@ -311,7 +313,8 @@ exampleNewEpochState value ppp pp = nesBcur = BlocksMade (Map.singleton (mkKeyHash 2) 3), nesEs = epochState, nesRu = SJust rewardUpdate, - nesPd = examplePoolDistr + nesPd = examplePoolDistr, + stashedAVVMAddresses = def } where epochState :: EpochState era diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Block.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Block.hs index 3701337c7fe..c778a8b5838 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Block.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Block.hs @@ -126,7 +126,7 @@ genBlockWithTxGen $ selectNextSlotWithLeader ge origChainState firstConsideredSlot -- Now we need to compute the KES period and get the set of hot keys. - let NewEpochState _ _ _ es _ _ = chainNes chainSt + let NewEpochState _ _ _ es _ _ _ = chainNes chainSt EpochState acnt _ ls _ pp _ = es kp@(KESPeriod kesPeriod_) = runShelleyBase $ kesPeriod nextSlot cs = chainOCertIssue chainSt diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/EraGen.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/EraGen.hs index 04948269c39..b7e2f54d736 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/EraGen.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/EraGen.hs @@ -55,7 +55,7 @@ import Cardano.Ledger.Shelley.API StakeReference (StakeRefBase), ) import Cardano.Ledger.Shelley.Constraints (UsesPParams (..)) -import Cardano.Ledger.Shelley.LedgerState (UTxOState (..)) +import Cardano.Ledger.Shelley.LedgerState (StashedAVVMAddresses, UTxOState (..)) import Cardano.Ledger.Shelley.PParams (Update) import Cardano.Ledger.Shelley.Rules.Utxo (UtxoEnv) import Cardano.Ledger.Shelley.TxBody (DCert, Wdrl, WitVKey) @@ -212,7 +212,8 @@ class PrettyA (Core.Tx era), PrettyA (Core.TxBody era), PrettyA (Core.Witnesses era), - PrettyA (Core.Value era) + PrettyA (Core.Value era), + Default (StashedAVVMAddresses era) ) => EraGen era where diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs index 742a3656f1d..871c64f5554 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs @@ -70,6 +70,7 @@ import Cardano.Ledger.Shelley.LedgerState LedgerState (..), NewEpochState (..), PState (..), + StashedAVVMAddresses, smartUTxOState, updateNES, _genDelegs, @@ -188,7 +189,8 @@ instance -- | Creates a valid initial chain state initialShelleyState :: ( Era era, - Default (State (Core.EraRule "PPUP" era)) + Default (State (Core.EraRule "PPUP" era)), + Default (StashedAVVMAddresses era) ) => WithOrigin (LastAppliedBlock (Crypto era)) -> EpochNo -> @@ -222,6 +224,7 @@ initialShelleyState lab e utxo reserves genDelegs pp initNonce = ) SNothing (PoolDistr Map.empty) + def ) cs initNonce @@ -322,7 +325,7 @@ chainTransition = Right () -> pure () Left e -> failBecause $ PrtclSeqFailure e - let NewEpochState _ _ _ (EpochState _ _ _ _ pp _) _ _ = nes + let NewEpochState _ _ _ (EpochState _ _ _ _ pp _) _ _ _ = nes chainChecksData = pparamsToChainChecksPParams pp bhView = makeHeaderView bh @@ -335,8 +338,8 @@ chainTransition = nes' <- trans @(Core.EraRule "TICK" era) $ TRC ((), nes, s) - let NewEpochState e1 _ _ _ _ _ = nes - NewEpochState e2 _ bcur es _ _pd = nes' + let NewEpochState e1 _ _ _ _ _ _ = nes + NewEpochState e2 _ bcur es _ _pd _ = nes' let EpochState account _ ls _ pp' _ = es let LedgerState _ (DPState (DState _ _ genDelegs _) (PState _ _ _)) = ls let ph = lastAppliedHash lab diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/EraIndepGenerators.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/EraIndepGenerators.hs index efdd7ea919e..64996218e2b 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/EraIndepGenerators.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/EraIndepGenerators.hs @@ -74,7 +74,7 @@ import Cardano.Ledger.Shelley.Constraints UsesTxOut, UsesValue, ) -import Cardano.Ledger.Shelley.LedgerState (FutureGenDeleg) +import Cardano.Ledger.Shelley.LedgerState (FutureGenDeleg, StashedAVVMAddresses) import qualified Cardano.Ledger.Shelley.Metadata as MD import Cardano.Ledger.Shelley.PoolRank ( Likelihood (..), @@ -561,12 +561,12 @@ instance Arbitrary (Core.Value era), Arbitrary (Core.PParams era), Arbitrary (State (Core.EraRule "PPUP" era)), + Arbitrary (StashedAVVMAddresses era), EraGen era ) => Arbitrary (NewEpochState era) where arbitrary = genericArbitraryU - shrink = genericShrink instance CC.Crypto crypto => Arbitrary (BlocksMade crypto) where arbitrary = BlocksMade <$> arbitrary diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Utils.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Utils.hs index 081f35525d3..929e1d3e22c 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Utils.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Utils.hs @@ -106,6 +106,7 @@ import Cardano.Ledger.Shelley.API ) import Cardano.Ledger.Shelley.BlockChain (TxSeq) import Cardano.Ledger.Shelley.Constraints +import Cardano.Ledger.Shelley.LedgerState (StashedAVVMAddresses) import Cardano.Ledger.Shelley.PParams (PParamsUpdate) import Cardano.Ledger.Shelley.Tx (Tx, TxOut, WitnessSet) import Cardano.Ledger.Slot (EpochNo, EpochSize (..), SlotNo) @@ -173,6 +174,7 @@ type ShelleyTest era = Core.Witnesses era ~ WitnessSet era, Split (Core.Value era), Default (State (Core.EraRule "PPUP" era)), + Default (StashedAVVMAddresses era), Core.AnnotatedData (Core.Witnesses era) ) diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Init.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Init.hs index 52df53a2646..ed9a31aeb1b 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Init.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Init.hs @@ -107,7 +107,11 @@ nonce0 = hashHeaderToNonce (lastByronHeaderHash @c) -- The initial state for the examples uses the function -- 'initialShelleyState' with the genesis delegation -- 'genDelegs' and any given starting 'UTxO' set. -initSt :: forall era. ShelleyTest era => UTxO era -> ChainState era +initSt :: + forall era. + (ShelleyTest era) => + UTxO era -> + ChainState era initSt utxo = initialShelleyState (At $ LastAppliedBlock (BlockNo 0) (SlotNo 0) lastByronHeaderHash) diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs index 6ae6675dab4..deb3b1c7587 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs @@ -147,7 +147,7 @@ import Cardano.Ledger.Shelley.TxBody pattern PoolParams, pattern RewardAcnt, ) -import Cardano.Ledger.Shelley.UTxO (makeWitnessVKey) +import Cardano.Ledger.Shelley.UTxO (UTxO (UTxO), makeWitnessVKey) import Cardano.Ledger.Slot (BlockNo (..), EpochNo (..), SlotNo (..)) import Cardano.Ledger.TxIn (TxId, TxIn (..)) import Cardano.Prelude (LByteString) @@ -1321,20 +1321,22 @@ tests = es (SJust ru) pd + (UTxO mempty) in checkEncodingCBOR "new_epoch_state" nes - ( T (TkListLen 6) + ( T (TkListLen 7) <> S e <> S (BlocksMade @C_Crypto bs) <> S (BlocksMade @C_Crypto bs) <> S es <> S (SJust ru) <> S pd + <> S (UTxO @(ShelleyEra C_Crypto) mempty) ), let actual = B16.encode . serialize' $ Ex.sleNewEpochState Ex.ledgerExamplesShelley expected = - "8600a1581ce0a714319812c3f773ba04ec5d6b3ffcd5aad85006805b047b082541" + "8700a1581ce0a714319812c3f773ba04ec5d6b3ffcd5aad85006805b047b082541" <> "0aa1581ca646474b8f5431261506b6c273d307c7569a4eb6c96b42dd4a29520a03" <> "86821927101903e8828283a0a0a08482a0a0a0a084a0a0000085a1825820ee155a" <> "ce9c40292074cb6aff8c9ccdd273c81648ff1149ef36bcea6ebb8a3e2500825839" @@ -1345,7 +1347,7 @@ tests = <> "1864d81e820001d81e820001d81e820001d81e82000181000000010082a0008183" <> "00880082000082a000000000a0a0840185a0803903ba820000a0a082a0a0a1581c" <> "e0a714319812c3f773ba04ec5d6b3ffcd5aad85006805b047b0825418282010158" - <> "20c5e21ab1c9f6022d81c3b25e3436cb7f1df77f9652ae3e1310c28e621dd87b4c" + <> "20c5e21ab1c9f6022d81c3b25e3436cb7f1df77f9652ae3e1310c28e621dd87b4ca0" in testCase "ledger state golden test" (actual @?= expected) ] where diff --git a/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs b/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs index 34a5bfcb921..5d8c32ad4d9 100644 --- a/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs +++ b/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs @@ -731,7 +731,7 @@ ppEpochState (EpochState acnt snap ls prev pp non) = ] ppNewEpochState :: CanPrettyPrintLedgerState era => NewEpochState era -> PDoc -ppNewEpochState (NewEpochState enum prevB curB es rewup pool) = +ppNewEpochState (NewEpochState enum prevB curB es rewup pool _) = ppRecord "NewEpochState" [ ("epochnum", ppEpochNo enum), diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Model/Properties.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Model/Properties.hs index 84c107d4f17..990cb25e522 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Model/Properties.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Model/Properties.hs @@ -29,6 +29,7 @@ import Cardano.Ledger.Coin import qualified Cardano.Ledger.Core as Core import Cardano.Ledger.Mary.Value (AssetName (..)) import Cardano.Ledger.Shelley (ShelleyEra) +import Cardano.Ledger.Shelley.LedgerState (StashedAVVMAddresses) import qualified Cardano.Ledger.Shelley.LedgerState as LedgerState import Cardano.Ledger.Shelley.TxBody (MIRPot (..)) import Cardano.Ledger.Val (Val (..)) @@ -136,7 +137,8 @@ modelTestDelegations :: Show (Core.Script era), Show (Core.PParams era), Show (State (Core.EraRule "PPUP" era)), - Show (LedgerState.LedgerState era) + Show (LedgerState.LedgerState era), + Show (StashedAVVMAddresses era) ) => proxy era -> Coin -> @@ -523,7 +525,8 @@ modelGenTest :: Show (Core.TxOut era), Show (Core.Script era), Show (Core.PParams era), - Show (State (Core.EraRule "PPUP" era)) + Show (State (Core.EraRule "PPUP" era)), + Show (StashedAVVMAddresses era) ) => proxy era -> Property @@ -548,7 +551,8 @@ testModelShrinking :: Show (Core.Script era), Show (Core.PParams era), Show (State (Core.EraRule "PPUP" era)), - Show (LedgerState.LedgerState era) + Show (LedgerState.LedgerState era), + Show (StashedAVVMAddresses era) ) => proxy era -> Property @@ -611,7 +615,8 @@ propertyShrinking :: Show (Core.PParams era), Show (State (Core.EraRule "PPUP" era)), Show (LedgerState.LedgerState era), - ElaborateEraModel era + ElaborateEraModel era, + Show (StashedAVVMAddresses era) ) => proxy era -> (ModelGenesis (EraFeatureSet era), [ModelEpoch (EraFeatureSet era)]) -> @@ -657,7 +662,8 @@ testDelegCombinations :: Show (Core.TxOut era), Show (Core.Script era), Show (Core.PParams era), - Show (State (Core.EraRule "PPUP" era)) + Show (State (Core.EraRule "PPUP" era)), + Show (StashedAVVMAddresses era) ) => proxy era -> TestTree @@ -686,7 +692,8 @@ modelUnitTests :: Show (Core.TxOut era), Show (Core.Script era), Show (Core.PParams era), - Show (State (Core.EraRule "PPUP" era)) + Show (State (Core.EraRule "PPUP" era)), + Show (StashedAVVMAddresses era) ) => proxy era -> TestTree