Only generating collaterals when scripts are called (#431)

* tests pass with new mockchain return type * more log levels * logging removal of unusable balancing utxos * improving logging in balancing * new log version with dedicated constructors * changing item * integrating comments, adding comments and more readable bullets * fixing the bug where collateral inputs were not resolved * CHANGELOG.md * integrating review comments * typo * removing useless instances * wip * reverting balancingspec * starting to consume scripts in balancing spec, to be continued * reworking empty collaterals * 2 first test groups passé * all tests fixed * doc * updating doc * logging of unused collateral option * post-rebase small fixes * post merge mini fix * Apply suggestions from code review Co-authored-by: Florent C. <[email protected]> * integrating review comments --------- Co-authored-by: mmontin <[email protected]> Co-authored-by: Florent C. <[email protected]>
tweag · Sep 4, 2024 · 51857a3 · 51857a3
1 parent b259bc3
commit 51857a3
Show file tree

Hide file tree

Showing 11 changed files with 524 additions and 210 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -32,11 +32,14 @@
   * it is now a component of `MonadBlockChainBalancing`
   * it can be turned on/off in pretty-printing options
   * it now displays the discarding of utxos during balancing.
+  * it now displays when the user specifies useless collateral utxos.
   * it is not visible from outside of `cooked-validators`
 
 ### Fixed
 
 - All kinds of scripts can now be used as reference scripts.
+- Transactions that do not involve scripts are now properly generated without any
+  collateral.
 
 ## [[4.0.0]](https://github.com/tweag/cooked-validators/releases/tag/v4.0.0) - 2024-06-28
 

diff --git a/doc/BALANCING.md b/doc/BALANCING.md
@@ -11,16 +11,19 @@ is currently implemented, and which options affect this mechanism.
 ## Balancing: what this is about.
 
 ### Balancing requirements
+
 In Cardano, transactions must be balanced before they can be submitted for
 validation. This means the equation `input value + minted value = output value +
-burned value + fee` must be satisfied to proceed to phase 2 of the validation
-process. Additionally, collaterals must be provided to account for transaction
-failures in phase 2. These collaterals are related to the fee by the following
-inequation: `totalCollateral >= fee * feeToCollateralRatio`, and they must
-satisfy their own preservation equation: `collateralInputs = totalCollaterals +
-returnCollaterals`. Lastly, the actual required fee for a given transaction
-depends on the size of the transaction and the (not yet executed) resources used
-by the scripts during validation.
+burned value + deposited value + fee` must be satisfied to proceed to phase 2 of
+the validation process. Additionally, when a transaction involves scripts, and
+thus its validation can fail in phase 2, collaterals must be provided to account
+for such possible failures. These collaterals are related to the fee through the
+protocol parameter `collateralPercentage` by the inequation `totalCollateral >=
+fee * collateralPercentage`, and they must satisfy their own preservation
+equation: `collateralInputs = totalCollaterals + returnCollaterals`. Lastly, the
+actual required fee for a given transaction depends on the size of the
+transaction and the (not yet executed) resources used by the scripts during
+validation.
 
 ### Balancing mechanism
 
@@ -213,17 +216,19 @@ data CollateralUtxos
   | CollateralUtxosFromSet (Set Api.TxOutRef) Wallet
 ```
 
-In addition to the regular UTXOs consumed in a transaction, additional UTXOs
-must be provided to cover potential phase 2 validation failures. These UTXOs
-need to be sufficient to meet a specified total collateral requirement,
-typically 1.5 times the transaction fee based on protocol parameters. Any
-surplus can be returned to a designated wallet through an output known as return
-collateral. This setting determines which UTXOs the balancing mechanism should
-consider for inclusion in the transaction. Similar to
-[`BalancingUtxos`](#balancing-utxos), the final set of UTXOs included may not
-necessarily match the considered set, especially for collaterals, as protocol
-parameters also impose limits on the number of allowable collateral UTXOs
-(typically 3).
+When a transaction involves executing scripts, UTXOs must be provided as
+collaterals to cover potential phase 2 validation failures. These UTXOs need to
+be sufficient to meet a specified total collateral requirement, typically 1.5
+times the transaction fee based on protocol parameters. Any surplus can be
+returned to a designated wallet through an output known as return
+collateral.
+
+This setting is ignored when the transaction does not involve any
+scripts, but otherwise determines which UTXOs the balancing mechanism should
+consider for inclusion. Similar to [`BalancingUtxos`](#balancing-utxos), the
+final set of UTXOs included may not necessarily match the considered set,
+especially for collaterals, as protocol parameters also impose a limit on the
+number of allowable collateral UTXOs (typically 3).
 
 Here are the options available:
 
@@ -387,4 +392,3 @@ the estimated fee resulting from this balancing, we adjust our search interval:
 
 The recursion continues until an error is propagated or the interval is reduced
 to a single point.
-
diff --git a/src/Cooked/MockChain/Balancing.hs b/src/Cooked/MockChain/Balancing.hs
@@ -1,7 +1,12 @@
 -- | This module handles auto-balancing of transaction skeleton. This includes
 -- computation of fees and collaterals because their computation cannot be
 -- separated from the balancing.
-module Cooked.MockChain.Balancing (balanceTxSkel, getMinAndMaxFee, estimateTxSkelFee) where
+module Cooked.MockChain.Balancing
+  ( balanceTxSkel,
+    getMinAndMaxFee,
+    estimateTxSkelFee,
+  )
+where
 
 import Cardano.Api.Ledger qualified as Cardano
 import Cardano.Api.Shelley qualified as Cardano
@@ -44,10 +49,11 @@ type BalancingOutputs = [(Api.TxOutRef, Api.TxOut)]
 
 -- | This is the main entry point of our balancing mechanism. This function
 -- takes a skeleton and returns a (possibly) balanced skeleton alongside the
--- associated fee, collateral inputs and return collateral wallet. The options
--- from the skeleton control whether it should be balanced, and how to compute
--- its associated elements.
-balanceTxSkel :: (MonadBlockChainBalancing m) => TxSkel -> m (TxSkel, Fee, Collaterals, Wallet)
+-- associated fee, collateral inputs and return collateral wallet, which might
+-- be empty when no script is involved in the transaction. The options from the
+-- skeleton control whether it should be balanced, and how to compute its
+-- associated elements.
+balanceTxSkel :: (MonadBlockChainBalancing m) => TxSkel -> m (TxSkel, Fee, Maybe (Collaterals, Wallet))
 balanceTxSkel skelUnbal@TxSkel {..} = do
   -- We retrieve the possible balancing wallet. Any extra payment will be
   -- redirected to them, and utxos will be taken from their wallet if associated
@@ -63,26 +69,37 @@ balanceTxSkel skelUnbal@TxSkel {..} = do
   -- single transaction fee, which we retrieve.
   (minFee, maxFee) <- getMinAndMaxFee
 
-  -- We collect collateral inputs. They might be directly provided in the
-  -- skeleton, or should be retrieved from a given wallet. They are associated
-  -- with a return collateral wallet, which we retrieve as well.
-  (collateralIns, returnCollateralWallet) <- case txOptCollateralUtxos txSkelOpts of
-    CollateralUtxosFromBalancingWallet -> case balancingWallet of
-      Nothing -> fail "Can't select collateral utxos from a balancing wallet because it does not exist."
-      Just bWallet -> (,bWallet) . Set.fromList . map fst <$> runUtxoSearch (onlyValueOutputsAtSearch bWallet)
-    CollateralUtxosFromWallet cWallet -> (,cWallet) . Set.fromList . map fst <$> runUtxoSearch (onlyValueOutputsAtSearch cWallet)
-    CollateralUtxosFromSet utxos rWallet -> return (utxos, rWallet)
+  -- We collect collateral inputs candidates. They might be directly provided in
+  -- the skeleton, or should be retrieved from a given wallet. They are
+  -- associated with a return collateral wallet, which we retrieve as well. All
+  -- of this is wrapped in a `Maybe` type to represent the case when the
+  -- transaction does not involve script and should not have any kind of
+  -- collaterals attached to it.
+  mCollaterals <- do
+    -- We retrieve the various kinds of scripts
+    spendingScripts <- txSkelInputValidators skelUnbal
+    -- The transaction will only require collaterals when involving scripts
+    let noScriptInvolved = Map.null txSkelMints && null (mapMaybe txSkelProposalWitness txSkelProposals) && Map.null spendingScripts
+    case (noScriptInvolved, txOptCollateralUtxos txSkelOpts) of
+      (True, CollateralUtxosFromSet utxos _) -> logEvent (MCLogUnusedCollaterals $ Right utxos) >> return Nothing
+      (True, CollateralUtxosFromWallet cWallet) -> logEvent (MCLogUnusedCollaterals $ Left cWallet) >> return Nothing
+      (True, CollateralUtxosFromBalancingWallet) -> return Nothing
+      (False, CollateralUtxosFromSet utxos rWallet) -> return $ Just (utxos, rWallet)
+      (False, CollateralUtxosFromWallet cWallet) -> Just . (,cWallet) . Set.fromList . map fst <$> runUtxoSearch (onlyValueOutputsAtSearch cWallet)
+      (False, CollateralUtxosFromBalancingWallet) -> case balancingWallet of
+        Nothing -> fail "Can't select collateral utxos from a balancing wallet because it does not exist."
+        Just bWallet -> Just . (,bWallet) . Set.fromList . map fst <$> runUtxoSearch (onlyValueOutputsAtSearch bWallet)
 
   -- At this point, the presence (or absence) of balancing wallet dictates
   -- whether the transaction should be automatically balanced or not.
-  (txSkelBal, fee, adjustedCollateralIns) <- case balancingWallet of
+  (txSkelBal, fee, adjustedColsAndWallet) <- case balancingWallet of
     Nothing ->
       -- The balancing should not be performed. We still adjust the collaterals
       -- though around a provided fee, or the maximum fee.
       let fee = case txOptFeePolicy txSkelOpts of
             AutoFeeComputation -> maxFee
             ManualFee fee' -> fee'
-       in (skelUnbal,fee,) <$> collateralInsFromFees fee collateralIns returnCollateralWallet
+       in (skelUnbal,fee,) <$> collateralsFromFees fee mCollaterals
     Just bWallet -> do
       -- The balancing should be performed. We collect the candidates balancing
       -- utxos based on the associated policy
@@ -103,15 +120,15 @@ balanceTxSkel skelUnbal@TxSkel {..} = do
         -- If fees are left for us to compute, we run a dichotomic search. This
         -- is full auto mode, the most powerful but time-consuming.
         AutoFeeComputation ->
-          computeFeeAndBalance bWallet minFee maxFee collateralIns balancingUtxos returnCollateralWallet skelUnbal
+          computeFeeAndBalance bWallet minFee maxFee balancingUtxos mCollaterals skelUnbal
         -- If fee are provided manually, we adjust the collaterals and the
         -- skeleton around them directly.
         ManualFee fee -> do
-          adjustedCollateralIns <- collateralInsFromFees fee collateralIns returnCollateralWallet
+          adjustedColsAndWallet <- collateralsFromFees fee mCollaterals
           attemptedSkel <- computeBalancedTxSkel bWallet balancingUtxos skelUnbal fee
-          return (attemptedSkel, fee, adjustedCollateralIns)
+          return (attemptedSkel, fee, adjustedColsAndWallet)
 
-  return (txSkelBal, fee, adjustedCollateralIns, returnCollateralWallet)
+  return (txSkelBal, fee, adjustedColsAndWallet)
   where
     filterAndWarn f s l
       | (ok, toInteger . length -> koLength) <- partition f l =
@@ -144,22 +161,22 @@ getMinAndMaxFee = do
 
 -- | Computes optimal fee for a given skeleton and balances it around those fees.
 -- This uses a dichotomic search for an optimal "balanceable around" fee.
-computeFeeAndBalance :: (MonadBlockChainBalancing m) => Wallet -> Fee -> Fee -> Collaterals -> BalancingOutputs -> Wallet -> TxSkel -> m (TxSkel, Fee, Collaterals)
-computeFeeAndBalance _ minFee maxFee _ _ _ _
+computeFeeAndBalance :: (MonadBlockChainBalancing m) => Wallet -> Fee -> Fee -> BalancingOutputs -> Maybe (Collaterals, Wallet) -> TxSkel -> m (TxSkel, Fee, Maybe (Collaterals, Wallet))
+computeFeeAndBalance _ minFee maxFee _ _ _
   | minFee > maxFee =
       throwError $ FailWith "Unreachable case, please report a bug at https://github.com/tweag/cooked-validators/issues"
-computeFeeAndBalance balancingWallet minFee maxFee collateralIns balancingUtxos returnCollateralWallet skel
+computeFeeAndBalance balancingWallet minFee maxFee balancingUtxos mCollaterals skel
   | minFee == maxFee = do
       -- The fee interval is reduced to a single element, we balance around it
-      (adjustedCollateralIns, attemptedSkel) <- attemptBalancingAndCollaterals balancingWallet collateralIns balancingUtxos returnCollateralWallet minFee skel
-      return (attemptedSkel, minFee, adjustedCollateralIns)
-computeFeeAndBalance balancingWallet minFee maxFee collateralIns balancingUtxos returnCollateralWallet skel
+      (adjustedColsAndWallet, attemptedSkel) <- attemptBalancingAndCollaterals balancingWallet balancingUtxos minFee mCollaterals skel
+      return (attemptedSkel, minFee, adjustedColsAndWallet)
+computeFeeAndBalance balancingWallet minFee maxFee balancingUtxos mCollaterals skel
   | fee <- (minFee + maxFee) `div` 2 = do
       -- The fee interval is larger than a single element. We attempt to balance
       -- around its central point, which can fail due to missing value in
       -- balancing utxos or collateral utxos.
       attemptedBalancing <- catchError
-        (Just <$> attemptBalancingAndCollaterals balancingWallet collateralIns balancingUtxos returnCollateralWallet fee skel)
+        (Just <$> attemptBalancingAndCollaterals balancingWallet balancingUtxos fee mCollaterals skel)
         $ \case
           -- If it fails, and the remaining fee interval is not reduced to the
           -- current fee attempt, we return `Nothing` which signifies that we
@@ -174,8 +191,8 @@ computeFeeAndBalance balancingWallet minFee maxFee collateralIns balancingUtxos
         Nothing -> return (minFee, fee - 1)
         -- The skeleton was balanceable, we compute and analyse the resulting
         -- fee to seach upwards or downwards for an optimal solution
-        Just (adjustedCollateralIns, attemptedSkel) -> do
-          newFee <- estimateTxSkelFee attemptedSkel fee adjustedCollateralIns returnCollateralWallet
+        Just (adjustedColsAndWallet, attemptedSkel) -> do
+          newFee <- estimateTxSkelFee attemptedSkel fee adjustedColsAndWallet
           return $ case fee - newFee of
             -- Current fee is insufficient, we look on the right (strictly)
             n | n < 0 -> (fee + 1, maxFee)
@@ -194,13 +211,13 @@ computeFeeAndBalance balancingWallet minFee maxFee collateralIns balancingUtxos
             -- fee of the input skeleton.
             _ -> (minFee, newFee)
 
-      computeFeeAndBalance balancingWallet newMinFee newMaxFee collateralIns balancingUtxos returnCollateralWallet skel
+      computeFeeAndBalance balancingWallet newMinFee newMaxFee balancingUtxos mCollaterals skel
 
 -- | Helper function to group the two real steps of the balancing: balance a
 -- skeleton around a given fee, and compute the associated collateral inputs
-attemptBalancingAndCollaterals :: (MonadBlockChainBalancing m) => Wallet -> Collaterals -> BalancingOutputs -> Wallet -> Fee -> TxSkel -> m (Collaterals, TxSkel)
-attemptBalancingAndCollaterals balancingWallet collateralIns balancingUtxos returnCollateralWallet fee skel = do
-  adjustedCollateralIns <- collateralInsFromFees fee collateralIns returnCollateralWallet
+attemptBalancingAndCollaterals :: (MonadBlockChainBalancing m) => Wallet -> BalancingOutputs -> Fee -> Maybe (Collaterals, Wallet) -> TxSkel -> m (Maybe (Collaterals, Wallet), TxSkel)
+attemptBalancingAndCollaterals balancingWallet balancingUtxos fee mCollaterals skel = do
+  adjustedCollateralIns <- collateralsFromFees fee mCollaterals
   attemptedSkel <- computeBalancedTxSkel balancingWallet balancingUtxos skel fee
   return (adjustedCollateralIns, attemptedSkel)
 
@@ -228,6 +245,12 @@ collateralInsFromFees fee collateralIns returnCollateralWallet = do
   -- Retrieving and returning the best candidate as a utxo set
   Set.fromList . fst <$> getOptimalCandidate candidatesRaw returnCollateralWallet noSuitableCollateralError
 
+-- | This adjusts collateral inputs when necessary
+collateralsFromFees :: (MonadBlockChainBalancing m) => Fee -> Maybe (Collaterals, Wallet) -> m (Maybe (Collaterals, Wallet))
+collateralsFromFees _ Nothing = return Nothing
+collateralsFromFees fee (Just (collateralIns, returnCollateralWallet)) =
+  Just . (,returnCollateralWallet) <$> collateralInsFromFees fee collateralIns returnCollateralWallet
+
 -- | The main computing function for optimal balancing and collaterals. It
 -- computes the subsets of a set of UTxOs that sum up to a certain target. It
 -- stops when the target is reached, not adding superfluous UTxOs. Despite
@@ -272,15 +295,18 @@ getOptimalCandidate candidates paymentTarget mceError = do
 
 -- | This function is essentially a copy of
 -- https://github.com/input-output-hk/plutus-apps/blob/d4255f05477fd8477ee9673e850ebb9ebb8c9657/plutus-ledger/src/Ledger/Fee.hs#L19
-estimateTxSkelFee :: (MonadBlockChainBalancing m) => TxSkel -> Fee -> Collaterals -> Wallet -> m Fee
-estimateTxSkelFee skel fee collateralIns returnCollateralWallet = do
+estimateTxSkelFee :: (MonadBlockChainBalancing m) => TxSkel -> Fee -> Maybe (Collaterals, Wallet) -> m Fee
+estimateTxSkelFee skel fee mCollaterals = do
   -- We retrieve the necessary data to generate the transaction body
   params <- getParams
   managedData <- txSkelInputData skel
-  managedTxOuts <- lookupUtxosPl $ txSkelKnownTxOutRefs skel <> Set.toList collateralIns
+  let collateralIns = case mCollaterals of
+        Nothing -> []
+        Just (s, _) -> Set.toList s
+  managedTxOuts <- lookupUtxosPl $ txSkelKnownTxOutRefs skel <> collateralIns
   managedValidators <- txSkelInputValidators skel
   -- We generate the transaction body content, handling errors in the meantime
-  txBodyContent <- case generateBodyContent fee returnCollateralWallet collateralIns params managedData managedTxOuts managedValidators skel of
+  txBodyContent <- case generateBodyContent fee params managedData managedTxOuts managedValidators mCollaterals skel of
     Left err -> throwError $ MCEGenerationError err
     Right txBodyContent -> return txBodyContent
   -- We create the actual body and send if for validation
@@ -290,7 +316,7 @@ estimateTxSkelFee skel fee collateralIns returnCollateralWallet = do
   -- We retrieve the estimate number of required witness in the transaction
   let nkeys = Cardano.estimateTransactionKeyWitnessCount txBodyContent
   -- We need to reconstruct an index to pass to the fee estimate function
-  (knownTxORefs, knownTxOuts) <- unzip . Map.toList <$> lookupUtxos (txSkelKnownTxOutRefs skel <> Set.toList collateralIns)
+  (knownTxORefs, knownTxOuts) <- unzip . Map.toList <$> lookupUtxos (txSkelKnownTxOutRefs skel <> collateralIns)
   index <- case forM knownTxORefs Ledger.toCardanoTxIn of
     Left err -> throwError $ MCEGenerationError $ ToCardanoError "estimateTxSkelFee: unable to generate TxIn" err
     Right txInL -> return $ Cardano.UTxO $ Map.fromList $ zip txInL $ Cardano.toCtxUTxOTxOut . Ledger.getTxOut <$> knownTxOuts

diff --git a/src/Cooked/MockChain/BlockChain.hs b/src/Cooked/MockChain/BlockChain.hs
@@ -120,14 +120,19 @@ data MockChainLogEntry
   = -- | Logging a Skeleton as it is submitted by the user.
     MCLogSubmittedTxSkel SkelContext TxSkel
   | -- | Logging a Skeleton as it has been adjusted by the balancing mechanism,
-    -- alongside fee, collateral utxos and return collateral wallet.
-    MCLogAdjustedTxSkel SkelContext TxSkel Integer (Set Api.TxOutRef) Wallet
+    -- alongside fee, and possible collateral utxos and return collateral wallet.
+    MCLogAdjustedTxSkel SkelContext TxSkel Integer (Maybe (Set Api.TxOutRef, Wallet))
   | -- | Logging the appearance of a new transaction, after a skeleton has been
     -- successfully sent for validation.
     MCLogNewTx Api.TxId
   | -- | Logging the fact that utxos provided by the user for balancing have to be
     -- discarded for a specific reason.
     MCLogDiscardedUtxos Integer String
+  | -- | Logging the fact that utxos provided as collaterals will not be used
+    -- because the transaction does not involve scripts. There are 2 cases,
+    -- depending on whether the user has provided an explicit wallet or a set of
+    -- utxos to be used as collaterals.
+    MCLogUnusedCollaterals (Either Wallet (Set Api.TxOutRef))
 
 -- | Contains methods needed for balancing.
 class (MonadFail m, MonadError MockChainError m) => MonadBlockChainBalancing m where