Skip to content

Commit b2300d1

Browse files
LucsanszkyLucsanszky
committed
Separate tests without certificate deposits
1 parent fe09bfa commit b2300d1

File tree

7 files changed

+165
-64
lines changed

7 files changed

+165
-64
lines changed

‎eras/alonzo/impl/test/Main.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ main =
2727
Golden.spec
2828
describe "Imp" $ do
2929
Imp.spec @AlonzoEra
30+
Imp.shelleyCertsSpec @AlonzoEra
3031
describe "CostModels" $ do
3132
CostModelsSpec.spec @AlonzoEra
3233
describe "TxWits" $ do

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

Lines changed: 19 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -11,35 +11,47 @@ import Cardano.Ledger.Alonzo.Core
1111
import Cardano.Ledger.Alonzo.Rules (
1212
AlonzoUtxoPredFailure,
1313
AlonzoUtxosPredFailure,
14-
-- AlonzoUtxowPredFailure,
14+
AlonzoUtxowPredFailure,
1515
)
1616
import Cardano.Ledger.Shelley.Rules (
17-
-- ShelleyDelegPredFailure,
17+
ShelleyDelegPredFailure,
1818
ShelleyUtxoPredFailure,
1919
ShelleyUtxowPredFailure,
2020
)
2121
import qualified Test.Cardano.Ledger.Alonzo.Imp.UtxoSpec as Utxo
2222
import qualified Test.Cardano.Ledger.Alonzo.Imp.UtxosSpec as Utxos
23-
-- import qualified Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec as Utxow
23+
import qualified Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec as Utxow
2424
import Test.Cardano.Ledger.Alonzo.ImpTest (AlonzoEraImp, LedgerSpec)
2525
import Test.Cardano.Ledger.Imp.Common
2626
import qualified Test.Cardano.Ledger.Mary.Imp as MaryImp
2727

2828
spec ::
2929
forall era.
3030
( AlonzoEraImp era
31-
, -- , InjectRuleFailure "LEDGER" ShelleyDelegPredFailure era
32-
InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era
31+
, InjectRuleFailure "LEDGER" ShelleyUtxoPredFailure era
3332
, InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
3433
, InjectRuleFailure "LEDGER" AlonzoUtxoPredFailure era
3534
, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
36-
-- , InjectRuleFailure "LEDGER" AlonzoUtxowPredFailure era
35+
, InjectRuleFailure "LEDGER" AlonzoUtxowPredFailure era
3736
) =>
3837
Spec
3938
spec = do
4039
MaryImp.spec @era
4140
describe "AlonzoImpSpec" . withImpInit @(LedgerSpec era) $ do
4241
Utxo.spec
4342
Utxos.spec
43+
Utxow.spec
4444

45-
-- Utxow.spec
45+
shelleyCertsSpec ::
46+
forall era.
47+
( AlonzoEraImp era
48+
, ShelleyEraTxCert era
49+
, InjectRuleFailure "LEDGER" ShelleyDelegPredFailure era
50+
, InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
51+
, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
52+
, InjectRuleFailure "LEDGER" AlonzoUtxowPredFailure era
53+
) =>
54+
Spec
55+
shelleyCertsSpec = do
56+
describe "AlonzoImp - certificates without deposit" . withImpInit @(LedgerSpec era) $ do
57+
Utxow.shelleyCertsSpec

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

Lines changed: 16 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
{-# LANGUAGE TypeFamilies #-}
88
{-# LANGUAGE TypeOperators #-}
99

10-
module Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec (spec) where
10+
module Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec (spec, shelleyCertsSpec) where
1111

1212
import Cardano.Ledger.Alonzo.Core
1313
import Cardano.Ledger.Alonzo.Rules (
@@ -23,8 +23,6 @@ import Test.Cardano.Ledger.Common
2323
spec ::
2424
forall era.
2525
( AlonzoEraImp era
26-
, ShelleyEraTxCert era
27-
, InjectRuleFailure "LEDGER" ShelleyDelegPredFailure era
2826
, InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
2927
, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
3028
, InjectRuleFailure "LEDGER" AlonzoUtxowPredFailure era
@@ -34,3 +32,18 @@ spec = do
3432
describe "UTXOW" $ do
3533
Valid.spec
3634
Invalid.spec
35+
36+
shelleyCertsSpec ::
37+
forall era.
38+
( AlonzoEraImp era
39+
, ShelleyEraTxCert era
40+
, InjectRuleFailure "LEDGER" ShelleyDelegPredFailure era
41+
, InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
42+
, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
43+
, InjectRuleFailure "LEDGER" AlonzoUtxowPredFailure era
44+
) =>
45+
SpecWith (ImpInit (LedgerSpec era))
46+
shelleyCertsSpec = do
47+
describe "UTXOW" $ do
48+
Valid.shelleyCertsSpec
49+
Invalid.shelleyCertsSpec

‎eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxowSpec/Invalid.hs‎

Lines changed: 41 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
{-# LANGUAGE ScopedTypeVariables #-}
88
{-# LANGUAGE TypeApplications #-}
99

10-
module Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec.Invalid (spec) where
10+
module Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec.Invalid (spec, shelleyCertsSpec) where
1111

1212
import Cardano.Ledger.Allegra.Scripts (AllegraEraScript (..))
1313
import Cardano.Ledger.Alonzo (AlonzoEra)
@@ -52,7 +52,6 @@ import Test.Cardano.Ledger.Plutus.Examples (
5252
spec ::
5353
forall era.
5454
( AlonzoEraImp era
55-
, ShelleyEraTxCert era
5655
, InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
5756
, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
5857
, InjectRuleFailure "LEDGER" AlonzoUtxowPredFailure era
@@ -74,7 +73,6 @@ spec = describe "Invalid transactions" $ do
7473
describe (show lang) $ do
7574
let redeemerSameAsDatumHash = hashPlutusScript $ redeemerSameAsDatum slang
7675
alwaysSucceedsWithDatumHash = hashPlutusScript $ alwaysSucceedsWithDatum slang
77-
alwaysSucceedsNoDatumHash = hashPlutusScript $ alwaysSucceedsNoDatum slang
7876

7977
it "MissingRedeemers" $ do
8078
let scriptHash = redeemerSameAsDatumHash
@@ -157,25 +155,6 @@ spec = describe "Invalid transactions" $ do
157155
then submitPhase2Invalid_ tx
158156
else submitFailingTx tx [injectFailure $ UnspendableUTxONoDatumHash [txIn]]
159157

160-
it "No ExtraRedeemers on same script certificates" $ do
161-
Positive n <- arbitrary
162-
replicateM_ n $ freshKeyHash >>= registerPool
163-
pools <- getsNES $ nesEsL . epochStatePoolParamsL
164-
poolId <- elements $ Map.keys pools
165-
let scriptHash = alwaysSucceedsNoDatumHash
166-
cred = ScriptHashObj scriptHash
167-
certs =
168-
[ mkRegTxCert cred
169-
, mkDelegStakeTxCert cred poolId
170-
, mkUnRegTxCert cred
171-
]
172-
tx <- submitTx $ mkBasicTx (mkBasicTxBody & certsTxBodyL .~ certs)
173-
let redeemers = tx ^. witsTxL . rdmrsTxWitsL . unRedeemersL
174-
Map.keys redeemers
175-
`shouldBe` [ mkCertifyingPurpose $ AsIx 1
176-
, mkCertifyingPurpose $ AsIx 2
177-
]
178-
179158
it "Missing phase-2 script witness" $ do
180159
let scriptHash = alwaysSucceedsWithDatumHash
181160
txIn <- produceScript scriptHash
@@ -253,6 +232,46 @@ spec = describe "Invalid transactions" $ do
253232
it "Spending" $
254233
testPurpose (mkSpendingPurpose $ AsIx 99)
255234

235+
shelleyCertsSpec ::
236+
forall era.
237+
( AlonzoEraImp era
238+
, ShelleyEraTxCert era
239+
, InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
240+
, InjectRuleFailure "LEDGER" AlonzoUtxowPredFailure era
241+
) =>
242+
SpecWith (ImpInit (LedgerSpec era))
243+
shelleyCertsSpec = describe "Invalid transactions" $ do
244+
-- let resetAddrWits tx = updateAddrTxWits $ tx & witsTxL . addrTxWitsL .~ []
245+
-- fixupResetAddrWits = fixupPPHash >=> resetAddrWits
246+
247+
forM_ (eraLanguages @era) $ \lang ->
248+
withSLanguage lang $ \slang ->
249+
describe (show lang) $ do
250+
let alwaysSucceedsWithDatumHash = hashPlutusScript $ alwaysSucceedsWithDatum slang
251+
alwaysSucceedsNoDatumHash = hashPlutusScript $ alwaysSucceedsNoDatum slang
252+
253+
it "No ExtraRedeemers on same script certificates" $ do
254+
Positive n <- arbitrary
255+
replicateM_ n $ freshKeyHash >>= registerPool
256+
pools <- getsNES $ nesEsL . epochStatePoolParamsL
257+
poolId <- elements $ Map.keys pools
258+
let scriptHash = alwaysSucceedsNoDatumHash
259+
cred = ScriptHashObj scriptHash
260+
certs =
261+
[ mkRegTxCert cred
262+
, mkDelegStakeTxCert cred poolId
263+
, mkUnRegTxCert cred
264+
]
265+
tx <- submitTx $ mkBasicTx (mkBasicTxBody & certsTxBodyL .~ certs)
266+
let redeemers = tx ^. witsTxL . rdmrsTxWitsL . unRedeemersL
267+
Map.keys redeemers
268+
`shouldBe` [ mkCertifyingPurpose $ AsIx 1
269+
, mkCertifyingPurpose $ AsIx 2
270+
]
271+
272+
-- Post-Alonzo eras produce additional post-Alonzo predicate failures that we can't include here
273+
unless (lang > eraMaxLanguage @AlonzoEra) $ do
274+
describe "Extra Redeemer" $ do
256275
it "Multiple equal plutus-locked certs" $ do
257276
let scriptHash = alwaysSucceedsWithDatumHash
258277
Positive n <- arbitrary

‎eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxowSpec/Valid.hs‎

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

11-
module Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec.Valid (spec) where
11+
module Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec.Valid (spec, shelleyCertsSpec) where
1212

1313
import Cardano.Ledger.Allegra.Scripts (
1414
pattern RequireTimeExpire,
@@ -47,8 +47,6 @@ import Test.Cardano.Ledger.Plutus.Examples
4747
spec ::
4848
forall era.
4949
( AlonzoEraImp era
50-
, ShelleyEraTxCert era
51-
, InjectRuleFailure "LEDGER" ShelleyDelegPredFailure era
5250
, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
5351
) =>
5452
SpecWith (ImpInit (LedgerSpec era))
@@ -89,6 +87,51 @@ spec = describe "Valid transactions" $ do
8987
mkBasicTx $
9088
mkBasicTxBody & inputsTxBodyL .~ [txIn]
9189

90+
it "Validating MINT script" $ do
91+
submitTx_ =<< mkTokenMintingTx alwaysSucceedsNoDatumHash
92+
93+
it "Not validating MINT script" $ do
94+
submitPhase2Invalid_ =<< mkTokenMintingTx alwaysFailsNoDatumHash
95+
96+
it "Acceptable supplementary datum" $ do
97+
inputAddr <- freshKeyHash @'Payment
98+
amount <- Coin <$> choose (2_000_000, 8_000_000)
99+
txIn <- sendCoinTo (mkAddr inputAddr StakeRefNull) amount
100+
let
101+
datum = Data (P.I 123)
102+
datumHash = hashData datum
103+
txOut =
104+
mkBasicTxOut
105+
(mkAddr alwaysSucceedsWithDatumHash StakeRefNull)
106+
(MaryValue amount mempty)
107+
& dataHashTxOutL .~ SJust datumHash
108+
txBody =
109+
mkBasicTxBody
110+
& inputsTxBodyL .~ [txIn]
111+
& outputsTxBodyL .~ [txOut]
112+
tx =
113+
mkBasicTx txBody
114+
& witsTxL . datsTxWitsL . unTxDatsL %~ Map.insert datumHash datum
115+
submitTx_ tx
116+
117+
shelleyCertsSpec ::
118+
forall era.
119+
( AlonzoEraImp era
120+
, ShelleyEraTxCert era
121+
, InjectRuleFailure "LEDGER" ShelleyDelegPredFailure era
122+
, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
123+
) =>
124+
SpecWith (ImpInit (LedgerSpec era))
125+
shelleyCertsSpec = do
126+
forM_ (eraLanguages @era) $ \lang ->
127+
withSLanguage lang $ \slang ->
128+
describe (show lang) $ do
129+
let
130+
alwaysSucceedsWithDatumHash = hashPlutusScript $ alwaysSucceedsWithDatum slang :: ScriptHash
131+
alwaysSucceedsNoDatumHash = hashPlutusScript $ alwaysSucceedsNoDatum slang :: ScriptHash
132+
alwaysFailsWithDatumHash = hashPlutusScript $ alwaysFailsWithDatum slang :: ScriptHash
133+
alwaysFailsNoDatumHash = hashPlutusScript $ alwaysFailsNoDatum slang :: ScriptHash
134+
92135
it "Validating CERT script" $ do
93136
txIn <- produceScript alwaysSucceedsWithDatumHash
94137
let txCert = RegTxCert $ ScriptHashObj alwaysSucceedsNoDatumHash
@@ -119,12 +162,6 @@ spec = describe "Valid transactions" $ do
119162
mkBasicTx $
120163
mkBasicTxBody & withdrawalsTxBodyL .~ Withdrawals [(account, mempty)]
121164

122-
it "Validating MINT script" $ do
123-
submitTx_ =<< mkTokenMintingTx alwaysSucceedsNoDatumHash
124-
125-
it "Not validating MINT script" $ do
126-
submitPhase2Invalid_ =<< mkTokenMintingTx alwaysFailsNoDatumHash
127-
128165
-- Process a transaction with a succeeding script in every place possible,
129166
-- and also with succeeding timelock scripts.
130167
it "Validating scripts everywhere" $ do
@@ -163,27 +200,6 @@ spec = describe "Valid transactions" $ do
163200
& outputsTxBodyL .~ [txOut]
164201
submitTx_ $ mkBasicTx txBody
165202

166-
it "Acceptable supplementary datum" $ do
167-
inputAddr <- freshKeyHash @'Payment
168-
amount <- Coin <$> choose (2_000_000, 8_000_000)
169-
txIn <- sendCoinTo (mkAddr inputAddr StakeRefNull) amount
170-
let
171-
datum = Data (P.I 123)
172-
datumHash = hashData datum
173-
txOut =
174-
mkBasicTxOut
175-
(mkAddr alwaysSucceedsWithDatumHash StakeRefNull)
176-
(MaryValue amount mempty)
177-
& dataHashTxOutL .~ SJust datumHash
178-
txBody =
179-
mkBasicTxBody
180-
& inputsTxBodyL .~ [txIn]
181-
& outputsTxBodyL .~ [txOut]
182-
tx =
183-
mkBasicTx txBody
184-
& witsTxL . datsTxWitsL . unTxDatsL %~ Map.insert datumHash datum
185-
submitTx_ tx
186-
187203
it "Multiple identical certificates" $ do
188204
let scriptHash = alwaysSucceedsNoDatumHash
189205
void . registerStakeCredential $ ScriptHashObj scriptHash

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

Lines changed: 40 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
{-# LANGUAGE TypeOperators #-}
88
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
99

10-
module Test.Cardano.Ledger.Conway.Imp (spec, conwaySpec) where
10+
module Test.Cardano.Ledger.Conway.Imp (spec, conwaySpec, shelleyCertsSpec) where
1111

1212
import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusContext (ContextError))
1313
import Cardano.Ledger.Alonzo.Rules (
@@ -40,6 +40,7 @@ import Cardano.Ledger.Shelley.Rules (
4040
)
4141
import Control.State.Transition.Extended
4242
import Data.Typeable (Typeable)
43+
import qualified Test.Cardano.Ledger.Alonzo.Imp as AlonzoImp
4344
import qualified Test.Cardano.Ledger.Babbage.Imp as BabbageImp
4445
import qualified Test.Cardano.Ledger.Conway.Imp.BbodySpec as Bbody
4546
import qualified Test.Cardano.Ledger.Conway.Imp.CertsSpec as Certs
@@ -140,3 +141,41 @@ conwaySpec = do
140141
describe "RATIFY" Ratify.spec
141142
describe "UTXO" Utxo.spec
142143
describe "UTXOS" Utxos.spec
144+
145+
shelleyCertsSpec ::
146+
forall era.
147+
( ConwayEraImp era
148+
, ShelleyEraTxCert era
149+
, Inject (BabbageContextError era) (ContextError era)
150+
, Inject (ConwayContextError era) (ContextError era)
151+
, InjectRuleFailure "LEDGER" ConwayGovPredFailure era
152+
, InjectRuleFailure "LEDGER" ConwayCertsPredFailure era
153+
, InjectRuleFailure "LEDGER" BabbageUtxoPredFailure era
154+
, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
155+
, InjectRuleFailure "LEDGER" AlonzoUtxowPredFailure era
156+
, InjectRuleFailure "LEDGER" ShelleyDelegPredFailure era
157+
, InjectRuleFailure "LEDGER" ShelleyUtxowPredFailure era
158+
, InjectRuleFailure "LEDGER" ConwayDelegPredFailure era
159+
, InjectRuleFailure "LEDGER" ConwayGovCertPredFailure era
160+
, InjectRuleFailure "LEDGER" ConwayLedgerPredFailure era
161+
, InjectRuleFailure "LEDGER" ConwayUtxoPredFailure era
162+
, InjectRuleFailure "BBODY" ConwayBbodyPredFailure era
163+
, InjectRuleEvent "TICK" ConwayEpochEvent era
164+
, Event (EraRule "EPOCH" era) ~ ConwayEpochEvent era
165+
, Event (EraRule "NEWEPOCH" era) ~ ConwayNewEpochEvent era
166+
, Event (EraRule "HARDFORK" era) ~ ConwayHardForkEvent era
167+
, ApplyTx era
168+
, NFData (Event (EraRule "ENACT" era))
169+
, ToExpr (Event (EraRule "ENACT" era))
170+
, Eq (Event (EraRule "ENACT" era))
171+
, Typeable (Event (EraRule "ENACT" era))
172+
) =>
173+
Spec
174+
shelleyCertsSpec = do
175+
AlonzoImp.shelleyCertsSpec @era
176+
withImpInit @(LedgerSpec era) $
177+
forM_ (eraProtVersions @era) $ \protVer ->
178+
describe ("Certificates without deposits - " <> show protVer) $
179+
modifyImpInitProtVer protVer $ do
180+
describe "DELEG" Deleg.shelleyCertsSpec
181+
describe "UTXO" Utxo.shelleyCertsSpec

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -109,8 +109,9 @@ spec =
109109
CommitteeRatify.spec @era
110110
SPORatifySpec.spec @era
111111
roundTripJsonEraSpec @era
112-
describe "Imp" $
112+
describe "Imp" $ do
113113
Imp.spec @era
114+
Imp.shelleyCertsSpec @era
114115
describe "CostModels" $ do
115116
CostModelsSpec.spec @era
116117
describe "TxWits" $ do

0 commit comments

Comments
 (0)