Handle non-spendable utxos when selecting collateral

Author: errfrom

src/Internal/BalanceTx/BalanceTx.purs

@@ -22,6 +22,7 @@ import Cardano.Types
   , Transaction
   , TransactionBody
   , TransactionOutput
+  , TransactionUnspentOutput
   , UtxoMap
   , Value(Value)
   , _amount
@@ -41,9 +42,10 @@ import Cardano.Types.Address (Address)
 import Cardano.Types.BigNum as BigNum
 import Cardano.Types.Coin as Coin
 import Cardano.Types.OutputDatum (OutputDatum(OutputDatum))
-import Cardano.Types.TransactionBody (_votingProposals)
+import Cardano.Types.TransactionBody (_collateral, _votingProposals)
 import Cardano.Types.TransactionInput (TransactionInput)
-import Cardano.Types.TransactionUnspentOutput as TransactionUnspentOutputs
+import Cardano.Types.TransactionUnspentOutput (_output)
+import Cardano.Types.TransactionUnspentOutput as TransactionUnspentOutput
 import Cardano.Types.TransactionWitnessSet (_redeemers)
 import Cardano.Types.UtxoMap (pprintUtxoMap)
 import Cardano.Types.Value (getMultiAsset, mkValue, pprintValue)
@@ -65,7 +67,10 @@ import Ctl.Internal.BalanceTx.Collateral
   ( addTxCollateral
   , addTxCollateralReturn
   )
-import Ctl.Internal.BalanceTx.Collateral.Select (selectCollateral)
+import Ctl.Internal.BalanceTx.Collateral.Select
+  ( minRequiredCollateral
+  , selectCollateral
+  ) as Collateral
 import Ctl.Internal.BalanceTx.Constraints
   ( BalanceTxConstraintsBuilder
   , _collateralUtxos
@@ -137,7 +142,7 @@ import Data.Array.NonEmpty
 import Data.Array.NonEmpty as NEA
 import Data.Bitraversable (ltraverse)
 import Data.Either (Either, hush, note)
-import Data.Foldable (fold, foldMap, foldr, length, null, sum)
+import Data.Foldable (foldMap, foldr, length, null, sum)
 import Data.Lens (view)
 import Data.Lens.Getter ((^.))
 import Data.Lens.Setter ((%~), (.~), (?~))
@@ -209,11 +214,6 @@ balanceTxWithConstraints transaction extraUtxos constraintsBuilder =
             <#> traverse (note CouldNotGetUtxos)
               >>> map (foldr Map.union Map.empty) -- merge all utxos into one map
 
-    unbalancedCollTx <- transactionWithNetworkId >>=
-      if Array.null (transaction ^. _witnessSet <<< _redeemers)
-      -- Don't set collateral if tx doesn't contain phase-2 scripts:
-      then pure
-      else setTransactionCollateral changeAddress
     let
       allUtxos :: UtxoMap
       allUtxos =
@@ -223,6 +223,12 @@ balanceTxWithConstraints transaction extraUtxos constraintsBuilder =
 
     availableUtxos <- liftContract $ filterLockedUtxos allUtxos
 
+    unbalancedCollTx <- transactionWithNetworkId >>=
+      if Array.null (transaction ^. _witnessSet <<< _redeemers)
+      -- Don't set collateral if tx doesn't contain phase-2 scripts:
+      then pure
+      else setTransactionCollateral changeAddress availableUtxos
+
     Logger.info (pprintUtxoMap allUtxos) "balanceTxWithConstraints: all UTxOs"
     Logger.info (pprintUtxoMap availableUtxos)
       "balanceTxWithConstraints: available UTxOs"
@@ -253,8 +259,9 @@ balanceTxWithConstraints transaction extraUtxos constraintsBuilder =
       (transaction ^. _body <<< _networkId)
     pure (transaction # _body <<< _networkId ?~ networkId)
 
-setTransactionCollateral :: Address -> Transaction -> BalanceTxM Transaction
-setTransactionCollateral changeAddr transaction = do
+setTransactionCollateral
+  :: Address -> UtxoMap -> Transaction -> BalanceTxM Transaction
+setTransactionCollateral changeAddr availableUtxos transaction = do
   nonSpendableSet <- asksConstraints _nonSpendableInputs
   mbCollateralUtxos <- asksConstraints _collateralUtxos
   -- We must filter out UTxOs that are set as non-spendable in the balancer
@@ -272,21 +279,42 @@ setTransactionCollateral changeAddr transaction = do
       when (not $ Array.null filteredUtxos) do
         logWarn' $ pprintTagSet
           "Some of the collateral UTxOs returned by the wallet were marked as non-spendable and ignored"
-          (pprintUtxoMap (TransactionUnspentOutputs.toUtxoMap filteredUtxos))
-      pure spendableUtxos
+          (pprintUtxoMap (TransactionUnspentOutput.toUtxoMap filteredUtxos))
+      let
+        collVal =
+          foldMap (Val.fromValue <<< view (_output <<< _amount))
+            spendableUtxos
+        minRequiredCollateral =
+          BigNum.toBigInt $
+            unwrap Collateral.minRequiredCollateral
+      if (Val.getCoin collVal < minRequiredCollateral) then do
+        logWarn' $ pprintTagSet
+          "Filtered collateral UTxOs do not cover the minimum required \
+          \collateral, reselecting collateral using CTL algorithm."
+          (pprintUtxoMap (TransactionUnspentOutput.toUtxoMap spendableUtxos))
+        selectCollateral availableUtxos
+      else pure spendableUtxos
     -- otherwise, get all the utxos, filter out unspendable, and select
     -- collateral using internal algo, that is also used in KeyWallet
-    Just utxoMap -> do
-      ProtocolParameters params <- liftContract getProtocolParameters
-      let
-        maxCollateralInputs = UInt.toInt $ params.maxCollateralInputs
-        mbCollateral =
-          Array.fromFoldable <$>
-            selectCollateral params.coinsPerUtxoByte maxCollateralInputs utxoMap
-      liftEither $ note (InsufficientCollateralUtxos utxoMap) mbCollateral
+    Just utxoMap -> selectCollateral utxoMap
   addTxCollateralReturn collateral (addTxCollateral collateral transaction)
     changeAddr
 
+-- | Select collateral from the provided utxos using internal CTL
+-- | collateral selection algorithm.
+selectCollateral :: UtxoMap -> BalanceTxM (Array TransactionUnspentOutput)
+selectCollateral utxos = do
+  pparams <- unwrap <$> liftContract getProtocolParameters
+  let
+    maxCollateralInputs = UInt.toInt $ pparams.maxCollateralInputs
+    mbCollateral =
+      Array.fromFoldable <$> Collateral.selectCollateral
+        pparams.coinsPerUtxoByte
+        maxCollateralInputs
+        utxos
+  liftEither $ note (InsufficientCollateralUtxos utxos)
+    mbCollateral
+
 --------------------------------------------------------------------------------
 -- Balancing Algorithm
 --------------------------------------------------------------------------------
@@ -346,11 +374,11 @@ runBalancer p = do
     isCip30 <- liftContract $ isCip30Wallet
     -- Get collateral inputs to mark them as unspendable.
     -- Some CIP-30 wallets don't allow to sign Txs that spend it.
-    nonSpendableCollateralInputs <-
-      if isCip30 then
-        liftContract $ Wallet.getWalletCollateral <#>
-          fold >>> map (unwrap >>> _.input) >>> Set.fromFoldable
-      else mempty
+    let
+      nonSpendableCollateralInputs =
+        if isCip30 then
+          Set.fromFoldable $ p.transaction ^. _body <<< _collateral
+        else mempty
     asksConstraints Constraints._nonSpendableInputs <#>
       append nonSpendableCollateralInputs >>>
         \nonSpendableInputs ->