Skip to content

Commit 8a090f2

Browse files
authored
Merge pull request #4744 from IntersectMBO/td/guardrail-in-imp-genesis
Guardrail in Imp genesis
2 parents 14a4713 + 48335ee commit 8a090f2

File tree

15 files changed

+199
-156
lines changed

15 files changed

+199
-156
lines changed

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

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -113,6 +113,7 @@ import Test.Cardano.Ledger.Plutus (
113113
testingCostModels,
114114
)
115115
import Test.Cardano.Ledger.Plutus.Examples
116+
import Test.Cardano.Ledger.Plutus.Guardrail (guardrailScript)
116117

117118
class
118119
( MaryEraImp era
@@ -392,6 +393,7 @@ plutusTestScripts lang =
392393
, mkScriptTestEntry (datumIsWellformed lang) $ PlutusArgs (P.I 221) (Just $ P.I 5)
393394
, mkScriptTestEntry (inputsOutputsAreNotEmptyNoDatum lang) $ PlutusArgs (P.I 122) Nothing
394395
, mkScriptTestEntry (inputsOutputsAreNotEmptyWithDatum lang) $ PlutusArgs (P.I 222) (Just $ P.I 5)
396+
, mkScriptTestEntry guardrailScript $ PlutusArgs (P.I 0) Nothing
395397
]
396398

397399
malformedPlutus :: Plutus l

eras/conway/impl/CHANGELOG.md

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,8 @@
88

99
### `testlib`
1010

11+
* Add `minFeeUpdateGovAction`
12+
* Add `mkTreasuryWithdrawalsGovAction` and `mkParameterChangeGovAction`
1113
* Switch to using `ImpSpec` package
1214
* Remove `withImpStateWithProtVer`
1315
* Added `delegateSPORewardAddressToDRep_`

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

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -178,8 +178,7 @@ library testlib
178178
mtl,
179179
plutus-ledger-api,
180180
prettyprinter,
181-
small-steps >=1.1,
182-
text
181+
small-steps >=1.1
183182

184183
executable huddle-cddl
185184
main-is: Main.hs

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

Lines changed: 12 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -460,13 +460,16 @@ actionPrioritySpec =
460460
nesEsL . esLStateL . lsUTxOStateL . utxosGovStateL . committeeGovStateL
461461
committee `shouldBe` SNothing
462462

463-
let val1 = Coin 1_000_001
464-
let val2 = Coin 1_000_002
465-
let val3 = Coin 1_000_003
466-
463+
-- distinct constitutional values for minFee
464+
let genMinFeeVals =
465+
(\x y z -> (Coin x, Coin y, Coin z))
466+
<$> uniformRM (30, 330)
467+
<*> uniformRM (330, 660)
468+
<*> uniformRM (660, 1000)
467469
it "proposals of same priority are enacted in order of submission" $ do
468470
modifyPParams $ ppPoolVotingThresholdsL . pvtPPSecurityGroupL .~ 1 %! 1
469471
whenPostBootstrap (modifyPParams $ ppDRepVotingThresholdsL . dvtPPEconomicGroupL .~ def)
472+
(val1, val2, val3) <- genMinFeeVals
470473

471474
committeeCs <- registerInitialCommittee
472475
(spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
@@ -498,24 +501,26 @@ actionPrioritySpec =
498501
it "only the first action of a transaction gets enacted" $ do
499502
modifyPParams $ ppPoolVotingThresholdsL . pvtPPSecurityGroupL .~ 1 %! 1
500503
whenPostBootstrap (modifyPParams $ ppDRepVotingThresholdsL . dvtPPEconomicGroupL .~ def)
504+
(val1, val2, val3) <- genMinFeeVals
501505

502506
committeeCs <- registerInitialCommittee
503507
(spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
508+
policy <- getGovPolicy
504509
gaids <-
505510
submitGovActions $
506511
NE.fromList
507512
[ ParameterChange
508513
SNothing
509514
(def & ppuMinFeeAL .~ SJust val1)
510-
SNothing
515+
policy
511516
, ParameterChange
512517
SNothing
513518
(def & ppuMinFeeAL .~ SJust val2)
514-
SNothing
519+
policy
515520
, ParameterChange
516521
SNothing
517522
(def & ppuMinFeeAL .~ SJust val3)
518-
SNothing
523+
policy
519524
]
520525
traverse_
521526
( \gaid -> do

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

Lines changed: 17 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -91,12 +91,10 @@ proposalsSpec =
9191

9292
initialValue <- getsNES (nesEsL . curPParamsEpochStateL . ppMinFeeAL)
9393

94-
policy <-
95-
getsNES $
96-
nesEpochStateL . epochStateGovStateL . constitutionGovStateL . constitutionScriptL
94+
parameterChangeAction <- mkMinFeeUpdateGovAction SNothing
9795
govActionId <-
9896
mkProposalWithRewardAccount
99-
(ParameterChange SNothing (def & ppuMinFeeAL .~ SJust (Coin 3000)) policy)
97+
parameterChangeAction
10098
rewardAccount
10199
>>= submitProposal
102100
expectPresentGovActionId govActionId
@@ -138,16 +136,15 @@ proposalsSpec =
138136
let ratifyState = extractDRepPulsingState (govStateFinal ^. cgsDRepPulsingStateL)
139137
rsExpired ratifyState `shouldBe` Set.singleton govActionId
140138
where
141-
submitParameterChangeTree = submitGovActionTree $ submitGovAction . paramAction
142-
paramAction p =
143-
ParameterChange (GovPurposeId <$> p) (def & ppuMinFeeAL .~ SJust (Coin 10)) SNothing
139+
submitParameterChangeTree = submitGovActionTree $ mkMinFeeUpdateGovAction >=> submitGovAction
144140

145141
dRepSpec ::
146142
forall era.
147143
ConwayEraImp era =>
148144
SpecWith (ImpInit (LedgerSpec era))
149145
dRepSpec =
150146
describe "DRep" $ do
147+
let submitParamChangeProposal = mkMinFeeUpdateGovAction SNothing >>= submitGovAction_
151148
it "expiry is updated based on the number of dormant epochs" $ do
152149
modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 2
153150
(drep, _, _) <- setupSingleDRep 1_000_000
@@ -156,12 +153,10 @@ dRepSpec =
156153
let
157154
-- compute the epoch number that is an offset from starting epoch number
158155
offDRepActivity = addEpochInterval startEpochNo . EpochInterval
159-
submitParamChangeProposal =
160-
submitParameterChange SNothing $ def & ppuMinFeeAL .~ SJust (Coin 3000)
161156
expectNumDormantEpochs 0
162157

163158
-- epoch 0: we submit a proposal
164-
_ <- submitParamChangeProposal
159+
submitParamChangeProposal
165160
passNEpochsChecking 2 $ do
166161
expectNumDormantEpochs 0
167162
expectDRepExpiry drep $ offDRepActivity 100
@@ -179,7 +174,7 @@ dRepSpec =
179174
expectNumDormantEpochs 3
180175
expectDRepExpiry drep $ offDRepActivity 100
181176

182-
_ <- submitParamChangeProposal
177+
submitParamChangeProposal
183178
-- number of dormant epochs is added to the drep expiry and reset to 0
184179
expectNumDormantEpochs 0
185180
expectDRepExpiry drep $ offDRepActivity 103
@@ -202,12 +197,10 @@ dRepSpec =
202197
offDRepActivity offset =
203198
addEpochInterval startEpochNo $ EpochInterval (drepActivity + offset)
204199

205-
let submitParamChangeProposal =
206-
submitParameterChange SNothing $ def & ppuMinFeeAL .~ SJust (Coin 3000)
207200
expectNumDormantEpochs 0
208201

209202
-- epoch 0: we submit a proposal
210-
_ <- submitParamChangeProposal
203+
submitParamChangeProposal
211204
passNEpochsChecking 2 $ do
212205
expectNumDormantEpochs 0
213206
expectDRepExpiry drep $ offDRepActivity 0
@@ -229,7 +222,7 @@ dRepSpec =
229222
expectDRepExpiry drep $ offDRepActivity 0
230223
expectActualDRepExpiry drep $ offDRepActivity 3
231224

232-
_ <- submitParamChangeProposal
225+
submitParamChangeProposal
233226
-- number of dormant epochs is added to the drep, considering they are not actually expired,
234227
-- and is reset to 0
235228
expectNumDormantEpochs 0
@@ -463,7 +456,11 @@ depositMovesToTreasuryWhenStakingAddressUnregisters = do
463456
govPolicy <- getGovPolicy
464457
gaid <-
465458
mkProposalWithRewardAccount
466-
(ParameterChange SNothing (emptyPParamsUpdate & ppuGovActionDepositL .~ SJust (Coin 10)) govPolicy)
459+
( ParameterChange
460+
SNothing
461+
(emptyPParamsUpdate & ppuGovActionDepositL .~ SJust (Coin 1000000))
462+
govPolicy
463+
)
467464
returnAddr
468465
>>= submitProposal
469466
expectPresentGovActionId gaid
@@ -503,7 +500,7 @@ eventsSpec = describe "Events" $ do
503500
propDeposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppGovActionDepositL
504501
let
505502
proposeParameterChange = do
506-
newVal <- arbitrary
503+
newVal <- CoinPerByte . Coin <$> choose (3000, 6500)
507504
proposal <- submitParameterChange SNothing $ def & ppuCoinsPerUTxOByteL .~ SJust newVal
508505
pure
509506
(proposal, getsNES (nesEsL . curPParamsEpochStateL . ppCoinsPerUTxOByteL) `shouldReturn` newVal)
@@ -512,9 +509,10 @@ eventsSpec = describe "Events" $ do
512509
rewardAccount@(RewardAccount _ rewardCred) <- registerRewardAccount
513510
passEpoch -- prevent proposalC expiry and force it's deletion due to conflit.
514511
proposalC <- impAnn "proposalC" $ do
515-
newVal <- arbitrary
512+
newVal <- CoinPerByte . Coin <$> choose (3000, 6500)
513+
paramChange <- mkParameterChangeGovAction SNothing $ (def & ppuCoinsPerUTxOByteL .~ SJust newVal)
516514
mkProposalWithRewardAccount
517-
(ParameterChange SNothing (def & ppuCoinsPerUTxOByteL .~ SJust newVal) SNothing)
515+
paramChange
518516
rewardAccount
519517
>>= submitProposal
520518
let

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

Lines changed: 20 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -57,7 +57,6 @@ spec = do
5757
withdrawalsSpec
5858
hardForkSpec
5959
pparamUpdateSpec
60-
proposalsSpec
6160
networkIdSpec
6261
bootstrapPhaseSpec
6362

@@ -188,7 +187,7 @@ pparamUpdateSpec =
188187
let ppUpdate =
189188
emptyPParamsUpdate
190189
& lenz .~ SJust val
191-
ga = ParameterChange SNothing ppUpdate SNothing
190+
ga <- mkParameterChangeGovAction SNothing ppUpdate
192191
mkProposal ga
193192
>>= flip
194193
submitFailingProposal
@@ -234,7 +233,7 @@ pparamUpdateSpec =
234233
ppuDRepDepositL
235234
zero
236235
it "PPU cannot be empty" $ do
237-
let ga = ParameterChange SNothing emptyPParamsUpdate SNothing
236+
ga <- mkParameterChangeGovAction SNothing emptyPParamsUpdate
238237
mkProposal ga
239238
>>= flip
240239
submitFailingProposal
@@ -260,19 +259,15 @@ proposalsSpec = do
260259
()
261260
[ Node () []
262261
]
263-
let parameterChangeAction =
264-
ParameterChange
265-
(SJust $ GovPurposeId $ mkCorruptGovActionId p1)
266-
(def & ppuMinFeeAL .~ SJust (Coin 3000))
267-
SNothing
262+
parameterChangeAction <- mkMinFeeUpdateGovAction (SJust $ mkCorruptGovActionId p1)
268263
parameterChangeProposal <- mkProposal parameterChangeAction
269264
submitFailingProposal
270265
parameterChangeProposal
271266
[ injectFailure $ InvalidPrevGovActionId parameterChangeProposal
272267
]
273268
it "Subtrees are pruned when proposals expire" $ do
274269
modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 4
275-
p1 <- submitParameterChange SNothing (def & ppuMinFeeAL .~ SJust (Coin 3000))
270+
p1 <- mkMinFeeUpdateGovAction SNothing >>= submitGovAction
276271
passNEpochs 3
277272
a <-
278273
submitParameterChangeTree
@@ -307,7 +302,7 @@ proposalsSpec = do
307302
, Node SNothing []
308303
]
309304
it "Subtrees are pruned when proposals expire over multiple rounds" $ do
310-
let ppupdate = def & ppuMinFeeAL .~ SJust (Coin 3000)
305+
let ppupdate = def & ppuMinFeeAL .~ SJust (Coin 1000)
311306
let submitInitialProposal = submitParameterChange SNothing ppupdate
312307
let submitChildProposal parent = submitParameterChange (SJust parent) ppupdate
313308
modifyPParams $ ppGovActionLifetimeL .~ EpochInterval 4
@@ -716,15 +711,16 @@ proposalsSpec = do
716711
ens <- getEnactState
717712
returnAddr <- registerRewardAccount
718713
withdrawal <-
719-
Map.singleton returnAddr . Coin . getPositive
714+
(: []) . (returnAddr,) . Coin . getPositive
720715
<$> (arbitrary :: ImpTestM era (Positive Integer))
716+
wdrl <- mkTreasuryWithdrawalsGovAction withdrawal
721717
[prop0, prop1, prop2, prop3] <-
722718
traverse
723719
mkProposal
724720
( [ InfoAction
725721
, NoConfidence (ens ^. ensPrevCommitteeL)
726722
, InfoAction
727-
, TreasuryWithdrawals withdrawal SNothing
723+
, wdrl
728724
] ::
729725
[GovAction era]
730726
)
@@ -742,11 +738,10 @@ proposalsSpec = do
742738
submitProposal_ prop3
743739
checkProps [prop0, prop1, prop2, prop3]
744740
where
745-
submitParameterChangeForest = submitGovActionForest $ submitGovAction . paramAction
746-
submitParameterChangeTree = submitGovActionTree $ submitGovAction . paramAction
741+
submitParameterChangeForest = submitGovActionForest $ paramAction >=> submitGovAction
742+
submitParameterChangeTree = submitGovActionTree (paramAction >=> submitGovAction)
747743
submitConstitutionForest = submitGovActionForest $ submitConstitution . fmap GovPurposeId
748-
paramAction p =
749-
ParameterChange (GovPurposeId <$> p) (def & ppuMinFeeAL .~ SJust (Coin 10)) SNothing
744+
paramAction p = mkParameterChangeGovAction p (def & ppuMinFeeAL .~ SJust (Coin 500))
750745

751746
votingSpec ::
752747
forall era.
@@ -1089,7 +1084,7 @@ withdrawalsSpec =
10891084
, raCredential = rewardCredential
10901085
}
10911086
proposal <-
1092-
mkProposal $ TreasuryWithdrawals (Map.singleton badRewardAccount $ Coin 100_000_000) SNothing
1087+
mkTreasuryWithdrawalsGovAction [(badRewardAccount, Coin 100_000_000)] >>= mkProposal
10931088
let idMismatch =
10941089
injectFailure $
10951090
TreasuryWithdrawalsNetworkIdMismatch (Set.singleton badRewardAccount) Testnet
@@ -1105,19 +1100,17 @@ withdrawalsSpec =
11051100
}
11061101

11071102
it "Fails for empty withdrawals" $ do
1108-
expectZeroTreasuryFailurePostBootstrap $ TreasuryWithdrawals Map.empty SNothing
1103+
mkTreasuryWithdrawalsGovAction [] >>= expectZeroTreasuryFailurePostBootstrap
11091104

11101105
rwdAccount1 <- registerRewardAccount
1111-
expectZeroTreasuryFailurePostBootstrap $
1112-
TreasuryWithdrawals [(rwdAccount1, zero)] SNothing
1106+
mkTreasuryWithdrawalsGovAction [(rwdAccount1, zero)] >>= expectZeroTreasuryFailurePostBootstrap
11131107

11141108
rwdAccount2 <- registerRewardAccount
1115-
let withdrawals = Map.fromList [(rwdAccount1, zero), (rwdAccount2, zero)]
1109+
let withdrawals = [(rwdAccount1, zero), (rwdAccount2, zero)]
11161110

1117-
expectZeroTreasuryFailurePostBootstrap $
1118-
TreasuryWithdrawals withdrawals SNothing
1111+
mkTreasuryWithdrawalsGovAction withdrawals >>= expectZeroTreasuryFailurePostBootstrap
11191112

1120-
let wdrls = TreasuryWithdrawals (Map.insert rwdAccount2 (Coin 100_000) withdrawals) SNothing
1113+
wdrls <- mkTreasuryWithdrawalsGovAction $ withdrawals ++ [(rwdAccount2, Coin 100_000)]
11211114
proposal <- mkProposal wdrls
11221115
submitBootstrapAwareFailingProposal_ proposal $
11231116
FailBootstrap [disallowedProposalFailure proposal]
@@ -1256,9 +1249,9 @@ bootstrapPhaseSpec ::
12561249
) =>
12571250
SpecWith (ImpInit (LedgerSpec era))
12581251
bootstrapPhaseSpec =
1259-
describe "Proposing and voting during bootstrap phase" $ do
1252+
describe "Proposing and voting" $ do
12601253
it "Parameter change" $ do
1261-
gid <- submitParameterChange SNothing (def & ppuMinFeeAL .~ SJust (Coin 3000))
1254+
gid <- mkMinFeeUpdateGovAction SNothing >>= submitGovAction
12621255
(committee :| _) <- registerInitialCommittee
12631256
(drep, _, _) <- setupSingleDRep 1_000_000
12641257
(spo, _, _) <- setupPoolWithStake $ Coin 42_000_000
@@ -1287,7 +1280,7 @@ bootstrapPhaseSpec =
12871280
submitYesVote_ (CommitteeVoter committee) gid
12881281
it "Treasury withdrawal" $ do
12891282
rewardAccount <- registerRewardAccount
1290-
let action = TreasuryWithdrawals [(rewardAccount, Coin 1000)] SNothing
1283+
action <- mkTreasuryWithdrawalsGovAction [(rewardAccount, Coin 1000)]
12911284
proposal <- mkProposalWithRewardAccount action rewardAccount
12921285
checkProposalFailure proposal
12931286
it "NoConfidence" $ do

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,6 @@ import qualified Cardano.Ledger.Shelley.HardForks as HF (bootstrapPhase)
2727
import Cardano.Ledger.Shelley.LedgerState
2828
import Cardano.Ledger.Shelley.Rules (ShelleyLedgersEnv (..), ShelleyLedgersEvent (..))
2929
import Control.State.Transition.Extended
30-
import Data.Default (def)
3130
import qualified Data.Sequence as Seq
3231
import qualified Data.Set as Set
3332
import Lens.Micro ((&), (.~), (^.))
@@ -162,7 +161,7 @@ spec = do
162161
(drep, _, _) <- setupSingleDRep 1_000_000
163162

164163
-- expire the drep before delegation
165-
void $ submitParameterChange SNothing $ def & ppuMinFeeAL .~ SJust (Coin 3000)
164+
mkMinFeeUpdateGovAction SNothing >>= submitGovAction_
166165
passNEpochs 4
167166
isDRepExpired drep `shouldReturn` True
168167

@@ -191,7 +190,8 @@ spec = do
191190
_ <- delegateToDRep cred (Coin 1_000_000) (DRepCredential drep)
192191

193192
-- expire the drep after delegation
194-
void $ submitParameterChange SNothing $ def & ppuMinFeeAL .~ SJust (Coin 3000)
193+
mkMinFeeUpdateGovAction SNothing >>= submitGovAction_
194+
195195
passNEpochs 4
196196
isDRepExpired drep `shouldReturn` True
197197

0 commit comments

Comments
 (0)