Merge pull request #4328 from IntersectMBO/lehins/disable-drep-in-boo…

…tstrap

Disable drep thresholds in bootstrap

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,
@@ -304,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
@@ -496,13 +497,15 @@ votingDRepThresholdInternal ::
   GovAction era ->
   VotingThreshold
 votingDRepThresholdInternal pp isElectedCommittee action =
-  let DRepVotingThresholds
+  let thresholds@DRepVotingThresholds
         { dvtCommitteeNoConfidence
         , dvtCommitteeNormal
         , 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 {} ->
@@ -512,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
 

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

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

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 <-

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

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

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