Standard output format for query ledger-peer-snapshot command

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

@@ -149,7 +149,8 @@ data QueryLedgerStateCmdArgs = QueryLedgerStateCmdArgs
 
 data QueryLedgerPeerSnapshotCmdArgs = QueryLedgerPeerSnapshotCmdArgs
   { commons :: !QueryCommons
-  , outFile :: !(Maybe (File () Out))
+  , outputFormat :: !(Vary [FormatJson, FormatYaml])
+  , mOutFile :: !(Maybe (File () Out))
   }
   deriving (Generic, Show)
 

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

@@ -427,6 +427,11 @@ pQueryLedgerPeerSnapshotCmd era envCli =
   fmap QueryLedgerPeerSnapshotCmd $
     QueryLedgerPeerSnapshotCmdArgs
       <$> pQueryCommons era envCli
+      <*> pFormatFlags
+        "ledger-peer-snapshot output"
+        [ flagFormatJson & setDefault
+        , flagFormatYaml
+        ]
       <*> pMaybeOutputFile
 
 pQueryProtocolStateCmd :: ShelleyBasedEra era -> EnvCli -> Parser (QueryCmds era)

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

@@ -92,6 +92,7 @@ import Data.Text.Encoding qualified as Text
 import Data.Text.IO qualified as T
 import Data.Text.Lazy.IO qualified as LT
 import Data.Time.Clock
+import Data.Yaml qualified as Yaml
 import GHC.Exts (IsList (..))
 import GHC.Generics
 import Lens.Micro ((^.))
@@ -852,25 +853,50 @@ runQueryLedgerPeerSnapshot
         { Cmd.nodeConnInfo
         , Cmd.target
         }
-    , Cmd.outFile
+    , Cmd.outputFormat
+    , Cmd.mOutFile
     } = do
-    join $
-      lift
-        ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do
-            AnyCardanoEra era <-
-              lift queryCurrentEra
-                & onLeft (left . QueryCmdUnsupportedNtcVersion)
+    result <-
+      join $
+        lift
+          ( executeLocalStateQueryExpr nodeConnInfo target $ runExceptT $ do
+              AnyCardanoEra era <-
+                lift queryCurrentEra
+                  & onLeft (left . QueryCmdUnsupportedNtcVersion)
 
-            sbe <-
-              requireShelleyBasedEra era
-                & onNothing (left QueryCmdByronEra)
+              sbe <-
+                requireShelleyBasedEra era
+                  & onNothing (left QueryCmdByronEra)
 
-            result <- easyRunQuery (queryLedgerPeerSnapshot sbe)
+              result <- easyRunQuery (queryLedgerPeerSnapshot sbe)
 
-            pure $ shelleyBasedEraConstraints sbe (writeLedgerPeerSnapshot outFile) result
-        )
-        & onLeft (left . QueryCmdAcquireFailure)
-        & onLeft left
+              pure $
+                shelleyBasedEraConstraints sbe $
+                  case decodeBigLedgerPeerSnapshot result of
+                    Left (bs, _decoderError) -> pure $ Left bs
+                    Right snapshot -> pure $ Right snapshot
+          )
+          & onLeft (left . QueryCmdAcquireFailure)
+          & onLeft left
+
+    case result of
+      Left (bs :: LBS.ByteString) -> do
+        firstExceptT QueryCmdHelpersError $ pPrintCBOR bs
+      Right (snapshot :: LedgerPeerSnapshot) -> do
+        outputContents <-
+          outputFormat
+            & ( id
+                  . Vary.on (\FormatJson -> pure $ encodePretty snapshot)
+                  . Vary.on (\FormatYaml -> pure $ LBS.fromStrict $ Yaml.encode snapshot)
+                  $ Vary.exhaustiveCase
+              )
+
+        let writeOutputContents =
+              case mOutFile of
+                Nothing -> liftIO . LBS.putStrLn
+                Just (File outFile) -> liftIO . LBS.writeFile outFile
+
+        writeOutputContents outputContents
 
 runQueryProtocolStateCmd
   :: ()
@@ -1077,23 +1103,6 @@ writeStakeAddressInfo
             mDRep = Map.lookup addr voteDelegatees
       ]
 
--- | Writes JSON-encoded big ledger peer snapshot
-writeLedgerPeerSnapshot
-  :: Maybe (File () Out)
-  -> Serialised LedgerPeerSnapshot
-  -> ExceptT QueryCmdError IO ()
-writeLedgerPeerSnapshot mOutPath serBigLedgerPeerSnapshot = do
-  case decodeBigLedgerPeerSnapshot serBigLedgerPeerSnapshot of
-    Left (bs, _decoderError) ->
-      firstExceptT QueryCmdHelpersError $ pPrintCBOR bs
-    Right snapshot ->
-      case mOutPath of
-        Nothing -> liftIO . LBS.putStrLn $ Aeson.encode snapshot
-        Just fpath ->
-          firstExceptT QueryCmdWriteFileError $
-            newExceptT . writeLazyByteStringFile fpath $
-              encodePretty snapshot
-
 writeStakeSnapshots
   :: forall era
    . Maybe (File () Out)

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

@@ -8,6 +8,7 @@ module Cardano.CLI.Helper
   ( HelpersError (..)
   , cborToText
   , cborToTextByteString
+  , cborToTextLazyByteString
   , printWarning
   , deprecationWarning
   , ensureNewFile
@@ -35,11 +36,14 @@ import Data.Bifunctor (Bifunctor (..))
 import Data.ByteString (ByteString)
 import Data.ByteString qualified as BS
 import Data.ByteString.Lazy qualified as LB
+import Data.ByteString.Lazy qualified as LBS
 import Data.Functor (void)
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.Encoding qualified as Text
 import Data.Text.IO qualified as Text
+import Data.Text.Lazy qualified as LT
+import Data.Text.Lazy.Encoding qualified as LT
 import Data.Typeable (Typeable)
 import System.Console.ANSI
 import System.Console.ANSI qualified as ANSI
@@ -114,6 +118,10 @@ cborToTextByteString bs = do
   text <- cborToText bs
   pure $ LB.fromStrict $ Text.encodeUtf8 text
 
+cborToTextLazyByteString :: LB.ByteString -> ExceptT HelpersError IO LBS.ByteString
+cborToTextLazyByteString =
+  fmap (LT.encodeUtf8 . LT.fromStrict) . cborToText
+
 cborToText :: LB.ByteString -> ExceptT HelpersError IO Text
 cborToText bs = do
   as <- cborToTextList bs

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

@@ -493,6 +493,7 @@ Usage: cardano-cli query ledger-peer-snapshot
                                                 [ --volatile-tip
                                                 | --immutable-tip
                                                 ]
+                                                [--output-json | --output-yaml]
                                                 [--out-file FILEPATH]
 
   Dump the current snapshot of big ledger peers. These are the largest pools
@@ -2048,6 +2049,9 @@ Usage: cardano-cli conway query ledger-peer-snapshot
                                                        [ --volatile-tip
                                                        | --immutable-tip
                                                        ]
+                                                       [ --output-json
+                                                       | --output-yaml
+                                                       ]
                                                        [--out-file FILEPATH]
 
   Dump the current snapshot of ledger peers.These are the largest pools that
@@ -4285,6 +4289,9 @@ Usage: cardano-cli latest query ledger-peer-snapshot
                                                        [ --volatile-tip
                                                        | --immutable-tip
                                                        ]
+                                                       [ --output-json
+                                                       | --output-yaml
+                                                       ]
                                                        [--out-file FILEPATH]
 
   Dump the current snapshot of ledger peers.These are the largest pools that

cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_ledger-peer-snapshot.cli

@@ -8,6 +8,9 @@ Usage: cardano-cli conway query ledger-peer-snapshot
                                                        [ --volatile-tip
                                                        | --immutable-tip
                                                        ]
+                                                       [ --output-json
+                                                       | --output-yaml
+                                                       ]
                                                        [--out-file FILEPATH]
 
   Dump the current snapshot of ledger peers.These are the largest pools that
@@ -30,5 +33,7 @@ Available options:
   --volatile-tip           Use the volatile tip as a target. (This is the
                            default)
   --immutable-tip          Use the immutable tip as a target.
+  --output-json            Format ledger-peer-snapshot output to JSON (default).
+  --output-yaml            Format ledger-peer-snapshot output to YAML.
   --out-file FILEPATH      Optional output file. Default is to write to stdout.
   -h,--help                Show this help text

cardano-cli/test/cardano-cli-golden/files/golden/help/latest_query_ledger-peer-snapshot.cli

@@ -8,6 +8,9 @@ Usage: cardano-cli latest query ledger-peer-snapshot
                                                        [ --volatile-tip
                                                        | --immutable-tip
                                                        ]
+                                                       [ --output-json
+                                                       | --output-yaml
+                                                       ]
                                                        [--out-file FILEPATH]
 
   Dump the current snapshot of ledger peers.These are the largest pools that
@@ -30,5 +33,7 @@ Available options:
   --volatile-tip           Use the volatile tip as a target. (This is the
                            default)
   --immutable-tip          Use the immutable tip as a target.
+  --output-json            Format ledger-peer-snapshot output to JSON (default).
+  --output-yaml            Format ledger-peer-snapshot output to YAML.
   --out-file FILEPATH      Optional output file. Default is to write to stdout.
   -h,--help                Show this help text

cardano-cli/test/cardano-cli-golden/files/golden/help/query_ledger-peer-snapshot.cli

@@ -8,6 +8,7 @@ Usage: cardano-cli query ledger-peer-snapshot
                                                 [ --volatile-tip
                                                 | --immutable-tip
                                                 ]
+                                                [--output-json | --output-yaml]
                                                 [--out-file FILEPATH]
 
   Dump the current snapshot of big ledger peers. These are the largest pools
@@ -30,5 +31,7 @@ Available options:
   --volatile-tip           Use the volatile tip as a target. (This is the
                            default)
   --immutable-tip          Use the immutable tip as a target.
+  --output-json            Format ledger-peer-snapshot output to JSON (default).
+  --output-yaml            Format ledger-peer-snapshot output to YAML.
   --out-file FILEPATH      Optional output file. Default is to write to stdout.
   -h,--help                Show this help text