adding a MinAda file to separate min ada adjustement from balancing

cooked-validators.cabal

@@ -34,6 +34,7 @@ library
       Cooked.MockChain.BlockChain
       Cooked.MockChain.Direct
       Cooked.MockChain.GenerateTx
+      Cooked.MockChain.MinAda
       Cooked.MockChain.Staged
       Cooked.MockChain.Testing
       Cooked.MockChain.UtxoSearch

src/Cooked/MockChain.hs

@@ -5,6 +5,7 @@ module Cooked.MockChain (module X) where
 import Cooked.MockChain.Balancing as X
 import Cooked.MockChain.BlockChain as X
 import Cooked.MockChain.Direct as X
+import Cooked.MockChain.MinAda as X
 import Cooked.MockChain.Staged as X hiding
   ( MockChainLog,
     MockChainLogEntry,

src/Cooked/MockChain/Balancing.hs

@@ -5,7 +5,6 @@
 module Cooked.MockChain.Balancing (balanceTxSkel) where
 
 import Cardano.Api.Shelley qualified as Cardano
-import Cardano.Ledger.Shelley.Core qualified as Shelley
 import Cardano.Node.Emulator.Internal.Node.Params qualified as Emulator
 import Cardano.Node.Emulator.Internal.Node.Validation qualified as Emulator
 import Control.Monad.Except
@@ -33,12 +32,11 @@ balanceTxSkel :: (MonadBlockChainBalancing m) => TxSkel -> m (TxSkel, Fee, Set A
 balanceTxSkel skel = do
   -- We retrieve the balancing wallet, who is central in the balancing
   -- process. Any missing asset will be searched within its utxos.
-  let balancingWallet =
-        case txOptBalanceWallet . txSkelOpts $ skel of
-          BalanceWithFirstSigner -> case txSkelSigners skel of
-            [] -> error "Can't select balancing wallet: There has to be at least one wallet in txSkelSigners"
-            bw : _ -> bw
-          BalanceWith bWallet -> bWallet
+  balancingWallet <- case txOptBalanceWallet . txSkelOpts $ skel of
+    BalanceWithFirstSigner -> case txSkelSigners skel of
+      [] -> fail "Can't select balancing wallet: There has to be at least one wallet in txSkelSigners"
+      bw : _ -> return bw
+    BalanceWith bWallet -> return bWallet
 
   -- We collect collateral inputs. They might be directly provided in the
   -- skeleton, or should be retrieved from a given wallet
@@ -47,53 +45,16 @@ balanceTxSkel skel = do
     CollateralUtxosFromWallet cWallet -> getCollateralInputs cWallet
     CollateralUtxosFromSet utxos -> return utxos
 
-  -- We do the min Ada adjustment if it's requested
-  skelMinAda <-
-    if txOptEnsureMinAda . txSkelOpts $ skel
-      then ensureTxSkelOutsMinAda skel
-      else return skel
-
-  -- We compute the balanced skeleton with the associated fees
+  -- We compute the balanced skeleton with the associated fees when requested
+  -- we start with a fee of 10 an increase it a maximum of 5 times
   (skelBalanced, fees) <-
-    if txOptBalance . txSkelOpts $ skelMinAda
-      then -- We start with a small fee and then increase it
-        calcFee balancingWallet 5 (Fee 10) collateralInputs skelMinAda
-      else return (skelMinAda, Fee 0)
+    if txOptBalance . txSkelOpts $ skel
+      then calcFee balancingWallet 5 (Fee 10) collateralInputs skel
+      else return (skel, Fee 0)
 
   -- We return the new skeleton, the fees and the collateral inputs
   return (skelBalanced, fees, collateralInputs)
 
--- | Ensure that the transaction outputs have the necessary minimum amount of
--- Ada on them. This will only be applied if the 'txOptEnsureMinAda' is set to
--- @True@.
-ensureTxSkelOutsMinAda :: (MonadBlockChainBalancing m) => TxSkel -> m TxSkel
-ensureTxSkelOutsMinAda skel = do
-  theParams <- getParams
-  case mapM (ensureTxSkelOutHasMinAda theParams) $ skel ^. txSkelOutsL of
-    Left err -> throwError $ MCEGenerationError err
-    Right newTxSkelOuts -> return $ skel & txSkelOutsL .~ newTxSkelOuts
-  where
-    ensureTxSkelOutHasMinAda :: Emulator.Params -> TxSkelOut -> Either GenerateTxError TxSkelOut
-    ensureTxSkelOutHasMinAda theParams txSkelOut@(Pays output) = do
-      cardanoTxOut <- generateTxOut (Emulator.pNetworkId theParams) txSkelOut
-      let Script.Lovelace oldAda = output ^. outputValueL % adaL
-          Emulator.Coin requiredAda =
-            Shelley.getMinCoinTxOut
-              (Emulator.emulatorPParams theParams)
-              . Cardano.toShelleyTxOut Cardano.ShelleyBasedEraConway
-              . Cardano.toCtxUTxOTxOut
-              $ cardanoTxOut
-          updatedTxSkelOut = Pays $ output & outputValueL % adaL .~ Script.Lovelace (max oldAda requiredAda)
-      -- The following iterative approach to calculate the minimum Ada amount of
-      -- a TxOut is necessary, because the additional value might make the TxOut
-      -- heavier.
-      --
-      -- It is inspired by
-      -- https://github.com/input-output-hk/plutus-apps/blob/8706e6c7c525b4973a7b6d2ed7c9d0ef9cd4ef46/plutus-ledger/src/Ledger/Index.hs#L124
-      if oldAda < requiredAda
-        then ensureTxSkelOutHasMinAda theParams updatedTxSkelOut
-        else return txSkelOut
-
 -- ensuring that the equation
 --
 -- > input value + minted value = output value + burned value + fee
@@ -151,8 +112,6 @@ estimateTxSkelFee skel fee collateralIns = do
     Left err -> throwError $ MCEGenerationError (TxBodyError "Error creating body when estimating fees" err)
     Right txBody | Emulator.Coin fee' <- Cardano.evaluateTransactionFee Cardano.ShelleyBasedEraConway pParams txBody nkeys 0 -> return $ Fee fee'
 
--- TODO: improve our collateral mechanism
-
 -- | Calculates the collateral for a transaction
 getCollateralInputs :: (MonadBlockChainBalancing m) => Wallet -> m (Set Api.TxOutRef)
 getCollateralInputs w = do

src/Cooked/MockChain/Direct.hs

@@ -22,6 +22,7 @@ import Cooked.InitialDistribution
 import Cooked.MockChain.Balancing
 import Cooked.MockChain.BlockChain
 import Cooked.MockChain.GenerateTx
+import Cooked.MockChain.MinAda
 import Cooked.MockChain.UtxoState
 import Cooked.Output
 import Cooked.Skeleton
@@ -330,9 +331,12 @@ instance (Monad m) => MonadBlockChain (MockChainT m) where
     let newParams = applyEmulatorParamsModification (txOptEmulatorParamsModification . txSkelOpts $ skelUnbal) oldParams
     -- We change the parameters for the duration of the validation process
     setParams newParams
-    -- We balance the skeleton (when requested in the options) and get the
-    -- associated fees and collateral inputs
-    (skel, fees, collateralIns) <- balanceTxSkel skelUnbal
+    -- We ensure that the outputs have the required minimal amount of ada, when
+    -- requested in the skeleton options
+    minAdaSkelUnbal <- ensureTxSkelMinAda skelUnbal
+    -- We balance the skeleton and get the associated fees and collateral
+    -- inputs, when requested in the skeleton options
+    (skel, fees, collateralIns) <- balanceTxSkel minAdaSkelUnbal
     -- We retrieve data that will be used in the transaction generation process:
     -- datums, validators and various kinds of inputs. This idea is to provide a
     -- rich-enough context for the transaction generation to succeed.

src/Cooked/MockChain/MinAda.hs

@@ -0,0 +1,58 @@
+module Cooked.MockChain.MinAda
+  ( toTxSkelOutMinAda,
+    toTxSkelMinAda,
+    ensureTxSkelMinAda,
+  )
+where
+
+import Cardano.Api qualified as Cardano
+import Cardano.Api.Ledger qualified as Cardano
+import Cardano.Api.Shelley qualified as Cardano
+import Cardano.Ledger.Shelley.Core qualified as Shelley
+import Cardano.Node.Emulator qualified as Emulator
+import Cardano.Node.Emulator.Internal.Node.Params qualified as Emulator
+import Control.Monad.Except
+import Cooked.MockChain.BlockChain
+import Cooked.MockChain.GenerateTx
+import Cooked.Output
+import Cooked.Skeleton
+import Cooked.ValueUtils
+import Optics.Core
+import Plutus.Script.Utils.Ada qualified as Script
+
+ensureTxSkelMinAda :: (MonadBlockChainBalancing m) => TxSkel -> m TxSkel
+ensureTxSkelMinAda skel =
+  if txOptEnsureMinAda . txSkelOpts $ skel
+    then toTxSkelMinAda skel
+    else return skel
+
+-- | To that the transaction outputs have the necessary minimum amount of
+-- Ada on them. This will only be applied if the 'txOptToMinAda' is set to
+-- @True@.
+toTxSkelMinAda :: (MonadBlockChainBalancing m) => TxSkel -> m TxSkel
+toTxSkelMinAda skel = do
+  theParams <- getParams
+  case mapM (toTxSkelOutMinAda theParams) $ skel ^. txSkelOutsL of
+    Left err -> throwError $ MCEGenerationError err
+    Right newTxSkelOuts -> return $ skel & txSkelOutsL .~ newTxSkelOuts
+
+toTxSkelOutMinAda :: Emulator.Params -> TxSkelOut -> Either GenerateTxError TxSkelOut
+toTxSkelOutMinAda theParams txSkelOut@(Pays output) = do
+  cardanoTxOut <- generateTxOut (Emulator.pNetworkId theParams) txSkelOut
+  let Script.Lovelace oldAda = output ^. outputValueL % adaL
+      Cardano.Coin requiredAda =
+        Shelley.getMinCoinTxOut
+          (Emulator.emulatorPParams theParams)
+          . Cardano.toShelleyTxOut Cardano.ShelleyBasedEraConway
+          . Cardano.toCtxUTxOTxOut
+          $ cardanoTxOut
+      updatedTxSkelOut = Pays $ output & outputValueL % adaL .~ Script.Lovelace (max oldAda requiredAda)
+  -- The following iterative approach to calculate the minimum Ada amount of
+  -- a TxOut is necessary, because the additional value might make the TxOut
+  -- heavier.
+  --
+  -- It is inspired by
+  -- https://github.com/input-output-hk/plutus-apps/blob/8706e6c7c525b4973a7b6d2ed7c9d0ef9cd4ef46/plutus-ledger/src/Ledger/Index.hs#L124
+  if oldAda < requiredAda
+    then toTxSkelOutMinAda theParams updatedTxSkelOut
+    else return txSkelOut

src/Cooked/MockChain/UtxoSearch.hs

@@ -16,6 +16,7 @@ module Cooked.MockChain.UtxoSearch
     filterWithValuePred,
     filterWithOnlyAda,
     filterWithNotOnlyAda,
+    onlyValueOutputsAtSearch,
     vanillaOutputsAtSearch,
     filterWithAlways,
     scriptOutputsSearch,
@@ -117,6 +118,17 @@ filterWithOnlyAda as = filterWithValuePred as $ (1 ==) . length . Script.flatten
 filterWithNotOnlyAda :: (Monad m) => UtxoSearch m Api.TxOut -> UtxoSearch m Api.Value
 filterWithNotOnlyAda as = filterWithValuePred as $ (1 <) . length . Script.flattenValue
 
+onlyValueOutputsAtSearch ::
+  (MonadBlockChainBalancing m, ToAddress addr) =>
+  addr ->
+  UtxoSearch m (ConcreteOutput Api.Credential () Api.Value Api.ScriptHash)
+onlyValueOutputsAtSearch addr =
+  utxosAtSearch addr
+    `filterWithAlways` fromAbstractOutput
+    `filterWithPure` isOutputWithoutDatum
+    `filterWithPure` isEmptyStakingCredentialOutput
+    `filterWithPred` (isNothing . view outputReferenceScriptL)
+
 -- A vanilla output only possesses an ada-only value and does not have a staking
 -- credential, a datum or a reference script. A vanilla UTxO is a perfect
 -- candidate to be used for fee, balancing or collateral.
@@ -125,12 +137,8 @@ vanillaOutputsAtSearch ::
   addr ->
   UtxoSearch m (ConcreteOutput Api.Credential () Script.Ada Api.ScriptHash)
 vanillaOutputsAtSearch addr =
-  utxosAtSearch addr
-    `filterWithAlways` fromAbstractOutput
+  onlyValueOutputsAtSearch addr
     `filterWithPure` isOnlyAdaOutput
-    `filterWithPure` isOutputWithoutDatum
-    `filterWithPure` isEmptyStakingCredentialOutput
-    `filterWithPred` (isNothing . view outputReferenceScriptL)
 
 scriptOutputsSearch ::
   (MonadBlockChain m, ToScriptHash s) =>