Review Fixes

IntersectMBO · Mar 10, 2021 · 87f118a · 87f118a
1 parent cdd4233
commit 87f118a
Showing 1 changed file with 29 additions and 55 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs
@@ -31,8 +31,7 @@ import qualified Data.Text.IO as Text
 import qualified Data.Vector as Vector
 import           Numeric (showEFloat)
 
-import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistMaybe, left,
-                   newExceptT)
+import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistMaybe, left)
 
 import           Cardano.Api
 import           Cardano.Api.Byron
@@ -123,8 +122,7 @@ runQueryProtocolParameters (AnyConsensusModeParams cModeParams) network mOutFile
   case consensusModeOnly cModeParams of
     ByronMode -> left ShelleyQueryCmdByronEra
     ShelleyMode -> do
-      let anyEra = AnyCardanoEra ShelleyEra
-      eraInMode <- calcEraInMode anyEra ShelleyEra ShelleyMode
+      eraInMode <- calcEraInMode ShelleyEra ShelleyMode
 
       let qInMode = QueryInEra eraInMode
                       $ QueryInShelleyBasedEra ShelleyBasedEraShelley QueryProtocolParameters
@@ -133,15 +131,9 @@ runQueryProtocolParameters (AnyConsensusModeParams cModeParams) network mOutFile
       handleQueryResult finalRes $ writeProtocolParameters mOutFile
 
     CardanoMode -> do
-      eraQ <- liftIO . queryNodeLocalState localNodeConnInfo (Just point)
-                     $ QueryCurrentEra CardanoModeIsMultiEra
+      AnyCardanoEra era <- getCurrentEra localNodeConnInfo point
 
-      anyEra@(AnyCardanoEra era) <-
-        case eraQ of
-          Left acqFail -> left $ ShelleyQueryCmdAcquireFailure acqFail
-          Right anyCarEra -> return anyCarEra
-
-      eraInMode <- calcEraInMode anyEra era CardanoMode
+      eraInMode <- calcEraInMode era CardanoMode
 
       qInMode <- case cardanoEraStyle era of
                    LegacyByronEra -> left ShelleyQueryCmdByronEra
@@ -190,10 +182,7 @@ runQueryTip (AnyConsensusModeParams cModeParams) network mOutFile = do
         Nothing                 -> liftIO $ LBS.putStrLn        output
 
     CardanoMode -> do
-      anyEra <- firstExceptT ShelleyQueryCmdAcquireFailure
-                  . newExceptT
-                  . queryNodeLocalState localNodeConnInfo (Just point)
-                    $ QueryCurrentEra CardanoModeIsMultiEra
+      anyEra <- getCurrentEra localNodeConnInfo point
 
       mEpoch <- mEpochQuery anyEra consensusMode tip localNodeConnInfo
 
@@ -257,14 +246,9 @@ runQueryUTxO (AnyConsensusModeParams cModeParams)
       eUtxo <- liftIO $ queryNodeLocalState localNodeConnInfo (Just point) qInMode
       handleQueryResult eUtxo $ writeFilteredUTxOs ShelleyBasedEraShelley mOutFile
     CardanoMode -> do
-       eraQ <- liftIO . queryNodeLocalState localNodeConnInfo (Just point)
-                      $ QueryCurrentEra CardanoModeIsMultiEra
-       anyEra@(AnyCardanoEra era) <-
-         case eraQ of
-           Left acqFail -> left $ ShelleyQueryCmdAcquireFailure acqFail
-           Right anyCarEra -> return anyCarEra
+       AnyCardanoEra era <- getCurrentEra localNodeConnInfo point
 
-       eraInMode <- calcEraInMode anyEra era CardanoMode
+       eraInMode <- calcEraInMode era CardanoMode
 
        sbe <- getSbe $ cardanoEraStyle era
 
@@ -310,14 +294,9 @@ runQueryLedgerState (AnyConsensusModeParams cModeParams)
         $ obtainLedgerEraClassConstraints ShelleyBasedEraShelley
         $ writeLedgerState mOutFile
     CardanoMode -> do
-      eraQ <- liftIO . queryNodeLocalState localNodeConnInfo (Just point)
-                     $ QueryCurrentEra CardanoModeIsMultiEra
-      anyEra@(AnyCardanoEra era) <-
-        case eraQ of
-          Left acqFail -> left $ ShelleyQueryCmdAcquireFailure acqFail
-          Right anyCarEra -> return anyCarEra
+      AnyCardanoEra era <- getCurrentEra localNodeConnInfo point
 
-      eraInMode <- calcEraInMode anyEra era CardanoMode
+      eraInMode <- calcEraInMode era CardanoMode
 
       sbe <- getSbe $ cardanoEraStyle era
 
@@ -353,14 +332,9 @@ runQueryProtocolState (AnyConsensusModeParams cModeParams)
       handleQueryResult res $ writeProtocolState mOutFile
 
     CardanoMode -> do
-      eraQ <- liftIO . queryNodeLocalState localNodeConnInfo (Just point)
-                     $ QueryCurrentEra CardanoModeIsMultiEra
-      anyEra@(AnyCardanoEra era) <-
-        case eraQ of
-          Left acqFail -> left $ ShelleyQueryCmdAcquireFailure acqFail
-          Right anyCarEra -> return anyCarEra
+      AnyCardanoEra era <- getCurrentEra localNodeConnInfo point
 
-      eraInMode <- calcEraInMode anyEra era CardanoMode
+      eraInMode <- calcEraInMode era CardanoMode
 
       sbe <- getSbe $ cardanoEraStyle era
 
@@ -399,14 +373,9 @@ runQueryStakeAddressInfo (AnyConsensusModeParams cModeParams)
       handleQueryResult res $ writeStakeAddressInfo mOutFile . DelegationsAndRewards
 
     CardanoMode -> do
-      eraQ <- liftIO . queryNodeLocalState localNodeConnInfo (Just point)
-                     $ QueryCurrentEra CardanoModeIsMultiEra
-      anyEra@(AnyCardanoEra era) <-
-        case eraQ of
-          Left acqFail -> left $ ShelleyQueryCmdAcquireFailure acqFail
-          Right anyCarEra -> return anyCarEra
+      AnyCardanoEra era <- getCurrentEra localNodeConnInfo point
 
-      eraInMode <- calcEraInMode anyEra era CardanoMode
+      eraInMode <- calcEraInMode era CardanoMode
 
       sbe <- getSbe $ cardanoEraStyle era
       let stakeAddr = Set.singleton $ fromShelleyStakeCredential addr
@@ -595,14 +564,9 @@ runQueryStakeDistribution (AnyConsensusModeParams cModeParams)
       res <- liftIO $ queryNodeLocalState localNodeConnInfo (Just point) query
       handleQueryResult res $ writeStakeDistribution mOutFile
     CardanoMode -> do
-      eraQ <- liftIO . queryNodeLocalState localNodeConnInfo (Just point)
-                          $ QueryCurrentEra CardanoModeIsMultiEra
-      anyEra@(AnyCardanoEra era) <-
-        case eraQ of
-          Left acqFail -> left $ ShelleyQueryCmdAcquireFailure acqFail
-          Right anyCarEra -> return anyCarEra
+      AnyCardanoEra era <- getCurrentEra localNodeConnInfo point
 
-      eraInMode <- calcEraInMode anyEra era CardanoMode
+      eraInMode <- calcEraInMode era CardanoMode
 
       sbe <- getSbe $ cardanoEraStyle era
 
@@ -675,13 +639,23 @@ instance ToJSON DelegationsAndRewards where
 
 -- Helpers
 
+getCurrentEra
+  :: LocalNodeConnectInfo CardanoMode
+  -> ChainPoint
+  -> ExceptT ShelleyQueryCmdError IO AnyCardanoEra
+getCurrentEra localNodeConnInfo point = do
+  eraQ <- liftIO . queryNodeLocalState localNodeConnInfo (Just point)
+               $ QueryCurrentEra CardanoModeIsMultiEra
+  case eraQ of
+    Left acqFail -> left $ ShelleyQueryCmdAcquireFailure acqFail
+    Right anyCarEra -> return anyCarEra
+
 calcEraInMode
-  :: AnyCardanoEra
-  -> CardanoEra era
+  :: CardanoEra era
   -> ConsensusMode mode
   -> ExceptT ShelleyQueryCmdError IO (EraInMode era mode)
-calcEraInMode anyEra era mode=
-  hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch anyEra (AnyConsensusMode mode))
+calcEraInMode era mode=
+  hoistMaybe (ShelleyQueryCmdEraConsensusModeMismatch (anyCardanoEra era) (AnyConsensusMode mode))
                    $ toEraInMode era mode
 
 handleQueryResult