From 8c043b9b43ae020073e6f7e4bc5d04b2d831cacd Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Thu, 25 Jun 2026 14:29:04 +0200 Subject: [PATCH 1/4] JSON round-trip fails for TxOut with non-canonical inline datum MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit FromJSON (TxOut CtxUTxO era) ignores inlineDatumRaw and reconstructs HashableScriptData via scriptDataFromJson, which re-serialises to canonical CBOR bytes. For datums whose original CBOR uses definite-length arrays (non-canonical), H(canonical) ≠ H(original), causing "Inline datum not equivalent to inline datum hash" on parse. Adds genNonCanonicalHashableScriptData and a failing property test that will pass once FromJSON reads inlineDatumRaw to preserve original bytes. Signed-off-by: Sasha Bogicevic --- cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 23 ++++++++++++++++++- .../cardano-api-test/Test/Cardano/Api/Json.hs | 13 +++++++++++ 2 files changed, 35 insertions(+), 1 deletion(-) diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 841d484318..817ff566f2 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -44,6 +44,7 @@ module Test.Gen.Cardano.Api.Typed -- * Scripts , genHashableScriptData + , genNonCanonicalHashableScriptData , genReferenceScript , genScript , genValidScript @@ -188,7 +189,7 @@ import Data.Int (Int64) import Data.Maybe import Data.Ratio (Ratio, (%)) import Data.String -import Data.Word (Word32, Word64) +import Data.Word (Word32, Word64, Word8) import GHC.Exts (IsList (..)) import GHC.Stack import Numeric.Natural (Natural) @@ -391,6 +392,26 @@ genHashableScriptData = do Left e -> error $ "genHashableScriptData: " <> show e Right r -> return r +-- | Generate 'HashableScriptData' whose CBOR uses a definite-length array +-- instead of the canonical indefinite-length form that Plutus normally emits. +-- This means 'hashScriptDataBytes' of the result differs from +-- 'hashScriptDataBytes' of its canonical re-encoding, exposing any JSON +-- round-trip that reconstructs CBOR rather than preserving original bytes. +genNonCanonicalHashableScriptData :: HasCallStack => Gen HashableScriptData +genNonCanonicalHashableScriptData = do + constrIdx <- Gen.integral (Range.linear 0 6 :: Range.Range Int) + args <- Gen.list (Range.linear 1 5) (Gen.integral (Range.linear 0 23 :: Range.Range Int)) + -- Plutus constructor n uses CBOR tag 121+n. + -- Canonical encoding wraps fields in an indefinite-length array (0x9f..0xff). + -- We use a definite-length array (0x80+len) to produce non-canonical bytes. + let tagBytes = [0xd8, fromIntegral (0x79 + constrIdx)] :: [Word8] + arrayHdr = [fromIntegral (0x80 + length args)] :: [Word8] + argBytes = map fromIntegral args :: [Word8] + bytes = BS.pack (tagBytes <> arrayHdr <> argBytes) + case deserialiseFromCBOR AsHashableScriptData bytes of + Left e -> error $ "genNonCanonicalHashableScriptData: " <> show e + Right r -> pure r + {-# DEPRECATED genScriptData "Use genHashableScriptData" #-} genScriptData :: Gen ScriptData genScriptData = diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Json.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Json.hs index 6593fd9d9f..b469e5efaa 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Json.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Json.hs @@ -54,6 +54,18 @@ prop_json_roundtrip_txout_utxo_context = H.property $ do txOut <- forAll $ genTxOutUTxOContext ShelleyBasedEraBabbage tripping txOut encode eitherDecode +-- | Round-trips a 'TxOut' whose inline datum uses non-canonical CBOR bytes +-- (definite-length array instead of the canonical indefinite-length form). +prop_json_roundtrip_txout_noncanonical_inline_datum :: Property +prop_json_roundtrip_txout_noncanonical_inline_datum = H.property $ do + hsd <- forAll genNonCanonicalHashableScriptData + addr <- forAll $ genAddressInEra ShelleyBasedEraConway + val <- forAll $ genTxOutValue ShelleyBasedEraConway + let txOut = + TxOut addr val (TxOutDatumInline BabbageEraOnwardsConway hsd) ReferenceScriptNone + :: TxOut CtxUTxO ConwayEra + tripping txOut encode eitherDecode + prop_json_roundtrip_scriptdata_detailed_json :: Property prop_json_roundtrip_scriptdata_detailed_json = H.property $ do sData <- forAll genHashableScriptData @@ -103,6 +115,7 @@ tests = , testProperty "json roundtrip txoutvalue" prop_json_roundtrip_txoutvalue , testProperty "json roundtrip txout tx context" prop_json_roundtrip_txout_tx_context , testProperty "json roundtrip txout utxo context" prop_json_roundtrip_txout_utxo_context + , testProperty "json roundtrip txout noncanonical inline datum" prop_json_roundtrip_txout_noncanonical_inline_datum , testProperty "json roundtrip scriptdata detailed json" prop_json_roundtrip_scriptdata_detailed_json , testProperty "json roundtrip praos nonce" prop_roundtrip_praos_nonce_JSON , testProperty "new TxOut ToJSON matches legacy" prop_new_txout_json_matches_legacy From 3eadafe3b8131d35fe05ad72a8f721d20275424d Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Thu, 25 Jun 2026 16:38:33 +0200 Subject: [PATCH 2/4] Fix: preserve original CBOR bytes when parsing TxOut with inline datum MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit FromJSON (TxOut) for Babbage, Conway and Dijkstra ignored inlineDatumRaw and reconstructed HashableScriptData via scriptDataFromJson, which always re-serialises to canonical CBOR. For datums whose original on-chain CBOR uses definite-length arrays (non-canonical Plutus encoding), this caused H(canonical) ≠ H(original), triggering "Inline datum not equivalent to inline datum hash" when parsing JSON produced by the ToJSON instance. ToJSON always writes inlineDatumRaw containing the original CBOR bytes. FromJSON now reads that field first and uses deserialiseFromCBOR to reconstruct HashableScriptData with the original bytes intact, falling back to scriptDataFromJson only for JSON produced without inlineDatumRaw. Fix applied to both CtxTx and CtxUTxO instances for all three eras. The repeated logic is extracted into a parseInlineDatum helper. Signed-off-by: Sasha Bogicevic --- .../src/Cardano/Api/Tx/Internal/Output.hs | 106 ++++++++++-------- 1 file changed, 60 insertions(+), 46 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs index b22fec6205..ccc4e98e7b 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs @@ -431,6 +431,26 @@ txOutToJsonValue era (TxOut addr val dat refScript) = ReferenceScript _ s -> toJSON s ReferenceScriptNone -> Aeson.Null +-- | Parse 'HashableScriptData' from a JSON object, preferring the raw CBOR +-- bytes in @inlineDatumRaw@ when present to preserve non-canonical encodings, +-- falling back to the supplied parser for JSON that lacks the field. +parseInlineDatum + :: Aeson.Object + -> Aeson.Value + -> Hash ScriptData + -> (Aeson.Value -> Aeson.Parser HashableScriptData) + -> Aeson.Parser HashableScriptData +parseInlineDatum o dVal h fallback = do + mRaw <- o .:? "inlineDatumRaw" + hashableData <- case mRaw of + Just rawHex -> do + rawBytes <- either fail pure $ Base16.decode (Text.encodeUtf8 rawHex) + either (fail . show) pure $ deserialiseFromCBOR AsHashableScriptData rawBytes + Nothing -> fallback dVal + if hashScriptDataBytes hashableData /= h + then fail "Inline datum not equivalent to inline datum hash" + else pure hashableData + instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where parseJSON = withObject "TxOut" $ \o -> do case shelleyBasedEra :: ShelleyBasedEra era of @@ -462,13 +482,12 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where mInlineDatum <- case (inlineDatum, inlineDatumHash) of (Just dVal, Just h) -> do - case scriptDataJsonToHashable ScriptDataJsonDetailedSchema dVal of - Left err -> - fail $ "Error parsing TxOut JSON: " <> displayError err - Right hashableData -> do - if hashScriptDataBytes hashableData /= h - then fail "Inline datum not equivalent to inline datum hash" - else return $ TxOutDatumInline BabbageEraOnwardsBabbage hashableData + hashableData <- + parseInlineDatum o dVal h $ \v -> + case scriptDataJsonToHashable ScriptDataJsonDetailedSchema v of + Left err -> fail $ "Error parsing TxOut JSON: " <> displayError err + Right hsd -> pure hsd + return $ TxOutDatumInline BabbageEraOnwardsBabbage hashableData (Nothing, Nothing) -> return TxOutDatumNone (_, _) -> fail @@ -485,14 +504,13 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where inlineDatum <- o .:? "inlineDatum" mInlineDatum <- case (inlineDatum, inlineDatumHash) of - (Just dVal, Just h) -> - case scriptDataFromJson ScriptDataJsonDetailedSchema dVal of - Left err -> - fail $ "Error parsing TxOut JSON: " <> displayError err - Right sData -> - if hashScriptDataBytes sData /= h - then fail "Inline datum not equivalent to inline datum hash" - else return $ TxOutDatumInline BabbageEraOnwardsConway sData + (Just dVal, Just h) -> do + hashableData <- + parseInlineDatum o dVal h $ \v -> + case scriptDataFromJson ScriptDataJsonDetailedSchema v of + Left err -> fail $ "Error parsing TxOut JSON: " <> displayError err + Right sData -> pure sData + return $ TxOutDatumInline BabbageEraOnwardsConway hashableData (Nothing, Nothing) -> return TxOutDatumNone (_, _) -> fail @@ -509,14 +527,13 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where inlineDatum <- o .:? "inlineDatum" mInlineDatum <- case (inlineDatum, inlineDatumHash) of - (Just dVal, Just h) -> - case scriptDataFromJson ScriptDataJsonDetailedSchema dVal of - Left err -> - fail $ "Error parsing TxOut JSON: " <> displayError err - Right sData -> - if hashScriptDataBytes sData /= h - then fail "Inline datum not equivalent to inline datum hash" - else return $ TxOutDatumInline BabbageEraOnwardsDijkstra sData + (Just dVal, Just h) -> do + hashableData <- + parseInlineDatum o dVal h $ \v -> + case scriptDataFromJson ScriptDataJsonDetailedSchema v of + Left err -> fail $ "Error parsing TxOut JSON: " <> displayError err + Right sData -> pure sData + return $ TxOutDatumInline BabbageEraOnwardsDijkstra hashableData (Nothing, Nothing) -> return TxOutDatumNone (_, _) -> fail @@ -645,13 +662,12 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where mInlineDatum <- case (inlineDatum, inlineDatumHash) of (Just dVal, Just h) -> do - case scriptDataJsonToHashable ScriptDataJsonDetailedSchema dVal of - Left err -> - fail $ "Error parsing TxOut JSON: " <> displayError err - Right hashableData -> do - if hashScriptDataBytes hashableData /= h - then fail "Inline datum not equivalent to inline datum hash" - else return $ TxOutDatumInline BabbageEraOnwardsBabbage hashableData + hashableData <- + parseInlineDatum o dVal h $ \v -> + case scriptDataJsonToHashable ScriptDataJsonDetailedSchema v of + Left err -> fail $ "Error parsing TxOut JSON: " <> displayError err + Right hsd -> pure hsd + return $ TxOutDatumInline BabbageEraOnwardsBabbage hashableData (Nothing, Nothing) -> return TxOutDatumNone (_, _) -> fail @@ -669,14 +685,13 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where inlineDatum <- o .:? "inlineDatum" mInlineDatum <- case (inlineDatum, inlineDatumHash) of - (Just dVal, Just h) -> - case scriptDataFromJson ScriptDataJsonDetailedSchema dVal of - Left err -> - fail $ "Error parsing TxOut JSON: " <> displayError err - Right sData -> - if hashScriptDataBytes sData /= h - then fail "Inline datum not equivalent to inline datum hash" - else return $ TxOutDatumInline BabbageEraOnwardsConway sData + (Just dVal, Just h) -> do + hashableData <- + parseInlineDatum o dVal h $ \v -> + case scriptDataFromJson ScriptDataJsonDetailedSchema v of + Left err -> fail $ "Error parsing TxOut JSON: " <> displayError err + Right sData -> pure sData + return $ TxOutDatumInline BabbageEraOnwardsConway hashableData (Nothing, Nothing) -> return TxOutDatumNone (_, _) -> fail @@ -694,14 +709,13 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where inlineDatum <- o .:? "inlineDatum" mInlineDatum <- case (inlineDatum, inlineDatumHash) of - (Just dVal, Just h) -> - case scriptDataFromJson ScriptDataJsonDetailedSchema dVal of - Left err -> - fail $ "Error parsing TxOut JSON: " <> displayError err - Right sData -> - if hashScriptDataBytes sData /= h - then fail "Inline datum not equivalent to inline datum hash" - else return $ TxOutDatumInline BabbageEraOnwardsDijkstra sData + (Just dVal, Just h) -> do + hashableData <- + parseInlineDatum o dVal h $ \v -> + case scriptDataFromJson ScriptDataJsonDetailedSchema v of + Left err -> fail $ "Error parsing TxOut JSON: " <> displayError err + Right sData -> pure sData + return $ TxOutDatumInline BabbageEraOnwardsDijkstra hashableData (Nothing, Nothing) -> return TxOutDatumNone (_, _) -> fail From dcc84d0ecab435534e4f606278d33b589a45ce7a Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Thu, 25 Jun 2026 16:57:32 +0200 Subject: [PATCH 3/4] Changelog entry Signed-off-by: Sasha Bogicevic --- ...60625_fix_non_canonical_inline_datum_json_roundtrip.yml | 7 +++++++ 1 file changed, 7 insertions(+) create mode 100644 .changes/20260625_fix_non_canonical_inline_datum_json_roundtrip.yml diff --git a/.changes/20260625_fix_non_canonical_inline_datum_json_roundtrip.yml b/.changes/20260625_fix_non_canonical_inline_datum_json_roundtrip.yml new file mode 100644 index 0000000000..9e87a60876 --- /dev/null +++ b/.changes/20260625_fix_non_canonical_inline_datum_json_roundtrip.yml @@ -0,0 +1,7 @@ +project: cardano-api +pr: 1238 +kind: + - bugfix +description: | + FromJSON (TxOut) crashes when parsing a TxOut whose inline datum was encoded with non-canonical CBOR bytes (e.g. definite-length arrays instead of the indefinite-length form Plutus normally emits). + From c57ae488ced757ae819f7f8be4232e40e0ca30ec Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Thu, 25 Jun 2026 17:31:46 +0200 Subject: [PATCH 4/4] Potential fix for pull request finding Co-authored-by: Copilot Autofix powered by AI <175728472+Copilot@users.noreply.github.com> --- .../test/cardano-api-test/Test/Cardano/Api/Json.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Json.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Json.hs index b469e5efaa..1705065e7c 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Json.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Json.hs @@ -61,10 +61,14 @@ prop_json_roundtrip_txout_noncanonical_inline_datum = H.property $ do hsd <- forAll genNonCanonicalHashableScriptData addr <- forAll $ genAddressInEra ShelleyBasedEraConway val <- forAll $ genTxOutValue ShelleyBasedEraConway - let txOut = + let txOutUTxO = TxOut addr val (TxOutDatumInline BabbageEraOnwardsConway hsd) ReferenceScriptNone :: TxOut CtxUTxO ConwayEra - tripping txOut encode eitherDecode + txOutTx = + TxOut addr val (TxOutDatumInline BabbageEraOnwardsConway hsd) ReferenceScriptNone + :: TxOut CtxTx ConwayEra + tripping txOutUTxO encode eitherDecode + tripping txOutTx encode eitherDecode prop_json_roundtrip_scriptdata_detailed_json :: Property prop_json_roundtrip_scriptdata_detailed_json = H.property $ do