Convert determineEra to use oops.

IntersectMBO · Jan 15, 2023 · a89d79f · a89d79f
1 parent b0e07fa
commit a89d79f
Show file tree

Hide file tree

Showing 3 changed files with 45 additions and 29 deletions.
diff --git 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
@@ -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
@@ -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