diff --git a/cardano-api/src/Cardano/Api/Convenience/Query.hs b/cardano-api/src/Cardano/Api/Convenience/Query.hs index 49dfbba0e6b..dc07a3b7b80 100644 --- a/cardano-api/src/Cardano/Api/Convenience/Query.hs +++ b/cardano-api/src/Cardano/Api/Convenience/Query.hs @@ -106,17 +106,18 @@ queryStateForBalancedTx era networkId allTxIns = runExceptT $ do -- | Query the node to determine which era it is in. determineEra - :: forall mode. () + :: forall e mode. () + => e `OO.CouldBe` AcquireFailure => ConsensusModeParams mode -> LocalNodeConnectInfo mode - -> ExceptT AcquireFailure IO AnyCardanoEra + -> ExceptT (OO.Variant e) IO AnyCardanoEra determineEra cModeParams localNodeConnInfo = case consensusModeOnly cModeParams of ByronMode -> pure $ AnyCardanoEra ByronEra ShelleyMode -> pure $ AnyCardanoEra ShelleyEra - CardanoMode -> OO.runOops1 - $ queryNodeLocalState localNodeConnInfo Nothing - $ QueryCurrentEra CardanoModeIsMultiEra + CardanoMode -> + queryNodeLocalState localNodeConnInfo Nothing + $ QueryCurrentEra CardanoModeIsMultiEra getSbe :: CardanoEraStyle era -> Either QueryConvenienceError (ShelleyBasedEra era) getSbe LegacyByronEra = Left ByronEraNotSupported diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs index 735735325d7..482ff2d87fc 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs @@ -388,8 +388,9 @@ runQueryUTxO (AnyConsensusModeParams cModeParams) $ newExceptT readEnvSocketPath let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath - anyE@(AnyCardanoEra era) <- catchE (determineEra cModeParams localNodeConnInfo) - \e -> throwE $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e + anyE@(AnyCardanoEra era) <- OO.runOops1 @ShelleyQueryCmdError do + determineEra cModeParams localNodeConnInfo + & do OO.catchM @AcquireFailure \e -> OO.throwM $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e let cMode = consensusModeOnly cModeParams sbe <- getSbe $ cardanoEraStyle era @@ -423,8 +424,9 @@ runQueryKesPeriodInfo (AnyConsensusModeParams cModeParams) network nodeOpCertFil $ newExceptT readEnvSocketPath let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath - anyE@(AnyCardanoEra era) <- catchE (determineEra cModeParams localNodeConnInfo) - \e -> throwE $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e + anyE@(AnyCardanoEra era) <- OO.runOops1 @ShelleyQueryCmdError do + determineEra cModeParams localNodeConnInfo + & do OO.catchM @AcquireFailure \e -> OO.throwM $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e let cMode = consensusModeOnly cModeParams sbe <- getSbe $ cardanoEraStyle era @@ -632,8 +634,9 @@ runQueryPoolState (AnyConsensusModeParams cModeParams) network poolIds = do $ newExceptT readEnvSocketPath let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath - anyE@(AnyCardanoEra era) <- catchE (determineEra cModeParams localNodeConnInfo) - \e -> throwE $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e + anyE@(AnyCardanoEra era) <- OO.runOops1 @ShelleyQueryCmdError do + determineEra cModeParams localNodeConnInfo + & do OO.catchM @AcquireFailure \e -> OO.throwM $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e let cMode = consensusModeOnly cModeParams sbe <- getSbe $ cardanoEraStyle era @@ -659,8 +662,9 @@ runQueryTxMempool (AnyConsensusModeParams cModeParams) network query mOutFile = localQuery <- case query of TxMempoolQueryTxExists tx -> do - anyE@(AnyCardanoEra era) <- catchE (determineEra cModeParams localNodeConnInfo) - \e -> throwE $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e + anyE@(AnyCardanoEra era) <- OO.runOops1 @ShelleyQueryCmdError do + determineEra cModeParams localNodeConnInfo + & do OO.catchM @AcquireFailure \e -> OO.throwM $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e let cMode = consensusModeOnly cModeParams eInMode <- toEraInMode era cMode & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE) @@ -688,8 +692,9 @@ runQueryStakeSnapshot (AnyConsensusModeParams cModeParams) network poolId = do SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr $ newExceptT readEnvSocketPath let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath - anyE@(AnyCardanoEra era) <- catchE (determineEra cModeParams localNodeConnInfo) - \e -> throwE $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e + anyE@(AnyCardanoEra era) <- OO.runOops1 @ShelleyQueryCmdError do + determineEra cModeParams localNodeConnInfo + & do OO.catchM @AcquireFailure \e -> OO.throwM $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e let cMode = consensusModeOnly cModeParams sbe <- getSbe $ cardanoEraStyle era @@ -713,8 +718,9 @@ runQueryLedgerState (AnyConsensusModeParams cModeParams) $ newExceptT readEnvSocketPath let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath - anyE@(AnyCardanoEra era) <- catchE (determineEra cModeParams localNodeConnInfo) - \e -> throwE $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e + anyE@(AnyCardanoEra era) <- OO.runOops1 @ShelleyQueryCmdError do + determineEra cModeParams localNodeConnInfo + & do OO.catchM @AcquireFailure \e -> OO.throwM $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e let cMode = consensusModeOnly cModeParams sbe <- getSbe $ cardanoEraStyle era @@ -744,8 +750,9 @@ runQueryProtocolState (AnyConsensusModeParams cModeParams) $ newExceptT readEnvSocketPath let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath - anyE@(AnyCardanoEra era) <- catchE (determineEra cModeParams localNodeConnInfo) - \e -> throwE $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e + anyE@(AnyCardanoEra era) <- OO.runOops1 @ShelleyQueryCmdError do + determineEra cModeParams localNodeConnInfo + & do OO.catchM @AcquireFailure \e -> OO.throwM $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e let cMode = consensusModeOnly cModeParams sbe <- getSbe $ cardanoEraStyle era @@ -782,8 +789,9 @@ runQueryStakeAddressInfo (AnyConsensusModeParams cModeParams) $ newExceptT readEnvSocketPath let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath - anyE@(AnyCardanoEra era) <- catchE (determineEra cModeParams localNodeConnInfo) - \e -> throwE $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e + anyE@(AnyCardanoEra era) <- OO.runOops1 @ShelleyQueryCmdError do + determineEra cModeParams localNodeConnInfo + & do OO.catchM @AcquireFailure \e -> OO.throwM $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e let cMode = consensusModeOnly cModeParams sbe <- getSbe $ cardanoEraStyle era @@ -1084,8 +1092,9 @@ runQueryStakeDistribution (AnyConsensusModeParams cModeParams) $ newExceptT readEnvSocketPath let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath - anyE@(AnyCardanoEra era) <- catchE (determineEra cModeParams localNodeConnInfo) - \e -> throwE $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e + anyE@(AnyCardanoEra era) <- OO.runOops1 @ShelleyQueryCmdError do + determineEra cModeParams localNodeConnInfo + & do OO.catchM @AcquireFailure \e -> OO.throwM $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e let cMode = consensusModeOnly cModeParams sbe <- getSbe $ cardanoEraStyle era @@ -1207,8 +1216,9 @@ runQueryLeadershipSchedule (AnyConsensusModeParams cModeParams) network $ newExceptT readEnvSocketPath let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath - anyE@(AnyCardanoEra era) <- catchE (determineEra cModeParams localNodeConnInfo) - \e -> throwE $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e + anyE@(AnyCardanoEra era) <- OO.runOops1 do + determineEra cModeParams localNodeConnInfo + & do OO.catchM @AcquireFailure \e -> OO.throwM $ ShelleyQueryCmdAcquireFailure $ toAcquiringFailure e sbe <- getSbe $ cardanoEraStyle era let cMode = consensusModeOnly cModeParams diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs index 6d006041403..73eef18b70c 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs @@ -23,6 +23,7 @@ module Cardano.CLI.Shelley.Run.Transaction import Cardano.Prelude hiding (All, Any) import Prelude (String, error, id) +import qualified Control.Monad.Oops as OO import Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither, hoistMaybe, left, newExceptT) import Data.Aeson.Encode.Pretty (encodePretty) @@ -353,8 +354,10 @@ runTxBuildCmd , localNodeSocketPath = sockPath } - AnyCardanoEra nodeEra <- catchE (determineEra cModeParams localNodeConnInfo) - \e -> throwE $ ShelleyTxCmdQueryConvenienceError $ AcqFailure $ toAcquiringFailure e + AnyCardanoEra nodeEra <- OO.runOops1 @ShelleyTxCmdError do + determineEra cModeParams localNodeConnInfo + & do OO.catchM @AcquireFailure \e -> + OO.throwM $ ShelleyTxCmdQueryConvenienceError $ AcqFailure $ toAcquiringFailure e inputsAndMaybeScriptWits <- firstExceptT ShelleyTxCmdScriptWitnessError $ readScriptWitnessFiles cEra txins certFilesAndMaybeScriptWits <- firstExceptT ShelleyTxCmdScriptWitnessError $ readScriptWitnessFiles cEra certs @@ -708,8 +711,10 @@ runTxBuild era (AnyConsensusModeParams cModeParams) networkId mScriptValidity , localNodeNetworkId = networkId , localNodeSocketPath = sockPath } - AnyCardanoEra nodeEra <- catchE (determineEra cModeParams localNodeConnInfo) - $ \e -> throwE $ ShelleyTxCmdQueryConvenienceError $ AcqFailure $ toAcquiringFailure e + AnyCardanoEra nodeEra <- OO.runOops1 @ShelleyTxCmdError do + determineEra cModeParams localNodeConnInfo + & do OO.catchM @AcquireFailure \e -> + OO.throwM $ ShelleyTxCmdQueryConvenienceError $ AcqFailure $ toAcquiringFailure e (nodeEraUTxO, pparams, eraHistory, systemStart, stakePools) <- firstExceptT ShelleyTxCmdQueryConvenienceError