Skip to content

Commit dfcf1ed

Browse files
neilmayhewneilmayhew
authored
Merge pull request #5347 from IntersectMBO/nm/4183-babbagefeatures-to-imp
Move or replace `BabbageFeatures` tests in `cardano-ledger-test` Closes #4183
2 parents 173fc6b + c818c8a commit dfcf1ed

File tree

9 files changed

+150
-523
lines changed

9 files changed

+150
-523
lines changed

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

Lines changed: 4 additions & 63 deletions
Original file line numberDiff line numberDiff line change
@@ -11,19 +11,10 @@ module Test.Cardano.Ledger.Babbage.Imp.UtxoSpec (spec) where
1111

1212
import Cardano.Ledger.Babbage.Core
1313
import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure (..))
14-
import Cardano.Ledger.BaseTypes (Inject (..), ProtVer (..), StrictMaybe (..), natVersion)
15-
import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..))
16-
import Cardano.Ledger.Credential (StakeReference (..))
17-
import Cardano.Ledger.Plutus (
18-
Language (..),
19-
SLanguage (..),
20-
hashPlutusScript,
21-
mkInlineDatum,
22-
withSLanguage,
23-
)
14+
import Cardano.Ledger.BaseTypes (Inject (..))
15+
import Cardano.Ledger.Coin (Coin (..))
16+
import Cardano.Ledger.Plutus (mkInlineDatum)
2417
import qualified Data.ByteString as BS
25-
import qualified Data.Sequence.Strict as SSeq
26-
import qualified Data.Set as Set
2718
import Lens.Micro ((&), (.~))
2819
import qualified PlutusLedgerApi.V1 as PV1
2920
import Test.Cardano.Ledger.Babbage.ImpTest (
@@ -32,15 +23,9 @@ import Test.Cardano.Ledger.Babbage.ImpTest (
3223
LedgerSpec,
3324
freshKeyAddr_,
3425
getsPParams,
35-
sendCoinTo,
3626
submitFailingTx,
37-
submitTx,
38-
submitTx_,
3927
)
40-
import Test.Cardano.Ledger.Common (SpecWith, describe, it, when)
41-
import Test.Cardano.Ledger.Core.Utils (txInAt)
42-
import Test.Cardano.Ledger.Imp.Common (mkAddr)
43-
import Test.Cardano.Ledger.Plutus.Examples (alwaysSucceedsWithDatum, inputsOverlapsWithRefInputs)
28+
import Test.Cardano.Ledger.Common (SpecWith, describe, it)
4429

4530
spec ::
4631
forall era.
@@ -50,50 +35,6 @@ spec ::
5035
) =>
5136
SpecWith (ImpInit (LedgerSpec era))
5237
spec = describe "UTXO" $ do
53-
describe "Reference scripts" $ do
54-
it "Reference inputs can overlap with regular inputs in PlutusV2" $ do
55-
let
56-
txOut =
57-
mkBasicTxOut
58-
( mkAddr
59-
(hashPlutusScript (inputsOverlapsWithRefInputs SPlutusV2))
60-
StakeRefNull
61-
)
62-
(inject $ Coin 1_000_000)
63-
& datumTxOutL .~ mkInlineDatum (PV1.I 0)
64-
tx <-
65-
submitTx $
66-
mkBasicTx mkBasicTxBody
67-
& bodyTxL . outputsTxBodyL .~ SSeq.singleton txOut
68-
let txIn = txInAt 0 tx
69-
majorVer <- pvMajor <$> getsPParams ppProtocolVersionL
70-
when (majorVer < natVersion @9 || majorVer > natVersion @10) $
71-
submitTx_ @era $
72-
mkBasicTx mkBasicTxBody
73-
& bodyTxL . inputsTxBodyL .~ Set.singleton txIn
74-
& bodyTxL . referenceInputsTxBodyL .~ Set.singleton txIn
75-
76-
it "Incorrect collateral total" $ do
77-
let scriptHash = withSLanguage PlutusV2 (hashPlutusScript . alwaysSucceedsWithDatum)
78-
txOut =
79-
mkBasicTxOut (mkAddr scriptHash StakeRefNull) mempty
80-
& datumTxOutL .~ mkInlineDatum (PV1.I 1)
81-
tx1 = mkBasicTx $ mkBasicTxBody & outputsTxBodyL .~ [txOut]
82-
txIn <- txInAt 0 <$> submitTx tx1
83-
addr <- freshKeyAddr_
84-
coll <- sendCoinTo addr $ Coin 5_000_000
85-
let collReturn = mkBasicTxOut addr . inject $ Coin 2_000_000
86-
tx2 =
87-
mkBasicTx $
88-
mkBasicTxBody
89-
& inputsTxBodyL .~ [txIn]
90-
& collateralInputsTxBodyL .~ [coll]
91-
& collateralReturnTxBodyL .~ SJust collReturn
92-
& totalCollateralTxBodyL .~ SJust (Coin 1_000_000)
93-
submitFailingTx
94-
tx2
95-
[injectFailure (IncorrectTotalCollateralField (DeltaCoin 3_000_000) (Coin 1_000_000))]
96-
9738
-- TxOut too large for the included ADA, using a large inline datum
9839
it "Min-utxo value with output too large" $ do
9940
pp <- getsPParams id

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

Lines changed: 64 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -14,17 +14,26 @@ import Cardano.Ledger.Alonzo.Plutus.TxInfo (
1414
)
1515
import Cardano.Ledger.Alonzo.Rules (AlonzoUtxosPredFailure (CollectErrors))
1616
import Cardano.Ledger.Babbage (BabbageEra)
17-
import Cardano.Ledger.Babbage.Core (referenceInputsTxBodyL)
17+
import Cardano.Ledger.Babbage.Core (
18+
collateralInputsTxBodyL,
19+
collateralReturnTxBodyL,
20+
datumTxOutL,
21+
referenceInputsTxBodyL,
22+
totalCollateralTxBodyL,
23+
)
24+
import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure (..))
1825
import Cardano.Ledger.Babbage.TxInfo (
1926
BabbageContextError (
2027
ReferenceInputsNotSupported,
2128
ReferenceScriptsNotSupported
2229
),
2330
)
2431
import Cardano.Ledger.Babbage.TxOut (referenceScriptTxOutL)
25-
import Cardano.Ledger.BaseTypes (StrictMaybe (..), TxIx (..), inject)
26-
import Cardano.Ledger.Coin (Coin (..))
32+
import Cardano.Ledger.BaseTypes (ProtVer (..), TxIx (..), inject, natVersion)
33+
import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..))
2734
import Cardano.Ledger.Core (
35+
ProtVerHigh,
36+
bodyTxL,
2837
eraProtVerHigh,
2938
eraProtVerLow,
3039
fromNativeScript,
@@ -33,20 +42,24 @@ import Cardano.Ledger.Core (
3342
inputsTxBodyL,
3443
mkBasicTx,
3544
mkBasicTxBody,
45+
mkBasicTxOut,
3646
mkCoinTxOut,
3747
outputsTxBodyL,
3848
)
39-
import Cardano.Ledger.Plutus (Language (..), hashPlutusScript, withSLanguage)
49+
import Cardano.Ledger.Credential (StakeReference (..))
50+
import Cardano.Ledger.Plutus (Language (..), hashPlutusScript, mkInlineDatum, withSLanguage)
4051
import Cardano.Ledger.Shelley.Scripts (pattern RequireAllOf)
4152
import Lens.Micro
53+
import qualified PlutusLedgerApi.V1 as PV1
4254
import Test.Cardano.Ledger.Alonzo.ImpTest
4355
import Test.Cardano.Ledger.Babbage.ImpTest (BabbageEraImp)
56+
import Test.Cardano.Ledger.Core.Utils (txInAt)
4457
import Test.Cardano.Ledger.Imp.Common
4558
import Test.Cardano.Ledger.Plutus.Examples
4659

4760
spec :: forall era. BabbageEraImp era => SpecWith (ImpInit (LedgerSpec era))
4861
spec = describe "UTXOS" $ do
49-
describe "Plutus V1 with references" $ do
62+
describe "PlutusV1 with references" $ do
5063
let inBabbage = eraProtVerLow @era <= eraProtVerHigh @BabbageEra
5164
behavior = if inBabbage then "fails" else "succeeds"
5265
submitBabbageFailingTx tx failures =
@@ -59,7 +72,7 @@ spec = describe "UTXOS" $ do
5972
addr <- freshKeyAddr_
6073
let txOut =
6174
mkCoinTxOut addr (inject $ Coin 5_000_000)
62-
& referenceScriptTxOutL .~ SJust nativeScript
75+
& referenceScriptTxOutL .~ pure nativeScript
6376
tx =
6477
mkBasicTx $
6578
mkBasicTxBody
@@ -92,3 +105,48 @@ spec = describe "UTXOS" $ do
92105
ReferenceInputsNotSupported @era [refIn]
93106
]
94107
]
108+
109+
describe "PlutusV2 with references" $ do
110+
it "succeeds with same txIn in regular inputs and reference inputs" $ do
111+
let
112+
scriptHash = withSLanguage PlutusV2 $ hashPlutusScript . inputsOverlapsWithRefInputs
113+
txOut =
114+
mkBasicTxOut (mkAddr scriptHash StakeRefNull) mempty
115+
& datumTxOutL .~ mkInlineDatum (PV1.I 0)
116+
tx <-
117+
submitTx $
118+
mkBasicTx $
119+
mkBasicTxBody & outputsTxBodyL .~ [txOut]
120+
let txIn = txInAt 0 tx
121+
majorVer <- pvMajor <$> getProtVer
122+
when (majorVer <= natVersion @(ProtVerHigh BabbageEra) || majorVer >= natVersion @11) $
123+
submitTx_ $
124+
mkBasicTx mkBasicTxBody
125+
& bodyTxL . inputsTxBodyL .~ [txIn]
126+
& bodyTxL . referenceInputsTxBodyL .~ [txIn]
127+
128+
it "Incorrect collateral total" $ do
129+
let
130+
scriptHash = withSLanguage PlutusV2 (hashPlutusScript . alwaysSucceedsWithDatum)
131+
txOut =
132+
mkBasicTxOut (mkAddr scriptHash StakeRefNull) mempty
133+
& datumTxOutL .~ mkInlineDatum (PV1.I 1)
134+
tx <-
135+
submitTx $
136+
mkBasicTx $
137+
mkBasicTxBody & outputsTxBodyL .~ [txOut]
138+
let txIn = txInAt 0 tx
139+
addr <- freshKeyAddr_
140+
coll <- sendCoinTo addr $ Coin 5_000_000
141+
let
142+
collReturn = mkBasicTxOut addr . inject $ Coin 2_000_000
143+
tx2 =
144+
mkBasicTx $
145+
mkBasicTxBody
146+
& inputsTxBodyL .~ [txIn]
147+
& collateralInputsTxBodyL .~ [coll]
148+
& collateralReturnTxBodyL .~ pure collReturn
149+
& totalCollateralTxBodyL .~ pure (Coin 1_000_000)
150+
submitFailingTx
151+
tx2
152+
[injectFailure (IncorrectTotalCollateralField (DeltaCoin 3_000_000) (Coin 1_000_000))]

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

Lines changed: 2 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -14,21 +14,14 @@ module Test.Cardano.Ledger.Conway.Imp.UtxoSpec (
1414
) where
1515

1616
import Cardano.Ledger.Address
17-
import Cardano.Ledger.Alonzo.Plutus.Evaluate (CollectError (..))
1817
import Cardano.Ledger.Alonzo.Scripts
19-
import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure (..))
2018
import Cardano.Ledger.BaseTypes
2119
import Cardano.Ledger.Coin (Coin (..))
2220
import Cardano.Ledger.Conway.Core
2321
import Cardano.Ledger.Conway.PParams (ppMinFeeRefScriptCostPerByteL)
24-
import Cardano.Ledger.Conway.Rules (ConwayUtxosPredFailure (..))
2522
import Cardano.Ledger.Conway.TxCert
26-
import Cardano.Ledger.Conway.TxInfo (ConwayContextError (..))
2723
import Cardano.Ledger.Credential
28-
import Cardano.Ledger.Plutus.Language (
29-
SLanguage (..),
30-
hashPlutusScript,
31-
)
24+
import Cardano.Ledger.Plutus.Language (SLanguage (..))
3225
import Cardano.Ledger.Shelley.LedgerState
3326
import Cardano.Ledger.Shelley.Scripts (
3427
pattern RequireSignature,
@@ -42,7 +35,7 @@ import Lens.Micro ((&), (.~), (^.))
4235
import Test.Cardano.Ledger.Conway.ImpTest
4336
import Test.Cardano.Ledger.Core.Rational ((%!))
4437
import Test.Cardano.Ledger.Imp.Common
45-
import Test.Cardano.Ledger.Plutus.Examples (alwaysSucceedsNoDatum, inputsOverlapsWithRefInputs)
38+
import Test.Cardano.Ledger.Plutus.Examples (alwaysSucceedsNoDatum)
4639

4740
spec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
4841
spec = do
@@ -160,22 +153,6 @@ spec = do
160153
++ extraScripts
161154
++ extraScripts
162155

163-
let scriptHash lang = hashPlutusScript $ inputsOverlapsWithRefInputs lang
164-
it "Cannot run scripts that expect inputs and refInputs to overlap (PV 9/10)" $ do
165-
whenMajorVersionAtMost @10 $ do
166-
txIn <- produceScript $ scriptHash SPlutusV3
167-
submitFailingTx @era
168-
(mkTxWithRefInputs txIn (NE.fromList [txIn]))
169-
[ injectFailure $ BabbageNonDisjointRefInputs [txIn]
170-
]
171-
it "Same script cannot appear in regular and reference inputs in PlutusV3 (PV 11)" $ whenMajorVersionAtLeast @11 $ do
172-
txIn <- produceScript $ scriptHash SPlutusV3
173-
submitFailingTx @era
174-
(mkTxWithRefInputs txIn (NE.fromList [txIn]))
175-
[ injectFailure $
176-
CollectErrors [BadTranslation . inject $ ReferenceInputsNotDisjointFromInputs @era [txIn]]
177-
]
178-
179156
conwayEraSpecificSpec ::
180157
forall era.
181158
( ConwayEraImp era

0 commit comments

Comments
 (0)