test(api): add comprehensive JSON tests for TxOut instances

cardano-api/cardano-api.cabal

@@ -310,6 +310,7 @@ library gen
     Test.Gen.Cardano.Api.Metadata
     Test.Gen.Cardano.Api.Orphans
     Test.Gen.Cardano.Api.ProtocolParameters
+    Test.Gen.Cardano.Api.TxOut
     Test.Gen.Cardano.Api.Typed
     Test.Gen.Cardano.Crypto.Seed
     Test.Hedgehog.Golden.ErrorMessage
@@ -420,6 +421,11 @@ test-suite cardano-api-test
     Test.Cardano.Api.Transaction.Autobalance
     Test.Cardano.Api.Transaction.Body.Plutus.Scripts
     Test.Cardano.Api.TxBody
+    Test.Cardano.Api.TxOut.Helpers
+    Test.Cardano.Api.TxOut.Json
+    Test.Cardano.Api.TxOut.JsonEdgeCases
+    Test.Cardano.Api.TxOut.JsonErrorCases
+    Test.Cardano.Api.TxOut.JsonRoundtrip
     Test.Cardano.Api.Value
 
   ghc-options:

cardano-api/gen/Test/Gen/Cardano/Api/TxOut.hs

@@ -0,0 +1,185 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | Additional generators for TxOut JSON testing
+module Test.Gen.Cardano.Api.TxOut
+  ( -- * Specific Datum Type Generators
+    genTxOutWithNoDatum
+  , genTxOutWithDatumHash
+  , genTxOutWithSupplementalDatum
+  , genTxOutWithInlineDatum
+
+    -- * Invalid JSON Generators
+  , genConflictingDatumJSON
+  , genMismatchedInlineDatumHashJSON
+  , genPartialInlineDatumJSON
+
+    -- * Era-specific TxOut generators
+  , genTxOutForEra
+  )
+where
+
+import Cardano.Api hiding (Value)
+
+import Data.Aeson (Value (..), object, (.=))
+
+import Test.Gen.Cardano.Api.Typed
+
+import Hedgehog (Gen)
+import Hedgehog.Gen qualified as Gen
+
+-- | Generate a TxOut with no datum and no reference script
+genTxOutWithNoDatum
+  :: ShelleyBasedEra era
+  -> Gen (TxOut CtxTx era)
+genTxOutWithNoDatum era =
+  TxOut
+    <$> genAddressInEra era
+    <*> genTxOutValue era
+    <*> pure TxOutDatumNone
+    <*> pure ReferenceScriptNone
+
+-- | Generate a TxOut with a datum hash (Alonzo+)
+genTxOutWithDatumHash
+  :: forall era
+   . AlonzoEraOnwards era
+  -> Gen (TxOut CtxTx era)
+genTxOutWithDatumHash w =
+  alonzoEraOnwardsConstraints w $
+    TxOut
+      <$> genAddressInEra sbe
+      <*> genTxOutValue sbe
+      <*> (TxOutDatumHash w <$> genHashScriptData)
+      <*> genReferenceScript sbe
+ where
+  sbe :: ShelleyBasedEra era
+  sbe = convert w
+
+-- | Generate a TxOut with a supplemental datum (Alonzo+, CtxTx only)
+genTxOutWithSupplementalDatum
+  :: forall era
+   . AlonzoEraOnwards era
+  -> Gen (TxOut CtxTx era)
+genTxOutWithSupplementalDatum w =
+  alonzoEraOnwardsConstraints w $
+    TxOut
+      <$> genAddressInEra sbe
+      <*> genTxOutValue sbe
+      <*> (TxOutSupplementalDatum w <$> genHashableScriptData)
+      <*> genReferenceScript sbe
+ where
+  sbe :: ShelleyBasedEra era
+  sbe = convert w
+
+-- | Generate a TxOut with an inline datum (Babbage+)
+genTxOutWithInlineDatum
+  :: forall era
+   . BabbageEraOnwards era
+  -> Gen (TxOut CtxTx era)
+genTxOutWithInlineDatum w =
+  babbageEraOnwardsConstraints w $
+    TxOut
+      <$> genAddressInEra sbe
+      <*> genTxOutValue sbe
+      <*> (TxOutDatumInline w <$> genHashableScriptData)
+      <*> genReferenceScript sbe
+ where
+  sbe :: ShelleyBasedEra era
+  sbe = convert w
+
+-- | Generate JSON with conflicting Alonzo and Babbage datum fields
+genConflictingDatumJSON :: Gen Value
+genConflictingDatumJSON = do
+  addr <- genAddressInEra ShelleyBasedEraBabbage
+  val <- genTxOutValue ShelleyBasedEraBabbage
+  datum1 <- genHashableScriptData
+  datum2 <- genHashableScriptData
+  let hash1 = hashScriptDataBytes datum1
+  let hash2 = hashScriptDataBytes datum2
+  pure $
+    object
+      [ "address" .= addr
+      , "value" .= val
+      , "datumhash" .= hash1
+      , "datum" .= scriptDataToJson ScriptDataJsonDetailedSchema datum1
+      , "inlineDatumhash" .= hash2
+      , "inlineDatum" .= scriptDataToJson ScriptDataJsonDetailedSchema datum2
+      ]
+
+-- | Generate JSON with inline datum that doesn't match its hash
+genMismatchedInlineDatumHashJSON :: Gen Value
+genMismatchedInlineDatumHashJSON = do
+  addr <- genAddressInEra ShelleyBasedEraBabbage
+  val <- genTxOutValue ShelleyBasedEraBabbage
+  datum <- genHashableScriptData
+  wrongDatum <- Gen.filter (/= datum) genHashableScriptData
+  let wrongHash = hashScriptDataBytes wrongDatum
+  pure $
+    object
+      [ "address" .= addr
+      , "value" .= val
+      , "inlineDatumhash" .= wrongHash
+      , "inlineDatum" .= scriptDataToJson ScriptDataJsonDetailedSchema datum
+      ]
+
+-- | Generate JSON with only partial inline datum fields
+genPartialInlineDatumJSON :: Gen Value
+genPartialInlineDatumJSON = do
+  addr <- genAddressInEra ShelleyBasedEraBabbage
+  val <- genTxOutValue ShelleyBasedEraBabbage
+  datum <- genHashableScriptData
+  let hash = hashScriptDataBytes datum
+  Gen.choice
+    [ -- Only hash, no datum
+      pure $
+        object
+          [ "address" .= addr
+          , "value" .= val
+          , "inlineDatumhash" .= hash
+          ]
+    , -- Only datum, no hash
+      pure $
+        object
+          [ "address" .= addr
+          , "value" .= val
+          , "inlineDatum" .= scriptDataToJson ScriptDataJsonDetailedSchema datum
+          ]
+    ]
+
+-- | Generate a TxOut for a specific era (using appropriate datum types)
+genTxOutForEra
+  :: ShelleyBasedEra era
+  -> Gen (TxOut CtxTx era)
+genTxOutForEra = \case
+  ShelleyBasedEraShelley -> genTxOutWithNoDatum ShelleyBasedEraShelley
+  ShelleyBasedEraAllegra -> genTxOutWithNoDatum ShelleyBasedEraAllegra
+  ShelleyBasedEraMary -> genTxOutWithNoDatum ShelleyBasedEraMary
+  ShelleyBasedEraAlonzo ->
+    Gen.choice
+      [ genTxOutWithNoDatum ShelleyBasedEraAlonzo
+      , genTxOutWithDatumHash AlonzoEraOnwardsAlonzo
+      , genTxOutWithSupplementalDatum AlonzoEraOnwardsAlonzo
+      ]
+  ShelleyBasedEraBabbage ->
+    Gen.choice
+      [ genTxOutWithNoDatum ShelleyBasedEraBabbage
+      , genTxOutWithDatumHash AlonzoEraOnwardsBabbage
+      , genTxOutWithSupplementalDatum AlonzoEraOnwardsBabbage
+      , genTxOutWithInlineDatum BabbageEraOnwardsBabbage
+      ]
+  ShelleyBasedEraConway ->
+    Gen.choice
+      [ genTxOutWithNoDatum ShelleyBasedEraConway
+      , genTxOutWithDatumHash AlonzoEraOnwardsConway
+      , genTxOutWithSupplementalDatum AlonzoEraOnwardsConway
+      , genTxOutWithInlineDatum BabbageEraOnwardsConway
+      ]
+  ShelleyBasedEraDijkstra ->
+    Gen.choice
+      [ genTxOutWithNoDatum ShelleyBasedEraDijkstra
+      , genTxOutWithDatumHash AlonzoEraOnwardsDijkstra
+      , genTxOutWithSupplementalDatum AlonzoEraOnwardsDijkstra
+      , genTxOutWithInlineDatum BabbageEraOnwardsDijkstra
+      ]

cardano-api/src/Cardano/Api/Era/Internal/Case.hs

@@ -3,6 +3,15 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 
+-- | Era case functions for branching on era types
+--
+-- DEPRECATION NOTICE: The @case*@ functions in this module are deprecated and will be
+-- removed in a future release. They were used for era-based conditional logic but are
+-- being phased out in favor of direct pattern matching or other approaches.
+--
+-- DO NOT add new @case*@ functions to this module. If you need era-based branching,
+-- prefer direct pattern matching on era witnesses or use the conversion functions
+-- provided by the era system.
 module Cardano.Api.Era.Internal.Case
   ( -- Case on CardanoEra
     caseByronOrShelleyBasedEra

cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/Helpers.hs

@@ -0,0 +1,158 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | Test helpers and assertion utilities for TxOut JSON testing
+module Test.Cardano.Api.TxOut.Helpers
+  ( -- * JSON Field Assertions
+    assertHasFields
+  , assertFieldPresent
+  , assertFieldNull
+  , assertAllNull
+  , assertFieldEquals
+
+    -- * Parse Failure Assertions
+  , assertParseFails
+  , assertParseFailsWithMessage
+
+    -- * Datum Assertions
+  , assertDatumEqual
+  , assertDatumHashMatches
+
+    -- * JSON Object Manipulation
+  , getObjectField
+  , hasField
+  , isNullField
+  )
+where
+
+import Cardano.Api hiding (Value)
+
+import Control.Monad (unless)
+import Data.Aeson (Object, Value (..))
+import Data.Aeson qualified as Aeson
+import Data.Aeson.Key qualified as Aeson.Key
+import Data.Aeson.KeyMap qualified as KeyMap
+import Data.Text (Text)
+import Data.Text qualified as Text
+import GHC.Stack (HasCallStack, callStack)
+
+import Hedgehog.Extras qualified as H
+import Hedgehog.Internal.Property (MonadTest)
+
+-- | Assert that a JSON value has all specified fields
+assertHasFields :: (MonadTest m, HasCallStack) => Value -> [Text] -> m ()
+assertHasFields (Object obj) fields = do
+  let missing = filter (not . hasField obj) fields
+  unless (null missing) $
+    H.failMessage callStack $
+      "Missing fields: " <> show missing <> "\nObject: " <> show obj
+assertHasFields val _ =
+  H.failMessage callStack $ "Expected Object but got: " <> show val
+
+-- | Assert that a field is present with a specific value
+assertFieldPresent :: (MonadTest m, HasCallStack) => Value -> Text -> Value -> m ()
+assertFieldPresent (Object obj) field expected = do
+  case getObjectField obj field of
+    Nothing ->
+      H.failMessage callStack $ "Field '" <> Text.unpack field <> "' not found in object"
+    Just actual ->
+      unless (actual == expected) $
+        H.failMessage callStack $
+          "Field '"
+            <> Text.unpack field
+            <> "' has wrong value.\nExpected: "
+            <> show expected
+            <> "\nActual: "
+            <> show actual
+assertFieldPresent val field _ =
+  H.failMessage callStack $
+    "Expected Object but got: " <> show val <> " when checking field " <> Text.unpack field
+
+-- | Assert that a field equals a specific value (same as assertFieldPresent)
+assertFieldEquals :: (MonadTest m, HasCallStack) => Value -> Text -> Value -> m ()
+assertFieldEquals = assertFieldPresent
+
+-- | Assert that a field is present and is null
+assertFieldNull :: (MonadTest m, HasCallStack) => Value -> Text -> m ()
+assertFieldNull (Object obj) field = do
+  case getObjectField obj field of
+    Nothing ->
+      H.failMessage callStack $ "Field '" <> Text.unpack field <> "' not found in object"
+    Just Null -> return ()
+    Just val ->
+      H.failMessage callStack $
+        "Field '" <> Text.unpack field <> "' is not null, got: " <> show val
+assertFieldNull val field =
+  H.failMessage callStack $
+    "Expected Object but got: " <> show val <> " when checking field " <> Text.unpack field
+
+-- | Assert that all specified fields are null
+assertAllNull :: (MonadTest m, HasCallStack) => Value -> [Text] -> m ()
+assertAllNull obj fields = mapM_ (assertFieldNull obj) fields
+
+-- | Assert that parsing a JSON value fails
+assertParseFails :: forall a m. (Aeson.FromJSON a, MonadTest m, HasCallStack) => Value -> m ()
+assertParseFails val =
+  case Aeson.fromJSON val of
+    Aeson.Success (_ :: a) ->
+      H.failMessage callStack $ "Expected parse failure but succeeded for: " <> show val
+    Aeson.Error _ -> return ()
+
+-- | Assert that parsing fails with a message containing the specified text
+assertParseFailsWithMessage
+  :: forall a m. (Aeson.FromJSON a, MonadTest m, HasCallStack) => Value -> Text -> m ()
+assertParseFailsWithMessage val expectedMsg =
+  case Aeson.fromJSON val of
+    Aeson.Success (_ :: a) ->
+      H.failMessage callStack $ "Expected parse failure but succeeded for: " <> show val
+    Aeson.Error msg ->
+      unless (expectedMsg `Text.isInfixOf` Text.pack msg) $
+        H.failMessage callStack $
+          "Error message doesn't contain expected text.\n"
+            <> "Expected substring: "
+            <> Text.unpack expectedMsg
+            <> "\nActual message: "
+            <> msg
+
+-- | Assert that two datums are equal
+assertDatumEqual
+  :: (MonadTest m, HasCallStack)
+  => TxOutDatum ctx era
+  -> TxOutDatum ctx era
+  -> m ()
+assertDatumEqual d1 d2 =
+  unless (d1 == d2) $
+    H.failMessage callStack $
+      "Datums not equal.\nExpected: " <> show d1 <> "\nActual: " <> show d2
+
+-- | Assert that a datum's hash matches the expected hash
+assertDatumHashMatches
+  :: (MonadTest m, HasCallStack)
+  => HashableScriptData
+  -> Hash ScriptData
+  -> m ()
+assertDatumHashMatches datum expectedHash =
+  let actualHash = hashScriptDataBytes datum
+   in unless (actualHash == expectedHash) $
+        H.failMessage callStack $
+          "Datum hash mismatch.\n"
+            <> "Expected: "
+            <> show expectedHash
+            <> "\nActual: "
+            <> show actualHash
+
+-- | Get a field from a JSON object
+getObjectField :: Object -> Text -> Maybe Value
+getObjectField obj field = KeyMap.lookup (Aeson.Key.fromText field) obj
+
+-- | Check if an object has a field
+hasField :: Object -> Text -> Bool
+hasField obj field = KeyMap.member (Aeson.Key.fromText field) obj
+
+-- | Check if a field is null
+isNullField :: Object -> Text -> Bool
+isNullField obj field =
+  case getObjectField obj field of
+    Just Null -> True
+    _ -> False