Rollout --output-json and --output-yaml part 1

cardano-cli/cardano-cli.cabal

@@ -164,6 +164,7 @@ library
     Cardano.CLI.EraIndependent.Ping.Run
     Cardano.CLI.Helper
     Cardano.CLI.IO.Lazy
+    Cardano.CLI.Json.Encode
     Cardano.CLI.Json.Friendly
     Cardano.CLI.Legacy.Command
     Cardano.CLI.Legacy.Genesis.Command

cardano-cli/src/Cardano/CLI/EraBased/Governance/Vote/Run.hs

@@ -21,16 +21,15 @@ import Cardano.Api.Shelley
 import Cardano.CLI.EraBased.Governance.Vote.Command qualified as Cmd
 import Cardano.CLI.EraBased.Script.Vote.Read
 import Cardano.CLI.EraIndependent.Hash.Internal.Common (carryHashChecks)
+import Cardano.CLI.Json.Encode qualified as Json
 import Cardano.CLI.Read (getHashFromStakePoolKeyHashSource)
 import Cardano.CLI.Type.Common
 import Cardano.CLI.Type.Error.CmdError
 import Cardano.CLI.Type.Error.GovernanceVoteCmdError
 import Cardano.CLI.Type.Governance
 import Cardano.CLI.Type.Key
 
-import Data.Aeson.Encode.Pretty
 import Data.Function
-import Data.Yaml.Pretty qualified as Yaml
 import Vary qualified
 
 runGovernanceVoteCmds
@@ -115,26 +114,14 @@ runGovernanceVoteViewCmd
         fmap fst $
           firstExceptT GovernanceVoteCmdReadVoteFileError $
             readVoteScriptWitness eon (voteFile, Nothing)
-      firstExceptT GovernanceVoteCmdWriteError
-        . newExceptT
-        . ( outFormat
+
+      let output =
+            outFormat
               & ( id
-                    . Vary.on (\FormatJson -> writeJson)
-                    . Vary.on (\FormatYaml -> writeYaml)
+                    . Vary.on (\FormatJson -> Json.encodeJson)
+                    . Vary.on (\FormatYaml -> Json.encodeYaml)
                     $ Vary.exhaustiveCase
                 )
-          )
-        . unVotingProcedures
-        $ voteProcedures
-   where
-    writeJson :: ToJSON a => a -> IO (Either (FileError ()) ())
-    writeJson =
-      writeLazyByteStringOutput mOutFile
-        . encodePretty'
-          (defConfig{confCompare = compare})
+              $ unVotingProcedures voteProcedures
 
-    writeYaml :: ToJSON a => a -> IO (Either (FileError ()) ())
-    writeYaml =
-      writeByteStringOutput mOutFile
-        . Yaml.encodePretty
-          (Yaml.setConfCompare compare Yaml.defConfig)
+      firstExceptT GovernanceVoteCmdWriteError $ newExceptT $ writeLazyByteStringOutput mOutFile output

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

@@ -94,7 +94,7 @@ data QueryLeadershipScheduleCmdArgs = QueryLeadershipScheduleCmdArgs
   , poolColdVerKeyFile :: !StakePoolKeyHashSource
   , vrkSkeyFp :: !(SigningKeyFile In)
   , whichSchedule :: !EpochLeadershipSchedule
-  , format :: !(Vary [FormatJson, FormatText])
+  , format :: !(Vary [FormatJson, FormatText, FormatYaml])
   , mOutFile :: !(Maybe (File () Out))
   }
   deriving (Generic, Show)

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

@@ -512,6 +512,7 @@ pLeadershipScheduleCmd era envCli =
         "leadership-schedule query output"
         [ flagFormatJson & setDefault
         , flagFormatText
+        , flagFormatYaml
         ]
       <*> pMaybeOutputFile
 

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

@@ -52,6 +52,7 @@ import Cardano.Binary qualified as CBOR
 import Cardano.CLI.EraBased.Genesis.Internal.Common
 import Cardano.CLI.EraBased.Query.Command qualified as Cmd
 import Cardano.CLI.Helper
+import Cardano.CLI.Json.Encode qualified as Json
 import Cardano.CLI.Read
   ( getHashFromStakePoolKeyHashSource
   )
@@ -69,7 +70,7 @@ import Cardano.Slotting.Time (RelativeTime (..), toRelativeTime)
 import Control.Monad (forM, forM_, join)
 import Data.Aeson as Aeson
 import Data.Aeson qualified as A
-import Data.Aeson.Encode.Pretty (encodePretty)
+import Data.Aeson.Encode.Pretty qualified as Aeson
 import Data.Bifunctor (Bifunctor (..))
 import Data.ByteString.Base16.Lazy qualified as Base16
 import Data.ByteString.Char8 qualified as C8
@@ -92,7 +93,6 @@ 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 ((^.))
@@ -160,7 +160,7 @@ runQueryProtocolParametersCmd
       firstExceptT QueryCmdWriteFileError . newExceptT $
         writeLazyByteStringOutput mOutFile' $
           shelleyBasedEraConstraints sbe $
-            encodePretty pparams
+            Aeson.encodePretty pparams
 
 -- | Calculate the percentage sync rendered as text: @min 1 (tipTime/nowTime)@
 percentage
@@ -290,7 +290,7 @@ runQueryTipCmd
 
     firstExceptT QueryCmdWriteFileError . newExceptT $
       writeLazyByteStringOutput mOutFile $
-        encodePretty localStateOutput
+        Aeson.encodePretty localStateOutput
 
 -- | Query the UTxO, filtered by a given set of addresses, from a Shelley node
 -- via the local state query protocol.
@@ -387,7 +387,7 @@ runQueryKesPeriodInfoCmd
                   renderOpCertNodeAndOnDiskCounterInformation (unFile nodeOpCertFp) counterInformation
 
               let qKesInfoOutput = createQueryKesPeriodInfoOutput opCertIntervalInformation counterInformation eInfo gParams
-                  kesPeriodInfoJSON = encodePretty qKesInfoOutput
+                  kesPeriodInfoJSON = Aeson.encodePretty qKesInfoOutput
 
               liftIO $ LBS.putStrLn kesPeriodInfoJSON
               forM_
@@ -681,7 +681,7 @@ runQueryTxMempoolCmd
     result <- liftIO $ queryTxMonitoringLocal nodeConnInfo localQuery
     firstExceptT QueryCmdWriteFileError . newExceptT $
       writeLazyByteStringOutput mOutFile $
-        encodePretty result
+        Aeson.encodePretty result
 
 runQuerySlotNumberCmd
   :: ()
@@ -883,13 +883,14 @@ runQueryLedgerPeerSnapshot
       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 outputContents =
+              outputFormat
+                & ( id
+                      . Vary.on (\FormatJson -> Json.encodeJson)
+                      . Vary.on (\FormatYaml -> Json.encodeYaml)
+                      $ Vary.exhaustiveCase
+                  )
+                $ snapshot
 
         let writeOutputContents =
               case mOutFile of
@@ -1047,7 +1048,7 @@ writeStakeAddressInfo
     )
   mOutFile =
     firstExceptT QueryCmdWriteFileError . newExceptT $
-      writeLazyByteStringOutput mOutFile (encodePretty $ jsonInfo sbe)
+      writeLazyByteStringOutput mOutFile (Aeson.encodePretty $ jsonInfo sbe)
    where
     jsonInfo :: ShelleyBasedEra era -> [Aeson.Value]
     jsonInfo =
@@ -1114,7 +1115,7 @@ writeStakeSnapshots mOutFile qState = do
       & onLeft (left . QueryCmdStakeSnapshotDecodeError)
 
   -- Calculate the three pool and active stake values for the given pool
-  liftIO . maybe LBS.putStrLn (LBS.writeFile . unFile) mOutFile $ encodePretty snapshot
+  liftIO . maybe LBS.putStrLn (LBS.writeFile . unFile) mOutFile $ Aeson.encodePretty snapshot
 
 -- | This function obtains the pool parameters, equivalent to the following jq query on the output of query ledger-state
 --   .nesEs.esLState.lsDPState.dpsPState.psStakePoolParams.<pool_id>
@@ -1154,7 +1155,7 @@ writePoolState mOutFile serialisedCurrentEpochState = do
 
   firstExceptT QueryCmdWriteFileError . newExceptT $
     writeLazyByteStringOutput mOutFile $
-      encodePretty poolStates
+      Aeson.encodePretty poolStates
 
 writeProtocolState
   :: ShelleyBasedEra era
@@ -1195,7 +1196,7 @@ writeProtocolState sbe mOutFile ps@(ProtocolState pstate) =
   decodePState ps' =
     case decodeProtocolState ps' of
       Left (bs, _) -> firstExceptT QueryCmdHelpersError $ pPrintCBOR bs
-      Right chainDepstate -> liftIO . LBS.putStrLn $ encodePretty chainDepstate
+      Right chainDepstate -> liftIO . LBS.putStrLn $ Aeson.encodePretty chainDepstate
 
 writeFilteredUTxOs
   :: Api.ShelleyBasedEra era
@@ -1211,7 +1212,7 @@ writeFilteredUTxOs sbe format mOutFile utxo =
     $ format
       & ( id
             . Vary.on (\FormatCbor -> Base16.encode . CBOR.serialize $ toLedgerUTxO sbe utxo)
-            . Vary.on (\FormatJson -> encodePretty utxo)
+            . Vary.on (\FormatJson -> Json.encodeJson utxo)
             . Vary.on (\FormatText -> strictTextToLazyBytestring $ filteredUTxOsToText sbe utxo)
             $ Vary.exhaustiveCase
         )
@@ -1347,7 +1348,7 @@ writeStakePools format mOutFile stakePools =
             $ Vary.exhaustiveCase
         )
   writeJson =
-    encodePretty stakePools
+    Aeson.encodePretty stakePools
   writeText =
     LBS.unlines $
       map (strictTextToLazyBytestring . serialiseToBech32) $
@@ -1368,7 +1369,7 @@ writeFormattedOutput format mOutFile value =
   toWrite :: LBS.ByteString =
     format
       & ( id
-            . Vary.on (\FormatJson -> encodePretty value)
+            . Vary.on (\FormatJson -> Json.encodeJson value)
             . Vary.on (\FormatText -> fromString . docToString $ pretty value)
             $ Vary.exhaustiveCase
         )
@@ -1416,7 +1417,7 @@ writeStakeDistribution format mOutFile stakeDistrib =
   toWrite :: LBS.ByteString =
     format
       & ( id
-            . Vary.on (\FormatJson -> encodePretty stakeDistrib)
+            . Vary.on (\FormatJson -> Json.encodeJson stakeDistrib)
             . Vary.on (\FormatText -> strictTextToLazyBytestring stakeDistributionText)
             $ Vary.exhaustiveCase
         )
@@ -1540,8 +1541,9 @@ runQueryLeadershipScheduleCmd
       toWrite =
         format
           & ( id
-                . Vary.on (\FormatJson -> encodePretty $ leadershipScheduleToJson schedule eInfo start)
+                . Vary.on (\FormatJson -> Json.encodeJson $ leadershipScheduleToJson schedule eInfo start)
                 . Vary.on (\FormatText -> strictTextToLazyBytestring $ leadershipScheduleToText schedule eInfo start)
+                . Vary.on (\FormatYaml -> Json.encodeYaml $ leadershipScheduleToJson schedule eInfo start)
                 $ Vary.exhaustiveCase
             )
 
@@ -1973,10 +1975,10 @@ writeOutput
   -> b
   -> ExceptT QueryCmdError IO ()
 writeOutput mOutFile content = case mOutFile of
-  Nothing -> liftIO . LBS.putStrLn . encodePretty $ content
+  Nothing -> liftIO . LBS.putStrLn . Aeson.encodePretty $ content
   Just (File f) ->
     handleIOExceptT (QueryCmdWriteFileError . FileIOError f) $
-      LBS.writeFile f (encodePretty content)
+      LBS.writeFile f (Aeson.encodePretty content)
 
 -- Helpers
 

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

@@ -0,0 +1,30 @@
+module Cardano.CLI.Json.Encode
+  ( encodeJson
+  , encodeYaml
+  )
+where
+
+import Data.Aeson qualified as Aeson
+import Data.Aeson.Encode.Pretty qualified as Aeson
+import Data.ByteString.Lazy qualified as LBS
+import Data.Yaml.Pretty qualified as Yaml
+
+-- | Encode JSON with pretty printing.
+encodeJson :: Aeson.ToJSON a => a -> LBS.ByteString
+encodeJson =
+  Aeson.encodePretty' jsonConfig
+
+-- | Encode YAML with pretty printing.
+encodeYaml :: Aeson.ToJSON a => a -> LBS.ByteString
+encodeYaml =
+  LBS.fromStrict . Yaml.encodePretty yamlConfig
+
+jsonConfig :: Aeson.Config
+jsonConfig =
+  Aeson.defConfig
+    { Aeson.confCompare = compare
+    }
+
+yamlConfig :: Yaml.Config
+yamlConfig =
+  Yaml.setConfCompare compare Yaml.defConfig

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

@@ -10,6 +10,7 @@
 
 {-# HLINT ignore "Redundant bracket" #-}
 {-# HLINT ignore "Redundant id" #-}
+{-# HLINT ignore "Use let" #-}
 
 -- | User-friendly pretty-printing for textual user interfaces (TUI)
 module Cardano.CLI.Json.Friendly
@@ -26,10 +27,7 @@ module Cardano.CLI.Json.Friendly
   --
   -- They are more low-level, but can be used in any context.
   -- The '*Impl' functions give you access to the Aeson representation
-  -- of various structures. Then use 'friendlyBS' to format the Aeson
-  -- values to a ByteString, in a manner consistent with the IO functions
-  -- of this module.
-  , friendlyBS
+  -- of various structures.
   , friendlyTxImpl
   , friendlyTxBodyImpl
   , friendlyProposalImpl
@@ -55,20 +53,18 @@ import Cardano.Api.Shelley
   , toShelleyStakeCredential
   )
 
+import Cardano.CLI.Json.Encode qualified as Json
 import Cardano.CLI.Orphan ()
 import Cardano.CLI.Type.Common
 import Cardano.CLI.Type.MonadWarning (MonadWarning, runWarningIO)
 import Cardano.Crypto.Hash (hashToTextAsHex)
 
 import Data.Aeson (Value (..), object, toJSON, (.=))
 import Data.Aeson qualified as Aeson
-import Data.Aeson.Encode.Pretty qualified as Aeson
 import Data.Aeson.Key qualified as Aeson
 import Data.Aeson.KeyMap qualified as KeyMap
 import Data.Aeson.Types qualified as Aeson
-import Data.ByteString qualified as BS
 import Data.ByteString.Char8 qualified as BSC
-import Data.ByteString.Lazy qualified as LBS
 import Data.Char (isAscii)
 import Data.Function ((&))
 import Data.Functor ((<&>))
@@ -80,8 +76,6 @@ import Data.Text qualified as Text
 import Data.Typeable (Typeable)
 import Data.Vector qualified as Vector
 import Data.Yaml (array)
-import Data.Yaml.Pretty (setConfCompare)
-import Data.Yaml.Pretty qualified as Yaml
 import GHC.Exts (IsList (..))
 import GHC.Real (denominator)
 import GHC.Unicode (isAlphaNum)
@@ -95,33 +89,18 @@ friendly
   -> Maybe (File () Out)
   -> a
   -> m (Either (FileError e) ())
-friendly format mOutFile =
-  format
-    & ( id
-          . Vary.on (\FormatJson -> writeLazyByteStringOutput mOutFile . Aeson.encodePretty' jsonConfig)
-          . Vary.on (\FormatYaml -> writeByteStringOutput mOutFile . Yaml.encodePretty yamlConfig)
-          $ Vary.exhaustiveCase
-      )
-
-friendlyBS
-  :: ()
-  => Aeson.ToJSON a
-  => Vary [FormatJson, FormatYaml]
-  -> a
-  -> BS.ByteString
-friendlyBS format a =
-  format
-    & ( id
-          . Vary.on (\FormatJson -> BS.concat . LBS.toChunks $ Aeson.encodePretty' jsonConfig a)
-          . Vary.on (\FormatYaml -> Yaml.encodePretty yamlConfig a)
-          $ Vary.exhaustiveCase
-      )
-
-jsonConfig :: Aeson.Config
-jsonConfig = Aeson.defConfig{Aeson.confCompare = compare}
-
-yamlConfig :: Yaml.Config
-yamlConfig = Yaml.defConfig & setConfCompare compare
+friendly format mOutFile value = do
+  output <-
+    pure
+      $ format
+        & ( id
+              . Vary.on (\FormatJson -> Json.encodeJson)
+              . Vary.on (\FormatYaml -> Json.encodeYaml)
+              $ Vary.exhaustiveCase
+          )
+      $ value
+
+  writeLazyByteStringOutput mOutFile output
 
 friendlyTx
   :: MonadIO m

cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs

@@ -229,6 +229,6 @@ hprop_golden_view_conway_proposal =
 
     result <-
       execCardanoCLI
-        ["debug", "transaction", "view", "--tx-file", input </> "tx-proposal.json", "--output-json"]
+        ["debug", "transaction", "view", "--tx-file", input </> "tx-proposal.json"]
 
     H.diffVsGoldenFile result (golden </> "tx-proposal.out.json")