cardano-cli query utxo: Fix JSON output description

IntersectMBO · May 20, 2022 · 86f69aa · 86f69aa
1 parent 41afffd
commit 86f69aa
Show file tree

Hide file tree

Showing 3 changed files with 52 additions and 29 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs
@@ -23,6 +23,7 @@ module Cardano.CLI.Shelley.Commands
   , ByronKeyFormat (..)
   , CardanoAddressKeyType (..)
   , GenesisDir (..)
+  , JsonOutput (..)
   , TxInCount (..)
   , TxOutCount (..)
   , TxShelleyWitnessCount (..)
@@ -350,6 +351,9 @@ renderPoolCmd cmd =
     PoolGetId {} -> "stake-pool id"
     PoolMetadataHash {} -> "stake-pool metadata-hash"
 
+newtype JsonOutput = JsonOutput Bool
+  deriving Show
+
 data QueryCmd =
     QueryLeadershipSchedule
       AnyConsensusModeParams
@@ -364,7 +368,12 @@ data QueryCmd =
   | QueryStakePools' AnyConsensusModeParams NetworkId (Maybe OutputFile)
   | QueryStakeDistribution' AnyConsensusModeParams NetworkId (Maybe OutputFile)
   | QueryStakeAddressInfo AnyConsensusModeParams StakeAddress NetworkId (Maybe OutputFile)
-  | QueryUTxO' AnyConsensusModeParams QueryUTxOFilter NetworkId (Maybe OutputFile)
+  | QueryUTxO'
+      AnyConsensusModeParams
+      QueryUTxOFilter
+      NetworkId
+      (Maybe OutputFile)
+      JsonOutput
   | QueryDebugLedgerState' AnyConsensusModeParams NetworkId (Maybe OutputFile)
   | QueryProtocolState' AnyConsensusModeParams NetworkId (Maybe OutputFile)
   | QueryStakeSnapshot' AnyConsensusModeParams NetworkId (Hash StakePoolKey)

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs
@@ -933,6 +933,7 @@ pQueryCmd =
         <*> pQueryUTxOFilter
         <*> pNetworkId
         <*> pMaybeOutputFile
+        <*> pJsonOutput
 
     pQueryStakePools :: Parser QueryCmd
     pQueryStakePools =
@@ -956,6 +957,10 @@ pQueryCmd =
         <*> pNetworkId
         <*> pMaybeOutputFile
 
+    pJsonOutput :: Parser JsonOutput
+    pJsonOutput =
+      JsonOutput <$> switch (long "json" <> Opt.help "Enable JSON output")
+
     pQueryLedgerState :: Parser QueryCmd
     pQueryLedgerState = QueryDebugLedgerState'
                           <$> pConsensusModeParams
@@ -1715,7 +1720,9 @@ pMaybeOutputFile =
       Opt.strOption
         (  Opt.long "out-file"
         <> Opt.metavar "FILE"
-        <> Opt.help "Optional output file. Default is to write to stdout."
+        <> Opt.help
+              "Optional output file. Default is to write to stdout. \
+              \Forces enabling JSON format (--json)."
         <> Opt.completer (Opt.bashCompleter "file")
         )
 

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DuplicateRecordFields #-}
@@ -184,8 +185,8 @@ runQueryCmd cmd =
       runQueryPoolParams consensusModeParams network poolid
     QueryProtocolState' consensusModeParams network mOutFile ->
       runQueryProtocolState consensusModeParams network mOutFile
-    QueryUTxO' consensusModeParams qFilter networkId mOutFile ->
-      runQueryUTxO consensusModeParams qFilter networkId mOutFile
+    QueryUTxO' consensusModeParams qFilter networkId mOutFile jsonOut ->
+      runQueryUTxO consensusModeParams qFilter networkId mOutFile jsonOut
     QueryKesPeriodInfo consensusModeParams network nodeOpCert mOutFile ->
       runQueryKesPeriodInfo consensusModeParams network nodeOpCert mOutFile
 
@@ -356,9 +357,10 @@ runQueryUTxO
   -> QueryUTxOFilter
   -> NetworkId
   -> Maybe OutputFile
+  -> JsonOutput
   -> ExceptT ShelleyQueryCmdError IO ()
 runQueryUTxO (AnyConsensusModeParams cModeParams)
-             qfilter network mOutFile = do
+             qfilter network mOutFile jsonOutput = do
   SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr readEnvSocketPath
   let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
 
@@ -375,7 +377,7 @@ runQueryUTxO (AnyConsensusModeParams cModeParams)
                   cModeParams
                   localNodeConnInfo
                   qInMode
-      writeFilteredUTxOs sbe mOutFile result
+      writeFilteredUTxOs sbe mOutFile jsonOutput result
     Nothing -> left $ ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE
 
 
@@ -855,37 +857,42 @@ writeProtocolState mOutFile ps@(ProtocolState pstate) =
 
 writeFilteredUTxOs :: Api.ShelleyBasedEra era
                    -> Maybe OutputFile
+                   -> JsonOutput
                    -> UTxO era
                    -> ExceptT ShelleyQueryCmdError IO ()
-writeFilteredUTxOs shelleyBasedEra' mOutFile utxo =
-    case mOutFile of
-      Nothing -> liftIO $ printFilteredUTxOs shelleyBasedEra' utxo
-      Just (OutputFile fpath) ->
-        case shelleyBasedEra' of
-          ShelleyBasedEraShelley -> writeUTxo fpath utxo
-          ShelleyBasedEraAllegra -> writeUTxo fpath utxo
-          ShelleyBasedEraMary -> writeUTxo fpath utxo
-          ShelleyBasedEraAlonzo -> writeUTxo fpath utxo
-          ShelleyBasedEraBabbage -> writeUTxo fpath utxo
+writeFilteredUTxOs shelleyBasedEra' mOutFile (JsonOutput isJsonOutputRequsted)
+                   utxo =
+  case mOutFile of
+    Nothing | isJsonOutputRequsted -> writeUtxoStdout
+    Nothing -> liftIO $ printFilteredUTxOs shelleyBasedEra' utxo
+    Just (OutputFile fpath) -> writeUtxo fpath
  where
-   writeUTxo fpath utxo' =
-     handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath)
-       $ LBS.writeFile fpath (encodePretty utxo')
+
+  writeUtxo fpath =
+    withAnyCardanoEra shelleyBasedEra' $ \_ ->
+      handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath)
+        $ LBS.writeFile fpath (encodePretty utxo)
+
+  writeUtxoStdout =
+    withAnyCardanoEra shelleyBasedEra' $ \_ ->
+      liftIO $ LBS.putStr (encodePretty utxo)
+
+withAnyCardanoEra :: Api.ShelleyBasedEra era
+                  -> (IsCardanoEra era => Api.ShelleyBasedEra era -> a)
+                  -> a
+withAnyCardanoEra e f =
+  case e of
+    ShelleyBasedEraShelley -> f e
+    ShelleyBasedEraAllegra -> f e
+    ShelleyBasedEraMary    -> f e
+    ShelleyBasedEraAlonzo  -> f e
+    ShelleyBasedEraBabbage -> f e
 
 printFilteredUTxOs :: Api.ShelleyBasedEra era -> UTxO era -> IO ()
 printFilteredUTxOs shelleyBasedEra' (UTxO utxo) = do
   Text.putStrLn title
   putStrLn $ replicate (Text.length title + 2) '-'
-  case shelleyBasedEra' of
-    ShelleyBasedEraShelley ->
-      mapM_ (printUtxo shelleyBasedEra') $ Map.toList utxo
-    ShelleyBasedEraAllegra ->
-      mapM_ (printUtxo shelleyBasedEra') $ Map.toList utxo
-    ShelleyBasedEraMary    ->
-      mapM_ (printUtxo shelleyBasedEra') $ Map.toList utxo
-    ShelleyBasedEraAlonzo ->
-      mapM_ (printUtxo shelleyBasedEra') $ Map.toList utxo
-    ShelleyBasedEraBabbage ->
+  withAnyCardanoEra shelleyBasedEra' \_ ->
       mapM_ (printUtxo shelleyBasedEra') $ Map.toList utxo
 
  where