Skip to content

Commit dcec4ee

Browse files
LucsanszkyLucsanszky
committed
Separate tests without certificate deposits
1 parent 8ac82bb commit dcec4ee

File tree

7 files changed

+172
-71
lines changed

7 files changed

+172
-71
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: 42 additions & 23 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" . whenMajorVersionAtMost @11 $ 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,7 +232,47 @@ spec = describe "Invalid transactions" $ do
253232
it "Spending" $
254233
testPurpose (mkSpendingPurpose $ AsIx 99)
255234

256-
it "Multiple equal plutus-locked certs" . whenMajorVersionAtMost @11 $ do
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
275+
it "Multiple equal plutus-locked certs" $ do
257276
let scriptHash = alwaysSucceedsWithDatumHash
258277
Positive n <- arbitrary
259278
replicateM_ n $ freshKeyHash >>= registerPool

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

Lines changed: 52 additions & 36 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,7 +87,52 @@ spec = describe "Valid transactions" $ do
8987
mkBasicTx $
9088
mkBasicTxBody & inputsTxBodyL .~ [txIn]
9189

92-
it "Validating CERT script" . whenMajorVersionAtMost @11 $ do
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+
135+
it "Validating CERT script" $ do
93136
txIn <- produceScript alwaysSucceedsWithDatumHash
94137
let txCert = RegTxCert $ ScriptHashObj alwaysSucceedsNoDatumHash
95138
submitTx_ $
@@ -98,7 +141,7 @@ spec = describe "Valid transactions" $ do
98141
& inputsTxBodyL .~ [txIn]
99142
& certsTxBodyL .~ [txCert]
100143

101-
it "Not validating CERT script" . whenMajorVersionAtMost @11 $ do
144+
it "Not validating CERT script" $ do
102145
txIn <- produceScript alwaysFailsWithDatumHash
103146
let txCert = RegTxCert $ ScriptHashObj alwaysSucceedsNoDatumHash
104147
submitPhase2Invalid_ $
@@ -107,27 +150,21 @@ spec = describe "Valid transactions" $ do
107150
& inputsTxBodyL .~ [txIn]
108151
& certsTxBodyL .~ [txCert]
109152

110-
it "Validating WITHDRAWAL script" . whenMajorVersionAtMost @11 $ do
153+
it "Validating WITHDRAWAL script" $ do
111154
account <- registerStakeCredential $ ScriptHashObj alwaysSucceedsNoDatumHash
112155
submitTx_ $
113156
mkBasicTx $
114157
mkBasicTxBody & withdrawalsTxBodyL .~ Withdrawals [(account, mempty)]
115158

116-
it "Not validating WITHDRAWAL script" . whenMajorVersionAtMost @11 $ do
159+
it "Not validating WITHDRAWAL script" $ do
117160
account <- registerStakeCredential $ ScriptHashObj alwaysFailsNoDatumHash
118161
submitPhase2Invalid_ $
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.
130-
it "Validating scripts everywhere" . whenMajorVersionAtMost @11 $ do
167+
it "Validating scripts everywhere" $ do
131168
slotNo <- use impLastTickG
132169
let
133170
timelockScriptHash i = do
@@ -163,28 +200,7 @@ 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-
187-
it "Multiple identical certificates" . whenMajorVersionAtMost @11 $ do
203+
it "Multiple identical certificates" $ do
188204
let scriptHash = alwaysSucceedsNoDatumHash
189205
void . registerStakeCredential $ ScriptHashObj scriptHash
190206
let tx =

0 commit comments

Comments
 (0)