Pluggable Balancers

CHANGELOG.md

@@ -109,6 +109,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/)
 - Blockfrost Provider has been extracted to a separate package [purescript-cardano-blockfrost-provider](https://github.com/mlabs-haskell/purescript-cardano-blockfrost-provider) using module names in the format `Cardano.Blockfrost.*` ([#1661](https://github.com/Plutonomicon/cardano-transaction-lib/issues/1661))
 - Kupo + Ogmios Provider has been extracted to a separate package [purescript-cardano-kupmios-provider](https://github.com/mlabs-haskell/purescript-cardano-kupmios-provider) using module names in the format `Cardano.Kupmios.*` ([#1662](https://github.com/Plutonomicon/cardano-transaction-lib/issues/1662))
 - Ogmios' mempool functionality has been extracted to a separate package [purescript-cardano-ogmios-mempool](https://github.com/mlabs-haskell/purescript-cardano-ogmios-mempool) using the module `Cardano.Ogmios.Mempool`. To use it, the user must create and manage the websocket connection (see [Test.Ctl.Testnet.Contract.OgmiosMempool](https://github.com/Plutonomicon/cardano-transaction-lib/blob/cd80e31d59b233e48ccb2a0b6635d5d8beb5b160/test/Testnet/Contract/OgmiosMempool.purs))
+- `BalanceTx` module has been extracted to a separate package: [purescript-cardano-transaction-balancer](https://github.com/mlabs-haskell/purescript-cardano-transaction-balancer) using module names in the format `Cardano.Transaction.Balancer.*` ([#1621](https://github.com/Plutonomicon/cardano-transaction-lib/issues/1621))
 - Made adjustments to the [E2E testing documentation page](./doc/e2e-testing.md). Updated the [template](./templates/ctl-scaffold) to use the newly introduced `e2eConfigs` helper function that allows to define E2E configurations without unnecessary boilerplate. ([#1674](https://github.com/Plutonomicon/cardano-transaction-lib/pull/1674))
 
 ### Removed

README.md

@@ -88,7 +88,7 @@ CTL is being developed by MLabs. The following companies/funds have contributed
 - [Equine](https://www.equine.gg/)
 - [Liqwid Labs](https://liqwid.finance/)
 - PlayerMint
-- [Fourier Labs](https://fourierlabs.io/)
+- Fourier Labs
 - Ardana
 
 ## Use in production

examples/AdditionalUtxos.purs

@@ -42,18 +42,20 @@ import Contract.Sync (withoutSync)
 import Contract.Transaction
   ( ScriptRef(NativeScriptRef)
   , awaitTxConfirmed
-  , balanceTx
   , buildTx
   , createAdditionalUtxos
+  , defaultBalancer
+  , emptyBalancerCtx
   , signTransaction
   , submit
+  , submitTxFromBlueprint
   , withBalancedTx
   )
 import Contract.Utxos (UtxoMap)
 import Contract.Value (Value)
 import Contract.Value (lovelaceValueOf) as Value
 import Ctl.Examples.PlutusV2.Scripts.AlwaysSucceeds (alwaysSucceedsScriptV2)
-import Data.Map (difference, empty, filter) as Map
+import Data.Map (difference, filter) as Map
 import JS.BigInt (fromInt) as BigInt
 import Test.QuickCheck (arbitrary)
 import Test.QuickCheck.Gen (randomSampleOne)
@@ -74,7 +76,7 @@ contract testAdditionalUtxoOverlap = withoutSync do
   validator <- alwaysSucceedsScriptV2
   let vhash = PlutusScript.hash validator
   { unbalancedTx, datum } <- payToValidator vhash
-  withBalancedTx unbalancedTx Map.empty mempty \balancedTx -> do
+  withBalancedTx defaultBalancer unbalancedTx emptyBalancerCtx \balancedTx -> do
     balancedSignedTx <- signTransaction balancedTx
     txHash <- submit balancedSignedTx
     when testAdditionalUtxoOverlap $ awaitTxConfirmed txHash
@@ -135,16 +137,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."

examples/KeyWallet/SignMultiple.purs

@@ -9,6 +9,7 @@ import Contract.ScriptLookups as Lookups
 import Contract.Transaction
   ( TransactionHash
   , awaitTxConfirmed
+  , defaultBalancer
   , signTransaction
   , submit
   , withBalancedTxs
@@ -46,14 +47,18 @@ main = runKeyWalletContract_ \pkh lovelace unlock -> do
   unbalancedTx1 /\ usedUtxos1 <- mkUnbalancedTx lookups constraints
 
   txIds <-
-    withBalancedTxs
+    withBalancedTxs defaultBalancer
       [ { transaction: unbalancedTx0
-        , usedUtxos: usedUtxos0
-        , balancerConstraints: mempty
+        , balancerCtx:
+            { balancerConstraints: mempty
+            , extraUtxos: usedUtxos0
+            }
         }
       , { transaction: unbalancedTx1
-        , usedUtxos: usedUtxos1
-        , balancerConstraints: mempty
+        , balancerCtx:
+            { balancerConstraints: mempty
+            , extraUtxos: usedUtxos1
+            }
         }
       ] $ \balancedTxs -> do
       locked <- getLockedInputs

examples/SignMultiple.purs

@@ -39,6 +39,8 @@ import Contract.Transaction
   , awaitTxConfirmed
   , awaitTxConfirmedWithTimeout
   , buildTx
+  , defaultBalancer
+  , emptyBalancerCtx
   , signTransaction
   , submit
   , submitTxFromBuildPlan
@@ -98,14 +100,12 @@ contract = do
   unbalancedTx1 <- buildTx plan
 
   txIds <-
-    withBalancedTxs
+    withBalancedTxs defaultBalancer
       [ { transaction: unbalancedTx0
-        , usedUtxos: Map.empty
-        , balancerConstraints: mempty
+        , balancerCtx: emptyBalancerCtx
         }
       , { transaction: unbalancedTx1
-        , usedUtxos: Map.empty
-        , balancerConstraints: mempty
+        , balancerCtx: emptyBalancerCtx
         }
       ] $ \balancedTxs -> do
       locked <- getLockedInputs

examples/TxChaining.purs

@@ -36,9 +36,10 @@ import Contract.Log (logInfo')
 import Contract.Monad (Contract, launchAff_, liftedM, runContract)
 import Contract.Transaction
   ( awaitTxConfirmed
-  , balanceTx
   , buildTx
   , createAdditionalUtxos
+  , defaultBalancer
+  , emptyBalancerCtx
   , signTransaction
   , submit
   , withBalancedTx
@@ -76,24 +77,27 @@ contract = do
 
   unbalancedTx0 <- buildTx plan
 
-  withBalancedTx unbalancedTx0 Map.empty mempty \balancedTx0 -> do
-    logInfo' $ "balanced"
-    balancedSignedTx0 <- signTransaction balancedTx0
+  withBalancedTx defaultBalancer unbalancedTx0 emptyBalancerCtx \balancedTx0 ->
+    do
+      logInfo' $ "balanced"
+      balancedSignedTx0 <- signTransaction balancedTx0
 
-    additionalUtxos <- createAdditionalUtxos balancedSignedTx0
-    logInfo' $ "Additional utxos: " <> show additionalUtxos
-    when (Map.isEmpty additionalUtxos) do
-      liftEffect $ throw "empty utxos"
-    let
-      balanceTxConstraints :: BalancerConstraints
-      balanceTxConstraints =
-        mustUseAdditionalUtxos additionalUtxos
-    unbalancedTx1 <- buildTx plan
-    balancedTx1 <- balanceTx unbalancedTx1 additionalUtxos balanceTxConstraints
-    balancedSignedTx1 <- signTransaction balancedTx1
+      additionalUtxos <- createAdditionalUtxos balancedSignedTx0
+      logInfo' $ "Additional utxos: " <> show additionalUtxos
+      when (Map.isEmpty additionalUtxos) do
+        liftEffect $ throw "empty utxos"
+      let
+        balancerConstraints :: BalancerConstraints
+        balancerConstraints = mustUseAdditionalUtxos additionalUtxos
+      unbalancedTx1 <- buildTx plan
+      balancedTx1 <- liftEither =<< defaultBalancer unbalancedTx1
+        { balancerConstraints
+        , extraUtxos: additionalUtxos
+        }
+      balancedSignedTx1 <- signTransaction balancedTx1
 
-    txId0 <- submit balancedSignedTx0
-    txId1 <- submit balancedSignedTx1
+      txId0 <- submit balancedSignedTx0
+      txId1 <- submit balancedSignedTx1
 
-    awaitTxConfirmed txId0
-    awaitTxConfirmed txId1
+      awaitTxConfirmed txId0
+      awaitTxConfirmed txId1

packages.dhall

@@ -3,4 +3,53 @@ let upstream =
       https://raw.githubusercontent.com/mlabs-haskell/purescript-cardano-package-set/v2.0.0/packages.dhall
         sha256:89e383ba2cceff5b668cefae59aae352e60fb28543f9dc3fb198a0231d56d8e0
 
-in upstream
+let additions =
+      { cardano-transaction-balancer =
+        { dependencies =
+          [ "aff"
+          , "ansi"
+          , "arrays"
+          , "bifunctors"
+          , "bytearrays"
+          , "cardano-data-lite"
+          , "cardano-kupmios-provider"
+          , "cardano-provider"
+          , "cardano-transaction-builder"
+          , "cardano-types"
+          , "console"
+          , "effect"
+          , "either"
+          , "exceptions"
+          , "foldable-traversable"
+          , "integers"
+          , "js-bigints"
+          , "js-date"
+          , "lattice"
+          , "lists"
+          , "literals"
+          , "maybe"
+          , "monad-logger"
+          , "newtype"
+          , "ordered-collections"
+          , "parallel"
+          , "partial"
+          , "prelude"
+          , "profunctor"
+          , "profunctor-lenses"
+          , "quickcheck"
+          , "random"
+          , "strings"
+          , "stringutils"
+          , "these"
+          , "transformers"
+          , "tuples"
+          , "uint"
+          , "unsafe-coerce"
+          ]
+        , repo =
+            "https://github.com/mlabs-haskell/purescript-cardano-transaction-balancer"
+        , version = "2762e726922a65c772f6f21d547d6bc8f9859e4e"
+        }
+      }
+
+in (upstream // additions)

spago.dhall

@@ -21,6 +21,7 @@
   , "cardano-ogmios-mempool"
   , "cardano-plutus-data-schema"
   , "cardano-provider"
+  , "cardano-transaction-balancer"
   , "cardano-transaction-builder"
   , "cardano-types"
   , "checked-exceptions"
@@ -92,7 +93,6 @@
   , "strings"
   , "stringutils"
   , "tailrec"
-  , "these"
   , "toppokki"
   , "transformers"
   , "tuples"

src/Contract/BalanceTxConstraints.purs

@@ -2,7 +2,7 @@
 -- | adjust the behaviour of the balancer.
 module Contract.BalanceTxConstraints (module BalanceTxConstraints) where
 
-import Ctl.Internal.BalanceTx.Constraints
+import Cardano.Transaction.Balancer.Constraints
   ( BalanceTxConstraintsBuilder
   , BalancerConfig(BalancerConfig)
   , BalancerConstraints(BalancerConstraints)