Skip to content

Commit db7c007

Browse files
newhoggynewhoggy
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
1 parent 22428bc commit db7c007

File tree

9 files changed

+859
-1
lines changed

9 files changed

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

‎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)