diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index edcf0fc0dfc..e3017c8394a 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -236,7 +236,7 @@ data TxIn = TxIn TxId TxIx deriving instance ToJSON TxIn instance ToJSONKey TxIn where - toJSONKey = toJSONKeyText (\txIn -> Text.pack $ show txIn) + toJSONKey = toJSONKeyText (Text.pack . show) newtype TxIx = TxIx Word deriving stock (Eq, Ord, Show) 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 984a7090f4f..98af73353ba 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.CLI.Mary.TxOutParser (parseTxOutAnyEra) @@ -708,7 +707,7 @@ pQueryCmd = pQueryProtocolState :: Parser QueryCmd pQueryProtocolState = QueryProtocolState <$> pCardanoEra - <*> pProtocol + <*> pConsensusModeParams <*> pNetworkId <*> pMaybeOutputFile @@ -2302,43 +2301,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 fe45109b5b2..3b666124e4d 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs @@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -31,22 +30,20 @@ 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 qualified Control.State.Transition as STS 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,20 +52,17 @@ import Cardano.CLI.Types import Cardano.Binary (decodeFull) import Cardano.Crypto.Hash (hashToBytesAsHex) +import qualified Cardano.Ledger.Core as Ledger +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 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.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 () {- HLINT ignore "Reduce duplication" -} @@ -81,7 +75,6 @@ data ShelleyQueryCmdError | ShelleyQueryCmdAcquireFailure !AcquireFailure | ShelleyQueryCmdEraConsensusModeMismatch !AnyCardanoEra !AnyConsensusMode | ShelleyQueryCmdByronEra - | ShelleyQueryCmdByronEraDetected | ShelleyQueryCmdEraMismatch !EraMismatch deriving Show @@ -93,8 +86,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 +107,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 consensusModeParams qFilter networkId mOutFile -> runQueryUTxO era consensusModeParams qFilter networkId mOutFile @@ -219,7 +211,7 @@ runQueryUTxO anyEra@(AnyCardanoEra era) (AnyConsensusModeParams cModeParams) -> ExceptT ShelleyQueryCmdError IO (Query.QueryInMode mode (Either EraMismatch (Query.UTxO era))) createQuery sbe e = do let mFilter = maybeFiltered qfilter - query = (NewIPC.QueryInShelleyBasedEra sbe $ NewIPC.QueryUTxO mFilter) + query = NewIPC.QueryInShelleyBasedEra sbe $ NewIPC.QueryUTxO mFilter return $ NewIPC.QueryInEra e query maybeFiltered :: QueryFilter -> Maybe (Set AddressAny) @@ -260,43 +252,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. @@ -380,6 +369,7 @@ writeLedgerState :: forall era ledgerera. ShelleyLedgerEra era ~ ledgerera => Ledger.UsesTxOut ledgerera => ToJSON (Ledger.NewEpochState ledgerera) + => FromCBOR (STS.State (Ledger.EraRule "PPUP" ledgerera)) => Ledger.ShelleyBased ledgerera => Maybe OutputFile -> Query.LedgerState era @@ -399,15 +389,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 @@ -449,7 +448,7 @@ printUtxo printUtxo shelleyBasedEra' txInOutTuple = case shelleyBasedEra' of ShelleyBasedEraShelley -> - let ((TxIn (TxId txhash) (TxIx index)),(TxOut _ value)) = txInOutTuple + let (TxIn (TxId txhash) (TxIx index), TxOut _ value) = txInOutTuple in Text.putStrLn $ mconcat [ Text.decodeLatin1 (hashToBytesAsHex txhash) @@ -458,7 +457,7 @@ printUtxo shelleyBasedEra' txInOutTuple = ] ShelleyBasedEraAllegra -> - let ((TxIn (TxId txhash) (TxIx index)),(TxOut _ value)) = txInOutTuple + let (TxIn (TxId txhash) (TxIx index), TxOut _ value) = txInOutTuple in Text.putStrLn $ mconcat [ Text.decodeLatin1 (hashToBytesAsHex txhash) @@ -466,7 +465,7 @@ printUtxo shelleyBasedEra' txInOutTuple = , " " <> printableValue value ] ShelleyBasedEraMary -> - let ((TxIn (TxId txhash) (TxIx index)),(TxOut _ value)) = txInOutTuple + let (TxIn (TxId txhash) (TxIx index), TxOut _ value) = txInOutTuple in Text.putStrLn $ mconcat [ Text.decodeLatin1 (hashToBytesAsHex txhash) @@ -579,62 +578,20 @@ 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 + , FromCBOR (STS.State (Ledger.EraRule "PPUP" ledgerera)) + ) => a) -> a +obtainLedgerEraClassConstraints ShelleyBasedEraShelley f = f +obtainLedgerEraClassConstraints ShelleyBasedEraAllegra f = f +obtainLedgerEraClassConstraints ShelleyBasedEraMary f = f