regression tests for outputs adjsutment

- see issue #138

Author: mikekeke

test/Spec/Integration.hs

@@ -18,6 +18,7 @@ import Plutus.Contract qualified as Contract
 import Spec.TestContract.AdjustTx (runAdjustTest)
 import Spec.TestContract.AlwaysFail (lockThenFailToSpend)
 import Spec.TestContract.LockSpendMint (lockThenSpend)
+import Spec.TestContract.MintAndPay (zeroAdaOutTestContract)
 import Spec.TestContract.SimpleContracts (
   getUtxos,
   getUtxosThrowsErr,
@@ -26,7 +27,6 @@ import Spec.TestContract.SimpleContracts (
   ownValueToState,
   payTo,
  )
-import Spec.TestContract.MintAndPay (mintAndPayTokens)
 import Spec.TestContract.ValidateTimeRange (failingTimeContract, successTimeContract)
 import Test.Plutip.Contract (
   TestWallets,
@@ -215,21 +215,20 @@ test =
               ]
       , -- Test `adjustUnbalancedTx`
         runAdjustTest
-      , testMintMintAndPay
+      , testBugMintAndPay
       ]
       ++ testValueAssertionsOrderCorrectness
 
--- mint bug
-testMintMintAndPay :: (TestWallets, IO (ClusterEnv, NonEmpty BpiWallet) -> TestTree)
-testMintMintAndPay =
+-- https://github.com/mlabs-haskell/plutip/issues/138
+testBugMintAndPay :: (TestWallets, IO (ClusterEnv, NonEmpty BpiWallet) -> TestTree)
+testBugMintAndPay =
   assertExecution
-    "testMintMintAndPay"
+    "Adjustment of outputs with 0 Ada does not fail"
     (withCollateral $ initAda [1000] <> initAda [1111])
-    (withContract $ \[p1] -> mintAndPayTokens p1)
+    (withContract $ \[p1] -> zeroAdaOutTestContract p1)
     [ shouldSucceed
     ]
 
-
 -- Tests for https://github.com/mlabs-haskell/plutip/issues/84
 testValueAssertionsOrderCorrectness ::
   [(TestWallets, IO (ClusterEnv, NonEmpty BpiWallet) -> TestTree)]

test/Spec/TestContract/MintAndPay.hs

@@ -1,57 +1,67 @@
-module Spec.TestContract.MintAndPay (mintAndPayTokens) where
+module Spec.TestContract.MintAndPay (zeroAdaOutTestContract) where
 
-import Control.Monad (void)
-import Data.List.NonEmpty qualified as NonEmpty
-import Data.Map qualified as Map
 import Data.Text (Text)
 import Ledger (
-  Address,
-  CardanoTx,
-  ChainIndexTxOut,
   CurrencySymbol,
-  PaymentPubKeyHash (PaymentPubKeyHash),
-  ScriptContext (scriptContextTxInfo),
-  TxId,
-  TxInfo (txInfoMint),
-  TxOutRef,
+  PaymentPubKeyHash,
+  ScriptContext,
   getCardanoTxId,
-  scriptHashAddress,
  )
-import Ledger.Ada (adaValueOf)
 import Ledger.Constraints qualified as Constraints
 import Ledger.Scripts qualified as Scripts
-import Ledger.Typed.Scripts (TypedValidator, Validator, ValidatorTypes, mkUntypedMintingPolicy)
+import Ledger.Typed.Scripts (mkUntypedMintingPolicy)
 import Ledger.Typed.Scripts qualified as TypedScripts
-import Ledger.Value (flattenValue, tokenName)
-import Plutus.Contract (Contract, mkTxConstraints, adjustUnbalancedTx, submitTxConfirmed)
--- import Plutus.Contract qualified as Contract
+import Ledger.Value (tokenName)
+import Plutus.Contract (Contract, adjustUnbalancedTx, awaitTxConfirmed, mkTxConstraints, submitTxConfirmed, submitTxConstraintsWith)
+
+import Data.Void (Void)
 import Plutus.PAB.Effects.Contract.Builtin (EmptySchema)
 import Plutus.Script.Utils.V1.Scripts qualified as ScriptUtils
 import Plutus.V1.Ledger.Value qualified as Value
 import PlutusTx qualified
 import PlutusTx.Prelude qualified as PP
 import Prelude
-import Data.Void (Void)
 
+{- This test contract checks that outputs with 0 Ada are hadled properly.
+ BPI does adjustment of ouptupt even w/o explicit `adjustUnbalancedTx`,
+ so this test contract checks bot cases - with implicit and explicit adjustment.
+-}
+zeroAdaOutTestContract :: PaymentPubKeyHash -> Contract () EmptySchema Text ()
+zeroAdaOutTestContract pkh =
+  mintAndPayWithAdjustment 0 pkh
+    >> mintAndPayNoAdjustment 0 pkh
+    >> mintAndPayWithAdjustment 7 pkh
+    >> mintAndPayNoAdjustment 7 pkh
+
+mintAndPayWithAdjustment :: Integer -> PaymentPubKeyHash -> Contract () EmptySchema Text ()
+mintAndPayWithAdjustment tokensAmt pkh = do
+  let token = Value.singleton currencySymbol (tokenName "ff") tokensAmt
+      txc1 =
+        Constraints.mustMintValueWithRedeemer Scripts.unitRedeemer token
+          <> Constraints.mustPayToPubKey pkh token
+      lookups1 = Constraints.plutusV1MintingPolicy mintingPolicy
+
+  utx <- mkTxConstraints @Void lookups1 txc1
+  tx <- adjustUnbalancedTx utx
+  submitTxConfirmed tx
 
-mintAndPayTokens :: PaymentPubKeyHash -> Contract () EmptySchema Text ()
-mintAndPayTokens pkh = do
-      let token = Value.singleton currencySymbol (tokenName "ff") 10
-          txc1 = Constraints.mustMintValueWithRedeemer Scripts.unitRedeemer token
-                  <> Constraints.mustPayToPubKey pkh token
-          lookups1 = Constraints.plutusV1MintingPolicy mintingPolicy
+mintAndPayNoAdjustment :: Integer -> PaymentPubKeyHash -> Contract () EmptySchema Text ()
+mintAndPayNoAdjustment tokensAmt pkh = do
+  let token = Value.singleton currencySymbol (tokenName "ff") tokensAmt
+      txc1 =
+        Constraints.mustMintValueWithRedeemer Scripts.unitRedeemer token
+          <> Constraints.mustPayToPubKey pkh token
+      lookups1 = Constraints.plutusV1MintingPolicy mintingPolicy
 
-      utx <- mkTxConstraints @Void lookups1 txc1
-      tx <- adjustUnbalancedTx utx
-      submitTxConfirmed tx
+  tx <- submitTxConstraintsWith @Void lookups1 txc1
+  awaitTxConfirmed (getCardanoTxId tx)
 
 -- minting policy
 {-# INLINEABLE mkPolicy #-}
 mkPolicy :: () -> ScriptContext -> Bool
 mkPolicy _ _ =
   PP.traceIfFalse "Mint only check" check
   where
-    -- info = scriptContextTxInfo ctx
     check = PP.length someWork PP.== 10
     someWork = PP.sort [9, 8, 7, 6, 5, 4, 3, 2, 1, 0] :: [Integer]