Skip to content

Commit f90e9af

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 f90e9af

File tree

17 files changed

+16025
-11314
lines changed

17 files changed

+16025
-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: 149 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,149 @@
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+
where
20+
21+
import Cardano.Api hiding (Value)
22+
23+
import Data.Aeson (Value (..), object, (.=))
24+
25+
import Test.Gen.Cardano.Api.Typed
26+
27+
import Hedgehog (Gen)
28+
import Hedgehog.Gen qualified as Gen
29+
30+
-- | Generate a TxOut with no datum and no reference script
31+
genTxOutWithNoDatum
32+
:: ShelleyBasedEra era
33+
-> Gen (TxOut CtxTx era)
34+
genTxOutWithNoDatum era =
35+
TxOut
36+
<$> genAddressInEra era
37+
<*> genTxOutValue era
38+
<*> pure TxOutDatumNone
39+
<*> pure ReferenceScriptNone
40+
41+
-- | Generate a TxOut with a datum hash (Alonzo+)
42+
genTxOutWithDatumHash
43+
:: forall era
44+
. AlonzoEraOnwards era
45+
-> Gen (TxOut CtxTx era)
46+
genTxOutWithDatumHash w =
47+
alonzoEraOnwardsConstraints w $
48+
TxOut
49+
<$> genAddressInEra sbe
50+
<*> genTxOutValue sbe
51+
<*> (TxOutDatumHash w <$> genHashScriptData)
52+
<*> genReferenceScript sbe
53+
where
54+
sbe :: ShelleyBasedEra era
55+
sbe = convert w
56+
57+
-- | Generate a TxOut with a supplemental datum (Alonzo+, CtxTx only)
58+
genTxOutWithSupplementalDatum
59+
:: forall era
60+
. AlonzoEraOnwards era
61+
-> Gen (TxOut CtxTx era)
62+
genTxOutWithSupplementalDatum w =
63+
alonzoEraOnwardsConstraints w $
64+
TxOut
65+
<$> genAddressInEra sbe
66+
<*> genTxOutValue sbe
67+
<*> (TxOutSupplementalDatum w <$> genHashableScriptData)
68+
<*> genReferenceScript sbe
69+
where
70+
sbe :: ShelleyBasedEra era
71+
sbe = convert w
72+
73+
-- | Generate a TxOut with an inline datum (Babbage+)
74+
genTxOutWithInlineDatum
75+
:: forall era
76+
. BabbageEraOnwards era
77+
-> Gen (TxOut CtxTx era)
78+
genTxOutWithInlineDatum w =
79+
babbageEraOnwardsConstraints w $
80+
TxOut
81+
<$> genAddressInEra sbe
82+
<*> genTxOutValue sbe
83+
<*> (TxOutDatumInline w <$> genHashableScriptData)
84+
<*> genReferenceScript sbe
85+
where
86+
sbe :: ShelleyBasedEra era
87+
sbe = convert w
88+
89+
-- | Generate JSON with conflicting Alonzo and Babbage datum fields
90+
--
91+
-- Note: Uses Conway era for address/value generation because ToJSON
92+
-- for TxOut requires Exp.IsEra constraint (Conway+).
93+
genConflictingDatumJSON :: Gen Value
94+
genConflictingDatumJSON = do
95+
addr <- genAddressInEra ShelleyBasedEraConway
96+
val <- genTxOutValue ShelleyBasedEraConway
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 ShelleyBasedEraConway
115+
val <- genTxOutValue ShelleyBasedEraConway
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 ShelleyBasedEraConway
131+
val <- genTxOutValue ShelleyBasedEraConway
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+
]

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