cli: Pretty print output of 'query filtered-utxo' command

Author: erikd

cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs

@@ -116,7 +116,7 @@ data QueryCmd
   = QueryPoolId NodeAddress
   | QueryProtocolParameters ConfigYamlFilePath OutputFile
   | QueryTip NodeAddress
-  | QueryFilteredUTxO Address ConfigYamlFilePath OutputFile
+  | QueryFilteredUTxO Address ConfigYamlFilePath
   | QueryVersion NodeAddress
   | QueryStatus NodeAddress
   deriving (Eq, Show)
@@ -468,7 +468,6 @@ pQueryCmd =
       QueryFilteredUTxO
         <$> pHexEncodedAddress
         <*> (ConfigYamlFilePath <$> parseConfigFile)
-        <*> pOutputFile
 
     pQueryVersion :: Parser QueryCmd
     pQueryVersion = QueryVersion <$> parseNodeAddress

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

@@ -23,26 +23,33 @@ import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT
 
 import           Data.Aeson.Encode.Pretty (encodePretty)
 import qualified Data.ByteString.Lazy.Char8 as LBS
+import qualified Data.Map as Map
 import qualified Data.Set as Set
+import qualified Data.Text as Text
+import qualified Data.Text.IO as Text
 
 import           Ouroboros.Consensus.Cardano (Protocol (..), protocolInfo)
 import           Ouroboros.Consensus.Config (configCodec)
 import           Ouroboros.Consensus.Node.ProtocolInfo (ProtocolInfo(..))
 import           Ouroboros.Consensus.Node.Run (nodeNetworkMagic)
+import           Ouroboros.Consensus.Shelley.Protocol.Crypto (TPraosStandardCrypto)
 import           Ouroboros.Network.NodeToClient (withIOManager)
 
 import           Ouroboros.Network.Block (getTipPoint)
 
+import           Shelley.Spec.Ledger.Coin (Coin (..))
 import           Shelley.Spec.Ledger.PParams (PParams)
+import           Shelley.Spec.Ledger.TxData (TxId (..), TxIn (..), TxOut (..))
+import           Shelley.Spec.Ledger.UTxO (UTxO (..))
 
 
 runQueryCmd :: QueryCmd -> ExceptT CliError IO ()
 runQueryCmd cmd =
   case cmd of
     QueryProtocolParameters configFp outFile ->
       runQueryProtocolParameters configFp outFile
-    QueryFilteredUTxO addr configFp outFile ->
-      runQueryFilteredUTxO addr configFp outFile
+    QueryFilteredUTxO addr configFp ->
+      runQueryFilteredUTxO addr configFp
     _ -> liftIO $ putStrLn $ "runQueryCmd: " ++ show cmd
 
 runQueryProtocolParameters
@@ -70,9 +77,8 @@ runQueryProtocolParameters configFp (OutputFile outFile) = do
 runQueryFilteredUTxO
   :: Address
   -> ConfigYamlFilePath
-  -> OutputFile
   -> ExceptT CliError IO ()
-runQueryFilteredUTxO addr configFp (OutputFile _outFile) = do
+runQueryFilteredUTxO addr configFp = do
     nc <- liftIO $ parseNodeConfigurationFP configFp
     SomeConsensusProtocol p <- firstExceptT ProtocolError $ mkConsensusProtocol nc Nothing
 
@@ -83,7 +89,7 @@ runQueryFilteredUTxO addr configFp (OutputFile _outFile) = do
         filteredUtxo <- firstExceptT NodeLocalStateQueryError $
           queryFilteredUTxOFromLocalState cfg nm sockPath
                                           (Set.singleton addr) (getTipPoint tip)
-        liftIO $ putStrLn $ "Filtered UTxO: " ++ show filteredUtxo
+        liftIO $ printFilteredUTxOs filteredUtxo
         where
           cfg = configCodec ptclcfg
           --FIXME: this works, but we should get the magic properly:
@@ -95,3 +101,29 @@ runQueryFilteredUTxO addr configFp (OutputFile _outFile) = do
 writeProtocolParameters :: FilePath -> PParams -> ExceptT CliError IO ()
 writeProtocolParameters fpath pparams =
   handleIOExceptT (IOError fpath) $ LBS.writeFile fpath (encodePretty pparams)
+
+
+printFilteredUTxOs :: UTxO TPraosStandardCrypto -> IO ()
+printFilteredUTxOs (UTxO utxo) = do
+    Text.putStrLn title
+    putStrLn $ replicate (Text.length title + 2) '-'
+    mapM_ printUtxo $ Map.toList utxo
+  where
+    title :: Text
+    title =
+      "                           TxHash                                 TxId        Lovelace"
+
+    printUtxo :: (TxIn TPraosStandardCrypto, TxOut TPraosStandardCrypto) -> IO ()
+    printUtxo (TxIn (TxId txhash) txin , TxOut _ (Coin coin)) =
+      Text.putStrLn $
+        mconcat
+          [ Text.pack (show txhash)
+          , textShowN 6 txin
+          , textShowN 18 coin -- enough to display maxLovelaceVal
+          ]
+
+    textShowN :: Show a => Int -> a -> Text
+    textShowN len x =
+      let str = show x
+          slen = length str
+      in Text.pack $ replicate (max 1 (len - slen)) ' ' ++ str