cli: Add 'shelley query ledger-state' command

This command queries the node to the LedgerState to be returned as
CBOR-in-CBOR. If the node and the cli are compatible, the LedgerState
will be printed as JSON. If they are incompatible it will be printed
as generic decoded CBOR.

cardano-api/src/Cardano/Api.hs

@@ -62,6 +62,7 @@ module Cardano.Api
   , LocalStateQueryError (..)
   , renderLocalStateQueryError
   , queryFilteredUTxOFromLocalState
+  , queryLocalLedgerState
   , queryPParamsFromLocalState
   , queryStakeDistributionFromLocalState
 

cardano-api/src/Cardano/Api/LocalStateQuery.hs

@@ -7,6 +7,7 @@
 module Cardano.Api.LocalStateQuery
   ( LocalStateQueryError (..)
   , renderLocalStateQueryError
+  , queryLocalLedgerState
   , queryFilteredUTxOFromLocalState
   , Ledger.UTxO(..)
   , queryPParamsFromLocalState
@@ -19,7 +20,7 @@ import           Cardano.Prelude hiding (atomically, option, threadDelay)
 
 import           Cardano.Api.Types (Network, toNetworkMagic, Address (..), ByronAddress, ShelleyAddress)
 import           Cardano.Api.TxSubmit.Types (textShow)
-
+import           Cardano.Binary (decodeFull)
 import           Cardano.BM.Data.Tracer (ToLogObject (..), nullTracer)
 import           Cardano.BM.Trace (Trace, appendName, logInfo)
 
@@ -53,7 +54,7 @@ import           Ouroboros.Consensus.Node.Run (RunNode)
 import           Ouroboros.Consensus.Shelley.Ledger
 import           Ouroboros.Consensus.Shelley.Protocol.Crypto (TPraosStandardCrypto)
 
-import           Ouroboros.Network.Block (Point)
+import           Ouroboros.Network.Block (Point, Serialised (..))
 import           Ouroboros.Network.Mux
                    ( AppType(..), OuroborosApplication(..),
                      MuxPeer(..), RunMiniProtocol(..))
@@ -70,6 +71,7 @@ import           Ouroboros.Network.Protocol.LocalStateQuery.Type (AcquireFailure
 import qualified Shelley.Spec.Ledger.PParams as Ledger (PParams)
 import qualified Shelley.Spec.Ledger.UTxO as Ledger (UTxO(..))
 import qualified Shelley.Spec.Ledger.Delegation.Certificates as Ledger (PoolDistr(..))
+import qualified Shelley.Spec.Ledger.LedgerState as Ledger
 
 -- | An error that can occur while querying a node's local state.
 data LocalStateQueryError
@@ -149,6 +151,27 @@ queryStakeDistributionFromLocalState network socketPath point = do
       socketPath
       pointAndQuery
 
+queryLocalLedgerState
+  :: blk ~ ShelleyBlock TPraosStandardCrypto
+  => Network
+  -> SocketPath
+  -> Point blk
+  -> ExceptT LocalStateQueryError IO (Either LByteString (Ledger.LedgerState TPraosStandardCrypto))
+queryLocalLedgerState network socketPath point = do
+  lbs <- fmap unSerialised <$>
+            newExceptT . liftIO $
+              queryNodeLocalState
+                nullTracer
+                (pClientInfoCodecConfig . protocolClientInfo $ mkNodeClientProtocolTPraos)
+                network
+                socketPath
+                (point, GetCBOR GetCurrentLedgerState) -- Get CBOR-in-CBOR version
+  case decodeFull lbs of
+    Right lstate -> pure $ Right lstate
+    Left _ -> pure $ Left lbs
+
+-- -------------------------------------------------------------------------------------------------
+
 -- | Establish a connection to a node and execute the provided query
 -- via the local state query protocol.
 --

cardano-cli/cardano-cli.cabal

@@ -42,6 +42,7 @@ library
                        Cardano.CLI.Byron.Vote
 
                        Cardano.CLI.Shelley.Commands
+                       Cardano.CLI.Shelley.KeyGen
                        Cardano.CLI.Shelley.Parsers
                        Cardano.CLI.Shelley.Run
                        Cardano.CLI.Shelley.Run.Address
@@ -53,7 +54,6 @@ library
                        Cardano.CLI.Shelley.Run.Query
                        Cardano.CLI.Shelley.Run.Genesis
                        Cardano.CLI.Shelley.Run.TextView
-                       Cardano.CLI.Shelley.KeyGen
 
   other-modules:       Paths_cardano_cli
 

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

@@ -152,6 +152,7 @@ data QueryCmd
   | QueryFilteredUTxO Address Network (Maybe OutputFile)
   | QueryStakeDistribution Network (Maybe OutputFile)
   | QueryVersion NodeAddress
+  | QueryLedgerState Network (Maybe OutputFile)
   | QueryStatus NodeAddress
   deriving (Eq, Show)
 

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

@@ -358,6 +358,8 @@ pQueryCmd =
           (Opt.info pQueryStakeDistribution $ Opt.progDesc "Get the node's current aggregated stake distribution")
       , Opt.command "version"
           (Opt.info pQueryVersion $ Opt.progDesc "Get the node version")
+      , Opt.command "ledger-state"
+          (Opt.info pQueryLedgerState $ Opt.progDesc "Dump the current state of the node")
       , Opt.command "status"
           (Opt.info pQueryStatus $ Opt.progDesc "Get the status of the node")
       ]
@@ -390,6 +392,9 @@ pQueryCmd =
     pQueryVersion :: Parser QueryCmd
     pQueryVersion = QueryVersion <$> parseNodeAddress
 
+    pQueryLedgerState :: Parser QueryCmd
+    pQueryLedgerState = QueryLedgerState <$> pNetwork <*> pMaybeOutputFile
+
     pQueryStatus :: Parser QueryCmd
     pQueryStatus = QueryStatus <$> parseNodeAddress
 

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

@@ -20,19 +20,22 @@ import           Numeric (showEFloat)
 import           Control.Monad.Trans.Except (ExceptT)
 import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT)
 
-import           Cardano.Crypto.Hash.Class (getHashBytesAsHex)
-
 import           Cardano.Api
                    (Address, LocalStateQueryError, Network(..), getLocalTip,
-                    queryFilteredUTxOFromLocalState, queryPParamsFromLocalState,
-                    queryStakeDistributionFromLocalState)
+                    queryFilteredUTxOFromLocalState, queryLocalLedgerState,
+                    queryPParamsFromLocalState, queryStakeDistributionFromLocalState)
 
 import           Cardano.CLI.Environment (EnvSocketError, readEnvSocketPath)
 import           Cardano.CLI.Helpers
 import           Cardano.CLI.Shelley.Parsers (OutputFile (..), QueryCmd (..))
 
+import           Cardano.Config.Shelley.Orphans ()
 import           Cardano.Config.Shelley.Protocol (mkNodeClientProtocolTPraos)
 
+import           Cardano.Crypto.Hash.Class (getHashBytesAsHex)
+
+import           Data.Aeson (ToJSON)
+
 import           Ouroboros.Consensus.Cardano (protocolClientInfo)
 import           Ouroboros.Consensus.Node.ProtocolInfo (pClientInfoCodecConfig)
 import           Ouroboros.Consensus.Shelley.Protocol.Crypto (TPraosStandardCrypto)
@@ -45,8 +48,7 @@ import           Shelley.Spec.Ledger.TxData (TxId (..), TxIn (..), TxOut (..))
 import           Shelley.Spec.Ledger.UTxO (UTxO (..))
 import           Shelley.Spec.Ledger.PParams (PParams)
 import           Shelley.Spec.Ledger.Delegation.Certificates (PoolDistr(..))
-import           Shelley.Spec.Ledger.Keys
-                   (Hash, KeyHash(..), KeyRole (..), VerKeyVRF)
+import           Shelley.Spec.Ledger.Keys (Hash, KeyHash(..), KeyRole (..), VerKeyVRF)
 
 
 data ShelleyQueryCmdError
@@ -67,6 +69,8 @@ runQueryCmd cmd =
       runQueryFilteredUTxO addr network mOutFile
     QueryStakeDistribution network mOutFile ->
       runQueryStakeDistribution network mOutFile
+    QueryLedgerState network mOutFile ->
+      runQueryLedgerState network mOutFile
     _ -> liftIO $ putStrLn $ "runQueryCmd: " ++ show cmd
 
 runQueryProtocolParameters
@@ -109,11 +113,40 @@ runQueryFilteredUTxO addr network mOutFile = do
   sockPath <- firstExceptT ShelleyQueryEnvVarSocketErr readEnvSocketPath
   let ptclClientInfo = pClientInfoCodecConfig . protocolClientInfo $ mkNodeClientProtocolTPraos
   tip <- liftIO $ withIOManager $ \iomgr ->
-    getLocalTip iomgr ptclClientInfo network sockPath
+            getLocalTip iomgr ptclClientInfo network sockPath
   filteredUtxo <- firstExceptT NodeLocalStateQueryError $
-    queryFilteredUTxOFromLocalState network sockPath (Set.singleton addr) (getTipPoint tip)
+            queryFilteredUTxOFromLocalState network sockPath (Set.singleton addr) (getTipPoint tip)
   writeFilteredUTxOs mOutFile filteredUtxo
 
+runQueryLedgerState
+  :: Network
+  -> Maybe OutputFile
+  -> ExceptT ShelleyQueryCmdError IO ()
+runQueryLedgerState network mOutFile = do
+  sockPath <- firstExceptT ShelleyQueryEnvVarSocketErr readEnvSocketPath
+  let ptclClientInfo = pClientInfoCodecConfig . protocolClientInfo $ mkNodeClientProtocolTPraos
+  tip <- liftIO $ withIOManager $ \iomgr ->
+            getLocalTip iomgr ptclClientInfo network sockPath
+  els <- firstExceptT NodeLocalStateQueryError $
+                      queryLocalLedgerState network sockPath (getTipPoint tip)
+  case els of
+    Right lstate -> maybePrintFileJson mOutFile lstate
+    Left lbs -> do
+      liftIO $ putTextLn "Verion mismatch beteen node and consensus, so dumping this as generic CBOR."
+      firstExceptT ShelleyHelperError $ pPrintCBOR lbs
+
+-- -------------------------------------------------------------------------------------------------
+
+maybePrintFileJson :: ToJSON a => Maybe OutputFile -> a -> ExceptT ShelleyQueryCmdError IO ()
+maybePrintFileJson mOutputFile x = do
+  let jsonX = encodePretty x
+  case mOutputFile of
+    Just (OutputFile fpath) ->
+      handleIOExceptT (ShelleyHelperError . IOError' fpath)
+          $ LBS.writeFile fpath jsonX
+    Nothing -> liftIO $ LBS.putStrLn jsonX
+
+
 writeFilteredUTxOs :: Maybe OutputFile -> UTxO TPraosStandardCrypto -> ExceptT ShelleyQueryCmdError IO ()
 writeFilteredUTxOs mOutFile utxo =
     case mOutFile of
@@ -155,27 +188,27 @@ runQueryStakeDistribution network mOutFile = do
   let ptclClientInfo = pClientInfoCodecConfig . protocolClientInfo $ mkNodeClientProtocolTPraos
   tip <- liftIO $ withIOManager $ \iomgr ->
     getLocalTip iomgr ptclClientInfo network sockPath
-  stakeDistr <- firstExceptT NodeLocalStateQueryError $
+  stakeDist <- firstExceptT NodeLocalStateQueryError $
     queryStakeDistributionFromLocalState network sockPath (getTipPoint tip)
-  writeStakeDistribution mOutFile stakeDistr
+  writeStakeDistribution mOutFile stakeDist
 
 writeStakeDistribution :: Maybe OutputFile
                        -> PoolDistr TPraosStandardCrypto
                        -> ExceptT ShelleyQueryCmdError IO ()
-writeStakeDistribution (Just (OutputFile outFile)) (PoolDistr stakeDistr) =
+writeStakeDistribution (Just (OutputFile outFile)) (PoolDistr stakeDist) =
     handleIOExceptT (ShelleyHelperError . IOError' outFile) $
-      LBS.writeFile outFile (encodePretty stakeDistr)
+      LBS.writeFile outFile (encodePretty stakeDist)
 
-writeStakeDistribution Nothing stakeDistr =
-    liftIO $ printStakeDistribution stakeDistr
+writeStakeDistribution Nothing stakeDist =
+    liftIO $ printStakeDistribution stakeDist
 
 printStakeDistribution :: PoolDistr TPraosStandardCrypto -> IO ()
-printStakeDistribution (PoolDistr stakeDistr) = do
+printStakeDistribution (PoolDistr stakeDist) = do
     Text.putStrLn title
     putStrLn $ replicate (Text.length title + 2) '-'
     sequence_
       [ putStrLn $ showStakeDistr poolId stakeFraction vrfKeyId
-      | (poolId, (stakeFraction, vrfKeyId)) <- Map.toList stakeDistr ]
+      | (poolId, (stakeFraction, vrfKeyId)) <- Map.toList stakeDist ]
   where
     title :: Text
     title =