From 771184bfb6991b134e7bd4bfb3e7d896f2b8f2f7 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 19 Jun 2026 16:15:55 +0200 Subject: [PATCH] Fix PlutusV4 script handling and scrambled ToPlutusScriptPurpose type family --- .../20260619_fix_plutusv4_script_handling.yml | 6 ++++ .../Plutus/Internal/Shim/LegacyScripts.hs | 13 ++++---- .../Experimental/Tx/Internal/AnyWitness.hs | 2 +- .../src/Cardano/Api/Plutus/Internal/Script.hs | 33 +++++++++---------- 4 files changed, 30 insertions(+), 24 deletions(-) create mode 100644 .changes/20260619_fix_plutusv4_script_handling.yml diff --git a/.changes/20260619_fix_plutusv4_script_handling.yml b/.changes/20260619_fix_plutusv4_script_handling.yml new file mode 100644 index 0000000000..22a16c8aeb --- /dev/null +++ b/.changes/20260619_fix_plutusv4_script_handling.yml @@ -0,0 +1,6 @@ +project: cardano-api +pr: 1237 +kind: + - bugfix +description: | + Fix PlutusV4 scripts being mislabelled as V3 in several conversion functions, causing silent hash mismatches for V4 reference scripts. Fix `toShelleyScript` and `getPlutusDatum` crashing for V4. Fix scrambled `ToPlutusScriptPurpose` type family. diff --git a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Shim/LegacyScripts.hs b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Shim/LegacyScripts.hs index f81dfd1029..11e4bfbd75 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Shim/LegacyScripts.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Shim/LegacyScripts.hs @@ -75,11 +75,11 @@ toAnyWitness eon (witnessable, BuildTxWith (Old.ScriptWitness _ oldApiPlutusScri type family ToPlutusScriptPurpose witnessable = (purpose :: PlutusScriptPurpose) | purpose -> witnessable where ToPlutusScriptPurpose TxInItem = SpendingScript - ToPlutusScriptPurpose CertItem = MintingScript - ToPlutusScriptPurpose MintItem = CertifyingScript + ToPlutusScriptPurpose CertItem = CertifyingScript + ToPlutusScriptPurpose MintItem = MintingScript ToPlutusScriptPurpose WithdrawalItem = WithdrawingScript - ToPlutusScriptPurpose VoterItem = ProposingScript - ToPlutusScriptPurpose ProposalItem = VotingScript + ToPlutusScriptPurpose VoterItem = VotingScript + ToPlutusScriptPurpose ProposalItem = ProposingScript convertToNewScriptWitness :: AlonzoEraOnwards era @@ -133,10 +133,11 @@ createPlutusScriptDatum missingContext plutusVersion oldDatum = (WitTxCert{}, _) -> NoScriptDatum toPlutusScriptDatum - :: Witnessable TxInItem era + :: thing ~ TxInItem + => Witnessable thing era -> Old.PlutusScriptVersion lang -> Old.ScriptDatum Old.WitCtxTxIn - -> PlutusScriptDatum (Old.ToLedgerPlutusLanguage lang) (ToPlutusScriptPurpose TxInItem) + -> PlutusScriptDatum (Old.ToLedgerPlutusLanguage lang) (ToPlutusScriptPurpose thing) -- ^ Encapsulates CIP-69: V3 spending script datums are optional toPlutusScriptDatum WitTxIn{} Old.PlutusScriptV4 (Old.ScriptDatumForTxIn r) = SpendingScriptDatum r toPlutusScriptDatum WitTxIn{} Old.PlutusScriptV3 (Old.ScriptDatumForTxIn r) = SpendingScriptDatum r diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs index 264f2dcbc7..7af8ebe606 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs @@ -125,7 +125,7 @@ getPlutusDatum getPlutusDatum L.SPlutusV1 (SpendingScriptDatum d) = Just d getPlutusDatum L.SPlutusV2 (SpendingScriptDatum d) = Just d getPlutusDatum L.SPlutusV3 (SpendingScriptDatum d) = d -getPlutusDatum L.SPlutusV4 (SpendingScriptDatum _d) = error "TODO Dijkstra: getPlutusDatum: era not supported" +getPlutusDatum L.SPlutusV4 (SpendingScriptDatum d) = d getPlutusDatum _ InlineDatum = Nothing getPlutusDatum _ NoScriptDatum = Nothing diff --git a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs index dff230b9c7..9d0ce24b27 100644 --- a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs +++ b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs @@ -290,6 +290,7 @@ instance Enum AnyScriptLanguage where toEnum 1 = AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV1) toEnum 2 = AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV2) toEnum 3 = AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV3) + toEnum 4 = AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV4) toEnum err = error $ "AnyScriptLanguage.toEnum: bad argument: " <> show err fromEnum (AnyScriptLanguage SimpleScriptLanguage) = 0 @@ -300,7 +301,7 @@ instance Enum AnyScriptLanguage where instance Bounded AnyScriptLanguage where minBound = AnyScriptLanguage SimpleScriptLanguage - maxBound = AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV3) + maxBound = AnyScriptLanguage (PlutusScriptLanguage PlutusScriptV4) data AnyPlutusScriptVersion where AnyPlutusScriptVersion @@ -320,6 +321,7 @@ instance Enum AnyPlutusScriptVersion where toEnum 0 = AnyPlutusScriptVersion PlutusScriptV1 toEnum 1 = AnyPlutusScriptVersion PlutusScriptV2 toEnum 2 = AnyPlutusScriptVersion PlutusScriptV3 + toEnum 3 = AnyPlutusScriptVersion PlutusScriptV4 toEnum err = error $ "AnyPlutusScriptVersion.toEnum: bad argument: " <> show err fromEnum (AnyPlutusScriptVersion PlutusScriptV1) = 0 @@ -329,7 +331,7 @@ instance Enum AnyPlutusScriptVersion where instance Bounded AnyPlutusScriptVersion where minBound = AnyPlutusScriptVersion PlutusScriptV1 - maxBound = AnyPlutusScriptVersion PlutusScriptV3 + maxBound = AnyPlutusScriptVersion PlutusScriptV4 instance ToCBOR AnyPlutusScriptVersion where toCBOR = toCBOR . fromEnum @@ -358,7 +360,8 @@ parsePlutusScriptVersion t = "PlutusScriptV1" -> return (AnyPlutusScriptVersion PlutusScriptV1) "PlutusScriptV2" -> return (AnyPlutusScriptVersion PlutusScriptV2) "PlutusScriptV3" -> return (AnyPlutusScriptVersion PlutusScriptV3) - _ -> fail "Expected PlutusScriptVX, for X = 1, 2, or 3" + "PlutusScriptV4" -> return (AnyPlutusScriptVersion PlutusScriptV4) + _ -> fail "Expected PlutusScriptVX, for X = 1, 2, 3, or 4" instance FromJSON AnyPlutusScriptVersion where parseJSON = Aeson.withText "PlutusScriptVersion" parsePlutusScriptVersion @@ -385,7 +388,7 @@ fromAlonzoLanguage :: Plutus.Language -> AnyPlutusScriptVersion fromAlonzoLanguage Plutus.PlutusV1 = AnyPlutusScriptVersion PlutusScriptV1 fromAlonzoLanguage Plutus.PlutusV2 = AnyPlutusScriptVersion PlutusScriptV2 fromAlonzoLanguage Plutus.PlutusV3 = AnyPlutusScriptVersion PlutusScriptV3 -fromAlonzoLanguage Plutus.PlutusV4 = AnyPlutusScriptVersion PlutusScriptV3 +fromAlonzoLanguage Plutus.PlutusV4 = AnyPlutusScriptVersion PlutusScriptV4 class HasTypeProxy lang => IsScriptLanguage lang where scriptLanguage :: ScriptLanguage lang @@ -1294,20 +1297,16 @@ toShelleyScript Plutus.PlutusBinary script toShelleyScript ( ScriptInEra - _langInEra + langInEra ( PlutusScript PlutusScriptV4 - (PlutusScriptSerialised _script) + (PlutusScriptSerialised script) ) - ) = error "toShelleyScript: PlutusV4 not implemented yet." - --- TODO: Ledger needs to introduce a plutusV4 constructor --- case langInEra of --- PlutusScriptV4InConway -> --- Alonzo.PlutusScript . Conway.ConwayPlutusV3 . Plutus.Plutus $ Plutus.PlutusBinary script --- PlutusScriptV4InDijkstra -> --- Alonzo.PlutusScript . Dijkstra.MkDijkstraPlutusScript . Conway.ConwayPlutusV3 . Plutus.Plutus $ --- Plutus.PlutusBinary script + ) = + case langInEra of + PlutusScriptV4InDijkstra -> + Alonzo.PlutusScript . Dijkstra.DijkstraPlutusV4 . Plutus.Plutus $ + Plutus.PlutusBinary script fromShelleyBasedScript :: ShelleyBasedEra era @@ -1391,8 +1390,8 @@ fromShelleyBasedScript sbe script = $ PlutusScriptSerialised s Dijkstra.DijkstraPlutusV4 (PlutusScriptBinary s) -> ScriptInEra - PlutusScriptV3InDijkstra - . PlutusScript PlutusScriptV3 + PlutusScriptV4InDijkstra + . PlutusScript PlutusScriptV4 $ PlutusScriptSerialised s Alonzo.NativeScript s -> ScriptInEra SimpleScriptInDijkstra