From 3c326411e7bfe423bba73926b4066d8fa20beec2 Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 26 Oct 2023 21:09:25 +1100 Subject: [PATCH] Remove use of AnyConsensusMode --- .../Cardano/CLI/EraBased/Commands/Query.hs | 36 ++-- .../CLI/EraBased/Commands/Transaction.hs | 4 +- .../Cardano/CLI/EraBased/Options/Common.hs | 10 +- .../src/Cardano/CLI/EraBased/Run/Query.hs | 190 ++++++------------ .../Cardano/CLI/EraBased/Run/Transaction.hs | 29 +-- cardano-cli/src/Cardano/CLI/Helpers.hs | 14 ++ .../src/Cardano/CLI/Legacy/Commands/Query.hs | 30 +-- .../CLI/Legacy/Commands/Transaction.hs | 4 +- .../src/Cardano/CLI/Legacy/Run/Transaction.hs | 4 +- .../CLI/Types/Errors/GovernanceQueryError.hs | 6 - .../Cardano/CLI/Types/Errors/QueryCmdError.hs | 6 - .../Cardano/CLI/Types/Errors/TxCmdError.hs | 17 -- 12 files changed, 130 insertions(+), 220 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs index 173c0c2fdf..5b18e964fb 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Query.hs @@ -60,7 +60,7 @@ data QueryCmds era data QueryLeadershipScheduleCmdArgs = QueryLeadershipScheduleCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , genesisFp :: !GenesisFile , poolColdVerKeyFile :: !(VerificationKeyOrHashOrFile StakePoolKey) @@ -71,42 +71,42 @@ data QueryLeadershipScheduleCmdArgs = QueryLeadershipScheduleCmdArgs data QueryProtocolParametersCmdArgs = QueryProtocolParametersCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) } deriving (Generic, Show) data QueryConstitutionHashCmdArgs = QueryConstitutionHashCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) } deriving (Generic, Show) data QueryTipCmdArgs = QueryTipCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) } deriving (Generic, Show) data QueryStakePoolsCmdArgs = QueryStakePoolsCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) } deriving (Generic, Show) data QueryStakeDistributionCmdArgs = QueryStakeDistributionCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) } deriving (Generic, Show) data QueryStakeAddressInfoCmdArgs = QueryStakeAddressInfoCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , addr :: !StakeAddress , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) @@ -114,7 +114,7 @@ data QueryStakeAddressInfoCmdArgs = QueryStakeAddressInfoCmdArgs data QueryUTxOCmdArgs = QueryUTxOCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , queryFilter :: !QueryUTxOFilter , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) @@ -122,21 +122,21 @@ data QueryUTxOCmdArgs = QueryUTxOCmdArgs data QueryLedgerStateCmdArgs = QueryLedgerStateCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) } deriving (Generic, Show) data QueryProtocolStateCmdArgs = QueryProtocolStateCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) } deriving (Generic, Show) data QueryStakeSnapshotCmdArgs = QueryStakeSnapshotCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , allOrOnlyPoolIds :: !(AllOrOnly [Hash StakePoolKey]) , mOutFile :: !(Maybe (File () Out)) @@ -144,7 +144,7 @@ data QueryStakeSnapshotCmdArgs = QueryStakeSnapshotCmdArgs data QueryKesPeriodInfoCmdArgs = QueryKesPeriodInfoCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , nodeOpCertFp :: !(File () In) -- ^ Node operational certificate , mOutFile :: !(Maybe (File () Out)) @@ -152,14 +152,14 @@ data QueryKesPeriodInfoCmdArgs = QueryKesPeriodInfoCmdArgs data QueryPoolStateCmdArgs = QueryPoolStateCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , poolIds :: ![Hash StakePoolKey] } deriving (Generic, Show) data QueryTxMempoolCmdArgs = QueryTxMempoolCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , query :: !TxMempoolQuery , mOutFile :: !(Maybe (File () Out)) @@ -168,7 +168,7 @@ data QueryTxMempoolCmdArgs = QueryTxMempoolCmdArgs data QuerySlotNumberCmdArgs = QuerySlotNumberCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , utcTime :: !UTCTime } deriving (Generic, Show) @@ -176,7 +176,7 @@ data QuerySlotNumberCmdArgs = QuerySlotNumberCmdArgs data QueryNoArgCmdArgs era = QueryNoArgCmdArgs { eon :: !(ConwayEraOnwards era) , nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) } deriving Show @@ -184,7 +184,7 @@ data QueryNoArgCmdArgs era = QueryNoArgCmdArgs data QueryDRepStateCmdArgs era = QueryDRepStateCmdArgs { eon :: !(ConwayEraOnwards era) , nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , drepKeys :: ![VerificationKeyOrHashOrFile DRepKey] , mOutFile :: !(Maybe (File () Out)) @@ -193,7 +193,7 @@ data QueryDRepStateCmdArgs era = QueryDRepStateCmdArgs data QueryDRepStakeDistributionCmdArgs era = QueryDRepStakeDistributionCmdArgs { eon :: !(ConwayEraOnwards era) , nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , drepKeys :: ![VerificationKeyOrHashOrFile DRepKey] , mOutFile :: !(Maybe (File () Out)) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs index 3a7a36d7f7..b6ded2e2ed 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs @@ -84,7 +84,7 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs data TransactionBuildCmdArgs era = TransactionBuildCmdArgs { eon :: !(ShelleyBasedEra era) , nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , mScriptValidity :: !(Maybe ScriptValidity) -- ^ Mark script as expected to pass or fail validation @@ -148,7 +148,7 @@ data TransactionSignWitnessCmdArgs = TransactionSignWitnessCmdArgs data TransactionSubmitCmdArgs = TransactionSubmitCmdArgs { nodeSocketPath :: !SocketPath - , anyConsensusModeParams :: !AnyConsensusModeParams + , anyConsensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , txFile :: !FilePath } deriving Show diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index 1f2bab172f..cfd951e7cf 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -109,7 +109,7 @@ toUnitIntervalOrErr r = case Ledger.boundRational r of ] Just n -> n -pConsensusModeParams :: Parser AnyConsensusModeParams +pConsensusModeParams :: Parser (ConsensusModeParams CardanoMode) pConsensusModeParams = asum [ pCardanoMode *> pCardanoConsensusMode , pDefaultConsensusMode @@ -122,12 +122,12 @@ pConsensusModeParams = asum , Opt.help "For talking to a node running in full Cardano mode (default)." ] - pCardanoConsensusMode :: Parser AnyConsensusModeParams - pCardanoConsensusMode = AnyConsensusModeParams . CardanoModeParams <$> pEpochSlots + pCardanoConsensusMode :: Parser (ConsensusModeParams CardanoMode) + pCardanoConsensusMode = CardanoModeParams <$> pEpochSlots - pDefaultConsensusMode :: Parser AnyConsensusModeParams + pDefaultConsensusMode :: Parser (ConsensusModeParams CardanoMode) pDefaultConsensusMode = - pure . AnyConsensusModeParams . CardanoModeParams $ EpochSlots defaultByronEpochSlots + pure . CardanoModeParams $ EpochSlots defaultByronEpochSlots defaultByronEpochSlots :: Word64 defaultByronEpochSlots = 21600 diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs index cd8e309272..256e4f2288 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs @@ -45,7 +45,7 @@ import Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..)) import qualified Cardano.CLI.EraBased.Commands.Query as Cmd import Cardano.CLI.EraBased.Run.Genesis (readAndDecodeShelleyGenesis) -import Cardano.CLI.Helpers (pPrintCBOR) +import Cardano.CLI.Helpers import Cardano.CLI.Pretty import Cardano.CLI.Read import Cardano.CLI.Types.Common @@ -137,23 +137,20 @@ runQueryConstitutionHashCmd :: () runQueryConstitutionHashCmd Cmd.QueryConstitutionHashCmdArgs { Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.networkId , Cmd.mOutFile } = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams networkId nodeSocketPath result <- liftIO $ executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do - anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + AnyCardanoEra era <- lift (determineEraExpr cModeParams) & onLeft (left . QueryCmdUnsupportedNtcVersion) sbe <- requireShelleyBasedEra era & onNothing (left QueryCmdByronEra) - let cMode = consensusModeOnly cModeParams - - eInMode <- toEraInMode era cMode - & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + let eInMode = toEraInCardanoMode era lift (shelleyBasedEraConstraints sbe (queryConstitutionHash eInMode sbe)) & onLeft (left . QueryCmdUnsupportedNtcVersion) @@ -178,18 +175,16 @@ runQueryProtocolParametersCmd :: () runQueryProtocolParametersCmd Cmd.QueryProtocolParametersCmdArgs { Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.networkId , Cmd.mOutFile } = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams networkId nodeSocketPath - anyE@(AnyCardanoEra era) <- firstExceptT QueryCmdAcquireFailure $ newExceptT $ determineEra cModeParams localNodeConnInfo + AnyCardanoEra era <- firstExceptT QueryCmdAcquireFailure $ newExceptT $ determineEra cModeParams localNodeConnInfo sbe <- case cardanoEraStyle era of LegacyByronEra -> left QueryCmdByronEra ShelleyBasedEra sbe -> return sbe - let cMode = consensusModeOnly cModeParams - eInMode <- toEraInMode era cMode - & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + let eInMode = toEraInCardanoMode era let qInMode = QueryInEra eInMode $ QueryInShelleyBasedEra sbe Api.QueryProtocolParameters pp <- firstExceptT QueryCmdConvenienceError @@ -250,7 +245,7 @@ runQueryTipCmd :: () runQueryTipCmd Cmd.QueryTipCmdArgs { Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.networkId , Cmd.mOutFile } = do @@ -327,8 +322,6 @@ runQueryTipCmd Just (File fpath) -> liftIO $ LBS.writeFile fpath $ encodePretty localStateOutput Nothing -> liftIO $ LBS.putStrLn $ encodePretty localStateOutput - mode -> left (QueryCmdUnsupportedMode (AnyConsensusMode mode)) - -- | Query the UTxO, filtered by a given set of addresses, from a Shelley node -- via the local state query protocol. runQueryUTxOCmd :: () @@ -337,7 +330,7 @@ runQueryUTxOCmd :: () runQueryUTxOCmd Cmd.QueryUTxOCmdArgs { Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.queryFilter , Cmd.networkId , Cmd.mOutFile @@ -346,20 +339,15 @@ runQueryUTxOCmd join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do - anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + AnyCardanoEra era <- lift (determineEraExpr cModeParams) & onLeft (left . QueryCmdUnsupportedNtcVersion) - let cMode = consensusModeOnly cModeParams - sbe <- requireShelleyBasedEra era & onNothing (left QueryCmdByronEra) - eInMode <- pure (toEraInMode era cMode) - & onNothing (left (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) - - eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams + let eInMode = toEraInCardanoMode era - requireNotByronEraInByronMode eraInMode + requireNotByronEraInByronMode eInMode utxo <- lift (queryUtxo eInMode sbe queryFilter) & onLeft (left . QueryCmdUnsupportedNtcVersion) @@ -377,7 +365,7 @@ runQueryKesPeriodInfoCmd :: () runQueryKesPeriodInfoCmd Cmd.QueryKesPeriodInfoCmdArgs { Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.networkId , Cmd.nodeOpCertFp , Cmd.mOutFile @@ -393,18 +381,17 @@ runQueryKesPeriodInfoCmd CardanoMode -> do join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do - anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + AnyCardanoEra era <- lift (determineEraExpr cModeParams) & onLeft (left . QueryCmdUnsupportedNtcVersion) sbe <- requireShelleyBasedEra era & onNothing (left QueryCmdByronEra) - eInMode <- toEraInMode era cMode - & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + let eInMode = toEraInCardanoMode era -- We check that the KES period specified in the operational certificate is correct -- based on the KES period defined in the genesis parameters and the current slot number - eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams + let eraInMode = toEraInCardanoMode era requireNotByronEraInByronMode eraInMode @@ -450,8 +437,6 @@ runQueryKesPeriodInfoCmd & onLeft (left . QueryCmdAcquireFailure) & onLeft left - mode -> left . QueryCmdUnsupportedMode $ AnyConsensusMode mode - where currentKesPeriod :: ChainTip -> GenesisParameters era -> CurrentKesPeriod currentKesPeriod ChainTipAtGenesis _ = CurrentKesPeriod 0 @@ -661,7 +646,7 @@ runQueryPoolStateCmd :: () runQueryPoolStateCmd Cmd.QueryPoolStateCmdArgs { Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.networkId , Cmd.poolIds } = do @@ -669,18 +654,15 @@ runQueryPoolStateCmd join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do - anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + AnyCardanoEra era <- lift (determineEraExpr cModeParams) & onLeft (left . QueryCmdUnsupportedNtcVersion) - let cMode = consensusModeOnly cModeParams - sbe <- requireShelleyBasedEra era & onNothing (left QueryCmdByronEra) - eInMode <- toEraInMode era cMode - & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + let eInMode = toEraInCardanoMode era - eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams + let eraInMode = toEraInCardanoMode era requireNotByronEraInByronMode eraInMode @@ -701,7 +683,7 @@ runQueryTxMempoolCmd :: () runQueryTxMempoolCmd Cmd.QueryTxMempoolCmdArgs { Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.networkId , Cmd.query , Cmd.mOutFile @@ -710,12 +692,10 @@ runQueryTxMempoolCmd localQuery <- case query of TxMempoolQueryTxExists tx -> do - anyE@(AnyCardanoEra era) <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) + AnyCardanoEra era <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) & onLeft (left . QueryCmdAcquireFailure) & onLeft (left . QueryCmdUnsupportedNtcVersion) - let cMode = consensusModeOnly cModeParams - eInMode <- toEraInMode era cMode - & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + let eInMode = toEraInCardanoMode era pure $ LocalTxMonitoringQueryTx $ TxIdInMode tx eInMode TxMempoolQueryNextTx -> pure LocalTxMonitoringSendNextTx TxMempoolQueryInfo -> pure LocalTxMonitoringMempoolInformation @@ -749,7 +729,7 @@ runQueryStakeSnapshotCmd :: () runQueryStakeSnapshotCmd Cmd.QueryStakeSnapshotCmdArgs { Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.networkId , Cmd.allOrOnlyPoolIds , Cmd.mOutFile @@ -758,24 +738,19 @@ runQueryStakeSnapshotCmd join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do - anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + AnyCardanoEra era <- lift (determineEraExpr cModeParams) & onLeft (left . QueryCmdUnsupportedNtcVersion) - let cMode = consensusModeOnly cModeParams - sbe <- requireShelleyBasedEra era & onNothing (left QueryCmdByronEra) - eInMode <- toEraInMode era cMode - & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + let eInMode = toEraInCardanoMode era let poolFilter = case allOrOnlyPoolIds of All -> Nothing Only poolIds -> Just $ Set.fromList poolIds - eraInMode2 <- calcEraInMode era $ consensusModeOnly cModeParams - - requireNotByronEraInByronMode eraInMode2 + requireNotByronEraInByronMode eInMode result <- lift (queryStakeSnapshot eInMode sbe poolFilter) & onLeft (left . QueryCmdUnsupportedNtcVersion) @@ -793,7 +768,7 @@ runQueryLedgerStateCmd :: () runQueryLedgerStateCmd Cmd.QueryLedgerStateCmdArgs { Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.networkId , Cmd.mOutFile } = do @@ -801,18 +776,15 @@ runQueryLedgerStateCmd join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do - anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + AnyCardanoEra era <- lift (determineEraExpr cModeParams) & onLeft (left . QueryCmdUnsupportedNtcVersion) - let cMode = consensusModeOnly cModeParams - sbe <- requireShelleyBasedEra era & onNothing (left QueryCmdByronEra) - eInMode <- pure (toEraInMode era cMode) - & onNothing (left (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) + let eInMode = toEraInCardanoMode era - eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams + let eraInMode = toEraInCardanoMode era requireNotByronEraInByronMode eraInMode @@ -832,7 +804,7 @@ runQueryProtocolStateCmd :: () runQueryProtocolStateCmd Cmd.QueryProtocolStateCmdArgs { Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.networkId , Cmd.mOutFile } = do @@ -840,7 +812,7 @@ runQueryProtocolStateCmd join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do - anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + AnyCardanoEra era <- lift (determineEraExpr cModeParams) & onLeft (left . QueryCmdUnsupportedNtcVersion) let cMode = consensusModeOnly cModeParams @@ -848,10 +820,9 @@ runQueryProtocolStateCmd sbe <- requireShelleyBasedEra era & onNothing (left QueryCmdByronEra) - eInMode <- pure (toEraInMode era cMode) - & onNothing (left (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) + let eInMode = toEraInCardanoMode era - eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams + let eraInMode = toEraInCardanoMode era requireNotByronEraInByronMode eraInMode @@ -862,7 +833,6 @@ runQueryProtocolStateCmd pure $ do case cMode of CardanoMode -> shelleyBasedEraConstraints sbe $ writeProtocolState mOutFile result - mode -> left . QueryCmdUnsupportedMode $ AnyConsensusMode mode ) & onLeft (left . QueryCmdAcquireFailure) & onLeft left @@ -876,7 +846,7 @@ runQueryStakeAddressInfoCmd :: () runQueryStakeAddressInfoCmd Cmd.QueryStakeAddressInfoCmdArgs { Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.addr = StakeAddress _ addr , Cmd.networkId , Cmd.mOutFile @@ -885,20 +855,17 @@ runQueryStakeAddressInfoCmd join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do - anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + AnyCardanoEra era <- lift (determineEraExpr cModeParams) & onLeft (left . QueryCmdUnsupportedNtcVersion) - let cMode = consensusModeOnly cModeParams - sbe <- requireShelleyBasedEra era & onNothing (left QueryCmdByronEra) - eInMode <- pure (toEraInMode era cMode) - & onNothing (left (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) + let eInMode = toEraInCardanoMode era let stakeAddr = Set.singleton $ fromShelleyStakeCredential addr - eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams + let eraInMode = toEraInCardanoMode era requireNotByronEraInByronMode eraInMode @@ -1148,7 +1115,7 @@ runQueryStakePoolsCmd :: () runQueryStakePoolsCmd Cmd.QueryStakePoolsCmdArgs { Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.networkId , Cmd.mOutFile } = do @@ -1156,15 +1123,10 @@ runQueryStakePoolsCmd join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT @QueryCmdError $ do - anyE@(AnyCardanoEra era) <- case consensusModeOnly cModeParams of - ByronMode -> return $ AnyCardanoEra ByronEra - ShelleyMode -> return $ AnyCardanoEra ShelleyEra + AnyCardanoEra era <- case consensusModeOnly cModeParams of CardanoMode -> lift queryCurrentEra & onLeft (left . QueryCmdUnsupportedNtcVersion) - let cMode = consensusModeOnly cModeParams - - eInMode <- toEraInMode era cMode - & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + let eInMode = toEraInCardanoMode era sbe <- requireShelleyBasedEra era & onNothing (left QueryCmdByronEra) @@ -1196,7 +1158,7 @@ runQueryStakeDistributionCmd :: () runQueryStakeDistributionCmd Cmd.QueryStakeDistributionCmdArgs { Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.networkId , Cmd.mOutFile } = do @@ -1204,18 +1166,15 @@ runQueryStakeDistributionCmd join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do - anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + AnyCardanoEra era <- lift (determineEraExpr cModeParams) & onLeft (left . QueryCmdUnsupportedNtcVersion) - let cMode = consensusModeOnly cModeParams - sbe <- requireShelleyBasedEra era & onNothing (left QueryCmdByronEra) - eInMode <- pure (toEraInMode era cMode) - & onNothing (left (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)) + let eInMode = toEraInCardanoMode era - eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams + let eraInMode = toEraInCardanoMode era requireNotByronEraInByronMode eraInMode @@ -1270,7 +1229,7 @@ runQueryLeadershipScheduleCmd runQueryLeadershipScheduleCmd Cmd.QueryLeadershipScheduleCmdArgs { Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.networkId , Cmd.genesisFp = GenesisFile genFile , Cmd.poolColdVerKeyFile @@ -1291,7 +1250,7 @@ runQueryLeadershipScheduleCmd join $ lift ( executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do - anyE@(AnyCardanoEra era) <- lift (determineEraExpr cModeParams) + AnyCardanoEra era <- lift (determineEraExpr cModeParams) & onLeft (left . QueryCmdUnsupportedNtcVersion) sbe <- requireShelleyBasedEra era @@ -1301,10 +1260,9 @@ runQueryLeadershipScheduleCmd case cMode of CardanoMode -> do - eInMode <- toEraInMode era cMode - & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) + let eInMode = toEraInCardanoMode era - eraInMode <- calcEraInMode era $ consensusModeOnly cModeParams + let eraInMode = toEraInCardanoMode era requireNotByronEraInByronMode eraInMode @@ -1362,9 +1320,6 @@ runQueryLeadershipScheduleCmd eInfo (tip, curentEpoch) writeSchedule mOutFile eInfo shelleyGenesis schedule - mode -> - pure $ do - left . QueryCmdUnsupportedMode $ AnyConsensusMode mode ) & onLeft (left . QueryCmdAcquireFailure) & onLeft left @@ -1442,17 +1397,15 @@ runQueryConstitution Cmd.QueryNoArgCmdArgs { Cmd.eon , Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.networkId , Cmd.mOutFile } = conwayEraOnwardsConstraints eon $ do let localNodeConnInfo = LocalNodeConnectInfo cModeParams networkId nodeSocketPath sbe = conwayEraOnwardsToShelleyBasedEra eon cEra = conwayEraOnwardsToCardanoEra eon - cMode = consensusModeOnly cModeParams - eraInMode <- toEraInMode cEra cMode - & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) (AnyCardanoEra cEra)) + let eraInMode = toEraInCardanoMode cEra constitution <- runQuery localNodeConnInfo $ queryConstitution eraInMode sbe writeOutput mOutFile constitution @@ -1464,17 +1417,15 @@ runQueryGovState Cmd.QueryNoArgCmdArgs { Cmd.eon , Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.networkId , Cmd.mOutFile } = conwayEraOnwardsConstraints eon $ do let localNodeConnInfo = LocalNodeConnectInfo cModeParams networkId nodeSocketPath sbe = conwayEraOnwardsToShelleyBasedEra eon cEra = conwayEraOnwardsToCardanoEra eon - cMode = consensusModeOnly cModeParams - eraInMode <- toEraInMode cEra cMode - & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) (AnyCardanoEra cEra)) + let eraInMode = toEraInCardanoMode cEra govState <- runQuery localNodeConnInfo $ queryGovState eraInMode sbe writeOutput mOutFile govState @@ -1486,7 +1437,7 @@ runQueryDRepState Cmd.QueryDRepStateCmdArgs { Cmd.eon , Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.networkId , Cmd.drepKeys = drepKeys , Cmd.mOutFile @@ -1494,10 +1445,8 @@ runQueryDRepState let localNodeConnInfo = LocalNodeConnectInfo cModeParams networkId nodeSocketPath sbe = conwayEraOnwardsToShelleyBasedEra eon cEra = conwayEraOnwardsToCardanoEra eon - cMode = consensusModeOnly cModeParams - eraInMode <- toEraInMode cEra cMode - & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) (AnyCardanoEra cEra)) + let eraInMode = toEraInCardanoMode cEra drepCreds <- Set.fromList <$> mapM (firstExceptT QueryCmdDRepKeyError . getDRepCredentialFromVerKeyHashOrFile) drepKeys @@ -1518,7 +1467,7 @@ runQueryDRepStakeDistribution Cmd.QueryDRepStakeDistributionCmdArgs { Cmd.eon , Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.networkId , Cmd.drepKeys = drepKeys , Cmd.mOutFile @@ -1526,15 +1475,13 @@ runQueryDRepStakeDistribution let localNodeConnInfo = LocalNodeConnectInfo cModeParams networkId nodeSocketPath sbe = conwayEraOnwardsToShelleyBasedEra eon cEra = conwayEraOnwardsToCardanoEra eon - cMode = consensusModeOnly cModeParams let drepFromVrfKey = fmap Ledger.DRepCredential . firstExceptT QueryCmdDRepKeyError . getDRepCredentialFromVerKeyHashOrFile dreps <- Set.fromList <$> mapM drepFromVrfKey drepKeys - eraInMode <- toEraInMode cEra cMode - & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) (AnyCardanoEra cEra)) + let eraInMode = toEraInCardanoMode cEra drepStakeDistribution <- runQuery localNodeConnInfo $ queryDRepStakeDistribution eraInMode sbe dreps writeOutput mOutFile $ @@ -1547,7 +1494,7 @@ runQueryCommitteeState Cmd.QueryNoArgCmdArgs { Cmd.eon , Cmd.nodeSocketPath - , Cmd.consensusModeParams = AnyConsensusModeParams cModeParams + , Cmd.consensusModeParams = cModeParams , Cmd.networkId , Cmd.mOutFile } @@ -1555,10 +1502,8 @@ runQueryCommitteeState let localNodeConnInfo = LocalNodeConnectInfo cModeParams networkId nodeSocketPath sbe = conwayEraOnwardsToShelleyBasedEra eon cEra = conwayEraOnwardsToCardanoEra eon - cMode = consensusModeOnly cModeParams - eraInMode <- toEraInMode cEra cMode - & hoistMaybe (QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) (AnyCardanoEra cEra)) + let eraInMode = toEraInCardanoMode cEra committeeState <- runQuery localNodeConnInfo $ queryCommitteeState eraInMode sbe writeOutput mOutFile $ @@ -1594,15 +1539,6 @@ writeOutput mOutFile content = case mOutFile of -- Helpers -calcEraInMode :: () - => Monad m - => CardanoEra era - -> ConsensusMode mode - -> ExceptT QueryCmdError m (EraInMode era mode) -calcEraInMode era mode = - pure (toEraInMode era mode) - & onNothing (left (QueryCmdEraConsensusModeMismatch (AnyConsensusMode mode) (anyCardanoEra era))) - requireNotByronEraInByronMode :: () => Monad m => EraInMode era mode @@ -1636,11 +1572,11 @@ toTentativeEpochInfo (EraHistory _ interpreter) = -- | Get slot number for timestamp, or an error if the UTC timestamp is before 'SystemStart' or after N+1 era utcTimeToSlotNo :: SocketPath - -> AnyConsensusModeParams + -> ConsensusModeParams CardanoMode -> NetworkId -> UTCTime -> ExceptT QueryCmdError IO SlotNo -utcTimeToSlotNo nodeSocketPath (AnyConsensusModeParams cModeParams) networkId utcTime = do +utcTimeToSlotNo nodeSocketPath cModeParams networkId utcTime = do let localNodeConnInfo = LocalNodeConnectInfo cModeParams networkId nodeSocketPath case consensusModeOnly cModeParams of CardanoMode -> do @@ -1659,5 +1595,3 @@ utcTimeToSlotNo nodeSocketPath (AnyConsensusModeParams cModeParams) networkId ut ) & onLeft (left . QueryCmdAcquireFailure) & onLeft left - - mode -> left . QueryCmdUnsupportedMode $ AnyConsensusMode mode diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 46a9042ab6..3d3df85009 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -36,6 +36,7 @@ import Cardano.Api.Shelley import qualified Cardano.CLI.EraBased.Commands.Transaction as Cmd import Cardano.CLI.EraBased.Run.Genesis +import Cardano.CLI.Helpers import Cardano.CLI.Json.Friendly (FriendlyFormat (..), friendlyTx, friendlyTxBody) import Cardano.CLI.Read import Cardano.CLI.Types.Common @@ -101,7 +102,7 @@ runTransactionBuildCmd Cmd.TransactionBuildCmdArgs { eon , nodeSocketPath - , consensusModeParams = consensusModeParams@(AnyConsensusModeParams cModeParams) + , consensusModeParams , networkId = networkId , mScriptValidity = mScriptValidity , mOverrideWitnesses = mOverrideWitnesses @@ -133,7 +134,7 @@ runTransactionBuildCmd -- from the node's era and this will result in the 'QueryEraMismatch' failure. let localNodeConnInfo = LocalNodeConnectInfo - { localConsensusModeParams = cModeParams + { localConsensusModeParams = consensusModeParams , localNodeNetworkId = networkId , localNodeSocketPath = nodeSocketPath } @@ -210,11 +211,11 @@ runTransactionBuildCmd pparams <- pure mTxProtocolParams & onNothing (left TxCmdProtocolParametersNotPresentInTxBody) executionUnitPrices <- pure (getExecutionUnitPrices era pparams) & onNothing (left TxCmdPParamExecutionUnitsNotAvailable) - let consensusMode = consensusModeOnly cModeParams + let consensusMode = consensusModeOnly consensusModeParams case consensusMode of CardanoMode -> do - AnyCardanoEra nodeEra <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr cModeParams)) + AnyCardanoEra nodeEra <- lift (executeLocalStateQueryExpr localNodeConnInfo Nothing (determineEraExpr consensusModeParams)) & onLeft (left . TxCmdQueryConvenienceError . AcqFailure) & onLeft (left . TxCmdQueryConvenienceError . QceUnsupportedNtcVersion) @@ -240,7 +241,6 @@ runTransactionBuildCmd mScriptWits scriptExecUnitsMap liftIO $ LBS.writeFile (unFile fp) $ encodePretty scriptCostOutput - _ -> left TxCmdPlutusScriptsRequireCardanoMode OutputTxBodyOnly fpath -> let noWitTx = makeSignedTransaction [] balancedTxBody @@ -463,7 +463,7 @@ runTxBuildRaw era runTxBuild :: () => ShelleyBasedEra era -> SocketPath - -> AnyConsensusModeParams + -> ConsensusModeParams CardanoMode -> NetworkId -> Maybe ScriptValidity -- ^ Mark script as expected to pass or fail validation @@ -501,14 +501,13 @@ runTxBuild :: () -> TxBuildOutputOptions -> ExceptT TxCmdError IO (BalancedTxBody era) runTxBuild - sbe socketPath (AnyConsensusModeParams cModeParams) networkId mScriptValidity + sbe socketPath cModeParams networkId mScriptValidity inputsAndMaybeScriptWits readOnlyRefIns txinsc mReturnCollateral mTotCollateral txouts (TxOutChangeAddress changeAddr) valuesWithScriptWits mLowerBound mUpperBound certsAndMaybeScriptWits withdrawals reqSigners txAuxScripts txMetadata - txUpdateProposal mOverrideWits votingProcedures proposals outputOptions = shelleyBasedEraConstraints sbe $ do + txUpdateProposal mOverrideWits votingProcedures proposals _outputOptions = shelleyBasedEraConstraints sbe $ do let era = shelleyBasedToCardanoEra sbe - -- txUpdateProposal mOverrideWits votingProcedures proposals outputOptions = cardanoEraConstraints era $ do let consensusMode = consensusModeOnly cModeParams dummyFee = Just $ Lovelace 0 @@ -538,9 +537,6 @@ runTxBuild case consensusMode of CardanoMode -> do - _ <- toEraInMode era CardanoMode - & hoistMaybe (TxCmdEraConsensusModeMismatchTxBalance outputOptions (AnyConsensusMode CardanoMode) (AnyCardanoEra era)) - let allTxInputs = inputsThatRequireWitnessing ++ allReferenceInputs ++ txinsc localNodeConnInfo = LocalNodeConnectInfo { localConsensusModeParams = CardanoModeParams $ EpochSlots 21600 @@ -612,8 +608,6 @@ runTxBuild return balancedTxBody - wrongMode -> left (TxCmdUnsupportedMode (AnyConsensusMode wrongMode)) - -- ---------------------------------------------------------------------------- -- Transaction body validation and conversion -- @@ -934,16 +928,13 @@ runTransactionSubmitCmd :: () runTransactionSubmitCmd Cmd.TransactionSubmitCmdArgs { nodeSocketPath - , anyConsensusModeParams = AnyConsensusModeParams cModeParams + , anyConsensusModeParams = cModeParams , networkId , txFile } = do txFileOrPipe <- liftIO $ fileOrPipe txFile InAnyCardanoEra era tx <- lift (readFileTx txFileOrPipe) & onLeft (left . TxCmdCddlError) - let cMode = AnyConsensusMode $ consensusModeOnly cModeParams - eraInMode <- hoistMaybe - (TxCmdEraConsensusModeMismatch (Just txFile) cMode (AnyCardanoEra era)) - (toEraInMode era $ consensusModeOnly cModeParams) + let eraInMode = toEraInCardanoMode era let txInMode = TxInMode tx eraInMode localNodeConnInfo = LocalNodeConnectInfo { localConsensusModeParams = cModeParams diff --git a/cardano-cli/src/Cardano/CLI/Helpers.hs b/cardano-cli/src/Cardano/CLI/Helpers.hs index ac04634d22..911432fcd6 100644 --- a/cardano-cli/src/Cardano/CLI/Helpers.hs +++ b/cardano-cli/src/Cardano/CLI/Helpers.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -12,8 +14,11 @@ module Cardano.CLI.Helpers , readCBOR , renderHelpersError , validateCBOR + , toEraInCardanoMode ) where +import Cardano.Api (CardanoEra (..), CardanoMode, EraInMode (..)) + import Cardano.Chain.Block (decCBORABlockOrBoundary) import qualified Cardano.Chain.Delegation as Delegation import qualified Cardano.Chain.Update as Update @@ -129,3 +134,12 @@ validateCBOR cborObject bs = void $ decodeCBOR bs (fromCBOR :: Decoder s Update.Vote) Right "Valid Byron vote." +toEraInCardanoMode :: CardanoEra era -> EraInMode era CardanoMode +toEraInCardanoMode = \case + ByronEra -> ByronEraInCardanoMode + ShelleyEra -> ShelleyEraInCardanoMode + AllegraEra -> AllegraEraInCardanoMode + MaryEra -> MaryEraInCardanoMode + AlonzoEra -> AlonzoEraInCardanoMode + BabbageEra -> BabbageEraInCardanoMode + ConwayEra -> ConwayEraInCardanoMode diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Commands/Query.hs b/cardano-cli/src/Cardano/CLI/Legacy/Commands/Query.hs index d5f43cce92..879230794a 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Commands/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Commands/Query.hs @@ -52,7 +52,7 @@ data LegacyQueryCmds data LegacyQueryLeadershipScheduleCmdArgs = LegacyQueryLeadershipScheduleCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , genesisFp :: !GenesisFile , poolColdVerKeyFile :: !(VerificationKeyOrHashOrFile StakePoolKey) @@ -63,42 +63,42 @@ data LegacyQueryLeadershipScheduleCmdArgs = LegacyQueryLeadershipScheduleCmdArgs data LegacyQueryProtocolParametersCmdArgs = LegacyQueryProtocolParametersCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) } deriving (Generic, Show) data LegacyQueryConstitutionHashCmdArgs = LegacyQueryConstitutionHashCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) } deriving (Generic, Show) data LegacyQueryTipCmdArgs = LegacyQueryTipCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) } deriving (Generic, Show) data LegacyQueryStakePoolsCmdArgs = LegacyQueryStakePoolsCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) } deriving (Generic, Show) data LegacyQueryStakeDistributionCmdArgs = LegacyQueryStakeDistributionCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) } deriving (Generic, Show) data LegacyQueryStakeAddressInfoCmdArgs = LegacyQueryStakeAddressInfoCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , addr :: !StakeAddress , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) @@ -106,7 +106,7 @@ data LegacyQueryStakeAddressInfoCmdArgs = LegacyQueryStakeAddressInfoCmdArgs data LegacyQueryUTxOCmdArgs = LegacyQueryUTxOCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , queryFilter :: !QueryUTxOFilter , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) @@ -114,21 +114,21 @@ data LegacyQueryUTxOCmdArgs = LegacyQueryUTxOCmdArgs data LegacyQueryLedgerStateCmdArgs = LegacyQueryLedgerStateCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) } deriving (Generic, Show) data LegacyQueryProtocolStateCmdArgs = LegacyQueryProtocolStateCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , mOutFile :: !(Maybe (File () Out)) } deriving (Generic, Show) data LegacyQueryStakeSnapshotCmdArgs = LegacyQueryStakeSnapshotCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , allOrOnlyPoolIds :: !(AllOrOnly [Hash StakePoolKey]) , mOutFile :: !(Maybe (File () Out)) @@ -136,7 +136,7 @@ data LegacyQueryStakeSnapshotCmdArgs = LegacyQueryStakeSnapshotCmdArgs data LegacyQueryKesPeriodInfoCmdArgs = LegacyQueryKesPeriodInfoCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , nodeOpCertFp :: !(File () In) -- ^ Node operational certificate , mOutFile :: !(Maybe (File () Out)) @@ -144,14 +144,14 @@ data LegacyQueryKesPeriodInfoCmdArgs = LegacyQueryKesPeriodInfoCmdArgs data LegacyQueryPoolStateCmdArgs = LegacyQueryPoolStateCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , poolIds :: ![Hash StakePoolKey] } deriving (Generic, Show) data LegacyQueryTxMempoolCmdArgs = LegacyQueryTxMempoolCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , query :: !TxMempoolQuery , mOutFile :: !(Maybe (File () Out)) @@ -160,7 +160,7 @@ data LegacyQueryTxMempoolCmdArgs = LegacyQueryTxMempoolCmdArgs data LegacyQuerySlotNumberCmdArgs = LegacyQuerySlotNumberCmdArgs { nodeSocketPath :: !SocketPath - , consensusModeParams :: !AnyConsensusModeParams + , consensusModeParams :: !(ConsensusModeParams CardanoMode) , networkId :: !NetworkId , utcTime :: !UTCTime } deriving (Generic, Show) diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs index 34ed738efe..a3f9cc10ad 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs @@ -54,7 +54,7 @@ data LegacyTransactionCmds | TransactionBuildCmd SocketPath (EraInEon ShelleyBasedEra) - AnyConsensusModeParams + (ConsensusModeParams CardanoMode) NetworkId (Maybe ScriptValidity) -- ^ Mark script as expected to pass or fail validation (Maybe Word) @@ -109,7 +109,7 @@ data LegacyTransactionCmds (File () Out) | TransactionSubmitCmd SocketPath - AnyConsensusModeParams + (ConsensusModeParams CardanoMode) NetworkId FilePath | TransactionPolicyIdCmd diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs index f4f371e0b4..6cc0c63f60 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs @@ -67,7 +67,7 @@ runLegacyTransactionCmds = \case runLegacyTransactionBuildCmd :: () => SocketPath -> EraInEon ShelleyBasedEra - -> AnyConsensusModeParams + -> ConsensusModeParams CardanoMode -> NetworkId -> Maybe ScriptValidity -> Maybe Word -- ^ Override the required number of tx witnesses @@ -174,7 +174,7 @@ runLegacyTransactionSignCmd runLegacyTransactionSubmitCmd :: () => SocketPath - -> AnyConsensusModeParams + -> ConsensusModeParams CardanoMode -> NetworkId -> FilePath -> ExceptT TxCmdError IO () diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceQueryError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceQueryError.hs index 8649118355..e02b362e4d 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceQueryError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/GovernanceQueryError.hs @@ -6,13 +6,9 @@ import Cardano.Api.Shelley import Ouroboros.Consensus.Cardano.Block (EraMismatch) -import qualified Data.Text as T - - data GovernanceQueryError = GovernanceQueryWriteFileError !(FileError ()) | GovernanceQueryAcqireFailureError !AcquiringFailure - | GovernanceQueryEraConsensusModeMismatch !AnyConsensusMode !AnyCardanoEra | GovernanceQueryUnsupportedNtcVersion !UnsupportedNtcVersionError | GovernanceQueryEraMismatch !EraMismatch | GovernanceQueryDRepKeyError !(FileError InputDecodeError) @@ -24,8 +20,6 @@ instance Error GovernanceQueryError where displayError err GovernanceQueryAcqireFailureError err -> show err - GovernanceQueryEraConsensusModeMismatch mode era -> - "Era " <> T.unpack (renderEra era) <> " does not support consensus mode " <> T.unpack (renderMode mode) <> "." GovernanceQueryUnsupportedNtcVersion (UnsupportedNtcVersionError minNtcVersion ntcVersion) -> unlines [ "Unsupported feature for the node-to-client protocol version." , "This query requires at least " <> show minNtcVersion <> " but the node negotiated " <> show ntcVersion <> "." diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/QueryCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/QueryCmdError.hs index 82ddb5605d..2cc6bd8f53 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/QueryCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/QueryCmdError.hs @@ -39,10 +39,8 @@ data QueryCmdError | QueryCmdWriteFileError !(FileError ()) | QueryCmdHelpersError !HelpersError | QueryCmdAcquireFailure !AcquiringFailure - | QueryCmdEraConsensusModeMismatch !AnyConsensusMode !AnyCardanoEra | QueryCmdByronEra | QueryCmdEraMismatch !EraMismatch - | QueryCmdUnsupportedMode !AnyConsensusMode | QueryCmdPastHorizon !Qry.PastHorizonException | QueryCmdSystemStartUnavailable | QueryCmdGenesisReadError !GenesisCmdError @@ -65,13 +63,9 @@ renderQueryCmdError = \case QueryCmdHelpersError helpersErr -> renderHelpersError helpersErr QueryCmdAcquireFailure acquireFail -> Text.pack $ show acquireFail QueryCmdByronEra -> "This query cannot be used for the Byron era" - QueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) (AnyCardanoEra era) -> - "Consensus mode and era mismatch. Consensus mode: " <> textShow cMode <> - " Era: " <> textShow era QueryCmdEraMismatch (EraMismatch ledgerEra queryEra) -> "\nAn error mismatch occurred." <> "\nSpecified query era: " <> queryEra <> "\nCurrent ledger era: " <> ledgerEra - QueryCmdUnsupportedMode mode -> "Unsupported mode: " <> renderMode mode QueryCmdPastHorizon e -> "Past horizon: " <> textShow e QueryCmdSystemStartUnavailable -> "System start unavailable" QueryCmdGenesisReadError err' -> Text.pack $ displayError err' diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs index 3ea8fa80bc..6df48f652d 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs @@ -38,11 +38,6 @@ data TxCmdError | TxCmdReadTextViewFileError !(FileError TextEnvelopeError) | TxCmdReadWitnessSigningDataError !ReadWitnessSigningDataError | TxCmdWriteFileError !(FileError ()) - | TxCmdEraConsensusModeMismatch - !(Maybe FilePath) - !AnyConsensusMode - !AnyCardanoEra - -- ^ Era | TxCmdBootstrapWitnessError !BootstrapWitnessError | TxCmdTxSubmitError !Text | TxCmdTxSubmitErrorEraMismatch !EraMismatch @@ -52,12 +47,7 @@ data TxCmdError | TxCmdWitnessEraMismatch !AnyCardanoEra !AnyCardanoEra !WitnessFile | TxCmdPolicyIdsMissing ![PolicyId] | TxCmdPolicyIdsExcess ![PolicyId] - | TxCmdUnsupportedMode !AnyConsensusMode | TxCmdByronEra - | TxCmdEraConsensusModeMismatchTxBalance - !TxBuildOutputOptions - !AnyConsensusMode - !AnyCardanoEra | TxCmdBalanceTxBody !TxBodyErrorAutoBalance | TxCmdTxInsDoNotExist !TxInsExistError | TxCmdPParamsErr !ProtocolParametersError @@ -133,9 +123,6 @@ renderTxCmdError err = "The transaction is for the " <> renderEra era <> " era, but the " <> "witness in " <> textShow file <> " is for the " <> renderEra era' <> " era." - TxCmdEraConsensusModeMismatch fp mode era -> - "Submitting " <> renderEra era <> " era transaction (" <> textShow fp <> - ") is not supported in the " <> renderMode mode <> " consensus mode." TxCmdPolicyIdsMissing policyids -> mconcat [ "The \"--mint\" flag specifies an asset with a policy Id, but no " , "corresponding monetary policy script has been provided as a witness " @@ -148,11 +135,7 @@ renderTxCmdError err = , "id of any asset specified in the \"--mint\" field. The script hash is: " , Text.intercalate ", " (map serialiseToRawBytesHexText policyids) ] - TxCmdUnsupportedMode mode -> "Unsupported mode: " <> renderMode mode TxCmdByronEra -> "This query cannot be used for the Byron era" - TxCmdEraConsensusModeMismatchTxBalance fp mode era -> - "Cannot balance " <> renderEra era <> " era transaction body (" <> textShow fp <> - ") because is not supported in the " <> renderMode mode <> " consensus mode." TxCmdBalanceTxBody err' -> Text.pack $ displayError err' TxCmdTxInsDoNotExist e -> renderTxInsExistError e