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..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) @@ -125,7 +124,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 c4242a7203..194ba515a2 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