Move or replace BabbageFeatures tests in cardano-ledger-test

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

@@ -11,19 +11,10 @@ module Test.Cardano.Ledger.Babbage.Imp.UtxoSpec (spec) where
 
 import Cardano.Ledger.Babbage.Core
 import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure (..))
-import Cardano.Ledger.BaseTypes (Inject (..), ProtVer (..), StrictMaybe (..), natVersion)
-import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..))
-import Cardano.Ledger.Credential (StakeReference (..))
-import Cardano.Ledger.Plutus (
-  Language (..),
-  SLanguage (..),
-  hashPlutusScript,
-  mkInlineDatum,
-  withSLanguage,
- )
+import Cardano.Ledger.BaseTypes (Inject (..))
+import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.Plutus (mkInlineDatum)
 import qualified Data.ByteString as BS
-import qualified Data.Sequence.Strict as SSeq
-import qualified Data.Set as Set
 import Lens.Micro ((&), (.~))
 import qualified PlutusLedgerApi.V1 as PV1
 import Test.Cardano.Ledger.Babbage.ImpTest (
@@ -32,15 +23,9 @@ import Test.Cardano.Ledger.Babbage.ImpTest (
   LedgerSpec,
   freshKeyAddr_,
   getsPParams,
-  sendCoinTo,
   submitFailingTx,
-  submitTx,
-  submitTx_,
  )
-import Test.Cardano.Ledger.Common (SpecWith, describe, it, when)
-import Test.Cardano.Ledger.Core.Utils (txInAt)
-import Test.Cardano.Ledger.Imp.Common (mkAddr)
-import Test.Cardano.Ledger.Plutus.Examples (alwaysSucceedsWithDatum, inputsOverlapsWithRefInputs)
+import Test.Cardano.Ledger.Common (SpecWith, describe, it)
 
 spec ::
   forall era.
@@ -50,50 +35,6 @@ spec ::
   ) =>
   SpecWith (ImpInit (LedgerSpec era))
 spec = describe "UTXO" $ do
-  describe "Reference scripts" $ do
-    it "Reference inputs can overlap with regular inputs in PlutusV2" $ do
-      let
-        txOut =
-          mkBasicTxOut
-            ( mkAddr
-                (hashPlutusScript (inputsOverlapsWithRefInputs SPlutusV2))
-                StakeRefNull
-            )
-            (inject $ Coin 1_000_000)
-            & datumTxOutL .~ mkInlineDatum (PV1.I 0)
-      tx <-
-        submitTx $
-          mkBasicTx mkBasicTxBody
-            & bodyTxL . outputsTxBodyL .~ SSeq.singleton txOut
-      let txIn = txInAt 0 tx
-      majorVer <- pvMajor <$> getsPParams ppProtocolVersionL
-      when (majorVer < natVersion @9 || majorVer > natVersion @10) $
-        submitTx_ @era $
-          mkBasicTx mkBasicTxBody
-            & bodyTxL . inputsTxBodyL .~ Set.singleton txIn
-            & bodyTxL . referenceInputsTxBodyL .~ Set.singleton txIn
-
-  it "Incorrect collateral total" $ do
-    let scriptHash = withSLanguage PlutusV2 (hashPlutusScript . alwaysSucceedsWithDatum)
-        txOut =
-          mkBasicTxOut (mkAddr scriptHash StakeRefNull) mempty
-            & datumTxOutL .~ mkInlineDatum (PV1.I 1)
-        tx1 = mkBasicTx $ mkBasicTxBody & outputsTxBodyL .~ [txOut]
-    txIn <- txInAt 0 <$> submitTx tx1
-    addr <- freshKeyAddr_
-    coll <- sendCoinTo addr $ Coin 5_000_000
-    let collReturn = mkBasicTxOut addr . inject $ Coin 2_000_000
-        tx2 =
-          mkBasicTx $
-            mkBasicTxBody
-              & inputsTxBodyL .~ [txIn]
-              & collateralInputsTxBodyL .~ [coll]
-              & collateralReturnTxBodyL .~ SJust collReturn
-              & totalCollateralTxBodyL .~ SJust (Coin 1_000_000)
-    submitFailingTx
-      tx2
-      [injectFailure (IncorrectTotalCollateralField (DeltaCoin 3_000_000) (Coin 1_000_000))]
-
   -- TxOut too large for the included ADA, using a large inline datum
   it "Min-utxo value with output too large" $ do
     pp <- getsPParams id

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

@@ -14,17 +14,26 @@ import Cardano.Ledger.Alonzo.Plutus.TxInfo (
  )
 import Cardano.Ledger.Alonzo.Rules (AlonzoUtxosPredFailure (CollectErrors))
 import Cardano.Ledger.Babbage (BabbageEra)
-import Cardano.Ledger.Babbage.Core (referenceInputsTxBodyL)
+import Cardano.Ledger.Babbage.Core (
+  collateralInputsTxBodyL,
+  collateralReturnTxBodyL,
+  datumTxOutL,
+  referenceInputsTxBodyL,
+  totalCollateralTxBodyL,
+ )
+import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure (..))
 import Cardano.Ledger.Babbage.TxInfo (
   BabbageContextError (
     ReferenceInputsNotSupported,
     ReferenceScriptsNotSupported
   ),
  )
 import Cardano.Ledger.Babbage.TxOut (referenceScriptTxOutL)
-import Cardano.Ledger.BaseTypes (StrictMaybe (..), TxIx (..), inject)
-import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.BaseTypes (ProtVer (..), TxIx (..), inject, natVersion)
+import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..))
 import Cardano.Ledger.Core (
+  ProtVerHigh,
+  bodyTxL,
   eraProtVerHigh,
   eraProtVerLow,
   fromNativeScript,
@@ -33,20 +42,24 @@ import Cardano.Ledger.Core (
   inputsTxBodyL,
   mkBasicTx,
   mkBasicTxBody,
+  mkBasicTxOut,
   mkCoinTxOut,
   outputsTxBodyL,
  )
-import Cardano.Ledger.Plutus (Language (..), hashPlutusScript, withSLanguage)
+import Cardano.Ledger.Credential (StakeReference (..))
+import Cardano.Ledger.Plutus (Language (..), hashPlutusScript, mkInlineDatum, withSLanguage)
 import Cardano.Ledger.Shelley.Scripts (pattern RequireAllOf)
 import Lens.Micro
+import qualified PlutusLedgerApi.V1 as PV1
 import Test.Cardano.Ledger.Alonzo.ImpTest
 import Test.Cardano.Ledger.Babbage.ImpTest (BabbageEraImp)
+import Test.Cardano.Ledger.Core.Utils (txInAt)
 import Test.Cardano.Ledger.Imp.Common
 import Test.Cardano.Ledger.Plutus.Examples
 
 spec :: forall era. BabbageEraImp era => SpecWith (ImpInit (LedgerSpec era))
 spec = describe "UTXOS" $ do
-  describe "Plutus V1 with references" $ do
+  describe "PlutusV1 with references" $ do
     let inBabbage = eraProtVerLow @era <= eraProtVerHigh @BabbageEra
         behavior = if inBabbage then "fails" else "succeeds"
         submitBabbageFailingTx tx failures =
@@ -59,7 +72,7 @@ spec = describe "UTXOS" $ do
       addr <- freshKeyAddr_
       let txOut =
             mkCoinTxOut addr (inject $ Coin 5_000_000)
-              & referenceScriptTxOutL .~ SJust nativeScript
+              & referenceScriptTxOutL .~ pure nativeScript
           tx =
             mkBasicTx $
               mkBasicTxBody
@@ -92,3 +105,48 @@ spec = describe "UTXOS" $ do
                   ReferenceInputsNotSupported @era [refIn]
               ]
         ]
+
+  describe "PlutusV2 with references" $ do
+    it "succeeds with same txIn in regular inputs and reference inputs" $ do
+      let
+        scriptHash = withSLanguage PlutusV2 $ hashPlutusScript . inputsOverlapsWithRefInputs
+        txOut =
+          mkBasicTxOut (mkAddr scriptHash StakeRefNull) mempty
+            & datumTxOutL .~ mkInlineDatum (PV1.I 0)
+      tx <-
+        submitTx $
+          mkBasicTx $
+            mkBasicTxBody & outputsTxBodyL .~ [txOut]
+      let txIn = txInAt 0 tx
+      majorVer <- pvMajor <$> getProtVer
+      when (majorVer <= natVersion @(ProtVerHigh BabbageEra) || majorVer >= natVersion @11) $
+        submitTx_ $
+          mkBasicTx mkBasicTxBody
+            & bodyTxL . inputsTxBodyL .~ [txIn]
+            & bodyTxL . referenceInputsTxBodyL .~ [txIn]
+
+  it "Incorrect collateral total" $ do
+    let
+      scriptHash = withSLanguage PlutusV2 (hashPlutusScript . alwaysSucceedsWithDatum)
+      txOut =
+        mkBasicTxOut (mkAddr scriptHash StakeRefNull) mempty
+          & datumTxOutL .~ mkInlineDatum (PV1.I 1)
+    tx <-
+      submitTx $
+        mkBasicTx $
+          mkBasicTxBody & outputsTxBodyL .~ [txOut]
+    let txIn = txInAt 0 tx
+    addr <- freshKeyAddr_
+    coll <- sendCoinTo addr $ Coin 5_000_000
+    let
+      collReturn = mkBasicTxOut addr . inject $ Coin 2_000_000
+      tx2 =
+        mkBasicTx $
+          mkBasicTxBody
+            & inputsTxBodyL .~ [txIn]
+            & collateralInputsTxBodyL .~ [coll]
+            & collateralReturnTxBodyL .~ pure collReturn
+            & totalCollateralTxBodyL .~ pure (Coin 1_000_000)
+    submitFailingTx
+      tx2
+      [injectFailure (IncorrectTotalCollateralField (DeltaCoin 3_000_000) (Coin 1_000_000))]

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

@@ -14,21 +14,14 @@ module Test.Cardano.Ledger.Conway.Imp.UtxoSpec (
 ) where
 
 import Cardano.Ledger.Address
-import Cardano.Ledger.Alonzo.Plutus.Evaluate (CollectError (..))
 import Cardano.Ledger.Alonzo.Scripts
-import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure (..))
 import Cardano.Ledger.BaseTypes
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Conway.PParams (ppMinFeeRefScriptCostPerByteL)
-import Cardano.Ledger.Conway.Rules (ConwayUtxosPredFailure (..))
 import Cardano.Ledger.Conway.TxCert
-import Cardano.Ledger.Conway.TxInfo (ConwayContextError (..))
 import Cardano.Ledger.Credential
-import Cardano.Ledger.Plutus.Language (
-  SLanguage (..),
-  hashPlutusScript,
- )
+import Cardano.Ledger.Plutus.Language (SLanguage (..))
 import Cardano.Ledger.Shelley.LedgerState
 import Cardano.Ledger.Shelley.Scripts (
   pattern RequireSignature,
@@ -42,7 +35,7 @@ import Lens.Micro ((&), (.~), (^.))
 import Test.Cardano.Ledger.Conway.ImpTest
 import Test.Cardano.Ledger.Core.Rational ((%!))
 import Test.Cardano.Ledger.Imp.Common
-import Test.Cardano.Ledger.Plutus.Examples (alwaysSucceedsNoDatum, inputsOverlapsWithRefInputs)
+import Test.Cardano.Ledger.Plutus.Examples (alwaysSucceedsNoDatum)
 
 spec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
 spec = do
@@ -160,22 +153,6 @@ spec = do
           ++ extraScripts
           ++ extraScripts
 
-    let scriptHash lang = hashPlutusScript $ inputsOverlapsWithRefInputs lang
-    it "Cannot run scripts that expect inputs and refInputs to overlap (PV 9/10)" $ do
-      whenMajorVersionAtMost @10 $ do
-        txIn <- produceScript $ scriptHash SPlutusV3
-        submitFailingTx @era
-          (mkTxWithRefInputs txIn (NE.fromList [txIn]))
-          [ injectFailure $ BabbageNonDisjointRefInputs [txIn]
-          ]
-    it "Same script cannot appear in regular and reference inputs in PlutusV3 (PV 11)" $ whenMajorVersionAtLeast @11 $ do
-      txIn <- produceScript $ scriptHash SPlutusV3
-      submitFailingTx @era
-        (mkTxWithRefInputs txIn (NE.fromList [txIn]))
-        [ injectFailure $
-            CollectErrors [BadTranslation . inject $ ReferenceInputsNotDisjointFromInputs @era [txIn]]
-        ]
-
 conwayEraSpecificSpec ::
   forall era.
   ( ConwayEraImp era