diff --git a/.changes/plutus-v4-dijkstra-script-language-in-era.yml b/.changes/plutus-v4-dijkstra-script-language-in-era.yml new file mode 100644 index 0000000000..aa5e65983d --- /dev/null +++ b/.changes/plutus-v4-dijkstra-script-language-in-era.yml @@ -0,0 +1,8 @@ +project: cardano-api +pr: 1359 +kind: + - feature + - compatible +description: | + `scriptLanguageSupportedInEra` and `toScriptInEra` now accept Plutus V4 in the Dijkstra era. + Plutus V4 scripts can be used as reference scripts in transaction outputs and as auxiliary scripts. diff --git a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs index 450971284a..0be1ce7eb8 100644 --- a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs +++ b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs @@ -666,6 +666,8 @@ scriptLanguageSupportedInEra era lang = Just PlutusScriptV2InDijkstra (ShelleyBasedEraDijkstra, PlutusScriptLanguage PlutusScriptV3) -> Just PlutusScriptV3InDijkstra + (ShelleyBasedEraDijkstra, PlutusScriptLanguage PlutusScriptV4) -> + Just PlutusScriptV4InDijkstra _ -> Nothing languageOfScriptLanguageInEra diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Body/Plutus/Scripts.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Body/Plutus/Scripts.hs index 074d6fba5e..a7f9dfd571 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Body/Plutus/Scripts.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Body/Plutus/Scripts.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -38,6 +39,8 @@ import Data.Map.Strict qualified as Map import Data.Proxy (Proxy (..)) import Data.Text qualified as Text import Data.Word (Word32) +import GHC.Exts (IsList (..)) +import Lens.Micro ((^.)) import Test.Gen.Cardano.Api.Experimental qualified as Exp import Test.Gen.Cardano.Api.Typed @@ -294,6 +297,39 @@ prop_createTransactionBody_rejects_unsupported_reference_script_language = prope (Api.AnyCardanoEra Api.ConwayEra) ) +-- | The same PlutusV4 reference script in a Dijkstra output is accepted and +-- kept on the ledger output. +prop_createTransactionBody_accepts_supported_reference_script_language :: Property +prop_createTransactionBody_accepts_supported_reference_script_language = property $ do + srcTxIn <- forAll genTxIn + destAddress <- forAll $ genAddressInEra Api.ShelleyBasedEraDijkstra + v4PlutusScript <- forAll $ genPlutusScript Script.PlutusScriptV4 + let v4Script = Script.PlutusScript Script.PlutusScriptV4 v4PlutusScript + refScript = + Script.ReferenceScript Api.BabbageEraOnwardsDijkstra $ + Script.ScriptInAnyLang (Script.PlutusScriptLanguage Script.PlutusScriptV4) v4Script + txBodyContent = + Api.defaultTxBodyContent Api.ShelleyBasedEraDijkstra + & Api.setTxIns [(srcTxIn, Api.BuildTxWith (Api.KeyWitness Api.KeyWitnessForSpending))] + & Api.setTxOuts + [ Api.TxOut + destAddress + (Api.lovelaceToTxOutValue Api.ShelleyBasedEraDijkstra 10_000_000) + Api.TxOutDatumNone + refScript + ] + & Api.setTxFee (Api.TxFeeExplicit Api.ShelleyBasedEraDijkstra 2_000_000) + + Api.ShelleyTxBody _ ledgerBody _ _ _ _ <- + H.leftFail $ Api.createTransactionBody Api.ShelleyBasedEraDijkstra txBodyContent + + case toList (ledgerBody ^. L.outputsTxBodyL) of + [ledgerTxOut] -> + H.assertWith (ledgerTxOut ^. L.referenceScriptTxOutL) $ \case + L.SJust _ -> True + L.SNothing -> False + outs -> annotateShow outs >> failure + -- | 'toPlutusScriptPurposeIndex' classifies ledger redeemer pointers the same -- way as the older 'Api.toScriptIndex', for every purpose category the two -- share, at every era with plutus scripts. 'GuardingScript' (Dijkstra's new @@ -392,6 +428,9 @@ tests = , testProperty "prop_createTransactionBody_rejects_unsupported_reference_script_language" prop_createTransactionBody_rejects_unsupported_reference_script_language + , testProperty + "prop_createTransactionBody_accepts_supported_reference_script_language" + prop_createTransactionBody_accepts_supported_reference_script_language , testProperty "prop_getAnyWitnessRedeemerPointerMap" prop_getAnyWitnessRedeemerPointerMap , testProperty "prop_toAnyWitness" prop_toAnyWitness , testProperty