Merge pull request #4744 from IntersectMBO/td/guardrail-in-imp-genesis

Guardrail in Imp genesis

eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs

@@ -113,6 +113,7 @@ import Test.Cardano.Ledger.Plutus (
   testingCostModels,
  )
 import Test.Cardano.Ledger.Plutus.Examples
+import Test.Cardano.Ledger.Plutus.Guardrail (guardrailScript)
 
 class
   ( MaryEraImp era
@@ -392,6 +393,7 @@ plutusTestScripts lang =
     , mkScriptTestEntry (datumIsWellformed lang) $ PlutusArgs (P.I 221) (Just $ P.I 5)
     , mkScriptTestEntry (inputsOutputsAreNotEmptyNoDatum lang) $ PlutusArgs (P.I 122) Nothing
     , mkScriptTestEntry (inputsOutputsAreNotEmptyWithDatum lang) $ PlutusArgs (P.I 222) (Just $ P.I 5)
+    , mkScriptTestEntry guardrailScript $ PlutusArgs (P.I 0) Nothing
     ]
 
 malformedPlutus :: Plutus l

eras/conway/impl/CHANGELOG.md

@@ -8,6 +8,8 @@
 
 ### `testlib`
 
+* Add `minFeeUpdateGovAction`
+* Add `mkTreasuryWithdrawalsGovAction` and `mkParameterChangeGovAction`
 * Switch to using `ImpSpec` package
 * Remove `withImpStateWithProtVer`
 * Added `delegateSPORewardAddressToDRep_`

eras/conway/impl/cardano-ledger-conway.cabal

@@ -178,8 +178,7 @@ library testlib
         mtl,
         plutus-ledger-api,
         prettyprinter,
-        small-steps >=1.1,
-        text
+        small-steps >=1.1
 
 executable huddle-cddl
     main-is:          Main.hs

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

@@ -460,13 +460,16 @@ actionPrioritySpec =
             nesEsL . esLStateL . lsUTxOStateL . utxosGovStateL . committeeGovStateL
         committee `shouldBe` SNothing
 
-    let val1 = Coin 1_000_001
-    let val2 = Coin 1_000_002
-    let val3 = Coin 1_000_003
-
+    -- distinct constitutional values for minFee
+    let genMinFeeVals =
+          (\x y z -> (Coin x, Coin y, Coin z))
+            <$> uniformRM (30, 330)
+            <*> uniformRM (330, 660)
+            <*> uniformRM (660, 1000)
     it "proposals of same priority are enacted in order of submission" $ do
       modifyPParams $ ppPoolVotingThresholdsL . pvtPPSecurityGroupL .~ 1 %! 1
       whenPostBootstrap (modifyPParams $ ppDRepVotingThresholdsL . dvtPPEconomicGroupL .~ def)
+      (val1, val2, val3) <- genMinFeeVals
 
       committeeCs <- registerInitialCommittee
       (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
@@ -498,24 +501,26 @@ actionPrioritySpec =
     it "only the first action of a transaction gets enacted" $ do
       modifyPParams $ ppPoolVotingThresholdsL . pvtPPSecurityGroupL .~ 1 %! 1
       whenPostBootstrap (modifyPParams $ ppDRepVotingThresholdsL . dvtPPEconomicGroupL .~ def)
+      (val1, val2, val3) <- genMinFeeVals
 
       committeeCs <- registerInitialCommittee
       (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
+      policy <- getGovPolicy
       gaids <-
         submitGovActions $
           NE.fromList
             [ ParameterChange
                 SNothing
                 (def & ppuMinFeeAL .~ SJust val1)
-                SNothing
+                policy
             , ParameterChange
                 SNothing
                 (def & ppuMinFeeAL .~ SJust val2)
-                SNothing
+                policy
             , ParameterChange
                 SNothing
                 (def & ppuMinFeeAL .~ SJust val3)
-                SNothing
+                policy
             ]
       traverse_
         ( \gaid -> do

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

@@ -91,12 +91,10 @@ proposalsSpec =
 
       initialValue <- getsNES (nesEsL . curPParamsEpochStateL . ppMinFeeAL)
 
-      policy <-
-        getsNES $
-          nesEpochStateL . epochStateGovStateL . constitutionGovStateL . constitutionScriptL
+      parameterChangeAction <- mkMinFeeUpdateGovAction SNothing
       govActionId <-
         mkProposalWithRewardAccount
-          (ParameterChange SNothing (def & ppuMinFeeAL .~ SJust (Coin 3000)) policy)
+          parameterChangeAction
           rewardAccount
           >>= submitProposal
       expectPresentGovActionId govActionId
@@ -138,16 +136,15 @@ proposalsSpec =
         let ratifyState = extractDRepPulsingState (govStateFinal ^. cgsDRepPulsingStateL)
         rsExpired ratifyState `shouldBe` Set.singleton govActionId
   where
-    submitParameterChangeTree = submitGovActionTree $ submitGovAction . paramAction
-    paramAction p =
-      ParameterChange (GovPurposeId <$> p) (def & ppuMinFeeAL .~ SJust (Coin 10)) SNothing
+    submitParameterChangeTree = submitGovActionTree $ mkMinFeeUpdateGovAction >=> submitGovAction
 
 dRepSpec ::
   forall era.
   ConwayEraImp era =>
   SpecWith (ImpInit (LedgerSpec era))
 dRepSpec =
   describe "DRep" $ do
+    let submitParamChangeProposal = mkMinFeeUpdateGovAction SNothing >>= submitGovAction_
     it "expiry is updated based on the number of dormant epochs" $ do
       modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 2
       (drep, _, _) <- setupSingleDRep 1_000_000
@@ -156,12 +153,10 @@ dRepSpec =
       let
         -- compute the epoch number that is an offset from starting epoch number
         offDRepActivity = addEpochInterval startEpochNo . EpochInterval
-        submitParamChangeProposal =
-          submitParameterChange SNothing $ def & ppuMinFeeAL .~ SJust (Coin 3000)
       expectNumDormantEpochs 0
 
       -- epoch 0: we submit a proposal
-      _ <- submitParamChangeProposal
+      submitParamChangeProposal
       passNEpochsChecking 2 $ do
         expectNumDormantEpochs 0
         expectDRepExpiry drep $ offDRepActivity 100
@@ -179,7 +174,7 @@ dRepSpec =
       expectNumDormantEpochs 3
       expectDRepExpiry drep $ offDRepActivity 100
 
-      _ <- submitParamChangeProposal
+      submitParamChangeProposal
       -- number of dormant epochs is added to the drep expiry and reset to 0
       expectNumDormantEpochs 0
       expectDRepExpiry drep $ offDRepActivity 103
@@ -202,12 +197,10 @@ dRepSpec =
         offDRepActivity offset =
           addEpochInterval startEpochNo $ EpochInterval (drepActivity + offset)
 
-      let submitParamChangeProposal =
-            submitParameterChange SNothing $ def & ppuMinFeeAL .~ SJust (Coin 3000)
       expectNumDormantEpochs 0
 
       -- epoch 0: we submit a proposal
-      _ <- submitParamChangeProposal
+      submitParamChangeProposal
       passNEpochsChecking 2 $ do
         expectNumDormantEpochs 0
         expectDRepExpiry drep $ offDRepActivity 0
@@ -229,7 +222,7 @@ dRepSpec =
       expectDRepExpiry drep $ offDRepActivity 0
       expectActualDRepExpiry drep $ offDRepActivity 3
 
-      _ <- submitParamChangeProposal
+      submitParamChangeProposal
       -- number of dormant epochs is added to the drep, considering they are not actually expired,
       -- and is reset to 0
       expectNumDormantEpochs 0
@@ -463,7 +456,11 @@ depositMovesToTreasuryWhenStakingAddressUnregisters = do
   govPolicy <- getGovPolicy
   gaid <-
     mkProposalWithRewardAccount
-      (ParameterChange SNothing (emptyPParamsUpdate & ppuGovActionDepositL .~ SJust (Coin 10)) govPolicy)
+      ( ParameterChange
+          SNothing
+          (emptyPParamsUpdate & ppuGovActionDepositL .~ SJust (Coin 1000000))
+          govPolicy
+      )
       returnAddr
       >>= submitProposal
   expectPresentGovActionId gaid
@@ -503,7 +500,7 @@ eventsSpec = describe "Events" $ do
       propDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppGovActionDepositL
       let
         proposeParameterChange = do
-          newVal <- arbitrary
+          newVal <- CoinPerByte . Coin <$> choose (3000, 6500)
           proposal <- submitParameterChange SNothing $ def & ppuCoinsPerUTxOByteL .~ SJust newVal
           pure
             (proposal, getsNES (nesEsL . curPParamsEpochStateL . ppCoinsPerUTxOByteL) `shouldReturn` newVal)
@@ -512,9 +509,10 @@ eventsSpec = describe "Events" $ do
       rewardAccount@(RewardAccount _ rewardCred) <- registerRewardAccount
       passEpoch -- prevent proposalC expiry and force it's deletion due to conflit.
       proposalC <- impAnn "proposalC" $ do
-        newVal <- arbitrary
+        newVal <- CoinPerByte . Coin <$> choose (3000, 6500)
+        paramChange <- mkParameterChangeGovAction SNothing $ (def & ppuCoinsPerUTxOByteL .~ SJust newVal)
         mkProposalWithRewardAccount
-          (ParameterChange SNothing (def & ppuCoinsPerUTxOByteL .~ SJust newVal) SNothing)
+          paramChange
           rewardAccount
           >>= submitProposal
       let

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

@@ -57,7 +57,6 @@ spec = do
   withdrawalsSpec
   hardForkSpec
   pparamUpdateSpec
-  proposalsSpec
   networkIdSpec
   bootstrapPhaseSpec
 
@@ -188,7 +187,7 @@ pparamUpdateSpec =
             let ppUpdate =
                   emptyPParamsUpdate
                     & lenz .~ SJust val
-                ga = ParameterChange SNothing ppUpdate SNothing
+            ga <- mkParameterChangeGovAction SNothing ppUpdate
             mkProposal ga
               >>= flip
                 submitFailingProposal
@@ -234,7 +233,7 @@ pparamUpdateSpec =
         ppuDRepDepositL
         zero
       it "PPU cannot be empty" $ do
-        let ga = ParameterChange SNothing emptyPParamsUpdate SNothing
+        ga <- mkParameterChangeGovAction SNothing emptyPParamsUpdate
         mkProposal ga
           >>= flip
             submitFailingProposal
@@ -260,19 +259,15 @@ proposalsSpec = do
               ()
               [ Node () []
               ]
-        let parameterChangeAction =
-              ParameterChange
-                (SJust $ GovPurposeId $ mkCorruptGovActionId p1)
-                (def & ppuMinFeeAL .~ SJust (Coin 3000))
-                SNothing
+        parameterChangeAction <- mkMinFeeUpdateGovAction (SJust $ mkCorruptGovActionId p1)
         parameterChangeProposal <- mkProposal parameterChangeAction
         submitFailingProposal
           parameterChangeProposal
           [ injectFailure $ InvalidPrevGovActionId parameterChangeProposal
           ]
       it "Subtrees are pruned when proposals expire" $ do
         modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 4
-        p1 <- submitParameterChange SNothing (def & ppuMinFeeAL .~ SJust (Coin 3000))
+        p1 <- mkMinFeeUpdateGovAction SNothing >>= submitGovAction
         passNEpochs 3
         a <-
           submitParameterChangeTree
@@ -307,7 +302,7 @@ proposalsSpec = do
                          , Node SNothing []
                          ]
       it "Subtrees are pruned when proposals expire over multiple rounds" $ do
-        let ppupdate = def & ppuMinFeeAL .~ SJust (Coin 3000)
+        let ppupdate = def & ppuMinFeeAL .~ SJust (Coin 1000)
         let submitInitialProposal = submitParameterChange SNothing ppupdate
         let submitChildProposal parent = submitParameterChange (SJust parent) ppupdate
         modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 4
@@ -716,15 +711,16 @@ proposalsSpec = do
         ens <- getEnactState
         returnAddr <- registerRewardAccount
         withdrawal <-
-          Map.singleton returnAddr . Coin . getPositive
+          (: []) . (returnAddr,) . Coin . getPositive
             <$> (arbitrary :: ImpTestM era (Positive Integer))
+        wdrl <- mkTreasuryWithdrawalsGovAction withdrawal
         [prop0, prop1, prop2, prop3] <-
           traverse
             mkProposal
             ( [ InfoAction
               , NoConfidence (ens ^. ensPrevCommitteeL)
               , InfoAction
-              , TreasuryWithdrawals withdrawal SNothing
+              , wdrl
               ] ::
                 [GovAction era]
             )
@@ -742,11 +738,10 @@ proposalsSpec = do
         submitProposal_ prop3
         checkProps [prop0, prop1, prop2, prop3]
   where
-    submitParameterChangeForest = submitGovActionForest $ submitGovAction . paramAction
-    submitParameterChangeTree = submitGovActionTree $ submitGovAction . paramAction
+    submitParameterChangeForest = submitGovActionForest $ paramAction >=> submitGovAction
+    submitParameterChangeTree = submitGovActionTree (paramAction >=> submitGovAction)
     submitConstitutionForest = submitGovActionForest $ submitConstitution . fmap GovPurposeId
-    paramAction p =
-      ParameterChange (GovPurposeId <$> p) (def & ppuMinFeeAL .~ SJust (Coin 10)) SNothing
+    paramAction p = mkParameterChangeGovAction p (def & ppuMinFeeAL .~ SJust (Coin 500))
 
 votingSpec ::
   forall era.
@@ -1089,7 +1084,7 @@ withdrawalsSpec =
               , raCredential = rewardCredential
               }
       proposal <-
-        mkProposal $ TreasuryWithdrawals (Map.singleton badRewardAccount $ Coin 100_000_000) SNothing
+        mkTreasuryWithdrawalsGovAction [(badRewardAccount, Coin 100_000_000)] >>= mkProposal
       let idMismatch =
             injectFailure $
               TreasuryWithdrawalsNetworkIdMismatch (Set.singleton badRewardAccount) Testnet
@@ -1105,19 +1100,17 @@ withdrawalsSpec =
               }
 
     it "Fails for empty withdrawals" $ do
-      expectZeroTreasuryFailurePostBootstrap $ TreasuryWithdrawals Map.empty SNothing
+      mkTreasuryWithdrawalsGovAction [] >>= expectZeroTreasuryFailurePostBootstrap
 
       rwdAccount1 <- registerRewardAccount
-      expectZeroTreasuryFailurePostBootstrap $
-        TreasuryWithdrawals [(rwdAccount1, zero)] SNothing
+      mkTreasuryWithdrawalsGovAction [(rwdAccount1, zero)] >>= expectZeroTreasuryFailurePostBootstrap
 
       rwdAccount2 <- registerRewardAccount
-      let withdrawals = Map.fromList [(rwdAccount1, zero), (rwdAccount2, zero)]
+      let withdrawals = [(rwdAccount1, zero), (rwdAccount2, zero)]
 
-      expectZeroTreasuryFailurePostBootstrap $
-        TreasuryWithdrawals withdrawals SNothing
+      mkTreasuryWithdrawalsGovAction withdrawals >>= expectZeroTreasuryFailurePostBootstrap
 
-      let wdrls = TreasuryWithdrawals (Map.insert rwdAccount2 (Coin 100_000) withdrawals) SNothing
+      wdrls <- mkTreasuryWithdrawalsGovAction $ withdrawals ++ [(rwdAccount2, Coin 100_000)]
       proposal <- mkProposal wdrls
       submitBootstrapAwareFailingProposal_ proposal $
         FailBootstrap [disallowedProposalFailure proposal]
@@ -1256,9 +1249,9 @@ bootstrapPhaseSpec ::
   ) =>
   SpecWith (ImpInit (LedgerSpec era))
 bootstrapPhaseSpec =
-  describe "Proposing and voting during bootstrap phase" $ do
+  describe "Proposing and voting" $ do
     it "Parameter change" $ do
-      gid <- submitParameterChange SNothing (def & ppuMinFeeAL .~ SJust (Coin 3000))
+      gid <- mkMinFeeUpdateGovAction SNothing >>= submitGovAction
       (committee :| _) <- registerInitialCommittee
       (drep, _, _) <- setupSingleDRep 1_000_000
       (spo, _, _) <- setupPoolWithStake $ Coin 42_000_000
@@ -1287,7 +1280,7 @@ bootstrapPhaseSpec =
       submitYesVote_ (CommitteeVoter committee) gid
     it "Treasury withdrawal" $ do
       rewardAccount <- registerRewardAccount
-      let action = TreasuryWithdrawals [(rewardAccount, Coin 1000)] SNothing
+      action <- mkTreasuryWithdrawalsGovAction [(rewardAccount, Coin 1000)]
       proposal <- mkProposalWithRewardAccount action rewardAccount
       checkProposalFailure proposal
     it "NoConfidence" $ do

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

@@ -27,7 +27,6 @@ import qualified Cardano.Ledger.Shelley.HardForks as HF (bootstrapPhase)
 import Cardano.Ledger.Shelley.LedgerState
 import Cardano.Ledger.Shelley.Rules (ShelleyLedgersEnv (..), ShelleyLedgersEvent (..))
 import Control.State.Transition.Extended
-import Data.Default (def)
 import qualified Data.Sequence as Seq
 import qualified Data.Set as Set
 import Lens.Micro ((&), (.~), (^.))
@@ -162,7 +161,7 @@ spec = do
     (drep, _, _) <- setupSingleDRep 1_000_000
 
     -- expire the drep before delegation
-    void $ submitParameterChange SNothing $ def & ppuMinFeeAL .~ SJust (Coin 3000)
+    mkMinFeeUpdateGovAction SNothing >>= submitGovAction_
     passNEpochs 4
     isDRepExpired drep `shouldReturn` True
 
@@ -191,7 +190,8 @@ spec = do
     _ <- delegateToDRep cred (Coin 1_000_000) (DRepCredential drep)
 
     -- expire the drep after delegation
-    void $ submitParameterChange SNothing $ def & ppuMinFeeAL .~ SJust (Coin 3000)
+    mkMinFeeUpdateGovAction SNothing >>= submitGovAction_
+
     passNEpochs 4
     isDRepExpired drep `shouldReturn` True