Skip to content

Commit 74e99d0

Browse files
LucsanszkyLucsanszky
committed
Adjust Conway UtxosSpec for Dijkstra era
* Generalise compatible tests by using certificates with deposits * Move tests that are reliant on certs w/out deposits and only run them pre-Dijkstra
1 parent cb1ab38 commit 74e99d0

File tree

2 files changed

+58
-30
lines changed

2 files changed

+58
-30
lines changed

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -56,7 +56,7 @@ import qualified Test.Cardano.Ledger.Conway.Imp.GovSpec as Gov
5656
import qualified Test.Cardano.Ledger.Conway.Imp.LedgerSpec as Ledger
5757
import qualified Test.Cardano.Ledger.Conway.Imp.RatifySpec as Ratify
5858
import qualified Test.Cardano.Ledger.Conway.Imp.UtxoSpec as Utxo
59-
-- import qualified Test.Cardano.Ledger.Conway.Imp.UtxosSpec as Utxos
59+
import qualified Test.Cardano.Ledger.Conway.Imp.UtxosSpec as Utxos
6060
-- import qualified Test.Cardano.Ledger.Conway.Imp.UtxowSpec as Utxow
6161
import Test.Cardano.Ledger.Conway.ImpTest (
6262
ConwayEraImp,
@@ -149,6 +149,6 @@ conwaySpec = do
149149
describe "LEDGER" Ledger.spec
150150
describe "RATIFY" Ratify.spec
151151
describe "UTXO" Utxo.spec
152+
describe "UTXOS" Utxos.spec
152153

153-
-- describe "UTXOS" Utxos.spec
154154
-- describe "UTXOW" Utxow.spec

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

Lines changed: 56 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@
88
{-# LANGUAGE ScopedTypeVariables #-}
99
{-# LANGUAGE TypeApplications #-}
1010

11-
module Test.Cardano.Ledger.Conway.Imp.UtxosSpec (spec) where
11+
module Test.Cardano.Ledger.Conway.Imp.UtxosSpec (spec, shelleyCertsSpec) where
1212

1313
import Cardano.Ledger.Address (Addr (..))
1414
import Cardano.Ledger.Allegra.Scripts (
@@ -52,7 +52,6 @@ import Test.Cardano.Ledger.Plutus.Examples (
5252
spec ::
5353
forall era.
5454
( ConwayEraImp era
55-
, ShelleyEraTxCert era
5655
, Inject (BabbageContextError era) (ContextError era)
5756
, Inject (ConwayContextError era) (ContextError era)
5857
, InjectRuleFailure "LEDGER" BabbageUtxoPredFailure era
@@ -207,7 +206,6 @@ datumAndReferenceInputsSpec = do
207206
conwayFeaturesPlutusV1V2FailureSpec ::
208207
forall era.
209208
( ConwayEraImp era
210-
, ShelleyEraTxCert era
211209
, InjectRuleFailure "LEDGER" BabbageUtxoPredFailure era
212210
, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
213211
, Inject (ConwayContextError era) (ContextError era)
@@ -271,7 +269,7 @@ conwayFeaturesPlutusV1V2FailureSpec = do
271269
describe "ProposalProcedures" $ do
272270
it "V1" $ do
273271
deposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppGovActionDepositL
274-
rewardAccount <- registerRewardAccount
272+
rewardAccount <- registerRewardAccountWithDeposit
275273
let badField = OSet.singleton $ ProposalProcedure deposit rewardAccount InfoAction def
276274
testPlutusV1V2Failure
277275
(hashPlutusScript $ redeemerSameAsDatum SPlutusV1)
@@ -281,7 +279,7 @@ conwayFeaturesPlutusV1V2FailureSpec = do
281279
$ ProposalProceduresFieldNotSupported badField
282280
it "V2" $ do
283281
deposit <- getsNES $ nesEsL . curPParamsEpochStateL . ppGovActionDepositL
284-
rewardAccount <- registerRewardAccount
282+
rewardAccount <- registerRewardAccountWithDeposit
285283
let badField = OSet.singleton $ ProposalProcedure deposit rewardAccount InfoAction def
286284
testPlutusV1V2Failure
287285
(hashPlutusScript $ redeemerSameAsDatum SPlutusV2)
@@ -364,21 +362,6 @@ conwayFeaturesPlutusV1V2FailureSpec = do
364362
CertificateNotSupported badCert
365363
]
366364
)
367-
describe "DelegTxCert" $ do
368-
it "V1" $ do
369-
(drep, delegator, _) <- setupSingleDRep 1_000_000_000
370-
let delegTxCert =
371-
DelegTxCert @era
372-
delegator
373-
(DelegVote (DRepCredential drep))
374-
testCertificateNotSupportedV1 delegTxCert
375-
it "V2" $ do
376-
(drep, delegator, _) <- setupSingleDRep 1_000_000_000
377-
let delegTxCert =
378-
DelegTxCert @era
379-
delegator
380-
(DelegVote (DRepCredential drep))
381-
testCertificateNotSupportedV2 delegTxCert
382365
describe "RegDepositDelegTxCert" $ do
383366
it "V1" $ do
384367
(drep, _, _) <- setupSingleDRep 1_000_000_000
@@ -455,7 +438,6 @@ conwayFeaturesPlutusV1V2FailureSpec = do
455438
govPolicySpec ::
456439
forall era.
457440
( ConwayEraImp era
458-
, ShelleyEraTxCert era
459441
, InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
460442
, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
461443
) =>
@@ -482,7 +464,7 @@ govPolicySpec = do
482464
submitFailingTx tx [injectFailure $ ScriptWitnessNotValidatingUTXOW [scriptHash]]
483465

484466
impAnn "TreasuryWithdrawals" $ do
485-
rewardAccount <- registerRewardAccount
467+
rewardAccount <- registerRewardAccountWithDeposit
486468
let withdrawals = Map.fromList [(rewardAccount, Coin 1000)]
487469
let govAction = TreasuryWithdrawals withdrawals (SJust scriptHash)
488470
proposal <- mkProposal govAction
@@ -503,7 +485,7 @@ govPolicySpec = do
503485
(Constitution anchor (SJust alwaysSucceedsSh))
504486
dRep
505487
committeeMembers'
506-
rewardAccount <- registerRewardAccount
488+
rewardAccount <- registerRewardAccountWithDeposit
507489

508490
impAnn "ParameterChange" $ do
509491
let pparamsUpdate = def & ppuCommitteeMinSizeL .~ SJust 1
@@ -530,7 +512,7 @@ govPolicySpec = do
530512
submitPhase2Invalid_ tx
531513

532514
impAnn "TreasuryWithdrawals" $ do
533-
rewardAccount <- registerRewardAccount
515+
rewardAccount <- registerRewardAccountWithDeposit
534516
let withdrawals = Map.fromList [(rewardAccount, Coin 1000)]
535517
let govAction = TreasuryWithdrawals withdrawals (SJust alwaysFailsSh)
536518
proposal <- mkProposal govAction
@@ -540,7 +522,6 @@ govPolicySpec = do
540522
costModelsSpec ::
541523
forall era.
542524
( ConwayEraImp era
543-
, ShelleyEraTxCert era
544525
, InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
545526
, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
546527
) =>
@@ -704,9 +685,7 @@ testPlutusV1V2Failure sh badField lenz errorField = do
704685
)
705686

706687
enactCostModels ::
707-
( ConwayEraImp era
708-
, ShelleyEraTxCert era
709-
) =>
688+
ConwayEraImp era =>
710689
StrictMaybe (GovPurposeId 'PParamUpdatePurpose) ->
711690
CostModels ->
712691
Credential 'DRepRole ->
@@ -725,3 +704,52 @@ enactCostModels prevGovId cms dRep committeeMembers' = do
725704

726705
spendDatum :: P1.Data
727706
spendDatum = P1.I 3
707+
708+
shelleyCertsSpec ::
709+
forall era.
710+
( ConwayEraImp era
711+
, ShelleyEraTxCert era
712+
, Inject (ConwayContextError era) (ContextError era)
713+
, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
714+
) =>
715+
SpecWith (ImpInit (LedgerSpec era))
716+
shelleyCertsSpec = do
717+
describe "Conway features fail in Plutusdescribe v1 and v2" $ do
718+
describe "Certificates" $ do
719+
describe "Unsupported" $ do
720+
let testCertificateNotSupportedV1 badCert =
721+
testCertificateNotSupported badCert
722+
=<< produceScript @era (hashPlutusScript $ redeemerSameAsDatum SPlutusV1)
723+
testCertificateNotSupportedV2 badCert =
724+
testCertificateNotSupported badCert
725+
=<< produceScript @era (hashPlutusScript $ redeemerSameAsDatum SPlutusV2)
726+
testCertificateNotSupported badCert txIn = do
727+
submitFailingTx
728+
( mkBasicTx mkBasicTxBody
729+
& bodyTxL . inputsTxBodyL
730+
.~ Set.singleton txIn
731+
& bodyTxL . certsTxBodyL
732+
.~ SSeq.singleton badCert
733+
)
734+
( pure . injectFailure $
735+
CollectErrors
736+
[ BadTranslation $
737+
inject $
738+
CertificateNotSupported badCert
739+
]
740+
)
741+
describe "DelegTxCert" $ do
742+
it "V1" $ do
743+
(drep, delegator, _) <- setupSingleDRep 1_000_000_000
744+
let delegTxCert =
745+
DelegTxCert @era
746+
delegator
747+
(DelegVote (DRepCredential drep))
748+
testCertificateNotSupportedV1 delegTxCert
749+
it "V2" $ do
750+
(drep, delegator, _) <- setupSingleDRep 1_000_000_000
751+
let delegTxCert =
752+
DelegTxCert @era
753+
delegator
754+
(DelegVote (DRepCredential drep))
755+
testCertificateNotSupportedV2 delegTxCert

0 commit comments

Comments
 (0)