From 6c780d72c62c87d3a6b098bc4b644331fc5e4298 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Mon, 6 May 2024 21:55:59 -0600 Subject: [PATCH 1/3] Enforce DRep thresholds to be 0 during bootstrap phase --- .../impl/src/Cardano/Ledger/Conway/Governance/Internal.hs | 5 ++++- 1 file changed, 4 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 e1fe75e8ce1..b0f4776bd98 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Internal.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Internal.hs @@ -111,6 +111,7 @@ import Cardano.Ledger.Credential (Credential (..)) import Cardano.Ledger.DRep (DRep (..), DRepState (..)) import Cardano.Ledger.Keys (KeyRole (..)) import Cardano.Ledger.PoolDistr (PoolDistr (..)) +import qualified Cardano.Ledger.Shelley.HardForks as HF (bootstrapPhase) import Cardano.Ledger.Shelley.LedgerState ( epochStateIncrStakeDistrL, epochStateRegDrepL, @@ -502,7 +503,9 @@ votingDRepThresholdInternal pp isElectedCommittee action = , dvtUpdateToConstitution , dvtHardForkInitiation , dvtTreasuryWithdrawal - } = pp ^. ppDRepVotingThresholdsL + } -- 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 UpdateCommittee {} -> From bd69e9cdb3459d107d695a5e0257d736bb8669c6 Mon Sep 17 00:00:00 2001 From: teodanciu Date: Wed, 8 May 2024 13:47:53 +0100 Subject: [PATCH 2/3] Set DRep threshold to 0 during bootstrap phase for param change action --- .../src/Cardano/Ledger/Conway/Governance/Internal.hs | 10 +++++----- .../test/Test/Cardano/Ledger/Conway/DRepRatifySpec.hs | 10 ++++------ 2 files changed, 9 insertions(+), 11 deletions(-) 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 b0f4776bd98..1028d0323ff 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Internal.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Internal.hs @@ -305,17 +305,17 @@ toRatifyStatePairs cg@(RatifyState _ _ _ _) = pparamsUpdateThreshold :: forall era. ConwayEraPParams era => - PParams era -> + DRepVotingThresholds -> PParamsUpdate era -> UnitInterval -pparamsUpdateThreshold pp ppu = +pparamsUpdateThreshold thresholds ppu = let thresholdLens = \case NetworkGroup -> dvtPPNetworkGroupL GovGroup -> dvtPPGovGroupL TechnicalGroup -> dvtPPTechnicalGroupL EconomicGroup -> dvtPPEconomicGroupL lookupGroupThreshold (PPGroups grp _) = - pp ^. ppDRepVotingThresholdsL . thresholdLens grp + thresholds ^. thresholdLens grp in Set.foldr' max minBound $ Set.map lookupGroupThreshold $ modifiedPPGroups @era ppu @@ -497,7 +497,7 @@ votingDRepThresholdInternal :: GovAction era -> VotingThreshold votingDRepThresholdInternal pp isElectedCommittee action = - let DRepVotingThresholds + let thresholds@DRepVotingThresholds { dvtCommitteeNoConfidence , dvtCommitteeNormal , dvtUpdateToConstitution @@ -515,7 +515,7 @@ votingDRepThresholdInternal pp isElectedCommittee action = else dvtCommitteeNoConfidence NewConstitution {} -> VotingThreshold dvtUpdateToConstitution HardForkInitiation {} -> VotingThreshold dvtHardForkInitiation - ParameterChange _ ppu _ -> VotingThreshold $ pparamsUpdateThreshold pp ppu + ParameterChange _ ppu _ -> VotingThreshold $ pparamsUpdateThreshold thresholds ppu TreasuryWithdrawals {} -> VotingThreshold dvtTreasuryWithdrawal InfoAction {} -> NoVotingThreshold diff --git a/eras/conway/impl/test/Test/Cardano/Ledger/Conway/DRepRatifySpec.hs b/eras/conway/impl/test/Test/Cardano/Ledger/Conway/DRepRatifySpec.hs index 5412e7dced5..0eb2d15f8ea 100644 --- a/eras/conway/impl/test/Test/Cardano/Ledger/Conway/DRepRatifySpec.hs +++ b/eras/conway/impl/test/Test/Cardano/Ledger/Conway/DRepRatifySpec.hs @@ -43,7 +43,6 @@ import qualified Data.Map.Strict as Map import Data.Ratio ((%)) import qualified Data.Set as Set import Data.Word (Word64) -import Lens.Micro import Test.Cardano.Ledger.Common import Test.Cardano.Ledger.Conway.Arbitrary () import Test.Cardano.Ledger.Core.Arbitrary () @@ -63,13 +62,12 @@ spec = do correctThresholdsProp :: forall era. ( ConwayEraPParams era - , Arbitrary (PParams era) , Arbitrary (PParamsUpdate era) ) => Spec correctThresholdsProp = do - prop "PParamsUpdateThreshold always selects a threshold" $ \(pp :: PParams era) ppu -> do - let DRepVotingThresholds {..} = pp ^. ppDRepVotingThresholdsL + prop "PParamsUpdateThreshold always selects a threshold" $ \thresholds ppu -> do + let DRepVotingThresholds {..} = thresholds allDRepThresholds = Set.fromList [ dvtPPNetworkGroup @@ -78,8 +76,8 @@ correctThresholdsProp = do , dvtPPGovGroup ] when (ppu /= emptyPParamsUpdate) $ - pparamsUpdateThreshold pp ppu `shouldSatisfy` (`Set.member` allDRepThresholds) - pparamsUpdateThreshold pp emptyPParamsUpdate `shouldBe` (0 %! 1) + pparamsUpdateThreshold @era thresholds ppu `shouldSatisfy` (`Set.member` allDRepThresholds) + pparamsUpdateThreshold @era thresholds emptyPParamsUpdate `shouldBe` (0 %! 1) acceptedRatioProp :: forall era. Era era => Spec acceptedRatioProp = do From 311234ad7aa530b19c3f3b003cae7c2ac86c255d Mon Sep 17 00:00:00 2001 From: teodanciu Date: Wed, 8 May 2024 17:37:39 +0100 Subject: [PATCH 3/3] Run Imp tests with non-zero DRep thresholds when no DReps are involved in the test cases --- .../testlib/Test/Cardano/Ledger/Conway/Imp.hs | 28 ++-- .../Cardano/Ledger/Conway/Imp/EnactSpec.hs | 34 ++--- .../Cardano/Ledger/Conway/Imp/EpochSpec.hs | 18 +-- .../Cardano/Ledger/Conway/Imp/GovCertSpec.hs | 5 +- .../Test/Cardano/Ledger/Conway/Imp/GovSpec.hs | 23 ++-- .../Cardano/Ledger/Conway/Imp/RatifySpec.hs | 123 ++++++------------ .../Cardano/Ledger/Conway/Imp/UtxoSpec.hs | 2 +- .../Cardano/Ledger/Conway/Imp/UtxosSpec.hs | 9 +- .../Test/Cardano/Ledger/Conway/ImpTest.hs | 24 ++-- 9 files changed, 103 insertions(+), 163 deletions(-) diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs index 5269b93c56b..9d6f29e617e 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp.hs @@ -63,19 +63,19 @@ spec = do BabbageImp.spec @era describe "ConwayImpSpec - post bootstrap (protocol version 10)" $ withImpStateWithProtVer @era (natVersion @10) $ do - Enact.spec @era - Epoch.spec @era - Gov.spec @era - GovCert.spec @era - Utxo.spec @era - Utxos.spec @era - Ratify.spec @era + describe "ENACT" $ Enact.spec @era + describe "EPOCH" $ Epoch.spec @era + describe "GOV" $ Gov.spec @era + describe "GOVCERT" $ GovCert.spec @era + describe "UTXO" $ Utxo.spec @era + describe "UTXOS" $ Utxos.spec @era + describe "RATIFY" $ Ratify.spec @era describe "ConwayImpSpec - bootstrap phase (protocol version 9)" $ withImpState @era $ do - Enact.relevantDuringBootstrapSpec @era - Epoch.relevantDuringBootstrapSpec @era - Gov.relevantDuringBootstrapSpec @era - GovCert.relevantDuringBootstrapSpec @era - Utxo.spec @era - Utxos.relevantDuringBootstrapSpec @era - Ratify.relevantDuringBootstrapSpec @era + describe "ENACT" $ Enact.relevantDuringBootstrapSpec @era + describe "EPOCH" $ Epoch.relevantDuringBootstrapSpec @era + describe "GOV" $ Gov.relevantDuringBootstrapSpec @era + describe "GOVCERT" $ GovCert.relevantDuringBootstrapSpec @era + describe "UTXO" $ Utxo.spec @era + describe "UTXOS" $ Utxos.relevantDuringBootstrapSpec @era + describe "RATIFY" $ Ratify.relevantDuringBootstrapSpec @era diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EnactSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EnactSpec.hs index 9ffdac274d0..ff88caf0658 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EnactSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EnactSpec.hs @@ -48,14 +48,13 @@ spec :: , Typeable (Event (EraRule "ENACT" era)) ) => SpecWith (ImpTestState era) -spec = - describe "ENACT" $ do - relevantDuringBootstrapSpec - treasuryWithdrawalsSpec - noConfidenceSpec - constitutionSpec - actionPriorityCommitteePurposeSpec - hardForkInitiationSpec +spec = do + relevantDuringBootstrapSpec + treasuryWithdrawalsSpec + noConfidenceSpec + constitutionSpec + actionPriorityCommitteePurposeSpec + hardForkInitiationSpec relevantDuringBootstrapSpec :: ConwayEraImp era => @@ -225,10 +224,8 @@ hardForkInitiationNoDRepsSpec :: ConwayEraImp era => SpecWith (ImpTestState era) hardForkInitiationNoDRepsSpec = it "HardForkInitiation without DRep voting" $ do (committeeMember :| _) <- registerInitialCommittee - modifyPParams $ \pp -> - pp - & ppDRepVotingThresholdsL . dvtHardForkInitiationL .~ def - & ppPoolVotingThresholdsL . pvtHardForkInitiationL .~ 2 %! 3 + modifyPParams $ ppPoolVotingThresholdsL . pvtHardForkInitiationL .~ 2 %! 3 + whenPostBootstrap (modifyPParams $ ppDRepVotingThresholdsL . dvtHardForkInitiationL .~ def) _ <- setupPoolWithStake $ Coin 22_000_000 (stakePoolId1, _, _) <- setupPoolWithStake $ Coin 22_000_000 (stakePoolId2, _, _) <- setupPoolWithStake $ Coin 22_000_000 @@ -402,10 +399,8 @@ actionPrioritySpec = let val3 = Coin 1_000_003 it "proposals of same priority are enacted in order of submission" $ do - modifyPParams $ \pp -> - pp - & ppDRepVotingThresholdsL . dvtPPEconomicGroupL .~ def - & ppPoolVotingThresholdsL . pvtPPSecurityGroupL .~ 1 %! 1 + modifyPParams $ ppPoolVotingThresholdsL . pvtPPSecurityGroupL .~ 1 %! 1 + whenPostBootstrap (modifyPParams $ ppDRepVotingThresholdsL . dvtPPEconomicGroupL .~ def) (committeeC :| _) <- registerInitialCommittee (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000 @@ -435,10 +430,9 @@ actionPrioritySpec = `shouldReturn` val3 it "only the first action of a transaction gets enacted" $ do - modifyPParams $ \pp -> - pp - & ppDRepVotingThresholdsL . dvtPPEconomicGroupL .~ def - & ppPoolVotingThresholdsL . pvtPPSecurityGroupL .~ 1 %! 1 + modifyPParams $ ppPoolVotingThresholdsL . pvtPPSecurityGroupL .~ 1 %! 1 + whenPostBootstrap (modifyPParams $ ppDRepVotingThresholdsL . dvtPPEconomicGroupL .~ def) + (committeeC :| _) <- registerInitialCommittee (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000 gaids <- diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EpochSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EpochSpec.hs index c5a4d37f2f3..7e7d2c63321 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EpochSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/EpochSpec.hs @@ -48,11 +48,10 @@ spec :: , Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era ) => SpecWith (ImpTestState era) -spec = - describe "EPOCH" $ do - relevantDuringBootstrapSpec - dRepVotingSpec - treasurySpec +spec = do + relevantDuringBootstrapSpec + dRepVotingSpec + treasurySpec relevantDuringBootstrapSpec :: forall era. @@ -215,12 +214,7 @@ dRepVotingSpec :: dRepVotingSpec = describe "DRep" $ do it "proposal is accepted after two epochs" $ do - modifyPParams $ \pp -> - pp - & ppDRepVotingThresholdsL - .~ def - { dvtPPEconomicGroup = 1 %! 1 - } + modifyPParams $ ppDRepVotingThresholdsL . dvtPPEconomicGroupL .~ 1 %! 1 let getParamValue = getsNES (nesEsL . curPParamsEpochStateL . ppMinFeeAL) initialParamValue <- getParamValue @@ -363,8 +357,8 @@ eventsSpec = describe "Events" $ do modifyPParams $ \pp -> pp & ppGovActionLifetimeL .~ EpochInterval actionLifetime - & ppDRepVotingThresholdsL . dvtPPEconomicGroupL .~ def & ppPoolVotingThresholdsL . pvtPPSecurityGroupL .~ 1 %! 1 + whenPostBootstrap (modifyPParams $ ppDRepVotingThresholdsL . dvtPPEconomicGroupL .~ def) propDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppGovActionDepositL let proposeCostModel = do diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovCertSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovCertSpec.hs index 215816ea152..a8c13ed7f35 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovCertSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/GovCertSpec.hs @@ -65,9 +65,8 @@ spec :: SpecWith (ImpTestState era) spec = do relevantDuringBootstrapSpec - describe "GOVCERT" - $ it - "A CC that has resigned will need to be first voted out and then voted in to be considered active" + it + "A CC that has resigned will need to be first voted out and then voted in to be considered active" $ do (drepCred, _, _) <- setupSingleDRep 1_000_000 passNEpochs 2 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 d1f4d6934cb..ea7d716bd92 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 @@ -52,16 +52,15 @@ spec :: , InjectRuleFailure "LEDGER" ConwayGovPredFailure era ) => SpecWith (ImpTestState era) -spec = - describe "GOV" $ do - relevantDuringBootstrapSpec - constitutionSpec - proposalsWithVotingSpec - votingSpec - policySpec - networkIdWithdrawalsSpec - predicateFailuresSpec - unknownCostModelsSpec +spec = do + relevantDuringBootstrapSpec + constitutionSpec + proposalsWithVotingSpec + votingSpec + policySpec + networkIdWithdrawalsSpec + predicateFailuresSpec + unknownCostModelsSpec relevantDuringBootstrapSpec :: forall era. @@ -848,10 +847,6 @@ votingSpec = modifyPParams $ \pp -> pp & ppGovActionLifetimeL .~ EpochInterval 3 - & ppDRepVotingThresholdsL - .~ def - { dvtUpdateToConstitution = 1 %! 2 - } & ppCommitteeMinSizeL .~ 2 (dRepCred, _, _) <- setupSingleDRep 1_000_000 ccColdCred0 <- KeyHashObj <$> freshKeyHash 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 8838a9ba10a..3e1abe2ba60 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 @@ -39,15 +39,14 @@ spec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era) -spec = - describe "RATIFY" $ do - relevantDuringBootstrapSpec - votingSpec - delayingActionsSpec - spoVotesCommitteeUpdates - committeeMinSizeAffectsInFlightProposalsSpec - paramChangeAffectsProposalsSpec - committeeExpiryResignationDiscountSpec +spec = do + relevantDuringBootstrapSpec + votingSpec + delayingActionsSpec + spoVotesCommitteeUpdates + committeeMinSizeAffectsInFlightProposalsSpec + paramChangeAffectsProposalsSpec + committeeExpiryResignationDiscountSpec relevantDuringBootstrapSpec :: forall era. @@ -132,18 +131,10 @@ paramChangeAffectsProposalsSpec = smallerThreshold :: UnitInterval smallerThreshold = 1 %! 2 describe "DRep" $ do - let setThreshold :: UnitInterval -> ImpTestM era () - setThreshold threshold = do - drepVotingThresholds <- getsPParams ppDRepVotingThresholdsL - modifyPParams $ - ppDRepVotingThresholdsL - .~ (drepVotingThresholds & dvtCommitteeNormalL .~ threshold) - enactThreshold :: - UnitInterval -> - Credential 'DRepRole (EraCrypto era) -> - Credential 'HotCommitteeRole (EraCrypto era) -> - ImpTestM era () + let setThreshold threshold = + modifyPParams $ ppDRepVotingThresholdsL . dvtCommitteeNormalL .~ threshold enactThreshold threshold drepC hotCommitteeC = do + modifyPParams $ ppDRepVotingThresholdsL . dvtPPGovGroupL .~ 1 %! 10 drepVotingThresholds <- getsPParams ppDRepVotingThresholdsL let paramChange = ParameterChange @@ -196,16 +187,8 @@ paramChangeAffectsProposalsSpec = getLastEnactedCommittee `shouldReturn` SJust (GovPurposeId gaiChild) describe "SPO" $ do let setThreshold :: UnitInterval -> ImpTestM era () - setThreshold threshold = do - poolVotingThresholds <- getsPParams ppPoolVotingThresholdsL - modifyPParams $ - ppPoolVotingThresholdsL - .~ (poolVotingThresholds & pvtCommitteeNormalL .~ threshold) - enactThreshold :: - UnitInterval -> - Credential 'DRepRole (EraCrypto era) -> - Credential 'HotCommitteeRole (EraCrypto era) -> - ImpTestM era () + setThreshold threshold = + modifyPParams $ ppPoolVotingThresholdsL . pvtCommitteeNormalL .~ threshold enactThreshold threshold drepC hotCommitteeC = do poolVotingThresholds <- getsPParams ppPoolVotingThresholdsL let paramChange = @@ -378,10 +361,8 @@ spoVotesCommitteeUpdates = _ <- setupPoolWithStake $ Coin 1_000 _ <- setupPoolWithStake $ Coin 1_000 _ <- setupPoolWithStake $ Coin 1_000 - modifyPParams $ \pp -> - pp - & ppPoolVotingThresholdsL . pvtMotionNoConfidenceL .~ 1 %! 2 - & ppDRepVotingThresholdsL .~ def + modifyPParams $ ppPoolVotingThresholdsL . pvtMotionNoConfidenceL .~ 1 %! 2 + whenPostBootstrap (modifyPParams $ ppDRepVotingThresholdsL .~ def) gai <- submitGovAction $ NoConfidence SNothing -- 1 % 4 stake yes; 3 % 4 stake abstain; yes / stake - abstain > 1 % 2 submitYesVote_ (StakePoolVoter spoK1) gai @@ -392,10 +373,8 @@ spoVotesCommitteeUpdates = _ <- setupPoolWithStake $ Coin 1_000 _ <- setupPoolWithStake $ Coin 1_000 _ <- setupPoolWithStake $ Coin 1_000 - modifyPParams $ \pp -> - pp - & ppPoolVotingThresholdsL . pvtCommitteeNormalL .~ 1 %! 2 - & ppDRepVotingThresholdsL .~ def + modifyPParams $ ppPoolVotingThresholdsL . pvtCommitteeNormalL .~ 1 %! 2 + whenPostBootstrap (modifyPParams $ ppDRepVotingThresholdsL .~ def) committeeC <- KeyHashObj <$> freshKeyHash gai <- @@ -414,6 +393,7 @@ spoVotesForHardForkInitiation :: spoVotesForHardForkInitiation = describe "Counting of SPO votes" $ do it "HardForkInitiation" $ do + whenPostBootstrap (modifyPParams $ ppDRepVotingThresholdsL . dvtHardForkInitiationL .~ def) (hotCC :| _) <- registerInitialCommittee (spoK1, _, _) <- setupPoolWithStake $ Coin 1_000 (spoK2, _, _) <- setupPoolWithStake $ Coin 1_000 @@ -517,14 +497,6 @@ votingSpec = describe "Active voting stake" $ do describe "DRep" $ do it "UTxOs contribute to active voting stake" $ do - -- Only modify the applicable thresholds - modifyPParams $ \pp -> - pp - & ppDRepVotingThresholdsL - .~ def - { dvtCommitteeNormal = 51 %! 100 - , dvtCommitteeNoConfidence = 51 %! 100 - } -- Setup DRep delegation #1 (drep1, KeyHashObj stakingKH1, paymentKP1) <- setupSingleDRep 1_000_000 -- Setup DRep delegation #2 @@ -547,14 +519,6 @@ votingSpec = -- The same vote should now successfully ratify the proposal getLastEnactedCommittee `shouldReturn` SJust (GovPurposeId addCCGaid) it "Rewards contribute to active voting stake" $ do - -- Only modify the applicable thresholds - modifyPParams $ \pp -> - pp - & ppDRepVotingThresholdsL - .~ def - { dvtCommitteeNormal = 51 %! 100 - , dvtCommitteeNoConfidence = 51 %! 100 - } -- Setup DRep delegation #1 (drep1, staking1, _) <- setupSingleDRep 1_000_000 -- Setup DRep delegation #2 @@ -584,11 +548,6 @@ votingSpec = -- Only modify the applicable thresholds modifyPParams $ \pp -> pp - & ppDRepVotingThresholdsL - .~ def - { dvtCommitteeNormal = 51 %! 100 - , dvtCommitteeNoConfidence = 51 %! 100 - } & ppGovActionDepositL .~ Coin 1_000_000 & ppPoolDepositL .~ Coin 200_000 & ppEMaxL .~ EpochInterval 5 @@ -630,11 +589,7 @@ votingSpec = describe "Proposal deposits contribute to active voting stake" $ do it "Directly" $ do -- Only modify the applicable thresholds - modifyPParams $ \pp -> - pp - & ppDRepVotingThresholdsL - .~ def {dvtCommitteeNormal = 51 %! 100} - & ppGovActionDepositL .~ Coin 600_000 + modifyPParams $ ppGovActionDepositL .~ Coin 600_000 -- Setup DRep delegation without stake #1 (drepKH1, stakingKH1) <- setupDRepWithoutStake -- Setup DRep delegation #2 @@ -674,11 +629,7 @@ votingSpec = getLastEnactedCommittee `shouldReturn` SJust (GovPurposeId addCCGaid) it "After switching delegations" $ do -- Only modify the applicable thresholds - modifyPParams $ \pp -> - pp - & ppDRepVotingThresholdsL - .~ def {dvtCommitteeNormal = 51 %! 100} - & ppGovActionDepositL .~ Coin 1_000_000 + modifyPParams $ ppGovActionDepositL .~ Coin 1_000_000 -- Setup DRep delegation without stake #1 (drepKH1, stakingKH1) <- setupDRepWithoutStake -- Setup DRep delegation #2 @@ -731,14 +682,13 @@ votingSpec = describe "StakePool" $ do it "UTxOs contribute to active voting stake" $ do -- Only modify the applicable thresholds - modifyPParams $ \pp -> - pp - & ppPoolVotingThresholdsL - .~ def - { pvtCommitteeNormal = 51 %! 100 - , pvtCommitteeNoConfidence = 51 %! 100 - } - & ppDRepVotingThresholdsL .~ def + modifyPParams $ + ppPoolVotingThresholdsL + .~ def + { pvtCommitteeNormal = 51 %! 100 + , pvtCommitteeNoConfidence = 51 %! 100 + } + whenPostBootstrap (modifyPParams $ ppDRepVotingThresholdsL .~ def) -- Setup Pool delegation #1 (poolKH1, delegatorCPayment1, delegatorCStaking1) <- setupPoolWithStake $ Coin 1_000_000 -- Setup Pool delegation #2 @@ -767,14 +717,14 @@ votingSpec = getLastEnactedCommittee `shouldReturn` SJust (GovPurposeId addCCGaid) it "Rewards contribute to active voting stake" $ do -- Only modify the applicable thresholds - modifyPParams $ \pp -> - pp - & ppPoolVotingThresholdsL - .~ def - { pvtCommitteeNormal = 51 %! 100 - , pvtCommitteeNoConfidence = 51 %! 100 - } - & ppDRepVotingThresholdsL .~ def + modifyPParams $ + ppPoolVotingThresholdsL + .~ def + { pvtCommitteeNormal = 51 %! 100 + , pvtCommitteeNoConfidence = 51 %! 100 + } + whenPostBootstrap (modifyPParams $ ppDRepVotingThresholdsL .~ def) + -- Setup Pool delegation #1 (poolKH1, _, delegatorCStaking1) <- setupPoolWithStake $ Coin 1_000_000 -- Setup Pool delegation #2 @@ -815,7 +765,8 @@ votingSpec = & ppPoolDepositL .~ Coin 200_000 & ppEMaxL .~ EpochInterval 5 & ppGovActionLifetimeL .~ EpochInterval 5 - & ppDRepVotingThresholdsL .~ def + whenPostBootstrap (modifyPParams $ ppDRepVotingThresholdsL .~ def) + -- Setup Pool delegation #1 (poolKH1, delegatorCStaking1) <- setupPoolWithoutStake -- Add rewards to delegation #1 diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/UtxoSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/UtxoSpec.hs index aae54302565..e94b6a3b3be 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/UtxoSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/UtxoSpec.hs @@ -44,7 +44,7 @@ spec :: forall era. ConwayEraImp era => SpecWith (ImpTestState era) -spec = describe "UTxO" $ do +spec = describe "Reference scripts" $ do it "required reference script counts towards the minFee calculation" $ do spendingScript <- nativeScript diff --git a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/UtxosSpec.hs b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/UtxosSpec.hs index 52c1b28ad37..65fad0f5051 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/UtxosSpec.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/UtxosSpec.hs @@ -66,11 +66,10 @@ spec :: , InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era ) => SpecWith (ImpTestState era) -spec = - describe "UTXOS" $ do - relevantDuringBootstrapSpec - govPolicySpec - costModelsSpec +spec = do + relevantDuringBootstrapSpec + govPolicySpec + costModelsSpec relevantDuringBootstrapSpec :: 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 6c72e979016..ba2249183f7 100644 --- a/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs +++ b/eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs @@ -258,20 +258,25 @@ instance where initConwayNES committee constitution nes = let newNes = - (initAlonzoImpNES nes) + initAlonzoImpNES nes & nesEsL . curPParamsEpochStateL . ppDRepActivityL .~ EpochInterval 100 & nesEsL . curPParamsEpochStateL . ppGovActionLifetimeL .~ EpochInterval 30 & nesEsL . curPParamsEpochStateL . ppGovActionDepositL .~ Coin 123 & nesEsL . curPParamsEpochStateL . ppCommitteeMaxTermLengthL .~ EpochInterval 20 & nesEsL . curPParamsEpochStateL . ppCommitteeMinSizeL .~ 1 & nesEsL . curPParamsEpochStateL . ppDRepVotingThresholdsL - %~ ( \dvt -> - dvt - { dvtCommitteeNormal = 1 %! 1 - , dvtCommitteeNoConfidence = 1 %! 2 - , dvtUpdateToConstitution = 1 %! 2 - } - ) + .~ DRepVotingThresholds + { dvtMotionNoConfidence = 51 %! 100 + , dvtCommitteeNormal = 51 %! 100 + , dvtCommitteeNoConfidence = 51 %! 100 + , dvtUpdateToConstitution = 51 %! 100 + , dvtHardForkInitiation = 51 %! 100 + , dvtPPNetworkGroup = 51 %! 100 + , dvtPPEconomicGroup = 51 %! 100 + , dvtPPTechnicalGroup = 51 %! 100 + , dvtPPGovGroup = 51 %! 100 + , dvtTreasuryWithdrawal = 51 %! 100 + } & nesEsL . epochStateGovStateL . committeeGovStateL .~ SJust committee & nesEsL . epochStateGovStateL . constitutionGovStateL .~ constitution epochState = newNes ^. nesEsL @@ -1195,6 +1200,9 @@ electBasicCommittee = do submitYesVote_ (DRepVoter drep) gaidCommitteeProp passEpoch passEpoch + committeeMembers <- getCommitteeMembers + impAnn "The committee should be enacted" $ + committeeMembers `shouldSatisfy` Set.member coldCommitteeC hotCommitteeC <- registerCommitteeHotKey coldCommitteeC pure (drep, hotCommitteeC, GovPurposeId gaidCommitteeProp)