From 4f63c04a27f0c72fdb0b1869ea1413f7a77aee84 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 18 Jan 2021 07:50:45 +0000 Subject: [PATCH] Implement query protocol state in cardano-cli using the new api --- .../src/Cardano/CLI/Shelley/Commands.hs | 3 +- .../src/Cardano/CLI/Shelley/Parsers.hs | 40 +--- .../src/Cardano/CLI/Shelley/Run/Query.hs | 178 +++++++----------- 3 files changed, 68 insertions(+), 153 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs b/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs index 32fc05e39a7..04522e245af 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Commands.hs +++ b/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 Show renderQueryCmd :: QueryCmd -> Text diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs index 38d23c3587a..9d1c2763dbc 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs +++ b/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 diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs index 548a9ac3fd9..465276aa33a 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs +++ b/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 (AnyConsensusMode (..), AnyConsensusModeParams (..), toEraInMode) import qualified Cardano.Api.Modes as Mode -import Cardano.Api.Protocol (Protocol, withlocalNodeConnectInfo) 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,22 +52,18 @@ import Cardano.CLI.Types import Cardano.Binary (decodeFull) import Cardano.Crypto.Hash (hashToBytesAsHex) +import qualified Cardano.Ledger.Crypto as Crypto import qualified Cardano.Ledger.Shelley.Constraints as Ledger -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 Ouroboros.Consensus.Cardano.Block as Consensus (EraMismatch (..)) +import Ouroboros.Consensus.Shelley.Protocol (StandardCrypto) +import Ouroboros.Network.Block (Serialised (..)) +import Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery + (AcquireFailure (..)) import qualified Shelley.Spec.Ledger.API.Protocol as Ledger import qualified Shelley.Spec.Ledger.LedgerState as Ledger import Shelley.Spec.Ledger.Scripts () -import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus -import Ouroboros.Consensus.Shelley.Protocol (StandardCrypto) -import Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery - (AcquireFailure (..)) -{- HLINT ignore "Reduce duplication" -} data ShelleyQueryCmdError @@ -81,7 +74,6 @@ data ShelleyQueryCmdError | ShelleyQueryCmdAcquireFailure !AcquireFailure | ShelleyQueryCmdEraConsensusModeMismatch !AnyCardanoEra !AnyConsensusMode | ShelleyQueryCmdByronEra - | ShelleyQueryCmdByronEraDetected | ShelleyQueryCmdEraMismatch !EraMismatch deriving Show @@ -93,8 +85,7 @@ renderShelleyQueryCmdError err = ShelleyQueryCmdWriteFileError fileErr -> Text.pack (displayError fileErr) ShelleyQueryCmdHelpersError helpersErr -> renderHelpersError helpersErr ShelleyQueryCmdAcquireFailure aqFail -> Text.pack $ show aqFail - ShelleyQueryCmdByronEra -> "Query was submitted in the Byron era. Expected Shelley era." - ShelleyQueryCmdByronEraDetected -> "This query cannot be used for the Byron era" + ShelleyQueryCmdByronEra -> "This query cannot be used for the Byron era" ShelleyQueryCmdEraConsensusModeMismatch (AnyCardanoEra era) (AnyConsensusMode cMode) -> "Consensus mode and era mismatch. Consensus mode: " <> show cMode <> " Era: " <> show era @@ -115,8 +106,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 @@ -260,43 +251,40 @@ runQueryLedgerState anyEra@(AnyCardanoEra era) (AnyConsensusModeParams cModePara Right stakeDist -> obtainLedgerEraClassConstraints sbe $ writeLedgerState mOutFile stakeDist - -getSbe :: CardanoEraStyle era -> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era) -getSbe LegacyByronEra = left ShelleyQueryCmdByronEra -getSbe (ShelleyBasedEra sbe) = return sbe - -obtainLedgerEraClassConstraints - :: ShelleyLedgerEra era ~ ledgerera - => ShelleyBasedEra era - -> ((Ledger.ShelleyBased ledgerera - , ToJSON (Ledger.NewEpochState ledgerera) - , Ledger.UsesTxOut ledgerera - ) => a) -> a -obtainLedgerEraClassConstraints ShelleyBasedEraShelley f = f -obtainLedgerEraClassConstraints ShelleyBasedEraAllegra f = f -obtainLedgerEraClassConstraints ShelleyBasedEraMary f = f - 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) (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) + let consensusMode = NewIPC.consensusModeOnly cModeParams + + eraInMode <- hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch anyEra (AnyConsensusMode consensusMode)) + $ toEraInMode era consensusMode + + let localNodeConnInfo = NewIPC.LocalNodeConnectInfo cModeParams network sockPath + + sbe <- getSbe $ cardanoEraStyle era + + + let qInMode = NewIPC.QueryInEra eraInMode + . NewIPC.QueryInShelleyBasedEra sbe + $ 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. @@ -399,15 +387,24 @@ writeLedgerState mOutFile qState@(Query.LedgerState serLedgerState) = decodeLedgerState (Query.LedgerState (Serialised ls)) = first (const ls) (decodeFull ls) -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 :: ShelleyBasedEra era -> Maybe OutputFile @@ -579,62 +576,19 @@ 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 --- +-- Helpers --- | 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 +getSbe :: CardanoEraStyle era -> ExceptT ShelleyQueryCmdError IO (ShelleyBasedEra era) +getSbe LegacyByronEra = left ShelleyQueryCmdByronEra +getSbe (ShelleyBasedEra sbe) = return sbe +obtainLedgerEraClassConstraints + :: ShelleyLedgerEra era ~ ledgerera + => ShelleyBasedEra era + -> ((Ledger.ShelleyBased ledgerera + , ToJSON (Ledger.NewEpochState ledgerera) + , Ledger.UsesTxOut ledgerera + ) => a) -> a +obtainLedgerEraClassConstraints ShelleyBasedEraShelley f = f +obtainLedgerEraClassConstraints ShelleyBasedEraAllegra f = f +obtainLedgerEraClassConstraints ShelleyBasedEraMary f = f