Set slot's length to 1s for awaiting tx/out status tests to make them…

… stable

plutus-chain-index-core/src/Plutus/ChainIndex/TxIdState.hs

@@ -28,7 +28,6 @@ import Plutus.ChainIndex.Types (BlockNumber (..), Depth (..), Point (..), Rollba
 import Plutus.ChainIndex.UtxoState (RollbackFailed (..), RollbackResult (..), UtxoIndex, UtxoState (..), rollbackWith,
                                     tip, utxoState, viewTip)
 
-
 -- | The 'TxStatus' of a transaction right after it was added to the chain
 initialStatus :: OnChainTx -> TxStatus
 initialStatus tx =

plutus-contract/src/Wallet/API.hs

@@ -61,7 +61,6 @@ import Control.Monad (unless, void)
 import Control.Monad.Freer (Eff, Member)
 import Control.Monad.Freer.Error (Error, throwError)
 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, Interval (Interval, ivFrom, ivTo), Params (..), PaymentPubKeyHash, PubKey (PubKey, getPubKey),
@@ -91,7 +90,7 @@ payToPaymentPublicKeyHash ::
     => Params -> SlotRange -> Value -> PaymentPubKeyHash -> Eff effs CardanoTx
 payToPaymentPublicKeyHash params range v pk = do
     let constraints = Constraints.mustPayToPubKey pk v
-                   <> Constraints.mustValidateIn (TimeSlot.slotRangeToPOSIXTimeRange def range)
+                   <> Constraints.mustValidateIn (TimeSlot.slotRangeToPOSIXTimeRange (pSlotConfig params) range)
     utx <- either (throwError . PaymentMkTxError)
                   pure
                   (Constraints.mkTx @Void mempty constraints)

plutus-pab-executables/test/full/Plutus/PAB/CoreSpec.hs

@@ -103,6 +103,15 @@ runScenario sim = do
         Left err -> error (show err)
         Right _  -> pure ()
 
+-- To run scenarios with the slot's length to 1s to make the awaiting tests stable
+runScenarioWithSecondSlot :: Simulation (Builtin TestContracts) a -> IO ()
+runScenarioWithSecondSlot sim = do
+    let params = Ledger.allowBigTransactions def
+    result <- Simulator.runSimulationWithParams params sim
+    case result of
+        Left err -> error (show err)
+        Right _  -> pure ()
+
 defaultWallet :: Wallet
 defaultWallet = knownWallet 1
 
@@ -133,9 +142,8 @@ executionTests =
         , currencyTest
         , testCase "wait for update" waitForUpdateTest
         , testCase "stop contract instance" stopContractInstanceTest
-        -- TODO: Commented temporarly until PR#565 is merged
-        -- , testCase "can wait for tx status change" waitForTxStatusChangeTest
-        -- , testCase "can wait for tx output status change" waitForTxOutStatusChangeTest
+        , testCase "can wait for tx status change" waitForTxStatusChangeTest
+        , testCase "can wait for tx output status change" waitForTxOutStatusChangeTest
         , testCase "can subscribe to slot updates" slotChangeTest
         , testCase "can query wallet funds" valueAtTest
         , testCase "can subscribe to observable state changes" observableStateChangeTest
@@ -182,7 +190,7 @@ slotChangeTest = runScenario $ do
 -- | Testing whether state of a tx correctly goes from 'TentativelyConfirmed'
 -- to 'Committed'.
 waitForTxStatusChangeTest :: IO ()
-waitForTxStatusChangeTest = runScenario $ do
+waitForTxStatusChangeTest = runScenarioWithSecondSlot $ do
   -- Add funds to a wallet and create a new transaction which we will observe
   -- for a status change.
   (w1, pk1) <- Simulator.addWallet
@@ -216,7 +224,7 @@ waitForTxStatusChangeTest = runScenario $ do
 -- | Testing whether state of a tx correctly goes from 'TentativelyConfirmed'
 -- to 'Committed'.
 waitForTxOutStatusChangeTest :: IO ()
-waitForTxOutStatusChangeTest = runScenario $ do
+waitForTxOutStatusChangeTest = runScenarioWithSecondSlot $ do
   -- Add funds to a wallet and create a new transaction which we will observe
   -- for a status change.
   (w1, pk1) <- Simulator.addWallet

plutus-pab-executables/test/full/Plutus/PAB/Simulator/Test.hs

@@ -5,7 +5,7 @@
 A 'Simulator' for the test contracts
 
 -}
-module Plutus.PAB.Simulator.Test(runSimulation) where
+module Plutus.PAB.Simulator.Test(runSimulation, runSimulationWithParams) where
 
 import Control.Monad.Freer (interpret)
 import Data.Default (Default (def))
@@ -20,15 +20,17 @@ import Plutus.PAB.Types (PABError)
 
 -- | Run the PAB simulator with the test contracts
 runSimulation :: Simulation (Builtin TestContracts) a -> IO (Either PABError a)
-runSimulation = runSimulationWith simulatorHandlers
+runSimulation = runSimulationWithParams $
+  allowBigTransactions def { pSlotConfig = def { scSlotLength = 1 } }
+
+-- | Run the PAB simulator with the test contracts with provided params
+runSimulationWithParams :: Params -> Simulation (Builtin TestContracts) a -> IO (Either PABError a)
+runSimulationWithParams params = runSimulationWith (simulatorHandlers params)
 
 -- | 'EffectHandlers' for running the PAB as a simulator (no connectivity to
 --   out-of-process services such as wallet backend, node, etc.)
-simulatorHandlers :: EffectHandlers (Builtin TestContracts) (SimulatorState (Builtin TestContracts))
-simulatorHandlers = mkSimulatorHandlers params handler
+simulatorHandlers :: Params -> EffectHandlers (Builtin TestContracts) (SimulatorState (Builtin TestContracts))
+simulatorHandlers params = mkSimulatorHandlers params handler
   where
-    params :: Params
-    params = allowBigTransactions $ def { pSlotConfig = def { scSlotLength = 1 } }
-
     handler :: SimulatorContractHandler (Builtin TestContracts)
     handler = interpret (contractHandler handleBuiltin)

plutus-pab/src/Plutus/PAB/Simulator.hs

@@ -238,8 +238,7 @@ mkSimulatorHandlers params handleContractEffect =
                 $ interpret (Core.handleBlockchainEnvReader @t @(SimulatorState t))
                 $ advanceClock @t
             Core.waitUntilSlot 1
-        , onShutdown = do
-            handleDelayEffect $ delayThread (500 :: Millisecond) -- need to wait a little to avoid garbled terminal output in GHCi.
+        , onShutdown = handleDelayEffect $ delayThread (500 :: Millisecond) -- need to wait a little to avoid garbled terminal output in GHCi.
         }
 
 handleLogSimulator ::
@@ -341,7 +340,7 @@ activateContract = Core.activateContract
 callEndpointOnInstance :: forall a t. (JSON.ToJSON a) => ContractInstanceId -> String -> a -> Simulation t (Maybe NotificationError)
 callEndpointOnInstance = Core.callEndpointOnInstance'
 
--- | Wait 1 second, then add a new block.
+-- | Wait 1 slot length, then add a new block.
 makeBlock ::
     forall t effs.
     ( LastMember IO effs
@@ -787,6 +786,7 @@ payToWallet source target = payToPaymentPublicKeyHash source (Emulator.mockWalle
 payToPaymentPublicKeyHash :: forall t.  Wallet -> PaymentPubKeyHash -> Value -> Simulation t CardanoTx
 payToPaymentPublicKeyHash source target amount = do
     Instances.BlockchainEnv{beParams} <- Core.askBlockchainEnv @t @(SimulatorState t)
+--    handleDelayEffect $ delayThread (250 :: Millisecond)
     handleAgentThread source Nothing
         $ flip (handleError @WAPI.WalletAPIError) (throwError . WalletError)
         $ WAPI.payToPaymentPublicKeyHash beParams WAPI.defaultSlotRange amount target

run.sh

@@ -0,0 +1,4 @@
+#!/usr/bin/env sh
+until ! LANG=C.UTF-8 cabal test plutus-pab-executables:test:plutus-pab-test-full --test-options="-p \"can wait for tx\""; do
+echo ...;
+done