cli: Add 'shelley query ledger-state' command

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,29 @@ 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
+  -- If decode as a LedgerState fails we return the ByteString so we can do a generic
+  -- CBOR decode.
+  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 =

cardano-config/src/Cardano/Config/Shelley/Orphans.hs

@@ -14,37 +14,50 @@ module Cardano.Config.Shelley.Orphans () where
 import           Cardano.Prelude
 
 import           Control.Monad.Fail (fail)
-import           Data.Aeson
+import           Data.Aeson (FromJSON (..), FromJSONKey (..), FromJSONKeyFunction (..), ToJSON (..),
+                    ToJSONKey (..), ToJSONKeyFunction (..), Value (..), (.=), (.:), (.!=), (.:?))
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Encoding as Aeson
 import           Data.Aeson.Types (Parser)
+import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Base16 as Base16
+import           Data.ByteString.Char8 as BS
+import           Data.Char (isPrint)
+import           Data.IP (IPv4, IPv6)
+import           Data.Sequence.Strict (StrictSeq (..))
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 
 import           Cardano.Crypto.Hash.Class as Crypto
 import           Cardano.Slotting.Slot (EpochSize (..))
 import           Cardano.TracingOrphanInstances.Common () -- For ToJSON EpochNo
-import           Ouroboros.Consensus.BlockchainTime
-                   (SlotLength (..), SystemStart (..))
+import           Ouroboros.Consensus.BlockchainTime (SlotLength (..), SystemStart (..))
 import           Ouroboros.Consensus.BlockchainTime.WallClock.Types
 import           Ouroboros.Network.Magic (NetworkMagic (..))
 import           Ouroboros.Consensus.Protocol.Abstract (SecurityParam (..))
-import           Ouroboros.Consensus.Shelley.Node
-                   (ShelleyGenesis (..), emptyGenesisStaking)
+import           Ouroboros.Consensus.Shelley.Node (ShelleyGenesis (..), emptyGenesisStaking)
+import           Ouroboros.Consensus.Shelley.Protocol.Crypto (TPraosStandardCrypto)
+
 import           Shelley.Spec.Ledger.Address (Addr(..), serialiseAddr, deserialiseAddr)
-import           Shelley.Spec.Ledger.BaseTypes
-                   (Nonce (..), UnitInterval (..), truncateUnitInterval)
+import           Shelley.Spec.Ledger.BaseTypes (DnsName, Nonce (..), Port, StrictMaybe,
+                    UnitInterval (..), truncateUnitInterval)
 import           Shelley.Spec.Ledger.Coin (Coin(..))
 import           Shelley.Spec.Ledger.Credential (RewardAcnt (..), StakeCredential, Credential (..))
+import qualified Shelley.Spec.Ledger.Credential as Ledger
 import           Shelley.Spec.Ledger.Crypto (Crypto)
 import           Shelley.Spec.Ledger.Keys (KeyHash(..))
+import qualified Shelley.Spec.Ledger.Keys as Ledger
+import qualified Shelley.Spec.Ledger.LedgerState as Ledger
 import           Shelley.Spec.Ledger.MetaData (MetaDataHash(..))
 import           Shelley.Spec.Ledger.PParams (PParams, PParams' (..), ProtVer (..))
+import qualified Shelley.Spec.Ledger.PParams as Ledger
 import           Shelley.Spec.Ledger.Scripts (ScriptHash (..))
 import           Shelley.Spec.Ledger.TxData (TxId(..), TxIn(..), TxOut(..))
+import qualified Shelley.Spec.Ledger.TxData as Ledger
 import           Shelley.Spec.Ledger.UTxO (UTxO(..))
 
+
+
 instance Crypto crypto => ToJSON (ShelleyGenesis crypto) where
   toJSON sg =
     Aeson.object
@@ -202,28 +215,28 @@ deriving newtype instance Crypto c => ToJSON (UTxO c)
 -- These ones are all just newtype wrappers of numbers,
 -- so newtype deriving for the JSON format is ok.
 
-deriving newtype instance Aeson.ToJSON   Coin
-deriving newtype instance Aeson.FromJSON Coin
+deriving newtype instance ToJSON   Coin
+deriving newtype instance FromJSON Coin
 
-deriving newtype instance Aeson.ToJSON   EpochSize
-deriving newtype instance Aeson.FromJSON EpochSize
+deriving newtype instance ToJSON   EpochSize
+deriving newtype instance FromJSON EpochSize
 
-deriving newtype instance Aeson.ToJSON   NetworkMagic
-deriving newtype instance Aeson.FromJSON NetworkMagic
+deriving newtype instance ToJSON   NetworkMagic
+deriving newtype instance FromJSON NetworkMagic
 
-deriving newtype instance Aeson.ToJSON   SecurityParam
-deriving newtype instance Aeson.FromJSON SecurityParam
+deriving newtype instance ToJSON   SecurityParam
+deriving newtype instance FromJSON SecurityParam
 
 -- A 'NominalDiffTime' time
-instance Aeson.ToJSON   SlotLength where
+instance ToJSON   SlotLength where
   toJSON = toJSON . getSlotLength
 
-instance Aeson.FromJSON SlotLength where
+instance FromJSON SlotLength where
   parseJSON = fmap mkSlotLength . parseJSON
 
 -- A UTCTime, with format like "2020-04-15 11:44:07"
-deriving newtype instance Aeson.ToJSON   SystemStart
-deriving newtype instance Aeson.FromJSON SystemStart
+deriving newtype instance ToJSON   SystemStart
+deriving newtype instance FromJSON SystemStart
 
 deriving newtype instance ToJSONKey (RewardAcnt c)
 
@@ -296,3 +309,47 @@ parseAddr t = do
   where
     badHex h = fail $ "Addresses are expected in hex encoding for now: " ++ show h
     badFormat = fail "Address is not in the right format"
+
+-- We are deriving ToJSON instances for all of these types mainly so we can dump
+-- a JSON representation for the purposes of debug. Therefore ByteString that are
+-- not printable should be hex encoded for readability.
+instance ToJSON ByteString where
+  toJSON bs =
+    toJSON $
+      if BS.all isPrint bs
+        then bs
+        else Base16.encode bs
+
+instance ToJSON a => ToJSON (StrictSeq a) where
+  toJSON ss =
+    toJSON $ toList (getSeq ss)
+
+deriving instance ToJSON a => ToJSON (StrictMaybe a)
+
+deriving anyclass instance ToJSON DnsName
+deriving anyclass instance ToJSON IPv4
+deriving anyclass instance ToJSON IPv6
+deriving anyclass instance ToJSON Ledger.Url
+deriving anyclass instance ToJSON Port
+
+deriving anyclass instance ToJSON (Ledger.GenDelegs TPraosStandardCrypto)
+deriving anyclass instance ToJSON (Ledger.ProposedPPUpdates TPraosStandardCrypto)
+deriving anyclass instance ToJSON (Ledger.StakeCreds TPraosStandardCrypto)
+deriving anyclass instance ToJSON (Ledger.StakePools TPraosStandardCrypto)
+
+deriving instance ToJSON Ledger.PoolMetaData
+deriving instance ToJSON Ledger.Ptr
+deriving instance ToJSON Ledger.StakePoolRelay
+
+deriving instance ToJSON (Ledger.DPState TPraosStandardCrypto)
+deriving instance ToJSON (Ledger.DState TPraosStandardCrypto)
+deriving instance ToJSON (Ledger.FutureGenDeleg TPraosStandardCrypto)
+deriving instance ToJSON (Ledger.LedgerState TPraosStandardCrypto)
+deriving instance ToJSON (Ledger.PoolParams TPraosStandardCrypto)
+deriving instance ToJSON (Ledger.PParams' StrictMaybe)
+deriving instance ToJSON (Ledger.PState TPraosStandardCrypto)
+deriving instance ToJSON (Ledger.StakeReference TPraosStandardCrypto)
+deriving instance ToJSON (Ledger.UTxOState TPraosStandardCrypto)
+
+deriving instance ToJSONKey Ledger.Ptr
+deriving instance ToJSONKey (Ledger.FutureGenDeleg TPraosStandardCrypto)