SCP-3129: Fix minAda related bugs

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

@@ -65,6 +65,7 @@ module Plutus.Contract.Test(
     , defaultCheckOptions
     , minLogLevel
     , emulatorConfig
+    , changeInitialWalletValue
     -- * Etc
     , goldenPir
     ) where
@@ -73,7 +74,7 @@ import Control.Applicative (liftA2)
 import Control.Arrow ((>>>))
 import Control.Foldl (FoldM)
 import Control.Foldl qualified as L
-import Control.Lens (at, makeLenses, preview, to, (&), (.~), (^.))
+import Control.Lens (_Left, at, ix, makeLenses, over, preview, to, (&), (.~), (^.))
 import Control.Monad (unless)
 import Control.Monad.Freer (Eff, reinterpret, runM, sendM)
 import Control.Monad.Freer.Error (Error, runError)
@@ -163,6 +164,10 @@ defaultCheckOptions =
         , _emulatorConfig = def
         }
 
+-- | Modify the value assigned to the given wallet in the initial distribution.
+changeInitialWalletValue :: Wallet -> (Value -> Value) -> CheckOptions -> CheckOptions
+changeInitialWalletValue wallet = over (emulatorConfig . initialChainState . _Left . ix wallet)
+
 type TestEffects = '[Reader InitialDistribution, Error EmulatorFoldErr, Writer (Doc Void)]
 
 -- | Check if the emulator trace meets the condition

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

@@ -62,7 +62,7 @@ instance Pretty TxBalanceMsg where
         AddingInputsFor vl           -> "Adding inputs for" <+> pretty vl
         NoCollateralInputsAdded      -> "No collateral inputs added"
         AddingCollateralInputsFor vl -> "Adding collateral inputs for" <+> pretty vl
-        FinishedBalancing tx         -> "Finished balancing." <+> pretty (txId tx)
+        FinishedBalancing tx         -> hang 2 $ vsep ["Finished balancing:", pretty tx]
         SubmittingTx tx              -> "Submitting tx:" <+> pretty (txId tx)
         ValidationFailed p i _ e _   -> "Validation error:" <+> pretty p <+> pretty i <> colon <+> pretty e
 

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

@@ -380,7 +380,7 @@ handleBalanceTx utxo UnbalancedTx{unBalancedTxTx} = do
                pure filteredUnbalancedTxTx
            else do
                 logDebug $ AddingPublicKeyOutputFor pos
-                pure $ addOutputs ownPaymentPubKey ownStakePubKey pos filteredUnbalancedTxTx
+                pure $ addOutput ownPaymentPubKey ownStakePubKey pos filteredUnbalancedTxTx
 
     tx'' <- if Value.isZero neg
             then do
@@ -443,7 +443,7 @@ adjustBalanceWithMissingLovelace utxo ownPaymentPubKey unBalancedTx (neg, pos) =
         -- minted, and if the positive balance is > 0 and < 'Ledger.minAdaTxOut',
         -- then we adjust it to the minimum Ada.
         missingLovelaceFromPosValue =
-          if Ada.isZero (Ada.fromValue posWithMintAda) || Ada.fromValue posWithMintAda >= Ledger.minAdaTxOut
+          if Value.isZero posWithMintAda || Ada.fromValue posWithMintAda >= Ledger.minAdaTxOut
             then 0
             else max 0 (Ledger.minAdaTxOut - Ada.fromValue posWithMintAda)
         -- We calculate the final negative and positive balances
@@ -452,8 +452,8 @@ adjustBalanceWithMissingLovelace utxo ownPaymentPubKey unBalancedTx (neg, pos) =
 
     pure (newNeg, newPos)
 
-addOutputs :: PaymentPubKey -> Maybe StakePubKey -> Value -> Tx -> Tx
-addOutputs pk sk vl tx = tx & over Tx.outputs (pko :) where
+addOutput :: PaymentPubKey -> Maybe StakePubKey -> Value -> Tx -> Tx
+addOutput pk sk vl tx = tx & over Tx.outputs (pko :) where
     pko = Tx.pubKeyTxOut vl pk sk
 
 addCollateral
@@ -486,15 +486,16 @@ addInputs mp pk sk vl tx = do
     (spend, change) <- selectCoin (second (view Ledger.ciTxOutValue) <$> Map.toList mp) vl
     let
 
-        addTxIns  =
+        addTxIns =
             let ins = Set.fromList (Tx.pubKeyTxIn . fst <$> spend)
             in over Tx.inputs (Set.union ins)
 
-        addTxOuts = if Value.isZero change
-                    then id
-                    else addOutputs pk sk change
+        addTxOut =
+            if Value.isZero change
+                then id
+                else addOutput pk sk change
 
-    pure $ tx & addTxOuts & addTxIns
+    pure $ tx & addTxOut & addTxIns
 
 -- Make a transaction output from a positive value.
 mkChangeOutput :: PaymentPubKey -> Maybe StakePubKey -> Value -> Maybe TxOut

plutus-contract/test/Spec/Contract.hs

@@ -25,19 +25,20 @@ import Data.Map qualified as Map
 import Data.Void (Void)
 import Test.Tasty (TestTree, testGroup)
 
-import Ledger (Address, PaymentPubKeyHash)
+import Ledger (Address, PaymentPubKeyHash, Validator, validatorHash)
 import Ledger qualified
 import Ledger.Ada qualified as Ada
 import Ledger.Constraints qualified as Constraints
-import Ledger.Scripts (datumHash)
+import Ledger.Scripts (datumHash, unitDatum, unitRedeemer)
 import Ledger.Tx (getCardanoTxId)
+import Ledger.Value qualified as Value
 import Plutus.Contract as Con
 import Plutus.Contract.State qualified as State
 import Plutus.Contract.Test (Shrinking (DoShrink, DontShrink), TracePredicate, assertAccumState, assertContractError,
                              assertDone, assertInstanceLog, assertNoFailedTransactions, assertResumableResult,
-                             assertUserLog, checkEmulatorFails, checkPredicateOptions, defaultCheckOptions,
-                             endpointAvailable, minLogLevel, mockWalletPaymentPubKeyHash, not, w1, w2, waitingForSlot,
-                             walletFundsChange, (.&&.))
+                             assertUserLog, changeInitialWalletValue, checkEmulatorFails, checkPredicateOptions,
+                             defaultCheckOptions, endpointAvailable, minLogLevel, mockWalletPaymentPubKeyHash, not, w1,
+                             w2, waitingForSlot, walletFundsChange, (.&&.))
 import Plutus.Contract.Types (ResumableResult (ResumableResult, _finalState), responses)
 import Plutus.Contract.Util (loopM)
 import Plutus.Trace qualified as Trace
@@ -314,8 +315,37 @@ tests =
           in run "mustSatisfyAnyOf [mempty] works"
             ( assertDone c tag (const True) "should be done"
             ) (void $ activateContract w1 c tag)
+
+        , balanceTxnMinAda
         ]
 
+balanceTxnMinAda :: TestTree
+balanceTxnMinAda =
+    let ee = Value.singleton "ee" "ee" 1
+        ff = Value.singleton "ff" "ff" 1
+        options = defaultCheckOptions
+            & changeInitialWalletValue w1 (Value.scale 1000 (ee <> ff) <>)
+        vHash = validatorHash someValidator
+
+        contract :: Contract () EmptySchema ContractError ()
+        contract = do
+            let constraints1 = Constraints.mustPayToOtherScript vHash unitDatum (Value.scale 100 ff <> Ada.toValue Ledger.minAdaTxOut)
+                utx1 = either (error . show) id $ Constraints.mkTx @Void mempty constraints1
+            submitTxConfirmed utx1
+            utxo <- utxosAt someAddress
+            let txOutRef = head (Map.keys utxo)
+                constraints2 = Constraints.mustSpendScriptOutput txOutRef unitRedeemer
+                    <> Constraints.mustPayToOtherScript vHash unitDatum (Value.scale 200 ee)
+                lookups2 = Constraints.unspentOutputs utxo <> Constraints.otherScript someValidator
+                utx2 = Constraints.adjustUnbalancedTx $ either (error . show) id $ Constraints.mkTx @Void lookups2 constraints2
+            submitTxConfirmed utx2
+
+        trace = do
+            Trace.activateContractWallet w1 contract
+            Trace.waitNSlots 2
+
+    in checkPredicateOptions options "balancing doesn't create outputs with no Ada" assertNoFailedTransactions (void trace)
+
 checkpointContract :: Contract () Schema ContractError ()
 checkpointContract = void $ do
     checkpoint $ awaitPromise $ endpoint @"1" @Int pure .> endpoint @"2" @Int pure
@@ -340,8 +370,10 @@ errorContract = do
         (\_ -> checkpoint $ awaitPromise $ endpoint @"2" @Int pure .> endpoint @"3" @Int pure)
 
 someAddress :: Address
-someAddress = Ledger.scriptAddress $
-    Ledger.mkValidatorScript $$(PlutusTx.compile [|| \(_ :: PlutusTx.BuiltinData) (_ :: PlutusTx.BuiltinData) (_ :: PlutusTx.BuiltinData) -> () ||])
+someAddress = Ledger.scriptAddress someValidator
+
+someValidator :: Validator
+someValidator = Ledger.mkValidatorScript $$(PlutusTx.compile [|| \(_ :: PlutusTx.BuiltinData) (_ :: PlutusTx.BuiltinData) (_ :: PlutusTx.BuiltinData) -> () ||])
 
 type Schema =
     Endpoint "1" Int

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

@@ -378,11 +378,8 @@ mkTx lookups txc = mkSomeTx [SomeLookupsAndConstraints lookups txc]
 --
 -- TODO: In the future, the minimum Ada value should be configurable.
 adjustUnbalancedTx :: UnbalancedTx -> UnbalancedTx
-adjustUnbalancedTx = over (tx . Tx.outputs) adjustTxOuts
+adjustUnbalancedTx = over (tx . Tx.outputs . traverse) adjustTxOut
   where
-    adjustTxOuts :: [TxOut] -> [TxOut]
-    adjustTxOuts = fmap adjustTxOut . filter (not . Value.isZero . txOutValue)
-
     adjustTxOut :: TxOut -> TxOut
     adjustTxOut txOut =
       let missingLovelace = max 0 (Ledger.minAdaTxOut - Ada.fromValue (txOutValue txOut))

plutus-use-cases/scripts/Main.hs

@@ -92,8 +92,8 @@ writeScripts config = do
         [ -- TODO: The revert of input-output-hk/cardano-node#3206 prevents us from using traces
           --       for the auction contract for now. Uncomment the following code whenever we
           --       have a proper implementation.
-          --  ("auction_1", Auction.auctionTrace1, Auction.auctionEmulatorCfg)
-          --, ("auction_2", Auction.auctionTrace2, Auction.auctionEmulatorCfg)
+          --  ("auction_1", Auction.auctionTrace1, view emulatorConfig Auction.options)
+          --, ("auction_2", Auction.auctionTrace2, view emulatorConfig Auction.options)
           ("crowdfunding-success", Crowdfunding.successfulCampaign, def)
         , ("currency", Currency.currencyTrace, def)
         , ("escrow-redeem_1", Escrow.redeemTrace, def)

plutus-use-cases/src/Plutus/Contracts/Auction.hs

@@ -126,7 +126,7 @@ auctionTransition AuctionParams{apOwner, apAsset, apEndTime} State{stateData=old
     case (oldStateData, input) of
 
         (Ongoing HighestBid{highestBid, highestBidder}, Bid{newBid, newBidder}) | newBid > highestBid -> -- if the new bid is higher,
-            let constraints =
+            let constraints = if highestBid == 0 then mempty else
                     Constraints.mustPayToPubKey highestBidder (Ada.toValue highestBid) -- we pay back the previous highest bid
                     <> Constraints.mustValidateIn (Interval.to $ apEndTime - 1) -- but only if we haven't gone past 'apEndTime'
                 newState =

plutus-use-cases/test/Spec/Auction.hs

@@ -9,7 +9,7 @@
 {-# LANGUAGE TypeFamilies       #-}
 module Spec.Auction
     ( tests
-    , auctionEmulatorCfg
+    , options
     , auctionTrace1
     , auctionTrace2
     , prop_Auction
@@ -68,15 +68,10 @@ theToken =
     -- This currency is created by the initial transaction.
     Value.singleton mpsHash "token" 1
 
--- | 'EmulatorConfig' that includes 'theToken' in the initial distribution of Wallet 1.
-auctionEmulatorCfg :: Trace.EmulatorConfig
-auctionEmulatorCfg =
-    let initialDistribution = defaultDist & over (ix w1) ((<>) theToken)
-    in (def & Trace.initialChainState .~ Left initialDistribution) & Trace.slotConfig .~ slotCfg
-
--- | 'CheckOptions' that includes our own 'auctionEmulatorCfg'.
+-- | 'CheckOptions' that includes 'theToken' in the initial distribution of Wallet 1.
 options :: CheckOptions
-options = set emulatorConfig auctionEmulatorCfg defaultCheckOptions
+options = defaultCheckOptions
+    & changeInitialWalletValue w1 ((<>) theToken)
 
 seller :: Contract AuctionOutput SellerSchema AuctionError ()
 seller = auctionSeller (apAsset params) (apEndTime params)

plutus-use-cases/test/Spec/Future.hs

@@ -43,14 +43,11 @@ import Wallet.Emulator.Folds qualified as Folds
 import Wallet.Emulator.Stream qualified as Stream
 import Wallet.Emulator.Wallet qualified as Wallet
 
-futureEmulatorCfg :: Trace.EmulatorConfig
-futureEmulatorCfg =
-    let initialDistribution = fmap (const $ Ada.lovelaceValueOf 1_000_000_000) defaultDist
-    in def & Trace.initialChainState .~ Left initialDistribution
-
--- | 'CheckOptions' that includes our own 'auctionEmulatorCfg'.
+-- | 'CheckOptions' that assigns 1000 Ada to Wallets 1 and 2.
 options :: CheckOptions
-options = set emulatorConfig futureEmulatorCfg defaultCheckOptions
+options = defaultCheckOptions
+    & changeInitialWalletValue w1 (const $ Ada.adaValueOf 1000)
+    & changeInitialWalletValue w2 (const $ Ada.adaValueOf 1000)
 
 tests :: TestTree
 tests =
@@ -217,5 +214,5 @@ testAccounts =
         $ Freer.runError @Folds.EmulatorFoldErr
         $ Stream.foldEmulatorStreamM fld
         $ Stream.takeUntilSlot 10
-        $ Trace.runEmulatorStream futureEmulatorCfg F.setupTokensTrace
+        $ Trace.runEmulatorStream (view emulatorConfig options) F.setupTokensTrace
 

plutus-use-cases/test/Spec/SealedBidAuction.hs

@@ -50,15 +50,10 @@ theToken = Value.singleton mpsHash "token" 1
 mpsHash :: Value.CurrencySymbol
 mpsHash = Value.CurrencySymbol $ PlutusTx.toBuiltin $ Crypto.hashToBytes $ Crypto.hashWith @Crypto.Blake2b_256 id "ffff"
 
--- | 'EmulatorConfig' that includes 'theToken' in the initial distribution of Wallet 1.
-auctionEmulatorCfg :: Trace.EmulatorConfig
-auctionEmulatorCfg =
-    let initialDistribution = defaultDist & over (ix w1) ((<>) theToken)
-    in (def & Trace.initialChainState .~ Left initialDistribution) & Trace.slotConfig .~ def
-
--- | 'CheckOptions' that includes our own 'auctionEmulatorCfg'.
+-- | 'CheckOptions' that includes 'theToken' in the initial distribution of Wallet 1.
 options :: CheckOptions
-options = set emulatorConfig auctionEmulatorCfg defaultCheckOptions
+options = defaultCheckOptions
+    & changeInitialWalletValue w1 ((<>) theToken)
 
 -- * QuickCheck model
 

plutus-use-cases/test/Spec/SimpleEscrow.hs

@@ -100,9 +100,9 @@ token2 = Value.singleton "2222" "Token2"
 
 options :: CheckOptions
 options =
-    let initialDistribution = defaultDist & over (ix w1) ((<>) (token1 500))
-                                          & over (ix w2) ((<>) (token2 500))
-    in defaultCheckOptions & emulatorConfig . Trace.initialChainState .~ Left initialDistribution
+    defaultCheckOptions
+        & changeInitialWalletValue w1 ((<>) (token1 500))
+        & changeInitialWalletValue w2 ((<>) (token2 500))
 
 mkEscrowParams :: POSIXTime -> Value -> Value -> EscrowParams
 mkEscrowParams startTime p e =