fix tests and some review comments

plutus-contract/src/Plutus/Contract/Test.hs

@@ -574,11 +574,11 @@ walletFundsExactChange = walletFundsChangeImpl True
 
 walletFundsChangeImpl :: Bool -> Wallet -> Value -> TracePredicate
 walletFundsChangeImpl exact w dlt' = TracePredicate $
-    flip postMapM (L.generalize $ (,,) <$> Folds.walletFunds w <*> Folds.walletFees w <*> Folds.walletAdjustedTxEvents) $ \(finalValue', fees, txOutCosts) -> do
+    flip postMapM (L.generalize $ (,,,) <$> Folds.walletFunds w <*> Folds.walletFees w <*> Folds.walletsAdjustedTxEvents <*> Folds.walletAdjustedTxEvents w) $ \(finalValue', fees, txOutCosts, walletTxOutCosts) -> do
         dist <- ask @InitialDistribution
         let initialValue = fold (dist ^. at w)
             finalValue = finalValue' P.+ if exact then mempty else fees
-            dlt = calculateDelta dlt' initialValue finalValue w txOutCosts
+            dlt = calculateDelta dlt' initialValue finalValue w ((w, concat walletTxOutCosts) : txOutCosts)
             result = initialValue P.+ dlt == finalValue
         unless result $ do
             tell @(Doc Void) $ vsep $

plutus-contract/src/Plutus/Contract/Test/ContractModel/Internal.hs

@@ -1619,7 +1619,7 @@ checkBalances s envOuter = Map.foldrWithKey (\ w sval p -> walletFundsChange w s
     walletFundsChange w sval = TracePredicate $
       -- see Note [The Env contract]
       flip postMapM ((,) <$> Folds.instanceOutcome @() (toContract getEnvContract) envContractInstanceTag
-                         <*> L.generalize ((,,) <$> Folds.walletFunds w <*> Folds.walletFees w <*> Folds.walletAdjustedTxEvents)) $ \(outcome, (finalValue', fees, txOutCosts)) -> do
+                         <*> L.generalize ((,,,) <$> Folds.walletFunds w <*> Folds.walletFees w <*> Folds.walletsAdjustedTxEvents <*> Folds.walletAdjustedTxEvents w)) $ \(outcome, (finalValue', fees, txOutCosts, walletTxOutCosts)) -> do
         dist <- Freer.ask @InitialDistribution
         case outcome of
           Done envInner -> do
@@ -1633,7 +1633,7 @@ checkBalances s envOuter = Map.foldrWithKey (\ w sval p -> walletFundsChange w s
                 initialValue = fold (dist ^. at w)
                 dlt' = toValue lookup sval
                 finalValue = finalValue' P.+ fees
-                dlt = calculateDelta dlt' initialValue finalValue w txOutCosts
+                dlt = calculateDelta dlt' initialValue finalValue w ((w, concat walletTxOutCosts) : txOutCosts)
                 result = initialValue P.+ dlt == finalValue
             unless result $ do
                 tell @(Doc Void) $ vsep $
@@ -1642,7 +1642,7 @@ checkBalances s envOuter = Map.foldrWithKey (\ w sval p -> walletFundsChange w s
                     if initialValue == finalValue
                     then ["but they did not change"]
                     else ["but they changed by", " " <+> viaShow (finalValue P.- initialValue),
-                          "a discrepancy of",    " " <+> viaShow (finalValue P.- initialValue P.- dlt)]
+                          "a discrepancy of",    " " <+> viaShow (finalValue P.- initialValue P.- dlt) ]
             pure result
           _ -> error "I am the pope"
 

plutus-contract/src/Plutus/Contract/Test/ContractModel/MissingLovelace.hs

@@ -1,21 +1,20 @@
+{-# LANGUAGE ViewPatterns #-}
 module Plutus.Contract.Test.ContractModel.MissingLovelace
   ( calculateDelta
   ) where
 
-import Data.List as List
+import Data.Set qualified as Set
 import Ledger.Ada qualified as Ada
 import Ledger.Value (Value, noAdaValue)
 import PlutusTx.Prelude qualified as P
 import Wallet.Emulator (Wallet)
 
-calculateDelta :: Value -> Value -> Value -> Wallet -> [(Wallet, [Value])] -> Value
-calculateDelta initialDelta initialValue finalValue w txOutCosts =
+calculateDelta :: Value -> Value -> Value -> Wallet -> [(Wallet, [Ada.Ada])] -> Value
+calculateDelta initialDelta initialValue finalValue w (Set.toList . Set.fromList -> txOutCosts) =
   let
     deltas =
-      let txOutCosts' = case List.uncons $ reverse $ filter ((== w) . fst) txOutCosts of
-            Just ((_, vs), _) -> map Ada.fromValue vs
-            _                 -> []
-          otherWalletsTxOutCosts = concatMap (map Ada.fromValue . snd) $ txOutCosts
+      let txOutCosts' = concatMap snd $ filter ((== w) . fst) txOutCosts
+          otherWalletsTxOutCosts = concatMap snd txOutCosts
       in map P.abs $ concat
         [ [ P.abs val P.- P.abs wCost
           , P.abs val P.+ P.abs wCost ] | val <- [Ada.fromValue initialDelta, 0] ++ txOutCosts'

plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs

@@ -43,15 +43,15 @@ import Control.Monad.Freer.NonDet qualified as NonDet
 import Control.Monad.Freer.Reader (Reader, ask)
 import Data.Monoid (Alt (Alt), Ap (Ap))
 import Data.Text (Text)
+import Data.Traversable (forM)
 import Plutus.Contract.Resumable (Request (Request, itID, rqID, rqRequest),
                                   Response (Response, rspItID, rspResponse, rspRqID))
 
 import Control.Monad.Freer.Extras.Log (LogMessage, LogMsg, LogObserve, logDebug, logWarn, surroundDebug)
 import Ledger (POSIXTime, POSIXTimeRange, Params (..), PaymentPubKeyHash, Slot, SlotRange)
-import Ledger.Constraints.OffChain (UnbalancedTx, adjustUnbalancedTx, unBalancedTxTx)
+import Ledger.Constraints.OffChain (UnbalancedTx, adjustUnbalancedTx)
 import Ledger.TimeSlot qualified as TimeSlot
-import Ledger.Tx (CardanoTx (EmulatorTx), ToCardanoError)
-import Ledger.Validation (getCardanoTxOutputsMissingCosts)
+import Ledger.Tx (CardanoTx, ToCardanoError)
 import Plutus.ChainIndex (ChainIndexQueryEffect)
 import Plutus.ChainIndex.Effects qualified as ChainIndexEff
 import Plutus.Contract.Effects (ChainIndexQuery (..), ChainIndexResponse (..))
@@ -269,5 +269,6 @@ handleAdjustUnbalancedTx =
     RequestHandler $ \utx ->
         surroundDebug @Text "handleAdjustUnbalancedTx" $ do
             params <- Wallet.Effects.getClientParams
-            logDebug $ AdjustingUnbalancedTx $ getCardanoTxOutputsMissingCosts params (EmulatorTx $ unBalancedTxTx utx)
-            pure $ adjustUnbalancedTx params utx
+            forM (adjustUnbalancedTx params utx) $ \(missingAdaCosts, adjusted) -> do
+                logDebug $ AdjustingUnbalancedTx missingAdaCosts
+                pure adjusted

plutus-contract/src/Wallet/API.hs

@@ -64,13 +64,12 @@ import Control.Monad.Freer.Extras.Log (LogMsg, logDebug, logWarn)
 import Data.Default (Default (def))
 import Data.Text (Text)
 import Data.Void (Void)
-import Ledger (CardanoTx (EmulatorTx), Interval (Interval, ivFrom, ivTo), Params (..), PaymentPubKeyHash,
-               PubKey (PubKey, getPubKey), PubKeyHash (PubKeyHash, getPubKeyHash), Slot, SlotRange, Value, after,
-               always, before, contains, interval, isEmpty, member, singleton, width)
+import Ledger (CardanoTx, Interval (Interval, ivFrom, ivTo), Params (..), PaymentPubKeyHash, PubKey (PubKey, getPubKey),
+               PubKeyHash (PubKeyHash, getPubKeyHash), Slot, SlotRange, Value, after, always, before, contains,
+               interval, isEmpty, member, singleton, width)
 import Ledger.Constraints qualified as Constraints
-import Ledger.Constraints.OffChain (adjustUnbalancedTx, unBalancedTxTx)
+import Ledger.Constraints.OffChain (adjustUnbalancedTx)
 import Ledger.TimeSlot qualified as TimeSlot
-import Ledger.Validation (getCardanoTxOutputsMissingCosts)
 import Wallet.Effects (NodeClientEffect, WalletEffect, balanceTx, getClientParams, getClientSlot, ownPaymentPubKeyHash,
                        publishTx, submitTxn, walletAddSignature, yieldUnbalancedTx)
 import Wallet.Emulator.LogMessages (RequestHandlerLogMsg (AdjustingUnbalancedTx))
@@ -96,8 +95,8 @@ payToPaymentPublicKeyHash params range v pk = do
     utx <- either (throwError . PaymentMkTxError)
                   pure
                   (Constraints.mkTx @Void mempty constraints)
-    adjustedUtx <- either (throwError . ToCardanoError) pure (adjustUnbalancedTx params utx)
-    logDebug $ AdjustingUnbalancedTx $ getCardanoTxOutputsMissingCosts params (EmulatorTx $ unBalancedTxTx utx)
+    (missingAdaCosts, adjustedUtx) <- either (throwError . ToCardanoError) pure (adjustUnbalancedTx params utx)
+    logDebug $ AdjustingUnbalancedTx missingAdaCosts
     unless (utx == adjustedUtx) $
       logWarn @Text $ "Wallet.API.payToPublicKeyHash: "
                    <> "Adjusted a transaction output value which has less than the minimum amount of Ada."

plutus-contract/src/Wallet/Emulator/Folds.hs

@@ -37,6 +37,7 @@ module Wallet.Emulator.Folds (
     , walletFees
     , walletTxBalanceEvents
     , walletAdjustedTxEvents
+    , walletsAdjustedTxEvents
     -- * Folds that are used in the Playground
     , annotatedBlockchain
     , blockchain
@@ -79,12 +80,13 @@ import Plutus.Trace.Emulator.ContractInstance (ContractInstanceState, addEventIn
                                                instContractState, instEvents, instHandlersHistory)
 import Plutus.Trace.Emulator.Types (ContractInstanceLog, ContractInstanceMsg (ContractLog), ContractInstanceTag,
                                     UserThreadMsg, _HandledRequest, cilMessage, cilTag, toInstanceState)
+import Plutus.V1.Ledger.Ada qualified as Ada
 import Prettyprinter (Pretty (..), defaultLayoutOptions, layoutPretty, vsep)
 import Prettyprinter.Render.Text (renderStrict)
 import Wallet.Emulator.Chain (ChainEvent (SlotAdd, TxnValidate, TxnValidationFail), _TxnValidate, _TxnValidationFail)
 import Wallet.Emulator.LogMessages (_AdjustingUnbalancedTx, _BalancingUnbalancedTx, _ValidationFailed)
 import Wallet.Emulator.MultiAgent (EmulatorEvent, EmulatorTimeEvent, chainEvent, eteEvent, instanceEvent,
-                                   userThreadEvent, walletClientEvent, walletEvent')
+                                   userThreadEvent, walletClientEvent, walletEvent, walletEvent')
 import Wallet.Emulator.NodeClient (_TxSubmit)
 import Wallet.Emulator.Wallet (Wallet, _RequestHandlerLog, _TxBalanceLog, mockWalletAddress)
 import Wallet.Rollup qualified as Rollup
@@ -121,9 +123,13 @@ scriptEvents = preMapMaybe (preview (eteEvent . chainEvent) >=> getEvent) (conca
 walletTxBalanceEvents :: EmulatorEventFold [UnbalancedTx]
 walletTxBalanceEvents = preMapMaybe (preview (eteEvent . walletEvent' . _2 . _TxBalanceLog . _BalancingUnbalancedTx)) L.list
 
--- | Min lovelace of 'txOut's from adjusted unbalanced transactions
-walletAdjustedTxEvents :: EmulatorEventFold [(Wallet, [Value])]
-walletAdjustedTxEvents = preMapMaybe (preview (eteEvent . walletEvent' . to (\x -> (x ^. _1, x ^. _2 . _RequestHandlerLog . _AdjustingUnbalancedTx)))) L.list
+-- | Min lovelace of 'txOut's from adjusted unbalanced transactions for all wallets
+walletsAdjustedTxEvents :: EmulatorEventFold [(Wallet, [Ada.Ada])]
+walletsAdjustedTxEvents = preMapMaybe (preview (eteEvent . walletEvent' . to (\x -> (x ^. _1, x ^. _2 . _RequestHandlerLog . _AdjustingUnbalancedTx)))) L.list
+
+-- | Min lovelace of 'txOut's from adjusted unbalanced transactions for the given wallet
+walletAdjustedTxEvents :: Wallet -> EmulatorEventFold [[Ada.Ada]]
+walletAdjustedTxEvents w = preMapMaybe (preview (eteEvent . walletEvent w . _RequestHandlerLog . _AdjustingUnbalancedTx)) L.list
 
 mkTxLogs :: EmulatorEventFold [MkTxLog]
 mkTxLogs =

plutus-contract/src/Wallet/Emulator/LogMessages.hs

@@ -21,6 +21,7 @@ import Ledger.Constraints.OffChain (UnbalancedTx)
 import Ledger.Index (ScriptValidationEvent, ValidationError, ValidationPhase)
 import Ledger.Slot (Slot)
 import Ledger.Value (Value)
+import Plutus.V1.Ledger.Ada qualified as Ada
 import Prettyprinter (Pretty (..), colon, hang, viaShow, vsep, (<+>))
 import Wallet.Emulator.Error (WalletAPIError)
 
@@ -29,7 +30,7 @@ data RequestHandlerLogMsg =
     | StartWatchingContractAddresses
     | HandleTxFailed WalletAPIError
     | UtxoAtFailed Address
-    | AdjustingUnbalancedTx [Value]
+    | AdjustingUnbalancedTx [Ada.Ada]
     deriving stock (Eq, Show, Generic)
     deriving anyclass (ToJSON, FromJSON)
 

plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs

@@ -47,7 +47,7 @@ module Ledger.Constraints.OffChain(
     , missingValueSpent
     ) where
 
-import Control.Lens (At (at), iforM_, makeLensesFor, mapMOf, use, view, (%=), (.=), (<>=))
+import Control.Lens (At (at), iforM_, makeLensesFor, mapAccumLOf, use, view, (%=), (.=), (<>=))
 import Control.Monad (forM_)
 import Control.Monad.Except (MonadError (catchError, throwError), runExcept, unless)
 import Control.Monad.Reader (MonadReader (ask), ReaderT (runReaderT), asks)
@@ -401,14 +401,20 @@ mkTx lookups txc = mkSomeTx [SomeLookupsAndConstraints lookups txc]
 
 -- | Each transaction output should contain a minimum amount of Ada (this is a
 -- restriction on the real Cardano network).
-adjustUnbalancedTx :: Params -> UnbalancedTx -> Either Tx.ToCardanoError UnbalancedTx
-adjustUnbalancedTx params = mapMOf (tx . Tx.outputs . traverse) adjustTxOut
+adjustUnbalancedTx :: Params -> UnbalancedTx -> Either Tx.ToCardanoError ([Ada.Ada], UnbalancedTx)
+adjustUnbalancedTx params utx =
+    let (acc, res) = mapAccumLOf (tx . Tx.outputs . traverse) step (Right []) utx
+    in (flip (,) res) <$> acc
   where
-    adjustTxOut :: TxOut -> Either Tx.ToCardanoError TxOut
+    step acc txOut = case (acc, adjustTxOut txOut) of
+        (Left _, _)                       -> (acc, txOut) -- acc is an error, do nothing
+        (Right _, Left e)                 -> (Left e, txOut) -- failed somewhere, return error as acc
+        (Right acc', Right (ada, txOut')) -> (Right $ ada:acc', txOut')
+    adjustTxOut :: TxOut -> Either Tx.ToCardanoError (Ada.Ada, TxOut)
     adjustTxOut txOut = fromPlutusTxOutUnsafe params txOut <&> \txOut' ->
         let minAdaTxOut' = Ada.fromValue $ evaluateMinLovelaceOutput params txOut'
             missingLovelace = max 0 (minAdaTxOut' - Ada.fromValue (txOutValue txOut))
-        in txOut { txOutValue = txOutValue txOut <> Ada.toValue missingLovelace }
+        in (missingLovelace, txOut { txOutValue = txOutValue txOut <> Ada.toValue missingLovelace })
 
 -- | Add the remaining balance of the total value that the tx must spend.
 --   See note [Balance of value spent]

plutus-ledger/src/Ledger/Validation.hs

@@ -39,7 +39,6 @@ module Ledger.Validation(
   previousBlocks,
   -- * Etc.
   emulatorGlobals,
-  getCardanoTxOutputsMissingCosts
   ) where
 
 import Cardano.Api.Shelley (ShelleyBasedEra (ShelleyBasedEraAlonzo), makeSignedTransaction, shelleyGenesisDefaults,
@@ -335,14 +334,3 @@ fromPaymentPrivateKey xprv txBody
       (C.Api.WitnessPaymentExtendedKey (C.Api.PaymentExtendedSigningKey xprv))
   where
     notUsed = undefined -- hack so we can reuse code from cardano-api
-
-getCardanoTxOutputsMissingCosts :: P.Params -> P.CardanoTx -> [P.Value]
-getCardanoTxOutputsMissingCosts params = getCosts . Map.elems . P.getCardanoTxUnspentOutputsTx
-    where
-      getCosts :: [P.TxOut] -> [P.Value]
-      getCosts txOuts = txOuts <&> \txOut -> case fromPlutusTxOutUnsafe params txOut of
-        Left _       -> P.zero
-        Right txOut' ->
-          let minAdaTxOut' = P.fromValue $ evaluateMinLovelaceOutput params txOut'
-              missingLovelace = max 0 (minAdaTxOut' - P.fromValue (P.txOutValue txOut))
-          in P.toValue missingLovelace