Skip to content

Commit 9782105

Browse files
newhoggynewhoggy
committed
test(api): add comprehensive JSON tests for TxOut instances
Implements extensive test coverage for the ToJSON and FromJSON instances of TxOut across all eras and contexts, ensuring robust JSON serialization and deserialization behavior. Test modules added: - Test.Cardano.Api.TxOut.Gen: 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 all eras (Shelley through Conway) 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 Coverage highlights: - All eras from Byron through Dijkstra (where supported) - Both transaction contexts (CtxTx and CtxUTxO) - All datum types including edge cases like supplemental datums - Comprehensive error handling validation - JSON field presence and null handling verification This test suite ensures the TxOut JSON instances maintain backward compatibility while properly handling the complex datum type variations across different Cardano eras.
1 parent ff61025 commit 9782105

File tree

9 files changed

+1010
-1
lines changed

9 files changed

+1010
-1
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: 185 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,185 @@
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+
genConflictingDatumJSON :: Gen Value
94+
genConflictingDatumJSON = do
95+
addr <- genAddressInEra ShelleyBasedEraBabbage
96+
val <- genTxOutValue ShelleyBasedEraBabbage
97+
datum1 <- genHashableScriptData
98+
datum2 <- genHashableScriptData
99+
let hash1 = hashScriptDataBytes datum1
100+
let hash2 = hashScriptDataBytes datum2
101+
pure $
102+
object
103+
[ "address" .= addr
104+
, "value" .= val
105+
, "datumhash" .= hash1
106+
, "datum" .= scriptDataToJson ScriptDataJsonDetailedSchema datum1
107+
, "inlineDatumhash" .= hash2
108+
, "inlineDatum" .= scriptDataToJson ScriptDataJsonDetailedSchema datum2
109+
]
110+
111+
-- | Generate JSON with inline datum that doesn't match its hash
112+
genMismatchedInlineDatumHashJSON :: Gen Value
113+
genMismatchedInlineDatumHashJSON = do
114+
addr <- genAddressInEra ShelleyBasedEraBabbage
115+
val <- genTxOutValue ShelleyBasedEraBabbage
116+
datum <- genHashableScriptData
117+
wrongDatum <- Gen.filter (/= datum) genHashableScriptData
118+
let wrongHash = hashScriptDataBytes wrongDatum
119+
pure $
120+
object
121+
[ "address" .= addr
122+
, "value" .= val
123+
, "inlineDatumhash" .= wrongHash
124+
, "inlineDatum" .= scriptDataToJson ScriptDataJsonDetailedSchema datum
125+
]
126+
127+
-- | Generate JSON with only partial inline datum fields
128+
genPartialInlineDatumJSON :: Gen Value
129+
genPartialInlineDatumJSON = do
130+
addr <- genAddressInEra ShelleyBasedEraBabbage
131+
val <- genTxOutValue ShelleyBasedEraBabbage
132+
datum <- genHashableScriptData
133+
let hash = hashScriptDataBytes datum
134+
Gen.choice
135+
[ -- Only hash, no datum
136+
pure $
137+
object
138+
[ "address" .= addr
139+
, "value" .= val
140+
, "inlineDatumhash" .= hash
141+
]
142+
, -- Only datum, no hash
143+
pure $
144+
object
145+
[ "address" .= addr
146+
, "value" .= val
147+
, "inlineDatum" .= scriptDataToJson ScriptDataJsonDetailedSchema datum
148+
]
149+
]
150+
151+
-- | Generate a TxOut for a specific era (using appropriate datum types)
152+
genTxOutForEra
153+
:: ShelleyBasedEra era
154+
-> Gen (TxOut CtxTx era)
155+
genTxOutForEra = \case
156+
ShelleyBasedEraShelley -> genTxOutWithNoDatum ShelleyBasedEraShelley
157+
ShelleyBasedEraAllegra -> genTxOutWithNoDatum ShelleyBasedEraAllegra
158+
ShelleyBasedEraMary -> genTxOutWithNoDatum ShelleyBasedEraMary
159+
ShelleyBasedEraAlonzo ->
160+
Gen.choice
161+
[ genTxOutWithNoDatum ShelleyBasedEraAlonzo
162+
, genTxOutWithDatumHash AlonzoEraOnwardsAlonzo
163+
, genTxOutWithSupplementalDatum AlonzoEraOnwardsAlonzo
164+
]
165+
ShelleyBasedEraBabbage ->
166+
Gen.choice
167+
[ genTxOutWithNoDatum ShelleyBasedEraBabbage
168+
, genTxOutWithDatumHash AlonzoEraOnwardsBabbage
169+
, genTxOutWithSupplementalDatum AlonzoEraOnwardsBabbage
170+
, genTxOutWithInlineDatum BabbageEraOnwardsBabbage
171+
]
172+
ShelleyBasedEraConway ->
173+
Gen.choice
174+
[ genTxOutWithNoDatum ShelleyBasedEraConway
175+
, genTxOutWithDatumHash AlonzoEraOnwardsConway
176+
, genTxOutWithSupplementalDatum AlonzoEraOnwardsConway
177+
, genTxOutWithInlineDatum BabbageEraOnwardsConway
178+
]
179+
ShelleyBasedEraDijkstra ->
180+
Gen.choice
181+
[ genTxOutWithNoDatum ShelleyBasedEraDijkstra
182+
, genTxOutWithDatumHash AlonzoEraOnwardsDijkstra
183+
, genTxOutWithSupplementalDatum AlonzoEraOnwardsDijkstra
184+
, genTxOutWithInlineDatum BabbageEraOnwardsDijkstra
185+
]

‎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

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

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
3+
-- | Comprehensive JSON tests for TxOut instances
4+
--
5+
-- This module provides extensive testing coverage for the ToJSON and FromJSON
6+
-- instances of TxOut across all eras and contexts.
7+
--
8+
-- Test coverage includes:
9+
-- - Roundtrip tests for all eras (Byron through Dijkstra)
10+
-- - Both CtxTx and CtxUTxO contexts
11+
-- - All datum types (None, Hash, Supplemental, Inline)
12+
-- - Error cases (conflicting fields, mismatched hashes, etc.)
13+
-- - Edge cases (null handling, supplemental datum ambiguity)
14+
-- - ToJSON output validation
15+
module Test.Cardano.Api.TxOut.Json
16+
( tests
17+
)
18+
where
19+
20+
import Test.Cardano.Api.TxOut.JsonEdgeCases qualified as EdgeCases
21+
import Test.Cardano.Api.TxOut.JsonErrorCases qualified as ErrorCases
22+
import Test.Cardano.Api.TxOut.JsonRoundtrip qualified as Roundtrip
23+
24+
import Test.Tasty (TestTree, testGroup)
25+
26+
-- | All TxOut JSON tests
27+
tests :: TestTree
28+
tests =
29+
testGroup
30+
"TxOut.Json"
31+
[ Roundtrip.tests
32+
, ErrorCases.tests
33+
, EdgeCases.tests
34+
]

0 commit comments

Comments
 (0)