Keep first valid subset of collaterals returned & cleanup

Plutonomicon · Nov 30, 2022 · cf3ba2f · cf3ba2f
1 parent f9091b3
commit cf3ba2f
Show file tree

Hide file tree

Showing 3 changed files with 29 additions and 39 deletions.
diff --git a/examples/SignMultiple.purs b/examples/SignMultiple.purs
@@ -6,8 +6,7 @@ module Ctl.Examples.SignMultiple (example, contract, main) where
 import Contract.Prelude
 
 import Contract.Address
-  ( getWalletAddresses
-  , ownPaymentPubKeysHashes
+  ( ownPaymentPubKeysHashes
   , ownStakePubKeysHashes
   )
 import Contract.Config (ConfigParams, testnetNamiConfig)
@@ -30,7 +29,7 @@ import Contract.Transaction
   , withBalancedTxs
   )
 import Contract.TxConstraints as Constraints
-import Contract.Utxos (getWalletUtxos, utxosAt)
+import Contract.Utxos (getWalletUtxos)
 import Contract.Value (leq)
 import Contract.Value as Value
 import Control.Monad.Reader (asks)
@@ -57,33 +56,15 @@ contract = do
   skh <- liftedM "Failed to get own SKH" $ join <<< head <$>
     ownStakePubKeysHashes
 
-  let amountToSend = Value.lovelaceValueOf $ BigInt.fromInt 2_000_000
-
-  utxos <- getWalletAddresses >>= traverse utxosAt
-
-  logInfo' $ "Utxos: " <> show utxos
-
-  -- _ <- throwContractError "aoeuaou"
-
   -- Early fail if not enough utxos present for 2 transactions
-  -- walletUtxosLength <- liftedM "Failed to get wallet Utxos"
-  --   $ map
-  --       ( length <<< filter
-  --           ( leq
-  --               ( amountToSend <>
-  --                   ( Value.lovelaceValueOf
-  --                       $ BigInt.fromInt 4_000_000
-  --                   )
-  --               ) <<< _.amount <<< unwrap <<< _.output <<< unwrap
-  --           )
-  --       )
-  --   <$> getWalletUtxos
-
-  -- when (walletUtxosLength < 2) $ throwContractError "Not enough Utxos with sufficient funds at wallet"
+  unlessM hasSufficientUtxos $ throwContractError
+    "Insufficient Utxos for 2 transactions"
 
   let
     constraints :: Constraints.TxConstraints Void Void
-    constraints = Constraints.mustPayToPubKeyAddress pkh skh amountToSend
+    constraints = Constraints.mustPayToPubKeyAddress pkh skh
+      $ Value.lovelaceValueOf
+      $ BigInt.fromInt 2_000_000
 
     lookups :: Lookups.ScriptLookups Void
     lookups = mempty
@@ -118,6 +99,19 @@ contract = do
     logInfo' $ "Tx ID: " <> show txId
     pure txId
 
+  hasSufficientUtxos :: forall (r :: Row Type). Contract r Boolean
+  hasSufficientUtxos = do
+    let
+      -- 4 Ada: enough to cover 2 Ada transfer and fees
+      isUtxoValid u = leq (Value.lovelaceValueOf $ BigInt.fromInt 4_000_000)
+        (unwrap (unwrap u).output).amount
+
+    walletValidUtxos <- liftedM "Failed to get wallet Utxos"
+      $ map (length <<< filter isUtxoValid)
+      <$> getWalletUtxos
+
+    pure $ walletValidUtxos >= 2 -- 2 transactions
+
 example :: ConfigParams () -> Effect Unit
 example cfg = launchAff_ do
   runContract cfg contract
diff --git a/src/Internal/BalanceTx/BalanceTx.purs b/src/Internal/BalanceTx/BalanceTx.purs
@@ -135,7 +135,6 @@ import Data.Set (Set)
 import Data.Set as Set
 import Data.Traversable (traverse, traverse_)
 import Data.Tuple.Nested (type (/\), (/\))
-import Debug (trace)
 import Effect.Class (class MonadEffect, liftEffect)
 
 -- | Balances an unbalanced transaction using the specified balancer
@@ -459,9 +458,6 @@ collectTransactionInputs
 collectTransactionInputs originalTxIns utxos value = do
   txInsValue <- updatedInputs >>= getTxInsValue utxos
   updatedInputs' <- updatedInputs
-  trace (show utxos) $ const $ pure unit
-  trace (show txInsValue) $ const $ pure unit
-  trace (show updatedInputs) $ const $ pure unit
   case isSufficient updatedInputs' txInsValue of
     true ->
       pure $ Set.fromFoldable updatedInputs'

diff --git a/src/Internal/QueryM/Utxos.purs b/src/Internal/QueryM/Utxos.purs
@@ -16,9 +16,9 @@ import Ctl.Internal.Cardano.Types.Transaction (TransactionOutput, UtxoMap)
 import Ctl.Internal.Cardano.Types.TransactionUnspentOutput
   ( TransactionUnspentOutput
   )
+import Ctl.Internal.Cardano.Types.Value (Value)
+import Ctl.Internal.Cardano.Types.Value (geq, lovelaceValueOf) as Value
 import Ctl.Internal.Helpers as Helpers
-import Ctl.Internal.Plutus.Types.Value (Value)
-import Ctl.Internal.Plutus.Types.Value (geq, lovelaceValueOf) as Value
 import Ctl.Internal.QueryM
   ( QueryM
   , callCip30Wallet
@@ -34,13 +34,13 @@ import Data.Array (cons, head)
 import Data.Array as Array
 import Data.BigInt as BigInt
 import Data.Either (hush)
-import Data.Foldable (fold, foldr)
+import Data.Foldable (fold, foldl, foldr)
 import Data.Functor (mapFlipped)
 import Data.Map as Map
 import Data.Maybe (Maybe(Nothing), fromMaybe, maybe)
 import Data.Newtype (unwrap, wrap)
 import Data.Traversable (for, for_, traverse)
-import Data.Tuple.Nested ((/\))
+import Data.Tuple (fst)
 import Data.Tuple.Nested ((/\))
 import Data.UInt as UInt
 import Effect.Aff (Aff)
@@ -165,23 +165,23 @@ getWalletCollateral = do
   let
     maxCollateral = Value.lovelaceValueOf $ BigInt.fromInt 5_000_000
     sufficientUtxos = mapFlipped mbCollateralUTxOs \colUtxos ->
-      foldr
-        ( \u (us /\ total) ->
+      fst $ foldl
+        ( \(us /\ total) u ->
             if total `Value.geq` maxCollateral then (us /\ total)
-            else (cons u us /\ total <> (unwrap (unwrap u).output).amount)
+            else (cons u us /\ (total <> (unwrap (unwrap u).output).amount))
         )
         ([] /\ mempty)
         colUtxos
 
-  for_ mbCollateralUTxOs \collateralUTxOs -> do
+  for_ sufficientUtxos \collateralUTxOs -> do
     pparams <- asks $ _.runtime >>> _.pparams
     let
       tooManyCollateralUTxOs =
         UInt.fromInt (Array.length collateralUTxOs) >
           (unwrap pparams).maxCollateralInputs
     when tooManyCollateralUTxOs do
       liftEffect $ throw tooManyCollateralUTxOsError
-  pure mbCollateralUTxOs
+  pure sufficientUtxos
   where
   tooManyCollateralUTxOsError =
     "Wallet returned too many UTxOs as collateral. This is likely a bug in \