Straight line error handling

IntersectMBO · Jan 15, 2023 · 1ccbace · 1ccbace
1 parent 0a066fe
commit 1ccbace
Show file tree

Hide file tree

Showing 2 changed files with 38 additions and 42 deletions.
diff --git a/cardano-api/src/Cardano/Api/Convenience/Query.hs b/cardano-api/src/Cardano/Api/Convenience/Query.hs
@@ -15,7 +15,10 @@ module Cardano.Api.Convenience.Query (
 
 import           Prelude
 
+import           Control.Monad.Trans.Except (ExceptT(..), runExceptT)
+import           Control.Monad.Trans.Except.Extra (firstExceptT)
 import           Data.Bifunctor (first)
+import           Data.Function ((&))
 import           Data.Set (Set)
 import qualified Data.Set as Set
 import           Data.Text (Text)
@@ -63,48 +66,36 @@ queryStateForBalancedTx
   -> NetworkId
   -> [TxIn]
   -> IO (Either QueryConvenienceError (UTxO era, ProtocolParameters, EraHistory CardanoMode, SystemStart, Set PoolId))
-queryStateForBalancedTx era networkId allTxIns = do
- eSocketPath <- first SockErr <$> readEnvSocketPath
- case eSocketPath of
-  Left e -> return $ Left e
-  Right (SocketPath sockPath) -> do
-    let cModeParams = CardanoModeParams $ EpochSlots 21600
-        localNodeConnInfo = LocalNodeConnectInfo
-                              cModeParams
-                              networkId
-                              sockPath
-    eSbe <- return . getSbe $ cardanoEraStyle era
-    case eSbe of
-      Left e -> return $ Left e
-      Right qSbe -> do
-        case toEraInMode era CardanoMode of
-          Just qeInMode -> do
-
-            -- Queries
-            let utxoQuery = QueryInEra qeInMode $ QueryInShelleyBasedEra qSbe
-                              $ QueryUTxO (QueryUTxOByTxIn (Set.fromList allTxIns))
-                pparamsQuery = QueryInEra qeInMode
-                                 $ QueryInShelleyBasedEra qSbe QueryProtocolParameters
-                eraHistoryQuery = QueryEraHistory CardanoModeIsMultiEra
-                systemStartQuery = QuerySystemStart
-                stakePoolsQuery = QueryInEra qeInMode . QueryInShelleyBasedEra qSbe $ QueryStakePools
-
-            -- Query execution
-            eUtxo <- executeQueryCardanoMode era networkId utxoQuery
-            ePparams <- executeQueryCardanoMode era networkId pparamsQuery
-            eEraHistory <- queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery
-            eSystemStart <- queryNodeLocalState localNodeConnInfo Nothing systemStartQuery
-            eStakePools <- executeQueryCardanoMode era networkId stakePoolsQuery
-            return $ do
-              utxo <- eUtxo
-              pparams <- ePparams
-              eraHistory <- first AcqFailure eEraHistory
-              systemStart <- first AcqFailure eSystemStart
-              stakePools <- eStakePools
-              Right (utxo, pparams, eraHistory, systemStart, stakePools)
-          Nothing -> return $ Left $ EraConsensusModeMismatch
-                                      (AnyConsensusMode CardanoMode)
-                                      (getIsCardanoEraConstraint era $ AnyCardanoEra era)
+queryStateForBalancedTx era networkId allTxIns = runExceptT $ do
+  SocketPath sockPath <- ExceptT $ first SockErr <$> readEnvSocketPath
+
+  let cModeParams = CardanoModeParams $ EpochSlots 21600
+      localNodeConnInfo = LocalNodeConnectInfo
+                            cModeParams
+                            networkId
+                            sockPath
+  qSbe <- ExceptT $ return $ getSbe $ cardanoEraStyle era
+
+  qeInMode <- toEraInMode era CardanoMode
+    & throwNothingM (EraConsensusModeMismatch (AnyConsensusMode CardanoMode) (getIsCardanoEraConstraint era $ AnyCardanoEra era))
+
+  -- Queries
+  let utxoQuery = QueryInEra qeInMode $ QueryInShelleyBasedEra qSbe
+                    $ QueryUTxO (QueryUTxOByTxIn (Set.fromList allTxIns))
+      pparamsQuery = QueryInEra qeInMode
+                        $ QueryInShelleyBasedEra qSbe QueryProtocolParameters
+      eraHistoryQuery = QueryEraHistory CardanoModeIsMultiEra
+      systemStartQuery = QuerySystemStart
+      stakePoolsQuery = QueryInEra qeInMode . QueryInShelleyBasedEra qSbe $ QueryStakePools
+
+  -- Query execution
+  utxo <- ExceptT $ executeQueryCardanoMode era networkId utxoQuery
+  pparams <- ExceptT $ executeQueryCardanoMode era networkId pparamsQuery
+  eraHistory <- firstExceptT AcqFailure $ ExceptT $ queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery
+  systemStart <- firstExceptT AcqFailure $ ExceptT $ queryNodeLocalState localNodeConnInfo Nothing systemStartQuery
+  stakePools <- ExceptT $ executeQueryCardanoMode era networkId stakePoolsQuery
+
+  return (utxo, pparams, eraHistory, systemStart, stakePools)
 
 -- | Query the node to determine which era it is in.
 determineEra

diff --git a/cardano-api/src/Cardano/Api/Utils.hs b/cardano-api/src/Cardano/Api/Utils.hs
@@ -16,6 +16,7 @@ module Cardano.Api.Utils
   , failEitherWith
   , noInlineMaybeToStrictMaybe
   , note
+  , throwNothingM
   , parseFilePath
   , readFileBlocking
   , renderEra
@@ -50,6 +51,7 @@ import           System.Directory (emptyPermissions, readable, setPermissions)
 #endif
 
 import           Cardano.Api.Eras
+import Control.Monad.Trans.Except (ExceptT, throwE)
 
 (?!) :: Maybe a -> e -> Either e a
 Nothing ?! e = Left e
@@ -59,6 +61,9 @@ Just x  ?! _ = Right x
 Left  e ?!. f = Left (f e)
 Right x ?!. _ = Right x
 
+throwNothingM :: Monad m => e -> Maybe a -> ExceptT e m a
+throwNothingM e = maybe (throwE e) pure
+
 {-# NOINLINE noInlineMaybeToStrictMaybe #-}
 noInlineMaybeToStrictMaybe :: Maybe a -> StrictMaybe a
 noInlineMaybeToStrictMaybe Nothing = SNothing