queryStateForBalancedTx: introduce a record to avoid a long list of p…

…arameters
IntersectMBO · Jun 18, 2024 · 4bbf621 · 4bbf621
1 parent 850aa19
commit 4bbf621
Show file tree

Hide file tree

Showing 2 changed files with 31 additions and 28 deletions.
diff --git a/cardano-api/internal/Cardano/Api/Convenience/Construction.hs b/cardano-api/internal/Cardano/Api/Convenience/Construction.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 -- | Convenience transaction construction functions
 --
@@ -16,23 +17,16 @@ module Cardano.Api.Convenience.Construction (
   ) where
 
 import           Cardano.Api.Address
-import           Cardano.Api.Certificate
+import           Cardano.Api.Convenience.Query (StateForBalancedTx (..))
 import           Cardano.Api.Eon.ShelleyBasedEra
 import           Cardano.Api.Fees
-import           Cardano.Api.ProtocolParameters
 import           Cardano.Api.Query
 import           Cardano.Api.Tx.Body
 import           Cardano.Api.Tx.Sign
 import           Cardano.Api.Utils
 
-import qualified Cardano.Ledger.Api as L
-import qualified Cardano.Ledger.Coin as L
-import qualified Cardano.Ledger.Credential as L
-import qualified Cardano.Ledger.Keys as L
-
 import qualified Data.List as List
 import qualified Data.Map.Strict as Map
-import           Data.Set (Set)
 import qualified Data.Set as Set
 import           Data.Text (Text)
 import qualified Data.Text as Text
@@ -46,23 +40,19 @@ constructBalancedTx :: ()
   -> TxBodyContent BuildTx era
   -> AddressInEra era -- ^ Change address
   -> Maybe Word       -- ^ Override key witnesses
-  -> UTxO era         -- ^ Just the transaction inputs, not the entire 'UTxO'.
-  -> LedgerProtocolParameters era
+  -> StateForBalancedTx () era
   -> LedgerEpochInfo
-  -> SystemStart
-  -> Set PoolId       -- ^ The set of registered stake pools
-  -> Map.Map StakeCredential L.Coin
-  -> Map.Map (L.Credential L.DRepRole L.StandardCrypto) L.Coin
   -> [ShelleyWitnessSigningKey]
   -> Either (TxBodyErrorAutoBalance era) (Tx era)
-constructBalancedTx sbe txbodcontent changeAddr mOverrideWits utxo lpp
-                    ledgerEpochInfo systemStart stakePools
-                    stakeDelegDeposits drepDelegDeposits shelleyWitSigningKeys = do
+constructBalancedTx sbe txbodcontent changeAddr mOverrideWits
+                    StateForBalancedTx {utxo, pparams, systemStart, stakePools, stakeDelegDeposits, drepDelegDeposits}
+                    ledgerEpochInfo
+                     shelleyWitSigningKeys = do
 
   BalancedTxBody _ txbody _txBalanceOutput _fee
     <- makeTransactionBodyAutoBalance
          sbe systemStart ledgerEpochInfo
-         lpp stakePools stakeDelegDeposits drepDelegDeposits utxo txbodcontent
+         pparams stakePools stakeDelegDeposits drepDelegDeposits utxo txbodcontent
          changeAddr mOverrideWits
 
   let keyWits = map (makeShelleyKeyWitness sbe txbody) shelleyWitSigningKeys

diff --git a/cardano-api/internal/Cardano/Api/Convenience/Query.hs b/cardano-api/internal/Cardano/Api/Convenience/Query.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -13,6 +14,7 @@ module Cardano.Api.Convenience.Query (
 
     queryStateForBalancedTx,
     renderQueryConvenienceError,
+    StateForBalancedTx(..)
   ) where
 
 import           Cardano.Api.Address
@@ -69,22 +71,26 @@ renderQueryConvenienceError (QceUnsupportedNtcVersion (UnsupportedNtcVersionErro
   "This query requires at least " <> textShow minNtcVersion <> " but the node negotiated " <> textShow ntcVersion <> ".\n" <>
   "Later node versions support later protocol versions (but development protocol versions are not enabled in the node by default)."
 
+-- | Data returned by 'queryStateForBalancedTx'. Parameterized on the type of 'eraHistory',
+-- because sometimes we don't need it.
+data StateForBalancedTx history era = StateForBalancedTx
+  { utxo :: UTxO era
+  , pparams :: LedgerProtocolParameters era
+  , eraHistory :: history
+  , systemStart :: SystemStart
+  , stakePools :: Set PoolId
+  , stakeDelegDeposits :: Map StakeCredential L.Coin
+  , drepDelegDeposits :: Map (L.Credential L.DRepRole L.StandardCrypto) L.Coin
+  }
+
 -- | A convenience function to query the relevant information, from
 -- the local node, for Cardano.Api.Convenience.Construction.constructBalancedTx
 queryStateForBalancedTx :: ()
   => CardanoEra era
   -> [TxIn]
   -> [Certificate era]
   -> LocalStateQueryExpr block point QueryInMode r IO
-      ( Either
-          QueryConvenienceError
-          ( UTxO era
-          , LedgerProtocolParameters era
-          , EraHistory
-          , SystemStart
-          , Set PoolId
-          , Map StakeCredential L.Coin
-          , Map (L.Credential L.DRepRole L.StandardCrypto) L.Coin))
+      (Either QueryConvenienceError (StateForBalancedTx EraHistory era))
 queryStateForBalancedTx era allTxIns certs = runExceptT $ do
   sbe <- requireShelleyBasedEra era
     & onNothing (left ByronEraNotSupported)
@@ -124,7 +130,14 @@ queryStateForBalancedTx era allTxIns certs = runExceptT $ do
           & onLeft (left . QceUnsupportedNtcVersion)
           & onLeft (left . QueryEraMismatch))
 
-  pure (utxo, LedgerProtocolParameters pparams, eraHistory, systemStart, stakePools, stakeDelegDeposits, drepDelegDeposits)
+  pure $ StateForBalancedTx
+           { utxo
+             , pparams = LedgerProtocolParameters pparams
+             , eraHistory
+             , systemStart
+             , stakePools
+             , stakeDelegDeposits
+             , drepDelegDeposits }
 
 -- | Query the node to determine which era it is in.
 determineEra :: ()