Skip to content

Commit 55e5a9d

Browse files
newhoggyclaude
newhoggy
and
claude
committed
test(api): add comprehensive JSON tests for TxOut instances (IsEra)
Implements extensive test coverage for the ToJSON and FromJSON instances of TxOut, adapted for the new Exp.IsEra constraint on ToJSON. Test modules added: - Test.Gen.Cardano.Api.TxOut: Specialized generators for TxOut with specific datum types (no datum, datum hash, supplemental, inline) and invalid JSON scenarios for error testing - Test.Cardano.Api.TxOut.Helpers: Test utilities including JSON field assertions, parse failure validators, and datum equality checks - Test.Cardano.Api.TxOut.Json: Main test module organizing all test suites - Test.Cardano.Api.TxOut.JsonRoundtrip: Roundtrip property tests for Conway era in both CtxTx and CtxUTxO contexts - Test.Cardano.Api.TxOut.JsonEdgeCases: Edge case tests for supplemental datum behavior, null field handling, and ToJSON output validation - Test.Cardano.Api.TxOut.JsonErrorCases: Error case tests for conflicting datums, mismatched hashes, partial fields, and invalid data Note: Tests are limited to Conway era because: - ToJSON now uses Exp.IsEra constraint (Conway/Dijkstra only) - Dijkstra era is not yet fully supported by shelleyBasedEraConstraints 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude <[email protected]>
1 parent f12c64b commit 55e5a9d

File tree

17 files changed

+16064
-11314
lines changed

17 files changed

+16064
-11314
lines changed

‎cardano-api/cardano-api.cabal‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -310,6 +310,7 @@ library gen
310310
Test.Gen.Cardano.Api.Metadata
311311
Test.Gen.Cardano.Api.Orphans
312312
Test.Gen.Cardano.Api.ProtocolParameters
313+
Test.Gen.Cardano.Api.TxOut
313314
Test.Gen.Cardano.Api.Typed
314315
Test.Gen.Cardano.Crypto.Seed
315316
Test.Hedgehog.Golden.ErrorMessage
@@ -420,6 +421,11 @@ test-suite cardano-api-test
420421
Test.Cardano.Api.Transaction.Autobalance
421422
Test.Cardano.Api.Transaction.Body.Plutus.Scripts
422423
Test.Cardano.Api.TxBody
424+
Test.Cardano.Api.TxOut.Helpers
425+
Test.Cardano.Api.TxOut.Json
426+
Test.Cardano.Api.TxOut.JsonEdgeCases
427+
Test.Cardano.Api.TxOut.JsonErrorCases
428+
Test.Cardano.Api.TxOut.JsonRoundtrip
423429
Test.Cardano.Api.Value
424430

425431
ghc-options:

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

Lines changed: 188 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,188 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE GADTs #-}
3+
{-# LANGUAGE LambdaCase #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
6+
-- | Additional generators for TxOut JSON testing
7+
module Test.Gen.Cardano.Api.TxOut
8+
( -- * Specific Datum Type Generators
9+
genTxOutWithNoDatum
10+
, genTxOutWithDatumHash
11+
, genTxOutWithSupplementalDatum
12+
, genTxOutWithInlineDatum
13+
14+
-- * Invalid JSON Generators
15+
, genConflictingDatumJSON
16+
, genMismatchedInlineDatumHashJSON
17+
, genPartialInlineDatumJSON
18+
19+
-- * Era-specific TxOut generators
20+
, genTxOutForEra
21+
)
22+
where
23+
24+
import Cardano.Api hiding (Value)
25+
26+
import Data.Aeson (Value (..), object, (.=))
27+
28+
import Test.Gen.Cardano.Api.Typed
29+
30+
import Hedgehog (Gen)
31+
import Hedgehog.Gen qualified as Gen
32+
33+
-- | Generate a TxOut with no datum and no reference script
34+
genTxOutWithNoDatum
35+
:: ShelleyBasedEra era
36+
-> Gen (TxOut CtxTx era)
37+
genTxOutWithNoDatum era =
38+
TxOut
39+
<$> genAddressInEra era
40+
<*> genTxOutValue era
41+
<*> pure TxOutDatumNone
42+
<*> pure ReferenceScriptNone
43+
44+
-- | Generate a TxOut with a datum hash (Alonzo+)
45+
genTxOutWithDatumHash
46+
:: forall era
47+
. AlonzoEraOnwards era
48+
-> Gen (TxOut CtxTx era)
49+
genTxOutWithDatumHash w =
50+
alonzoEraOnwardsConstraints w $
51+
TxOut
52+
<$> genAddressInEra sbe
53+
<*> genTxOutValue sbe
54+
<*> (TxOutDatumHash w <$> genHashScriptData)
55+
<*> genReferenceScript sbe
56+
where
57+
sbe :: ShelleyBasedEra era
58+
sbe = convert w
59+
60+
-- | Generate a TxOut with a supplemental datum (Alonzo+, CtxTx only)
61+
genTxOutWithSupplementalDatum
62+
:: forall era
63+
. AlonzoEraOnwards era
64+
-> Gen (TxOut CtxTx era)
65+
genTxOutWithSupplementalDatum w =
66+
alonzoEraOnwardsConstraints w $
67+
TxOut
68+
<$> genAddressInEra sbe
69+
<*> genTxOutValue sbe
70+
<*> (TxOutSupplementalDatum w <$> genHashableScriptData)
71+
<*> genReferenceScript sbe
72+
where
73+
sbe :: ShelleyBasedEra era
74+
sbe = convert w
75+
76+
-- | Generate a TxOut with an inline datum (Babbage+)
77+
genTxOutWithInlineDatum
78+
:: forall era
79+
. BabbageEraOnwards era
80+
-> Gen (TxOut CtxTx era)
81+
genTxOutWithInlineDatum w =
82+
babbageEraOnwardsConstraints w $
83+
TxOut
84+
<$> genAddressInEra sbe
85+
<*> genTxOutValue sbe
86+
<*> (TxOutDatumInline w <$> genHashableScriptData)
87+
<*> genReferenceScript sbe
88+
where
89+
sbe :: ShelleyBasedEra era
90+
sbe = convert w
91+
92+
-- | Generate JSON with conflicting Alonzo and Babbage datum fields
93+
--
94+
-- Note: Uses Conway era for address/value generation because ToJSON
95+
-- for TxOut requires Exp.IsEra constraint (Conway+).
96+
genConflictingDatumJSON :: Gen Value
97+
genConflictingDatumJSON = do
98+
addr <- genAddressInEra ShelleyBasedEraConway
99+
val <- genTxOutValue ShelleyBasedEraConway
100+
datum1 <- genHashableScriptData
101+
datum2 <- genHashableScriptData
102+
let hash1 = hashScriptDataBytes datum1
103+
let hash2 = hashScriptDataBytes datum2
104+
pure $
105+
object
106+
[ "address" .= addr
107+
, "value" .= val
108+
, "datumhash" .= hash1
109+
, "datum" .= scriptDataToJson ScriptDataJsonDetailedSchema datum1
110+
, "inlineDatumhash" .= hash2
111+
, "inlineDatum" .= scriptDataToJson ScriptDataJsonDetailedSchema datum2
112+
]
113+
114+
-- | Generate JSON with inline datum that doesn't match its hash
115+
genMismatchedInlineDatumHashJSON :: Gen Value
116+
genMismatchedInlineDatumHashJSON = do
117+
addr <- genAddressInEra ShelleyBasedEraConway
118+
val <- genTxOutValue ShelleyBasedEraConway
119+
datum <- genHashableScriptData
120+
wrongDatum <- Gen.filter (/= datum) genHashableScriptData
121+
let wrongHash = hashScriptDataBytes wrongDatum
122+
pure $
123+
object
124+
[ "address" .= addr
125+
, "value" .= val
126+
, "inlineDatumhash" .= wrongHash
127+
, "inlineDatum" .= scriptDataToJson ScriptDataJsonDetailedSchema datum
128+
]
129+
130+
-- | Generate JSON with only partial inline datum fields
131+
genPartialInlineDatumJSON :: Gen Value
132+
genPartialInlineDatumJSON = do
133+
addr <- genAddressInEra ShelleyBasedEraConway
134+
val <- genTxOutValue ShelleyBasedEraConway
135+
datum <- genHashableScriptData
136+
let hash = hashScriptDataBytes datum
137+
Gen.choice
138+
[ -- Only hash, no datum
139+
pure $
140+
object
141+
[ "address" .= addr
142+
, "value" .= val
143+
, "inlineDatumhash" .= hash
144+
]
145+
, -- Only datum, no hash
146+
pure $
147+
object
148+
[ "address" .= addr
149+
, "value" .= val
150+
, "inlineDatum" .= scriptDataToJson ScriptDataJsonDetailedSchema datum
151+
]
152+
]
153+
154+
-- | Generate a TxOut for a specific era (using appropriate datum types)
155+
genTxOutForEra
156+
:: ShelleyBasedEra era
157+
-> Gen (TxOut CtxTx era)
158+
genTxOutForEra = \case
159+
ShelleyBasedEraShelley -> genTxOutWithNoDatum ShelleyBasedEraShelley
160+
ShelleyBasedEraAllegra -> genTxOutWithNoDatum ShelleyBasedEraAllegra
161+
ShelleyBasedEraMary -> genTxOutWithNoDatum ShelleyBasedEraMary
162+
ShelleyBasedEraAlonzo ->
163+
Gen.choice
164+
[ genTxOutWithNoDatum ShelleyBasedEraAlonzo
165+
, genTxOutWithDatumHash AlonzoEraOnwardsAlonzo
166+
, genTxOutWithSupplementalDatum AlonzoEraOnwardsAlonzo
167+
]
168+
ShelleyBasedEraBabbage ->
169+
Gen.choice
170+
[ genTxOutWithNoDatum ShelleyBasedEraBabbage
171+
, genTxOutWithDatumHash AlonzoEraOnwardsBabbage
172+
, genTxOutWithSupplementalDatum AlonzoEraOnwardsBabbage
173+
, genTxOutWithInlineDatum BabbageEraOnwardsBabbage
174+
]
175+
ShelleyBasedEraConway ->
176+
Gen.choice
177+
[ genTxOutWithNoDatum ShelleyBasedEraConway
178+
, genTxOutWithDatumHash AlonzoEraOnwardsConway
179+
, genTxOutWithSupplementalDatum AlonzoEraOnwardsConway
180+
, genTxOutWithInlineDatum BabbageEraOnwardsConway
181+
]
182+
ShelleyBasedEraDijkstra ->
183+
Gen.choice
184+
[ genTxOutWithNoDatum ShelleyBasedEraDijkstra
185+
, genTxOutWithDatumHash AlonzoEraOnwardsDijkstra
186+
, genTxOutWithSupplementalDatum AlonzoEraOnwardsDijkstra
187+
, genTxOutWithInlineDatum BabbageEraOnwardsDijkstra
188+
]

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

Lines changed: 158 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,158 @@
1+
{-# LANGUAGE AllowAmbiguousTypes #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
{-# LANGUAGE ScopedTypeVariables #-}
4+
5+
-- | Test helpers and assertion utilities for TxOut JSON testing
6+
module Test.Cardano.Api.TxOut.Helpers
7+
( -- * JSON Field Assertions
8+
assertHasFields
9+
, assertFieldPresent
10+
, assertFieldNull
11+
, assertAllNull
12+
, assertFieldEquals
13+
14+
-- * Parse Failure Assertions
15+
, assertParseFails
16+
, assertParseFailsWithMessage
17+
18+
-- * Datum Assertions
19+
, assertDatumEqual
20+
, assertDatumHashMatches
21+
22+
-- * JSON Object Manipulation
23+
, getObjectField
24+
, hasField
25+
, isNullField
26+
)
27+
where
28+
29+
import Cardano.Api hiding (Value)
30+
31+
import Control.Monad (unless)
32+
import Data.Aeson (Object, Value (..))
33+
import Data.Aeson qualified as Aeson
34+
import Data.Aeson.Key qualified as Aeson.Key
35+
import Data.Aeson.KeyMap qualified as KeyMap
36+
import Data.Text (Text)
37+
import Data.Text qualified as Text
38+
import GHC.Stack (HasCallStack, callStack)
39+
40+
import Hedgehog.Extras qualified as H
41+
import Hedgehog.Internal.Property (MonadTest)
42+
43+
-- | Assert that a JSON value has all specified fields
44+
assertHasFields :: (MonadTest m, HasCallStack) => Value -> [Text] -> m ()
45+
assertHasFields (Object obj) fields = do
46+
let missing = filter (not . hasField obj) fields
47+
unless (null missing) $
48+
H.failMessage callStack $
49+
"Missing fields: " <> show missing <> "\nObject: " <> show obj
50+
assertHasFields val _ =
51+
H.failMessage callStack $ "Expected Object but got: " <> show val
52+
53+
-- | Assert that a field is present with a specific value
54+
assertFieldPresent :: (MonadTest m, HasCallStack) => Value -> Text -> Value -> m ()
55+
assertFieldPresent (Object obj) field expected = do
56+
case getObjectField obj field of
57+
Nothing ->
58+
H.failMessage callStack $ "Field '" <> Text.unpack field <> "' not found in object"
59+
Just actual ->
60+
unless (actual == expected) $
61+
H.failMessage callStack $
62+
"Field '"
63+
<> Text.unpack field
64+
<> "' has wrong value.\nExpected: "
65+
<> show expected
66+
<> "\nActual: "
67+
<> show actual
68+
assertFieldPresent val field _ =
69+
H.failMessage callStack $
70+
"Expected Object but got: " <> show val <> " when checking field " <> Text.unpack field
71+
72+
-- | Assert that a field equals a specific value (same as assertFieldPresent)
73+
assertFieldEquals :: (MonadTest m, HasCallStack) => Value -> Text -> Value -> m ()
74+
assertFieldEquals = assertFieldPresent
75+
76+
-- | Assert that a field is present and is null
77+
assertFieldNull :: (MonadTest m, HasCallStack) => Value -> Text -> m ()
78+
assertFieldNull (Object obj) field = do
79+
case getObjectField obj field of
80+
Nothing ->
81+
H.failMessage callStack $ "Field '" <> Text.unpack field <> "' not found in object"
82+
Just Null -> return ()
83+
Just val ->
84+
H.failMessage callStack $
85+
"Field '" <> Text.unpack field <> "' is not null, got: " <> show val
86+
assertFieldNull val field =
87+
H.failMessage callStack $
88+
"Expected Object but got: " <> show val <> " when checking field " <> Text.unpack field
89+
90+
-- | Assert that all specified fields are null
91+
assertAllNull :: (MonadTest m, HasCallStack) => Value -> [Text] -> m ()
92+
assertAllNull obj fields = mapM_ (assertFieldNull obj) fields
93+
94+
-- | Assert that parsing a JSON value fails
95+
assertParseFails :: forall a m. (Aeson.FromJSON a, MonadTest m, HasCallStack) => Value -> m ()
96+
assertParseFails val =
97+
case Aeson.fromJSON val of
98+
Aeson.Success (_ :: a) ->
99+
H.failMessage callStack $ "Expected parse failure but succeeded for: " <> show val
100+
Aeson.Error _ -> return ()
101+
102+
-- | Assert that parsing fails with a message containing the specified text
103+
assertParseFailsWithMessage
104+
:: forall a m. (Aeson.FromJSON a, MonadTest m, HasCallStack) => Value -> Text -> m ()
105+
assertParseFailsWithMessage val expectedMsg =
106+
case Aeson.fromJSON val of
107+
Aeson.Success (_ :: a) ->
108+
H.failMessage callStack $ "Expected parse failure but succeeded for: " <> show val
109+
Aeson.Error msg ->
110+
unless (expectedMsg `Text.isInfixOf` Text.pack msg) $
111+
H.failMessage callStack $
112+
"Error message doesn't contain expected text.\n"
113+
<> "Expected substring: "
114+
<> Text.unpack expectedMsg
115+
<> "\nActual message: "
116+
<> msg
117+
118+
-- | Assert that two datums are equal
119+
assertDatumEqual
120+
:: (MonadTest m, HasCallStack)
121+
=> TxOutDatum ctx era
122+
-> TxOutDatum ctx era
123+
-> m ()
124+
assertDatumEqual d1 d2 =
125+
unless (d1 == d2) $
126+
H.failMessage callStack $
127+
"Datums not equal.\nExpected: " <> show d1 <> "\nActual: " <> show d2
128+
129+
-- | Assert that a datum's hash matches the expected hash
130+
assertDatumHashMatches
131+
:: (MonadTest m, HasCallStack)
132+
=> HashableScriptData
133+
-> Hash ScriptData
134+
-> m ()
135+
assertDatumHashMatches datum expectedHash =
136+
let actualHash = hashScriptDataBytes datum
137+
in unless (actualHash == expectedHash) $
138+
H.failMessage callStack $
139+
"Datum hash mismatch.\n"
140+
<> "Expected: "
141+
<> show expectedHash
142+
<> "\nActual: "
143+
<> show actualHash
144+
145+
-- | Get a field from a JSON object
146+
getObjectField :: Object -> Text -> Maybe Value
147+
getObjectField obj field = KeyMap.lookup (Aeson.Key.fromText field) obj
148+
149+
-- | Check if an object has a field
150+
hasField :: Object -> Text -> Bool
151+
hasField obj field = KeyMap.member (Aeson.Key.fromText field) obj
152+
153+
-- | Check if a field is null
154+
isNullField :: Object -> Text -> Bool
155+
isNullField obj field =
156+
case getObjectField obj field of
157+
Just Null -> True
158+
_ -> False

0 commit comments

Comments
 (0)