Merge #4303

4303: Deprecate intermediate txbody format r=Jimbo4350 a=Jimbo4350 - You can no longer create tx bodies with the cli's intermediate format. - The flags `--cddl-format` and `--cli-format` are no longer available, we default to the CDDL format closes [#4277](#4277) Co-authored-by: Jordan Millar <jordan.millar@iohk.io>
IntersectMBO · Sep 22, 2022 · 15f2160 · 15f2160
2 parents 002e0ca + 6e0052b
commit 15f2160
Show file tree

Hide file tree

Showing 25 changed files with 183 additions and 102 deletions.
diff --git a/cardano-api/gen/Gen/Hedgehog/Roundtrip/CBOR.hs b/cardano-api/gen/Gen/Hedgehog/Roundtrip/CBOR.hs
@@ -2,6 +2,7 @@
 
 module Gen.Hedgehog.Roundtrip.CBOR
   ( roundtrip_CBOR
+  , roundtrip_CDDL_Tx
   ) where
 
 import           Cardano.Api
@@ -19,3 +20,11 @@ roundtrip_CBOR typeProxy gen =
   H.property $ do
     val <- H.forAll gen
     H.tripping val serialiseToCBOR (deserialiseFromCBOR typeProxy)
+
+
+roundtrip_CDDL_Tx
+  :: IsCardanoEra era => CardanoEra era -> Gen (Tx era) -> Property
+roundtrip_CDDL_Tx era gen =
+  H.property $ do
+    val <- H.forAll gen
+    H.tripping val serialiseTxLedgerCddl (deserialiseTxLedgerCddl era)
diff --git a/cardano-api/src/Cardano/Api/Error.hs b/cardano-api/src/Cardano/Api/Error.hs
@@ -48,7 +48,7 @@ data FileError e = FileError   FilePath e
                      -- ^ Temporary path
                      Handle
                  | FileIOError FilePath IOException
-  deriving Show
+  deriving (Show, Eq)
 
 instance Error e => Error (FileError e) where
   displayError (FileErrorTempFile targetPath tempPath h)=

diff --git a/cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs b/cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs
@@ -115,7 +115,7 @@ instance Error TextEnvelopeCddlError where
        <> List.intercalate ", " (map Text.unpack expTypes)
        <> " Actual: " <> Text.unpack actType
   displayError (TextEnvelopeCddlErrUnknownType unknownType) =
-    "Unknown TextEnvelopeCddl type:" <> Text.unpack unknownType
+    "Unknown TextEnvelopeCddl type: " <> Text.unpack unknownType
   displayError TextEnvelopeCddlErrByronKeyWitnessUnsupported =
     "TextEnvelopeCddl error: Byron key witnesses are currently unsupported."
 
@@ -132,7 +132,6 @@ serialiseTxLedgerCddl tx =
   genType tx' = case getTxWitnesses tx' of
                   [] -> "Unwitnessed " <> genTxType
                   _ -> "Witnessed " <> genTxType
-
   genTxType :: Text
   genTxType =
     case cardanoEra :: CardanoEra era of

diff --git a/cardano-api/src/Cardano/Api/Tx.hs b/cardano-api/src/Cardano/Api/Tx.hs
@@ -29,6 +29,7 @@ module Cardano.Api.Tx (
     toShelleySigningKey,
     signByronTransaction,
     signShelleyTransaction,
+
     -- ** Incremental signing and separate witnesses
     makeSignedTransaction,
     KeyWitness(..),
@@ -57,7 +58,9 @@ import qualified Data.ByteString.Lazy as LBS
 import           Data.Functor.Identity (Identity)
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
+import           Data.Type.Equality (TestEquality (..), (:~:) (Refl))
 import qualified Data.Vector as Vector
+
 --
 -- Common types, consensus, network
 --
@@ -127,6 +130,16 @@ data Tx era where
        -> Ledger.Tx (ShelleyLedgerEra era)
        -> Tx era
 
+
+instance Show (InAnyCardanoEra Tx) where
+    show (InAnyCardanoEra _ tx) = show tx
+
+instance Eq (InAnyCardanoEra Tx) where
+    (==) (InAnyCardanoEra eraA txA) (InAnyCardanoEra eraB txB) =
+      case testEquality eraA eraB of
+        Nothing -> False
+        Just Refl -> txA == txB
+
 -- The GADT in the ShelleyTx case requires a custom instance
 instance Eq (Tx era) where
     (==) (ByronTx txA)

diff --git a/cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs b/cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs
@@ -8,9 +8,9 @@ module Test.Cardano.Api.Typed.CBOR
 
 import           Cardano.Api
 import           Cardano.Prelude
-import           Data.String (IsString(..))
+import           Data.String (IsString (..))
 import           Gen.Cardano.Api.Typed
-import           Gen.Hedgehog.Roundtrip.CBOR (roundtrip_CBOR)
+import           Gen.Hedgehog.Roundtrip.CBOR (roundtrip_CBOR, roundtrip_CDDL_Tx)
 import           Hedgehog (Property, forAll, property, success, tripping)
 import           Test.Cardano.Api.Typed.Orphans ()
 import           Test.Tasty (TestTree, testGroup)
@@ -24,14 +24,14 @@ import           Test.Tasty.Hedgehog (testPropertyNamed)
 test_roundtrip_txbody_CBOR :: [TestTree]
 test_roundtrip_txbody_CBOR =
   [ testPropertyNamed (show era) (fromString (show era)) $
-    roundtrip_CBOR (proxyToAsType Proxy) (genTxBody era)
-  | AnyCardanoEra era <- [minBound..(AnyCardanoEra AlonzoEra)] -- TODO: Babbage era
+    roundtrip_CDDL_Tx era (makeSignedTransaction [] <$> genTxBody era)
+  | AnyCardanoEra era <- [minBound..(AnyCardanoEra BabbageEra)]
   ]
 
 test_roundtrip_tx_CBOR :: [TestTree]
 test_roundtrip_tx_CBOR =
   [ testPropertyNamed (show era) (fromString (show era)) $ roundtrip_CBOR (proxyToAsType Proxy) (genTx era)
-  | AnyCardanoEra era <- [minBound..(AnyCardanoEra AlonzoEra)] -- TODO: Babbage era
+  | AnyCardanoEra era <- [minBound..(AnyCardanoEra BabbageEra)]
   ]
 
 prop_roundtrip_witness_byron_CBOR :: Property

diff --git a/cardano-cli/ChangeLog.md b/cardano-cli/ChangeLog.md
@@ -2,6 +2,8 @@
 
 ## vNext
 
+Default to the ledger's CDDL format for transaction body creation by removing flags `--cddl-format` and `--cli-format` from `build` and `build-raw` ([PR 4303](https://github.com/input-output-hk/cardano-node/pull/4303))
+
 ### Bugs
 
 - Allow reading signing keys from a pipe ([PR 4342](https://github.com/input-output-hk/cardano-node/pull/4342))

diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal
@@ -194,6 +194,7 @@ test-suite cardano-cli-test
                       , yaml
 
   other-modules:        Test.Config.Mainnet
+                        Test.Cli.CliIntermediateFormat
                         Test.Cli.FilePermissions
                         Test.Cli.ITN
                         Test.Cli.JSON

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs
@@ -190,7 +190,6 @@ data TransactionCmd
       [MetadataFile]
       (Maybe ProtocolParamsSourceSpec)
       (Maybe UpdateProposalFile)
-      OutputSerialisation
       TxBodyFile
 
     -- | Like 'TxBuildRaw' but without the fee, and with a change output.
@@ -233,7 +232,6 @@ data TransactionCmd
       [MetadataFile]
       (Maybe ProtocolParamsSourceSpec)
       (Maybe UpdateProposalFile)
-      OutputSerialisation
       TxBuildOutputOptions
   | TxSign InputTxBodyOrTxFile [WitnessSigningData] (Maybe NetworkId) TxFile
   | TxCreateWitness TxBodyFile WitnessSigningData (Maybe NetworkId) OutputFile

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs
@@ -718,7 +718,6 @@ pTransaction =
             <*> many pMetadataFile
             <*> optional pProtocolParamsSourceSpec
             <*> optional pUpdateProposalFile
-            <*> pOutputSerialisation
             <*> (OutputTxBodyOnly <$> pTxBodyFile Output <|> pCalculatePlutusScriptCost)
 
   pChangeAddress :: Parser TxOutChangeAddress
@@ -755,7 +754,6 @@ pTransaction =
                <*> many pMetadataFile
                <*> optional pProtocolParamsSourceSpec
                <*> optional pUpdateProposalFile
-               <*> pOutputSerialisation
                <*> pTxBodyFile Output
 
   pTransactionSign  :: Parser TransactionCmd
@@ -1768,17 +1766,6 @@ pOutputFormat =
     <> Opt.value OutputFormatBech32
     )
 
-pOutputSerialisation :: Parser OutputSerialisation
-pOutputSerialisation =
-  Opt.flag' OutputLedgerCDDLSerialisation
-    (  Opt.long "cddl-format"
-    <> Opt.help "Serialise in the ledger CDDL specified CBOR format."
-    ) <|>
-  Opt.flag OutputCliSerialisation OutputCliSerialisation
-    (  Opt.long "cli-format"
-    <> Opt.help "Serialise in the cardano-cli CBOR format."
-    )
-
 pMaybeOutputFile :: Parser (Maybe OutputFile)
 pMaybeOutputFile =
   optional $

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs
@@ -12,6 +12,7 @@ module Cardano.CLI.Shelley.Run.Transaction
   ( ShelleyTxCmdError(..)
   , renderShelleyTxCmdError
   , runTransactionCmd
+  , readCddlTx
   , readFileTx
   , readProtocolParametersSourceSpec
   , toTxOutInAnyEra
@@ -317,17 +318,17 @@ runTransactionCmd cmd =
     TxBuild era consensusModeParams nid mScriptValidity mOverrideWits txins readOnlyRefIns
             reqSigners txinsc mReturnColl mTotCollateral txouts changeAddr mValue mLowBound
             mUpperBound certs wdrls metadataSchema scriptFiles metadataFiles mpparams
-            mUpProp outputFormat output ->
+            mUpProp output ->
       runTxBuild era consensusModeParams nid mScriptValidity txins readOnlyRefIns txinsc
                  mReturnColl mTotCollateral txouts changeAddr mValue mLowBound
                  mUpperBound certs wdrls reqSigners metadataSchema scriptFiles
-                 metadataFiles mpparams mUpProp outputFormat mOverrideWits output
+                 metadataFiles mpparams mUpProp mOverrideWits output
     TxBuildRaw era mScriptValidity txins readOnlyRefIns txinsc mReturnColl mTotColl reqSigners
                txouts mValue mLowBound mUpperBound fee certs wdrls metadataSchema scriptFiles
-               metadataFiles mpparams mUpProp outputFormat out ->
+               metadataFiles mpparams mUpProp out ->
       runTxBuildRaw era mScriptValidity txins readOnlyRefIns txinsc mReturnColl mTotColl txouts
                     mLowBound mUpperBound fee mValue certs wdrls reqSigners metadataSchema
-                    scriptFiles metadataFiles mpparams mUpProp outputFormat out
+                    scriptFiles metadataFiles mpparams mUpProp out
     TxSign txinfile skfiles network txoutfile ->
       runTxSign txinfile skfiles network txoutfile
     TxSubmit anyConensusModeParams network txFp ->
@@ -383,7 +384,6 @@ runTxBuildRaw
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
-  -> OutputSerialisation
   -> TxBodyFile
   -> ExceptT ShelleyTxCmdError IO ()
 runTxBuildRaw (AnyCardanoEra era)
@@ -395,7 +395,6 @@ runTxBuildRaw (AnyCardanoEra era)
               certFiles withdrawals reqSigners
               metadataSchema scriptFiles
               metadataFiles mpparams mUpdatePropFile
-              outputFormat
               (TxBodyFile fpath) = do
 
     allReferenceInputs
@@ -426,14 +425,10 @@ runTxBuildRaw (AnyCardanoEra era)
     txBody <-
       firstExceptT ShelleyTxCmdTxBodyError . hoistEither $
         makeTransactionBody txBodyContent
-    case outputFormat of
-      OutputCliSerialisation ->
-        firstExceptT ShelleyTxCmdWriteFileError . newExceptT $
-          writeFileTextEnvelope fpath Nothing txBody
-      OutputLedgerCDDLSerialisation ->
-        let noWitTx = makeSignedTransaction [] txBody
-        in firstExceptT ShelleyTxCmdWriteFileError . newExceptT $
-             writeTxFileTextEnvelopeCddl fpath noWitTx
+
+    let noWitTx = makeSignedTransaction [] txBody
+    firstExceptT ShelleyTxCmdWriteFileError . newExceptT $
+      writeTxFileTextEnvelopeCddl fpath noWitTx
 
 getSbe :: Monad m => CardanoEraStyle era -> ExceptT ShelleyTxCmdError m (Api.ShelleyBasedEra era)
 getSbe LegacyByronEra = left ShelleyTxCmdByronEra
@@ -490,14 +485,13 @@ runTxBuild
   -> [MetadataFile]
   -> Maybe ProtocolParamsSourceSpec
   -> Maybe UpdateProposalFile
-  -> OutputSerialisation
   -> Maybe Word
   -> TxBuildOutputOptions
   -> ExceptT ShelleyTxCmdError IO ()
 runTxBuild (AnyCardanoEra era) (AnyConsensusModeParams cModeParams) networkId mScriptValidity
            txins readOnlyRefIns txinsc mReturnCollateral mtotcoll txouts (TxOutChangeAddress changeAddr) mValue mLowerBound mUpperBound
            certFiles withdrawals reqSigners metadataSchema scriptFiles metadataFiles mpparams
-           mUpdatePropFile outputFormat mOverrideWits outputOptions = do
+           mUpdatePropFile mOverrideWits outputOptions = do
   SocketPath sockPath <- firstExceptT ShelleyTxCmdSocketEnvError readEnvSocketPath
   let localNodeConnInfo = LocalNodeConnectInfo cModeParams networkId sockPath
       consensusMode = consensusModeOnly cModeParams
@@ -594,14 +588,9 @@ runTxBuild (AnyCardanoEra era) (AnyConsensusModeParams cModeParams) networkId mS
 
             Nothing -> left ShelleyTxCmdPParamExecutionUnitsNotAvailable
         OutputTxBodyOnly (TxBodyFile fpath)  ->
-          case outputFormat of
-            OutputCliSerialisation ->
-              firstExceptT ShelleyTxCmdWriteFileError . newExceptT $
-                writeFileTextEnvelope fpath Nothing balancedTxBody
-            OutputLedgerCDDLSerialisation ->
-              let noWitTx = makeSignedTransaction [] balancedTxBody
-              in firstExceptT ShelleyTxCmdWriteFileError . newExceptT $
-                   writeTxFileTextEnvelopeCddl fpath noWitTx
+          let noWitTx = makeSignedTransaction [] balancedTxBody
+          in firstExceptT ShelleyTxCmdWriteFileError . newExceptT $
+               writeTxFileTextEnvelopeCddl fpath noWitTx
 
     (CardanoMode, LegacyByronEra) -> left ShelleyTxCmdByronEra
 
@@ -1286,7 +1275,7 @@ runTxSign txOrTxBody witSigningData mnw (TxFile outTxFile) = do
           signedTx = makeSignedTransaction allKeyWits txbody
 
       firstExceptT ShelleyTxCmdWriteFileError . newExceptT $
-        writeFileTextEnvelope outTxFile Nothing signedTx
+        writeTxFileTextEnvelopeCddl outTxFile signedTx
 
     (InputTxBodyFile (TxBodyFile txbodyFile)) -> do
       unwitnessed <- readFileTxBody txbodyFile
@@ -1838,10 +1827,29 @@ readFileWitness fp =
 -- (respectively needs additional witnesses or totally unwitnessed)
 -- while UnwitnessedCliFormattedTxBody is CLI formatted TxBody and
 -- needs to be key witnessed.
+
 data IncompleteTx
   = UnwitnessedCliFormattedTxBody (InAnyCardanoEra TxBody)
   | IncompleteCddlFormattedTx (InAnyCardanoEra Tx)
 
+
+readCddlTx :: FilePath -> IO (Either (FileError TextEnvelopeCddlError) CddlTx)
+readCddlTx = readFileTextEnvelopeCddlAnyOf teTypes
+ where
+    teTypes = [ FromCDDLTx "Witnessed Tx ByronEra" CddlTx
+              , FromCDDLTx "Witnessed Tx ShelleyEra" CddlTx
+              , FromCDDLTx "Witnessed Tx AllegraEra" CddlTx
+              , FromCDDLTx "Witnessed Tx MaryEra" CddlTx
+              , FromCDDLTx "Witnessed Tx AlonzoEra" CddlTx
+              , FromCDDLTx "Witnessed Tx BabbageEra" CddlTx
+              , FromCDDLTx "Unwitnessed Tx ByronEra" CddlTx
+              , FromCDDLTx "Unwitnessed Tx ShelleyEra" CddlTx
+              , FromCDDLTx "Unwitnessed Tx AllegraEra" CddlTx
+              , FromCDDLTx "Unwitnessed Tx MaryEra" CddlTx
+              , FromCDDLTx "Unwitnessed Tx AlonzoEra" CddlTx
+              , FromCDDLTx "Unwitnessed Tx BabbageEra" CddlTx
+              ]
+
 readFileTxBody :: FilePath -> ExceptT ShelleyTxCmdError IO IncompleteTx
 readFileTxBody fp =
   handleLeftT
@@ -1887,7 +1895,6 @@ readFileTx fp =
     (\e -> unCddlTx <$> acceptTxCDDLSerialisation e)
     (readFileInAnyCardanoEra AsTx fp)
 
-
 readFileInAnyCardanoEra
   :: ( HasTextEnvelope (thing ByronEra)
      , HasTextEnvelope (thing ShelleyEra)

diff --git a/cardano-cli/src/Cardano/CLI/Types.hs b/cardano-cli/src/Cardano/CLI/Types.hs
@@ -19,7 +19,6 @@ module Cardano.CLI.Types
   , OpCertNodeStateCounter (..)
   , OpCertStartingKesPeriod (..)
   , OutputFormat (..)
-  , OutputSerialisation (..)
   , TxBuildOutputOptions(..)
   , ReferenceScriptAnyEra (..)
   , SigningKeyFile (..)
@@ -76,7 +75,7 @@ data CBORObject = CBORBlockByron Byron.EpochSlots
                 | CBORVoteByron
                 deriving Show
 
-newtype CddlTx = CddlTx {unCddlTx :: InAnyCardanoEra Tx}
+newtype CddlTx = CddlTx {unCddlTx :: InAnyCardanoEra Tx} deriving (Show, Eq)
 
 -- Encompasses stake certificates, stake pool certificates,
 -- genesis delegate certificates and MIR certificates.
@@ -186,14 +185,6 @@ data OutputFormat
   | OutputFormatBech32
   deriving (Eq, Show)
 
--- | Specify whether to serialise a value according to the ledger's CDDL spec
--- or the cli's intermediate format. Note the intermediate format is defined
--- within SerialiseAsCBOR instances. The plan is to merge TextEnvelope with
--- SerialiseAsCBOR.
-data OutputSerialisation
-  = OutputLedgerCDDLSerialisation
-  | OutputCliSerialisation
-  deriving Show
 
 -- | This data structure is used to allow nicely formatted output within the query stake-snapshot command.
 --