From f710b2b8abcb7f2ae3877a28b30e6ccfd612a430 Mon Sep 17 00:00:00 2001 From: John Ky Date: Sun, 30 Nov 2025 21:23:15 +1100 Subject: [PATCH 1/2] test(golden): add comprehensive golden tests for TxOut JSON serialization Implements a complete golden test suite for TxOut, TxOutValue, AddressInEra, and ReferenceScript types to ensure JSON format stability after migrating from IsShelleyBasedEra/IsCardanoEra constraints to Exp.IsEra constraints. Test Coverage: - TxOut variations: simple, with datum hash, inline datum, reference script, and full - TxOutValue: lovelace-only and multi-asset configurations - AddressInEra: payment address serialization - ReferenceScript: simple script reference handling - UTxO: complete UTxO map serialization with multiple outputs Golden Test Infrastructure: - Helper functions for constructing test addresses, values, and scripts - Pretty JSON encoding for readable golden files - Comprehensive test data builders with realistic hash values - Support for ConwayEra and future eras (Dijkstra) This test suite ensures backwards compatibility of the JSON format is maintained during the constraint migration, preventing breaking changes in API consumers that depend on JSON serialization. --- cardano-api/cardano-api.cabal | 2 + .../Test/Golden/Cardano/Api/TxOut.hs | 323 ++++++++++++++++++ .../files/TxOut/conway/address.json | 1 + .../files/TxOut/conway/referencescript.json | 10 + .../files/TxOut/conway/txout-datumhash.json | 11 + .../files/TxOut/conway/txout-full.json | 23 ++ .../files/TxOut/conway/txout-inlinedatum.json | 13 + .../TxOut/conway/txout-referencescript.json | 18 + .../files/TxOut/conway/txout-simple.json | 11 + .../TxOut/conway/txoutvalue-lovelace.json | 3 + .../TxOut/conway/txoutvalue-multiasset.json | 6 + .../files/TxOut/conway/utxo.json | 27 ++ 12 files changed, 448 insertions(+) create mode 100644 cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/TxOut.hs create mode 100644 cardano-api/test/cardano-api-golden/files/TxOut/conway/address.json create mode 100644 cardano-api/test/cardano-api-golden/files/TxOut/conway/referencescript.json create mode 100644 cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-datumhash.json create mode 100644 cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-full.json create mode 100644 cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-inlinedatum.json create mode 100644 cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-referencescript.json create mode 100644 cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-simple.json create mode 100644 cardano-api/test/cardano-api-golden/files/TxOut/conway/txoutvalue-lovelace.json create mode 100644 cardano-api/test/cardano-api-golden/files/TxOut/conway/txoutvalue-multiasset.json create mode 100644 cardano-api/test/cardano-api-golden/files/TxOut/conway/utxo.json diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 217a3f6595..4d4ba0a35d 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -437,6 +437,7 @@ test-suite cardano-api-golden buildable: False build-depends: aeson, + aeson-pretty, base64-bytestring, bech32 >=1.1.0, bytestring, @@ -475,5 +476,6 @@ test-suite cardano-api-golden Test.Golden.Cardano.Api.Genesis Test.Golden.Cardano.Api.Ledger Test.Golden.Cardano.Api.Script + Test.Golden.Cardano.Api.TxOut Test.Golden.Cardano.Api.Value Test.Golden.ErrorsSpec diff --git a/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/TxOut.hs b/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/TxOut.hs new file mode 100644 index 0000000000..ff42a1457f --- /dev/null +++ b/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/TxOut.hs @@ -0,0 +1,323 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Golden tests for TxOut, TxOutValue, AddressInEra, and ReferenceScript JSON serialization. +-- +-- These tests ensure backwards compatibility of the JSON format for types whose +-- ToJSON/FromJSON instances were migrated from IsShelleyBasedEra/IsCardanoEra +-- constraints to Exp.IsEra constraints. +module Test.Golden.Cardano.Api.TxOut + ( -- * TxOut golden tests + tasty_golden_TxOut_ConwayEra_simple + , tasty_golden_TxOut_ConwayEra_datumHash + , tasty_golden_TxOut_ConwayEra_inlineDatum + , tasty_golden_TxOut_ConwayEra_referenceScript + , tasty_golden_TxOut_ConwayEra_full + + -- * TxOutValue golden tests + , tasty_golden_TxOutValue_ConwayEra_lovelaceOnly + , tasty_golden_TxOutValue_ConwayEra_multiAsset + + -- * AddressInEra golden tests + , tasty_golden_AddressInEra_ConwayEra + + -- * ReferenceScript golden tests + , tasty_golden_ReferenceScript_ConwayEra + + -- * UTxO golden tests + , tasty_golden_UTxO_ConwayEra + ) +where + +import Cardano.Api +import Cardano.Api.Ledger qualified as L + +import Control.Error.Util (hush) +import Data.Aeson qualified as Aeson +import Data.Aeson.Encode.Pretty (encodePretty) +import Data.ByteString (ByteString) +import Data.ByteString.Lazy.Char8 qualified as BL8 +import Data.Maybe (fromJust) +import GHC.Exts (IsList (..)) +import System.FilePath (()) + +import Hedgehog.Extras (UnitIO) +import Hedgehog.Extras qualified as H + +-- ----------------------------------------------------------------------------- +-- Test data construction helpers +-- ----------------------------------------------------------------------------- + +goldenPath :: FilePath +goldenPath = "test/cardano-api-golden/files/TxOut" + +-- | Helper to encode value as pretty JSON string +toJsonString :: Aeson.ToJSON a => a -> String +toJsonString a = BL8.unpack (encodePretty a) + +-- | Create a simple payment address for testing +mkTestAddress :: ShelleyBasedEra era -> AddressInEra era +mkTestAddress sbe = + shelleyAddressInEra sbe $ + makeShelleyAddress + Mainnet + (PaymentCredentialByKey testPaymentKeyHash) + NoStakeAddress + +testPaymentKeyHash :: Hash PaymentKey +testPaymentKeyHash = + fromJust $ + hush $ + deserialiseFromRawBytesHex "1c14ee8e58fbcbd48dc7367c95a63fd1d937ba989820015db16ac7e5" + +-- | Create a test TxOutValue with only lovelace +mkLovelaceValue :: ShelleyBasedEra era -> L.Coin -> TxOutValue era +mkLovelaceValue = lovelaceToTxOutValue + +-- | Create a test TxOutValue with multi-assets +mkMultiAssetValue :: ShelleyBasedEra era -> TxOutValue era +mkMultiAssetValue sbe = + shelleyBasedEraConstraints sbe $ + TxOutValueShelleyBased sbe $ + toLedgerValue (maryEraOnwardsToMaryEraOnwards sbe) testMultiAssetValue + where + maryEraOnwardsToMaryEraOnwards :: ShelleyBasedEra era -> MaryEraOnwards era + maryEraOnwardsToMaryEraOnwards = \case + ShelleyBasedEraConway -> MaryEraOnwardsConway + ShelleyBasedEraDijkstra -> MaryEraOnwardsDijkstra + _ -> error "mkMultiAssetValue: unsupported era" + +testMultiAssetValue :: Value +testMultiAssetValue = + fromList + [ (AdaAssetId, Quantity 2_000_000) + , (AssetId testPolicyId testAssetName, Quantity 100) + ] + +testPolicyId :: PolicyId +testPolicyId = + fromJust $ + hush $ + deserialiseFromRawBytesHex "a0000000000000000000000000000000000000000000000000000000" + +testAssetName :: AssetName +testAssetName = + fromJust $ + hush $ + deserialiseFromRawBytes AsAssetName "TestToken" + +-- | Create a test datum hash +testDatumHash :: Hash ScriptData +testDatumHash = + fromJust $ + hush $ + deserialiseFromRawBytesHex "ffd29f3e52e7cf2eb451a59448fd55f9c64e4c1ad1ab0e500d6ceb6d7ff97e9c" + +-- | Create test inline datum (ScriptData) +testScriptData :: HashableScriptData +testScriptData = + fromJust $ + hush $ + deserialiseFromCBOR AsHashableScriptData testScriptDataCBOR + where + -- CBOR encoding of ScriptDataNumber 42 + testScriptDataCBOR :: ByteString + testScriptDataCBOR = "\24\42" + +-- | Create a test simple script for reference script testing +testSimpleScript :: Script SimpleScript' +testSimpleScript = + SimpleScript $ + RequireAllOf + [ RequireSignature testPaymentKeyHash + ] + +-- | Create a test reference script +mkTestReferenceScript :: ShelleyBasedEra era -> ReferenceScript era +mkTestReferenceScript = \case + ShelleyBasedEraConway -> + ReferenceScript BabbageEraOnwardsConway (ScriptInAnyLang SimpleScriptLanguage testSimpleScript) + ShelleyBasedEraDijkstra -> + ReferenceScript BabbageEraOnwardsDijkstra (ScriptInAnyLang SimpleScriptLanguage testSimpleScript) + _ -> error "mkTestReferenceScript: unsupported era" + +-- ----------------------------------------------------------------------------- +-- TxOut golden tests - Conway Era +-- ----------------------------------------------------------------------------- + +tasty_golden_TxOut_ConwayEra_simple :: UnitIO () +tasty_golden_TxOut_ConwayEra_simple = + H.diffVsGoldenFile + (toJsonString txOut) + (goldenPath "conway" "txout-simple.json") + where + txOut :: TxOut CtxTx ConwayEra + txOut = + TxOut + (mkTestAddress ShelleyBasedEraConway) + (mkLovelaceValue ShelleyBasedEraConway (L.Coin 1_000_000)) + TxOutDatumNone + ReferenceScriptNone + +tasty_golden_TxOut_ConwayEra_datumHash :: UnitIO () +tasty_golden_TxOut_ConwayEra_datumHash = + H.diffVsGoldenFile + (toJsonString txOut) + (goldenPath "conway" "txout-datumhash.json") + where + txOut :: TxOut CtxTx ConwayEra + txOut = + TxOut + (mkTestAddress ShelleyBasedEraConway) + (mkLovelaceValue ShelleyBasedEraConway (L.Coin 2_000_000)) + (TxOutDatumHash AlonzoEraOnwardsConway testDatumHash) + ReferenceScriptNone + +tasty_golden_TxOut_ConwayEra_inlineDatum :: UnitIO () +tasty_golden_TxOut_ConwayEra_inlineDatum = + H.diffVsGoldenFile + (toJsonString txOut) + (goldenPath "conway" "txout-inlinedatum.json") + where + txOut :: TxOut CtxTx ConwayEra + txOut = + TxOut + (mkTestAddress ShelleyBasedEraConway) + (mkLovelaceValue ShelleyBasedEraConway (L.Coin 3_000_000)) + (TxOutDatumInline BabbageEraOnwardsConway testScriptData) + ReferenceScriptNone + +tasty_golden_TxOut_ConwayEra_referenceScript :: UnitIO () +tasty_golden_TxOut_ConwayEra_referenceScript = + H.diffVsGoldenFile + (toJsonString txOut) + (goldenPath "conway" "txout-referencescript.json") + where + txOut :: TxOut CtxTx ConwayEra + txOut = + TxOut + (mkTestAddress ShelleyBasedEraConway) + (mkLovelaceValue ShelleyBasedEraConway (L.Coin 4_000_000)) + TxOutDatumNone + (mkTestReferenceScript ShelleyBasedEraConway) + +tasty_golden_TxOut_ConwayEra_full :: UnitIO () +tasty_golden_TxOut_ConwayEra_full = + H.diffVsGoldenFile + (toJsonString txOut) + (goldenPath "conway" "txout-full.json") + where + txOut :: TxOut CtxTx ConwayEra + txOut = + TxOut + (mkTestAddress ShelleyBasedEraConway) + (mkMultiAssetValue ShelleyBasedEraConway) + (TxOutDatumInline BabbageEraOnwardsConway testScriptData) + (mkTestReferenceScript ShelleyBasedEraConway) + +-- ----------------------------------------------------------------------------- +-- TxOutValue golden tests +-- ----------------------------------------------------------------------------- + +tasty_golden_TxOutValue_ConwayEra_lovelaceOnly :: UnitIO () +tasty_golden_TxOutValue_ConwayEra_lovelaceOnly = + H.diffVsGoldenFile + (toJsonString txOutValue) + (goldenPath "conway" "txoutvalue-lovelace.json") + where + txOutValue :: TxOutValue ConwayEra + txOutValue = mkLovelaceValue ShelleyBasedEraConway (L.Coin 5_000_000) + +tasty_golden_TxOutValue_ConwayEra_multiAsset :: UnitIO () +tasty_golden_TxOutValue_ConwayEra_multiAsset = + H.diffVsGoldenFile + (toJsonString txOutValue) + (goldenPath "conway" "txoutvalue-multiasset.json") + where + txOutValue :: TxOutValue ConwayEra + txOutValue = mkMultiAssetValue ShelleyBasedEraConway + +-- ----------------------------------------------------------------------------- +-- AddressInEra golden tests +-- ----------------------------------------------------------------------------- + +tasty_golden_AddressInEra_ConwayEra :: UnitIO () +tasty_golden_AddressInEra_ConwayEra = + H.diffVsGoldenFile + (toJsonString addr) + (goldenPath "conway" "address.json") + where + addr :: AddressInEra ConwayEra + addr = mkTestAddress ShelleyBasedEraConway + +-- ----------------------------------------------------------------------------- +-- ReferenceScript golden tests +-- ----------------------------------------------------------------------------- + +tasty_golden_ReferenceScript_ConwayEra :: UnitIO () +tasty_golden_ReferenceScript_ConwayEra = + H.diffVsGoldenFile + (toJsonString refScript) + (goldenPath "conway" "referencescript.json") + where + refScript :: ReferenceScript ConwayEra + refScript = mkTestReferenceScript ShelleyBasedEraConway + +-- ----------------------------------------------------------------------------- +-- UTxO golden tests +-- ----------------------------------------------------------------------------- + +tasty_golden_UTxO_ConwayEra :: UnitIO () +tasty_golden_UTxO_ConwayEra = + H.diffVsGoldenFile + (toJsonString utxo) + (goldenPath "conway" "utxo.json") + where + utxo :: UTxO ConwayEra + utxo = + UTxO $ + fromList + [ (testTxIn, txOut1) + , (testTxIn2, txOut2) + ] + + txOut1 :: TxOut CtxUTxO ConwayEra + txOut1 = + TxOut + (mkTestAddress ShelleyBasedEraConway) + (mkLovelaceValue ShelleyBasedEraConway (L.Coin 1_000_000)) + TxOutDatumNone + ReferenceScriptNone + + txOut2 :: TxOut CtxUTxO ConwayEra + txOut2 = + TxOut + (mkTestAddress ShelleyBasedEraConway) + (mkMultiAssetValue ShelleyBasedEraConway) + (TxOutDatumHash AlonzoEraOnwardsConway testDatumHash) + ReferenceScriptNone + + testTxIn :: TxIn + testTxIn = + TxIn testTxId1 (TxIx 0) + + testTxIn2 :: TxIn + testTxIn2 = + TxIn testTxId2 (TxIx 1) + + testTxId1 :: TxId + testTxId1 = + fromJust $ + hush $ + deserialiseFromRawBytesHex "0000000000000000000000000000000000000000000000000000000000000001" + + testTxId2 :: TxId + testTxId2 = + fromJust $ + hush $ + deserialiseFromRawBytesHex "0000000000000000000000000000000000000000000000000000000000000002" diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/address.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/address.json new file mode 100644 index 0000000000..680c6e2384 --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/address.json @@ -0,0 +1 @@ +"addr1vywpfm5wtrauh4ydcum8e9dx8lgajda6nzvzqq2ak94v0eg88t7u2" \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/referencescript.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/referencescript.json new file mode 100644 index 0000000000..f9aa421a61 --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/referencescript.json @@ -0,0 +1,10 @@ +{ + "referenceScript": { + "script": { + "cborHex": "8201818200581c1c14ee8e58fbcbd48dc7367c95a63fd1d937ba989820015db16ac7e5", + "description": "", + "type": "SimpleScript" + }, + "scriptLanguage": "SimpleScriptLanguage" + } +} \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-datumhash.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-datumhash.json new file mode 100644 index 0000000000..fb5ba205be --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-datumhash.json @@ -0,0 +1,11 @@ +{ + "address": "addr1vywpfm5wtrauh4ydcum8e9dx8lgajda6nzvzqq2ak94v0eg88t7u2", + "datum": null, + "datumhash": "ffd29f3e52e7cf2eb451a59448fd55f9c64e4c1ad1ab0e500d6ceb6d7ff97e9c", + "inlineDatum": null, + "inlineDatumRaw": null, + "referenceScript": null, + "value": { + "lovelace": 2000000 + } +} \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-full.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-full.json new file mode 100644 index 0000000000..f92bc6f68b --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-full.json @@ -0,0 +1,23 @@ +{ + "address": "addr1vywpfm5wtrauh4ydcum8e9dx8lgajda6nzvzqq2ak94v0eg88t7u2", + "datum": null, + "inlineDatum": { + "int": 42 + }, + "inlineDatumRaw": "182a", + "inlineDatumhash": "9e1199a988ba72ffd6e9c269cadb3b53b5f360ff99f112d9b2ee30c4d74ad88b", + "referenceScript": { + "script": { + "cborHex": "8201818200581c1c14ee8e58fbcbd48dc7367c95a63fd1d937ba989820015db16ac7e5", + "description": "", + "type": "SimpleScript" + }, + "scriptLanguage": "SimpleScriptLanguage" + }, + "value": { + "a0000000000000000000000000000000000000000000000000000000": { + "54657374546f6b656e": 100 + }, + "lovelace": 2000000 + } +} \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-inlinedatum.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-inlinedatum.json new file mode 100644 index 0000000000..8ef3dbd168 --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-inlinedatum.json @@ -0,0 +1,13 @@ +{ + "address": "addr1vywpfm5wtrauh4ydcum8e9dx8lgajda6nzvzqq2ak94v0eg88t7u2", + "datum": null, + "inlineDatum": { + "int": 42 + }, + "inlineDatumRaw": "182a", + "inlineDatumhash": "9e1199a988ba72ffd6e9c269cadb3b53b5f360ff99f112d9b2ee30c4d74ad88b", + "referenceScript": null, + "value": { + "lovelace": 3000000 + } +} \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-referencescript.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-referencescript.json new file mode 100644 index 0000000000..ac63ea41f7 --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-referencescript.json @@ -0,0 +1,18 @@ +{ + "address": "addr1vywpfm5wtrauh4ydcum8e9dx8lgajda6nzvzqq2ak94v0eg88t7u2", + "datum": null, + "datumhash": null, + "inlineDatum": null, + "inlineDatumRaw": null, + "referenceScript": { + "script": { + "cborHex": "8201818200581c1c14ee8e58fbcbd48dc7367c95a63fd1d937ba989820015db16ac7e5", + "description": "", + "type": "SimpleScript" + }, + "scriptLanguage": "SimpleScriptLanguage" + }, + "value": { + "lovelace": 4000000 + } +} \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-simple.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-simple.json new file mode 100644 index 0000000000..ab302534e0 --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txout-simple.json @@ -0,0 +1,11 @@ +{ + "address": "addr1vywpfm5wtrauh4ydcum8e9dx8lgajda6nzvzqq2ak94v0eg88t7u2", + "datum": null, + "datumhash": null, + "inlineDatum": null, + "inlineDatumRaw": null, + "referenceScript": null, + "value": { + "lovelace": 1000000 + } +} \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/txoutvalue-lovelace.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txoutvalue-lovelace.json new file mode 100644 index 0000000000..4dbf163d41 --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txoutvalue-lovelace.json @@ -0,0 +1,3 @@ +{ + "lovelace": 5000000 +} \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/txoutvalue-multiasset.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txoutvalue-multiasset.json new file mode 100644 index 0000000000..776699cf92 --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/txoutvalue-multiasset.json @@ -0,0 +1,6 @@ +{ + "a0000000000000000000000000000000000000000000000000000000": { + "54657374546f6b656e": 100 + }, + "lovelace": 2000000 +} \ No newline at end of file diff --git a/cardano-api/test/cardano-api-golden/files/TxOut/conway/utxo.json b/cardano-api/test/cardano-api-golden/files/TxOut/conway/utxo.json new file mode 100644 index 0000000000..c63a574a33 --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/TxOut/conway/utxo.json @@ -0,0 +1,27 @@ +{ + "0000000000000000000000000000000000000000000000000000000000000001#0": { + "address": "addr1vywpfm5wtrauh4ydcum8e9dx8lgajda6nzvzqq2ak94v0eg88t7u2", + "datum": null, + "datumhash": null, + "inlineDatum": null, + "inlineDatumRaw": null, + "referenceScript": null, + "value": { + "lovelace": 1000000 + } + }, + "0000000000000000000000000000000000000000000000000000000000000002#1": { + "address": "addr1vywpfm5wtrauh4ydcum8e9dx8lgajda6nzvzqq2ak94v0eg88t7u2", + "datum": null, + "datumhash": "ffd29f3e52e7cf2eb451a59448fd55f9c64e4c1ad1ab0e500d6ceb6d7ff97e9c", + "inlineDatum": null, + "inlineDatumRaw": null, + "referenceScript": null, + "value": { + "a0000000000000000000000000000000000000000000000000000000": { + "54657374546f6b656e": 100 + }, + "lovelace": 2000000 + } + } +} \ No newline at end of file From c66862997b39cee4af2f628b170ebe8be612d9ce Mon Sep 17 00:00:00 2001 From: John Ky Date: Sun, 30 Nov 2025 21:59:19 +1100 Subject: [PATCH 2/2] refactor(api): migrate JSON instances to use Exp.IsEra constraints Refactors JSON serialization instances for core types to use the experimental Exp.IsEra constraint system instead of IsShelleyBasedEra/IsCardanoEra. This unifies the constraint approach across the codebase and simplifies era-based type class instances. Key Changes: - AddressInEra: Migrate ToJSON/FromJSON instances to Exp.IsEra - ReferenceScript: Update JSON instances using Exp.convert for era witnesses - TxOut (CtxTx/CtxUTxO): Consolidate era-specific parsing into unified handlers - TxOutValue: Simplify FromJSON with direct era conversion Implementation Details: - Use Exp.useEra for obtaining era witnesses at the type level - Convert era witnesses to required eon types (AlonzoEraOnwards, BabbageEraOnwards, etc.) - Consolidate duplicate reconciliation logic into single reconcileDatums function - Remove redundant era-specific pattern matching in favor of generic handlers This refactoring maintains full backwards compatibility with existing JSON formats while reducing code duplication and improving maintainability. The changes prepare the codebase for easier extension to future eras by centralizing era-handling logic. --- cardano-api/src/Cardano/Api/Address.hs | 11 +- .../src/Cardano/Api/Plutus/Internal/Script.hs | 11 +- .../src/Cardano/Api/Tx/Internal/Output.hs | 350 ++++-------------- cardano-api/src/Cardano/Api/UTxO.hs | 5 +- 4 files changed, 96 insertions(+), 281 deletions(-) diff --git a/cardano-api/src/Cardano/Api/Address.hs b/cardano-api/src/Cardano/Api/Address.hs index 86db0828c3..05be0fc8e8 100644 --- a/cardano-api/src/Cardano/Api/Address.hs +++ b/cardano-api/src/Cardano/Api/Address.hs @@ -90,6 +90,7 @@ where import Cardano.Api.Byron.Internal.Key import Cardano.Api.Era +import Cardano.Api.Experimental.Era qualified as Exp import Cardano.Api.HasTypeProxy import Cardano.Api.Key.Internal import Cardano.Api.Monad.Error @@ -370,12 +371,14 @@ data AddressInEra era where instance NFData (AddressInEra era) where rnf (AddressInEra t a) = deepseq (deepseq t a) () -instance IsCardanoEra era => ToJSON (AddressInEra era) where - toJSON = Aeson.String . serialiseAddress +instance Exp.IsEra era => ToJSON (AddressInEra era) where + toJSON = + Exp.obtainCommonConstraints (Exp.useEra @era) $ + Aeson.String . serialiseAddress -instance IsShelleyBasedEra era => FromJSON (AddressInEra era) where +instance Exp.IsEra era => FromJSON (AddressInEra era) where parseJSON = - let sbe = shelleyBasedEra @era + let sbe = convert (Exp.useEra @era) in withText "AddressInEra" $ \txt -> do addressAny <- P.runParserFail parseAddressAny txt pure $ anyAddressInShelleyBasedEra sbe addressAny diff --git a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs index 8c30f37b44..2be0699f4a 100644 --- a/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs +++ b/cardano-api/src/Cardano/Api/Plutus/Internal/Script.hs @@ -125,6 +125,7 @@ import Cardano.Api.Era.Internal.Core import Cardano.Api.Era.Internal.Eon.BabbageEraOnwards import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra import Cardano.Api.Error +import Cardano.Api.Experimental.Era qualified as Exp import Cardano.Api.HasTypeProxy import Cardano.Api.Hash import Cardano.Api.Key.Internal @@ -1647,16 +1648,14 @@ deriving instance Eq (ReferenceScript era) deriving instance Show (ReferenceScript era) -instance IsCardanoEra era => ToJSON (ReferenceScript era) where +instance Exp.IsEra era => ToJSON (ReferenceScript era) where toJSON (ReferenceScript _ s) = object ["referenceScript" .= s] toJSON ReferenceScriptNone = Aeson.Null -instance IsCardanoEra era => FromJSON (ReferenceScript era) where +instance Exp.IsEra era => FromJSON (ReferenceScript era) where parseJSON = Aeson.withObject "ReferenceScript" $ \o -> - caseByronToAlonzoOrBabbageEraOnwards - (const (pure ReferenceScriptNone)) - (\w -> ReferenceScript w <$> o .: "referenceScript") - (cardanoEra :: CardanoEra era) + let w = Exp.convert (Exp.useEra @era) + in ReferenceScript w <$> o .: "referenceScript" refScriptToShelleyScript :: ShelleyBasedEra era diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs index 92184b820e..8730d5f11d 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Output.hs @@ -63,6 +63,7 @@ import Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards import Cardano.Api.Era.Internal.Eon.BabbageEraOnwards import Cardano.Api.Era.Internal.Eon.Convert import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards +import Cardano.Api.Era.Internal.Eon.MaryEraOnwards import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra import Cardano.Api.Error (Error (..), displayError) import Cardano.Api.Experimental.Era qualified as Exp @@ -413,149 +414,58 @@ txOutToJsonValue era (TxOut addr val dat refScript) = ReferenceScript _ s -> toJSON s ReferenceScriptNone -> Aeson.Null -instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where +instance Exp.IsEra era => FromJSON (TxOut CtxTx era) where parseJSON = withObject "TxOut" $ \o -> do - case shelleyBasedEra :: ShelleyBasedEra era of - ShelleyBasedEraShelley -> - TxOut - <$> o .: "address" - <*> o .: "value" - <*> return TxOutDatumNone - <*> return ReferenceScriptNone - ShelleyBasedEraMary -> - TxOut - <$> o .: "address" - <*> o .: "value" - <*> return TxOutDatumNone - <*> return ReferenceScriptNone - ShelleyBasedEraAllegra -> - TxOut - <$> o .: "address" - <*> o .: "value" - <*> return TxOutDatumNone - <*> return ReferenceScriptNone - ShelleyBasedEraAlonzo -> alonzoTxOutParser AlonzoEraOnwardsAlonzo o - ShelleyBasedEraBabbage -> do - alonzoTxOutInBabbage <- alonzoTxOutParser AlonzoEraOnwardsBabbage o - - -- We check for the existence of inline datums - inlineDatumHash <- o .:? "inlineDatumhash" - inlineDatum <- o .:? "inlineDatum" - 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 - (Nothing, Nothing) -> return TxOutDatumNone - (_, _) -> - fail - "Should not be possible to create a tx output with either an inline datum hash or an inline datum" - - mReferenceScript <- o .:? "referenceScript" - - reconcileBabbage alonzoTxOutInBabbage mInlineDatum mReferenceScript - ShelleyBasedEraConway -> do - alonzoTxOutInConway <- alonzoTxOutParser AlonzoEraOnwardsConway o - - -- We check for the existence of inline datums - inlineDatumHash <- o .:? "inlineDatumhash" - 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 - (Nothing, Nothing) -> return TxOutDatumNone - (_, _) -> - fail - "Should not be possible to create a tx output with either an inline datum hash or an inline datum" - - mReferenceScript <- o .:? "referenceScript" - - reconcileConway ConwayEraOnwardsConway alonzoTxOutInConway mInlineDatum mReferenceScript - ShelleyBasedEraDijkstra -> do - alonzoTxOutInConway <- alonzoTxOutParser AlonzoEraOnwardsDijkstra o - - -- We check for the existence of inline datums - inlineDatumHash <- o .:? "inlineDatumhash" - 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 - (Nothing, Nothing) -> return TxOutDatumNone - (_, _) -> - fail - "Should not be possible to create a tx output with either an inline datum hash or an inline datum" - - mReferenceScript <- o .:? "referenceScript" - - reconcileConway ConwayEraOnwardsDijkstra alonzoTxOutInConway mInlineDatum mReferenceScript + let era = Exp.useEra @era + alonzoW = convert era :: AlonzoEraOnwards era + babbageW = convert era :: BabbageEraOnwards era + conwayW = convert era :: ConwayEraOnwards era + + alonzoTxOut <- alonzoTxOutParser alonzoW o + + -- We check for the existence of inline datums + inlineDatumHash <- o .:? "inlineDatumhash" + 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 babbageW sData + (Nothing, Nothing) -> return TxOutDatumNone + (_, _) -> + fail + "Should not be possible to create a tx output with either an inline datum hash or an inline datum" + + mReferenceScript <- o .:? "referenceScript" + + reconcileDatums conwayW alonzoTxOut mInlineDatum mReferenceScript where - reconcileBabbage - :: TxOut CtxTx BabbageEra - -- \^ Alonzo era datum in Babbage era - -> TxOutDatum CtxTx BabbageEra - -- \^ Babbage inline datum - -> Maybe ScriptInAnyLang - -> Aeson.Parser (TxOut CtxTx BabbageEra) - reconcileBabbage top@(TxOut addr v dat r) babbageDatum mBabRefScript = do - -- We check for conflicting datums - finalDat <- case (dat, babbageDatum) of - (TxOutDatumNone, bDatum) -> return bDatum - (anyDat, TxOutDatumNone) -> return anyDat - (alonzoDat, babbageDat) -> - fail $ - "Parsed an Alonzo era datum and a Babbage era datum " - <> "TxOut: " - <> show top - <> "Alonzo datum: " - <> show alonzoDat - <> "Babbage dat: " - <> show babbageDat - finalRefScript <- case mBabRefScript of - Nothing -> return r - Just anyScript -> - return $ ReferenceScript BabbageEraOnwardsBabbage anyScript - return $ TxOut addr v finalDat finalRefScript - - reconcileConway + reconcileDatums :: ConwayEraOnwards era -> TxOut CtxTx era - -- \^ Alonzo era datum in Conway era + -- \^ Alonzo era datum -> TxOutDatum CtxTx era -- \^ Babbage inline datum -> Maybe ScriptInAnyLang -> Aeson.Parser (TxOut CtxTx era) - reconcileConway w top@(TxOut addr v dat r) babbageDatum mBabRefScript = do + reconcileDatums w top@(TxOut addr v dat r) babbageDatum mBabRefScript = do -- We check for conflicting datums finalDat <- case (dat, babbageDatum) of (TxOutDatumNone, bDatum) -> return bDatum (anyDat, TxOutDatumNone) -> return anyDat (alonzoDat, babbageDat) -> fail $ - "Parsed an Alonzo era datum and a Conway era datum " + "Parsed an Alonzo era datum and a Babbage era datum " <> "TxOut: " <> show top <> "Alonzo datum: " <> show alonzoDat - <> "Conway dat: " + <> "Babbage dat: " <> show babbageDat finalRefScript <- case mBabRefScript of Nothing -> return r @@ -596,138 +506,52 @@ instance IsShelleyBasedEra era => FromJSON (TxOut CtxTx era) where -- Note: ReferenceScript is always None for Alonzo-era parsing pure $ TxOut parsedAddress parsedValue txOutDatum ReferenceScriptNone -instance IsShelleyBasedEra era => FromJSON (TxOut CtxUTxO era) where +instance Exp.IsEra era => FromJSON (TxOut CtxUTxO era) where parseJSON = withObject "TxOut" $ \o -> do - case shelleyBasedEra :: ShelleyBasedEra era of - ShelleyBasedEraShelley -> - TxOut - <$> o .: "address" - <*> o .: "value" - <*> return TxOutDatumNone - <*> return ReferenceScriptNone - ShelleyBasedEraMary -> - TxOut - <$> o .: "address" - <*> o .: "value" - <*> return TxOutDatumNone - <*> return ReferenceScriptNone - ShelleyBasedEraAllegra -> - TxOut - <$> o .: "address" - <*> o .: "value" - <*> return TxOutDatumNone - <*> return ReferenceScriptNone - ShelleyBasedEraAlonzo -> alonzoTxOutParser AlonzoEraOnwardsAlonzo o - ShelleyBasedEraBabbage -> do - alonzoTxOutInBabbage <- alonzoTxOutParser AlonzoEraOnwardsBabbage o - - -- We check for the existence of inline datums - inlineDatumHash <- o .:? "inlineDatumhash" - inlineDatum <- o .:? "inlineDatum" - 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 - (Nothing, Nothing) -> return TxOutDatumNone - (_, _) -> - fail - "Should not be possible to create a tx output with either an inline datum hash or an inline datum" - - -- We check for a reference script - mReferenceScript <- o .:? "referenceScript" - - reconcileBabbage alonzoTxOutInBabbage mInlineDatum mReferenceScript - ShelleyBasedEraConway -> do - alonzoTxOutInConway <- alonzoTxOutParser AlonzoEraOnwardsConway o - - -- We check for the existence of inline datums - inlineDatumHash <- o .:? "inlineDatumhash" - 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 - (Nothing, Nothing) -> return TxOutDatumNone - (_, _) -> - fail - "Should not be possible to create a tx output with either an inline datum hash or an inline datum" - - -- We check for a reference script - mReferenceScript <- o .:? "referenceScript" - - reconcileConway ConwayEraOnwardsConway alonzoTxOutInConway mInlineDatum mReferenceScript - ShelleyBasedEraDijkstra -> do - alonzoTxOutInConway <- alonzoTxOutParser AlonzoEraOnwardsDijkstra o - - -- We check for the existence of inline datums - inlineDatumHash <- o .:? "inlineDatumhash" - 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 - (Nothing, Nothing) -> return TxOutDatumNone - (_, _) -> - fail - "Should not be possible to create a tx output with either an inline datum hash or an inline datum" - - -- We check for a reference script - mReferenceScript <- o .:? "referenceScript" - - reconcileConway ConwayEraOnwardsDijkstra alonzoTxOutInConway mInlineDatum mReferenceScript + let era = Exp.useEra @era + alonzoW = convert era :: AlonzoEraOnwards era + babbageW = convert era :: BabbageEraOnwards era + conwayW = convert era :: ConwayEraOnwards era + + alonzoTxOut <- alonzoTxOutParser alonzoW o + + -- We check for the existence of inline datums + inlineDatumHash <- o .:? "inlineDatumhash" + 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 babbageW sData + (Nothing, Nothing) -> return TxOutDatumNone + (_, _) -> + fail + "Should not be possible to create a tx output with either an inline datum hash or an inline datum" + + -- We check for a reference script + mReferenceScript <- o .:? "referenceScript" + + reconcileDatums conwayW alonzoTxOut mInlineDatum mReferenceScript where - reconcileBabbage - :: TxOut CtxUTxO BabbageEra - -- \^ Alonzo era datum in Babbage era - -> TxOutDatum CtxUTxO BabbageEra - -- \^ Babbage inline datum - -> Maybe ScriptInAnyLang - -> Aeson.Parser (TxOut CtxUTxO BabbageEra) - reconcileBabbage (TxOut addr v dat r) babbageDatum mBabRefScript = do - -- We check for conflicting datums - finalDat <- case (dat, babbageDatum) of - (TxOutDatumNone, bDatum) -> return bDatum - (anyDat, TxOutDatumNone) -> return anyDat - (_, _) -> fail "Parsed an Alonzo era datum and a Babbage era datum" - finalRefScript <- case mBabRefScript of - Nothing -> return r - Just anyScript -> - return $ ReferenceScript BabbageEraOnwardsBabbage anyScript - - return $ TxOut addr v finalDat finalRefScript - - reconcileConway + reconcileDatums :: ConwayEraOnwards era -> TxOut CtxUTxO era - -- \^ Alonzo era datum in Conway era + -- \^ Alonzo era datum -> TxOutDatum CtxUTxO era -- \^ Babbage inline datum -> Maybe ScriptInAnyLang -> Aeson.Parser (TxOut CtxUTxO era) - reconcileConway w (TxOut addr v dat r) babbageDatum mBabRefScript = do + reconcileDatums w (TxOut addr v dat r) babbageDatum mBabRefScript = do -- We check for conflicting datums finalDat <- case (dat, babbageDatum) of (TxOutDatumNone, bDatum) -> return bDatum (anyDat, TxOutDatumNone) -> return anyDat - (_, _) -> fail "Parsed an Alonzo era datum and a Conway era datum" + (_, _) -> fail "Parsed an Alonzo era datum and a Babbage era datum" finalRefScript <- case mBabRefScript of Nothing -> return r Just anyScript -> @@ -940,35 +764,25 @@ deriving instance Eq (TxOutValue era) deriving instance Show (TxOutValue era) -instance IsCardanoEra era => ToJSON (TxOutValue era) where +instance Exp.IsEra era => ToJSON (TxOutValue era) where toJSON = \case TxOutValueByron ll -> toJSON ll TxOutValueShelleyBased sbe val -> shelleyBasedEraConstraints sbe $ toJSON (fromLedgerValue sbe val) -instance IsShelleyBasedEra era => FromJSON (TxOutValue era) where - parseJSON = withObject "TxOutValue" $ \o -> - caseShelleyToAllegraOrMaryEraOnwards - ( \shelleyToAlleg -> do - ll <- o .: "lovelace" - let sbe = convert shelleyToAlleg - pure $ - shelleyBasedEraConstraints sbe $ - TxOutValueShelleyBased sbe $ - A.mkAdaValue sbe ll - ) - ( \w -> do - let l = toList o - sbe = convert w - vals <- mapM decodeAssetId l - pure $ - shelleyBasedEraConstraints sbe $ - TxOutValueShelleyBased sbe $ - toLedgerValue w $ - mconcat vals - ) - (shelleyBasedEra @era) +instance Exp.IsEra era => FromJSON (TxOutValue era) where + parseJSON = withObject "TxOutValue" $ \o -> do + let era = Exp.useEra @era + maryW = convert era :: MaryEraOnwards era + sbe = convert era :: ShelleyBasedEra era + l = toList o + vals <- mapM decodeAssetId l + pure $ + shelleyBasedEraConstraints sbe $ + TxOutValueShelleyBased sbe $ + toLedgerValue maryW $ + mconcat vals where decodeAssetId :: (Aeson.Key, Aeson.Value) -> Aeson.Parser Value decodeAssetId (polid, Aeson.Object assetNameHm) = do diff --git a/cardano-api/src/Cardano/Api/UTxO.hs b/cardano-api/src/Cardano/Api/UTxO.hs index 481c66a3c1..46e136a06e 100644 --- a/cardano-api/src/Cardano/Api/UTxO.hs +++ b/cardano-api/src/Cardano/Api/UTxO.hs @@ -82,8 +82,7 @@ module Cardano.Api.UTxO where import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra - ( IsShelleyBasedEra - , ShelleyBasedEra + ( ShelleyBasedEra , ShelleyLedgerEra ) import Cardano.Api.Experimental.Era qualified as Exp @@ -137,7 +136,7 @@ instance Exp.IsEra era => ToJSON (UTxO era) where toJSON (UTxO m) = toJSON m toEncoding (UTxO m) = toEncoding m -instance IsShelleyBasedEra era => FromJSON (UTxO era) where +instance Exp.IsEra era => FromJSON (UTxO era) where parseJSON = Aeson.withObject "UTxO" $ \hm -> do let l = GHC.toList $ KeyMap.toHashMapText hm res <- mapM toTxIn l