Merge pull request #4561 from IntersectMBO/ldan/realistic-spo-thresholds

Configure Imp tests with realistic SPO voting thresholds

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EpochSpec.hs

@@ -356,12 +356,14 @@ dRepVotingSpec =
 
       committeeHotCreds <- registerInitialCommittee
       (dRepCred, _, _) <- setupSingleDRep 1_000_000
+      (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
       passEpoch
       logRatificationChecks gid
       do
         isAccepted <- isDRepAccepted gid
         assertBool "Gov action should not be accepted" $ not isAccepted
       submitYesVote_ (DRepVoter dRepCred) gid
+      submitYesVote_ (StakePoolVoter spoC) gid
       submitYesVoteCCs_ committeeHotCreds gid
       logAcceptedRatio gid
       do

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovCertSpec.hs

@@ -43,12 +43,14 @@ spec = do
     NonNegative n <- arbitrary
     passNEpochs n
     (drepCred, _, _) <- setupSingleDRep 1_000_000
+    (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
     cc <- KeyHashObj <$> freshKeyHash
     EpochInterval committeeMaxTermLength <-
       getsNES $ nesEsL . curPParamsEpochStateL . ppCommitteeMaxTermLengthL
     secondAddCCGaid <-
       submitUpdateCommittee Nothing mempty [(cc, EpochInterval (committeeMaxTermLength + 2))] (1 %! 2)
     submitYesVote_ (DRepVoter drepCred) secondAddCCGaid
+    submitYesVote_ (StakePoolVoter spoC) secondAddCCGaid
     passNEpochs 2
     -- Due to longer than allowed lifetime we have to wait an extra epoch for this new action to be enacted
     expectCommitteeMemberAbsence cc
@@ -67,11 +69,13 @@ spec = do
   it "CC re-election" $
     do
       (drepCred, _, _) <- setupSingleDRep 1_000_000
+      (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
       passNEpochs 2
       -- Add a fresh CC
       cc <- KeyHashObj <$> freshKeyHash
       addCCGaid <- submitUpdateCommittee Nothing mempty [(cc, EpochInterval 10)] (1 %! 2)
       submitYesVote_ (DRepVoter drepCred) addCCGaid
+      submitYesVote_ (StakePoolVoter spoC) addCCGaid
       passNEpochs 2
       -- Confirm that they are added
       expectCommitteeMemberPresence cc
@@ -84,19 +88,22 @@ spec = do
       -- Re-add the same CC
       reAddCCGaid <- submitUpdateCommittee Nothing mempty [(cc, EpochInterval 20)] (1 %! 2)
       submitYesVote_ (DRepVoter drepCred) reAddCCGaid
+      submitYesVote_ (StakePoolVoter spoC) reAddCCGaid
       passNEpochs 2
       -- Confirm that they are still resigned
       ccShouldBeResigned cc
       -- Remove them
       removeCCGaid <-
         submitUpdateCommittee (Just (SJust $ GovPurposeId reAddCCGaid)) (Set.singleton cc) [] (1 %! 2)
       submitYesVote_ (DRepVoter drepCred) removeCCGaid
+      submitYesVote_ (StakePoolVoter spoC) removeCCGaid
       passNEpochs 2
       -- Confirm that they have been removed
       expectCommitteeMemberAbsence cc
       secondAddCCGaid <-
         submitUpdateCommittee Nothing mempty [(cc, EpochInterval 20)] (1 %! 2)
       submitYesVote_ (DRepVoter drepCred) secondAddCCGaid
+      submitYesVote_ (StakePoolVoter spoC) secondAddCCGaid
       passNEpochs 2
       -- Confirm that they have been added
       expectCommitteeMemberPresence cc

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovSpec.hs

@@ -860,6 +860,7 @@ votingSpec =
             & ppGovActionLifetimeL .~ EpochInterval 3
             & ppCommitteeMinSizeL .~ 2
         (dRepCred, _, _) <- setupSingleDRep 1_000_000
+        (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
         ccColdCred0 <- KeyHashObj <$> freshKeyHash
         ccColdCred1 <- KeyHashObj <$> freshKeyHash
         electionGovAction <-
@@ -871,6 +872,7 @@ votingSpec =
             ]
             (3 %! 5)
         submitYesVote_ (DRepVoter dRepCred) electionGovAction
+        submitYesVote_ (StakePoolVoter spoC) electionGovAction
         logAcceptedRatio electionGovAction
         passNEpochs 3
         expectNoCurrentProposals

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs

@@ -113,6 +113,7 @@ committeeExpiryResignationDiscountSpec =
     it "Expired" $ do
       modifyPParams $ ppCommitteeMinSizeL .~ 2
       (drep, _, _) <- setupSingleDRep 1_000_000
+      (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
       -- Elect a committee of 2 members
       committeeColdC1 <- KeyHashObj <$> freshKeyHash
       committeeColdC2 <- KeyHashObj <$> freshKeyHash
@@ -125,6 +126,7 @@ committeeExpiryResignationDiscountSpec =
           ]
           (1 %! 2)
       submitYesVote_ (DRepVoter drep) gaiCC
+      submitYesVote_ (StakePoolVoter spoC) gaiCC
       passNEpochs 2
       getLastEnactedCommittee `shouldReturn` SJust (GovPurposeId gaiCC)
       committeeHotC1 <- registerCommitteeHotKey committeeColdC1
@@ -143,6 +145,7 @@ committeeExpiryResignationDiscountSpec =
     it "Resigned" $ do
       modifyPParams $ ppCommitteeMinSizeL .~ 2
       (drep, _, _) <- setupSingleDRep 1_000_000
+      (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
       -- Elect a committee of 2 members
       committeeColdC1 <- KeyHashObj <$> freshKeyHash
       committeeColdC2 <- KeyHashObj <$> freshKeyHash
@@ -155,6 +158,7 @@ committeeExpiryResignationDiscountSpec =
           ]
           (1 %! 2)
       submitYesVote_ (DRepVoter drep) gaiCC
+      submitYesVote_ (StakePoolVoter spoC) gaiCC
       passNEpochs 2
       getLastEnactedCommittee `shouldReturn` SJust (GovPurposeId gaiCC)
       committeeHotC1 <- registerCommitteeHotKey committeeColdC1
@@ -231,12 +235,15 @@ paramChangeAffectsProposalsSpec =
         (drepC, hotCommitteeC, _) <- electBasicCommittee
         setThreshold largerThreshold
         (drep, _, _) <- setupSingleDRep 1_000_000
-        (gaiParent, gaiChild) <- submitTwoExampleProposalsAndVoteOnTheChild [] [(drep, VoteYes)]
+        (spoC, _, _) <- setupPoolWithStake $ Coin 1_000_000
+        (gaiParent, gaiChild) <-
+          submitTwoExampleProposalsAndVoteOnTheChild [(spoC, VoteYes)] [(drep, VoteYes)]
         isDRepAccepted gaiChild `shouldReturn` False
         enactThreshold smallerThreshold drepC hotCommitteeC
         isDRepAccepted gaiChild `shouldReturn` True
         -- Not vote on the parent too to make sure both get enacted
         submitYesVote_ (DRepVoter drep) gaiParent
+        submitYesVote_ (StakePoolVoter spoC) gaiParent
         passNEpochs 2
         getLastEnactedCommittee `shouldReturn` SJust (GovPurposeId gaiParent)
         passEpoch -- UpdateCommittee is a delaying action
@@ -368,6 +375,7 @@ committeeMinSizeAffectsInFlightProposalsSpec =
       getsNES (nesEsL . esAccountStateL . asTreasuryL) `shouldReturn` treasury
     it "TreasuryWithdrawal ratifies due to a decrease in CommitteeMinSize" $ do
       (drepC, hotCommitteeC, _) <- electBasicCommittee
+      (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
       amount <- uniformRM (Coin 1, Coin 100_000_000)
       -- Ensure sufficient amount in the treasury
       submitTx_ $ mkBasicTx (mkBasicTxBody & treasuryDonationTxBodyL .~ amount)
@@ -386,6 +394,7 @@ committeeMinSizeAffectsInFlightProposalsSpec =
       coldCommitteeCred <- KeyHashObj <$> freshKeyHash
       gaiCC <- submitUpdateCommittee Nothing mempty [(coldCommitteeCred, EpochInterval 10)] (1 %! 2)
       submitYesVote_ (DRepVoter drepC) gaiCC
+      submitYesVote_ (StakePoolVoter spoC) gaiCC
       passNEpochs 2
       _hotCommitteeC' <- registerCommitteeHotKey coldCommitteeCred
       isCommitteeAccepted gaiTW `shouldReturn` True
@@ -467,7 +476,7 @@ votingSpec =
       initMinFeeA <- getsNES $ nesEsL . curPParamsEpochStateL . ppMinFeeAL
       gaidThreshold <- impAnn "Update StakePool thresholds" $ do
         pp <- getsNES $ nesEsL . curPParamsEpochStateL
-        (pp ^. ppPoolVotingThresholdsL . pvtPPSecurityGroupL) `shouldBe` minBound
+        (pp ^. ppPoolVotingThresholdsL . pvtPPSecurityGroupL) `shouldBe` (51 %! 100)
         rew <- registerRewardAccount
         let ppUpdate =
               emptyPParamsUpdate
@@ -540,11 +549,13 @@ votingSpec =
           (drep1, KeyHashObj stakingKH1, paymentKP1) <- setupSingleDRep 1_000_000_000
           -- Setup DRep delegation #2
           _ <- setupSingleDRep 1_000_000_000
+          (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
           -- Submit a committee proposal
           cc <- KeyHashObj <$> freshKeyHash
           addCCGaid <- submitUpdateCommittee Nothing mempty [(cc, EpochInterval 10)] (75 %! 100)
           -- Submit the vote
           submitVote_ VoteYes (DRepVoter drep1) addCCGaid
+          submitYesVote_ (StakePoolVoter spoC) addCCGaid
           passNEpochs 2
           -- The vote should not result in a ratification
           isDRepAccepted addCCGaid `shouldReturn` False
@@ -561,11 +572,13 @@ votingSpec =
           (drep1, staking1, _) <- setupSingleDRep 1_000_000_000
           -- Setup DRep delegation #2
           _ <- setupSingleDRep 1_000_000_000
+          (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
           -- Submit a committee proposal
           cc <- KeyHashObj <$> freshKeyHash
           addCCGaid <- submitUpdateCommittee Nothing mempty [(cc, EpochInterval 10)] (75 %! 100)
           -- Submit the vote
           submitVote_ VoteYes (DRepVoter drep1) addCCGaid
+          submitYesVote_ (StakePoolVoter spoC) addCCGaid
           passNEpochs 2
           -- The vote should not result in a ratification
           isDRepAccepted addCCGaid `shouldReturn` False
@@ -599,6 +612,7 @@ votingSpec =
           lookupReward (KeyHashObj stakingKH1) `shouldReturn` govActionDeposit
           -- Setup DRep delegation #2
           (_drepKH2, stakingKH2) <- setupDRepWithoutStake
+          (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
           -- Add rewards to delegation #2
           submitAndExpireProposalToMakeReward $ KeyHashObj stakingKH2
           lookupReward (KeyHashObj stakingKH2) `shouldReturn` govActionDeposit
@@ -609,6 +623,7 @@ votingSpec =
           addCCGaid <- submitUpdateCommittee Nothing mempty [(cc, lifetime)] (75 %! 100)
           -- Submit the vote
           submitVote_ VoteYes (DRepVoter $ KeyHashObj drepKH1) addCCGaid
+          submitYesVote_ (StakePoolVoter spoC) addCCGaid
           passNEpochs 2
           -- The vote should not result in a ratification
           isDRepAccepted addCCGaid `shouldReturn` False
@@ -629,6 +644,7 @@ votingSpec =
             (drepKH1, stakingKH1) <- setupDRepWithoutStake
             -- Setup DRep delegation #2
             (_drepKH2, _stakingKH2, _paymentKP2) <- setupSingleDRep 1_000_000
+            (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
             -- Make a note of the reward account for the delegator to DRep #1
             dRepRewardAccount <- getRewardAccountFor $ KeyHashObj stakingKH1
             -- Submit the first committee proposal, the one we will test active voting stake against.
@@ -647,6 +663,7 @@ votingSpec =
                   }
             -- Submit the vote from DRep #1
             submitVote_ VoteYes (DRepVoter $ KeyHashObj drepKH1) addCCGaid
+            submitYesVote_ (StakePoolVoter spoC) addCCGaid
             passNEpochs 2
             -- The vote should not result in a ratification
             isDRepAccepted addCCGaid `shouldReturn` False
@@ -674,6 +691,7 @@ votingSpec =
             (_drepKH2, _stakingKH2, _paymentKP2) <- setupSingleDRep 1_000_000
             -- Setup DRep delegation #3
             (_drepKH3, stakingKH3) <- setupDRepWithoutStake
+            (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
             -- Make a note of the reward accounts for the delegators to DReps #1 and #3
             dRepRewardAccount1 <- getRewardAccountFor $ KeyHashObj stakingKH1
             dRepRewardAccount3 <- getRewardAccountFor $ KeyHashObj stakingKH3
@@ -706,6 +724,7 @@ votingSpec =
                 }
             -- Submit the vote from DRep #1
             submitVote_ VoteYes (DRepVoter $ KeyHashObj drepKH1) addCCGaid
+            submitYesVote_ (StakePoolVoter spoC) addCCGaid
             passNEpochs 2
             -- The vote should not result in a ratification
             isDRepAccepted addCCGaid `shouldReturn` False
@@ -760,10 +779,12 @@ votingSpec =
           -- in order to make it necessary to redelegate to AlwaysNoConfidence,
           -- rather than just unregister
           (drep3, _, _) <- setupSingleDRep 1_000_000
+          (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
 
           noConfidenceGovId <- submitGovAction $ NoConfidence (SJust committeeGovId)
           submitYesVote_ (DRepVoter drep1) noConfidenceGovId
           submitVote_ VoteNo (DRepVoter drep3) noConfidenceGovId
+          submitYesVote_ (StakePoolVoter spoC) noConfidenceGovId
           passEpoch
           -- drep1 doesn't have enough stake to enact NoConfidence
           isDRepAccepted noConfidenceGovId `shouldReturn` False
@@ -1231,11 +1252,12 @@ delayingActionsSpec =
               let members = Map.keysSet $ foldMap' committeeMembers committee
               impAnn "Expecting committee members" $ members `shouldBe` expKhs
         (drep, _, _) <- setupSingleDRep 1_000_000
+        (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
         maxTermLength <-
           getsNES $
             nesEsL . esLStateL . lsUTxOStateL . utxosGovStateL . curPParamsGovStateL . ppCommitteeMaxTermLengthL
 
-        void registerInitialCommittee
+        hks <- registerInitialCommittee
         initialMembers <- getCommitteeMembers
 
         (membersExceedingExpiry, exceedingExpiry) <-
@@ -1246,14 +1268,15 @@ delayingActionsSpec =
             c4 <- freshKeyHash
             currentEpoch <- getsNES nesELL
             let exceedingExpiry = addEpochInterval (addEpochInterval currentEpoch maxTermLength) (EpochInterval 7)
-            let membersExceedingExpiry = [(KeyHashObj c3, exceedingExpiry), (KeyHashObj c4, addEpochInterval currentEpoch maxTermLength)]
-            _ <-
+                membersExceedingExpiry = [(KeyHashObj c3, exceedingExpiry), (KeyHashObj c4, addEpochInterval currentEpoch maxTermLength)]
+            GovPurposeId gaid <-
               electCommittee
                 SNothing
                 drep
                 Set.empty
                 membersExceedingExpiry
-            passEpoch >> passEpoch
+            submitYesVote_ (StakePoolVoter spoC) gaid
+            passNEpochs 2
             -- the new committee has not been enacted
             expectMembers initialMembers
             pure (Map.keysSet membersExceedingExpiry, exceedingExpiry)
@@ -1262,10 +1285,9 @@ delayingActionsSpec =
         govIdConst1 <- impAnn "Other actions are ratified and enacted" $ do
           (govIdConst1, constitution) <- submitConstitution SNothing
           submitYesVote_ (DRepVoter drep) govIdConst1
-          hks <- traverse registerCommitteeHotKey (Set.toList initialMembers)
-          traverse_ (\m -> submitYesVote_ (CommitteeVoter m) govIdConst1) hks
+          submitYesVoteCCs_ hks govIdConst1
 
-          passEpoch >> passEpoch
+          passNEpochs 2
           curConstitution <- getsNES $ newEpochStateGovStateL . constitutionGovStateL
           curConstitution `shouldBe` constitution
           pure govIdConst1
@@ -1286,9 +1308,9 @@ delayingActionsSpec =
         impAnn "New committee can vote" $ do
           (govIdConst2, constitution) <- submitConstitution $ SJust (GovPurposeId govIdConst1)
           submitYesVote_ (DRepVoter drep) govIdConst2
-          hks <- traverse registerCommitteeHotKey (Set.toList membersExceedingExpiry)
-          traverse_ (\m -> submitYesVote_ (CommitteeVoter m) govIdConst2) hks
+          hks' <- traverse registerCommitteeHotKey (Set.toList membersExceedingExpiry)
+          submitYesVoteCCs_ hks' govIdConst2
 
-          passEpoch >> passEpoch
+          passNEpochs 2
           curConstitution <- getsNES $ newEpochStateGovStateL . constitutionGovStateL
           curConstitution `shouldBe` constitution

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs

@@ -280,12 +280,12 @@ instance
         { cgUpgradePParams =
             UpgradeConwayPParams
               { ucppPoolVotingThresholds =
-                  PoolVotingThresholds -- FIXME: https://github.com/IntersectMBO/cardano-ledger/issues/4329
-                    { pvtMotionNoConfidence = 0 %! 1
-                    , pvtCommitteeNormal = 0 %! 1
-                    , pvtCommitteeNoConfidence = 0 %! 1
-                    , pvtHardForkInitiation = 0 %! 1
-                    , pvtPPSecurityGroup = 0 %! 1
+                  PoolVotingThresholds
+                    { pvtMotionNoConfidence = 51 %! 100
+                    , pvtCommitteeNormal = 51 %! 100
+                    , pvtCommitteeNoConfidence = 51 %! 100
+                    , pvtHardForkInitiation = 51 %! 100
+                    , pvtPPSecurityGroup = 51 %! 100
                     }
               , ucppDRepVotingThresholds =
                   DRepVotingThresholds
@@ -1303,6 +1303,7 @@ electBasicCommittee ::
 electBasicCommittee = do
   logEntry "Setting up a DRep"
   (drep, _, _) <- setupSingleDRep 1_000_000
+  (spoC, _, _) <- setupPoolWithStake $ Coin 1_000_000
 
   logEntry "Registering committee member"
   coldCommitteeC <- KeyHashObj <$> freshKeyHash
@@ -1320,6 +1321,7 @@ electBasicCommittee = do
       , UpdateCommittee SNothing mempty mempty (1 %! 10)
       ]
   submitYesVote_ (DRepVoter drep) gaidCommitteeProp
+  submitYesVote_ (StakePoolVoter spoC) gaidCommitteeProp
   passEpoch
   passEpoch
   committeeMembers <- getCommitteeMembers