From c8325ca3651012143bb1615ffd145e9be781467f Mon Sep 17 00:00:00 2001 From: Aniket Deshpande Date: Tue, 17 Sep 2024 20:00:31 +0530 Subject: [PATCH] Predicate-failures for invalid return addresses. * ProposalReturnAddressDoesNotExist * TreasuryWithdrawalReturnAddressDoesNotExist --- eras/conway/impl/CHANGELOG.md | 3 + .../src/Cardano/Ledger/Conway/Rules/Gov.hs | 36 ++++- .../Test/Cardano/Ledger/Conway/Imp/GovSpec.hs | 126 ++++++++++++------ libs/cardano-ledger-core/CHANGELOG.md | 1 + .../src/Cardano/Ledger/UMap.hs | 5 + .../Cardano/Ledger/Constrained/Conway/Gov.hs | 21 ++- .../Test/Cardano/Ledger/Generic/PrettyCore.hs | 2 + 7 files changed, 144 insertions(+), 50 deletions(-) diff --git a/eras/conway/impl/CHANGELOG.md b/eras/conway/impl/CHANGELOG.md index e1b4328cebf..5af8e7d4c95 100644 --- a/eras/conway/impl/CHANGELOG.md +++ b/eras/conway/impl/CHANGELOG.md @@ -2,6 +2,9 @@ ## 1.17.0.0 +* Add predicate failures to guard against invalid reward accounts (return addresses) in proposals and treasury withdrawals. #4639 + * `ProposalReturnAddressDoesNotExist`, and + * `TreasuryWithdrawalReturnAddressDoesNotExist`. * Add `refScriptCostStride` and `refScriptCostMultiplier` * Added protocol version argument to `ppuWellFormed` * Add `ConwayMempoolEvent` type diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs index 0381fa5386f..6509be12f8c 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Gov.hs @@ -1,5 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE EmptyDataDeriving #-} @@ -16,6 +17,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE UndecidableSuperClasses #-} {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Conway.Rules.Gov ( @@ -26,7 +28,7 @@ module Cardano.Ledger.Conway.Rules.Gov ( ConwayGovPredFailure (..), ) where -import Cardano.Ledger.Address (RewardAccount, raNetwork) +import Cardano.Ledger.Address (RewardAccount, raCredential, raNetwork) import Cardano.Ledger.BaseTypes ( EpochInterval (..), EpochNo (..), @@ -59,6 +61,7 @@ import Cardano.Ledger.CertState ( authorizedHotCommitteeCredentials, ) import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Conway.Core (ppGovActionDepositL, ppGovActionLifetimeL) import Cardano.Ledger.Conway.Era (ConwayEra, ConwayGOV) import Cardano.Ledger.Conway.Governance ( GovAction (..), @@ -81,6 +84,8 @@ import Cardano.Ledger.Conway.Governance ( isCommitteeVotingAllowed, isDRepVotingAllowed, isStakePoolVotingAllowed, + pProcGovActionL, + pProcReturnAddrL, pRootsL, proposalsActionsMap, proposalsAddAction, @@ -91,8 +96,6 @@ import Cardano.Ledger.Conway.Governance ( import Cardano.Ledger.Conway.Governance.Proposals (mapProposals) import Cardano.Ledger.Conway.PParams ( ConwayEraPParams (..), - ppGovActionDepositL, - ppGovActionLifetimeL, ) import Cardano.Ledger.Conway.TxCert import Cardano.Ledger.Core @@ -100,8 +103,10 @@ import Cardano.Ledger.Credential (Credential) import Cardano.Ledger.Keys (KeyRole (..)) import Cardano.Ledger.Rules.ValidationMode (Test, runTest) import qualified Cardano.Ledger.Shelley.HardForks as HF (bootstrapPhase) +import Cardano.Ledger.Shelley.LedgerState (dsUnifiedL) import Cardano.Ledger.Shelley.PParams (pvCanFollow) import Cardano.Ledger.TxIn (TxId (..)) +import qualified Cardano.Ledger.UMap as UMap import Control.DeepSeq (NFData) import Control.Monad (unless) import Control.Monad.Trans.Reader (asks) @@ -196,6 +201,10 @@ data ConwayGovPredFailure era VotersDoNotExist (NonEmpty (Voter (EraCrypto era))) | -- | Treasury withdrawals that sum up to zero are not allowed ZeroTreasuryWithdrawals (GovAction era) + | -- | Proposals that have an invalid reward account for returns of the deposit + ProposalReturnAccountDoesNotExist (RewardAccount (EraCrypto era)) + | -- | Treasury withdrawal proposals to an invalid reward account + TreasuryWithdrawalReturnAccountsDoNotExist (NonEmpty (RewardAccount (EraCrypto era))) deriving (Eq, Show, Generic) type instance EraRuleFailure "GOV" (ConwayEra c) = ConwayGovPredFailure (ConwayEra c) @@ -226,6 +235,8 @@ instance EraPParams era => DecCBOR (ConwayGovPredFailure era) where 13 -> SumD DisallowedVotesDuringBootstrap SumD VotersDoNotExist SumD ZeroTreasuryWithdrawals SumD ProposalReturnAccountDoesNotExist SumD TreasuryWithdrawalReturnAccountsDoNotExist Invalid k instance EraPParams era => EncCBOR (ConwayGovPredFailure era) where @@ -266,6 +277,10 @@ instance EraPParams era => EncCBOR (ConwayGovPredFailure era) where Sum VotersDoNotExist 14 !> To voters ZeroTreasuryWithdrawals ga -> Sum ZeroTreasuryWithdrawals 15 !> To ga + ProposalReturnAccountDoesNotExist returnAccount -> + Sum ProposalReturnAccountDoesNotExist 16 !> To returnAccount + TreasuryWithdrawalReturnAccountsDoNotExist accounts -> + Sum TreasuryWithdrawalReturnAccountsDoNotExist 17 !> To accounts instance EraPParams era => ToCBOR (ConwayGovPredFailure era) where toCBOR = toEraCBOR @era @@ -416,7 +431,7 @@ govTransition :: TransitionRule (EraRule "GOV" era) govTransition = do TRC - ( GovEnv txid currentEpoch pp constitutionPolicy CertState {certPState, certVState} + ( GovEnv txid currentEpoch pp constitutionPolicy CertState {certDState, certPState, certVState} , st , GovSignal {gsVotingProcedures, gsProposalProcedures, gsCertificates} ) <- @@ -446,6 +461,19 @@ govTransition = do -- PParamsUpdate well-formedness check runTest $ actionWellFormed (pp ^. ppProtocolVersionL) pProcGovAction + unless (HF.bootstrapPhase $ pp ^. ppProtocolVersionL) $ do + let refundAddress = proposal ^. pProcReturnAddrL + govAction = proposal ^. pProcGovActionL + UMap.member' (raCredential refundAddress) (certDState ^. dsUnifiedL) + ?! ProposalReturnAccountDoesNotExist refundAddress + case govAction of + TreasuryWithdrawals withdrawals _ -> do + let nonRegisteredAccounts = + flip Map.filterWithKey withdrawals $ \withdrawalAddress _ -> + not $ UMap.member' (raCredential withdrawalAddress) (certDState ^. dsUnifiedL) + failOnNonEmpty (Map.keys nonRegisteredAccounts) TreasuryWithdrawalReturnAccountsDoNotExist + _ -> pure () + -- Deposit check let expectedDep = pp ^. ppGovActionDepositL in pProcDeposit diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs index 3ffe3692263..45f651d54bd 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs @@ -5,9 +5,9 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} module Test.Cardano.Ledger.Conway.Imp.GovSpec ( spec, @@ -20,7 +20,7 @@ import Cardano.Ledger.Coin (Coin (Coin)) import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Governance import Cardano.Ledger.Conway.Rules (ConwayGovPredFailure (..)) -import Cardano.Ledger.Credential (Credential (KeyHashObj), StakeCredential) +import Cardano.Ledger.Credential (Credential (KeyHashObj)) import Cardano.Ledger.Plutus.CostModels (updateCostModels) import qualified Cardano.Ledger.Shelley.HardForks as HF import Cardano.Ledger.Shelley.LedgerState @@ -31,7 +31,6 @@ import Cardano.Ledger.Shelley.Scripts ( pattern RequireSignature, ) import Cardano.Ledger.Val (zero, (<->)) -import Control.Monad (forM) import Data.Default.Class (Default (..)) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE @@ -486,22 +485,13 @@ proposalsWithVotingSpec = fmap (!! 3) getProposalsForest `shouldReturn` Node (SJust p116) [] it "Proposals are stored in the expected order" $ do - modifyPParams $ - ppMaxValSizeL .~ 1_000_000_000 - returnAddr <- registerRewardAccount + modifyPParams $ ppMaxValSizeL .~ 1_000_000_000 deposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppGovActionDepositL ens <- getEnactState - withdrawals <- do - creds <- arbitrary :: ImpTestM era (NonEmpty (StakeCredential (EraCrypto era))) - pairs <- - forM - creds - ( \cred -> do - Positive n <- arbitrary - ac <- getRewardAccountFor cred - pure (ac, Coin n) - ) - pure $ Map.fromList (NE.toList pairs) + returnAddr <- registerRewardAccount + withdrawal <- + Map.singleton returnAddr . Coin . getPositive + <$> (arbitrary :: ImpTestM era (Positive Integer)) let mkProp name action = do ProposalProcedure @@ -513,7 +503,7 @@ proposalsWithVotingSpec = prop0 = mkProp "prop0" InfoAction prop1 = mkProp "prop1" $ NoConfidence (ens ^. ensPrevCommitteeL) prop2 = mkProp "prop2" InfoAction - prop3 = mkProp "prop3" $ TreasuryWithdrawals withdrawals SNothing + prop3 = mkProp "prop3" $ TreasuryWithdrawals withdrawal SNothing submitProposal_ prop0 submitProposal_ prop1 let @@ -550,8 +540,7 @@ proposalsSpec = do [injectFailure $ VotersDoNotExist [StakePoolVoter poolId]] dRepCred <- KeyHashObj <$> freshKeyHash whenPostBootstrap $ do - submitFailingVote (DRepVoter dRepCred) gaId $ - [injectFailure $ VotersDoNotExist [(DRepVoter dRepCred)]] + submitFailingVote (DRepVoter dRepCred) gaId [injectFailure $ VotersDoNotExist [DRepVoter dRepCred]] it "DRep votes are removed" $ do pp <- getsNES $ nesEsL . curPParamsEpochStateL gaId <- submitGovAction InfoAction @@ -564,6 +553,29 @@ proposalsSpec = do gasAfterRemoval <- getGovActionState gaId gasDRepVotes gasAfterRemoval `shouldBe` [] describe "Proposals" $ do + it "Predicate failure when proposal deposit has nonexistent return address" $ do + protVer <- getProtVer + registeredRewardAccount <- registerRewardAccount + unregisteredRewardAccount <- freshKeyHash >>= getRewardAccountFor . KeyHashObj + deposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppGovActionDepositL + anchor <- arbitrary + let mkProposal rewardAccount = + ProposalProcedure + { pProcDeposit = deposit + , pProcReturnAddr = rewardAccount + , pProcGovAction = InfoAction + , pProcAnchor = anchor + } + if HF.bootstrapPhase protVer + then do + submitProposal_ $ mkProposal registeredRewardAccount + submitProposal_ $ mkProposal unregisteredRewardAccount + else do + submitProposal_ $ mkProposal registeredRewardAccount + submitFailingProposal + (mkProposal unregisteredRewardAccount) + [ injectFailure $ ProposalReturnAccountDoesNotExist unregisteredRewardAccount + ] describe "Consistency" $ do it "Proposals submitted without proper parent fail" $ do let mkCorruptGovActionId :: GovActionId c -> GovActionId c @@ -577,7 +589,7 @@ proposalsSpec = do [ Node () [] ] pp <- getsNES $ nesEsL . curPParamsEpochStateL - khPropRwd <- freshKeyHash + rewardAccount <- registerRewardAccount let parameterChangeAction = ParameterChange (SJust $ GovPurposeId $ mkCorruptGovActionId p1) @@ -586,7 +598,7 @@ proposalsSpec = do parameterChangeProposal = ProposalProcedure { pProcDeposit = pp ^. ppGovActionDepositL - , pProcReturnAddr = RewardAccount Testnet (KeyHashObj khPropRwd) + , pProcReturnAddr = rewardAccount , pProcGovAction = parameterChangeAction , pProcAnchor = def } @@ -1130,18 +1142,34 @@ networkIdSpec = , raCredential = rewardCredential } propDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppGovActionDepositL - submitFailingProposal - ProposalProcedure - { pProcReturnAddr = badRewardAccount - , pProcGovAction = InfoAction - , pProcDeposit = propDeposit - , pProcAnchor = def - } - [ injectFailure $ - ProposalProcedureNetworkIdMismatch - badRewardAccount - Testnet - ] + pv <- getProtVer + let proposal = + ProposalProcedure + { pProcReturnAddr = badRewardAccount + , pProcGovAction = InfoAction + , pProcDeposit = propDeposit + , pProcAnchor = def + } + if HF.bootstrapPhase pv + then + submitFailingProposal + proposal + [ injectFailure $ + ProposalProcedureNetworkIdMismatch + badRewardAccount + Testnet + ] + else + submitFailingProposal + proposal + [ injectFailure $ + ProposalReturnAccountDoesNotExist + badRewardAccount + , injectFailure $ + ProposalProcedureNetworkIdMismatch + badRewardAccount + Testnet + ] withdrawalsSpec :: forall era. @@ -1151,6 +1179,19 @@ withdrawalsSpec :: SpecWith (ImpTestState era) withdrawalsSpec = describe "Withdrawals" $ do + it "Fails predicate when treasury withdrawal has nonexistent return address" $ do + policy <- getGovPolicy + unregisteredRewardAccount <- freshKeyHash >>= getRewardAccountFor . KeyHashObj + registeredRewardAccount <- registerRewardAccount + let genPositiveCoin = Coin . getPositive <$> arbitrary + withdrawalAccountDoesNotExist = TreasuryWithdrawalReturnAccountsDoNotExist [unregisteredRewardAccount] + withdrawals <- + sequence + [ (unregisteredRewardAccount,) <$> genPositiveCoin + , (registeredRewardAccount,) <$> genPositiveCoin + ] + expectPredFailures [withdrawalAccountDoesNotExist] [] $ + TreasuryWithdrawals (Map.fromList withdrawals) policy it "Fails with invalid network ID in withdrawal addresses" $ do rewardCredential <- KeyHashObj <$> freshKeyHash let badRewardAccount = @@ -1160,18 +1201,20 @@ withdrawalsSpec = } wdrls = TreasuryWithdrawals (Map.singleton badRewardAccount $ Coin 100_000_000) SNothing idMismatch = TreasuryWithdrawalsNetworkIdMismatch (Set.singleton badRewardAccount) Testnet - expectPredFailures [idMismatch] [idMismatch] wdrls + returnAddress = TreasuryWithdrawalReturnAccountsDoNotExist [badRewardAccount] + expectPredFailures [returnAddress, idMismatch] [idMismatch] wdrls it "Fails for empty withdrawals" $ do - rwdAccount1 <- freshKeyHash >>= getRewardAccountFor . KeyHashObj - rwdAccount2 <- freshKeyHash >>= getRewardAccountFor . KeyHashObj + rwdAccount1 <- registerRewardAccount + rwdAccount2 <- registerRewardAccount + let withdrawals = Map.fromList [(rwdAccount1, zero), (rwdAccount2, zero)] let wdrls = TreasuryWithdrawals Map.empty SNothing in expectPredFailures [ZeroTreasuryWithdrawals wdrls] [] wdrls let wdrls = TreasuryWithdrawals [(rwdAccount1, zero)] SNothing in expectPredFailures [ZeroTreasuryWithdrawals wdrls] [] wdrls - let wdrls = TreasuryWithdrawals [(rwdAccount1, zero), (rwdAccount2, zero)] SNothing + let wdrls = TreasuryWithdrawals withdrawals SNothing in expectPredFailures [ZeroTreasuryWithdrawals wdrls] [] wdrls rwdAccountRegistered <- registerRewardAccount @@ -1179,12 +1222,13 @@ withdrawalsSpec = in expectPredFailures [ZeroTreasuryWithdrawals wdrls] [] wdrls curProtVer <- getProtVer - let wdrls = [(rwdAccount1, zero), (rwdAccount2, Coin 100000)] - ga = TreasuryWithdrawals (Map.fromList wdrls) SNothing + let wdrls = Map.insert rwdAccount2 (Coin 100_000) withdrawals + ga = TreasuryWithdrawals wdrls SNothing in if HF.bootstrapPhase curProtVer then do expectPredFailures [] [] ga - else void $ submitTreasuryWithdrawals wdrls + else + submitGovAction_ ga where expectPredFailures :: [ConwayGovPredFailure era] -> [ConwayGovPredFailure era] -> GovAction era -> ImpTestM era () diff --git a/libs/cardano-ledger-core/CHANGELOG.md b/libs/cardano-ledger-core/CHANGELOG.md index 1e54694fb64..02a6022ccc7 100644 --- a/libs/cardano-ledger-core/CHANGELOG.md +++ b/libs/cardano-ledger-core/CHANGELOG.md @@ -2,6 +2,7 @@ ## 1.15.0.0 +* Add `member'` function to `UMap` module. #4639 * Add `credKeyHash` to `Credential` * Remove `maxMajorPV` from `Globals` * Add `deleteStakingCredential` and `extractStakingCredential` to `UMap` module. diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/UMap.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/UMap.hs index d467e72eec8..2fc897bec16 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/UMap.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/UMap.hs @@ -82,6 +82,7 @@ module Cardano.Ledger.UMap ( -- * Set and Map operations on `UView`s nullUView, member, + member', notMember, delete, delete', @@ -1002,6 +1003,10 @@ DRepUView UMap {umElems, umPtrs} ⋫ dRepSet = UMap (Map.foldlWithKey' accum umE _ -> ans rngDelete = (⋫) +-- | Checks for membership directly against `umElems` instead of a `UView`. +member' :: Credential 'Staking c -> UMap c -> Bool +member' k = Map.member k . umElems + -- | Membership check for a `UView`, just like `Map.member` -- -- Spec: diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Gov.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Gov.hs index f22a5658063..495a0acaa19 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Gov.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Gov.hs @@ -21,6 +21,7 @@ import Cardano.Ledger.Conway.Governance import Cardano.Ledger.Conway.Rules import Cardano.Ledger.Crypto (StandardCrypto) import Cardano.Ledger.Shelley.HardForks qualified as HardForks +import Cardano.Ledger.UMap (umElems) import Constrained import Constrained.Base (Pred (..)) import Data.Coerce @@ -46,7 +47,7 @@ govProposalsSpec :: IsConwayUniv fn => GovEnv (ConwayEra StandardCrypto) -> Specification fn (Proposals (ConwayEra StandardCrypto)) -govProposalsSpec GovEnv {geEpoch, gePPolicy} = +govProposalsSpec GovEnv {geEpoch, gePPolicy, geCertState} = constrained $ \ [var|props|] -> -- Note each of ppupTree, hardForkTree, committeeTree, constitutionTree -- have the pair type ProposalTree = (StrictMaybe (GovActionId StandardCrypto), [Tree GAS]) @@ -147,7 +148,10 @@ govProposalsSpec GovEnv {geEpoch, gePPolicy} = Block [ dependsOn gasOther withdrawMap , forAll (dom_ withdrawMap) $ \ [var|rewAcnt|] -> - match rewAcnt $ \ [var|network|] _ -> network ==. lit Testnet + match rewAcnt $ \ [var|network|] [var|credential|] -> + [ network ==. lit Testnet + , credential `member_` lit registeredCredentials + ] , assert $ policy ==. lit gePPolicy ] ) @@ -161,6 +165,7 @@ govProposalsSpec GovEnv {geEpoch, gePPolicy} = where treeGenHint = (Just 2, 10) listSizeHint = 5 + registeredCredentials = Map.keysSet $ umElems $ dsUnified $ certDState geCertState allGASInTree :: (IsConwayUniv fn, IsPred p fn) => @@ -298,6 +303,7 @@ govProceduresSpec ge@GovEnv {..} ps = actions isDRepVotingAllowed stakepoolVotableActionIds = actions isStakePoolVotingAllowed + registeredCredentials = Map.keysSet $ umElems $ dsUnified $ certDState geCertState in constrained $ \govSignal -> match govSignal $ \votingProcs proposalProcs _certificates -> [ match votingProcs $ \votingProcsMap -> @@ -322,9 +328,10 @@ govProceduresSpec ge@GovEnv {..} ps = , forAll proposalProcs $ \proc -> match proc $ \deposit returnAddr govAction _ -> [ assert $ deposit ==. lit (gePParams ^. ppGovActionDepositL) - , match returnAddr $ \net _cred -> + , match returnAddr $ \net cred -> [ dependsOn proc net , assert $ net ==. lit Testnet + , assert $ cred `member_` lit registeredCredentials ] , wfGovAction ge ps govAction ] @@ -336,7 +343,7 @@ wfGovAction :: Proposals (ConwayEra StandardCrypto) -> Term fn (GovAction (ConwayEra StandardCrypto)) -> Pred fn -wfGovAction GovEnv {gePPolicy, geEpoch, gePParams} ps govAction = +wfGovAction GovEnv {gePPolicy, geEpoch, gePParams, geCertState} ps govAction = caseOn govAction -- ParameterChange @@ -373,7 +380,10 @@ wfGovAction GovEnv {gePPolicy, geEpoch, gePParams} ps govAction = -- TreasuryWithdrawals ( branch $ \withdrawMap policy -> [ forAll (dom_ withdrawMap) $ \rewAcnt -> - match rewAcnt $ \net _ -> net ==. lit Testnet + match rewAcnt $ \net cred -> + [ net ==. lit Testnet + , cred `member_` lit registeredCredentials + ] , assert $ sum_ (rng_ withdrawMap) >. lit (Coin 0) , assert $ policy ==. lit gePPolicy , assert $ not $ HardForks.bootstrapPhase (gePParams ^. ppProtocolVersionL) @@ -402,6 +412,7 @@ wfGovAction GovEnv {gePPolicy, geEpoch, gePParams} ps govAction = -- InfoAction (branch $ \_ -> True) where + registeredCredentials = Map.keysSet $ umElems $ dsUnified $ certDState geCertState prevGovActionIds = ps ^. pRootsL . L.to toPrevGovActionIds constitutionIds = (prevGovActionIds ^. grConstitutionL) diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs index 712ca0ce769..43a89477bae 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs @@ -1548,6 +1548,8 @@ ppConwayGovPredFailure x = case x of DisallowedVotesDuringBootstrap m -> ppSexp "DisallowedVotesDuringBootstrap" [prettyA m] VotersDoNotExist m -> ppSexp "VotersDoNotExist" [prettyA m] ZeroTreasuryWithdrawals ga -> ppSexp "ZeroTreasuryWithdrawals" [pcGovAction ga] + ProposalReturnAccountDoesNotExist a -> ppSexp "ProposalReturnAccountDoesNotExist" [prettyA a] + TreasuryWithdrawalReturnAccountsDoNotExist a -> ppSexp "TreasuryWithdrawalReturnAccountsDoNotExist" [prettyA a] instance PrettyA (ConwayGovPredFailure era) where prettyA = ppConwayGovPredFailure