Add Test that adjustUnbalancedTx works

local-cluster/Main.hs

@@ -37,7 +37,6 @@ main = do
           workingDir = maybe Temporary (`Fixed` False) workDir
           plutipConfig = def {clusterWorkingDir = workingDir}
 
-      putStrLn "Starting cluster..."
       (st, _) <- startCluster plutipConfig $ do
         ws <- initWallets numWallets numUtxos amt dirWallets
         waitSeconds 2 -- let wallet Tx finish, it can take more time with bigger slot length

plutip.cabal

@@ -185,6 +185,7 @@ test-suite plutip-tests
   other-modules:
     Spec.Integration
     Spec.Test.Plutip.BotPlutusInterface
+    Spec.TestContract.AdjustTx
     Spec.TestContract.AlwaysFail
     Spec.TestContract.LockSpendMint
     Spec.TestContract.SimpleContracts

src/Test/Plutip/Internal/LocalCluster.hs

@@ -39,7 +39,7 @@ import Paths_plutip (getDataFileName)
 import Plutus.ChainIndex.App qualified as ChainIndex
 import Plutus.ChainIndex.Config qualified as ChainIndex
 import Plutus.ChainIndex.Logging (defaultConfig)
-import Servant.Client (BaseUrl (BaseUrl), Scheme (Http), mkClientEnv, runClientM)
+import Servant.Client (BaseUrl (BaseUrl), Scheme (Http))
 import System.Directory (canonicalizePath, copyFile, createDirectoryIfMissing, doesPathExist, findExecutable, removeDirectoryRecursive)
 import System.Environment (setEnv)
 import System.Exit (die)
@@ -70,7 +70,7 @@ import Test.Plutip.Internal.Types (
 import Test.Plutip.Tools.CardanoApi qualified as Tools
 import Text.Printf (printf)
 import UnliftIO.Concurrent (forkFinally, myThreadId, throwTo)
-import UnliftIO.Exception (bracket, catchIO, finally, throwString)
+import UnliftIO.Exception (bracket, catchIO, finally)
 import UnliftIO.STM (TVar, atomically, newTVarIO, readTVar, retrySTM, writeTVar)
 
 import Cardano.Wallet.Primitive.Types (
@@ -81,11 +81,7 @@ import Cardano.Wallet.Primitive.Types (
 import Data.Default (Default (def))
 import Data.Function ((&))
 import Data.Time (nominalDiffTimeToSeconds)
-import Ledger (Slot (Slot))
 import Ledger.TimeSlot (SlotConfig (scSlotLength))
-import Network.HTTP.Client (defaultManagerSettings, newManager)
-import Plutus.ChainIndex (Tip (Tip))
-import Plutus.ChainIndex.Client qualified as ChainIndexClient
 import Plutus.ChainIndex.Config qualified as CIC
 import PlutusPrelude ((.~), (^.))
 
@@ -149,7 +145,7 @@ withPlutusInterface conf action = do
     runActionWthSetup rn dir trCluster userActon = do
       let tracer' = trMessageText trCluster
       waitForRelayNode tracer' rn
-      -- launch chain index in separate thread
+      -- launch chain index in seperate thread, logs to stdout
       ciPort <- launchChainIndex conf rn dir
       traceWith tracer' (ChaiIndexStartedAt ciPort)
       let cEnv =
@@ -268,7 +264,6 @@ launchChainIndex conf (RunningNode sp _block0 (netParams, _vData) _) dir = do
   config <- defaultConfig
   CM.setMinSeverity config Severity.Notice
   let dbPath = dir </> "chain-index.db"
-      port = maybe (CIC.cicPort ChainIndex.defaultConfig) fromEnum (chainIndexPort conf)
       chainIndexConfig =
         CIC.defaultConfig
           & CIC.socketPath .~ nodeSocketFile sp
@@ -278,12 +273,12 @@ launchChainIndex conf (RunningNode sp _block0 (netParams, _vData) _) dir = do
           & CIC.slotConfig .~ (def {scSlotLength = toMilliseconds slotLen})
 
   void . async $ void $ ChainIndex.runMainWithLog (const $ return ()) config chainIndexConfig
-  waitForChainIndex port
   return $ chainIndexConfig ^. CIC.port
   where
     toMilliseconds = floor . (1e3 *) . nominalDiffTimeToSeconds
 
     waitForChainIndex port = do
+      let policy = constantDelay 500000 <> limitRetries 50
       let policy = constantDelay 1_000_000 <> limitRetries 60
       recoverAll policy $ \_ -> do
         tip <- queryTipWithChIndex port

src/Test/Plutip/LocalCluster.hs

@@ -92,9 +92,7 @@ withConfiguredCluster conf name testCases =
         traverse
           (traverse addSomeWallet . fmap twInitDistribuition . unTestWallets . fst)
           testCases
-      -- had to bump waiting period here coz of chain-index slowdown,
-      -- see https://github.com/mlabs-haskell/plutip/issues/120
-      waitSeconds 5 -- wait for transactions to submit
+      waitSeconds 2 -- wait for transactions to submit
       pure (env, wallets)
 
 imap :: (Int -> a -> b) -> [a] -> [b]

test/Spec/Integration.hs

@@ -15,6 +15,7 @@ import Plutus.Contract (
   waitNSlots,
  )
 import Plutus.Contract qualified as Contract
+import Spec.TestContract.AdjustTx (runAdjustTest)
 import Spec.TestContract.AlwaysFail (lockThenFailToSpend)
 import Spec.TestContract.LockSpendMint (lockThenSpend)
 import Spec.TestContract.SimpleContracts (
@@ -208,6 +209,8 @@ test =
               [ shouldFail
               , errorSatisfies "Fail validation with 'I always fail'" errCheck
               ]
+      , -- Check for adjusting Txs
+        runAdjustTest
       ]
       ++ testValueAssertionsOrderCorrectness
 

test/Spec/TestContract/AdjustTx.hs

@@ -0,0 +1,89 @@
+module Spec.TestContract.AdjustTx (
+  runAdjustTest,
+) where
+
+import BotPlutusInterface.Contract (runContract)
+import Control.Lens.Operators ((^.))
+import Data.Text (Text)
+import Data.Text qualified as Text
+import Data.Void (Void)
+import Ledger (
+  PaymentPubKeyHash,
+  Tx (..),
+  TxOut (..),
+  getCardanoTxId,
+ )
+import Ledger qualified
+import Ledger.Ada (adaValueOf)
+import Ledger.Ada qualified as Ada
+
+-- import Ledger.Constraints (mkTx)
+import Ledger.Constraints qualified as Constraints
+import Ledger.Constraints.OffChain qualified as OffChain
+import Ledger.Scripts qualified as Scripts
+import Ledger.Typed.Scripts (TypedValidator, Validator, ValidatorTypes, mkUntypedMintingPolicy)
+import Ledger.Typed.Scripts qualified as TypedScripts
+import Ledger.Value (Value, flattenValue, tokenName)
+import Ledger.Value qualified
+import Plutus.Contract (
+  Contract,
+  ContractError (ConstraintResolutionContractError),
+  adjustUnbalancedTx,
+  awaitTxConfirmed,
+  mkTxConstraints,
+  submitTx,
+  submitTxConstraintsWith,
+  submitUnbalancedTx,
+  utxosAt,
+ )
+import Plutus.Contract qualified as Contract
+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 Test.Plutip.Contract
+import Test.Plutip.Predicate (
+  shouldSucceed,
+  yieldSatisfies,
+ )
+import Prelude
+
+adjustTx :: PaymentPubKeyHash -> Contract () EmptySchema Text [Value]
+adjustTx toPkh = do
+  ownPkh <- Contract.ownPaymentPubKeyHash
+  let ownAddr = Ledger.pubKeyHashAddress ownPkh Nothing
+  utxos <- Contract.utxosAt ownAddr
+  let consts =
+        Constraints.mustPayToPubKey toPkh (Ada.lovelaceValueOf 50)
+      lkups =
+        Constraints.ownPaymentPubKeyHash ownPkh
+          <> Constraints.unspentOutputs utxos
+  unbalancedTx <- mkTxConstraints @Void lkups consts
+  -- Adjust the Tx so that all UTxOs have the minimum ADA.
+  adjustedTx <- adjustUnbalancedTx unbalancedTx
+  let rawTx = adjustedTx ^. OffChain.tx
+      vals = map txOutValue $ txOutputs rawTx
+  -- crdTx <- submitUnbalancedTx adjustedTx
+  balTx <- Contract.balanceTx adjustedTx
+  crdTx <- Contract.submitBalancedTx balTx
+  _ <- Contract.awaitTxConfirmed (getCardanoTxId crdTx)
+  pure vals
+
+adjustTx' :: [PaymentPubKeyHash] -> Contract () EmptySchema Text [Value]
+adjustTx' [] = do
+  pkh <- Contract.ownPaymentPubKeyHash
+  adjustTx pkh
+adjustTx' (pkh : _) = adjustTx pkh
+
+-- The actual test
+runAdjustTest =
+  assertExecution
+    "Adjust Unbalanced Tx Contract"
+    (initAda [1000] <> initAda [1000])
+    (withContract adjustTx')
+    [ shouldSucceed
+    , yieldSatisfies
+        "All UTxOs have minimum ADA."
+        (all (\val -> 2_000_000 <= Ada.getLovelace (Ada.fromValue val)))
+    ]