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

Co-authored-by: Alexey Kuleshevich <[email protected]>

Author: Soupstraw

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

@@ -41,7 +41,6 @@ import Cardano.Ledger.TxIn (TxIn (..))
 import Cardano.Ledger.Val
 import qualified Data.ByteString.Short as SBS (length)
 import Data.Functor ((<&>))
-import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
 import qualified Data.Sequence.Strict as SSeq
 import qualified Data.Set as Set
@@ -82,35 +81,31 @@ spec =
     describe "disjoint inputs and reference inputs" $ do
       let
         scriptHash lang = hashPlutusScript $ inputsOverlapsWithRefInputs lang
-        tx :: TxIn -> Tx era
-        tx txIn =
+        mkTestTx :: TxIn -> Tx era
+        mkTestTx txIn =
           mkBasicTx mkBasicTxBody
             & bodyTxL . inputsTxBodyL .~ Set.singleton txIn
             & bodyTxL . referenceInputsTxBodyL .~ Set.singleton txIn
 
-      it "Can run scripts that expect inputs and refInputs to overlap (PV 9)" . whenMajorVersion @9 $ do
+      it "Cannot run scripts that expect inputs and refInputs to overlap (PV 9)" $ whenMajorVersion @9 $ do
         txIn <- produceScript $ scriptHash SPlutusV3
-        submitTx_ @era $ tx txIn
-      it "Same script cannot appear in regular and reference inputs in PlutusV3 (PV 10)"
-        . whenMajorVersion @10
-        $ do
-          txIn <- produceScript $ scriptHash SPlutusV3
-          submitFailingTx @era
-            (tx txIn)
-            [ injectFailure $
-                BabbageNonDisjointRefInputs
-                  (txIn NE.:| [])
-            ]
-      it "Same script cannot appear in regular and reference inputs in PlutusV3 (PV 11)"
-        . whenMajorVersionAtLeast @11
-        $ do
-          txIn <- produceScript $ scriptHash SPlutusV3
-          submitFailingTx @era
-            (tx txIn)
-            [ injectFailure $
-                CollectErrors
-                  [BadTranslation . inject $ ReferenceInputsNotDisjointFromInputs @era (txIn NE.:| [])]
-            ]
+        submitFailingTx @era
+          (mkTestTx txIn)
+          [ injectFailure $ BabbageNonDisjointRefInputs [txIn]
+          ]
+      it "Same script cannot appear in regular and reference inputs in PlutusV3 (PV 10)" $ whenMajorVersion @10 $ do
+        txIn <- produceScript $ scriptHash SPlutusV3
+        submitFailingTx @era
+          (mkTestTx 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
+          (mkTestTx txIn)
+          [ injectFailure $
+              CollectErrors [BadTranslation . inject $ ReferenceInputsNotDisjointFromInputs @era [txIn]]
+          ]
   where
     checkMinFee :: HasCallStack => NativeScript era -> [Script era] -> ImpTestM era ()
     checkMinFee scriptToSpend refScripts = do

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

@@ -32,7 +32,6 @@ import Cardano.Ledger.Shelley.LedgerState
 import Cardano.Ledger.Shelley.Rules (ShelleyUtxowPredFailure (..))
 import Cardano.Ledger.TxIn (TxId (..), mkTxInPartial)
 import Data.Default (def)
-import Data.Either (isLeft, isRight)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Map.Strict as Map
 import qualified Data.OSet.Strict as OSet
@@ -121,17 +120,16 @@ datumAndReferenceInputsSpec = do
               , mkTxInPartial producingTx 1
               ]
           & bodyTxL . referenceInputsTxBodyL .~ Set.singleton (mkTxInPartial producingTx 0)
-    pv <- getProtVer
-    res <- trySubmitTx consumingTx
-    if pv == ProtVer (natVersion @10) 0
-      then case res of
-        Left (err, _) ->
-          err
-            `shouldBeExpr` ( pure . injectFailure . BabbageNonDisjointRefInputs $
-                              mkTxInPartial producingTx 0 :| []
-                           )
-        x -> x `shouldSatisfyExpr` isLeft
-      else res `shouldSatisfyExpr` isRight
+    let badTxIns = mkTxInPartial producingTx 0 :| []
+
+    whenMajorVersionAtMost @10 $
+      submitFailingTx
+        consumingTx
+        (pure . injectFailure $ BabbageNonDisjointRefInputs badTxIns)
+
+    -- consumingTx uses PlutusV1 script, so it should be a success
+    whenMajorVersionAtLeast @11 $
+      submitTx_ consumingTx
   it "fails when using inline datums for PlutusV1" $ do
     let shSpending = hashPlutusScript (redeemerSameAsDatum SPlutusV1)
     refTxOut <- mkRefTxOut shSpending