Merge pull request #4516 from IntersectMBO/td/default-dreps-test

Use `motionNoConfidence` drep thresholds to ratify `NoConfidence`

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
 

eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Internal.hs

@@ -505,14 +505,15 @@ votingDRepThresholdInternal pp isElectedCommittee action =
   let thresholds@DRepVotingThresholds
         { dvtCommitteeNoConfidence
         , dvtCommitteeNormal
+        , dvtMotionNoConfidence
         , dvtUpdateToConstitution
         , dvtHardForkInitiation
         , dvtTreasuryWithdrawal
         } -- We reset all (except InfoAction) DRep thresholds to 0 during bootstrap phase
           | HF.bootstrapPhase (pp ^. ppProtocolVersionL) = def
           | otherwise = pp ^. ppDRepVotingThresholdsL
    in case action of
-        NoConfidence {} -> VotingThreshold dvtCommitteeNoConfidence
+        NoConfidence {} -> VotingThreshold dvtMotionNoConfidence
         UpdateCommittee {} ->
           VotingThreshold $
             if isElectedCommittee

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

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