From 978210592ffd4c83ad4004ca3ad864f9ff14deec Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 7 Nov 2025 21:49:37 +1100 Subject: [PATCH 1/2] 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. --- cardano-api/cardano-api.cabal | 6 + cardano-api/gen/Test/Gen/Cardano/Api/TxOut.hs | 185 +++++++++++++ .../Test/Cardano/Api/TxOut/Helpers.hs | 158 +++++++++++ .../Test/Cardano/Api/TxOut/Json.hs | 34 +++ .../Test/Cardano/Api/TxOut/JsonEdgeCases.hs | 206 +++++++++++++++ .../Test/Cardano/Api/TxOut/JsonErrorCases.hs | 250 ++++++++++++++++++ .../Test/Cardano/Api/TxOut/JsonRoundtrip.hs | 169 ++++++++++++ .../test/cardano-api-test/cardano-api-test.hs | 2 + .../cardano-wasm-golden.hs | 1 - 9 files changed, 1010 insertions(+), 1 deletion(-) create mode 100644 cardano-api/gen/Test/Gen/Cardano/Api/TxOut.hs create mode 100644 cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/Helpers.hs create mode 100644 cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/Json.hs create mode 100644 cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/JsonEdgeCases.hs create mode 100644 cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/JsonErrorCases.hs create mode 100644 cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/JsonRoundtrip.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index b258043e55..6b8364d3e9 100644 --- a/cardano-api/cardano-api.cabal +++ b/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: diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/TxOut.hs b/cardano-api/gen/Test/Gen/Cardano/Api/TxOut.hs new file mode 100644 index 0000000000..483f38cd2d --- /dev/null +++ b/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 + ] diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/Helpers.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/Helpers.hs new file mode 100644 index 0000000000..7f9895b1d5 --- /dev/null +++ b/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 diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/Json.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/Json.hs new file mode 100644 index 0000000000..99b3f0541d --- /dev/null +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/Json.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Comprehensive JSON tests for TxOut instances +-- +-- This module provides extensive testing coverage for the ToJSON and FromJSON +-- instances of TxOut across all eras and contexts. +-- +-- Test coverage includes: +-- - Roundtrip tests for all eras (Byron through Dijkstra) +-- - Both CtxTx and CtxUTxO contexts +-- - All datum types (None, Hash, Supplemental, Inline) +-- - Error cases (conflicting fields, mismatched hashes, etc.) +-- - Edge cases (null handling, supplemental datum ambiguity) +-- - ToJSON output validation +module Test.Cardano.Api.TxOut.Json + ( tests + ) +where + +import Test.Cardano.Api.TxOut.JsonEdgeCases qualified as EdgeCases +import Test.Cardano.Api.TxOut.JsonErrorCases qualified as ErrorCases +import Test.Cardano.Api.TxOut.JsonRoundtrip qualified as Roundtrip + +import Test.Tasty (TestTree, testGroup) + +-- | All TxOut JSON tests +tests :: TestTree +tests = + testGroup + "TxOut.Json" + [ Roundtrip.tests + , ErrorCases.tests + , EdgeCases.tests + ] diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/JsonEdgeCases.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/JsonEdgeCases.hs new file mode 100644 index 0000000000..6190e7a693 --- /dev/null +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/JsonEdgeCases.hs @@ -0,0 +1,206 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +-- | Edge case tests for TxOut JSON instances +module Test.Cardano.Api.TxOut.JsonEdgeCases + ( tests + ) +where + +import Cardano.Api hiding (Value) + +import Data.Aeson (Value (..), eitherDecode, encode, object, (.=)) + +import Test.Gen.Cardano.Api.TxOut +import Test.Gen.Cardano.Api.Typed + +import Test.Cardano.Api.TxOut.Helpers + +import Hedgehog (Property, forAll) +import Hedgehog qualified as H +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.Hedgehog (testPropertyNamed) + +-- | All edge case tests +tests :: TestTree +tests = + testGroup + "JsonEdgeCases" + [ testGroup "Supplemental Datum Behavior" testsSupplementalDatum + , testGroup "Null Field Handling" testsNullFields + , testGroup "ToJSON Output Validation" testsToJSONValidation + ] + +-- ----------------------------------------------------------------------------- +-- Supplemental Datum Tests +-- ----------------------------------------------------------------------------- + +testsSupplementalDatum :: [TestTree] +testsSupplementalDatum = + [ testPropertyNamed + "supplemental datum produces both datumhash and datum fields" + "prop_supplemental_datum_produces_both_fields" + prop_supplemental_datum_produces_both_fields + , testPropertyNamed + "supplemental datum roundtrips to supplemental (not hash)" + "prop_supplemental_datum_roundtrips_to_supplemental" + prop_supplemental_datum_roundtrips_to_supplemental + ] + +prop_supplemental_datum_produces_both_fields :: Property +prop_supplemental_datum_produces_both_fields = H.property $ do + txOut <- forAll $ genTxOutWithSupplementalDatum AlonzoEraOnwardsAlonzo + let json = toJSON txOut + assertHasFields json ["datumhash", "datum"] + -- Verify datumhash is not null + case json of + Object obj -> do + case getObjectField obj "datumhash" of + Just Null -> do + H.annotate "datumhash should not be null for supplemental datum" + H.failure + Just _ -> return () + Nothing -> do + H.annotate "datumhash field missing" + H.failure + case getObjectField obj "datum" of + Just Null -> do + H.annotate "datum should not be null for supplemental datum" + H.failure + Just _ -> return () + Nothing -> do + H.annotate "datum field missing" + H.failure + _ -> do + H.annotate "Expected JSON object" + H.failure + +prop_supplemental_datum_roundtrips_to_supplemental :: Property +prop_supplemental_datum_roundtrips_to_supplemental = H.property $ do + txOut@(TxOut _ _ datum _) <- forAll $ genTxOutWithSupplementalDatum AlonzoEraOnwardsAlonzo + case datum of + TxOutSupplementalDatum{} -> do + let decoded = eitherDecode @(TxOut CtxTx AlonzoEra) (encode txOut) + case decoded of + Right (TxOut _ _ decodedDatum _) -> + case decodedDatum of + TxOutSupplementalDatum{} -> H.success + _ -> do + H.annotate $ "Expected TxOutSupplementalDatum but got: " <> show decodedDatum + H.failure + Left err -> do + H.annotate $ "Decode failed: " <> err + H.failure + _ -> do + H.annotate "Expected TxOutSupplementalDatum" + H.failure + +-- ----------------------------------------------------------------------------- +-- Null Field Handling Tests +-- ----------------------------------------------------------------------------- + +testsNullFields :: [TestTree] +testsNullFields = + [ testPropertyNamed + "null fields optional for parsing" + "prop_null_fields_optional" + prop_null_fields_optional + , testPropertyNamed + "explicit null fields accepted" + "prop_explicit_null_fields_accepted" + prop_explicit_null_fields_accepted + ] + +prop_null_fields_optional :: Property +prop_null_fields_optional = H.property $ do + addr <- forAll $ genAddressInEra ShelleyBasedEraBabbage + val <- forAll $ genTxOutValue ShelleyBasedEraBabbage + let json = object ["address" .= addr, "value" .= val] + case eitherDecode @(TxOut CtxTx BabbageEra) (encode json) of + Right (TxOut _ _ datum _) -> + assertDatumEqual datum TxOutDatumNone + Left err -> do + H.annotate $ "Parse failed: " <> err + H.failure + +prop_explicit_null_fields_accepted :: Property +prop_explicit_null_fields_accepted = H.property $ do + addr <- forAll $ genAddressInEra ShelleyBasedEraBabbage + val <- forAll $ genTxOutValue ShelleyBasedEraBabbage + let json = + object + [ "address" .= addr + , "value" .= val + , "datumhash" .= Null + , "datum" .= Null + , "inlineDatum" .= Null + , "referenceScript" .= Null + ] + case eitherDecode @(TxOut CtxTx BabbageEra) (encode json) of + Right (TxOut _ _ datum refScript) -> do + assertDatumEqual datum TxOutDatumNone + case refScript of + ReferenceScriptNone -> H.success + _ -> do + H.annotate $ "Expected ReferenceScriptNone but got: " <> show refScript + H.failure + Left err -> do + H.annotate $ "Parse failed: " <> err + H.failure + +-- ----------------------------------------------------------------------------- +-- ToJSON Output Validation Tests +-- ----------------------------------------------------------------------------- + +testsToJSONValidation :: [TestTree] +testsToJSONValidation = + [ testPropertyNamed + "no datum has null fields (Babbage)" + "prop_toJSON_no_datum_has_null_fields" + prop_toJSON_no_datum_has_null_fields + , testPropertyNamed + "inline datum uses inline fields" + "prop_toJSON_inline_datum_uses_inline_fields" + prop_toJSON_inline_datum_uses_inline_fields + ] + +prop_toJSON_no_datum_has_null_fields :: Property +prop_toJSON_no_datum_has_null_fields = H.property $ do + txOut <- forAll $ genTxOutWithNoDatum ShelleyBasedEraBabbage + let json = toJSON txOut + assertHasFields json ["datumhash", "datum", "inlineDatum", "inlineDatumRaw", "referenceScript"] + assertAllNull json ["datumhash", "datum", "inlineDatum", "inlineDatumRaw", "referenceScript"] + +prop_toJSON_inline_datum_uses_inline_fields :: Property +prop_toJSON_inline_datum_uses_inline_fields = H.property $ do + txOut <- forAll $ genTxOutWithInlineDatum BabbageEraOnwardsBabbage + let json = toJSON txOut + -- Should have inlineDatumhash and inlineDatum + assertHasFields json ["inlineDatumhash", "inlineDatum"] + case json of + Object obj -> do + -- inlineDatumhash and inlineDatum should not be null + case getObjectField obj "inlineDatumhash" of + Just Null -> do + H.annotate "inlineDatumhash should not be null for inline datum" + H.failure + Just _ -> return () + Nothing -> do + H.annotate "inlineDatumhash field missing" + H.failure + case getObjectField obj "inlineDatum" of + Just Null -> do + H.annotate "inlineDatum should not be null for inline datum" + H.failure + Just _ -> return () + Nothing -> do + H.annotate "inlineDatum field missing" + H.failure + -- datum field should be null (datumhash doesn't exist for inline datums) + assertFieldNull json "datum" + _ -> do + H.annotate "Expected JSON object" + H.failure diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/JsonErrorCases.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/JsonErrorCases.hs new file mode 100644 index 0000000000..454193f0e2 --- /dev/null +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/JsonErrorCases.hs @@ -0,0 +1,250 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +-- | Error case tests for TxOut JSON parsing +module Test.Cardano.Api.TxOut.JsonErrorCases + ( tests + ) +where + +import Cardano.Api hiding (Value) + +import Data.Aeson (object, (.=)) + +import Test.Gen.Cardano.Api.TxOut +import Test.Gen.Cardano.Api.Typed + +import Test.Cardano.Api.TxOut.Helpers + +import Hedgehog (Property, forAll) +import Hedgehog qualified as H +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.Hedgehog (testPropertyNamed) + +-- | All error case tests +tests :: TestTree +tests = + testGroup + "JsonErrorCases" + [ testGroup "Conflicting Datums" testsConflictingDatums + , testGroup "Mismatched Hashes" testsMismatchedHashes + , testGroup "Partial Fields" testsPartialFields + , testGroup "Invalid Data" testsInvalidData + , testGroup "Missing Required Fields" testsMissingFields + ] + +-- ----------------------------------------------------------------------------- +-- Conflicting Datum Tests +-- ----------------------------------------------------------------------------- + +testsConflictingDatums :: [TestTree] +testsConflictingDatums = + [ testPropertyNamed + "Babbage: reject conflicting Alonzo and Babbage datums" + "prop_reject_conflicting_datums_babbage" + prop_reject_conflicting_datums_babbage + , testPropertyNamed + "Conway: reject conflicting Alonzo and Conway datums" + "prop_reject_conflicting_datums_conway" + prop_reject_conflicting_datums_conway + -- Dijkstra era not yet supported in shelleyBasedEraConstraints + -- , testPropertyNamed + -- "Dijkstra: reject conflicting Alonzo and Dijkstra datums" + -- "prop_reject_conflicting_datums_dijkstra" + -- prop_reject_conflicting_datums_dijkstra + ] + +prop_reject_conflicting_datums_babbage :: Property +prop_reject_conflicting_datums_babbage = H.property $ do + json <- forAll genConflictingDatumJSON + assertParseFailsWithMessage @(TxOut CtxTx BabbageEra) + json + "Alonzo era datum and a Babbage era datum" + +prop_reject_conflicting_datums_conway :: Property +prop_reject_conflicting_datums_conway = H.property $ do + json <- forAll genConflictingDatumJSON + assertParseFailsWithMessage @(TxOut CtxTx ConwayEra) json "Alonzo era datum and a Conway era datum" + +-- Dijkstra era not yet supported in shelleyBasedEraConstraints +-- prop_reject_conflicting_datums_dijkstra :: Property +-- prop_reject_conflicting_datums_dijkstra = H.property $ do +-- json <- forAll genConflictingDatumJSON +-- H.evalIO $ assertParseFailsWithMessage @(TxOut CtxTx DijkstraEra) json "Alonzo era datum and a" + +-- ----------------------------------------------------------------------------- +-- Mismatched Hash Tests +-- ----------------------------------------------------------------------------- + +testsMismatchedHashes :: [TestTree] +testsMismatchedHashes = + [ testPropertyNamed + "Babbage CtxTx: reject mismatched inline datum hash" + "prop_reject_mismatched_hash_babbage_ctx_tx" + prop_reject_mismatched_hash_babbage_ctx_tx + , testPropertyNamed + "Babbage CtxUTxO: reject mismatched inline datum hash" + "prop_reject_mismatched_hash_babbage_ctx_utxo" + prop_reject_mismatched_hash_babbage_ctx_utxo + , testPropertyNamed + "Conway CtxTx: reject mismatched inline datum hash" + "prop_reject_mismatched_hash_conway_ctx_tx" + prop_reject_mismatched_hash_conway_ctx_tx + , testPropertyNamed + "Conway CtxUTxO: reject mismatched inline datum hash" + "prop_reject_mismatched_hash_conway_ctx_utxo" + prop_reject_mismatched_hash_conway_ctx_utxo + ] + +prop_reject_mismatched_hash_babbage_ctx_tx :: Property +prop_reject_mismatched_hash_babbage_ctx_tx = H.property $ do + json <- forAll genMismatchedInlineDatumHashJSON + assertParseFailsWithMessage @(TxOut CtxTx BabbageEra) + json + "Inline datum not equivalent to inline datum hash" + +prop_reject_mismatched_hash_babbage_ctx_utxo :: Property +prop_reject_mismatched_hash_babbage_ctx_utxo = H.property $ do + json <- forAll genMismatchedInlineDatumHashJSON + assertParseFailsWithMessage @(TxOut CtxUTxO BabbageEra) + json + "Inline datum not equivalent to inline datum hash" + +prop_reject_mismatched_hash_conway_ctx_tx :: Property +prop_reject_mismatched_hash_conway_ctx_tx = H.property $ do + json <- forAll genMismatchedInlineDatumHashJSON + assertParseFailsWithMessage @(TxOut CtxTx ConwayEra) + json + "Inline datum not equivalent to inline datum hash" + +prop_reject_mismatched_hash_conway_ctx_utxo :: Property +prop_reject_mismatched_hash_conway_ctx_utxo = H.property $ do + json <- forAll genMismatchedInlineDatumHashJSON + assertParseFailsWithMessage @(TxOut CtxUTxO ConwayEra) + json + "Inline datum not equivalent to inline datum hash" + +-- ----------------------------------------------------------------------------- +-- Partial Field Tests +-- ----------------------------------------------------------------------------- + +testsPartialFields :: [TestTree] +testsPartialFields = + [ testPropertyNamed + "Babbage CtxTx: reject partial inline datum fields" + "prop_reject_partial_inline_datum_babbage_ctx_tx" + prop_reject_partial_inline_datum_babbage_ctx_tx + , testPropertyNamed + "Babbage CtxUTxO: reject partial inline datum fields" + "prop_reject_partial_inline_datum_babbage_ctx_utxo" + prop_reject_partial_inline_datum_babbage_ctx_utxo + , testPropertyNamed + "Conway CtxTx: reject partial inline datum fields" + "prop_reject_partial_inline_datum_conway_ctx_tx" + prop_reject_partial_inline_datum_conway_ctx_tx + ] + +prop_reject_partial_inline_datum_babbage_ctx_tx :: Property +prop_reject_partial_inline_datum_babbage_ctx_tx = H.property $ do + json <- forAll genPartialInlineDatumJSON + assertParseFailsWithMessage @(TxOut CtxTx BabbageEra) + json + "either an inline datum hash or an inline datum" + +prop_reject_partial_inline_datum_babbage_ctx_utxo :: Property +prop_reject_partial_inline_datum_babbage_ctx_utxo = H.property $ do + json <- forAll genPartialInlineDatumJSON + assertParseFailsWithMessage @(TxOut CtxUTxO BabbageEra) + json + "either an inline datum hash or an inline datum" + +prop_reject_partial_inline_datum_conway_ctx_tx :: Property +prop_reject_partial_inline_datum_conway_ctx_tx = H.property $ do + json <- forAll genPartialInlineDatumJSON + assertParseFailsWithMessage @(TxOut CtxTx ConwayEra) + json + "either an inline datum hash or an inline datum" + +-- ----------------------------------------------------------------------------- +-- Invalid Data Tests +-- ----------------------------------------------------------------------------- + +testsInvalidData :: [TestTree] +testsInvalidData = + [ testPropertyNamed + "Alonzo: reject datum without hash" + "prop_reject_datum_without_hash" + prop_reject_datum_without_hash + , testPropertyNamed + "Babbage: reject invalid script data in datum" + "prop_reject_invalid_script_data_datum" + prop_reject_invalid_script_data_datum + , testPropertyNamed + "Babbage: reject invalid script data in inline datum" + "prop_reject_invalid_script_data_inline_datum" + prop_reject_invalid_script_data_inline_datum + ] + +prop_reject_datum_without_hash :: Property +prop_reject_datum_without_hash = H.property $ do + addr <- forAll $ genAddressInEra ShelleyBasedEraAlonzo + val <- forAll $ genTxOutValue ShelleyBasedEraAlonzo + let json = + object + [ "address" .= addr + , "value" .= val + , "datum" .= object ["int" .= (42 :: Int)] + ] + assertParseFailsWithMessage @(TxOut CtxTx AlonzoEra) json "Only datum JSON was found" + +prop_reject_invalid_script_data_datum :: Property +prop_reject_invalid_script_data_datum = H.property $ do + addr <- forAll $ genAddressInEra ShelleyBasedEraBabbage + val <- forAll $ genTxOutValue ShelleyBasedEraBabbage + scriptDataHash <- forAll genHashScriptData + let json = + object + [ "address" .= addr + , "value" .= val + , "datumhash" .= scriptDataHash + , "datum" .= object ["invalid" .= ("structure" :: String)] + ] + assertParseFails @(TxOut CtxTx BabbageEra) json + +prop_reject_invalid_script_data_inline_datum :: Property +prop_reject_invalid_script_data_inline_datum = H.property $ do + addr <- forAll $ genAddressInEra ShelleyBasedEraBabbage + val <- forAll $ genTxOutValue ShelleyBasedEraBabbage + scriptDataHash <- forAll genHashScriptData + let json = + object + [ "address" .= addr + , "value" .= val + , "inlineDatumhash" .= scriptDataHash + , "inlineDatum" .= object ["invalid" .= ("structure" :: String)] + ] + assertParseFails @(TxOut CtxTx BabbageEra) json + +-- ----------------------------------------------------------------------------- +-- Missing Required Fields Tests +-- ----------------------------------------------------------------------------- + +testsMissingFields :: [TestTree] +testsMissingFields = + [ testPropertyNamed "reject missing address" "prop_reject_missing_address" prop_reject_missing_address + , testPropertyNamed "reject missing value" "prop_reject_missing_value" prop_reject_missing_value + ] + +prop_reject_missing_address :: Property +prop_reject_missing_address = H.property $ do + val <- forAll $ genTxOutValue ShelleyBasedEraBabbage + let json = object ["value" .= val] + assertParseFails @(TxOut CtxTx BabbageEra) json + +prop_reject_missing_value :: Property +prop_reject_missing_value = H.property $ do + addr <- forAll $ genAddressInEra ShelleyBasedEraBabbage + let json = object ["address" .= addr] + assertParseFails @(TxOut CtxTx BabbageEra) json diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/JsonRoundtrip.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/JsonRoundtrip.hs new file mode 100644 index 0000000000..ad34d949c6 --- /dev/null +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/TxOut/JsonRoundtrip.hs @@ -0,0 +1,169 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Comprehensive roundtrip tests for TxOut JSON instances across all eras +module Test.Cardano.Api.TxOut.JsonRoundtrip + ( tests + ) +where + +import Cardano.Api + +import Data.Aeson (eitherDecode, encode) + +import Test.Gen.Cardano.Api.TxOut +import Test.Gen.Cardano.Api.Typed + +import Hedgehog (Property, forAll, tripping) +import Hedgehog qualified as H +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.Hedgehog (testProperty) + +-- | All roundtrip tests +tests :: TestTree +tests = + testGroup + "JsonRoundtrip" + [ testGroup "CtxTx" testsCtxTx + , testGroup "CtxUTxO" testsCtxUTxO + , testGroup "Datum-Specific" testsDatumSpecific + ] + +-- | Roundtrip tests for TxOut CtxTx across all eras +testsCtxTx :: [TestTree] +testsCtxTx = + [ testProperty "shelley" prop_json_roundtrip_txout_ctx_tx_shelley + , testProperty "allegra" prop_json_roundtrip_txout_ctx_tx_allegra + , testProperty "mary" prop_json_roundtrip_txout_ctx_tx_mary + , testProperty "alonzo" prop_json_roundtrip_txout_ctx_tx_alonzo + , testProperty "babbage" prop_json_roundtrip_txout_ctx_tx_babbage + , testProperty "conway" prop_json_roundtrip_txout_ctx_tx_conway + -- Dijkstra era not yet supported in shelleyBasedEraConstraints + -- , testProperty "dijkstra" prop_json_roundtrip_txout_ctx_tx_dijkstra + ] + +-- | Roundtrip tests for TxOut CtxUTxO across all eras +testsCtxUTxO :: [TestTree] +testsCtxUTxO = + [ testProperty "shelley" prop_json_roundtrip_txout_ctx_utxo_shelley + , testProperty "allegra" prop_json_roundtrip_txout_ctx_utxo_allegra + , testProperty "mary" prop_json_roundtrip_txout_ctx_utxo_mary + , testProperty "alonzo" prop_json_roundtrip_txout_ctx_utxo_alonzo + , testProperty "babbage" prop_json_roundtrip_txout_ctx_utxo_babbage + , testProperty "conway" prop_json_roundtrip_txout_ctx_utxo_conway + -- Dijkstra era not yet supported in shelleyBasedEraConstraints + -- , testProperty "dijkstra" prop_json_roundtrip_txout_ctx_utxo_dijkstra + ] + +-- | Datum-specific roundtrip tests +testsDatumSpecific :: [TestTree] +testsDatumSpecific = + [ testProperty "no datum (Alonzo)" prop_json_roundtrip_txout_no_datum + , testProperty "datum hash (Alonzo)" prop_json_roundtrip_txout_datum_hash + , testProperty "supplemental datum (Alonzo)" prop_json_roundtrip_txout_supplemental_datum + , testProperty "inline datum (Babbage)" prop_json_roundtrip_txout_inline_datum + ] + +-- ----------------------------------------------------------------------------- +-- CtxTx Roundtrip Properties +-- ----------------------------------------------------------------------------- + +prop_json_roundtrip_txout_ctx_tx_shelley :: Property +prop_json_roundtrip_txout_ctx_tx_shelley = H.property $ do + txOut <- forAll $ genTxOutTxContext ShelleyBasedEraShelley + tripping txOut encode eitherDecode + +prop_json_roundtrip_txout_ctx_tx_allegra :: Property +prop_json_roundtrip_txout_ctx_tx_allegra = H.property $ do + txOut <- forAll $ genTxOutTxContext ShelleyBasedEraAllegra + tripping txOut encode eitherDecode + +prop_json_roundtrip_txout_ctx_tx_mary :: Property +prop_json_roundtrip_txout_ctx_tx_mary = H.property $ do + txOut <- forAll $ genTxOutTxContext ShelleyBasedEraMary + tripping txOut encode eitherDecode + +prop_json_roundtrip_txout_ctx_tx_alonzo :: Property +prop_json_roundtrip_txout_ctx_tx_alonzo = H.property $ do + txOut <- forAll $ genTxOutTxContext ShelleyBasedEraAlonzo + tripping txOut encode eitherDecode + +prop_json_roundtrip_txout_ctx_tx_babbage :: Property +prop_json_roundtrip_txout_ctx_tx_babbage = H.property $ do + txOut <- forAll $ genTxOutTxContext ShelleyBasedEraBabbage + tripping txOut encode eitherDecode + +prop_json_roundtrip_txout_ctx_tx_conway :: Property +prop_json_roundtrip_txout_ctx_tx_conway = H.property $ do + txOut <- forAll $ genTxOutTxContext ShelleyBasedEraConway + tripping txOut encode eitherDecode + +-- Dijkstra era not yet supported in shelleyBasedEraConstraints +-- prop_json_roundtrip_txout_ctx_tx_dijkstra :: Property +-- prop_json_roundtrip_txout_ctx_tx_dijkstra = H.property $ do +-- txOut <- forAll $ genTxOutTxContext ShelleyBasedEraDijkstra +-- tripping txOut encode eitherDecode + +-- ----------------------------------------------------------------------------- +-- CtxUTxO Roundtrip Properties +-- ----------------------------------------------------------------------------- + +prop_json_roundtrip_txout_ctx_utxo_shelley :: Property +prop_json_roundtrip_txout_ctx_utxo_shelley = H.property $ do + txOut <- forAll $ genTxOutUTxOContext ShelleyBasedEraShelley + tripping txOut encode eitherDecode + +prop_json_roundtrip_txout_ctx_utxo_allegra :: Property +prop_json_roundtrip_txout_ctx_utxo_allegra = H.property $ do + txOut <- forAll $ genTxOutUTxOContext ShelleyBasedEraAllegra + tripping txOut encode eitherDecode + +prop_json_roundtrip_txout_ctx_utxo_mary :: Property +prop_json_roundtrip_txout_ctx_utxo_mary = H.property $ do + txOut <- forAll $ genTxOutUTxOContext ShelleyBasedEraMary + tripping txOut encode eitherDecode + +prop_json_roundtrip_txout_ctx_utxo_alonzo :: Property +prop_json_roundtrip_txout_ctx_utxo_alonzo = H.property $ do + txOut <- forAll $ genTxOutUTxOContext ShelleyBasedEraAlonzo + tripping txOut encode eitherDecode + +prop_json_roundtrip_txout_ctx_utxo_babbage :: Property +prop_json_roundtrip_txout_ctx_utxo_babbage = H.property $ do + txOut <- forAll $ genTxOutUTxOContext ShelleyBasedEraBabbage + tripping txOut encode eitherDecode + +prop_json_roundtrip_txout_ctx_utxo_conway :: Property +prop_json_roundtrip_txout_ctx_utxo_conway = H.property $ do + txOut <- forAll $ genTxOutUTxOContext ShelleyBasedEraConway + tripping txOut encode eitherDecode + +-- Dijkstra era not yet supported in shelleyBasedEraConstraints +-- prop_json_roundtrip_txout_ctx_utxo_dijkstra :: Property +-- prop_json_roundtrip_txout_ctx_utxo_dijkstra = H.property $ do +-- txOut <- forAll $ genTxOutUTxOContext ShelleyBasedEraDijkstra +-- tripping txOut encode eitherDecode + +-- ----------------------------------------------------------------------------- +-- Datum-Specific Roundtrip Properties +-- ----------------------------------------------------------------------------- + +prop_json_roundtrip_txout_no_datum :: Property +prop_json_roundtrip_txout_no_datum = H.property $ do + txOut <- forAll $ genTxOutWithNoDatum ShelleyBasedEraAlonzo + tripping txOut encode eitherDecode + +prop_json_roundtrip_txout_datum_hash :: Property +prop_json_roundtrip_txout_datum_hash = H.property $ do + txOut <- forAll $ genTxOutWithDatumHash AlonzoEraOnwardsAlonzo + tripping txOut encode eitherDecode + +prop_json_roundtrip_txout_supplemental_datum :: Property +prop_json_roundtrip_txout_supplemental_datum = H.property $ do + txOut <- forAll $ genTxOutWithSupplementalDatum AlonzoEraOnwardsAlonzo + tripping txOut encode eitherDecode + +prop_json_roundtrip_txout_inline_datum :: Property +prop_json_roundtrip_txout_inline_datum = H.property $ do + txOut <- forAll $ genTxOutWithInlineDatum BabbageEraOnwardsBabbage + tripping txOut encode eitherDecode diff --git a/cardano-api/test/cardano-api-test/cardano-api-test.hs b/cardano-api/test/cardano-api-test/cardano-api-test.hs index 8e3907f907..33cc2d9349 100644 --- a/cardano-api/test/cardano-api-test/cardano-api-test.hs +++ b/cardano-api/test/cardano-api-test/cardano-api-test.hs @@ -27,6 +27,7 @@ import Test.Cardano.Api.RawBytes qualified import Test.Cardano.Api.Transaction.Autobalance qualified import Test.Cardano.Api.Transaction.Body.Plutus.Scripts qualified import Test.Cardano.Api.TxBody qualified +import Test.Cardano.Api.TxOut.Json qualified import Test.Cardano.Api.Value qualified import Test.Tasty (TestTree, defaultMain, testGroup) @@ -65,5 +66,6 @@ tests = , Test.Cardano.Api.Transaction.Body.Plutus.Scripts.tests , Test.Cardano.Api.Transaction.Autobalance.tests , Test.Cardano.Api.TxBody.tests + , Test.Cardano.Api.TxOut.Json.tests , Test.Cardano.Api.Value.tests ] diff --git a/cardano-wasm/test/cardano-wasm-golden/cardano-wasm-golden.hs b/cardano-wasm/test/cardano-wasm-golden/cardano-wasm-golden.hs index de4594616b..5060d23910 100644 --- a/cardano-wasm/test/cardano-wasm-golden/cardano-wasm-golden.hs +++ b/cardano-wasm/test/cardano-wasm-golden/cardano-wasm-golden.hs @@ -5,4 +5,3 @@ #else main = return () #endif - From 5388ee2c3fd253e8861b48efbe1bf76e480033e6 Mon Sep 17 00:00:00 2001 From: John Ky Date: Wed, 12 Nov 2025 23:25:29 +1100 Subject: [PATCH 2/2] docs(eras): add deprecation notice for era case functions --- cardano-api/src/Cardano/Api/Era/Internal/Case.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/cardano-api/src/Cardano/Api/Era/Internal/Case.hs b/cardano-api/src/Cardano/Api/Era/Internal/Case.hs index 996bac75b1..647955620e 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Case.hs +++ b/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