From 8a70e1c8d5c14e47b9568493975444a9e5fb4804 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 4 Feb 2025 14:03:50 +0100 Subject: [PATCH 1/3] Remove deprecated functions and update types and update `serialiseTxLedgerCddl` --- cardano-api/src/Cardano/Api.hs | 2 - .../Api/Internal/SerialiseLedgerCddl.hs | 56 +++++-------------- .../cardano-api-test/Test/Cardano/Api/CBOR.hs | 32 ----------- 3 files changed, 14 insertions(+), 76 deletions(-) diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index f141620f6b..06353dac01 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -736,8 +736,6 @@ module Cardano.Api , deserialiseFromTextEnvelopeCddlAnyOf , writeTxFileTextEnvelopeCddl , writeTxWitnessFileTextEnvelopeCddl - , serialiseTxLedgerCddl - , deserialiseTxLedgerCddl , deserialiseByronTxCddl , serialiseWitnessLedgerCddl , deserialiseWitnessLedgerCddl diff --git a/cardano-api/src/Cardano/Api/Internal/SerialiseLedgerCddl.hs b/cardano-api/src/Cardano/Api/Internal/SerialiseLedgerCddl.hs index f491454ae9..6b187972e9 100644 --- a/cardano-api/src/Cardano/Api/Internal/SerialiseLedgerCddl.hs +++ b/cardano-api/src/Cardano/Api/Internal/SerialiseLedgerCddl.hs @@ -22,8 +22,6 @@ module Cardano.Api.Internal.SerialiseLedgerCddl , writeTxFileTextEnvelopeCddl , writeTxWitnessFileTextEnvelopeCddl -- Exported for testing - , serialiseTxLedgerCddl - , deserialiseTxLedgerCddl , deserialiseByronTxCddl , serialiseWitnessLedgerCddl , deserialiseWitnessLedgerCddl @@ -122,46 +120,6 @@ instance Error TextEnvelopeCddlError where TextEnvelopeCddlErrByronKeyWitnessUnsupported -> "TextEnvelopeCddl error: Byron key witnesses are currently unsupported." -{-# DEPRECATED - serialiseTxLedgerCddl - "Use 'serialiseToTextEnvelope' from 'Cardano.Api.Internal.SerialiseTextEnvelope' instead." - #-} -serialiseTxLedgerCddl :: ShelleyBasedEra era -> Tx era -> TextEnvelope -serialiseTxLedgerCddl era tx = - shelleyBasedEraConstraints era $ - (serialiseToTextEnvelope (Just (TextEnvelopeDescr "Ledger Cddl Format")) tx) - { teType = TextEnvelopeType $ T.unpack $ genType tx - } - where - genType :: Tx era -> Text - genType tx' = case getTxWitnesses tx' of - [] -> "Unwitnessed " <> genTxType - _ -> "Witnessed " <> genTxType - genTxType :: Text - genTxType = - case era of - ShelleyBasedEraShelley -> "Tx ShelleyEra" - ShelleyBasedEraAllegra -> "Tx AllegraEra" - ShelleyBasedEraMary -> "Tx MaryEra" - ShelleyBasedEraAlonzo -> "Tx AlonzoEra" - ShelleyBasedEraBabbage -> "Tx BabbageEra" - ShelleyBasedEraConway -> "Tx ConwayEra" - -{-# DEPRECATED - deserialiseTxLedgerCddl - "Use 'deserialiseFromTextEnvelope' from 'Cardano.Api.Internal.SerialiseTextEnvelope' instead." - #-} -deserialiseTxLedgerCddl - :: forall era - . ShelleyBasedEra era - -> TextEnvelope - -> Either TextEnvelopeError (Tx era) -deserialiseTxLedgerCddl era = - shelleyBasedEraConstraints era $ deserialiseFromTextEnvelope asType - where - asType :: AsType (Tx era) - asType = shelleyBasedEraConstraints era $ proxyToAsType Proxy - writeByronTxFileTextEnvelopeCddl :: File content Out -> Byron.ATxAux ByteString @@ -254,6 +212,11 @@ writeTxFileTextEnvelopeCddl era path tx = where txJson = encodePretty' textEnvelopeCddlJSONConfig (serialiseTxLedgerCddl era tx) <> "\n" + serialiseTxLedgerCddl :: ShelleyBasedEra era -> Tx era -> TextEnvelope + serialiseTxLedgerCddl era' tx' = + shelleyBasedEraConstraints era' $ + serialiseToTextEnvelope (Just (TextEnvelopeDescr "Ledger Cddl Format")) tx' + writeTxWitnessFileTextEnvelopeCddl :: ShelleyBasedEra era -> File () Out @@ -312,6 +275,15 @@ deserialiseFromTextEnvelopeCddlAnyOf types teCddl = matching (FromCDDLTx ttoken _f) = TextEnvelopeType (T.unpack ttoken) `legacyComparison` teType teCddl matching (FromCDDLWitness ttoken _f) = TextEnvelopeType (T.unpack ttoken) `legacyComparison` teType teCddl + deserialiseTxLedgerCddl + :: forall era + . ShelleyBasedEra era + -> TextEnvelope + -> Either TextEnvelopeError (Tx era) + deserialiseTxLedgerCddl era = + shelleyBasedEraConstraints era $ + deserialiseFromTextEnvelope (shelleyBasedEraConstraints era $ proxyToAsType Proxy) + -- Parse the text into types because this will increase code readability and -- will make it easier to keep track of the different Cddl descriptions via -- a single sum data type. 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 0af8d3144b..19d469b7cc 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 @@ -13,7 +13,6 @@ where import Cardano.Api import Cardano.Api.Internal.Script import Cardano.Api.Internal.SerialiseLedgerCddl (cddlTypeToEra) -import Cardano.Api.Internal.SerialiseTextEnvelope (TextEnvelopeDescr (TextEnvelopeDescr)) import Cardano.Api.Shelley (AsType (..)) import qualified Data.ByteString.Base16 as Base16 @@ -41,28 +40,6 @@ 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] - 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] - x <- H.forAll $ makeSignedTransaction [] . fst <$> genValidTxBody era - H.tripping x (serialiseTxLedgerCddl era) (deserialiseTxLedgerCddl era) - prop_roundtrip_tx_CBOR :: Property prop_roundtrip_tx_CBOR = H.property $ do AnyShelleyBasedEra era <- H.noteShowM . H.forAll $ Gen.element [minBound .. maxBound] @@ -289,12 +266,6 @@ prop_TxWitness_cddlTypeToEra = H.property $ do 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] - x <- forAll $ genTx era - H.tripping x (serialiseTxLedgerCddl era) (deserialiseTxLedgerCddl era) - prop_roundtrip_TxWitness_Cddl :: Property prop_roundtrip_TxWitness_Cddl = H.property $ do AnyShelleyBasedEra sbe <- H.noteShowM . H.forAll $ Gen.element [minBound .. maxBound] @@ -404,9 +375,6 @@ 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 , testProperty "roundtrip tx CBOR" prop_roundtrip_tx_CBOR , testProperty From fb5de89bc18954e2792acac2355bc815f87e67d8 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 11 Feb 2025 17:56:14 +0100 Subject: [PATCH 2/3] Add tests for text envelope roundtrip --- .../cardano-api-test/Test/Cardano/Api/CBOR.hs | 29 ++++++++++++++++++- 1 file changed, 28 insertions(+), 1 deletion(-) 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 19d469b7cc..312eb774b6 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 @@ -13,6 +13,7 @@ where import Cardano.Api import Cardano.Api.Internal.Script import Cardano.Api.Internal.SerialiseLedgerCddl (cddlTypeToEra) +import Cardano.Api.Internal.SerialiseTextEnvelope (TextEnvelopeDescr (TextEnvelopeDescr)) import Cardano.Api.Shelley (AsType (..)) import qualified Data.ByteString.Base16 as Base16 @@ -40,6 +41,30 @@ 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_text_envelope_roundtrip_txbody_CBOR :: Property +prop_text_envelope_roundtrip_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"))) + (deserialiseFromTextEnvelope (shelleyBasedEraConstraints era $ proxyToAsType Proxy)) + ) + +prop_text_envelope_roundtrip_tx_CBOR :: Property +prop_text_envelope_roundtrip_tx_CBOR = H.property $ do + AnyShelleyBasedEra era <- H.noteShowM . H.forAll $ Gen.element [minBound .. maxBound] + x <- H.forAll $ genTx era + shelleyBasedEraConstraints + era + ( H.tripping + x + (serialiseToTextEnvelope (Just (TextEnvelopeDescr "Ledger Cddl Format"))) + (deserialiseFromTextEnvelope (shelleyBasedEraConstraints era $ proxyToAsType Proxy)) + ) + prop_roundtrip_tx_CBOR :: Property prop_roundtrip_tx_CBOR = H.property $ do AnyShelleyBasedEra era <- H.noteShowM . H.forAll $ Gen.element [minBound .. maxBound] @@ -286,7 +311,9 @@ tests :: TestTree tests = testGroup "Test.Cardano.Api.Typed.CBOR" - [ testProperty "roundtrip witness CBOR" prop_roundtrip_witness_CBOR + [ testProperty "rountrip txbody text envelope" prop_text_envelope_roundtrip_txbody_CBOR + , testProperty "rountrip tx text envelope" prop_text_envelope_roundtrip_tx_CBOR + , testProperty "roundtrip witness CBOR" prop_roundtrip_witness_CBOR , testProperty "roundtrip operational certificate CBOR" prop_roundtrip_operational_certificate_CBOR From 3a74bcbec32c0c8064df6e727f615ba1cd0a15af Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 13 Feb 2025 18:29:18 +0100 Subject: [PATCH 3/3] Add test for ensuring backwards compatibility --- .../cardano-api-test/Test/Cardano/Api/CBOR.hs | 50 ++++++++++++++++--- 1 file changed, 43 insertions(+), 7 deletions(-) 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 312eb774b6..6a18cbe255 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 @@ -20,6 +20,7 @@ import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Short as SBS import Data.Proxy (Proxy (..)) +import Data.Text (Text) import qualified Data.Text as T import Test.Gen.Cardano.Api.Hardcoded @@ -32,7 +33,6 @@ import qualified Hedgehog as H import qualified Hedgehog.Extras as H import qualified Hedgehog.Gen as Gen import qualified Test.Hedgehog.Roundtrip.CBOR as H -import Test.Hedgehog.Roundtrip.CBOR import Test.Tasty (TestTree, testGroup) import Test.Tasty.Hedgehog (testProperty) @@ -41,6 +41,41 @@ 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_txbody_backwards_compatibility :: Property +prop_txbody_backwards_compatibility = 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 + (serialiseTxLedgerCddl era) + (deserialiseFromTextEnvelope (shelleyBasedEraConstraints era $ proxyToAsType Proxy)) + ) + where + -- This is the old implementation of serialisation for txbodies, and it is + -- now deprecated. But we keep it here for testing for backwards compatibility. + serialiseTxLedgerCddl :: ShelleyBasedEra era -> Tx era -> TextEnvelope + serialiseTxLedgerCddl era tx = + shelleyBasedEraConstraints era $ + (serialiseToTextEnvelope (Just (TextEnvelopeDescr "Ledger Cddl Format")) tx) + { teType = TextEnvelopeType $ T.unpack $ genType tx + } + where + genType :: Tx era -> Text + genType tx' = case getTxWitnesses tx' of + [] -> "Unwitnessed " <> genTxType + _ -> "Witnessed " <> genTxType + genTxType :: Text + genTxType = + case era of + ShelleyBasedEraShelley -> "Tx ShelleyEra" + ShelleyBasedEraAllegra -> "Tx AllegraEra" + ShelleyBasedEraMary -> "Tx MaryEra" + ShelleyBasedEraAlonzo -> "Tx AlonzoEra" + ShelleyBasedEraBabbage -> "Tx BabbageEra" + ShelleyBasedEraConway -> "Tx ConwayEra" + prop_text_envelope_roundtrip_txbody_CBOR :: Property prop_text_envelope_roundtrip_txbody_CBOR = H.property $ do AnyShelleyBasedEra era <- H.noteShowM . H.forAll $ Gen.element [minBound .. maxBound] @@ -217,7 +252,7 @@ prop_roundtrip_non_double_encoded_always_succeeds_plutus_V3_CBOR = H.property $ prop_decode_only_double_wrapped_plutus_script_bytes_CBOR :: Property prop_decode_only_double_wrapped_plutus_script_bytes_CBOR = H.property $ do let alwaysSucceedsDoubleEncoded = Base16.decodeLenient "46450101002499" - decodeOnlyPlutusScriptBytes + H.decodeOnlyPlutusScriptBytes ShelleyBasedEraConway PlutusScriptV3 alwaysSucceedsDoubleEncoded @@ -226,7 +261,7 @@ prop_decode_only_double_wrapped_plutus_script_bytes_CBOR = H.property $ do prop_decode_only_wrapped_plutus_script_V1_CBOR :: Property prop_decode_only_wrapped_plutus_script_V1_CBOR = H.property $ do PlutusScriptSerialised shortBs <- H.forAll $ genPlutusScript PlutusScriptV1 - decodeOnlyPlutusScriptBytes + H.decodeOnlyPlutusScriptBytes ShelleyBasedEraConway PlutusScriptV1 (SBS.fromShort shortBs) @@ -235,7 +270,7 @@ prop_decode_only_wrapped_plutus_script_V1_CBOR = H.property $ do prop_decode_only_wrapped_plutus_script_V2_CBOR :: Property prop_decode_only_wrapped_plutus_script_V2_CBOR = H.property $ do PlutusScriptSerialised shortBs <- H.forAll $ genPlutusScript PlutusScriptV2 - decodeOnlyPlutusScriptBytes + H.decodeOnlyPlutusScriptBytes ShelleyBasedEraConway PlutusScriptV2 (SBS.fromShort shortBs) @@ -244,7 +279,7 @@ prop_decode_only_wrapped_plutus_script_V2_CBOR = H.property $ do prop_decode_only_wrapped_plutus_script_V3_CBOR :: Property prop_decode_only_wrapped_plutus_script_V3_CBOR = H.property $ do PlutusScriptSerialised shortBs <- H.forAll $ genPlutusScript PlutusScriptV3 - decodeOnlyPlutusScriptBytes + H.decodeOnlyPlutusScriptBytes ShelleyBasedEraConway PlutusScriptV3 (SBS.fromShort shortBs) @@ -299,11 +334,11 @@ prop_roundtrip_TxWitness_Cddl = H.property $ do prop_roundtrip_GovernancePoll_CBOR :: Property prop_roundtrip_GovernancePoll_CBOR = property $ do - trippingCbor AsGovernancePoll =<< forAll genGovernancePoll + H.trippingCbor AsGovernancePoll =<< forAll genGovernancePoll prop_roundtrip_GovernancePollAnswer_CBOR :: Property prop_roundtrip_GovernancePollAnswer_CBOR = property $ do - trippingCbor AsGovernancePollAnswer =<< forAll genGovernancePollAnswer + H.trippingCbor AsGovernancePollAnswer =<< forAll genGovernancePollAnswer -- ----------------------------------------------------------------------------- @@ -312,6 +347,7 @@ tests = testGroup "Test.Cardano.Api.Typed.CBOR" [ testProperty "rountrip txbody text envelope" prop_text_envelope_roundtrip_txbody_CBOR + , testProperty "txbody backwards compatibility" prop_txbody_backwards_compatibility , testProperty "rountrip tx text envelope" prop_text_envelope_roundtrip_tx_CBOR , testProperty "roundtrip witness CBOR" prop_roundtrip_witness_CBOR , testProperty