Added basic "Don't add change" test.

Unsure whether it accurately tests whether change isn't added to utxos with datums.

Author: Anteproperispomenon

src/BotPlutusInterface/Balance.hs

@@ -45,7 +45,7 @@ import Data.List ((\\))
 import Data.List qualified as List
 import Data.Map (Map)
 import Data.Map qualified as Map
-import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
+import Data.Maybe (fromMaybe, isJust, mapMaybe)
 import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Text qualified as Text
@@ -104,7 +104,7 @@ balanceTxIO ::
   Eff effs (Either Text Tx)
 balanceTxIO = balanceTxIO' @w defaultBalanceConfig
 
--- | `balanceTxIO'` is more flexible version of `balanceTxIO`, this let us specify custom `BalanceConfig`.
+-- | `balanceTxIO'` is more flexible version of `balanceTxIO`, this lets us specify custom `BalanceConfig`.
 balanceTxIO' ::
   forall (w :: Type) (effs :: [Type -> Type]).
   (Member (PABEffect w) effs) =>
@@ -322,7 +322,7 @@ hasDatum :: TxOut -> Bool
 hasDatum = isJust . txOutDatumHash
 
 hasNoDatum :: TxOut -> Bool
-hasNoDatum = isNothing . txOutDatumHash
+hasNoDatum = not . hasDatum
 
 -- | Add min lovelaces to each tx output
 addLovelaces :: [(TxOut, Integer)] -> Tx -> Tx
@@ -382,8 +382,9 @@ handleNonAdaChange balanceCfg changeAddr utxos tx =
             ( \txout ->
                 Tx.txOutAddress txout == changeAddr
                   && not (justLovelace $ Tx.txOutValue txout)
+                  && hasNoDatum txout
             )
-          else (\txout -> Tx.txOutAddress txout == changeAddr)
+          else (\txout -> Tx.txOutAddress txout == changeAddr && hasNoDatum txout)
       newOutput =
         TxOut
           { txOutAddress = changeAddr

test/Spec/BotPlutusInterface/Balance.hs

@@ -1,6 +1,9 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Spec.BotPlutusInterface.Balance (tests) where
 
-import BotPlutusInterface.Balance (defaultBalanceConfig, withFee)
+import BotPlutusInterface.Balance (balanceTxIO, defaultBalanceConfig, withFee)
 import BotPlutusInterface.Balance qualified as Balance
 import BotPlutusInterface.Effects (PABEffect)
 import Data.Default (Default (def))
@@ -13,11 +16,14 @@ import Ledger.Address (Address, PaymentPubKeyHash (PaymentPubKeyHash))
 import Ledger.Address qualified as Address
 import Ledger.CardanoWallet qualified as Wallet
 import Ledger.Crypto (PubKeyHash)
+import Ledger.Scripts qualified as Scripts
 import Ledger.Tx (Tx (..), TxIn (..), TxInType (..), TxOut (..), TxOutRef (..))
 import Ledger.Value qualified as Value
+import Plutus.V1.Ledger.Api qualified as Api
+import PlutusTx qualified
 import Spec.MockContract (runPABEffectPure)
 import Test.Tasty (TestTree, testGroup)
-import Test.Tasty.HUnit (Assertion, assertFailure, testCase, (@?=))
+import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@?=))
 import Prelude
 
 {- | Tests for 'cardano-cli query utxo' result parsers
@@ -30,33 +36,50 @@ tests =
     [ testCase "Add utxos to cover fees" addUtxosForFees
     , testCase "Add utxos to cover native tokens" addUtxosForNativeTokens
     , testCase "Add utxos to cover change min utxo" addUtxosForChange
+    , testCase "Don't add change to UTxOs with datums" dontAddChangeToDatum
     ]
 
+validator :: Scripts.Validator
+validator =
+  Scripts.mkValidatorScript
+    $$(PlutusTx.compile [||(\_ _ _ -> ())||])
+
+valHash :: Ledger.ValidatorHash
+(Just valHash) = Ledger.toValidatorHash addr3
+
 pkh1, pkh2 :: PubKeyHash
 pkh1 = Address.unPaymentPubKeyHash . Wallet.paymentPubKeyHash $ Wallet.knownMockWallet 1
 pkh2 = Address.unPaymentPubKeyHash . Wallet.paymentPubKeyHash $ Wallet.knownMockWallet 2
 
-addr1, addr2 :: Address
+addr1, addr2, addr3 :: Address
 addr1 = Ledger.pubKeyHashAddress (PaymentPubKeyHash pkh1) Nothing
 addr2 = Ledger.pubKeyHashAddress (PaymentPubKeyHash pkh2) Nothing
+addr3 = Ledger.scriptAddress validator
 
-txOutRef1, txOutRef2, txOutRef3, txOutRef4 :: TxOutRef
+txOutRef1, txOutRef2, txOutRef3, txOutRef4, txOutRef5, txOutRef6, txOutRef7 :: TxOutRef
 txOutRef1 = TxOutRef "384de3f29396fdf687551e3f9e05bd400adcd277720c71f1d2b61f17f5183e51" 0
 txOutRef2 = TxOutRef "52a003b3f4956433429631afe4002f82a924a5a7a891db7ae1f6434797a57dff" 1
 txOutRef3 = TxOutRef "d8a5630a9d7e913f9d186c95e5138a239a4e79ece3414ac894dbf37280944de3" 0
 txOutRef4 = TxOutRef "d8a5630a9d7e913f9d186c95e5138a239a4e79ece3414ac894dbf37280944de3" 2
+txOutRef5 = TxOutRef "52a003b3f4956433429631afe4002f82a924a5a7a891db7ae1f6434797a57dff" 0
+txOutRef6 = TxOutRef "52a003b3f4956433429631afe4002f82a924a5a7a891db7ae1f6434797a57dff" 3
+txOutRef7 = TxOutRef "384de3f29396fdf687551e3f9e05bd400adcd277720c71f1d2b61f17f5183e51" 1
 
-txIn1, txIn2, txIn3, txIn4 :: TxIn
+txIn1, txIn2, txIn3, txIn4, txIn5 :: TxIn
 txIn1 = TxIn txOutRef1 (Just ConsumePublicKeyAddress)
 txIn2 = TxIn txOutRef2 (Just ConsumePublicKeyAddress)
 txIn3 = TxIn txOutRef3 (Just ConsumePublicKeyAddress)
 txIn4 = TxIn txOutRef4 (Just ConsumePublicKeyAddress)
+txIn5 = TxIn txOutRef5 (Just ConsumeSimpleScriptAddress)
 
-utxo1, utxo2, utxo3, utxo4 :: (TxOutRef, TxOut)
+utxo1, utxo2, utxo3, utxo4, utxo5, utxo6, utxo7 :: (TxOutRef, TxOut)
 utxo1 = (txOutRef1, TxOut addr1 (Ada.lovelaceValueOf 1_100_000) Nothing)
 utxo2 = (txOutRef2, TxOut addr1 (Ada.lovelaceValueOf 1_000_000) Nothing)
 utxo3 = (txOutRef3, TxOut addr1 (Ada.lovelaceValueOf 900_000) Nothing)
 utxo4 = (txOutRef4, TxOut addr1 (Ada.lovelaceValueOf 800_000 <> Value.singleton "11223344" "Token" 200) Nothing)
+utxo5 = (txOutRef5, TxOut addr3 (Ada.lovelaceValueOf 900_000) (Just $ Ledger.DatumHash ""))
+utxo6 = (txOutRef6, TxOut addr3 (Value.singleton "11223344" "Token" 200) Nothing)
+utxo7 = (txOutRef2, TxOut addr1 (Ada.lovelaceValueOf 5_000_000) Nothing)
 
 addUtxosForFees :: Assertion
 addUtxosForFees = do
@@ -105,3 +128,34 @@ addUtxosForChange = do
   case ebalancedTx of
     Left e -> assertFailure (Text.unpack e)
     Right balancedTx -> txInputs <$> balancedTx @?= Right (Set.fromList [txIn1, txIn2])
+
+dontAddChangeToDatum :: Assertion
+dontAddChangeToDatum = do
+  let txout = TxOut addr2 (Ada.lovelaceValueOf 1_300_000) Nothing
+      txout2 = snd utxo5
+      txout3 = snd utxo6
+      tx = mempty {txOutputs = [txout, txout2, txout3]} `withFee` 500_000
+      minUtxo = [(txout, 1_000_000), (txout3, 1_100_000)] -- add change to these utxos
+      utxoIndex = Map.fromList [utxo5, utxo3, utxo1, utxo4, utxo7]
+      ownAddr = addr1
+      ebalancedTx =
+        fst $
+          runPABEffectPure def $
+            Balance.balanceTxStep @() @'[PABEffect ()] defaultBalanceConfig minUtxo utxoIndex ownAddr tx
+
+  case ebalancedTx of
+    Left e -> assertFailure (Text.unpack e)
+    Right (Left e) -> assertFailure (Text.unpack e)
+    Right (Right balancedTx) ->
+      assertBool
+        ( "Original UTxO not in output;\n"
+            <> "TxOuts: "
+            <> show (txOutputs balancedTx)
+            <> "\n"
+            <> "TxIns : "
+            <> show (txInputs balancedTx)
+            <> "\n"
+        )
+        $ snd utxo5 `elem` txOutputs balancedTx
+
+-- txIn5 `Set.member` (txInputs balancedTx)