From 4bbf6218fc7d826dde0389505b927514784a436b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Tue, 18 Jun 2024 17:48:51 +0200 Subject: [PATCH] queryStateForBalancedTx: introduce a record to avoid a long list of parameters --- .../Cardano/Api/Convenience/Construction.hs | 26 +++++---------- .../internal/Cardano/Api/Convenience/Query.hs | 33 +++++++++++++------ 2 files changed, 31 insertions(+), 28 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Convenience/Construction.hs b/cardano-api/internal/Cardano/Api/Convenience/Construction.hs index 50a2698f61..06a376f8c5 100644 --- 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 index 1731b033b6..6dbb24a18f 100644 --- 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,6 +71,18 @@ 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 :: () @@ -76,15 +90,7 @@ queryStateForBalancedTx :: () -> [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 :: ()