From ed6e583bd28c10416f9bada2d26a7cb454766f32 Mon Sep 17 00:00:00 2001 From: teodanciu Date: Tue, 30 Jul 2024 12:07:05 +0100 Subject: [PATCH 1/2] Use `motionNoConfidence` drep thresholds to ratify `NoConfidence` --- .../impl/src/Cardano/Ledger/Conway/Governance/Internal.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Internal.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Internal.hs index da39ef3537e..afaee0b27c7 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Internal.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Internal.hs @@ -505,6 +505,7 @@ votingDRepThresholdInternal pp isElectedCommittee action = let thresholds@DRepVotingThresholds { dvtCommitteeNoConfidence , dvtCommitteeNormal + , dvtMotionNoConfidence , dvtUpdateToConstitution , dvtHardForkInitiation , dvtTreasuryWithdrawal @@ -512,7 +513,7 @@ votingDRepThresholdInternal pp isElectedCommittee action = | HF.bootstrapPhase (pp ^. ppProtocolVersionL) = def | otherwise = pp ^. ppDRepVotingThresholdsL in case action of - NoConfidence {} -> VotingThreshold dvtCommitteeNoConfidence + NoConfidence {} -> VotingThreshold dvtMotionNoConfidence UpdateCommittee {} -> VotingThreshold $ if isElectedCommittee From 1b07a6ac0b98b171545f5c922ee1f74997448a77 Mon Sep 17 00:00:00 2001 From: teodanciu Date: Tue, 30 Jul 2024 19:05:08 +0100 Subject: [PATCH 2/2] Add tests checking default dreps impact on ratification --- eras/conway/impl/CHANGELOG.md | 1 + .../Cardano/Ledger/Conway/Imp/RatifySpec.hs | 110 +++++++++++++++++- .../Test/Cardano/Ledger/Conway/ImpTest.hs | 51 +++++++- 3 files changed, 156 insertions(+), 6 deletions(-) diff --git a/eras/conway/impl/CHANGELOG.md b/eras/conway/impl/CHANGELOG.md index c12b9b7f8b5..33047dd4664 100644 --- a/eras/conway/impl/CHANGELOG.md +++ b/eras/conway/impl/CHANGELOG.md @@ -3,6 +3,7 @@ ## 1.16.1.0 * Added `Eq`, `Show`, `NFData` and `Generic` instances for `CertsEnv` +* Add `delegateToDRep` and `redelegateDRep` ### testlib diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs index 28cbc4f9b13..0dbb0243644 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs @@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Test.Cardano.Ledger.Conway.Imp.RatifySpec ( spec, @@ -23,11 +24,12 @@ import Cardano.Ledger.Keys import Cardano.Ledger.Shelley.HardForks (bootstrapPhase) import Cardano.Ledger.Shelley.LedgerState import qualified Cardano.Ledger.UMap as UM -import Cardano.Ledger.Val ((<->)) +import Cardano.Ledger.Val (zero, (<->)) import Data.Default.Class (def) import Data.Foldable import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map +import Data.Ratio ((%)) import qualified Data.Sequence.Strict as SSeq import qualified Data.Set as Set import Lens.Micro @@ -725,6 +727,112 @@ votingSpec = passNEpochs 2 -- The same vote should now successfully ratify the proposal getLastEnactedCommittee `shouldReturn` SJust (GovPurposeId addCCGaid) + describe "Predefined DReps" $ do + it "acceptedRatio with default DReps" $ do + (drep1, _, committeeGovId) <- electBasicCommittee + (drep2, drep2Staking, _) <- setupSingleDRep 1_000_000 + + paramChangeGovId <- submitParameterChange SNothing $ def & ppuMinFeeAL .~ SJust (Coin 3000) + submitYesVote_ (DRepVoter drep1) paramChangeGovId + + passEpoch + calculateDRepAcceptedRatio paramChangeGovId `shouldReturn` 1 % 2 + + _ <- delegateToDRep 1_000_000 DRepAlwaysNoConfidence + passEpoch + -- AlwaysNoConfidence vote acts like a 'No' vote for actions other than NoConfidence + calculateDRepAcceptedRatio paramChangeGovId `shouldReturn` 1 % 3 + + redelegateDRep drep2 DRepAlwaysAbstain drep2Staking + passEpoch + -- AlwaysAbstain vote acts like 'Abstain' vote + calculateDRepAcceptedRatio paramChangeGovId `shouldReturn` 1 % 2 + + noConfidenceGovId <- submitGovAction $ NoConfidence (SJust committeeGovId) + submitYesVote_ (DRepVoter drep1) noConfidenceGovId + passEpoch + -- AlwaysNoConfidence vote acts like 'Yes' for NoConfidence actions + calculateDRepAcceptedRatio noConfidenceGovId `shouldReturn` 2 % 2 + + it "AlwaysNoConfidence" $ do + (drep1, _, committeeGovId) <- electBasicCommittee + initialMembers <- getCommitteeMembers + modifyPParams $ + ppDRepVotingThresholdsL .~ (def & dvtMotionNoConfidenceL .~ 51 %! 100) + + -- drep2 won't explicitly vote, but eventually delegate to AlwaysNoConfidence + (drep2, drep2Staking, _) <- setupSingleDRep 1_000_000 + + -- we register another drep with the same stake as drep1, which will vote No - + -- in order to make it necessary to redelegate to AlwaysNoConfidence, + -- rather than just unregister + (drep3, _, _) <- setupSingleDRep 1_000_000 + + noConfidenceGovId <- submitGovAction $ NoConfidence (SJust committeeGovId) + submitYesVote_ (DRepVoter drep1) noConfidenceGovId + void $ submitVote VoteNo (DRepVoter drep3) noConfidenceGovId + passEpoch + -- drep1 doesn't have enough stake to enact NoConfidence + isDRepAccepted noConfidenceGovId `shouldReturn` False + passEpoch + getCommitteeMembers `shouldReturn` initialMembers + deposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL + + -- drep2 unregisters, but NoConfidence still doesn't pass, because there's a tie between drep1 and drep3 + submitTxAnn_ "Unregister drep2" $ + mkBasicTx mkBasicTxBody + & bodyTxL . certsTxBodyL + .~ SSeq.fromList + [ UnRegDRepTxCert @era + drep2 + deposit + ] + passEpoch + isDRepAccepted noConfidenceGovId `shouldReturn` False + + submitTxAnn_ "Redelegate to AlwaysNoConfidence " $ + mkBasicTx mkBasicTxBody + & bodyTxL . certsTxBodyL + .~ SSeq.fromList + [ DelegTxCert @era + drep2Staking + (DelegVote DRepAlwaysNoConfidence) + ] + passEpoch + isDRepAccepted noConfidenceGovId `shouldReturn` True + passEpoch + getCommitteeMembers `shouldReturn` mempty + + it "AlwaysAbstain" $ do + let getTreasury = getsNES (nesEsL . esAccountStateL . asTreasuryL) + + (drep1, comMember, _) <- electBasicCommittee + initialTreasury <- getTreasury + modifyPParams $ + ppDRepVotingThresholdsL .~ (def & dvtTreasuryWithdrawalL .~ 51 %! 100) + + (drep2, drep2Staking, _) <- setupSingleDRep 1_000_000 + + rewardAccount <- registerRewardAccount + govId <- submitTreasuryWithdrawals [(rewardAccount, initialTreasury)] + + submitYesVote_ (CommitteeVoter comMember) govId + submitYesVote_ (DRepVoter drep1) govId + void $ submitVote VoteNo (DRepVoter drep2) govId + passEpoch + -- drep1 doesn't have enough stake to enact the withdrawals + isDRepAccepted govId `shouldReturn` False + passEpoch + getTreasury `shouldReturn` initialTreasury + + redelegateDRep drep2 DRepAlwaysAbstain drep2Staking + + passEpoch + -- the delegation turns the No vote into an Abstain, enough to pass the action + isDRepAccepted govId `shouldReturn` True + passEpoch + getTreasury `shouldReturn` zero + describe "StakePool" $ do it "UTxOs contribute to active voting stake" $ do -- Only modify the applicable thresholds diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs index bfc0f1cd91d..1d6755ceda8 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs @@ -43,6 +43,8 @@ module Test.Cardano.Ledger.Conway.ImpTest ( registerDRep, unRegisterDRep, updateDRep, + delegateToDRep, + redelegateDRep, setupSingleDRep, setupDRepWithoutStake, setupPoolWithStake, @@ -397,8 +399,7 @@ updateDRep drep = do .~ SSeq.singleton (UpdateDRepTxCert drep mAnchor) -- | In contrast to `setupSingleDRep`, this function does not make a UTxO entry --- that could count as delegated stake to the DRep, so that we can test that --- rewards are also calculated nonetheless. +-- that could count as delegated stake to the DRep setupDRepWithoutStake :: forall era. ( ConwayEraTxCert era @@ -439,8 +440,25 @@ setupSingleDRep :: ) setupSingleDRep stake = do drepKH <- registerDRep + (stakingCred, spendingKh) <- delegateToDRep stake (DRepCredential (KeyHashObj drepKH)) + pure (KeyHashObj drepKH, stakingCred, spendingKh) + +delegateToDRep :: + forall era. + ( ConwayEraTxCert era + , ShelleyEraImp era + ) => + Integer -> + DRep (EraCrypto era) -> + ImpTestM + era + ( Credential 'Staking (EraCrypto era) + , KeyPair 'Payment (EraCrypto era) + ) +delegateToDRep stake dRep = do (delegatorKH, delegatorKP) <- freshKeyPair (_, spendingKP) <- freshKeyPair + deposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL submitTxAnn_ "Delegate to DRep" $ mkBasicTx mkBasicTxBody & bodyTxL . outputsTxBodyL @@ -453,10 +471,33 @@ setupSingleDRep stake = do .~ SSeq.fromList [ RegDepositDelegTxCert @era (KeyHashObj delegatorKH) - (DelegVote (DRepCredential $ KeyHashObj drepKH)) - zero + (DelegVote dRep) + deposit + ] + pure (KeyHashObj delegatorKH, spendingKP) + +redelegateDRep :: + forall era. + ( ConwayEraTxCert era + , ShelleyEraImp era + ) => + Credential 'DRepRole (EraCrypto era) -> + DRep (EraCrypto era) -> + Credential 'Staking (EraCrypto era) -> + ImpTestM era () +redelegateDRep dRepCred newDRep stakingCred = do + deposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL + submitTx_ $ + mkBasicTx mkBasicTxBody + & bodyTxL . certsTxBodyL + .~ SSeq.fromList + [ UnRegDRepTxCert @era + dRepCred + deposit + , DelegTxCert @era + stakingCred + (DelegVote newDRep) ] - pure (KeyHashObj drepKH, KeyHashObj delegatorKH, spendingKP) getsPParams :: EraGov era => Lens' (PParams era) a -> ImpTestM era a getsPParams f = getsNES $ nesEsL . curPParamsEpochStateL . f