Merge pull request #611 from IntersectMBO/smelc/query-utxo-control-ou…

…tput-format

query utxo: add --output-[json,text] flag to control format of the output

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

@@ -127,6 +127,7 @@ data QueryUTxOCmdArgs = QueryUTxOCmdArgs
   , queryFilter         :: !QueryUTxOFilter
   , networkId           :: !NetworkId
   , target              :: !(Consensus.Target ChainPoint)
+  , format              :: Maybe QueryOutputFormat
   , mOutFile            :: !(Maybe (File () Out))
   } deriving (Generic, Show)
 

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

@@ -1589,6 +1589,25 @@ pPoolIdOutputFormat =
     , Opt.value IdOutputFormatBech32
     ]
 
+-- | @pQueryOutputFormat kind@ is a parser to specify in which format
+-- to view some data (json or text). @kind@ is the kind of data considered.
+pQueryOutputFormat :: String -> Parser QueryOutputFormat
+pQueryOutputFormat kind =
+  asum
+    [ make QueryOutputFormatJson "JSON" "json" (Just " Default format when writing to a file")
+    , make QueryOutputFormatText "TEXT" "text" (Just " Default format when writing to stdout")
+    ]
+  where
+    make format desc flag_ extraHelp =
+      -- Not using Opt.flag, because there is no default. We can't have
+      -- a default and preserve the historical behavior (that differed whether
+      -- an output file was specified or not).
+      Opt.flag' format $ mconcat
+      [ Opt.help $
+          "Format " <> kind <> " query output to " <> desc <> "."
+            <> fromMaybe "" extraHelp
+      , Opt.long ("output-" <> flag_)]
+
 pTxViewOutputFormat :: Parser ViewOutputFormat
 pTxViewOutputFormat = pViewOutputFormat "transaction"
 

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

@@ -143,6 +143,7 @@ pQueryUTxOCmd era envCli =
       <*> pQueryUTxOFilter
       <*> pNetworkId envCli
       <*> pTarget era
+      <*> (optional $ pQueryOutputFormat "utxo")
       <*> pMaybeOutputFile
 
 pQueryStakePoolsCmd :: CardanoEra era -> EnvCli -> Parser (QueryCmds era)

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

@@ -87,6 +87,7 @@ import           Data.Aeson as Aeson
 import qualified Data.Aeson as A
 import           Data.Aeson.Encode.Pretty (encodePretty)
 import           Data.Bifunctor (Bifunctor (..))
+import qualified Data.ByteString.Lazy as BS
 import qualified Data.ByteString.Lazy.Char8 as LBS
 import           Data.Coerce (coerce)
 import           Data.Function ((&))
@@ -333,6 +334,7 @@ runQueryUTxOCmd
     , Cmd.queryFilter
     , Cmd.networkId
     , Cmd.target
+    , Cmd.format
     , Cmd.mOutFile
     } = do
   let localNodeConnInfo = LocalNodeConnectInfo consensusModeParams networkId nodeSocketPath
@@ -350,7 +352,7 @@ runQueryUTxOCmd
           & onLeft (left . QueryCmdLocalStateQueryError . EraMismatchError)
 
         pure $ do
-          writeFilteredUTxOs sbe mOutFile utxo
+          writeFilteredUTxOs sbe format mOutFile utxo
     )
     & onLeft (left . QueryCmdAcquireFailure)
     & onLeft left
@@ -1017,103 +1019,98 @@ writeProtocolState sbe mOutFile ps@(ProtocolState pstate) =
         Right chainDepstate -> liftIO . LBS.putStrLn $ encodePretty chainDepstate
 
 writeFilteredUTxOs :: Api.ShelleyBasedEra era
+                   -> Maybe QueryOutputFormat
                    -> Maybe (File () Out)
                    -> UTxO era
                    -> ExceptT QueryCmdError IO ()
-writeFilteredUTxOs sbe mOutFile utxo =
-  case mOutFile of
-    Nothing -> liftIO $ printFilteredUTxOs sbe utxo
-    Just (File fpath) ->
-      case sbe of
-        ShelleyBasedEraShelley -> writeUTxo fpath utxo
-        ShelleyBasedEraAllegra -> writeUTxo fpath utxo
-        ShelleyBasedEraMary -> writeUTxo fpath utxo
-        ShelleyBasedEraAlonzo -> writeUTxo fpath utxo
-        ShelleyBasedEraBabbage -> writeUTxo fpath utxo
-        ShelleyBasedEraConway -> writeUTxo fpath utxo
- where
-   writeUTxo fpath utxo' =
-     handleIOExceptT (QueryCmdWriteFileError . FileIOError fpath)
-       $ LBS.writeFile fpath (encodePretty utxo')
-
-printFilteredUTxOs :: Api.ShelleyBasedEra era -> UTxO era -> IO ()
-printFilteredUTxOs sbe (UTxO utxo) = do
-  Text.putStrLn title
-  putStrLn $ replicate (Text.length title + 2) '-'
-  case sbe of
-    ShelleyBasedEraShelley ->
-      mapM_ (printUtxo sbe) $ Map.toList utxo
-    ShelleyBasedEraAllegra ->
-      mapM_ (printUtxo sbe) $ Map.toList utxo
-    ShelleyBasedEraMary    ->
-      mapM_ (printUtxo sbe) $ Map.toList utxo
-    ShelleyBasedEraAlonzo ->
-      mapM_ (printUtxo sbe) $ Map.toList utxo
-    ShelleyBasedEraBabbage ->
-      mapM_ (printUtxo sbe) $ Map.toList utxo
-    ShelleyBasedEraConway ->
-      mapM_ (printUtxo sbe) $ Map.toList utxo
+writeFilteredUTxOs sbe format mOutFile utxo =
+  shelleyBasedEraConstraints sbe $
+    firstExceptT QueryCmdWriteFileError . newExceptT .
+      writeLazyByteStringOutput mOutFile $
+        case format' of
+          QueryOutputFormatJson -> encodePretty utxo
+          QueryOutputFormatText -> BS.fromChunks [Text.encodeUtf8 $ filteredUTxOsToText sbe utxo]
+  where
+    format' =
+      case (format, mOutFile) of
+        (Just f, _) -> f -- Take flag from CLI if specified
+        (Nothing, Nothing) -> QueryOutputFormatText -- No CLI flag, writing to stdout: write text
+        (Nothing, Just _) -> QueryOutputFormatJson -- No CLI flag, writing to a file: write JSON
+
+filteredUTxOsToText :: Api.ShelleyBasedEra era -> UTxO era -> Text
+filteredUTxOsToText sbe (UTxO utxo) = do
+  mconcat
+    [ title
+    , Text.replicate (Text.length title + 2) "-"
+    , Text.unlines $ case sbe of
+        ShelleyBasedEraShelley ->
+          map (utxoToText sbe) $ Map.toList utxo
+        ShelleyBasedEraAllegra ->
+          map (utxoToText sbe) $ Map.toList utxo
+        ShelleyBasedEraMary    ->
+          map (utxoToText sbe) $ Map.toList utxo
+        ShelleyBasedEraAlonzo ->
+          map (utxoToText sbe) $ Map.toList utxo
+        ShelleyBasedEraBabbage ->
+          map (utxoToText sbe) $ Map.toList utxo
+        ShelleyBasedEraConway ->
+          map (utxoToText sbe) $ Map.toList utxo
+    ]
 
  where
    title :: Text
    title =
      "                           TxHash                                 TxIx        Amount"
 
-printUtxo
+utxoToText
   :: Api.ShelleyBasedEra era
   -> (TxIn, TxOut CtxUTxO era)
-  -> IO ()
-printUtxo sbe txInOutTuple =
+  -> Text
+utxoToText sbe txInOutTuple =
   case sbe of
     ShelleyBasedEraShelley ->
       let (TxIn (TxId txhash) (TxIx index), TxOut _ value _ _) = txInOutTuple
-      in Text.putStrLn $
-           mconcat
-             [ Text.decodeLatin1 (hashToBytesAsHex txhash)
-             , textShowN 6 index
-             , "        " <> printableValue value
-             ]
+      in mconcat
+           [ Text.decodeLatin1 (hashToBytesAsHex txhash)
+           , textShowN 6 index
+           , "        " <> printableValue value
+           ]
 
     ShelleyBasedEraAllegra ->
       let (TxIn (TxId txhash) (TxIx index), TxOut _ value _ _) = txInOutTuple
-      in Text.putStrLn $
-           mconcat
-             [ Text.decodeLatin1 (hashToBytesAsHex txhash)
-             , textShowN 6 index
-             , "        " <> printableValue value
-             ]
+      in mconcat
+           [ Text.decodeLatin1 (hashToBytesAsHex txhash)
+           , textShowN 6 index
+           , "        " <> printableValue value
+           ]
     ShelleyBasedEraMary ->
       let (TxIn (TxId txhash) (TxIx index), TxOut _ value _ _) = txInOutTuple
-      in Text.putStrLn $
-           mconcat
-             [ Text.decodeLatin1 (hashToBytesAsHex txhash)
-             , textShowN 6 index
-             , "        " <> printableValue value
-             ]
+      in mconcat
+           [ Text.decodeLatin1 (hashToBytesAsHex txhash)
+           , textShowN 6 index
+           , "        " <> printableValue value
+           ]
     ShelleyBasedEraAlonzo ->
       let (TxIn (TxId txhash) (TxIx index), TxOut _ value mDatum _) = txInOutTuple
-      in Text.putStrLn $
-           mconcat
-             [ Text.decodeLatin1 (hashToBytesAsHex txhash)
-             , textShowN 6 index
-             , "        " <> printableValue value <> " + " <> Text.pack (show mDatum)
-             ]
+      in mconcat
+           [ Text.decodeLatin1 (hashToBytesAsHex txhash)
+           , textShowN 6 index
+           , "        " <> printableValue value <> " + " <> Text.pack (show mDatum)
+           ]
     ShelleyBasedEraBabbage ->
       let (TxIn (TxId txhash) (TxIx index), TxOut _ value mDatum _) = txInOutTuple
-      in Text.putStrLn $
-           mconcat
-             [ Text.decodeLatin1 (hashToBytesAsHex txhash)
-             , textShowN 6 index
-             , "        " <> printableValue value <> " + " <> Text.pack (show mDatum)
-             ]
+      in mconcat
+           [ Text.decodeLatin1 (hashToBytesAsHex txhash)
+           , textShowN 6 index
+           , "        " <> printableValue value <> " + " <> Text.pack (show mDatum)
+           ]
     ShelleyBasedEraConway ->
       let (TxIn (TxId txhash) (TxIx index), TxOut _ value mDatum _) = txInOutTuple
-      in Text.putStrLn $
-           mconcat
-             [ Text.decodeLatin1 (hashToBytesAsHex txhash)
-             , textShowN 6 index
-             , "        " <> printableValue value <> " + " <> Text.pack (show mDatum)
-             ]
+      in mconcat
+           [ Text.decodeLatin1 (hashToBytesAsHex txhash)
+           , textShowN 6 index
+           , "        " <> printableValue value <> " + " <> Text.pack (show mDatum)
+           ]
  where
   textShowN :: Show a => Int -> a -> Text
   textShowN len x =

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

@@ -108,6 +108,7 @@ data LegacyQueryUTxOCmdArgs = LegacyQueryUTxOCmdArgs
   , consensusModeParams :: !ConsensusModeParams
   , queryFilter         :: !QueryUTxOFilter
   , networkId           :: !NetworkId
+  , format              :: Maybe QueryOutputFormat
   , mOutFile            :: !(Maybe (File () Out))
   } deriving (Generic, Show)
 

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

@@ -648,6 +648,7 @@ pQueryCmds envCli =
           <*> pConsensusModeParams
           <*> pQueryUTxOFilter
           <*> pNetworkId envCli
+          <*> (optional $ pQueryOutputFormat "utxo")
           <*> pMaybeOutputFile
 
     pQueryStakePools :: Parser LegacyQueryCmds

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

@@ -44,6 +44,7 @@ module Cardano.CLI.Types.Common
   , ProposalText(..)
   , ProposalUrl(..)
   , ProtocolParamsFile(..)
+  , QueryOutputFormat(..)
   , ReferenceScriptAnyEra (..)
   , RequiredSigner (..)
   , ScriptDataOrFile (..)
@@ -87,8 +88,8 @@ import qualified Cardano.Api.Ledger as L
 import qualified Cardano.Chain.Slotting as Byron
 import qualified Cardano.Ledger.BaseTypes as L
 import qualified Cardano.Ledger.Crypto as Crypto
-import qualified Cardano.Ledger.SafeHash as L
 import           Cardano.Ledger.PoolParams (PoolParams (..))
+import qualified Cardano.Ledger.SafeHash as L
 
 import           Data.Aeson (FromJSON (..), ToJSON (..), object, pairs, (.=))
 import qualified Data.Aeson as Aeson
@@ -462,6 +463,11 @@ data TxMempoolQuery =
     | TxMempoolQueryInfo
   deriving Show
 
+data QueryOutputFormat
+  = QueryOutputFormatJson
+  | QueryOutputFormatText
+  deriving Show
+
 data ViewOutputFormat
   = ViewOutputFormatJson
   | ViewOutputFormatYaml

cardano-cli/test/cardano-cli-golden/files/golden/errors/Cardano.CLI.Types.Errors.GovernanceCmdError.GovernanceCmdError/GovernanceCmdCddlError.txt

@@ -1,2 +1,2 @@
 Reading transaction CDDL file error: Failed to decode the ledger's CDDL serialisation format. TextEnvelope error: path/file.txt: TextEnvelope decode error: DecoderErrorCustom "todecode" "decodeerr"
-TextEnvelopeCddl error: path/file.txt: Unknown key witness specified
+TextEnvelopeCddl error: path/file.txt: Unknown key witness specified

cardano-cli/test/cardano-cli-golden/files/golden/help.cli

@@ -506,6 +506,7 @@ Usage: cardano-cli shelley query utxo --socket-path SOCKET_PATH
                                         | (--tx-in TX-IN)
                                         )
                                         (--mainnet | --testnet-magic NATURAL)
+                                        [--output-json | --output-text]
                                         [--out-file FILE]
 
   Get a portion of the current UTxO: by tx in, by address or the whole.
@@ -1663,6 +1664,7 @@ Usage: cardano-cli allegra query utxo --socket-path SOCKET_PATH
                                         | (--tx-in TX-IN)
                                         )
                                         (--mainnet | --testnet-magic NATURAL)
+                                        [--output-json | --output-text]
                                         [--out-file FILE]
 
   Get a portion of the current UTxO: by tx in, by address or the whole.
@@ -2818,6 +2820,7 @@ Usage: cardano-cli mary query utxo --socket-path SOCKET_PATH
                                      | (--tx-in TX-IN)
                                      )
                                      (--mainnet | --testnet-magic NATURAL)
+                                     [--output-json | --output-text]
                                      [--out-file FILE]
 
   Get a portion of the current UTxO: by tx in, by address or the whole.
@@ -3964,6 +3967,7 @@ Usage: cardano-cli alonzo query utxo --socket-path SOCKET_PATH
                                        | (--tx-in TX-IN)
                                        )
                                        (--mainnet | --testnet-magic NATURAL)
+                                       [--output-json | --output-text]
                                        [--out-file FILE]
 
   Get a portion of the current UTxO: by tx in, by address or the whole.
@@ -5146,6 +5150,7 @@ Usage: cardano-cli babbage query utxo --socket-path SOCKET_PATH
                                         | (--tx-in TX-IN)
                                         )
                                         (--mainnet | --testnet-magic NATURAL)
+                                        [--output-json | --output-text]
                                         [--out-file FILE]
 
   Get a portion of the current UTxO: by tx in, by address or the whole.
@@ -6572,6 +6577,7 @@ Usage: cardano-cli conway query utxo --socket-path SOCKET_PATH
                                        )
                                        (--mainnet | --testnet-magic NATURAL)
                                        [--volatile-tip | --immutable-tip]
+                                       [--output-json | --output-text]
                                        [--out-file FILE]
 
   Get a portion of the current UTxO: by tx in, by address or the whole.
@@ -7929,6 +7935,7 @@ Usage: cardano-cli latest query utxo --socket-path SOCKET_PATH
                                        | (--tx-in TX-IN)
                                        )
                                        (--mainnet | --testnet-magic NATURAL)
+                                       [--output-json | --output-text]
                                        [--out-file FILE]
 
   Get a portion of the current UTxO: by tx in, by address or the whole.
@@ -8942,6 +8949,7 @@ Usage: cardano-cli legacy query utxo --socket-path SOCKET_PATH
                                        | (--tx-in TX-IN)
                                        )
                                        (--mainnet | --testnet-magic NATURAL)
+                                       [--output-json | --output-text]
                                        [--out-file FILE]
 
   Get a portion of the current UTxO: by tx in, by address or the whole.
@@ -10190,6 +10198,7 @@ Usage: cardano-cli query utxo --socket-path SOCKET_PATH
                                 | (--tx-in TX-IN)
                                 )
                                 (--mainnet | --testnet-magic NATURAL)
+                                [--output-json | --output-text]
                                 [--out-file FILE]
 
   Get a portion of the current UTxO: by tx in, by address or the whole.

cardano-cli/test/cardano-cli-golden/files/golden/help/allegra_query_utxo.cli

@@ -5,6 +5,7 @@ Usage: cardano-cli allegra query utxo --socket-path SOCKET_PATH
                                         | (--tx-in TX-IN)
                                         )
                                         (--mainnet | --testnet-magic NATURAL)
+                                        [--output-json | --output-text]
                                         [--out-file FILE]
 
   Get a portion of the current UTxO: by tx in, by address or the whole.
@@ -27,5 +28,9 @@ Available options:
                            CARDANO_NODE_NETWORK_ID environment variable
   --testnet-magic NATURAL  Specify a testnet magic id. This overrides the
                            CARDANO_NODE_NETWORK_ID environment variable
+  --output-json            Format utxo query output to JSON. Default format when
+                           writing to a file
+  --output-text            Format utxo query output to TEXT. Default format when
+                           writing to stdout
   --out-file FILE          Optional output file. Default is to write to stdout.
   -h,--help                Show this help text

cardano-cli/test/cardano-cli-golden/files/golden/help/alonzo_query_utxo.cli

@@ -5,6 +5,7 @@ Usage: cardano-cli alonzo query utxo --socket-path SOCKET_PATH
                                        | (--tx-in TX-IN)
                                        )
                                        (--mainnet | --testnet-magic NATURAL)
+                                       [--output-json | --output-text]
                                        [--out-file FILE]
 
   Get a portion of the current UTxO: by tx in, by address or the whole.
@@ -27,5 +28,9 @@ Available options:
                            CARDANO_NODE_NETWORK_ID environment variable
   --testnet-magic NATURAL  Specify a testnet magic id. This overrides the
                            CARDANO_NODE_NETWORK_ID environment variable
+  --output-json            Format utxo query output to JSON. Default format when
+                           writing to a file
+  --output-text            Format utxo query output to TEXT. Default format when
+                           writing to stdout
   --out-file FILE          Optional output file. Default is to write to stdout.
   -h,--help                Show this help text