Merge pull request #746 from IntersectMBO/remove-deprecated-functions

Remove deprecated functions and update types and update `writeTxFileTextEnvelopeCddl` to use new format

Author: palas

cardano-api/src/Cardano/Api.hs

@@ -736,8 +736,6 @@ module Cardano.Api
   , deserialiseFromTextEnvelopeCddlAnyOf
   , writeTxFileTextEnvelopeCddl
   , writeTxWitnessFileTextEnvelopeCddl
-  , serialiseTxLedgerCddl
-  , deserialiseTxLedgerCddl
   , deserialiseByronTxCddl
   , serialiseWitnessLedgerCddl
   , deserialiseWitnessLedgerCddl

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.

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,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")))
-        (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
@@ -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
@@ -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)
@@ -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)
@@ -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)
@@ -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]
@@ -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
@@ -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