Added script spend with reference script and inline datum test

plutus-e2e-tests/plutus-e2e-tests.cabal

@@ -106,8 +106,8 @@ test-suite plutus-e2e-tests-test
   other-modules:
     Helpers
     PlutusScripts
+    Spec.BabbageFeatures
     Spec.Builtins.SECP256k1
-    Spec.ReferenceScript
 
   --------------------
   -- Local components

plutus-e2e-tests/test/Helpers.hs

@@ -14,6 +14,7 @@ import Data.Function ((&))
 import Data.List as List
 import Data.Map qualified as Map
 import Data.Map.Lazy (isSubmapOf)
+import Data.Maybe as M
 import Data.Set qualified as Set
 import GHC.Stack qualified as GHC
 import Streaming.Prelude qualified as S
@@ -174,44 +175,79 @@ w1 tempAbsPath' networkId = do
 
   let
     paymentKey = C.castVerificationKey genesisVKey :: C.VerificationKey C.PaymentKey
-    address :: C.Address C.ShelleyAddr
-    address = C.makeShelleyAddress
-      networkId
-      (C.PaymentCredentialByKey (C.verificationKeyHash paymentKey :: C.Hash C.PaymentKey))
-      C.NoStakeAddress :: C.Address C.ShelleyAddr
+    address = makeAddress (Left paymentKey) networkId
 
   return (genesisSKey, address)
 
+-- | Make a payment or script address
+makeAddress :: (Either (C.VerificationKey C.PaymentKey) C.ScriptHash)
+  -> C.NetworkId
+  -> C.Address C.ShelleyAddr
+makeAddress (Left paymentKey)  nId =
+    C.makeShelleyAddress nId (C.PaymentCredentialByKey $ C.verificationKeyHash paymentKey) C.NoStakeAddress
+makeAddress (Right scriptHash) nId =
+    C.makeShelleyAddress nId (C.PaymentCredentialByScript scriptHash) C.NoStakeAddress
+
 -- | Build TxOut for spending or minting with no datum or reference script present
 txOutNoDatumOrRefScript :: C.CardanoEra era
   -> C.Value
   -> C.Address C.ShelleyAddr
   -> C.TxOut ctx era
 txOutNoDatumOrRefScript era value address = C.TxOut
-    (fromMaybe $ C.anyAddressInEra era $ C.toAddressAny address)
+    (maybeAnyAddressInEra $ C.anyAddressInEra era $ C.toAddressAny address)
     (C.TxOutValue (multiAssetSupportedInEra era) value)
     C.TxOutDatumNone
     C.ReferenceScriptNone
+
+-- | Build TxOut with option of including reference script and inline datum
+txOutWithRefScriptAndInlineDatum' :: C.CardanoEra era
+  -> C.Value
+  -> C.Address C.ShelleyAddr
+  -> Maybe C.ScriptData
+  -> Maybe (C.Script lang)
+  -> C.TxOut ctx era
+txOutWithRefScriptAndInlineDatum' era value address mDatum mScript =
+  C.TxOut
+    (maybeAnyAddressInEra $ C.anyAddressInEra era $ C.toAddressAny address)
+    (C.TxOutValue (multiAssetSupportedInEra era) value)
+    (maybe C.TxOutDatumNone
+      (C.TxOutDatumInline referenceTxInsScriptsInlineDatumsSupportedInEra) mDatum)
+    (maybe C.ReferenceScriptNone
+      (C.ReferenceScript referenceTxInsScriptsInlineDatumsSupportedInEra . C.toScriptInAnyLang) mScript)
   where
-    fromMaybe Nothing    = error $ "Era must be ShelleyBased"
-    fromMaybe (Just aie) = aie
+    referenceTxInsScriptsInlineDatumsSupportedInEra = case era of
+          C.BabbageEra -> C.ReferenceTxInsScriptsInlineDatumsInBabbageEra
+
+-- | Build TxOut with reference script and inline datum present
+txOutWithRefScriptAndInlineDatum :: C.CardanoEra era
+  -> C.Value
+  -> C.Address C.ShelleyAddr
+  -> C.ScriptData
+  -> C.Script lang
+  -> C.TxOut ctx era
+txOutWithRefScriptAndInlineDatum era value address datum script =
+    txOutWithRefScriptAndInlineDatum' era value address (Just datum) (Just script)
 
 -- | Build TxOut with a reference script present
 txOutWithRefScript :: C.CardanoEra era
   -> C.Value
   -> C.Address C.ShelleyAddr
   -> C.Script lang
   -> C.TxOut ctx era
-txOutWithRefScript era value address script = C.TxOut
-    (fromMaybe $ C.anyAddressInEra era $ C.toAddressAny address)
-    (C.TxOutValue (multiAssetSupportedInEra era) value)
-    C.TxOutDatumNone
-    (case era of
-      C.BabbageEra ->
-        C.ReferenceScript C.ReferenceTxInsScriptsInlineDatumsInBabbageEra $ C.toScriptInAnyLang script)
-  where
-    fromMaybe Nothing    = error $ "Era must be ShelleyBased"
-    fromMaybe (Just aie) = aie
+txOutWithRefScript era value address script =
+    txOutWithRefScriptAndInlineDatum' era value address Nothing (Just script)
+
+-- | Build TxOut with inline datum present
+txOutWithInlineDatum :: C.CardanoEra era
+  -> C.Value
+  -> C.Address C.ShelleyAddr
+  -> C.ScriptData
+  -> C.TxOut ctx era
+txOutWithInlineDatum era value address datum =
+    txOutWithRefScriptAndInlineDatum' era value address (Just datum) Nothing
+
+maybeAnyAddressInEra Nothing    = error $ "Era must be ShelleyBased"
+maybeAnyAddressInEra (Just aie) = aie
 
 -- | Find the first UTxO at address and return as TxIn. Used for txbody's txIns.
 firstTxIn :: (MonadIO m, MonadTest m)
@@ -310,13 +346,27 @@ txInsCollateral era txIns = case C.collateralSupportedInEra era of
     Nothing        -> error "era supporting collateral only"
     Just supported -> C.TxInsCollateral supported txIns
 
--- | Get TxId from a signed transaction to produce a TxIn.
---   Useful for asserting expected TxOut is onchain after submitting transaction.
-txInFromSignedTx :: C.Tx era -> Int -> C.TxIn
-txInFromSignedTx signedTx txIx = C.TxIn (C.getTxId $ C.getTxBody signedTx) (C.TxIx $ fromIntegral txIx)
+-- | Get TxId from a signed transaction.
+--  Useful for producing TxIn for building subsequant transaction.
+txId :: C.Tx era -> C.TxId
+txId = C.getTxId . C.getTxBody
+
+-- | Build TxIn from TxId and index. Useful for waiting for or asserting expected TxOut is
+--   onchain after submitting transaction.
+txIn :: C.TxId -> Int -> C.TxIn
+txIn txId txIx = C.TxIn txId (C.TxIx $ fromIntegral txIx)
 
 pubkeyTxIns  :: [C.TxIn] -> [(C.TxIn, C.BuildTxWith C.BuildTx (C.Witness C.WitCtxTxIn era))]
-pubkeyTxIns txIns = map (\txIn -> (txIn, C.BuildTxWith $ C.KeyWitness C.KeyWitnessForSpending)) txIns
+pubkeyTxIns txIns = map (\txIn -> txInWitness txIn $ C.KeyWitness C.KeyWitnessForSpending) txIns
+
+txInWitness :: C.TxIn -> (C.Witness C.WitCtxTxIn era) -> (C.TxIn, C.BuildTxWith C.BuildTx (C.Witness C.WitCtxTxIn era))
+txInWitness txIn wit = (txIn, C.BuildTxWith wit)
+
+txInsReference :: C.CardanoEra era
+  -> [C.TxIn]
+  -> C.TxInsReference build era
+txInsReference era txIns = case era of
+    C.BabbageEra -> C.TxInsReference C.ReferenceTxInsScriptsInlineDatumsInBabbageEra txIns
 
 txMintValue :: C.CardanoEra era
   -> C.Value
@@ -349,7 +399,7 @@ buildTx' :: (MonadIO m, MonadTest m)
   -> m (Either C.TxBodyErrorAutoBalance (C.Tx era))
 buildTx' era txBody changeAddress sKey networkId = do
   (nodeEraUtxo, pparams, eraHistory, systemStart, stakePools) <- H.leftFailM . liftIO $
-    C.queryStateForBalancedTx era networkId (fst <$> C.txIns txBody)
+    C.queryStateForBalancedTx era networkId allInputs
 
   return $ withIsShelleyBasedEra era $ C.constructBalancedTx
     (toEraInCardanoMode era)
@@ -362,6 +412,13 @@ buildTx' era txBody changeAddress sKey networkId = do
     systemStart
     stakePools
     [C.WitnessPaymentKey $ C.castSigningKey sKey]
+  where
+    allInputs :: [C.TxIn]
+    allInputs = do
+      let txIns = (fst <$> C.txIns txBody)
+      case C.txInsReference txBody of
+        C.TxInsReferenceNone        -> txIns
+        C.TxInsReference _ refTxIns -> txIns ++ refTxIns
 
 submitTx :: (MonadIO m, MonadTest m)
   => C.CardanoEra era

plutus-e2e-tests/test/PlutusScripts.hs

@@ -12,6 +12,10 @@ module PlutusScripts (
   , alwaysSucceedAssetIdV2
   , alwaysSucceedMintWitnessV2
 
+  , alwaysSucceedSpendScriptV2
+  , alwaysSucceedSpendScriptHashV2
+  , alwaysSucceedSpendWitnessV2
+
   , verifySchnorrAssetIdV1
   , verifySchnorrAssetIdV2
   , verifySchnorrMintWitnessV1
@@ -22,6 +26,7 @@ module PlutusScripts (
   , verifyEcdsaMintWitnessV1
   , verifyEcdsaMintWitnessV2
 
+  , toScriptData
   , unPlutusScriptV2
   ) where
 
@@ -32,7 +37,9 @@ import Data.ByteString qualified as BS (ByteString)
 import Data.ByteString.Lazy qualified as LBS
 import Data.ByteString.Short qualified as SBS
 import Plutus.Script.Utils.Typed as PSU (IsScriptContext (mkUntypedMintingPolicy))
-import Plutus.V1.Ledger.Api (MintingPolicy, mkMintingPolicyScript, unMintingPolicyScript)
+import Plutus.Script.Utils.V2.Address as PSU.V2
+import Plutus.V1.Ledger.Api (Address, MintingPolicy (MintingPolicy), Validator (Validator), mkMintingPolicyScript,
+                             mkValidatorScript, unMintingPolicyScript, unValidatorScript)
 import Plutus.V1.Ledger.Api qualified as PlutusV1
 import Plutus.V1.Ledger.Bytes qualified as P (bytes, fromHex)
 import Plutus.V2.Ledger.Api qualified as PlutusV2
@@ -66,7 +73,7 @@ plutusL2 = C.PlutusScriptLanguage C.PlutusScriptV2
 --   Provide either the script or TxIn for reference script to include in witness
 mintScriptWitness :: C.CardanoEra era
   -> C.ScriptLanguage lang
-  -> Either (C.PlutusScript lang) (C.TxIn, C.PolicyId) -- either script or reference to script
+  -> Either (C.PlutusScript lang) C.TxIn -- either script or reference to script
   -> C.ScriptData
   -> C.ScriptWitness C.WitCtxMint era
 -- V1 script
@@ -78,9 +85,20 @@ mintScriptWitness era lang@(C.PlutusScriptLanguage C.PlutusScriptV2) (Left scrip
     C.PlutusScriptWitness (maybeScriptWitness era lang $ C.scriptLanguageSupportedInEra era lang)
       C.PlutusScriptV2 (C.PScript script) C.NoScriptDatumForMint redeemer defExecutionUnits
 -- V2 reference script
-mintScriptWitness era lang@(C.PlutusScriptLanguage C.PlutusScriptV2) (Right (refTxIn, pid)) redeemer = do
+mintScriptWitness era lang@(C.PlutusScriptLanguage C.PlutusScriptV2) (Right refTxIn) redeemer = do
     C.PlutusScriptWitness (maybeScriptWitness era lang $ C.scriptLanguageSupportedInEra era lang)
-      C.PlutusScriptV2 (C.PReferenceScript refTxIn (Just $ C.unPolicyId pid)) C.NoScriptDatumForMint redeemer defExecutionUnits
+      C.PlutusScriptV2 (C.PReferenceScript refTxIn Nothing) C.NoScriptDatumForMint redeemer defExecutionUnits
+
+spendScriptWitness :: C.CardanoEra era
+  -> C.ScriptLanguage lang
+  -> Either (C.PlutusScript lang) C.TxIn -- either script or reference to script
+  -> (C.ScriptDatum C.WitCtxTxIn)
+  -> C.ScriptData
+  -> C.ScriptWitness C.WitCtxTxIn era
+-- V2 reference script
+spendScriptWitness era lang@(C.PlutusScriptLanguage C.PlutusScriptV2) (Right refTxIn) datumWit redeemer = do
+    C.PlutusScriptWitness (maybeScriptWitness era lang $ C.scriptLanguageSupportedInEra era lang)
+      C.PlutusScriptV2 (C.PReferenceScript refTxIn Nothing) datumWit redeemer defExecutionUnits -- tried with (Just scriptHash) instead of Nothing because hash isn't needed?
 
 -- | Produce ScriptLanguageInEra. Throw error when era doesn't support the script language.
 maybeScriptWitness :: C.CardanoEra era
@@ -95,6 +113,10 @@ maybeScriptWitness _ _ (Just p) = p
 policyScript :: MintingPolicy -> C.PlutusScript lang
 policyScript = C.PlutusScriptSerialised . SBS.toShort . LBS.toStrict . serialise . unMintingPolicyScript
 
+-- | Serialised plutus script from validator
+validatorScript :: Validator -> C.PlutusScript lang
+validatorScript = C.PlutusScriptSerialised . SBS.toShort . LBS.toStrict . serialise . unValidatorScript
+
 -- | V1 Plutus Script to general Script, Needed for producing reference script.
 unPlutusScriptV1 :: C.PlutusScript C.PlutusScriptV1 -> C.Script C.PlutusScriptV1
 unPlutusScriptV1 = C.PlutusScript C.PlutusScriptV1
@@ -111,9 +133,7 @@ policyIdV1 = C.scriptPolicyId . unPlutusScriptV1 . policyScript
 policyIdV2 :: MintingPolicy -> C.PolicyId
 policyIdV2 = C.scriptPolicyId . unPlutusScriptV2 . policyScript
 
----- AlwaysSucceeds ----
-
--- minting policy --
+-- AlwaysSucceeds minting policy --
 
 alwaysSucceedPolicy :: MintingPolicy
 alwaysSucceedPolicy = mkMintingPolicyScript $$(PlutusTx.compile [|| \_ _ -> () ||])
@@ -134,7 +154,28 @@ alwaysSucceedMintWitnessV2 era Nothing =
      mintScriptWitness era plutusL2 (Left alwaysSucceedPolicyScriptV2) (toScriptData ()))
 alwaysSucceedMintWitnessV2 era (Just refTxIn) =
     (policyIdV2 alwaysSucceedPolicy,
-     mintScriptWitness era plutusL2 (Right (refTxIn, policyIdV2 alwaysSucceedPolicy)) (toScriptData ()))
+     mintScriptWitness era plutusL2 (Right refTxIn) (toScriptData ()))
+
+-- AlwaysSucceeds validator --
+
+alwaysSucceedSpend :: Validator
+alwaysSucceedSpend = mkValidatorScript $$(PlutusTx.compile [|| \_ _ _ -> () ||])
+
+alwaysSucceedSpendScriptV2 :: C.PlutusScript C.PlutusScriptV2
+alwaysSucceedSpendScriptV2 = validatorScript alwaysSucceedSpend
+
+alwaysSucceedSpendScriptHashV2 :: C.ScriptHash
+alwaysSucceedSpendScriptHashV2 = C.hashScript $ C.PlutusScript C.PlutusScriptV2 alwaysSucceedSpendScriptV2
+
+alwaysSucceedSpendWitnessV2 :: C.CardanoEra era -- TODO: also support not using inline datum (ScriptDatumForTxIn)
+  -> Maybe C.TxIn -- maybe reference input
+  -> C.Witness C.WitCtxTxIn era
+alwaysSucceedSpendWitnessV2 era Nothing =
+  C.ScriptWitness C.ScriptWitnessForSpending $
+    spendScriptWitness era plutusL2 (Left alwaysSucceedSpendScriptV2) C.InlineScriptDatum (toScriptData ())
+alwaysSucceedSpendWitnessV2 era (Just refTxIn) =
+  C.ScriptWitness C.ScriptWitnessForSpending $
+    spendScriptWitness era plutusL2 (Right refTxIn) C.InlineScriptDatum (toScriptData ())
 
 ---- SECP256k1 ----
 

plutus-e2e-tests/test/Spec.hs

@@ -8,8 +8,8 @@
 -}
 module Main(main) where
 
+import Spec.BabbageFeatures qualified
 import Spec.Builtins.SECP256k1 qualified
-import Spec.ReferenceScript qualified
 import Test.Tasty (TestTree, defaultMain, testGroup)
 
 main :: IO ()
@@ -18,5 +18,5 @@ main = defaultMain tests
 tests :: TestTree
 tests = testGroup "Plutus E2E" [
     Spec.Builtins.SECP256k1.tests
-  , Spec.ReferenceScript.tests
+  , Spec.BabbageFeatures.tests
     ]