diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Governance.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Governance.hs index 8498c74e57a..d076cd8b434 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Governance.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Governance.hs @@ -45,12 +45,15 @@ module Cardano.Ledger.Conway.Governance ( cgGovActionsStateL, cgEnactStateL, cgRatifyStateL, + ensCommitteeL, ensConstitutionL, + ensCurPParamsL, ensPrevGovActionIdsL, ensPrevPParamUpdateL, ensPrevHardForkL, ensPrevCommitteeL, ensPrevConstitutionL, + ensProtVerL, rsEnactStateL, curPParamsConwayGovStateL, prevPParamsConwayGovStateL, @@ -340,9 +343,15 @@ data EnactState era = EnactState } deriving (Generic) +ensCommitteeL :: Lens' (EnactState era) (StrictMaybe (Committee era)) +ensCommitteeL = lens ensCommittee (\x y -> x {ensCommittee = y}) + ensConstitutionL :: Lens' (EnactState era) (Constitution era) ensConstitutionL = lens ensConstitution (\x y -> x {ensConstitution = y}) +ensProtVerL :: Lens' (EnactState era) ProtVer +ensProtVerL = lens ensProtVer (\x y -> x {ensProtVer = y}) + ensCurPParamsL :: Lens' (EnactState era) (PParams era) ensCurPParamsL = lens ensPParams (\es x -> es {ensPParams = x}) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Enact.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Enact.hs index 3a6d5beac05..8db2bbeeb3f 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Enact.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Enact.hs @@ -24,6 +24,15 @@ import Cardano.Ledger.Conway.Governance ( EnactState (..), GovAction (..), GovActionId (..), + PrevGovActionId (..), + ensCommitteeL, + ensConstitutionL, + ensCurPParamsL, + ensPrevCommitteeL, + ensPrevConstitutionL, + ensPrevHardForkL, + ensPrevPParamUpdateL, + ensProtVerL, ) import Cardano.Ledger.Rules.ValidationMode (Inject (..), runTest) import Cardano.Ledger.Val (Val (..)) @@ -36,6 +45,7 @@ import Control.State.Transition.Extended ( import Data.Foldable (fold) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map +import Lens.Micro import Validation (failureUnless) data EnactPredFailure era @@ -59,13 +69,19 @@ instance EraGov era => STS (ConwayENACT era) where enactmentTransition :: forall era. EraPParams era => TransitionRule (ConwayENACT era) enactmentTransition = do - TRC ((), st, EnactSignal _ act) <- judgmentContext + TRC ((), st, EnactSignal govActionId act) <- judgmentContext case act of - ParameterChange _prevGovActionId ppup -> pure $ st {ensPParams = newPP} - where - newPP = ensPParams st `applyPPUpdates` ppup - HardForkInitiation _prevGovActionId pv -> pure $ st {ensProtVer = pv} + ParameterChange _ ppup -> + pure $ + st + & ensCurPParamsL %~ (`applyPPUpdates` ppup) + & ensPrevPParamUpdateL .~ SJust (PrevGovActionId govActionId) + HardForkInitiation _ pv -> + pure $ + st + & ensProtVerL .~ pv + & ensPrevHardForkL .~ SJust (PrevGovActionId govActionId) TreasuryWithdrawals wdrls -> do let wdrlsAmount = fold wdrls wdrlsNoNetworkId = Map.mapKeys getRwdCred wdrls @@ -77,9 +93,21 @@ enactmentTransition = do { ensWithdrawals = Map.unionWith (<>) wdrlsNoNetworkId $ ensWithdrawals st , ensTreasury = ensTreasury st <-> wdrlsAmount } - NoConfidence _prevGovActionId -> pure $ st {ensCommittee = SNothing} - NewCommittee _prevGovActionId _ committee -> pure $ st {ensCommittee = SJust committee} -- TODO: check old members - NewConstitution _prevGovActionId c -> pure $ st {ensConstitution = c} + NoConfidence _ -> + pure $ + st + & ensCommitteeL .~ SNothing + & ensPrevCommitteeL .~ SJust (PrevGovActionId govActionId) + NewCommittee _ _ committee -> + pure $ + st + & ensCommitteeL .~ SJust committee -- TODO: check old members + & ensPrevCommitteeL .~ SJust (PrevGovActionId govActionId) + NewConstitution _ c -> + pure $ + st + & ensConstitutionL .~ c + & ensPrevConstitutionL .~ SJust (PrevGovActionId govActionId) InfoAction -> pure st instance Inject (EnactPredFailure era) (EnactPredFailure era) where diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/ConwayFeatures.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/ConwayFeatures.hs index 3a5a7d33d65..fc8d84fe68d 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/ConwayFeatures.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/ConwayFeatures.hs @@ -441,6 +441,10 @@ testGov pf = do Right x -> x Left e -> error $ "Error running runEPOCH: " <> show e constitution2 = epochState4 ^. esLStateL . lsUTxOStateL . utxosGovStateL . cgEnactStateL . ensConstitutionL + assertExprEqualWithMessage + "prevGovAction set correctly" + (SJust (PrevGovActionId govActionId)) + (epochState4 ^. esLStateL . lsUTxOStateL . utxosGovStateL . cgEnactStateL . ensPrevConstitutionL) assertEqual "constitution after enactment after no votes" constitution2 (proposedConstitution @era) let currentGovActions =