Add binary output option for query utxo command

IntersectMBO · Dec 28, 2024 · 8f06de2 · 8f06de2
1 parent 824a111
commit 8f06de2
Show file tree

Hide file tree

Showing 5 changed files with 46 additions and 7 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs
@@ -129,7 +129,7 @@ data QueryStakeAddressInfoCmdArgs = QueryStakeAddressInfoCmdArgs
 data QueryUTxOCmdArgs = QueryUTxOCmdArgs
   { commons :: !QueryCommons
   , queryFilter :: !QueryUTxOFilter
-  , format :: Maybe OutputFormatJsonOrText
+  , format :: Maybe AllOutputFormats
   , mOutFile :: !(Maybe (File () Out))
   }
   deriving (Generic, Show)

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs
@@ -1723,6 +1723,30 @@ pOutputFormatJsonOrText kind =
         , Opt.long ("output-" <> flag_)
         ]
 
+pAllOutputFormats :: String -> Parser AllOutputFormats
+pAllOutputFormats kind =
+  asum
+    [ make FormatJson "JSON" "json" (Just " Default format when writing to a file")
+    , make FormatText "TEXT" "text" (Just " Default format when writing to stdout")
+    , make FormatCBOR "CBOR" "cbor" Nothing
+    ]
+ 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"
 

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs
@@ -293,7 +293,7 @@ pQueryUTxOCmd era envCli =
     QueryUTxOCmdArgs
       <$> pQueryCommons era envCli
       <*> pQueryUTxOFilter
-      <*> (optional $ pOutputFormatJsonOrText "utxo")
+      <*> (optional $ pAllOutputFormats "utxo")
       <*> pMaybeOutputFile
 
 pQueryStakePoolsCmd :: ShelleyBasedEra era -> EnvCli -> Parser (QueryCmds era)

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs
@@ -10,7 +10,6 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
@@ -47,6 +46,7 @@ import           Cardano.Api.Network (Serialised (..))
 import qualified Cardano.Api.Network as Consensus
 import           Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..))
 
+import qualified Cardano.Binary as CBOR
 import qualified Cardano.CLI.EraBased.Commands.Query as Cmd
 import           Cardano.CLI.EraBased.Run.Genesis.Common
 import           Cardano.CLI.Helpers
@@ -1140,7 +1140,7 @@ writeProtocolState sbe mOutFile ps@(ProtocolState pstate) =
 
 writeFilteredUTxOs
   :: Api.ShelleyBasedEra era
-  -> Maybe OutputFormatJsonOrText
+  -> Maybe AllOutputFormats
   -> Maybe (File () Out)
   -> UTxO era
   -> ExceptT QueryCmdError IO ()
@@ -1149,9 +1149,10 @@ writeFilteredUTxOs sbe format mOutFile utxo =
     $ firstExceptT QueryCmdWriteFileError
       . newExceptT
       . writeLazyByteStringOutput mOutFile
-    $ case newOutputFormat format mOutFile of
-      OutputFormatJson -> encodePretty utxo
-      OutputFormatText -> strictTextToLazyBytestring $ filteredUTxOsToText sbe utxo
+    $ case allOutputFormats format mOutFile of
+      FormatJson -> encodePretty utxo
+      FormatText -> strictTextToLazyBytestring $ filteredUTxOsToText sbe utxo
+      FormatCBOR -> CBOR.serialize $ toLedgerUTxO sbe utxo
 
 filteredUTxOsToText :: Api.ShelleyBasedEra era -> UTxO era -> Text
 filteredUTxOsToText sbe (UTxO utxo) = do
@@ -1931,6 +1932,13 @@ newOutputFormat format mOutFile =
     (Nothing, Nothing) -> OutputFormatText -- No CLI flag, writing to stdout: write text
     (Nothing, Just _) -> OutputFormatJson -- No CLI flag, writing to a file: write JSON
 
+allOutputFormats :: Maybe AllOutputFormats -> Maybe a -> AllOutputFormats
+allOutputFormats format mOutFile =
+  case (format, mOutFile) of
+    (Just f, _) -> f -- Take flag from CLI if specified
+    (Nothing, Nothing) -> FormatText -- No CLI flag, writing to stdout: write text
+    (Nothing, Just _) -> FormatJson -- No CLI flag, writing to a file: write JSON
+
 strictTextToLazyBytestring :: Text -> LBS.ByteString
 strictTextToLazyBytestring t = BS.fromChunks [Text.encodeUtf8 t]
 

diff --git a/cardano-cli/src/Cardano/CLI/Types/Common.hs b/cardano-cli/src/Cardano/CLI/Types/Common.hs
@@ -8,6 +8,7 @@
 
 module Cardano.CLI.Types.Common
   ( AllOrOnly (..)
+  , AllOutputFormats (..)
   , AddressKeyType (..)
   , AnchorScheme (..)
   , AnyPlutusScriptVersion (..)
@@ -547,6 +548,12 @@ data OutputFormatJsonOrText
   | OutputFormatText
   deriving Show
 
+data AllOutputFormats
+  = FormatJson
+  | FormatText
+  | FormatCBOR
+  deriving Show
+
 data ViewOutputFormat
   = ViewOutputFormatJson
   | ViewOutputFormatYaml