Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Remove deprecated functions and update types and update writeTxFileTextEnvelopeCddl to use new format #746

Open
wants to merge 3 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 0 additions & 2 deletions cardano-api/src/Cardano/Api.hs
Original file line number Diff line number Diff line change
Expand Up @@ -736,8 +736,6 @@ module Cardano.Api
, deserialiseFromTextEnvelopeCddlAnyOf
, writeTxFileTextEnvelopeCddl
, writeTxWitnessFileTextEnvelopeCddl
, serialiseTxLedgerCddl
, deserialiseTxLedgerCddl
, deserialiseByronTxCddl
, serialiseWitnessLedgerCddl
, deserialiseWitnessLedgerCddl
Expand Down
56 changes: 14 additions & 42 deletions cardano-api/src/Cardano/Api/Internal/SerialiseLedgerCddl.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,8 +22,6 @@ module Cardano.Api.Internal.SerialiseLedgerCddl
, writeTxFileTextEnvelopeCddl
, writeTxWitnessFileTextEnvelopeCddl
-- Exported for testing
, serialiseTxLedgerCddl
, deserialiseTxLedgerCddl
, deserialiseByronTxCddl
, serialiseWitnessLedgerCddl
, deserialiseWitnessLedgerCddl
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down
87 changes: 59 additions & 28 deletions cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)

Expand All @@ -41,27 +41,64 @@ 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
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]
x <- H.forAll $ makeSignedTransaction [] . fst <$> genValidTxBody era
shelleyBasedEraConstraints
era
( H.tripping
x
(serialiseToTextEnvelope (Just (TextEnvelopeDescr "Ledger Cddl Format")))
palas marked this conversation as resolved.
Show resolved Hide resolved
(deserialiseTxLedgerCddl era)
(deserialiseFromTextEnvelope (shelleyBasedEraConstraints era $ proxyToAsType Proxy))
)

prop_roundtrip_txbody_CBOR :: Property
prop_roundtrip_txbody_CBOR = H.property $ do
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 $ makeSignedTransaction [] . fst <$> genValidTxBody era
H.tripping x (serialiseTxLedgerCddl era) (deserialiseTxLedgerCddl era)
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
Expand Down Expand Up @@ -215,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
Expand All @@ -224,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)
Expand All @@ -233,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)
Expand All @@ -242,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)
Expand Down Expand Up @@ -289,12 +326,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]
Expand All @@ -303,19 +334,22 @@ 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

-- -----------------------------------------------------------------------------

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 "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
"roundtrip operational certificate CBOR"
prop_roundtrip_operational_certificate_CBOR
Expand Down Expand Up @@ -404,9 +438,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
Expand Down
Loading