From 091b890090ec550990b075b742224773e858e766 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 12 Sep 2024 00:28:54 +0200 Subject: [PATCH 1/3] Add new types to CDDL list and test forward compatibility of `deserialiseTxLedgerCddl` --- .../internal/Cardano/Api/SerialiseLedgerCddl.hs | 6 ++++++ .../test/cardano-api-test/Test/Cardano/Api/CBOR.hs | 14 ++++++++++++++ 2 files changed, 20 insertions(+) diff --git a/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs b/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs index d559e51af..35e45143f 100644 --- a/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs +++ b/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs @@ -316,6 +316,12 @@ deserialiseFromTextEnvelopeCddlAnyOf types teCddl = -- a single sum data type. cddlTypeToEra :: Text -> Either TextEnvelopeCddlError AnyShelleyBasedEra cddlTypeToEra = \case + "TxSignedShelley" -> return $ AnyShelleyBasedEra ShelleyBasedEraShelley + "Tx AllegraEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAllegra + "Tx MaryEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraMary + "Tx AlonzoEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo + "Tx BabbageEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraBabbage + "Tx ConwayEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraConway "Witnessed Tx ShelleyEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraShelley "Witnessed Tx AllegraEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAllegra "Witnessed Tx MaryEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraMary diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs index 3bf25a923..ada869162 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs @@ -10,6 +10,7 @@ module Test.Cardano.Api.CBOR where import Cardano.Api +import Cardano.Api.SerialiseTextEnvelope (TextEnvelopeDescr (TextEnvelopeDescr)) import Cardano.Api.Shelley (AsType (..)) import Data.Proxy (Proxy (..)) @@ -32,6 +33,18 @@ import Test.Tasty.Hedgehog (testProperty) -- TODO: Need to add PaymentExtendedKey roundtrip tests however -- we can't derive an Eq instance for Crypto.HD.XPrv +prop_forward_compatibility_txbody_CBOR :: Property +prop_forward_compatibility_txbody_CBOR = H.property $ do + AnyShelleyBasedEra era <- H.noteShowM . H.forAll $ Gen.element [minBound .. maxBound] + x <- H.forAll $ makeSignedTransaction [] . fst <$> genValidTxBody era + shelleyBasedEraConstraints + era + ( H.tripping + x + (serialiseToTextEnvelope (Just (TextEnvelopeDescr "Ledger Cddl Format"))) + (deserialiseTxLedgerCddl era) + ) + prop_roundtrip_txbody_CBOR :: Property prop_roundtrip_txbody_CBOR = H.property $ do AnyShelleyBasedEra era <- H.noteShowM . H.forAll $ Gen.element [minBound .. maxBound] @@ -268,6 +281,7 @@ tests = "roundtrip UpdateProposal CBOR" prop_roundtrip_UpdateProposal_CBOR , testProperty "roundtrip ScriptData CBOR" prop_roundtrip_ScriptData_CBOR + , testProperty "roundtrip txbody forward compatibility CBOR" prop_forward_compatibility_txbody_CBOR , testProperty "roundtrip txbody CBOR" prop_roundtrip_txbody_CBOR , testProperty "roundtrip Tx Cddl" prop_roundtrip_Tx_Cddl , testProperty "roundtrip TxWitness Cddl" prop_roundtrip_TxWitness_Cddl From b33f0afdef355c9ce20f8491ef2885f76726c893 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Mon, 16 Sep 2024 22:25:23 +0200 Subject: [PATCH 2/3] Add comment to `prop_forward_compatibility_txbody_CBOR` test --- cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs index ada869162..8e9689d3b 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs @@ -33,6 +33,10 @@ import Test.Tasty.Hedgehog (testProperty) -- TODO: Need to add PaymentExtendedKey roundtrip tests however -- we can't derive an Eq instance for Crypto.HD.XPrv +-- This is the same test as prop_roundtrip_witness_CBOR but uses the +-- new function `serialiseTxLedgerCddl` instead of the deprecated +-- `serialiseToTextEnvelope`. `deserialiseTxLedgerCddl` must be +-- compatible with both during the transition. prop_forward_compatibility_txbody_CBOR :: Property prop_forward_compatibility_txbody_CBOR = H.property $ do AnyShelleyBasedEra era <- H.noteShowM . H.forAll $ Gen.element [minBound .. maxBound] From e7a70660555ce3477588a0b36ed1bddc2ae12fa5 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 17 Sep 2024 03:30:21 +0200 Subject: [PATCH 3/3] Add tests for `cddlTypeToEra` --- cardano-api/cardano-api.cabal | 1 + .../Cardano/Api/SerialiseLedgerCddl.hs | 54 ++++++++++--------- .../cardano-api-test/Test/Cardano/Api/CBOR.hs | 32 +++++++++++ 3 files changed, 61 insertions(+), 26 deletions(-) diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index d5dbdb8d1..6d3e3ee25 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -338,6 +338,7 @@ test-suite cardano-api-test tasty, tasty-hedgehog, tasty-quickcheck, + text, time, other-modules: diff --git a/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs b/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs index 35e45143f..02f628257 100644 --- a/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs +++ b/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs @@ -12,6 +12,7 @@ module Cardano.Api.SerialiseLedgerCddl ( TextEnvelopeCddlError (..) , FromSomeTypeCDDL (..) + , cddlTypeToEra -- * Reading one of several transaction or @@ -315,32 +316,33 @@ deserialiseFromTextEnvelopeCddlAnyOf types teCddl = -- will make it easier to keep track of the different Cddl descriptions via -- a single sum data type. cddlTypeToEra :: Text -> Either TextEnvelopeCddlError AnyShelleyBasedEra -cddlTypeToEra = \case - "TxSignedShelley" -> return $ AnyShelleyBasedEra ShelleyBasedEraShelley - "Tx AllegraEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAllegra - "Tx MaryEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraMary - "Tx AlonzoEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo - "Tx BabbageEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraBabbage - "Tx ConwayEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraConway - "Witnessed Tx ShelleyEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraShelley - "Witnessed Tx AllegraEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAllegra - "Witnessed Tx MaryEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraMary - "Witnessed Tx AlonzoEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo - "Witnessed Tx BabbageEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraBabbage - "Witnessed Tx ConwayEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraConway - "Unwitnessed Tx ShelleyEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraShelley - "Unwitnessed Tx AllegraEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAllegra - "Unwitnessed Tx MaryEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraMary - "Unwitnessed Tx AlonzoEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo - "Unwitnessed Tx BabbageEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraBabbage - "Unwitnessed Tx ConwayEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraConway - "TxWitness ShelleyEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraShelley - "TxWitness AllegraEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAllegra - "TxWitness MaryEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraMary - "TxWitness AlonzoEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo - "TxWitness BabbageEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraBabbage - "TxWitness ConwayEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraConway - unknownCddlType -> Left $ TextEnvelopeCddlErrUnknownType unknownCddlType +cddlTypeToEra = + \case + "TxSignedShelley" -> return $ AnyShelleyBasedEra ShelleyBasedEraShelley + "Tx AllegraEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAllegra + "Tx MaryEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraMary + "Tx AlonzoEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo + "Tx BabbageEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraBabbage + "Tx ConwayEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraConway + "Witnessed Tx ShelleyEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraShelley + "Witnessed Tx AllegraEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAllegra + "Witnessed Tx MaryEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraMary + "Witnessed Tx AlonzoEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo + "Witnessed Tx BabbageEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraBabbage + "Witnessed Tx ConwayEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraConway + "Unwitnessed Tx ShelleyEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraShelley + "Unwitnessed Tx AllegraEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAllegra + "Unwitnessed Tx MaryEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraMary + "Unwitnessed Tx AlonzoEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo + "Unwitnessed Tx BabbageEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraBabbage + "Unwitnessed Tx ConwayEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraConway + "TxWitness ShelleyEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraShelley + "TxWitness AllegraEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAllegra + "TxWitness MaryEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraMary + "TxWitness AlonzoEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo + "TxWitness BabbageEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraBabbage + "TxWitness ConwayEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraConway + unknownCddlType -> Left $ TextEnvelopeCddlErrUnknownType unknownCddlType readFileTextEnvelopeCddlAnyOf :: [FromSomeTypeCDDL TextEnvelope b] diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs index 8e9689d3b..15356340d 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs @@ -10,10 +10,12 @@ module Test.Cardano.Api.CBOR where import Cardano.Api +import Cardano.Api.SerialiseLedgerCddl (cddlTypeToEra) import Cardano.Api.SerialiseTextEnvelope (TextEnvelopeDescr (TextEnvelopeDescr)) import Cardano.Api.Shelley (AsType (..)) import Data.Proxy (Proxy (..)) +import qualified Data.Text as T import Test.Gen.Cardano.Api.Typed @@ -188,6 +190,30 @@ prop_roundtrip_UpdateProposal_CBOR = H.property $ do proposal <- H.forAll $ genUpdateProposal era H.trippingCbor AsUpdateProposal proposal +prop_Tx_cddlTypeToEra :: Property +prop_Tx_cddlTypeToEra = H.property $ do + AnyShelleyBasedEra era <- H.noteShowM . H.forAll $ Gen.element [minBound .. maxBound] + x <- forAll $ genTx era + shelleyBasedEraConstraints era $ do + let TextEnvelopeType d = textEnvelopeType (proxyToAsType (getProxy x)) + H.note_ $ "Envelope type: " <> show d + cddlTypeToEra (T.pack d) H.=== Right (AnyShelleyBasedEra era) + where + getProxy :: forall a. a -> Proxy a + getProxy _ = Proxy + +prop_TxWitness_cddlTypeToEra :: Property +prop_TxWitness_cddlTypeToEra = H.property $ do + AnyShelleyBasedEra era <- H.noteShowM . H.forAll $ Gen.element [minBound .. maxBound] + x <- forAll $ genCardanoKeyWitness era + shelleyBasedEraConstraints era $ do + let TextEnvelopeType d = textEnvelopeType (proxyToAsType (getProxy x)) + H.note_ $ "Envelope type: " <> show d + cddlTypeToEra (T.pack d) H.=== Right (AnyShelleyBasedEra era) + where + getProxy :: forall a. a -> Proxy a + getProxy _ = Proxy + prop_roundtrip_Tx_Cddl :: Property prop_roundtrip_Tx_Cddl = H.property $ do AnyShelleyBasedEra era <- H.noteShowM . H.forAll $ Gen.element [minBound .. maxBound] @@ -281,6 +307,12 @@ tests = , testProperty "roundtrip script PlutusScriptV2 CBOR" prop_roundtrip_script_PlutusScriptV2_CBOR + , testProperty + "cddlTypeToEra for Tx types" + prop_Tx_cddlTypeToEra + , testProperty + "cddlTypeToEra for TxWitness types" + prop_TxWitness_cddlTypeToEra , testProperty "roundtrip UpdateProposal CBOR" prop_roundtrip_UpdateProposal_CBOR