From ed389f0215f17de5dfb2d85cd102b475755ad79b Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Thu, 14 Jul 2022 14:54:25 +0500 Subject: [PATCH 1/3] Set slot's length to 1s for awaiting tx/out status tests to make them stable --- .../src/Plutus/ChainIndex/TxIdState.hs | 1 - plutus-contract/src/Wallet/API.hs | 2 +- .../test/full/Plutus/PAB/CoreSpec.hs | 18 +++++++++++++----- .../test/full/Plutus/PAB/Simulator/Test.hs | 16 +++++++++------- plutus-pab/src/Plutus/PAB/Simulator.hs | 6 +++--- run.sh | 4 ++++ 6 files changed, 30 insertions(+), 17 deletions(-) create mode 100644 run.sh diff --git a/plutus-chain-index-core/src/Plutus/ChainIndex/TxIdState.hs b/plutus-chain-index-core/src/Plutus/ChainIndex/TxIdState.hs index 8ff183b5ba..6ce85444fa 100644 --- a/plutus-chain-index-core/src/Plutus/ChainIndex/TxIdState.hs +++ b/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 = diff --git a/plutus-contract/src/Wallet/API.hs b/plutus-contract/src/Wallet/API.hs index 048bc46e20..61899d7a2b 100644 --- a/plutus-contract/src/Wallet/API.hs +++ b/plutus-contract/src/Wallet/API.hs @@ -125,7 +125,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) diff --git a/plutus-pab-executables/test/full/Plutus/PAB/CoreSpec.hs b/plutus-pab-executables/test/full/Plutus/PAB/CoreSpec.hs index e915098b81..75cd02e548 100644 --- a/plutus-pab-executables/test/full/Plutus/PAB/CoreSpec.hs +++ b/plutus-pab-executables/test/full/Plutus/PAB/CoreSpec.hs @@ -104,6 +104,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 @@ -134,9 +143,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 @@ -183,7 +191,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 @@ -217,7 +225,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 diff --git a/plutus-pab-executables/test/full/Plutus/PAB/Simulator/Test.hs b/plutus-pab-executables/test/full/Plutus/PAB/Simulator/Test.hs index 3f6dbf18f3..5582cb7acd 100644 --- a/plutus-pab-executables/test/full/Plutus/PAB/Simulator/Test.hs +++ b/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) diff --git a/plutus-pab/src/Plutus/PAB/Simulator.hs b/plutus-pab/src/Plutus/PAB/Simulator.hs index eba787c5f5..a1c88f320e 100644 --- a/plutus-pab/src/Plutus/PAB/Simulator.hs +++ b/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 diff --git a/run.sh b/run.sh new file mode 100644 index 0000000000..781c4a0b10 --- /dev/null +++ b/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 From 0b539b82e964acf11fef9d789270fb758ca3fd59 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Wed, 20 Jul 2022 19:20:16 +0500 Subject: [PATCH 2/3] cleanup --- plutus-pab/src/Plutus/PAB/Simulator.hs | 1 - run.sh | 4 ---- 2 files changed, 5 deletions(-) delete mode 100644 run.sh diff --git a/plutus-pab/src/Plutus/PAB/Simulator.hs b/plutus-pab/src/Plutus/PAB/Simulator.hs index a1c88f320e..326e148615 100644 --- a/plutus-pab/src/Plutus/PAB/Simulator.hs +++ b/plutus-pab/src/Plutus/PAB/Simulator.hs @@ -786,7 +786,6 @@ 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 diff --git a/run.sh b/run.sh deleted file mode 100644 index 781c4a0b10..0000000000 --- a/run.sh +++ /dev/null @@ -1,4 +0,0 @@ -#!/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 From 7d2c5fa316a0beff89f382881685f8962eafe0d4 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Wed, 20 Jul 2022 20:04:27 +0500 Subject: [PATCH 3/3] fix --- plutus-contract/src/Wallet/API.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/plutus-contract/src/Wallet/API.hs b/plutus-contract/src/Wallet/API.hs index 61899d7a2b..e1bb5404cc 100644 --- a/plutus-contract/src/Wallet/API.hs +++ b/plutus-contract/src/Wallet/API.hs @@ -64,7 +64,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.List.NonEmpty qualified as NonEmpty import Data.Maybe (mapMaybe) import Data.Text (Text)