Add submitTxFromBlueprint and deprecate older variants

Author: errfrom

examples/AdditionalUtxos.purs

@@ -42,11 +42,12 @@ import Contract.Sync (withoutSync)
 import Contract.Transaction
   ( ScriptRef(NativeScriptRef)
   , awaitTxConfirmed
-  , balanceTx
   , buildTx
   , createAdditionalUtxos
+  , defaultBalancer
   , signTransaction
   , submit
+  , submitTxFromBlueprint
   , withBalancedTx
   )
 import Contract.Utxos (UtxoMap)
@@ -135,16 +136,20 @@ spendFromValidator validator additionalUtxos _datum = do
       fromUtxoMap (Map.difference additionalUtxos scriptUtxos) <#> \output ->
         SpendOutput output Nothing
 
-    plan = spendScriptOutputs <> spendPubkeyOutputs
+    buildSteps = spendScriptOutputs <> spendPubkeyOutputs
 
     balancerConstraints :: BalancerConstraints
     balancerConstraints =
       mustUseAdditionalUtxos additionalUtxos
 
-  unbalancedTx <- buildTx plan
-  balancedTx <- balanceTx unbalancedTx additionalUtxos balancerConstraints
-  balancedSignedTx <- signTransaction balancedTx
-  txHash <- submit balancedSignedTx
+  { txHash } <- submitTxFromBlueprint
+    { buildSteps
+    , balancer: defaultBalancer
+    , balancerCtx:
+        { balancerConstraints
+        , extraUtxos: additionalUtxos
+        }
+    }
 
   awaitTxConfirmed txHash
   logInfo' "Successfully spent additional utxos from the validator address."

src/Contract/Transaction.purs

@@ -1,7 +1,9 @@
 -- | A module that defines the different transaction data types, balancing
 -- | functionality, transaction fees, signing and submission.
 module Contract.Transaction
-  ( balanceMultipleTxs
+  ( TxBlueprint
+  , TxReceipt
+  , balanceMultipleTxs
   , balanceTx
   , balanceTxE
   , balanceTxs
@@ -18,6 +20,7 @@ module Contract.Transaction
   , mkPoolPubKeyHash
   , hashTransaction
   , buildTx
+  , submitTxFromBlueprint
   , submitTxFromBuildPlan
   ) where
 
@@ -98,8 +101,13 @@ import Contract.UnbalancedTx (mkUnbalancedTx)
 import Control.Monad.Error.Class (catchError, liftEither, throwError)
 import Control.Monad.Reader (ReaderT, asks, runReaderT)
 import Control.Monad.Reader.Class (ask)
-import Ctl.Internal.BalanceTx (CtlBalancer, CtlBalancerContext, defaultBalancer) as X
-import Ctl.Internal.BalanceTx (defaultBalancer)
+import Ctl.Internal.BalanceTx
+  ( CtlBalancer
+  , CtlBalancerContext
+  , defaultBalancer
+  , defaultBalancerErr
+  ) as X
+import Ctl.Internal.BalanceTx (defaultBalancerErr)
 import Ctl.Internal.Contract.AwaitTxConfirmed
   ( awaitTxConfirmed
   , awaitTxConfirmedWithTimeout
@@ -273,7 +281,7 @@ balanceTxE
   -> BalancerConstraints
   -> Contract (Either BalanceTxError.BalanceTxError Transaction)
 balanceTxE tx utxos constraints =
-  defaultBalancer tx
+  defaultBalancerErr tx
     { balancerConstraints: constraints
     , extraUtxos: utxos
     }
@@ -389,7 +397,11 @@ createAdditionalUtxos tx = do
     foldl (\utxo txOut -> Map.insert (txIn $ length utxo) txOut utxo) Map.empty
 
 submitTxFromConstraints
-  :: ScriptLookups
+  :: Warn
+       ( Text
+           "Contract.TxConstraints is deprecated. Use `submitTxFromBlueprint` instead"
+       )
+  => ScriptLookups
   -> TxConstraints
   -> Contract TransactionHash
 submitTxFromConstraints lookups constraints = do
@@ -399,7 +411,8 @@ submitTxFromConstraints lookups constraints = do
   submit balancedSignedTx
 
 submitTxFromBuildPlan
-  :: UtxoMap
+  :: Warn (Text "Deprecated, use `submitTxFromBlueprint` instead")
+  => UtxoMap
   -> BalancerConstraints
   -> Array TransactionBuilderStep
   -> Contract Transaction
@@ -410,6 +423,40 @@ submitTxFromBuildPlan usedUtxos balancerConstraints plan = do
   void $ submit balancedSignedTx
   pure balancedSignedTx
 
+-- | Blueprint containing the steps and context required to construct
+-- | and balance a transaction.
+type TxBlueprint (ctx :: Type) =
+  { buildSteps :: Array TransactionBuilderStep
+  , balancer :: TxBalancer Contract Error ctx
+  , balancerCtx :: ctx
+  }
+
+-- | Represents the result of submitting a transaction via
+-- | `submitTxFromBlueprint`, which includes the balanced signed transaction
+-- | along with its hash.
+type TxReceipt =
+  { submittedTx :: Transaction
+  , txHash :: TransactionHash
+  }
+
+-- | Builds, balances, signs, and submits a transaction defined by the given
+-- | `TxBlueprint`. Returns a `TxReceipt` containing the submitted transaction
+-- | and its hash.
+submitTxFromBlueprint
+  :: forall (ctx :: Type)
+   . TxBlueprint ctx
+  -> Contract TxReceipt
+submitTxFromBlueprint blueprint = do
+  unbalancedTx <- buildTx blueprint.buildSteps
+  balancedTx <- liftEither =<< blueprint.balancer unbalancedTx
+    blueprint.balancerCtx
+  balancedSignedTx <- signTransaction balancedTx
+  txHash <- submit balancedSignedTx
+  pure
+    { submittedTx: balancedSignedTx
+    , txHash
+    }
+
 lookupTxHash
   :: TransactionHash -> UtxoMap -> Array TransactionUnspentOutput
 lookupTxHash txHash utxos =

src/Internal/BalanceTx/BalanceTx.purs

@@ -2,6 +2,7 @@ module Ctl.Internal.BalanceTx
   ( CtlBalancer
   , CtlBalancerContext
   , defaultBalancer
+  , defaultBalancerErr
   ) where
 
 import Prelude
@@ -11,7 +12,10 @@ import Cardano.Transaction.Balancer.Constraints
   ( BalancerConstraints
   , buildBalancerConfig
   )
-import Cardano.Transaction.Balancer.Error (BalanceTxError)
+import Cardano.Transaction.Balancer.Error
+  ( BalanceTxError
+  , explainBalanceTxError
+  )
 import Cardano.Types (UtxoMap)
 import Contract.Log (logInfo')
 import Control.Monad.Reader.Class (ask)
@@ -28,21 +32,28 @@ import Ctl.Internal.Contract.Wallet
   , getWalletUtxos
   ) as Wallet
 import Ctl.Internal.Types.TxBalancer (TxBalancer)
+import Data.Bifunctor (lmap)
 import Data.Maybe (isNothing)
 import Data.Newtype (unwrap)
 import Effect.Aff.Class (liftAff)
+import Effect.Exception (Error, error)
 
 type CtlBalancerContext =
   { balancerConstraints :: BalancerConstraints
   , extraUtxos :: UtxoMap
   }
 
-type CtlBalancer = TxBalancer Contract BalanceTxError CtlBalancerContext
+type CtlBalancer (err :: Type) = TxBalancer Contract err CtlBalancerContext
+
+defaultBalancer :: CtlBalancer Error
+defaultBalancer transaction =
+  map (lmap (error <<< explainBalanceTxError))
+    <<< defaultBalancerErr transaction
 
 -- | Balances an unbalanced transaction using the specified balancer
 -- | constraints.
-defaultBalancer :: CtlBalancer
-defaultBalancer transaction ctx = do
+defaultBalancerErr :: CtlBalancer BalanceTxError
+defaultBalancerErr transaction ctx = do
   contractEnv <- ask
   isCip30Wallet <- Sync.isCip30Wallet
   ownAddresses <- Wallet.getWalletAddresses