Skip to content

Commit 5a95635

Browse files
SoupstrawSoupstraw
committed
Added postEpochBoundaryHook
Also update the pulser when modifying the protocol version in Conway
1 parent 693218d commit 5a95635

File tree

15 files changed

+266
-120
lines changed

15 files changed

+266
-120
lines changed

‎eras/allegra/impl/testlib/Test/Cardano/Ledger/Allegra/ImpTest.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -42,6 +42,7 @@ instance ShelleyEraImp AllegraEra where
4242

4343
fixupTx = shelleyFixupTx
4444
expectTxSuccess = impShelleyExpectTxSuccess
45+
modifyImpInitProtVer = shelleyModifyImpInitProtVer
4546

4647
impAllegraSatisfyNativeScript ::
4748
( AllegraEraScript era

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -428,6 +428,7 @@ instance ShelleyEraImp AlonzoEra where
428428
impSatisfyNativeScript = impAllegraSatisfyNativeScript
429429
fixupTx = alonzoFixupTx
430430
expectTxSuccess = impAlonzoExpectTxSuccess
431+
modifyImpInitProtVer = shelleyModifyImpInitProtVer
431432

432433
instance MaryEraImp AlonzoEra
433434

‎eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/ImpTest.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -53,6 +53,7 @@ instance ShelleyEraImp BabbageEra where
5353
impSatisfyNativeScript = impAllegraSatisfyNativeScript
5454
fixupTx = babbageFixupTx
5555
expectTxSuccess = impBabbageExpectTxSuccess
56+
modifyImpInitProtVer = shelleyModifyImpInitProtVer
5657

5758
babbageFixupTx ::
5859
( HasCallStack

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -175,6 +175,7 @@ library testlib
175175

176176
build-depends:
177177
FailT,
178+
ImpSpec,
178179
aeson,
179180
base,
180181
bytestring,

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -516,7 +516,7 @@ spec = do
516516
setProtVer initialProtVer
517517
pure res
518518
(khSPO, _, _) <- setupPoolWithStake $ Coin 10_000_000
519-
-- Using an irrefutable pattern here to prevent evaluation of tuple
519+
-- Using a lazy pattern match here to prevent evaluation of tuple
520520
-- unless we actually need a value from it
521521
~(drepCred, _, _) <-
522522
if initialProtVer > bootstrapVer

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -77,7 +77,8 @@ unknownCostModelsSpec =
7777
& ppuCostModelsL .~ SJust newCostModels
7878
whenPostBootstrap $ submitYesVote_ (DRepVoter drepC) gai
7979
submitYesVoteCCs_ hotCommitteeCs gai
80-
passNEpochs 2
80+
impAnn "Passing first epoch" passEpoch
81+
impAnn "Passing second epoch" passEpoch
8182
getLastEnactedParameterChange `shouldReturn` SJust (GovPurposeId gai)
8283
getsPParams ppCostModelsL `shouldReturn` updateCostModels costModels newCostModels
8384

‎eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs‎

Lines changed: 73 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@
2121
module Test.Cardano.Ledger.Conway.ImpTest (
2222
module Test.Cardano.Ledger.Babbage.ImpTest,
2323
ConwayEraImp,
24+
conwayModifyImpInitProtVer,
2425
enactConstitution,
2526
enactTreasuryWithdrawals,
2627
submitGovAction,
@@ -140,9 +141,11 @@ import Cardano.Ledger.Allegra.Scripts (Timelock)
140141
import Cardano.Ledger.BaseTypes (
141142
EpochInterval (..),
142143
EpochNo (..),
144+
ProtVer (..),
143145
ShelleyBase,
144146
StrictMaybe (..),
145147
UnitInterval,
148+
Version,
146149
addEpochInterval,
147150
binOpEpochNo,
148151
inject,
@@ -222,6 +225,7 @@ import Test.Cardano.Ledger.Core.Rational (IsRatio (..))
222225
import Test.Cardano.Ledger.Imp.Common
223226
import Test.Cardano.Ledger.Plutus (testingCostModel)
224227
import Test.Cardano.Ledger.Plutus.Guardrail (guardrailScript)
228+
import Test.ImpSpec
225229

226230
-- | Modify the PParams in the current state with the given function
227231
conwayModifyPParams ::
@@ -297,6 +301,24 @@ instance ShelleyEraImp ConwayEra where
297301

298302
fixupTx = babbageFixupTx
299303
expectTxSuccess = impBabbageExpectTxSuccess
304+
modifyImpInitProtVer = conwayModifyImpInitProtVer
305+
306+
conwayModifyImpInitProtVer ::
307+
forall era.
308+
ConwayEraImp era =>
309+
Version ->
310+
SpecWith (ImpInit (LedgerSpec era)) ->
311+
SpecWith (ImpInit (LedgerSpec era))
312+
conwayModifyImpInitProtVer ver =
313+
modifyImpInit $ \impInit ->
314+
impInit
315+
{ impInitState =
316+
impInitState impInit
317+
& impNESL . nesEsL . curPParamsEpochStateL . ppProtocolVersionL .~ ProtVer ver 0
318+
& impNESL . nesEsL %~ (\es -> setCompleteDRepPulsingState def (ratifyState es) es)
319+
}
320+
where
321+
ratifyState es = def & rsEnactStateL .~ mkEnactState (es ^. epochStateGovStateL)
300322

301323
instance MaryEraImp ConwayEra
302324

@@ -439,7 +461,7 @@ setupSingleDRep ::
439461
ConwayEraImp era =>
440462
Integer ->
441463
ImpTestM era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
442-
setupSingleDRep stake = do
464+
setupSingleDRep stake = impAnn "Set up a single DRep" $ do
443465
drepKH <- registerDRep
444466
delegatorKH <- freshKeyHash
445467
deposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppKeyDepositL
@@ -488,7 +510,7 @@ setupPoolWithStake ::
488510
(ShelleyEraImp era, ConwayEraTxCert era) =>
489511
Coin ->
490512
ImpTestM era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
491-
setupPoolWithStake delegCoin = do
513+
setupPoolWithStake delegCoin = impAnn "Set up pool with stake" $ do
492514
khPool <- freshKeyHash
493515
registerPool khPool
494516
credDelegatorPayment <- KeyHashObj <$> freshKeyHash
@@ -548,7 +570,8 @@ submitYesVote_ ::
548570
Voter ->
549571
GovActionId ->
550572
ImpTestM era ()
551-
submitYesVote_ voter gaId = void $ submitVote VoteYes voter gaId
573+
submitYesVote_ voter gaId =
574+
void $ submitVote VoteYes voter gaId
552575

553576
submitVote_ ::
554577
( ShelleyEraImp era
@@ -584,22 +607,23 @@ trySubmitVote ::
584607
GovActionId ->
585608
ImpTestM era (Either (NonEmpty (PredicateFailure (EraRule "LEDGER" era))) TxId)
586609
trySubmitVote vote voter gaId =
587-
fmap (bimap fst txIdTx) $
588-
trySubmitTx $
589-
mkBasicTx mkBasicTxBody
590-
& bodyTxL . votingProceduresTxBodyL
591-
.~ VotingProcedures
592-
( Map.singleton
593-
voter
594-
( Map.singleton
595-
gaId
596-
( VotingProcedure
597-
{ vProcVote = vote
598-
, vProcAnchor = SNothing
599-
}
600-
)
601-
)
602-
)
610+
impAnn ("Submitting vote (" <> show vote <> ")") $
611+
fmap (bimap fst txIdTx) $
612+
trySubmitTx $
613+
mkBasicTx mkBasicTxBody
614+
& bodyTxL . votingProceduresTxBodyL
615+
.~ VotingProcedures
616+
( Map.singleton
617+
voter
618+
( Map.singleton
619+
gaId
620+
( VotingProcedure
621+
{ vProcVote = vote
622+
, vProcAnchor = SNothing
623+
}
624+
)
625+
)
626+
)
603627

604628
submitProposal_ ::
605629
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
@@ -1215,7 +1239,7 @@ registerCommitteeHotKey ::
12151239
(ShelleyEraImp era, ConwayEraTxCert era) =>
12161240
Credential 'ColdCommitteeRole ->
12171241
ImpTestM era (Credential 'HotCommitteeRole)
1218-
registerCommitteeHotKey coldKey = do
1242+
registerCommitteeHotKey coldKey = impAnn "Register committee hot key" $ do
12191243
hotKey NE.:| [] <- registerCommitteeHotKeys (KeyHashObj <$> freshKeyHash) $ pure coldKey
12201244
pure hotKey
12211245

@@ -1291,33 +1315,36 @@ electBasicCommittee ::
12911315
, GovPurposeId 'CommitteePurpose
12921316
)
12931317
electBasicCommittee = do
1294-
logString "Setting up a DRep"
1295-
(drep, _, _) <- setupSingleDRep 1_000_000
1296-
(spoC, _, _) <- setupPoolWithStake $ Coin 1_000_000
1318+
(drep, _, _) <- setupSingleDRep 1_000_001
1319+
logString $ "Registered DRep: " <> showExpr drep
12971320

1298-
logString "Registering committee member"
1299-
coldCommitteeC <- KeyHashObj <$> freshKeyHash
1300-
startEpochNo <- getsNES nesELL
1301-
let
1302-
committeeAction =
1303-
UpdateCommittee
1304-
SNothing
1305-
mempty
1306-
(Map.singleton coldCommitteeC (addEpochInterval startEpochNo (EpochInterval 10)))
1307-
(1 %! 2)
1308-
(gaidCommitteeProp NE.:| _) <-
1309-
submitGovActions
1310-
[ committeeAction
1311-
, UpdateCommittee SNothing mempty mempty (1 %! 10)
1312-
]
1313-
submitYesVote_ (DRepVoter drep) gaidCommitteeProp
1314-
submitYesVote_ (StakePoolVoter spoC) gaidCommitteeProp
1315-
passNEpochs 2
1316-
committeeMembers <- getCommitteeMembers
1317-
impAnn "The committee should be enacted" $
1318-
committeeMembers `shouldSatisfy` Set.member coldCommitteeC
1319-
hotCommitteeC <- registerCommitteeHotKey coldCommitteeC
1320-
pure (drep, hotCommitteeC, GovPurposeId gaidCommitteeProp)
1321+
(spoC, _, _) <- setupPoolWithStake $ Coin 1_000_002
1322+
logString $ "Registered SPO: " <> showExpr spoC
1323+
1324+
impAnn "Registering committee member" $ do
1325+
coldCommitteeC <- KeyHashObj <$> freshKeyHash
1326+
startEpochNo <- getsNES nesELL
1327+
let
1328+
committeeAction =
1329+
UpdateCommittee
1330+
SNothing
1331+
mempty
1332+
(Map.singleton coldCommitteeC (addEpochInterval startEpochNo (EpochInterval 10)))
1333+
(1 %! 2)
1334+
(gaidCommitteeProp NE.:| _) <-
1335+
impAnn "Submitting UpdateCommittee action" $
1336+
submitGovActions
1337+
[ committeeAction
1338+
, UpdateCommittee SNothing mempty mempty (1 %! 10)
1339+
]
1340+
submitYesVote_ (DRepVoter drep) gaidCommitteeProp
1341+
submitYesVote_ (StakePoolVoter spoC) gaidCommitteeProp
1342+
passNEpochs 2
1343+
committeeMembers <- getCommitteeMembers
1344+
impAnn "The committee should be enacted" $
1345+
committeeMembers `shouldSatisfy` Set.member coldCommitteeC
1346+
hotCommitteeC <- registerCommitteeHotKey coldCommitteeC
1347+
pure (drep, hotCommitteeC, GovPurposeId gaidCommitteeProp)
13211348

13221349
logCurPParams ::
13231350
( EraGov era

‎eras/dijkstra/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -53,6 +53,7 @@ instance ShelleyEraImp DijkstraEra where
5353

5454
fixupTx = babbageFixupTx
5555
expectTxSuccess = impBabbageExpectTxSuccess
56+
modifyImpInitProtVer = conwayModifyImpInitProtVer
5657

5758
instance MaryEraImp DijkstraEra
5859

‎eras/mary/impl/testlib/Test/Cardano/Ledger/Mary/ImpTest.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ instance ShelleyEraImp MaryEra where
2727
impSatisfyNativeScript = impAllegraSatisfyNativeScript
2828
fixupTx = shelleyFixupTx
2929
expectTxSuccess = impShelleyExpectTxSuccess
30+
modifyImpInitProtVer = shelleyModifyImpInitProtVer
3031

3132
class
3233
( ShelleyEraImp era

0 commit comments

Comments
 (0)