Make transaction view emit JSON

cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs

@@ -131,6 +131,8 @@ data TransactionCmds era
   | TxGetTxId
       InputTxBodyOrTxFile
   | TxView
+      TxViewOutputFormat
+      (Maybe (File () Out))
       InputTxBodyOrTxFile
 
 renderTransactionCmds :: TransactionCmds era -> Text

cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs

@@ -1560,6 +1560,18 @@ pPoolIdOutputFormat =
     , Opt.value IdOutputFormatBech32
     ]
 
+pTxViewOutputFormat :: Parser TxViewOutputFormat
+pTxViewOutputFormat =
+  Opt.option readTxViewOutputFormat $ mconcat
+    [ Opt.long "output-format"
+    , Opt.metavar "STRING"
+    , Opt.help $ mconcat
+      [ "Optional transaction view output format. Accepted output formats are \"json\" "
+      , "and \"yaml\" (default is \"json\")."
+      ]
+    , Opt.value TxViewOutputFormatJson
+    ]
+
 pMaybeOutputFile :: Parser (Maybe (File content Out))
 pMaybeOutputFile =
   optional $ fmap File $ Opt.strOption $ mconcat

cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs

@@ -276,4 +276,4 @@ pTransactionId  :: Parser (TransactionCmds era)
 pTransactionId = TxGetTxId <$> pInputTxOrTxBodyFile
 
 pTransactionView :: Parser (TransactionCmds era)
-pTransactionView = TxView <$> pInputTxOrTxBodyFile
+pTransactionView = TxView <$> pTxViewOutputFormat <*> pMaybeOutputFile <*> pInputTxOrTxBodyFile

cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs

@@ -33,7 +33,8 @@ import           Cardano.Api.Shelley
 
 import           Cardano.CLI.EraBased.Commands.Transaction
 import           Cardano.CLI.EraBased.Run.Genesis
-import           Cardano.CLI.Json.Friendly (friendlyTxBS, friendlyTxBodyBS)
+import           Cardano.CLI.Json.Friendly (friendlyTxBodyJson, friendlyTxBodyYaml, friendlyTxJson,
+                   friendlyTxYaml)
 import           Cardano.CLI.Read
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.BootstrapWitnessError
@@ -103,8 +104,8 @@ runTransactionCmds cmd =
       runTxHashScriptDataCmd scriptDataOrFile
     TxGetTxId txinfile ->
       runTxGetTxIdCmd txinfile
-    TxView txinfile ->
-      runTxViewCmd txinfile
+    TxView outFormat mOutFile txinfile ->
+      runTxViewCmd outFormat mOutFile txinfile
     TxMintedPolicyId sFile ->
       runTxCreatePolicyIdCmd sFile
     TxCreateWitness txBodyfile witSignData mbNw outFile ->
@@ -1173,9 +1174,11 @@ runTxGetTxIdCmd txfile = do
     liftIO $ BS.putStrLn $ serialiseToRawBytesHex (getTxId txbody)
 
 runTxViewCmd :: ()
-  => InputTxBodyOrTxFile
+  => TxViewOutputFormat
+  -> Maybe (File () Out)
+  -> InputTxBodyOrTxFile
   -> ExceptT TxCmdError IO ()
-runTxViewCmd = \case
+runTxViewCmd yamlOrJson mOutFile = \case
   InputTxBodyFile (File txbodyFilePath) -> do
     txbodyFile <- liftIO $ fileOrPipe txbodyFilePath
     unwitnessed <- firstExceptT TxCmdCddlError . newExceptT
@@ -1185,14 +1188,22 @@ runTxViewCmd = \case
         UnwitnessedCliFormattedTxBody anyTxBody -> pure anyTxBody
         IncompleteCddlFormattedTx (InAnyCardanoEra era tx) ->
           pure $ InAnyCardanoEra era (getTxBody tx)
-    --TODO: Why are we maintaining friendlyTxBodyBS and friendlyTxBS?
-    -- In the case of a transaction body, we can simply call makeSignedTransaction []
-    -- to get a transaction which allows us to reuse friendlyTxBS!
-    liftIO $ BS.putStr $ friendlyTxBodyBS era txbody
+    -- Why are we differentiating between a transaction body and a transaction?
+    -- In the case of a transaction body, we /could/ simply call @makeSignedTransaction []@
+    -- to get a transaction which would allow us to reuse friendlyTxBS. However,
+    -- this would mean that we'd have an empty list of witnesses mentioned in the output, which
+    -- is arguably not part of the transaction body.
+    firstExceptT TxCmdWriteFileError . newExceptT $
+      case yamlOrJson of
+        TxViewOutputFormatYaml -> friendlyTxBodyYaml mOutFile era txbody
+        TxViewOutputFormatJson -> friendlyTxBodyJson mOutFile era txbody
   InputTxFile (File txFilePath) -> do
     txFile <- liftIO $ fileOrPipe txFilePath
     InAnyCardanoEra era tx <- lift (readFileTx txFile) & onLeft (left . TxCmdCddlError)
-    liftIO $ BS.putStr $ friendlyTxBS era tx
+    firstExceptT TxCmdWriteFileError . newExceptT $
+      case yamlOrJson of
+        TxViewOutputFormatYaml -> friendlyTxYaml mOutFile era tx
+        TxViewOutputFormatJson -> friendlyTxJson mOutFile era tx
 
 
 -- ----------------------------------------------------------------------------

cardano-cli/src/Cardano/CLI/Json/Friendly.hs

@@ -11,7 +11,7 @@
 {-# LANGUAGE TypeOperators #-}
 
 -- | User-friendly pretty-printing for textual user interfaces (TUI)
-module Cardano.CLI.Json.Friendly (friendlyTxBS, friendlyTxBodyBS) where
+module Cardano.CLI.Json.Friendly (friendlyTxYaml, friendlyTxBodyYaml, friendlyTxJson, friendlyTxBodyJson) where
 
 import           Cardano.Api as Api
 import           Cardano.Api.Byron (KeyWitness (ByronKeyWitness))
@@ -29,7 +29,6 @@ import           Data.Aeson (Value (..), object, toJSON, (.=))
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Key as Aeson
 import qualified Data.Aeson.Types as Aeson
-import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as BSC
 import           Data.Char (isAscii)
 import           Data.Function ((&))
@@ -43,12 +42,58 @@ import           Data.Yaml.Pretty (setConfCompare)
 import qualified Data.Yaml.Pretty as Yaml
 import           GHC.Real (denominator)
 import           GHC.Unicode (isAlphaNum)
+import qualified Data.Aeson.Encode.Pretty as Aeson
+import Control.Monad.Trans (MonadIO)
+
+jsonConfig :: Aeson.Config
+jsonConfig = Aeson.defConfig {Aeson.confCompare = compare}
+
+friendlyTxJson ::
+  (MonadIO m, IsCardanoEra era)
+  => Maybe (File () Out)
+  -> CardanoEra era
+  -> Tx era
+  -> m (Either (FileError e) ())
+friendlyTxJson mOutFile era = writeLazyByteStringOutput mOutFile .
+  Aeson.encodePretty' jsonConfig .
+  object .
+  friendlyTx era
+
+friendlyTxBodyJson ::
+  (MonadIO m, IsCardanoEra era)
+  => Maybe (File () Out)
+  -> CardanoEra era
+  -> TxBody era
+  -> m (Either (FileError e) ())
+friendlyTxBodyJson mOutFile era = writeLazyByteStringOutput mOutFile .
+  Aeson.encodePretty' jsonConfig .
+  object .
+  friendlyTxBody era
 
 yamlConfig :: Yaml.Config
 yamlConfig = Yaml.defConfig & setConfCompare compare
 
-friendlyTxBS :: IsCardanoEra era => CardanoEra era -> Tx era -> ByteString
-friendlyTxBS era = Yaml.encodePretty yamlConfig . object . friendlyTx era
+friendlyTxYaml ::
+  (MonadIO m, IsCardanoEra era)
+  => Maybe (File () Out)
+  -> CardanoEra era
+  -> Tx era
+  -> m (Either (FileError e) ())
+friendlyTxYaml mOutFile era = writeByteStringOutput mOutFile .
+  Yaml.encodePretty yamlConfig .
+  object .
+  friendlyTx era
+
+friendlyTxBodyYaml ::
+  (MonadIO m, IsCardanoEra era)
+  => Maybe (File () Out)
+  -> CardanoEra era
+  -> TxBody era
+  -> m (Either (FileError e) ())
+friendlyTxBodyYaml mOutFile era = writeByteStringOutput mOutFile .
+  Yaml.encodePretty yamlConfig .
+  object .
+  friendlyTxBody era
 
 friendlyTx :: IsCardanoEra era => CardanoEra era -> Tx era -> [Aeson.Pair]
 friendlyTx era (Tx body witnesses) =
@@ -64,10 +109,6 @@ friendlyKeyWitness =
       ShelleyKeyWitness _era (Shelley.WitVKey key signature) ->
         ["key" .= textShow key, "signature" .= textShow signature]
 
-friendlyTxBodyBS :: IsCardanoEra era => CardanoEra era -> TxBody era -> ByteString
-friendlyTxBodyBS era =
-  Yaml.encodePretty yamlConfig . object . friendlyTxBody era
-
 friendlyTxBody :: IsCardanoEra era => CardanoEra era -> TxBody era -> [Aeson.Pair]
 friendlyTxBody
   era

cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs

@@ -131,6 +131,8 @@ data LegacyTransactionCmds
   | TxGetTxId
       InputTxBodyOrTxFile
   | TxView
+      TxViewOutputFormat
+      (Maybe (File () Out))
       InputTxBodyOrTxFile
 
 renderLegacyTransactionCmds :: LegacyTransactionCmds -> Text

cardano-cli/src/Cardano/CLI/Legacy/Options.hs

@@ -668,7 +668,7 @@ pTransaction envCli =
   pTransactionId = TxGetTxId <$> pInputTxOrTxBodyFile
 
   pTransactionView :: Parser LegacyTransactionCmds
-  pTransactionView = TxView <$> pInputTxOrTxBodyFile
+  pTransactionView = TxView <$> pTxViewOutputFormat <*> pMaybeOutputFile <*> pInputTxOrTxBodyFile
 
 pNodeCmds :: Parser LegacyNodeCmds
 pNodeCmds =

cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs

@@ -48,8 +48,8 @@ runLegacyTransactionCmds cmd =
       runLegacyTxHashScriptDataCmd scriptDataOrFile
     TxGetTxId txinfile ->
       runLegacyTxGetTxIdCmd txinfile
-    TxView txinfile ->
-      runLegacyTxViewCmd txinfile
+    TxView yamlOrJson mOutFile txinfile ->
+      runLegacyTxViewCmd yamlOrJson mOutFile txinfile
     TxMintedPolicyId sFile ->
       runLegacyTxCreatePolicyIdCmd sFile
     TxCreateWitness txBodyfile witSignData mbNw outFile ->
@@ -158,7 +158,7 @@ runLegacyTxHashScriptDataCmd = runTxHashScriptDataCmd
 runLegacyTxGetTxIdCmd :: InputTxBodyOrTxFile -> ExceptT TxCmdError IO ()
 runLegacyTxGetTxIdCmd = runTxGetTxIdCmd
 
-runLegacyTxViewCmd :: InputTxBodyOrTxFile -> ExceptT TxCmdError IO ()
+runLegacyTxViewCmd :: TxViewOutputFormat -> Maybe (File () Out) -> InputTxBodyOrTxFile -> ExceptT TxCmdError IO ()
 runLegacyTxViewCmd = runTxViewCmd
 
 runLegacyTxCreateWitnessCmd :: ()

cardano-cli/src/Cardano/CLI/Parser.hs

@@ -5,6 +5,7 @@ module Cardano.CLI.Parser
   , readFractionAsRational
   , readKeyOutputFormat
   , readIdOutputFormat
+  , readTxViewOutputFormat
   , readRational
   , readRationalUnitInterval
   , readStringOfMaxLength
@@ -49,6 +50,18 @@ readKeyOutputFormat = do
         , ". Accepted output formats are \"text-envelope\" and \"bech32\"."
         ]
 
+readTxViewOutputFormat :: Opt.ReadM TxViewOutputFormat
+readTxViewOutputFormat = do
+  s <- Opt.str @String
+  case s of
+    "json" -> pure TxViewOutputFormatJson
+    "yaml" -> pure TxViewOutputFormatYaml
+    _ ->
+      fail $ mconcat
+        [ "Invalid transaction view output format: " <> show s
+        , ". Accepted output formats are \"json\" and \"yaml\"."
+        ]
+
 readURIOfMaxLength :: Int -> Opt.ReadM Text
 readURIOfMaxLength maxLen =
   Text.pack <$> readStringOfMaxLength maxLen

cardano-cli/src/Cardano/CLI/Types/Common.hs

@@ -68,6 +68,7 @@ module Cardano.CLI.Types.Common
   , TxOutCount(..)
   , TxOutDatumAnyEra (..)
   , TxShelleyWitnessCount(..)
+  , TxViewOutputFormat(..)
   , UpdateProposalFile (..)
   , VerificationKeyBase64(..)
   , VerificationKeyFile
@@ -431,6 +432,11 @@ data TxMempoolQuery =
     | TxMempoolQueryInfo
   deriving Show
 
+data TxViewOutputFormat
+  = TxViewOutputFormatJson
+  | TxViewOutputFormatYaml
+  deriving Show
+
 --
 -- Shelley CLI flag/option data types
 --