Using onLeft combinator in more places

IntersectMBO · Jan 20, 2023 · a7a9ba0 · a7a9ba0
1 parent 2653fe7
commit a7a9ba0
Showing 1 changed file with 49 additions and 59 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs
@@ -211,8 +211,7 @@ runQueryProtocolParameters
   -> Maybe OutputFile
   -> ExceptT ShelleyQueryCmdError IO ()
 runQueryProtocolParameters (AnyConsensusModeParams cModeParams) network mOutFile = do
-  SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr
-                           $ newExceptT readEnvSocketPath
+  SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr)
   let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
 
   result <- liftIO $ executeLocalStateQueryExpr localNodeConnInfo Nothing $ runExceptT $ do
@@ -376,9 +375,8 @@ runQueryUTxO (AnyConsensusModeParams cModeParams)
                          $ newExceptT readEnvSocketPath
   let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
 
-  anyE@(AnyCardanoEra era) <-
-    firstExceptT ShelleyQueryCmdAcquireFailure
-      . newExceptT $ determineEra cModeParams localNodeConnInfo
+  anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
+    & onLeft (throwE . ShelleyQueryCmdAcquireFailure)
 
   let cMode = consensusModeOnly cModeParams
   sbe <- getSbe $ cardanoEraStyle era
@@ -405,16 +403,14 @@ runQueryKesPeriodInfo
 runQueryKesPeriodInfo (AnyConsensusModeParams cModeParams) network nodeOpCertFile
                        mOutFile = do
 
-  opCert <- firstExceptT ShelleyQueryCmdOpCertCounterReadError
-              . newExceptT $ readFileTextEnvelope AsOperationalCertificate nodeOpCertFile
+  opCert <- lift (readFileTextEnvelope AsOperationalCertificate nodeOpCertFile)
+    & onLeft (throwE . ShelleyQueryCmdOpCertCounterReadError)
 
-  SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr
-                           $ newExceptT readEnvSocketPath
+  SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr)
   let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
 
-  anyE@(AnyCardanoEra era) <-
-    firstExceptT ShelleyQueryCmdAcquireFailure
-      . newExceptT $ determineEra cModeParams localNodeConnInfo
+  anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
+    & onLeft (throwE . ShelleyQueryCmdAcquireFailure)
 
   let cMode = consensusModeOnly cModeParams
   sbe <- getSbe $ cardanoEraStyle era
@@ -436,7 +432,8 @@ runQueryKesPeriodInfo (AnyConsensusModeParams cModeParams) network nodeOpCertFil
           oCertEndKesPeriod = opCertEndKesPeriod gParams opCert
           opCertIntervalInformation = opCertIntervalInfo gParams chainTip curKesPeriod oCertStartKesPeriod oCertEndKesPeriod
 
-      eraHistory <- firstExceptT ShelleyQueryCmdAcquireFailure . newExceptT $ queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery
+      eraHistory <- lift (queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery)
+        & onLeft (throwE . ShelleyQueryCmdAcquireFailure)
 
       let eInfo = toEpochInfo eraHistory
 
@@ -616,14 +613,12 @@ runQueryPoolState
   -> [Hash StakePoolKey]
   -> ExceptT ShelleyQueryCmdError IO ()
 runQueryPoolState (AnyConsensusModeParams cModeParams) network poolIds = do
-  SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr
-                           $ newExceptT readEnvSocketPath
-  let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
+  SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr)
 
+  let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
 
-  anyE@(AnyCardanoEra era) <-
-    firstExceptT ShelleyQueryCmdAcquireFailure
-      . newExceptT $ determineEra cModeParams localNodeConnInfo
+  anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
+    & onLeft (throwE . ShelleyQueryCmdAcquireFailure)
 
   let cMode = consensusModeOnly cModeParams
   sbe <- getSbe $ cardanoEraStyle era
@@ -643,14 +638,13 @@ runQueryTxMempool
   -> Maybe OutputFile
   -> ExceptT ShelleyQueryCmdError IO ()
 runQueryTxMempool (AnyConsensusModeParams cModeParams) network query mOutFile = do
-  SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr
-                           $ newExceptT readEnvSocketPath
+  SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr)
   let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
 
   localQuery <- case query of
       TxMempoolQueryTxExists tx -> do
-        anyE@(AnyCardanoEra era) <- firstExceptT ShelleyQueryCmdAcquireFailure
-                                      . newExceptT $ determineEra cModeParams localNodeConnInfo
+        anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
+          & onLeft (throwE . ShelleyQueryCmdAcquireFailure)
         let cMode = consensusModeOnly cModeParams
         eInMode <- toEraInMode era cMode
           & hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (AnyConsensusMode cMode) anyE)
@@ -679,9 +673,8 @@ runQueryStakeSnapshot (AnyConsensusModeParams cModeParams) network allOrOnlyPool
   SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr $ newExceptT readEnvSocketPath
   let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
 
-  anyE@(AnyCardanoEra era) <-
-    firstExceptT ShelleyQueryCmdAcquireFailure
-      . newExceptT $ determineEra cModeParams localNodeConnInfo
+  anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
+    & onLeft (throwE . ShelleyQueryCmdAcquireFailure)
 
   let cMode = consensusModeOnly cModeParams
   sbe <- getSbe $ cardanoEraStyle era
@@ -704,13 +697,11 @@ runQueryLedgerState
   -> ExceptT ShelleyQueryCmdError IO ()
 runQueryLedgerState (AnyConsensusModeParams cModeParams)
                     network mOutFile = do
-  SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr
-                           $ newExceptT readEnvSocketPath
+  SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr)
   let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
 
-  anyE@(AnyCardanoEra era) <-
-    firstExceptT ShelleyQueryCmdAcquireFailure
-      . newExceptT $ determineEra cModeParams localNodeConnInfo
+  anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
+    & onLeft (throwE . ShelleyQueryCmdAcquireFailure)
 
   let cMode = consensusModeOnly cModeParams
   sbe <- getSbe $ cardanoEraStyle era
@@ -736,13 +727,11 @@ runQueryProtocolState
   -> ExceptT ShelleyQueryCmdError IO ()
 runQueryProtocolState (AnyConsensusModeParams cModeParams)
                       network mOutFile = do
-  SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr
-                           $ newExceptT readEnvSocketPath
+  SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr)
   let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
 
-  anyE@(AnyCardanoEra era) <-
-    firstExceptT ShelleyQueryCmdAcquireFailure
-      . newExceptT $ determineEra cModeParams localNodeConnInfo
+  anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
+    & onLeft (throwE . ShelleyQueryCmdAcquireFailure)
 
   let cMode = consensusModeOnly cModeParams
   sbe <- getSbe $ cardanoEraStyle era
@@ -775,13 +764,11 @@ runQueryStakeAddressInfo
   -> ExceptT ShelleyQueryCmdError IO ()
 runQueryStakeAddressInfo (AnyConsensusModeParams cModeParams)
                          (StakeAddress _ addr) network mOutFile = do
-  SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr
-                           $ newExceptT readEnvSocketPath
+  SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr)
   let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
 
-  anyE@(AnyCardanoEra era) <-
-    firstExceptT ShelleyQueryCmdAcquireFailure
-      . newExceptT $ determineEra cModeParams localNodeConnInfo
+  anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
+    & onLeft (throwE . ShelleyQueryCmdAcquireFailure)
 
   let cMode = consensusModeOnly cModeParams
   sbe <- getSbe $ cardanoEraStyle era
@@ -1066,13 +1053,11 @@ runQueryStakeDistribution
   -> ExceptT ShelleyQueryCmdError IO ()
 runQueryStakeDistribution (AnyConsensusModeParams cModeParams)
                           network mOutFile = do
-  SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr
-                           $ newExceptT readEnvSocketPath
+  SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr)
   let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
 
-  anyE@(AnyCardanoEra era) <-
-    firstExceptT ShelleyQueryCmdAcquireFailure
-      . newExceptT $ determineEra cModeParams localNodeConnInfo
+  anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
+    & onLeft (throwE . ShelleyQueryCmdAcquireFailure)
 
   let cMode = consensusModeOnly cModeParams
   sbe <- getSbe $ cardanoEraStyle era
@@ -1194,24 +1179,24 @@ runQueryLeadershipSchedule
 runQueryLeadershipSchedule (AnyConsensusModeParams cModeParams) network
                            (GenesisFile genFile) coldVerKeyFile (SigningKeyFile vrfSkeyFp)
                            whichSchedule mJsonOutputFile = do
-  SocketPath sockPath <- firstExceptT ShelleyQueryCmdEnvVarSocketErr
-                           $ newExceptT readEnvSocketPath
+  SocketPath sockPath <- lift readEnvSocketPath & onLeft (throwE . ShelleyQueryCmdEnvVarSocketErr)
   let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
 
-  anyE@(AnyCardanoEra era) <-
-    firstExceptT ShelleyQueryCmdAcquireFailure
-      . newExceptT $ determineEra cModeParams localNodeConnInfo
+  anyE@(AnyCardanoEra era) <- lift (determineEra cModeParams localNodeConnInfo)
+    & onLeft (throwE . ShelleyQueryCmdAcquireFailure)
 
   sbe <- getSbe $ cardanoEraStyle era
   let cMode = consensusModeOnly cModeParams
 
-  poolid <- firstExceptT ShelleyQueryCmdTextReadError
-              . newExceptT $ readVerificationKeyOrHashOrFile AsStakePoolKey coldVerKeyFile
+  poolid <- lift (readVerificationKeyOrHashOrFile AsStakePoolKey coldVerKeyFile)
+    & onLeft (throwE . ShelleyQueryCmdTextReadError)
+
+  vrkSkey <- lift (readFileTextEnvelope (AsSigningKey AsVrfKey) vrfSkeyFp)
+    & onLeft (throwE . ShelleyQueryCmdTextEnvelopeReadError)
+
+  shelleyGenesis <- lift (readAndDecodeShelleyGenesis genFile)
+    & onLeft (throwE . ShelleyQueryCmdGenesisReadError)
 
-  vrkSkey <- firstExceptT ShelleyQueryCmdTextEnvelopeReadError . newExceptT
-               $ readFileTextEnvelope (AsSigningKey AsVrfKey) vrfSkeyFp
-  shelleyGenesis <- firstExceptT ShelleyQueryCmdGenesisReadError $
-                          newExceptT $ readAndDecodeShelleyGenesis genFile
   case cMode of
     CardanoMode -> do
       eInMode <- toEraInMode era cMode
@@ -1223,15 +1208,20 @@ runQueryLeadershipSchedule (AnyConsensusModeParams cModeParams) network
 
       pparams <- executeQuery era cModeParams localNodeConnInfo pparamsQuery
       ptclState <- executeQuery era cModeParams localNodeConnInfo ptclStateQuery
-      eraHistory <- firstExceptT ShelleyQueryCmdAcquireFailure . newExceptT $ queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery
-      let eInfo = toEpochInfo eraHistory
+      eraHistory <- lift (queryNodeLocalState localNodeConnInfo Nothing eraHistoryQuery)
+        & onLeft (throwE . ShelleyQueryCmdAcquireFailure)
+
       let currentEpochQuery = QueryInEra eInMode $ QueryInShelleyBasedEra sbe QueryEpoch
+
       curentEpoch <- executeQuery era cModeParams localNodeConnInfo currentEpochQuery
 
+      let eInfo = toEpochInfo eraHistory
+
       schedule <- case whichSchedule of
         CurrentEpoch -> do
           serCurrentEpochState <- executeQuery era cModeParams localNodeConnInfo $
             QueryInEra eInMode $ QueryInShelleyBasedEra sbe (QueryPoolDistribution (Just (Set.singleton poolid)))
+
           firstExceptT ShelleyQueryCmdLeaderShipError $ hoistEither
             $ eligibleLeaderSlotsConstaints sbe
             $ currentEpochEligibleLeadershipSlots