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 bdd9172e0b2..21b62f1538e 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 @@ -143,6 +143,27 @@ spoAndCCVotingSpec = do getLastEnactedParameterChange `shouldReturn` SNothing getsPParams ppMinFeeRefScriptCostPerByteL `shouldReturn` initialRefScriptBaseFee + -- https://github.com/IntersectMBO/cardano-ledger/issues/5418 + -- TODO: Re-enable after issue is resolved, by removing this override + disableInConformanceIt "Committee proposals pass" $ + whenPostBootstrap $ do + modifyPParams $ \pp -> + pp + & ppCommitteeMinSizeL .~ 2 + & ppCommitteeMaxTermLengthL .~ EpochInterval 50 + committeeActionId <- setupActiveInactiveCCMembers 1 1 (1 %! 1) + committeeProposal <- + elements + [ NoConfidence (SJust (GovPurposeId committeeActionId)) + , UpdateCommittee (SJust (GovPurposeId committeeActionId)) Set.empty [] (0 %! 1) + ] + committeeActionId2 <- submitGovAction committeeProposal + (drep, _, _) <- setupSingleDRep 2_000_000_000 + (spo, _, _) <- setupPoolWithStake $ Coin 2_000_000_000 + submitYesVote_ (DRepVoter drep) committeeActionId2 + submitYesVote_ (StakePoolVoter spo) committeeActionId2 + passNEpochs 2 + getLastEnactedCommittee `shouldReturn` SJust (GovPurposeId committeeActionId2) describe "When CC threshold is 0" $ do -- During the bootstrap phase, proposals that modify the committee are not allowed, -- hence we need to directly set the threshold for the initial members @@ -198,86 +219,132 @@ spoAndCCVotingSpec = do else do getLastEnactedParameterChange `shouldReturn` SNothing newRefScriptBaseFee `shouldBe` initialRefScriptBaseFee - it "Constitution cannot be changed if active committee size is below min size" + describe "When min size is not 0" $ do + it "Constitution cannot be changed if active committee size is below min size" + . whenPostBootstrap + $ do + modifyPParams $ \pp -> + pp + & ppDRepVotingThresholdsL . dvtUpdateToConstitutionL .~ (0 %! 1) + & ppCommitteeMinSizeL .~ 2 + & ppCommitteeMaxTermLengthL .~ EpochInterval 50 + void $ setupActiveInactiveCCMembers 1 1 (0 %! 1) + newConstitution <- arbitrary + constitutionActionId <- submitGovAction $ NewConstitution SNothing newConstitution + logRatificationChecks constitutionActionId + getConstitution `shouldNotReturn` newConstitution + -- https://github.com/IntersectMBO/cardano-ledger/issues/5418 + -- TODO: Re-enable after issue is resolved, by removing this override + disableInConformanceIt + "Constitution cannot be changed if committee is not active because it doesn't have registered hot credentials" + $ whenPostBootstrap + $ do + modifyPParams $ \pp -> + pp + & ppCommitteeMinSizeL .~ 2 + modifyCommittee $ fmap (committeeThresholdL .~ 0 %! 1) + (drep, _, _) <- setupSingleDRep 1_000_000_000 + SJust committee <- getCommittee + committeeThreshold committee `shouldBe` 0 %! 1 + Map.size (committeeMembers committee) `shouldBe` 2 + forM_ (Map.keys $ committeeMembers committee) ccShouldNotBeExpired + oldConstitution <- getConstitution + (proposal, _) <- mkConstitutionProposal SNothing + gaiConstitution <- submitProposal proposal + submitYesVote_ (DRepVoter drep) gaiConstitution + passNEpochs 2 + getConstitution `shouldReturn` oldConstitution + it + "Constitution can be changed when an active committee doesn't vote" + $ whenPostBootstrap + $ do + modifyPParams $ \pp -> + pp + & ppCommitteeMinSizeL .~ 2 + modifyCommittee $ fmap (committeeThresholdL .~ 0 %! 1) + (drep, _, _) <- setupSingleDRep 1_000_000_000 + SJust committee <- getCommittee + committeeThreshold committee `shouldBe` 0 %! 1 + Map.size (committeeMembers committee) `shouldBe` 2 + forM_ (Map.keys $ committeeMembers committee) ccShouldNotBeExpired + (proposal, newConstitution) <- mkConstitutionProposal SNothing + gaiConstitution <- submitProposal proposal + submitYesVote_ (DRepVoter drep) gaiConstitution + mapM_ registerCommitteeHotKey (Map.keys $ committeeMembers committee) + passNEpochs 2 + getConstitution `shouldReturn` newConstitution + it + "Constitution can be changed regardless of active committee votes" + $ whenPostBootstrap + $ do + modifyPParams $ \pp -> + pp + & ppCommitteeMinSizeL .~ 2 + modifyCommittee $ fmap (committeeThresholdL .~ 0 %! 1) + (drep, _, _) <- setupSingleDRep 1_000_000_000 + SJust committee <- getCommittee + committeeThreshold committee `shouldBe` 0 %! 1 + Map.size (committeeMembers committee) `shouldBe` 2 + forM_ (Map.keys $ committeeMembers committee) ccShouldNotBeExpired + (proposal, newConstitution) <- mkConstitutionProposal SNothing + gaiConstitution <- submitProposal proposal + submitYesVote_ (DRepVoter drep) gaiConstitution + hotKeys <- mapM registerCommitteeHotKey (Map.keys $ committeeMembers committee) + forM_ hotKeys $ \c -> + oneof + [ return () + , submitYesVote_ (CommitteeVoter c) gaiConstitution + , submitVote_ VoteNo (CommitteeVoter c) gaiConstitution + ] + passNEpochs 2 + getConstitution `shouldReturn` newConstitution + describe "When min size is 0" $ do + it + "Constitution can be changed if the commitee is inactive but has some active members" + . whenPostBootstrap + $ do + modifyPParams $ \pp -> + pp + & ppDRepVotingThresholdsL . dvtUpdateToConstitutionL .~ (0 %! 1) + & ppCommitteeMinSizeL .~ 0 + & ppCommitteeMaxTermLengthL .~ EpochInterval 50 + void $ setupActiveInactiveCCMembers 1 1 (0 %! 1) + newConstitution <- arbitrary + constitutionActionId <- submitGovAction $ NewConstitution SNothing newConstitution + logRatificationChecks constitutionActionId + passNEpochs 2 + getConstitution `shouldReturn` newConstitution + it + "Constitution can be changed if there are no active members" + . whenPostBootstrap + $ do + modifyPParams $ \pp -> + pp + & ppCommitteeMinSizeL .~ 0 + & ppDRepVotingThresholdsL . dvtUpdateToConstitutionL .~ (0 %! 1) + modifyCommittee $ fmap (committeeThresholdL .~ 0 %! 1) + SJust committee <- getCommittee + forM_ (Map.keys $ committeeMembers committee) ccShouldNotBeExpired + newConstitution <- arbitrary + constitutionActionId <- submitGovAction $ NewConstitution SNothing newConstitution + logRatificationChecks constitutionActionId + passNEpochs 2 + getConstitution `shouldReturn` newConstitution + describe "When CC threshold is not 0" $ do + it "Constitution cannot be changed if min committee size is 0" . whenPostBootstrap $ do modifyPParams $ \pp -> pp & ppDRepVotingThresholdsL . dvtUpdateToConstitutionL .~ (0 %! 1) - & ppCommitteeMinSizeL .~ 2 + & ppCommitteeMinSizeL .~ 0 & ppCommitteeMaxTermLengthL .~ EpochInterval 50 - coldCommitteeActive <- KeyHashObj <$> freshKeyHash - coldCommitteeInactive <- KeyHashObj <$> freshKeyHash - startingEpoch <- getsNES nesELL - maxTermLength <- getsPParams ppCommitteeMaxTermLengthL - (dRep, _, _) <- setupSingleDRep 1_000_000_000 - (spo, _, _) <- setupPoolWithStake $ Coin 1_000_000_000 - let - committeeMap = - [ (coldCommitteeActive, addEpochInterval startingEpoch maxTermLength) - , (coldCommitteeInactive, addEpochInterval startingEpoch $ EpochInterval 5) - ] - initialCommittee <- getCommitteeMembers - committeeActionId <- - impAnn "Submit committee update" - . submitGovAction - $ UpdateCommittee - SNothing - initialCommittee - committeeMap - (0 %! 1) - submitYesVote_ (DRepVoter dRep) committeeActionId - submitYesVote_ (StakePoolVoter spo) committeeActionId - passNEpochs 2 - getCommitteeMembers `shouldReturn` Map.keysSet committeeMap - passNEpochs 3 + void $ setupActiveInactiveCCMembers 1 1 (1 %! 1) newConstitution <- arbitrary constitutionActionId <- submitGovAction $ NewConstitution SNothing newConstitution logRatificationChecks constitutionActionId passNEpochs 2 getConstitution `shouldNotReturn` newConstitution - -- https://github.com/IntersectMBO/cardano-ledger/issues/5418 - -- TODO: Re-enable after issue is resolved, by removing this override - disableInConformanceIt "Committee proposals pass with inactive committee" $ - whenPostBootstrap $ do - modifyPParams $ \pp -> - pp - & ppCommitteeMinSizeL .~ 2 - & ppCommitteeMaxTermLengthL .~ EpochInterval 50 - coldCommitteeActive <- KeyHashObj <$> freshKeyHash - coldCommitteeInactive <- KeyHashObj <$> freshKeyHash - startingEpoch <- getsNES nesELL - maxTermLength <- getsPParams ppCommitteeMaxTermLengthL - (drep, _, _) <- setupSingleDRep 1_000_000_000 - (spo, _, _) <- setupPoolWithStake $ Coin 1_000_000_000 - let - committeeMap = - [ (coldCommitteeActive, addEpochInterval startingEpoch maxTermLength) - , (coldCommitteeInactive, addEpochInterval startingEpoch $ EpochInterval 5) - ] - initialCommittee <- getCommitteeMembers - committeeActionId <- - impAnn "Submit committee update" - . submitGovAction - $ UpdateCommittee - SNothing - initialCommittee - committeeMap - (0 %! 1) - submitYesVote_ (DRepVoter drep) committeeActionId - submitYesVote_ (StakePoolVoter spo) committeeActionId - passNEpochs 5 - getCommitteeMembers `shouldReturn` Map.keysSet committeeMap - committeeProposal <- - elements - [ NoConfidence (SJust (GovPurposeId committeeActionId)) - , UpdateCommittee (SJust (GovPurposeId committeeActionId)) Set.empty [] (0 %! 1) - ] - committeeActionId2 <- submitGovAction committeeProposal - submitYesVote_ (DRepVoter drep) committeeActionId2 - submitYesVote_ (StakePoolVoter spo) committeeActionId2 - passNEpochs 2 - getLastEnactedCommittee `shouldReturn` SJust (GovPurposeId committeeActionId2) committeeExpiryResignationDiscountSpec :: forall era. 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 b250cec1df9..147124e3bf7 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs @@ -80,6 +80,7 @@ module Test.Cardano.Ledger.Conway.ImpTest ( logCurPParams, submitCommitteeElection, electBasicCommittee, + setupActiveInactiveCCMembers, proposalsShowDebug, getGovPolicy, submitFailingGovAction, @@ -1049,7 +1050,8 @@ ccShouldNotBeExpired :: ccShouldNotBeExpired coldC = do curEpochNo <- getsNES nesELL ccExpiryEpochNo <- getCCExpiry coldC - curEpochNo `shouldSatisfy` (<= ccExpiryEpochNo) + impAnn "ccShouldNotBeExpired" $ + curEpochNo `shouldSatisfy` (<= ccExpiryEpochNo) ccShouldBeExpired :: (HasCallStack, ConwayEraGov era) => @@ -1058,7 +1060,8 @@ ccShouldBeExpired :: ccShouldBeExpired coldC = do curEpochNo <- getsNES nesELL ccExpiryEpochNo <- getCCExpiry coldC - curEpochNo `shouldSatisfy` (> ccExpiryEpochNo) + impAnn "ccShouldBeExpired" $ + curEpochNo `shouldSatisfy` (> ccExpiryEpochNo) getCCExpiry :: (HasCallStack, ConwayEraGov era) => @@ -1375,6 +1378,47 @@ electBasicCommittee = do hotCommitteeC <- registerCommitteeHotKey coldCommitteeC pure (drep, hotCommitteeC, GovPurposeId gaidCommitteeProp) +setupActiveInactiveCCMembers :: + forall era. + ( HasCallStack + , ConwayEraImp era + ) => + -- | Number of active committee members + Int -> + -- | Number of inactive committee members + Int -> + -- | Threshold + UnitInterval -> + ImpTestM era GovActionId +setupActiveInactiveCCMembers nActive nInactive threshold = do + coldCommitteeActive <- replicateM nActive (KeyHashObj <$> freshKeyHash) + coldCommitteeInactive <- replicateM nInactive (KeyHashObj <$> freshKeyHash) + startingEpoch <- getsNES nesELL + maxTermLength <- getsPParams ppCommitteeMaxTermLengthL + (drep, _, _) <- setupSingleDRep 1_000_000_000 + (spo, _, _) <- setupPoolWithStake $ Coin 1_000_000_000 + let + committeeMap = + Map.fromList $ + map (,addEpochInterval startingEpoch maxTermLength) coldCommitteeActive + ++ map (,addEpochInterval startingEpoch $ EpochInterval 5) coldCommitteeInactive + initialCommittee <- getCommitteeMembers + committeeActionId <- + impAnn "Submit committee update" + . submitGovAction + $ UpdateCommittee + SNothing + initialCommittee + committeeMap + threshold + submitYesVote_ (DRepVoter drep) committeeActionId + submitYesVote_ (StakePoolVoter spo) committeeActionId + passNEpochs 6 + getCommitteeMembers `shouldReturn` Map.keysSet committeeMap + forM_ coldCommitteeActive ccShouldNotBeExpired + forM_ coldCommitteeInactive ccShouldBeExpired + return committeeActionId + logCurPParams :: ( EraGov era , ToExpr (PParamsHKD Identity era)