Implement query protocol state in cardano-cli using the new api

cardano-api/cardano-api.cabal

@@ -23,6 +23,7 @@ library
                         -- is fully integrated, or re-exported via the export
                         -- modules above
                         Cardano.Api.Crypto.Ed25519Bip32
+                        Cardano.Api.Eras
                         Cardano.Api.LocalChainSync
                         Cardano.Api.Modes
                         Cardano.Api.Protocol
@@ -31,6 +32,7 @@ library
                         Cardano.Api.Protocol.Cardano
                         Cardano.Api.Protocol.Shelley
                         Cardano.Api.Protocol.Types
+                        Cardano.Api.Query
                         Cardano.Api.Shelley.Genesis
                         Cardano.Api.TxInMode
                         Cardano.Api.TxSubmit
@@ -49,7 +51,6 @@ library
                         Cardano.Api.Address
                         Cardano.Api.Block
                         Cardano.Api.Certificate
-                        Cardano.Api.Eras
                         Cardano.Api.Error
                         Cardano.Api.Fees
                         Cardano.Api.Hash
@@ -62,7 +63,7 @@ library
                         Cardano.Api.NetworkId
                         Cardano.Api.OperationalCertificate
 -- TODO: move here      Cardano.Api.ProtocolParameters
-                        Cardano.Api.Query
+-- TODO: move here      Cardano.Api.Query
                         Cardano.Api.Script
                         Cardano.Api.SerialiseBech32
                         Cardano.Api.SerialiseCBOR

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

@@ -1,7 +1,7 @@
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE PatternSynonyms #-}
 
 
 -- | Cardano eras, sometimes we have to distinguish them.
@@ -43,12 +43,12 @@ module Cardano.Api.Eras
 
 import           Prelude
 
-import           Data.Type.Equality (TestEquality(..), (:~:)(Refl))
+import           Data.Type.Equality ((:~:) (Refl), TestEquality (..))
 
 import           Cardano.Ledger.Era as Ledger (Crypto)
 
-import           Ouroboros.Consensus.Shelley.Eras as Ledger
-                   (StandardShelley, StandardAllegra, StandardMary, StandardCrypto)
+import           Ouroboros.Consensus.Shelley.Eras as Ledger (StandardAllegra, StandardCrypto,
+                     StandardMary, StandardShelley)
 
 import           Cardano.Api.HasTypeProxy
 

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

@@ -50,7 +50,6 @@ import           Prelude
 
 import           Cardano.Api
 import           Cardano.Api.Modes
-import           Cardano.Api.Protocol (Protocol)
 import           Cardano.Api.Shelley hiding (PoolId)
 
 import           Ouroboros.Consensus.BlockchainTime (SystemStart (..))
@@ -278,7 +277,7 @@ data QueryCmd =
   | QueryStakeAddressInfo AnyCardanoEra AnyConsensusModeParams StakeAddress NetworkId (Maybe OutputFile)
   | QueryUTxO AnyCardanoEra AnyConsensusModeParams QueryFilter NetworkId (Maybe OutputFile)
   | QueryLedgerState AnyCardanoEra AnyConsensusModeParams NetworkId (Maybe OutputFile)
-  | QueryProtocolState AnyCardanoEra Protocol NetworkId (Maybe OutputFile)
+  | QueryProtocolState AnyCardanoEra AnyConsensusModeParams NetworkId (Maybe OutputFile)
   deriving (Eq, Show)
 
 renderQueryCmd :: QueryCmd -> Text

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

@@ -18,7 +18,6 @@ import           Prelude (String)
 
 import           Cardano.Api
 import           Cardano.Api.Modes
-import           Cardano.Api.Protocol (Protocol (..))
 import           Cardano.Api.Shelley
 
 import           Cardano.Chain.Slotting (EpochSlots (..))
@@ -709,7 +708,7 @@ pQueryCmd =
     pQueryProtocolState :: Parser QueryCmd
     pQueryProtocolState = QueryProtocolState
                             <$> pCardanoEra
-                            <*> pProtocol
+                            <*> pConsensusModeParams
                             <*> pNetworkId
                             <*> pMaybeOutputFile
 
@@ -2303,43 +2302,6 @@ pConsensusModeParams = asum
    pByronConsensusMode :: Parser AnyConsensusModeParams
    pByronConsensusMode = AnyConsensusModeParams . ByronModeParams <$> pEpochSlots
 
-pProtocol :: Parser Protocol
-pProtocol =
-    (  Opt.flag' ()
-        (  Opt.long "shelley-mode"
-        <> Opt.help "For talking to a node running in Shelley-only mode."
-        )
-    *> pShelleyMode
-    )
-  <|>
-    (  Opt.flag' ()
-        (  Opt.long "byron-mode"
-        <> Opt.help "For talking to a node running in Byron-only mode."
-        )
-    *> pByronMode
-    )
-  <|>
-    (  Opt.flag' ()
-        (  Opt.long "cardano-mode"
-        <> Opt.help "For talking to a node running in full Cardano mode (default)."
-        )
-    *> pCardanoMode
-    )
-  <|>
-    -- Default to the Cardano protocol.
-    pure
-      (CardanoProtocol
-        (EpochSlots defaultByronEpochSlots))
-  where
-    pByronMode :: Parser Protocol
-    pByronMode = ByronProtocol <$> pEpochSlots
-
-    pShelleyMode :: Parser Protocol
-    pShelleyMode = pure ShelleyProtocol
-
-    pCardanoMode :: Parser Protocol
-    pCardanoMode = CardanoProtocol <$> pEpochSlots
-
 defaultByronEpochSlots :: Word64
 defaultByronEpochSlots = 21600
 

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

@@ -31,22 +31,19 @@ import qualified Data.Text.IO as Text
 import qualified Data.Vector as Vector
 import           Numeric (showEFloat)
 
-import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistMaybe, left,
-                     newExceptT)
+import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistMaybe, left)
 
 import           Cardano.Api
 import           Cardano.Api.Byron
 import qualified Cardano.Api.IPC as NewIPC
-import           Cardano.Api.LocalChainSync (getLocalTip)
 import           Cardano.Api.Modes (AnyConsensusModeParams (..), toEraInMode)
 import qualified Cardano.Api.Modes as Mode
-import           Cardano.Api.Protocol
 import           Cardano.Api.ProtocolParameters
 import qualified Cardano.Api.Query as Query
 import           Cardano.Api.Shelley
 
 import           Cardano.CLI.Environment (EnvSocketError, readEnvSocketPath, renderEnvSocketError)
-import           Cardano.CLI.Helpers (HelpersError, pPrintCBOR, renderHelpersError)
+import           Cardano.CLI.Helpers (HelpersError (..), pPrintCBOR, renderHelpersError)
 import           Cardano.CLI.Mary.RenderValue (defaultRenderValueOptions, renderValue)
 import           Cardano.CLI.Shelley.Orphans ()
 import           Cardano.CLI.Shelley.Parsers (OutputFile (..), QueryCmd (..))
@@ -55,20 +52,14 @@ import           Cardano.CLI.Types
 import           Cardano.Binary (decodeFull)
 import           Cardano.Crypto.Hash (hashToBytesAsHex)
 
-import           Ouroboros.Consensus.Cardano.Block as Consensus (Either (..), EraMismatch (..),
-                     Query (..))
-import qualified Ouroboros.Consensus.Cardano.Block as Consensus
-import           Ouroboros.Consensus.HardFork.Combinator.Degenerate as Consensus
-import           Ouroboros.Network.Block (Serialised (..), getTipPoint)
-
-import qualified Shelley.Spec.Ledger.API.Protocol as Ledger
-import           Shelley.Spec.Ledger.Scripts ()
-
-import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
-import           Ouroboros.Consensus.Shelley.Protocol (StandardCrypto)
+import           Ouroboros.Consensus.Cardano.Block as Consensus (EraMismatch (..), StandardCrypto)
+import           Ouroboros.Network.Block (Serialised (..))
 
+import qualified Cardano.Ledger.Crypto as Crypto
 import           Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery
                      (AcquireFailure (..))
+import qualified Shelley.Spec.Ledger.API.Protocol as Ledger
+import           Shelley.Spec.Ledger.Scripts ()
 
 data ShelleyQueryCmdError
   = ShelleyQueryCmdEnvVarSocketErr !EnvSocketError
@@ -110,8 +101,8 @@ runQueryCmd cmd =
       runQueryStakeAddressInfo era consensusModeParams addr network mOutFile
     QueryLedgerState era consensusModeParams network mOutFile ->
       runQueryLedgerState era consensusModeParams network mOutFile
-    QueryProtocolState era protocol network mOutFile ->
-      runQueryProtocolState era protocol network mOutFile
+    QueryProtocolState era consensusModeParams network mOutFile ->
+      runQueryProtocolState era consensusModeParams network mOutFile
     QueryUTxO era protocol qFilter networkId mOutFile ->
       runQueryUTxO era protocol qFilter networkId mOutFile
 
@@ -228,25 +219,29 @@ runQueryLedgerState anyEra@(AnyCardanoEra era) anyCmodeParams@(AnyConsensusModeP
 
 runQueryProtocolState
   :: AnyCardanoEra
-  -> Protocol
+  -> AnyConsensusModeParams
   -> NetworkId
   -> Maybe OutputFile
   -> ExceptT ShelleyQueryCmdError IO ()
-runQueryProtocolState (AnyCardanoEra era) protocol network mOutFile
-  | ShelleyBasedEra era' <- cardanoEraStyle era = do
+runQueryProtocolState anyEra@(AnyCardanoEra era) anyCmodeParams@(AnyConsensusModeParams cModeParams)
+                      network mOutFile = do
 
     SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr readEnvSocketPath
-    els <- firstExceptT ShelleyQueryCmdLocalStateQueryError $
-      withlocalNodeConnectInfo protocol network sockPath $
-        queryLocalProtocolState era'
-    case els of
-      Right protocolState -> writeProtocolState mOutFile protocolState
-      Left pbs -> do
-        liftIO $ putTextLn "Version mismatch between node and consensus, so dumping this as generic CBOR."
-        firstExceptT ShelleyQueryCmdHelpersError $ pPrintCBOR pbs
-
-    | otherwise = throwError (ShelleyQueryCmdLocalStateQueryError
-                              ByronProtocolNotSupportedError)
+    eraInMode <- hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch anyEra anyCmodeParams)
+                  $ toEraInMode cModeParams era
+
+    let localNodeConnInfo = NewIPC.LocalNodeConnectInfo cModeParams network sockPath
+        qInMode = NewIPC.createQueryInMode eraInMode NewIPC.QueryProtocolState
+
+    tip <- liftIO $ NewIPC.getLocalChainTip localNodeConnInfo
+    res <- liftIO $ NewIPC.queryNodeLocalState localNodeConnInfo tip qInMode
+    case res of
+      Left acqFailure -> left $ ShelleyQueryCmdAcquireFailure acqFailure
+      Right eStakeDist ->
+        case eStakeDist of
+          Left mismatch -> left $ ShelleyQueryCmdEraMismatch mismatch
+          Right stakeDist -> writeProtocolState mOutFile stakeDist
+
 
 -- | Query the current delegations and reward accounts, filtered by a given
 -- set of addresses, from a Shelley node via the local state query protocol.
@@ -326,15 +321,24 @@ writeLedgerState mOutFile (Query.LedgerState serLedgerState) =
       handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath)
         $ LBS.writeFile fpath $ unSerialised serLedgerState
 
-writeProtocolState :: Maybe OutputFile
-                   -> Ledger.ChainDepState StandardCrypto
+writeProtocolState :: Crypto.Crypto StandardCrypto
+                   => Maybe OutputFile
+                   -> Query.ProtocolState era
                    -> ExceptT ShelleyQueryCmdError IO ()
-writeProtocolState mOutFile pstate =
+writeProtocolState mOutFile ps@(Query.ProtocolState pstate) =
   case mOutFile of
-    Nothing -> liftIO $ LBS.putStrLn (encodePretty pstate)
+    Nothing -> case decodeProtocolState ps of
+                 Left bs -> firstExceptT ShelleyQueryCmdHelpersError $ pPrintCBOR bs
+                 Right chainDepstate -> liftIO . LBS.putStrLn $ encodePretty chainDepstate
     Just (OutputFile fpath) ->
       handleIOExceptT (ShelleyQueryCmdWriteFileError . FileIOError fpath)
-        $ LBS.writeFile fpath (encodePretty pstate)
+        . LBS.writeFile fpath $ unSerialised pstate
+ where
+  decodeProtocolState
+    :: Query.ProtocolState era
+    -> Either LBS.ByteString (Ledger.ChainDepState StandardCrypto)
+  decodeProtocolState (Query.ProtocolState (Serialised pbs)) =
+    first (const pbs) (decodeFull pbs)
 
 writeFilteredUTxOs
   :: IsCardanoEra era
@@ -461,62 +465,3 @@ instance ToJSON DelegationsAndRewards where
           , "rewardAccountBalance" .= mRewards
           ]
 
-queryLocalProtocolState
-  :: forall era ledgerera mode block.
-     ShelleyLedgerEra era ~ ledgerera
-  => ShelleyBasedEra era
-  -> LocalNodeConnectInfo mode block
-  -> ExceptT ShelleyQueryCmdLocalStateQueryError IO
-             (Either LByteString (Ledger.ChainDepState StandardCrypto))
-queryLocalProtocolState era connectInfo@LocalNodeConnectInfo{localNodeConsensusMode} =
-  case localNodeConsensusMode of
-    ByronMode{} -> throwError ByronProtocolNotSupportedError
-
-    ShelleyMode{} | ShelleyBasedEraShelley <- era -> do
-      tip <- liftIO $ getLocalTip connectInfo
-      Consensus.DegenQueryResult result <-
-        firstExceptT AcquireFailureError . newExceptT $
-          queryNodeLocalState
-            connectInfo
-            ( getTipPoint tip
-            , Consensus.DegenQuery $
-                Consensus.GetCBOR Consensus.DebugChainDepState
-                -- Get CBOR-in-CBOR version
-            )
-      return (decodeProtocolState result)
-
-    ShelleyMode{} | otherwise -> throwError ShelleyProtocolEraMismatch
-
-    CardanoMode{} -> do
-      tip <- liftIO $ getLocalTip connectInfo
-      result <- firstExceptT AcquireFailureError . newExceptT $
-        queryNodeLocalState
-          connectInfo
-          (getTipPoint tip,
-           queryIfCurrentEra era (Consensus.GetCBOR Consensus.DebugChainDepState))
-                                  -- Get CBOR-in-CBOR version
-      case result of
-        QueryResultEraMismatch err -> throwError (EraMismatchError err)
-        QueryResultSuccess ls -> return (decodeProtocolState ls)
-  where
-    -- If decode as a ChainDepState fails we return the ByteString so we can do a generic
-    -- CBOR decode.
-    decodeProtocolState (Serialised pbs) =
-      first (const pbs) (decodeFull pbs)
-
--- -----------------------------------------------------------------------------
--- Era-generic helper functions
---
-
--- | Select the appropriate query constructor based on the era
--- 'QueryIfCurrentShelley', 'QueryIfCurrentAllegra' or 'QueryIfCurrentMary'.
---
---
-queryIfCurrentEra :: ShelleyBasedEra era
-                  -> Query (Consensus.ShelleyBlock (ShelleyLedgerEra era)) result
-                  -> Consensus.CardanoQuery StandardCrypto
-                       (Consensus.CardanoQueryResult StandardCrypto result)
-queryIfCurrentEra ShelleyBasedEraShelley = Consensus.QueryIfCurrentShelley
-queryIfCurrentEra ShelleyBasedEraAllegra = Consensus.QueryIfCurrentAllegra
-queryIfCurrentEra ShelleyBasedEraMary    = Consensus.QueryIfCurrentMary
-