Check if the desired status was reached

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

@@ -188,7 +188,7 @@ waitForTxStatusChangeTest = runScenario $ do
   (w1, pk1) <- Simulator.addWallet
   Simulator.waitNSlots 1
   tx <- Simulator.payToPaymentPublicKeyHash w1 pk1 (lovelaceValueOf 100_000_000)
-  txStatus <- Simulator.waitForTxStatusChange (getCardanoTxId tx)
+  txStatus <- Simulator.waitForTxStatus (getCardanoTxId tx) (TentativelyConfirmed 1 TxValid ())
   assertEqual "tx should be tentatively confirmed of depth 1"
               (TentativelyConfirmed 1 TxValid ())
               txStatus
@@ -197,7 +197,7 @@ waitForTxStatusChangeTest = runScenario $ do
   -- increment the block number.
   void $ Simulator.payToPaymentPublicKeyHash w1 pk1 (Ada.toValue Ledger.minAdaTxOut)
   Simulator.waitNSlots 1
-  txStatus' <- Simulator.waitForTxStatusChange (getCardanoTxId tx)
+  txStatus' <- Simulator.waitForTxStatus (getCardanoTxId tx) (TentativelyConfirmed 2 TxValid ())
   assertEqual "tx should be tentatively confirmed of depth 2"
               (TentativelyConfirmed 2 TxValid ())
               txStatus'
@@ -208,7 +208,7 @@ waitForTxStatusChangeTest = runScenario $ do
     void $ Simulator.payToPaymentPublicKeyHash w1 pk1 (Ada.toValue Ledger.minAdaTxOut)
     Simulator.waitNSlots 1
 
-  txStatus'' <- Simulator.waitForTxStatusChange (getCardanoTxId tx)
+  txStatus'' <- Simulator.waitForTxStatus (getCardanoTxId tx) (Committed TxValid ())
   assertEqual "tx should be committed"
               (Committed TxValid ())
               txStatus''
@@ -235,11 +235,11 @@ waitForTxOutStatusChangeTest = runScenario $ do
                 $ fmap snd
                 $ filter (\(txOut, txOutref) -> toPubKeyHash (txOutAddress txOut) == Just (unPaymentPubKeyHash pk2))
                 $ getCardanoTxOutRefs tx
-  txOutStatus1 <- Simulator.waitForTxOutStatusChange txOutRef1
+  txOutStatus1 <- Simulator.waitForTxOutStatus txOutRef1 (TentativelyConfirmed 1 TxValid Unspent)
   assertEqual "tx output 1 should be tentatively confirmed of depth 1"
               (TentativelyConfirmed 1 TxValid Unspent)
               txOutStatus1
-  txOutStatus2 <- Simulator.waitForTxOutStatusChange txOutRef2
+  txOutStatus2 <- Simulator.waitForTxOutStatus txOutRef2 (TentativelyConfirmed 1 TxValid Unspent)
   assertEqual "tx output 2 should be tentatively confirmed of depth 1"
               (TentativelyConfirmed 1 TxValid Unspent)
               txOutStatus2
@@ -248,11 +248,11 @@ waitForTxOutStatusChangeTest = runScenario $ do
   -- increment the block number.
   tx2 <- Simulator.payToPaymentPublicKeyHash w1 pk1 (Ada.toValue Ledger.minAdaTxOut)
   Simulator.waitNSlots 1
-  txOutStatus1' <- Simulator.waitForTxOutStatusChange txOutRef1
+  txOutStatus1' <- Simulator.waitForTxOutStatus txOutRef1 (TentativelyConfirmed 1 TxValid (Spent $ getCardanoTxId tx2))
   assertEqual "tx output 1 should be tentatively confirmed of depth 1"
               (TentativelyConfirmed 1 TxValid (Spent $ getCardanoTxId tx2))
               txOutStatus1'
-  txOutStatus2' <- Simulator.waitForTxOutStatusChange txOutRef2
+  txOutStatus2' <- Simulator.waitForTxOutStatus txOutRef2 (TentativelyConfirmed 2 TxValid Unspent)
   assertEqual "tx output 2 should be tentatively confirmed of depth 2"
               (TentativelyConfirmed 2 TxValid Unspent)
               txOutStatus2'
@@ -263,12 +263,11 @@ waitForTxOutStatusChangeTest = runScenario $ do
     void $ Simulator.payToPaymentPublicKeyHash w1 pk1 (Ada.toValue Ledger.minAdaTxOut)
     Simulator.waitNSlots 1
 
-  let oldStatus = (TentativelyConfirmed 8 TxValid (Spent $ getCardanoTxId tx2))
-  txOutStatus1'' <- Simulator.waitForTxOutStatusChange' oldStatus txOutRef1
+  txOutStatus1'' <- Simulator.waitForTxOutStatus txOutRef1 (Committed TxValid (Spent $ getCardanoTxId tx2))
   assertEqual "tx output 1 should be committed"
               (Committed TxValid (Spent $ getCardanoTxId tx2))
               txOutStatus1''
-  txOutStatus2'' <- Simulator.waitForTxOutStatusChange txOutRef2
+  txOutStatus2'' <- Simulator.waitForTxOutStatus txOutRef2 (Committed TxValid Unspent)
   assertEqual "tx output 2 should be committed"
               (Committed TxValid Unspent)
               txOutStatus2''
@@ -285,7 +284,7 @@ valueAtTest = runScenario $ do
 
     tx <- Simulator.payToPaymentPublicKeyHash defaultWallet mockWalletPubKeyHash payment
     -- Waiting for the tx to be confirmed
-    void $ Core.waitForTxStatusChange $ getCardanoTxId tx
+    void $ Core.waitForTxStatusChange (getCardanoTxId tx)
     finalValue <- Core.valueAt defaultWallet
     let difference = initialValue <> inv finalValue
     assertEqual "defaultWallet should make a payment" difference (payment <> getCardanoTxFee tx)

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

@@ -56,9 +56,10 @@ module Plutus.PAB.Core
     , instanceState
     , observableState
     , waitForState
+    , waitForTxStatus
     , waitForTxStatusChange
+    , waitForTxOutStatus
     , waitForTxOutStatusChange
-    , waitForTxOutStatusChange'
     , activeEndpoints
     , waitForEndpoint
     , yieldedExportTxs
@@ -509,23 +510,29 @@ waitForState extract instanceId = do
         state <- stm
         maybe STM.retry pure (extract state)
 
+-- | Wait for the transaction to be confirmed on the blockchain.
+waitForTxStatus :: forall t env. TxId -> TxStatus -> PABAction t env TxStatus
+waitForTxStatus t status = do
+    env <- asks @(PABEnvironment t env) blockchainEnv
+    liftIO $ STM.atomically $ Instances.waitForTxStatus status t env
+
 -- | Wait for the transaction to be confirmed on the blockchain.
 waitForTxStatusChange :: forall t env. TxId -> PABAction t env TxStatus
 waitForTxStatusChange t = do
     env <- asks @(PABEnvironment t env) blockchainEnv
     liftIO $ STM.atomically $ Instances.waitForTxStatusChange Unknown t env
 
--- | Wait for the transaction output to be confirmed on the blockchain.
-waitForTxOutStatusChange :: forall t env. TxOutRef -> PABAction t env TxOutStatus
-waitForTxOutStatusChange t = do
+-- | Wait until the status of the transaction changes to the given status
+waitForTxOutStatus :: forall t env. TxOutRef -> TxOutStatus -> PABAction t env TxOutStatus
+waitForTxOutStatus t status = do
     env <- asks @(PABEnvironment t env) blockchainEnv
-    liftIO $ STM.atomically $ Instances.waitForTxOutStatusChange Unknown t env
+    liftIO $ STM.atomically $ Instances.waitForTxOutStatus status t env
 
 -- | Wait until the status of the transaction changes from the given status
-waitForTxOutStatusChange' :: forall t env. TxOutStatus -> TxOutRef -> PABAction t env TxOutStatus
-waitForTxOutStatusChange' oldStatus t = do
+waitForTxOutStatusChange :: forall t env. TxOutRef -> PABAction t env TxOutStatus
+waitForTxOutStatusChange t = do
     env <- asks @(PABEnvironment t env) blockchainEnv
-    liftIO $ STM.atomically $ Instances.waitForTxOutStatusChange oldStatus t env
+    liftIO $ STM.atomically $ Instances.waitForTxOutStatusChange Unknown t env
 
 -- | The list of endpoints that are currently open
 activeEndpoints :: forall t env. ContractInstanceId -> PABAction t env (STM [OpenEndpoint])

plutus-pab/src/Plutus/PAB/Core/ContractInstance/STM.hs

@@ -13,7 +13,9 @@ module Plutus.PAB.Core.ContractInstance.STM(
     , awaitSlot
     , awaitTime
     , awaitEndpointResponse
+    , waitForTxStatus
     , waitForTxStatusChange
+    , waitForTxOutStatus
     , waitForTxOutStatusChange
     , currentSlot
     , lastSyncedBlockSlot
@@ -393,32 +395,48 @@ finalResult instanceId m = do
 insertInstance :: ContractInstanceId -> InstanceState -> InstancesState -> STM ()
 insertInstance instanceID state (InstancesState m) = STM.modifyTVar m (Map.insert instanceID state)
 
+-- | Wait for the status of a transaction to change to the given status.
+waitForTxStatus :: TxStatus -> TxId -> BlockchainEnv -> STM TxStatus
+waitForTxStatus status = waitForTxStatusCheck (\s -> s == status)
+
 -- | Wait for the status of a transaction to change.
 waitForTxStatusChange :: TxStatus -> TxId -> BlockchainEnv -> STM TxStatus
-waitForTxStatusChange oldStatus tx BlockchainEnv{beTxChanges, beLastSyncedBlockNo} = do
+waitForTxStatusChange status = waitForTxStatusCheck (\s -> s /= status)
+
+-- | Wait for the status of a transaction to satisfy the check.
+waitForTxStatusCheck :: (TxStatus -> Bool) -> TxId -> BlockchainEnv -> STM TxStatus
+waitForTxStatusCheck check tx BlockchainEnv{beTxChanges, beLastSyncedBlockNo} = do
     txIdState   <- _usTxUtxoData . utxoState <$> STM.readTVar beTxChanges
     blockNumber <- STM.readTVar beLastSyncedBlockNo
     let txStatus = transactionStatus blockNumber txIdState tx
-    -- Succeed only if we _found_ a status and it was different; if
+    -- Succeed only if we _found_ a status and it satisfies the check; if
     -- the status hasn't changed, _or_ there was an error computing
     -- the status, keep retrying.
     case txStatus of
-      Right s | s /= oldStatus -> pure s
-      _                        -> empty
+      Right s | check s -> pure s
+      _                 -> empty
+
+-- | Wait for the status of a transaction output to change to the given status.
+waitForTxOutStatus :: TxOutStatus -> TxOutRef -> BlockchainEnv -> STM TxOutStatus
+waitForTxOutStatus status = waitForTxOutStatusCheck (\s -> s == status)
 
 -- | Wait for the status of a transaction output to change.
 waitForTxOutStatusChange :: TxOutStatus -> TxOutRef -> BlockchainEnv -> STM TxOutStatus
-waitForTxOutStatusChange oldStatus txOutRef BlockchainEnv{beTxChanges, beTxOutChanges, beLastSyncedBlockNo} = do
+waitForTxOutStatusChange status = waitForTxOutStatusCheck (\s -> s /= status)
+
+-- | Wait for the status of a transaction output to satisfy the check.
+waitForTxOutStatusCheck :: (TxOutStatus -> Bool) -> TxOutRef -> BlockchainEnv -> STM TxOutStatus
+waitForTxOutStatusCheck check txOutRef BlockchainEnv{beTxChanges, beTxOutChanges, beLastSyncedBlockNo} = do
     txIdState   <- _usTxUtxoData . utxoState <$> STM.readTVar beTxChanges
     txOutBalance <- _usTxUtxoData . utxoState <$> STM.readTVar beTxOutChanges
     blockNumber   <- STM.readTVar beLastSyncedBlockNo
     let txOutStatus = transactionOutputStatus blockNumber txIdState txOutBalance txOutRef
-    -- Succeed only if we _found_ a status and it was different; if
+    -- Succeed only if we _found_ a status and it satisfies the check; if
     -- the status hasn't changed, _or_ there was an error computing
     -- the status, keep retrying.
     case txOutStatus of
-      Right s | s /= oldStatus -> pure s
-      _                        -> empty
+      Right s | check s -> pure s
+      _                 -> empty
 
 -- | The current slot number
 currentSlot :: BlockchainEnv -> STM Slot

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

@@ -48,9 +48,10 @@ module Plutus.PAB.Simulator(
     , waitForState
     , activeEndpoints
     , waitForEndpoint
+    , waitForTxStatus
     , waitForTxStatusChange
+    , waitForTxOutStatus
     , waitForTxOutStatusChange
-    , waitForTxOutStatusChange'
     , currentSlot
     , waitUntilSlot
     , waitNSlots
@@ -398,18 +399,22 @@ finalResult = Core.finalResult
 waitUntilFinished :: forall t. ContractInstanceId -> Simulation t (Maybe JSON.Value)
 waitUntilFinished = Core.waitUntilFinished
 
+-- | Wait until the status of the transaction changes to the given status
+waitForTxStatus :: forall t. TxId -> TxStatus -> Simulation t TxStatus
+waitForTxStatus = Core.waitForTxStatus
+
 -- | Wait until the status of the transaction changes
 waitForTxStatusChange :: forall t. TxId -> Simulation t TxStatus
 waitForTxStatusChange = Core.waitForTxStatusChange
 
+-- | Wait until the status of the transaction changes from the given status
+waitForTxOutStatus :: forall t. TxOutRef -> TxOutStatus -> Simulation t TxOutStatus
+waitForTxOutStatus = Core.waitForTxOutStatus
+
 -- | Wait until the status of the transaction changes
 waitForTxOutStatusChange :: forall t. TxOutRef -> Simulation t TxOutStatus
 waitForTxOutStatusChange = Core.waitForTxOutStatusChange
 
--- | Wait until the status of the transaction changes from the given status
-waitForTxOutStatusChange' :: forall t. TxOutStatus -> TxOutRef -> Simulation t TxOutStatus
-waitForTxOutStatusChange' = Core.waitForTxOutStatusChange'
-
 -- | Wait until the endpoint becomes active.
 waitForEndpoint :: forall t. ContractInstanceId -> String -> Simulation t ()
 waitForEndpoint = Core.waitForEndpoint