Query for stakepools in runTxBuild

IntersectMBO · Sep 5, 2021 · 03339e7 · 03339e7
1 parent beba405
commit 03339e7
Show file tree

Hide file tree

Showing 2 changed files with 8 additions and 17 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs
@@ -666,12 +666,6 @@ printUtxo shelleyBasedEra' txInOutTuple =
   printableValue (TxOutValue _ val) = renderValue val
   printableValue (TxOutAdaOnly _ (Lovelace i)) = Text.pack $ show i
 
-joinEither :: (x -> z) -> (y -> z) -> Either x (Either y a) -> Either z a
-joinEither f g = join . bimap f (first g)
-
-joinEitherM :: Functor m => (x -> z) -> (y -> z) -> m (Either x (Either y a)) -> m (Either z a)
-joinEitherM f g = fmap (joinEither f g)
-
 runQueryStakePools
   :: AnyConsensusModeParams
   -> NetworkId
@@ -683,7 +677,7 @@ runQueryStakePools (AnyConsensusModeParams cModeParams)
 
   let localNodeConnInfo = LocalNodeConnectInfo cModeParams network sockPath
 
-  result <- ExceptT . joinEitherM ShelleyQueryCmdAcquireFailure id $
+  result <- ExceptT . fmap (join . first ShelleyQueryCmdAcquireFailure) $
     executeLocalStateQueryExpr localNodeConnInfo Nothing $ \_ntcVersion -> runExceptT @ShelleyQueryCmdError $ do
       anyE@(AnyCardanoEra era) <- case consensusModeOnly cModeParams of
         ByronMode -> return $ AnyCardanoEra ByronEra

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs
@@ -369,12 +369,6 @@ runTxBuildRaw (AnyCardanoEra era)
     firstExceptT ShelleyTxCmdWriteFileError . newExceptT $
       writeFileTextEnvelope fpath Nothing txBody
 
-joinEither :: (x -> z) -> (y -> z) -> Either x (Either y a) -> Either z a
-joinEither f g = join . bimap f (first g)
-
-joinEitherM :: Functor m => (x -> z) -> (y -> z) -> m (Either x (Either y a)) -> m (Either z a)
-joinEitherM f g = fmap (joinEither f g)
-
 runTxBuild
   :: AnyCardanoEra
   -> AnyConsensusModeParams
@@ -446,8 +440,8 @@ runTxBuild (AnyCardanoEra era) (AnyConsensusModeParams cModeParams) networkId mS
                      left (ShelleyTxCmdEraConsensusModeMismatchTxBalance outBody
                             (AnyConsensusMode CardanoMode) (AnyCardanoEra era))
 
-      (utxo, pparams, eraHistory, systemStart) <-
-        newExceptT . joinEitherM ShelleyTxCmdAcquireFailure id $
+      (utxo, pparams, eraHistory, systemStart, stakePools) <-
+        newExceptT . fmap (join . first ShelleyTxCmdAcquireFailure) $
           executeLocalStateQueryExpr localNodeConnInfo Nothing $ \_ntcVersion -> runExceptT $ do
             utxo <- firstExceptT ShelleyTxCmdTxSubmitErrorEraMismatch . newExceptT . queryExpr
               $ QueryInEra eInMode $ QueryInShelleyBasedEra sbe
@@ -460,7 +454,10 @@ runTxBuild (AnyCardanoEra era) (AnyConsensusModeParams cModeParams) networkId mS
 
             systemStart <- lift $ queryExpr QuerySystemStart
 
-            return (utxo, pparams, eraHistory, systemStart)
+            stakePools <- firstExceptT ShelleyTxCmdTxSubmitErrorEraMismatch . ExceptT $
+              queryExpr . QueryInEra eInMode . QueryInShelleyBasedEra sbe $ QueryStakePools
+
+            return (utxo, pparams, eraHistory, systemStart, stakePools)
 
       let cAddr = case anyAddressInEra era changeAddr of
                     Just addr -> addr
@@ -470,7 +467,7 @@ runTxBuild (AnyCardanoEra era) (AnyConsensusModeParams cModeParams) networkId mS
         firstExceptT ShelleyTxCmdBalanceTxBody
           . hoistEither
           $ makeTransactionBodyAutoBalance eInMode systemStart eraHistory
-                                           pparams Set.empty utxo txBodyContent
+                                           pparams stakePools utxo txBodyContent
                                            cAddr mOverrideWits
 
       putStrLn $ "Estimated transaction fee: " <> (show fee :: String)