{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DerivingVia         #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE MonoLocalBinds      #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeOperators       #-}

{-

Start the threads for contract instances

-}
module Plutus.PAB.Core.ContractInstance(
    RequestHandlers.ContractInstanceMsg(..)
    , activateContractSTM
    , activateContractSTM'
    , initContractInstanceState
    , ContractInstanceState(..)
    , updateState
    -- * STM instances
    , startSTMInstanceThread
    , startContractInstanceThread'
    , AppBackendConstraints
    -- * Calling endpoints
    , callEndpointOnInstance
    -- * Indexed block
    ) where

import Control.Applicative (Alternative (empty, (<|>)))
import Control.Arrow ((>>>))
import Control.Concurrent (forkIO)
import Control.Concurrent.STM (STM)
import Control.Concurrent.STM qualified as STM
import Control.Lens (preview)
import Control.Lens.Operators
import Control.Monad (forM_)
import Control.Monad.Freer (Eff, LastMember, Member, raise, type (~>))
import Control.Monad.Freer.Error (Error)
import Control.Monad.Freer.Extras.Log (LogMessage, LogMsg, LogObserve, logDebug, logInfo)
import Control.Monad.Freer.NonDet (NonDet)
import Control.Monad.Freer.Reader (Reader, ask, runReader)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Aeson (Value)
import Data.IORef (IORef, readIORef)
import Data.Maybe (fromMaybe)
import Data.Monoid (Sum (Sum))
import Data.Proxy (Proxy (Proxy))
import Data.Text qualified as Text
import Ledger (TxId, TxOutRef (..))
import Marconi.Core.Index.VSplit qualified as Ix
import Plutus.ChainIndex (ChainIndexQueryEffect, Depth (..), RollbackState (..), TxConfirmedState (..), TxOutState (..),
                          TxOutStatus, TxStatus, TxValidity (..), transactionOutputState)
import Plutus.ChainIndex.UtxoState (UtxoState (_usTxUtxoData), utxoState)
import Plutus.Contract.Effects (ActiveEndpoint (aeDescription),
                                PABReq (AwaitUtxoProducedReq, AwaitUtxoSpentReq, ExposeEndpointReq),
                                PABResp (AwaitSlotResp, AwaitTimeResp, AwaitTxOutStatusChangeResp, AwaitTxStatusChangeResp, AwaitUtxoProducedResp, AwaitUtxoSpentResp, ExposeEndpointResp))
import Plutus.Contract.Effects qualified as Contract.Effects
import Plutus.Contract.Resumable (Request (Request, itID, rqID, rqRequest), Response (Response))
import Plutus.Contract.State (ContractResponse (ContractResponse, err, hooks, newState), State (State, observableState))
import Plutus.Contract.Trace qualified as RequestHandler
import Plutus.Contract.Trace.RequestHandler (RequestHandler (RequestHandler), RequestHandlerLogMsg, extract,
                                             maybeToHandler, tryHandler', wrapHandler)
import Plutus.PAB.Core.ContractInstance.RequestHandlers (ContractInstanceMsg (ActivatedContractInstance, HandlingRequests, InitialisingContract))
import Plutus.PAB.Core.ContractInstance.RequestHandlers qualified as RequestHandlers
import Plutus.PAB.Core.ContractInstance.STM (Activity (Done, Stopped), BlockchainEnv (..),
                                             InstanceState (InstanceState, issStop), InstancesState,
                                             callEndpointOnInstance, emptyInstanceState)
import Plutus.PAB.Core.ContractInstance.STM qualified as InstanceState
import Plutus.PAB.Core.Indexer.TxConfirmationStatus (TCSIndex)
import Plutus.PAB.Effects.Contract (ContractEffect, ContractStore, PABContract (ContractDef, serialisableState))
import Plutus.PAB.Effects.Contract qualified as Contract
import Plutus.PAB.Effects.UUID (UUIDEffect, uuidNextRandom)
import Plutus.PAB.Events.Contract (ContractInstanceId (ContractInstanceId))
import Plutus.PAB.Types (PABError)
import Plutus.PAB.Webserver.Types (ContractActivationArgs (ContractActivationArgs, caID, caWallet))
import Wallet.Effects (NodeClientEffect, WalletEffect)
import Wallet.Emulator.LogMessages (TxBalanceMsg)
import Wallet.Emulator.Wallet qualified as Wallet

-- | Container for holding a few bits of state related to the contract
-- instance that we may want to pass in.
data ContractInstanceState t =
  ContractInstanceState
    { ContractInstanceState t -> State t
contractState :: Contract.State t
    , ContractInstanceState t -> STM InstanceState
stmState      :: STM InstanceState
    }

-- | Create a new instance of the contract, but where the
-- activeContractInstanceId and the initial state are provided.
activateContractSTM' ::
    forall t m appBackend effs.
    ( Member (LogMsg (ContractInstanceMsg t)) effs
    , Member (ContractStore t) effs
    , Member (Reader InstancesState) effs
    , Contract.PABContract t
    , AppBackendConstraints t m appBackend
    , LastMember m (Reader ContractInstanceId ': appBackend)
    , LastMember m effs
    )
    => ContractInstanceState t
    -> ContractInstanceId
    -> (ContractInstanceId -> Eff appBackend ~> IO)
    -> ContractActivationArgs (ContractDef t)
    -> Eff effs ContractInstanceId
activateContractSTM' :: ContractInstanceState t
-> ContractInstanceId
-> (ContractInstanceId -> Eff appBackend ~> IO)
-> ContractActivationArgs (ContractDef t)
-> Eff effs ContractInstanceId
activateContractSTM' c :: ContractInstanceState t
c@ContractInstanceState{State t
contractState :: State t
contractState :: forall t. ContractInstanceState t -> State t
contractState} ContractInstanceId
activeContractInstanceId ContractInstanceId -> Eff appBackend ~> IO
runAppBackend a :: ContractActivationArgs (ContractDef t)
a@ContractActivationArgs{ContractDef t
caID :: ContractDef t
caID :: forall t. ContractActivationArgs t -> t
caID, Maybe Wallet
caWallet :: Maybe Wallet
caWallet :: forall t. ContractActivationArgs t -> Maybe Wallet
caWallet} = do
  forall (effs :: [* -> *]).
Member (LogMsg (ContractInstanceMsg t)) effs =>
ContractInstanceMsg t -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logInfo @(ContractInstanceMsg t) (ContractInstanceMsg t -> Eff effs ())
-> ContractInstanceMsg t -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ ContractDef t -> ContractInstanceId -> ContractInstanceMsg t
forall t.
ContractDef t -> ContractInstanceId -> ContractInstanceMsg t
InitialisingContract ContractDef t
caID ContractInstanceId
activeContractInstanceId
  ContractActivationArgs (ContractDef t)
-> ContractInstanceId -> Eff effs ()
forall t (effs :: [* -> *]).
Member (ContractStore t) effs =>
ContractActivationArgs (ContractDef t)
-> ContractInstanceId -> Eff effs ()
Contract.putStartInstance @t ContractActivationArgs (ContractDef t)
a ContractInstanceId
activeContractInstanceId
  ContractActivationArgs (ContractDef t)
-> ContractInstanceId -> State t -> Eff effs ()
forall t (effs :: [* -> *]).
Member (ContractStore t) effs =>
ContractActivationArgs (ContractDef t)
-> ContractInstanceId -> State t -> Eff effs ()
Contract.putState @t ContractActivationArgs (ContractDef t)
a ContractInstanceId
activeContractInstanceId State t
contractState
  ContractInstanceId
cid <- ContractInstanceState t
-> ContractInstanceId
-> (ContractInstanceId -> Eff appBackend ~> IO)
-> ContractActivationArgs (ContractDef t)
-> Eff effs ContractInstanceId
forall t (m :: * -> *) (appBackend :: [* -> *]) (effs :: [* -> *]).
(Member (Reader InstancesState) effs, PABContract t,
 AppBackendConstraints t m appBackend,
 LastMember m (Reader ContractInstanceId : appBackend),
 LastMember m effs) =>
ContractInstanceState t
-> ContractInstanceId
-> (ContractInstanceId -> Eff appBackend ~> IO)
-> ContractActivationArgs (ContractDef t)
-> Eff effs ContractInstanceId
startContractInstanceThread' ContractInstanceState t
c ContractInstanceId
activeContractInstanceId ContractInstanceId -> Eff appBackend ~> IO
runAppBackend ContractActivationArgs (ContractDef t)
a
  let wallet :: Wallet
wallet = Wallet -> Maybe Wallet -> Wallet
forall a. a -> Maybe a -> a
fromMaybe (Integer -> Wallet
Wallet.knownWallet Integer
1) Maybe Wallet
caWallet
  forall (effs :: [* -> *]).
Member (LogMsg (ContractInstanceMsg t)) effs =>
ContractInstanceMsg t -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logInfo @(ContractInstanceMsg t) (ContractInstanceMsg t -> Eff effs ())
-> ContractInstanceMsg t -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ ContractDef t
-> Wallet -> ContractInstanceId -> ContractInstanceMsg t
forall t.
ContractDef t
-> Wallet -> ContractInstanceId -> ContractInstanceMsg t
ActivatedContractInstance ContractDef t
caID Wallet
wallet ContractInstanceId
activeContractInstanceId
  ContractInstanceId -> Eff effs ContractInstanceId
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContractInstanceId
cid

-- | Spin up the STM Instance thread for the provided contract and add it to
-- the STM instance state.
startContractInstanceThread' ::
    forall t m appBackend effs.
    ( Member (Reader InstancesState) effs
    , Contract.PABContract t
    , AppBackendConstraints t m appBackend
    , LastMember m (Reader ContractInstanceId ': appBackend)
    , LastMember m effs
    )
    => ContractInstanceState t
    -> ContractInstanceId
    -> (ContractInstanceId -> Eff appBackend ~> IO)
    -> ContractActivationArgs (ContractDef t)
    -> Eff effs ContractInstanceId
startContractInstanceThread' :: ContractInstanceState t
-> ContractInstanceId
-> (ContractInstanceId -> Eff appBackend ~> IO)
-> ContractActivationArgs (ContractDef t)
-> Eff effs ContractInstanceId
startContractInstanceThread' ContractInstanceState{STM InstanceState
stmState :: STM InstanceState
stmState :: forall t. ContractInstanceState t -> STM InstanceState
stmState} ContractInstanceId
activeContractInstanceId ContractInstanceId -> Eff appBackend ~> IO
runAppBackend ContractActivationArgs (ContractDef t)
a = do
  InstanceState
s <- STM InstanceState
-> (ContractInstanceId -> Eff appBackend ~> IO)
-> ContractActivationArgs (ContractDef t)
-> ContractInstanceId
-> Eff effs InstanceState
forall t (m :: * -> *) (appBackend :: [* -> *]) (effs :: [* -> *]).
(LastMember m effs, PABContract t,
 AppBackendConstraints t m appBackend,
 LastMember
   m
   (Reader InstanceState : Reader ContractInstanceId : appBackend)) =>
STM InstanceState
-> (ContractInstanceId -> Eff appBackend ~> IO)
-> ContractActivationArgs (ContractDef t)
-> ContractInstanceId
-> Eff effs InstanceState
startSTMInstanceThread'
    @t @m STM InstanceState
stmState ContractInstanceId -> Eff appBackend ~> IO
runAppBackend ContractActivationArgs (ContractDef t)
a ContractInstanceId
activeContractInstanceId
  Eff effs InstancesState
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask Eff effs InstancesState
-> (InstancesState -> Eff effs ()) -> Eff effs ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Eff effs ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff effs ())
-> (InstancesState -> IO ()) -> InstancesState -> Eff effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractInstanceId -> InstanceState -> InstancesState -> IO ()
InstanceState.insertInstance ContractInstanceId
activeContractInstanceId InstanceState
s
  ContractInstanceId -> Eff effs ContractInstanceId
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContractInstanceId
activeContractInstanceId

-- | Create a new instance of the contract
activateContractSTM ::
    forall t m appBackend effs.
    ( Member (LogMsg (ContractInstanceMsg t)) effs
    , Member UUIDEffect effs
    , Member (ContractEffect t) effs
    , Member (ContractStore t) effs
    , Member (Reader InstancesState) effs
    , Contract.PABContract t
    , AppBackendConstraints t m appBackend
    , LastMember m (Reader ContractInstanceId ': appBackend)
    , LastMember m effs
    )
    => (ContractInstanceId -> Eff appBackend ~> IO)
    -> ContractActivationArgs (ContractDef t)
    -> Eff effs ContractInstanceId
activateContractSTM :: (ContractInstanceId -> Eff appBackend ~> IO)
-> ContractActivationArgs (ContractDef t)
-> Eff effs ContractInstanceId
activateContractSTM ContractInstanceId -> Eff appBackend ~> IO
runAppBackend ContractActivationArgs (ContractDef t)
a = do
  (ContractInstanceId
cid, ContractInstanceState t
initState) <- ContractActivationArgs (ContractDef t)
-> Eff effs (ContractInstanceId, ContractInstanceState t)
forall t (effs :: [* -> *]).
(Member UUIDEffect effs, Member (ContractEffect t) effs,
 PABContract t) =>
ContractActivationArgs (ContractDef t)
-> Eff effs (ContractInstanceId, ContractInstanceState t)
initContractInstanceState ContractActivationArgs (ContractDef t)
a
  ContractInstanceState t
-> ContractInstanceId
-> (ContractInstanceId -> Eff appBackend ~> IO)
-> ContractActivationArgs (ContractDef t)
-> Eff effs ContractInstanceId
forall t (m :: * -> *) (appBackend :: [* -> *]) (effs :: [* -> *]).
(Member (LogMsg (ContractInstanceMsg t)) effs,
 Member (ContractStore t) effs, Member (Reader InstancesState) effs,
 PABContract t, AppBackendConstraints t m appBackend,
 LastMember m (Reader ContractInstanceId : appBackend),
 LastMember m effs) =>
ContractInstanceState t
-> ContractInstanceId
-> (ContractInstanceId -> Eff appBackend ~> IO)
-> ContractActivationArgs (ContractDef t)
-> Eff effs ContractInstanceId
activateContractSTM' @t @m @appBackend @effs ContractInstanceState t
initState ContractInstanceId
cid ContractInstanceId -> Eff appBackend ~> IO
runAppBackend ContractActivationArgs (ContractDef t)
a

-- | Build a new ContractInstanceState and return it, along with
-- the corresponding new intsance id.
initContractInstanceState ::
    forall t effs.
    ( Member UUIDEffect effs
    , Member (ContractEffect t) effs
    , Contract.PABContract t
    )
    => ContractActivationArgs (ContractDef t)
    -> Eff effs (ContractInstanceId, ContractInstanceState t)
initContractInstanceState :: ContractActivationArgs (ContractDef t)
-> Eff effs (ContractInstanceId, ContractInstanceState t)
initContractInstanceState ContractActivationArgs{ContractDef t
caID :: ContractDef t
caID :: forall t. ContractActivationArgs t -> t
caID} = do
  ContractInstanceId
activeContractInstanceId <- UUID -> ContractInstanceId
ContractInstanceId (UUID -> ContractInstanceId)
-> Eff effs UUID -> Eff effs ContractInstanceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff effs UUID
forall (effs :: [* -> *]). Member UUIDEffect effs => Eff effs UUID
uuidNextRandom
  State t
initialState <- ContractInstanceId -> ContractDef t -> Eff effs (State t)
forall t (effs :: [* -> *]).
(Member (ContractEffect t) effs, PABContract t) =>
ContractInstanceId -> ContractDef t -> Eff effs (State t)
Contract.initialState @t ContractInstanceId
activeContractInstanceId ContractDef t
caID
  (ContractInstanceId, ContractInstanceState t)
-> Eff effs (ContractInstanceId, ContractInstanceState t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ContractInstanceId
activeContractInstanceId, State t -> STM InstanceState -> ContractInstanceState t
forall t. State t -> STM InstanceState -> ContractInstanceState t
ContractInstanceState State t
initialState STM InstanceState
emptyInstanceState)

processAwaitSlotRequestsSTM ::
    forall effs.
    ( Member (Reader BlockchainEnv) effs
    )
    => RequestHandler effs PABReq (STM PABResp)
processAwaitSlotRequestsSTM :: RequestHandler effs PABReq (STM PABResp)
processAwaitSlotRequestsSTM =
    (PABReq -> Maybe Slot) -> RequestHandler effs PABReq Slot
forall req resp (effs :: [* -> *]).
(req -> Maybe resp) -> RequestHandler effs req resp
maybeToHandler (Prism' PABReq Slot -> PABReq -> Maybe Slot
forall (f :: * -> *) a b. Alternative f => Prism' a b -> a -> f b
extract Prism' PABReq Slot
Contract.Effects._AwaitSlotReq)
    RequestHandler effs PABReq Slot
-> RequestHandler effs Slot (STM PABResp)
-> RequestHandler effs PABReq (STM PABResp)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((Slot -> Eff (NonDet : effs) (STM PABResp))
-> RequestHandler effs Slot (STM PABResp)
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((Slot -> Eff (NonDet : effs) (STM PABResp))
 -> RequestHandler effs Slot (STM PABResp))
-> (Slot -> Eff (NonDet : effs) (STM PABResp))
-> RequestHandler effs Slot (STM PABResp)
forall a b. (a -> b) -> a -> b
$ \Slot
targetSlot_ -> (Slot -> PABResp) -> STM Slot -> STM PABResp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Slot -> PABResp
AwaitSlotResp (STM Slot -> STM PABResp)
-> (BlockchainEnv -> STM Slot) -> BlockchainEnv -> STM PABResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slot -> BlockchainEnv -> STM Slot
InstanceState.awaitSlot Slot
targetSlot_ (BlockchainEnv -> STM PABResp)
-> Eff (NonDet : effs) BlockchainEnv
-> Eff (NonDet : effs) (STM PABResp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff (NonDet : effs) BlockchainEnv
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask)

processAwaitTimeRequestsSTM ::
    forall effs.
    ( Member (Reader BlockchainEnv) effs
    )
    => RequestHandler effs PABReq (STM PABResp)
processAwaitTimeRequestsSTM :: RequestHandler effs PABReq (STM PABResp)
processAwaitTimeRequestsSTM =
    (PABReq -> Maybe POSIXTime) -> RequestHandler effs PABReq POSIXTime
forall req resp (effs :: [* -> *]).
(req -> Maybe resp) -> RequestHandler effs req resp
maybeToHandler (Prism' PABReq POSIXTime -> PABReq -> Maybe POSIXTime
forall (f :: * -> *) a b. Alternative f => Prism' a b -> a -> f b
extract Prism' PABReq POSIXTime
Contract.Effects._AwaitTimeReq) RequestHandler effs PABReq POSIXTime
-> RequestHandler effs POSIXTime (STM PABResp)
-> RequestHandler effs PABReq (STM PABResp)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
        ((POSIXTime -> Eff (NonDet : effs) (STM PABResp))
-> RequestHandler effs POSIXTime (STM PABResp)
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((POSIXTime -> Eff (NonDet : effs) (STM PABResp))
 -> RequestHandler effs POSIXTime (STM PABResp))
-> (POSIXTime -> Eff (NonDet : effs) (STM PABResp))
-> RequestHandler effs POSIXTime (STM PABResp)
forall a b. (a -> b) -> a -> b
$ \POSIXTime
time ->
            (POSIXTime -> PABResp) -> STM POSIXTime -> STM PABResp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap POSIXTime -> PABResp
AwaitTimeResp (STM POSIXTime -> STM PABResp)
-> (BlockchainEnv -> STM POSIXTime) -> BlockchainEnv -> STM PABResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> BlockchainEnv -> STM POSIXTime
InstanceState.awaitTime POSIXTime
time (BlockchainEnv -> STM PABResp)
-> Eff (NonDet : effs) BlockchainEnv
-> Eff (NonDet : effs) (STM PABResp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff (NonDet : effs) BlockchainEnv
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask
        )

processTxStatusChangeRequestsSTM ::
    forall m effs.
    ( LastMember m effs
    , MonadIO m
    , Member (Reader BlockchainEnv) (NonDet : effs)
    )
    => RequestHandler effs PABReq (STM PABResp)
processTxStatusChangeRequestsSTM :: RequestHandler effs PABReq (STM PABResp)
processTxStatusChangeRequestsSTM =
    (PABReq -> Maybe TxId) -> RequestHandler effs PABReq TxId
forall req resp (effs :: [* -> *]).
(req -> Maybe resp) -> RequestHandler effs req resp
maybeToHandler (Prism' PABReq TxId -> PABReq -> Maybe TxId
forall (f :: * -> *) a b. Alternative f => Prism' a b -> a -> f b
extract Prism' PABReq TxId
Contract.Effects._AwaitTxStatusChangeReq)
    RequestHandler effs PABReq TxId
-> RequestHandler effs TxId (STM PABResp)
-> RequestHandler effs PABReq (STM PABResp)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (TxId -> Eff (NonDet : effs) (STM PABResp))
-> RequestHandler effs TxId (STM PABResp)
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler TxId -> Eff (NonDet : effs) (STM PABResp)
forall (e :: * -> *) (effs :: [* -> *]) (m :: * -> *).
(IfNotFound (Reader BlockchainEnv) (e : effs) (e : effs),
 MonadIO m, LastMember m effs,
 FindElem (Reader BlockchainEnv) (e : effs)) =>
TxId -> Eff (e : effs) (STM PABResp)
handler
    where
        handler :: TxId -> Eff (e : effs) (STM PABResp)
handler TxId
txId = do
            BlockchainEnv
env <- Eff (e : effs) BlockchainEnv
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask
            case BlockchainEnv
-> Either (TVar (UtxoIndex TxIdState)) (IORef TCSIndex)
InstanceState.beTxChanges BlockchainEnv
env of
              Left TVar (UtxoIndex TxIdState)
_      ->
                  STM PABResp -> Eff (e : effs) (STM PABResp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxId -> TxStatus -> PABResp
AwaitTxStatusChangeResp TxId
txId (TxStatus -> PABResp) -> STM TxStatus -> STM PABResp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxStatus -> TxId -> BlockchainEnv -> STM TxStatus
InstanceState.waitForTxStatusChange TxStatus
forall a. RollbackState a
Unknown TxId
txId BlockchainEnv
env)
              Right IORef TCSIndex
ixRef -> do
                  STM TxStatus
txStatus <- Eff effs (STM TxStatus) -> Eff (e : effs) (STM TxStatus)
forall (effs :: [* -> *]) a (e :: * -> *).
Eff effs a -> Eff (e : effs) a
raise (Eff effs (STM TxStatus) -> Eff (e : effs) (STM TxStatus))
-> (IO (STM TxStatus) -> Eff effs (STM TxStatus))
-> IO (STM TxStatus)
-> Eff (e : effs) (STM TxStatus)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (STM TxStatus) -> Eff effs (STM TxStatus)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (STM TxStatus) -> Eff (e : effs) (STM TxStatus))
-> IO (STM TxStatus) -> Eff (e : effs) (STM TxStatus)
forall a b. (a -> b) -> a -> b
$ IORef TCSIndex -> BlockchainEnv -> TxId -> IO (STM TxStatus)
processTxStatusChangeRequestIO IORef TCSIndex
ixRef BlockchainEnv
env TxId
txId
                  STM PABResp -> Eff (e : effs) (STM PABResp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxId -> TxStatus -> PABResp
AwaitTxStatusChangeResp TxId
txId (TxStatus -> PABResp) -> STM TxStatus -> STM PABResp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM TxStatus
txStatus)

processTxStatusChangeRequestIO
  :: IORef TCSIndex
  -> BlockchainEnv
  -> TxId
  -> IO (STM TxStatus)
processTxStatusChangeRequestIO :: IORef TCSIndex -> BlockchainEnv -> TxId -> IO (STM TxStatus)
processTxStatusChangeRequestIO IORef TCSIndex
ixRef BlockchainEnv
env TxId
txId = do
    TCSIndex
ix           <- IORef TCSIndex -> IO TCSIndex
forall a. IORef a -> IO a
readIORef IORef TCSIndex
ixRef
    BlockNumber
_blockNumber <- TVar BlockNumber -> IO BlockNumber
forall a. TVar a -> IO a
STM.readTVarIO (TVar BlockNumber -> IO BlockNumber)
-> TVar BlockNumber -> IO BlockNumber
forall a b. (a -> b) -> a -> b
$ BlockchainEnv -> TVar BlockNumber
InstanceState.beLastSyncedBlockNo BlockchainEnv
env
    [Event]
events       <- Storage Vector IO Event -> IO [Event]
forall (v :: * -> *) (m :: * -> *) e.
(MVector (Mutable v) e, PrimMonad m, Show e) =>
Storage v m e -> m [e]
Ix.getEvents (TCSIndex
ix TCSIndex
-> Getting
     (Storage Vector IO Event) TCSIndex (Storage Vector IO Event)
-> Storage Vector IO Event
forall s a. s -> Getting a s a -> a
^. Getting
  (Storage Vector IO Event) TCSIndex (Storage Vector IO Event)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) (Storage v m e)
Ix.storage)
    Result
queryResult  <- (TCSIndex
ix TCSIndex
-> Getting
     (TCSIndex -> TxId -> [Event] -> IO Result)
     TCSIndex
     (TCSIndex -> TxId -> [Event] -> IO Result)
-> TCSIndex
-> TxId
-> [Event]
-> IO Result
forall s a. s -> Getting a s a -> a
^. Getting
  (TCSIndex -> TxId -> [Event] -> IO Result)
  TCSIndex
  (TCSIndex -> TxId -> [Event] -> IO Result)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens'
  (SplitIndex m h v e n q r)
  (SplitIndex m h v e n q r -> q -> [e] -> m r)
Ix.query) TCSIndex
ix TxId
txId [Event]
events
    STM TxStatus -> IO (STM TxStatus)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (STM TxStatus -> IO (STM TxStatus))
-> (TxStatus -> STM TxStatus) -> TxStatus -> IO (STM TxStatus)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxStatus -> STM TxStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxStatus -> IO (STM TxStatus)) -> TxStatus -> IO (STM TxStatus)
forall a b. (a -> b) -> a -> b
$ case Result
queryResult of
        -- On this branch the transaction has not yet been indexed. This means
        -- that the transaction status has not changed from `Unknown` which is
        -- why we wait and re-poll.
        Result
Nothing -> TxStatus
forall a. RollbackState a
Unknown
        -- If we get any kind of update we can return. Due to the way the indexer
        -- works we can compute if the tx has been confirmed or not.
        Just (TxConfirmedState (Sum Int
0) Last BlockNumber
_ Last TxValidity
_) -> TxValidity -> () -> TxStatus
forall a. TxValidity -> a -> RollbackState a
Committed TxValidity
TxValid ()
        Just (TxConfirmedState (Sum Int
n) Last BlockNumber
_ Last TxValidity
_) ->
            Depth -> TxValidity -> () -> TxStatus
forall a. Depth -> TxValidity -> a -> RollbackState a
TentativelyConfirmed (Int -> Depth
Depth Int
n) TxValidity
TxValid ()

processTxOutStatusChangeRequestsSTM ::
    forall m effs.
    ( LastMember m effs
    , MonadIO m
    , Member (Reader BlockchainEnv) effs
    )
    => RequestHandler effs PABReq (STM PABResp)
processTxOutStatusChangeRequestsSTM :: RequestHandler effs PABReq (STM PABResp)
processTxOutStatusChangeRequestsSTM =
    (PABReq -> Maybe TxOutRef) -> RequestHandler effs PABReq TxOutRef
forall req resp (effs :: [* -> *]).
(req -> Maybe resp) -> RequestHandler effs req resp
maybeToHandler (Prism' PABReq TxOutRef -> PABReq -> Maybe TxOutRef
forall (f :: * -> *) a b. Alternative f => Prism' a b -> a -> f b
extract Prism' PABReq TxOutRef
Contract.Effects._AwaitTxOutStatusChangeReq)
    RequestHandler effs PABReq TxOutRef
-> RequestHandler effs TxOutRef (STM PABResp)
-> RequestHandler effs PABReq (STM PABResp)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (TxOutRef -> Eff (NonDet : effs) (STM PABResp))
-> RequestHandler effs TxOutRef (STM PABResp)
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler TxOutRef -> Eff (NonDet : effs) (STM PABResp)
forall (e :: * -> *) (effs :: [* -> *]) (m :: * -> *).
(IfNotFound (Reader BlockchainEnv) (e : effs) (e : effs),
 MonadIO m, LastMember m effs,
 FindElem (Reader BlockchainEnv) (e : effs)) =>
TxOutRef -> Eff (e : effs) (STM PABResp)
handler
    where
        handler :: TxOutRef -> Eff (e : effs) (STM PABResp)
handler TxOutRef
txOutRef = do
            BlockchainEnv
env <- Eff (e : effs) BlockchainEnv
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask
            case BlockchainEnv
-> Either (TVar (UtxoIndex TxIdState)) (IORef TCSIndex)
InstanceState.beTxChanges BlockchainEnv
env of
              Left TVar (UtxoIndex TxIdState)
_ ->
                STM PABResp -> Eff (e : effs) (STM PABResp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOutRef -> TxOutStatus -> PABResp
AwaitTxOutStatusChangeResp TxOutRef
txOutRef (TxOutStatus -> PABResp) -> STM TxOutStatus -> STM PABResp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxOutStatus -> TxOutRef -> BlockchainEnv -> STM TxOutStatus
InstanceState.waitForTxOutStatusChange TxOutStatus
forall a. RollbackState a
Unknown TxOutRef
txOutRef BlockchainEnv
env)
              Right IORef TCSIndex
txChange -> do
                 STM TxOutStatus
txOutStatus <- Eff effs (STM TxOutStatus) -> Eff (e : effs) (STM TxOutStatus)
forall (effs :: [* -> *]) a (e :: * -> *).
Eff effs a -> Eff (e : effs) a
raise (Eff effs (STM TxOutStatus) -> Eff (e : effs) (STM TxOutStatus))
-> (IO (STM TxOutStatus) -> Eff effs (STM TxOutStatus))
-> IO (STM TxOutStatus)
-> Eff (e : effs) (STM TxOutStatus)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (STM TxOutStatus) -> Eff effs (STM TxOutStatus)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (STM TxOutStatus) -> Eff (e : effs) (STM TxOutStatus))
-> IO (STM TxOutStatus) -> Eff (e : effs) (STM TxOutStatus)
forall a b. (a -> b) -> a -> b
$ IORef TCSIndex -> BlockchainEnv -> TxOutRef -> IO (STM TxOutStatus)
processTxOutStatusChangeRequestsIO IORef TCSIndex
txChange BlockchainEnv
env TxOutRef
txOutRef
                 STM PABResp -> Eff (e : effs) (STM PABResp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOutRef -> TxOutStatus -> PABResp
AwaitTxOutStatusChangeResp TxOutRef
txOutRef (TxOutStatus -> PABResp) -> STM TxOutStatus -> STM PABResp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM TxOutStatus
txOutStatus)

processTxOutStatusChangeRequestsIO
  :: IORef TCSIndex
  -> BlockchainEnv
  -> TxOutRef
  -> IO (STM TxOutStatus)
processTxOutStatusChangeRequestsIO :: IORef TCSIndex -> BlockchainEnv -> TxOutRef -> IO (STM TxOutStatus)
processTxOutStatusChangeRequestsIO IORef TCSIndex
tcsIx BlockchainEnv{TVar (UtxoIndex TxOutBalance)
beTxOutChanges :: BlockchainEnv -> TVar (UtxoIndex TxOutBalance)
beTxOutChanges :: TVar (UtxoIndex TxOutBalance)
beTxOutChanges} TxOutRef
txOutRef = do
  TxOutBalance
txOutBalance  <- UtxoState TxOutBalance -> TxOutBalance
forall a. UtxoState a -> a
_usTxUtxoData (UtxoState TxOutBalance -> TxOutBalance)
-> (UtxoIndex TxOutBalance -> UtxoState TxOutBalance)
-> UtxoIndex TxOutBalance
-> TxOutBalance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoIndex TxOutBalance -> UtxoState TxOutBalance
forall a. Monoid a => UtxoIndex a -> UtxoState a
utxoState (UtxoIndex TxOutBalance -> TxOutBalance)
-> IO (UtxoIndex TxOutBalance) -> IO TxOutBalance
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM (UtxoIndex TxOutBalance) -> IO (UtxoIndex TxOutBalance)
forall a. STM a -> IO a
STM.atomically (TVar (UtxoIndex TxOutBalance) -> STM (UtxoIndex TxOutBalance)
forall a. TVar a -> STM a
STM.readTVar TVar (UtxoIndex TxOutBalance)
beTxOutChanges)
  case TxOutBalance -> TxOutRef -> Maybe TxOutState
transactionOutputState TxOutBalance
txOutBalance TxOutRef
txOutRef of
    Maybe TxOutState
Nothing             -> STM TxOutStatus -> IO (STM TxOutStatus)
forall (f :: * -> *) a. Applicative f => a -> f a
pure STM TxOutStatus
forall (f :: * -> *) a. Alternative f => f a
empty
    Just s :: TxOutState
s@(Spent TxId
txId) -> TxOutState -> TxId -> IO (STM TxOutStatus)
queryTx TxOutState
s TxId
txId
    Just s :: TxOutState
s@(TxOutState
Unspent)    -> TxOutState -> TxId -> IO (STM TxOutStatus)
queryTx TxOutState
s (TxId -> IO (STM TxOutStatus)) -> TxId -> IO (STM TxOutStatus)
forall a b. (a -> b) -> a -> b
$ TxOutRef -> TxId
txOutRefId TxOutRef
txOutRef
  where
    queryTx :: TxOutState -> TxId -> IO (STM TxOutStatus)
    queryTx :: TxOutState -> TxId -> IO (STM TxOutStatus)
queryTx TxOutState
s TxId
txId = do
      TCSIndex
ix <- IORef TCSIndex -> IO TCSIndex
forall a. IORef a -> IO a
readIORef IORef TCSIndex
tcsIx
      [Event]
events <- Storage Vector IO Event -> IO [Event]
forall (v :: * -> *) (m :: * -> *) e.
(MVector (Mutable v) e, PrimMonad m, Show e) =>
Storage v m e -> m [e]
Ix.getEvents (TCSIndex
ix TCSIndex
-> Getting
     (Storage Vector IO Event) TCSIndex (Storage Vector IO Event)
-> Storage Vector IO Event
forall s a. s -> Getting a s a -> a
^. Getting
  (Storage Vector IO Event) TCSIndex (Storage Vector IO Event)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) (Storage v m e)
Ix.storage)
      Result
queryResult <- (TCSIndex
ix TCSIndex
-> Getting
     (TCSIndex -> TxId -> [Event] -> IO Result)
     TCSIndex
     (TCSIndex -> TxId -> [Event] -> IO Result)
-> TCSIndex
-> TxId
-> [Event]
-> IO Result
forall s a. s -> Getting a s a -> a
^. Getting
  (TCSIndex -> TxId -> [Event] -> IO Result)
  TCSIndex
  (TCSIndex -> TxId -> [Event] -> IO Result)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens'
  (SplitIndex m h v e n q r)
  (SplitIndex m h v e n q r -> q -> [e] -> m r)
Ix.query) TCSIndex
ix TxId
txId [Event]
events
      STM TxOutStatus -> IO (STM TxOutStatus)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (STM TxOutStatus -> IO (STM TxOutStatus))
-> (TxOutStatus -> STM TxOutStatus)
-> TxOutStatus
-> IO (STM TxOutStatus)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOutStatus -> STM TxOutStatus
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOutStatus -> IO (STM TxOutStatus))
-> TxOutStatus -> IO (STM TxOutStatus)
forall a b. (a -> b) -> a -> b
$ case Result
queryResult of
        Result
Nothing -> TxOutStatus
forall a. RollbackState a
Unknown
        Just (TxConfirmedState (Sum Int
0) Last BlockNumber
_ Last TxValidity
_) -> TxValidity -> TxOutState -> TxOutStatus
forall a. TxValidity -> a -> RollbackState a
Committed TxValidity
TxValid TxOutState
s
        Just (TxConfirmedState (Sum Int
n) Last BlockNumber
_ Last TxValidity
_) ->
          Depth -> TxValidity -> TxOutState -> TxOutStatus
forall a. Depth -> TxValidity -> a -> RollbackState a
TentativelyConfirmed (Int -> Depth
Depth Int
n) TxValidity
TxValid TxOutState
s

processUtxoSpentRequestsSTM ::
    forall effs.
    ( Member (Reader InstanceState) effs
    )
    => RequestHandler effs (Request PABReq) (Response (STM PABResp))
processUtxoSpentRequestsSTM :: RequestHandler effs (Request PABReq) (Response (STM PABResp))
processUtxoSpentRequestsSTM = (Request PABReq -> Eff (NonDet : effs) (Response (STM PABResp)))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((Request PABReq -> Eff (NonDet : effs) (Response (STM PABResp)))
 -> RequestHandler effs (Request PABReq) (Response (STM PABResp)))
-> (Request PABReq -> Eff (NonDet : effs) (Response (STM PABResp)))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall a b. (a -> b) -> a -> b
$ \Request PABReq
req -> do
    case (PABReq -> Maybe TxOutRef)
-> Request PABReq -> Maybe (Request TxOutRef)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Getting (First TxOutRef) PABReq TxOutRef
-> PABReq -> Maybe TxOutRef
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First TxOutRef) PABReq TxOutRef
Prism' PABReq TxOutRef
Contract.Effects._AwaitUtxoSpentReq) Request PABReq
req of
        Just request :: Request TxOutRef
request@Request{RequestID
rqID :: RequestID
rqID :: forall o. Request o -> RequestID
rqID, IterationID
itID :: IterationID
itID :: forall o. Request o -> IterationID
itID} -> do
            InstanceState
env <- Eff (NonDet : effs) InstanceState
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask
            Response (STM PABResp)
-> Eff (NonDet : effs) (Response (STM PABResp))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response (STM PABResp)
 -> Eff (NonDet : effs) (Response (STM PABResp)))
-> Response (STM PABResp)
-> Eff (NonDet : effs) (Response (STM PABResp))
forall a b. (a -> b) -> a -> b
$ RequestID -> IterationID -> STM PABResp -> Response (STM PABResp)
forall i. RequestID -> IterationID -> i -> Response i
Response RequestID
rqID IterationID
itID (ChainIndexTx -> PABResp
AwaitUtxoSpentResp (ChainIndexTx -> PABResp) -> STM ChainIndexTx -> STM PABResp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request TxOutRef -> InstanceState -> STM ChainIndexTx
InstanceState.waitForUtxoSpent Request TxOutRef
request InstanceState
env)
        Maybe (Request TxOutRef)
_ -> Eff (NonDet : effs) (Response (STM PABResp))
forall (f :: * -> *) a. Alternative f => f a
empty

processUtxoProducedRequestsSTM ::
    forall effs.
    ( Member (Reader InstanceState) effs
    )
    => RequestHandler effs (Request PABReq) (Response (STM PABResp))
processUtxoProducedRequestsSTM :: RequestHandler effs (Request PABReq) (Response (STM PABResp))
processUtxoProducedRequestsSTM = (Request PABReq -> Eff (NonDet : effs) (Response (STM PABResp)))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((Request PABReq -> Eff (NonDet : effs) (Response (STM PABResp)))
 -> RequestHandler effs (Request PABReq) (Response (STM PABResp)))
-> (Request PABReq -> Eff (NonDet : effs) (Response (STM PABResp)))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall a b. (a -> b) -> a -> b
$ \Request PABReq
req -> do
    case (PABReq -> Maybe CardanoAddress)
-> Request PABReq -> Maybe (Request CardanoAddress)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Getting (First CardanoAddress) PABReq CardanoAddress
-> PABReq -> Maybe CardanoAddress
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First CardanoAddress) PABReq CardanoAddress
Prism' PABReq CardanoAddress
Contract.Effects._AwaitUtxoProducedReq) Request PABReq
req of
        Just request :: Request CardanoAddress
request@Request{RequestID
rqID :: RequestID
rqID :: forall o. Request o -> RequestID
rqID, IterationID
itID :: IterationID
itID :: forall o. Request o -> IterationID
itID} -> do
            InstanceState
env <- Eff (NonDet : effs) InstanceState
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask
            Response (STM PABResp)
-> Eff (NonDet : effs) (Response (STM PABResp))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response (STM PABResp)
 -> Eff (NonDet : effs) (Response (STM PABResp)))
-> Response (STM PABResp)
-> Eff (NonDet : effs) (Response (STM PABResp))
forall a b. (a -> b) -> a -> b
$ RequestID -> IterationID -> STM PABResp -> Response (STM PABResp)
forall i. RequestID -> IterationID -> i -> Response i
Response RequestID
rqID IterationID
itID (NonEmpty ChainIndexTx -> PABResp
AwaitUtxoProducedResp (NonEmpty ChainIndexTx -> PABResp)
-> STM (NonEmpty ChainIndexTx) -> STM PABResp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request CardanoAddress
-> InstanceState -> STM (NonEmpty ChainIndexTx)
InstanceState.waitForUtxoProduced Request CardanoAddress
request InstanceState
env)
        Maybe (Request CardanoAddress)
_ -> Eff (NonDet : effs) (Response (STM PABResp))
forall (f :: * -> *) a. Alternative f => f a
empty

processEndpointRequestsSTM ::
    forall effs.
    ( Member (Reader InstanceState) effs
    )
    => RequestHandler effs (Request PABReq) (Response (STM PABResp))
processEndpointRequestsSTM :: RequestHandler effs (Request PABReq) (Response (STM PABResp))
processEndpointRequestsSTM =
    (Request PABReq -> Maybe (Request ActiveEndpoint))
-> RequestHandler effs (Request PABReq) (Request ActiveEndpoint)
forall req resp (effs :: [* -> *]).
(req -> Maybe resp) -> RequestHandler effs req resp
maybeToHandler ((PABReq -> Maybe ActiveEndpoint)
-> Request PABReq -> Maybe (Request ActiveEndpoint)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Prism' PABReq ActiveEndpoint -> PABReq -> Maybe ActiveEndpoint
forall (f :: * -> *) a b. Alternative f => Prism' a b -> a -> f b
extract Prism' PABReq ActiveEndpoint
Contract.Effects._ExposeEndpointReq))
    RequestHandler effs (Request PABReq) (Request ActiveEndpoint)
-> RequestHandler
     effs (Request ActiveEndpoint) (Response (STM PABResp))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((Request ActiveEndpoint
 -> Eff (NonDet : effs) (Response (STM PABResp)))
-> RequestHandler
     effs (Request ActiveEndpoint) (Response (STM PABResp))
forall (effs :: [* -> *]) req resp.
(req -> Eff (NonDet : effs) resp) -> RequestHandler effs req resp
RequestHandler ((Request ActiveEndpoint
  -> Eff (NonDet : effs) (Response (STM PABResp)))
 -> RequestHandler
      effs (Request ActiveEndpoint) (Response (STM PABResp)))
-> (Request ActiveEndpoint
    -> Eff (NonDet : effs) (Response (STM PABResp)))
-> RequestHandler
     effs (Request ActiveEndpoint) (Response (STM PABResp))
forall a b. (a -> b) -> a -> b
$ \q :: Request ActiveEndpoint
q@Request{RequestID
rqID :: RequestID
rqID :: forall o. Request o -> RequestID
rqID, IterationID
itID :: IterationID
itID :: forall o. Request o -> IterationID
itID, ActiveEndpoint
rqRequest :: ActiveEndpoint
rqRequest :: forall o. Request o -> o
rqRequest} -> (STM PABResp -> Response (STM PABResp))
-> Eff (NonDet : effs) (STM PABResp)
-> Eff (NonDet : effs) (Response (STM PABResp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RequestID -> IterationID -> STM PABResp -> Response (STM PABResp)
forall i. RequestID -> IterationID -> i -> Response i
Response RequestID
rqID IterationID
itID) ((EndpointValue Value -> PABResp)
-> STM (EndpointValue Value) -> STM PABResp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EndpointDescription -> EndpointValue Value -> PABResp
ExposeEndpointResp (ActiveEndpoint -> EndpointDescription
aeDescription ActiveEndpoint
rqRequest)) (STM (EndpointValue Value) -> STM PABResp)
-> (InstanceState -> STM (EndpointValue Value))
-> InstanceState
-> STM PABResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request ActiveEndpoint
-> InstanceState -> STM (EndpointValue Value)
InstanceState.awaitEndpointResponse Request ActiveEndpoint
q (InstanceState -> STM PABResp)
-> Eff (NonDet : effs) InstanceState
-> Eff (NonDet : effs) (STM PABResp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff (NonDet : effs) InstanceState
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask))

-- | 'RequestHandler' that uses TVars to wait for events
stmRequestHandler ::
    forall m effs.
    ( LastMember m effs
    , MonadIO m
    , Member ChainIndexQueryEffect effs
    , Member WalletEffect effs
    , Member NodeClientEffect effs
    , Member (LogMsg RequestHandlerLogMsg) effs
    , Member (LogObserve (LogMessage Text.Text)) effs
    , Member (Reader ContractInstanceId) effs
    , Member (Reader BlockchainEnv) effs
    , Member (Reader InstanceState) effs
    )
    => RequestHandler effs (Request PABReq) (STM (Response PABResp))
stmRequestHandler :: RequestHandler effs (Request PABReq) (STM (Response PABResp))
stmRequestHandler = (Response (STM PABResp) -> STM (Response PABResp))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
-> RequestHandler effs (Request PABReq) (STM (Response PABResp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Response (STM PABResp) -> STM (Response PABResp)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (RequestHandler effs PABReq (STM PABResp)
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall (effs :: [* -> *]) req resp.
RequestHandler effs req resp
-> RequestHandler effs (Request req) (Response resp)
wrapHandler ((PABResp -> STM PABResp)
-> RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq (STM PABResp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PABResp -> STM PABResp
forall (f :: * -> *) a. Applicative f => a -> f a
pure RequestHandler effs PABReq PABResp
nonBlockingRequests) RequestHandler effs (Request PABReq) (Response (STM PABResp))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall a. Semigroup a => a -> a -> a
<> RequestHandler effs (Request PABReq) (Response (STM PABResp))
blockingRequests) where

    -- requests that can be handled by 'WalletEffect', 'ChainIndexQueryEffect', etc.
    nonBlockingRequests :: RequestHandler effs PABReq PABResp
nonBlockingRequests =
        (Member (LogObserve (LogMessage Text)) effs,
 Member WalletEffect effs) =>
RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]).
(Member (LogObserve (LogMessage Text)) effs,
 Member WalletEffect effs) =>
RequestHandler effs PABReq PABResp
RequestHandler.handleOwnAddressesQueries @effs
        RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
forall a. Semigroup a => a -> a -> a
<> (Member (LogObserve (LogMessage Text)) effs,
 Member ChainIndexQueryEffect effs) =>
RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]).
(Member (LogObserve (LogMessage Text)) effs,
 Member ChainIndexQueryEffect effs) =>
RequestHandler effs PABReq PABResp
RequestHandler.handleChainIndexQueries @effs
        RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
forall a. Semigroup a => a -> a -> a
<> (Member (LogObserve (LogMessage Text)) effs,
 Member (LogMsg RequestHandlerLogMsg) effs,
 Member WalletEffect effs) =>
RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]).
(Member (LogObserve (LogMessage Text)) effs,
 Member (LogMsg RequestHandlerLogMsg) effs,
 Member WalletEffect effs) =>
RequestHandler effs PABReq PABResp
RequestHandler.handleUnbalancedTransactions @effs
        RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
forall a. Semigroup a => a -> a -> a
<> (Member (LogObserve (LogMessage Text)) effs,
 Member (LogMsg RequestHandlerLogMsg) effs,
 Member WalletEffect effs) =>
RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]).
(Member (LogObserve (LogMessage Text)) effs,
 Member (LogMsg RequestHandlerLogMsg) effs,
 Member WalletEffect effs) =>
RequestHandler effs PABReq PABResp
RequestHandler.handlePendingTransactions @effs
        RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
forall a. Semigroup a => a -> a -> a
<> (Member (LogObserve (LogMessage Text)) effs,
 Member (Reader ContractInstanceId) effs) =>
RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]).
(Member (LogObserve (LogMessage Text)) effs,
 Member (Reader ContractInstanceId) effs) =>
RequestHandler effs PABReq PABResp
RequestHandler.handleOwnInstanceIdQueries @effs
        RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
forall a. Semigroup a => a -> a -> a
<> (Member (LogObserve (LogMessage Text)) effs,
 Member NodeClientEffect effs) =>
RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]).
(Member (LogObserve (LogMessage Text)) effs,
 Member NodeClientEffect effs) =>
RequestHandler effs PABReq PABResp
RequestHandler.handleCurrentNodeClientSlotQueries @effs
        RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
forall a. Semigroup a => a -> a -> a
<> (Member (LogObserve (LogMessage Text)) effs,
 Member ChainIndexQueryEffect effs) =>
RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]).
(Member (LogObserve (LogMessage Text)) effs,
 Member ChainIndexQueryEffect effs) =>
RequestHandler effs PABReq PABResp
RequestHandler.handleCurrentChainIndexSlotQueries @effs
        RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
forall a. Semigroup a => a -> a -> a
<> (Member (LogObserve (LogMessage Text)) effs,
 Member NodeClientEffect effs) =>
RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]).
(Member (LogObserve (LogMessage Text)) effs,
 Member NodeClientEffect effs) =>
RequestHandler effs PABReq PABResp
RequestHandler.handleCurrentNodeClientTimeRangeQueries @effs
        RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
forall a. Semigroup a => a -> a -> a
<> (Member (LogObserve (LogMessage Text)) effs,
 Member WalletEffect effs) =>
RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]).
(Member (LogObserve (LogMessage Text)) effs,
 Member WalletEffect effs) =>
RequestHandler effs PABReq PABResp
RequestHandler.handleYieldedUnbalancedTx @effs
        RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
forall a. Semigroup a => a -> a -> a
<> (Member (LogObserve (LogMessage Text)) effs,
 Member (LogMsg RequestHandlerLogMsg) effs,
 Member NodeClientEffect effs) =>
RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]).
(Member (LogObserve (LogMessage Text)) effs,
 Member (LogMsg RequestHandlerLogMsg) effs,
 Member NodeClientEffect effs) =>
RequestHandler effs PABReq PABResp
RequestHandler.handleAdjustUnbalancedTx @effs
        RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
-> RequestHandler effs PABReq PABResp
forall a. Semigroup a => a -> a -> a
<> (Member (LogObserve (LogMessage Text)) effs,
 Member NodeClientEffect effs) =>
RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]).
(Member (LogObserve (LogMessage Text)) effs,
 Member NodeClientEffect effs) =>
RequestHandler effs PABReq PABResp
RequestHandler.handleGetParams @effs

    -- requests that wait for changes to happen
    blockingRequests :: RequestHandler effs (Request PABReq) (Response (STM PABResp))
blockingRequests =
        RequestHandler effs PABReq (STM PABResp)
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall (effs :: [* -> *]) req resp.
RequestHandler effs req resp
-> RequestHandler effs (Request req) (Response resp)
wrapHandler (Member (Reader BlockchainEnv) effs =>
RequestHandler effs PABReq (STM PABResp)
forall (effs :: [* -> *]).
Member (Reader BlockchainEnv) effs =>
RequestHandler effs PABReq (STM PABResp)
processAwaitSlotRequestsSTM @effs)
        RequestHandler effs (Request PABReq) (Response (STM PABResp))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall a. Semigroup a => a -> a -> a
<> RequestHandler effs PABReq (STM PABResp)
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall (effs :: [* -> *]) req resp.
RequestHandler effs req resp
-> RequestHandler effs (Request req) (Response resp)
wrapHandler (Member (Reader BlockchainEnv) effs =>
RequestHandler effs PABReq (STM PABResp)
forall (effs :: [* -> *]).
Member (Reader BlockchainEnv) effs =>
RequestHandler effs PABReq (STM PABResp)
processAwaitTimeRequestsSTM @effs)
        RequestHandler effs (Request PABReq) (Response (STM PABResp))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall a. Semigroup a => a -> a -> a
<> RequestHandler effs PABReq (STM PABResp)
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall (effs :: [* -> *]) req resp.
RequestHandler effs req resp
-> RequestHandler effs (Request req) (Response resp)
wrapHandler ((LastMember m effs, MonadIO m,
 Member (Reader BlockchainEnv) (NonDet : effs)) =>
RequestHandler effs PABReq (STM PABResp)
forall (m :: * -> *) (effs :: [* -> *]).
(LastMember m effs, MonadIO m,
 Member (Reader BlockchainEnv) (NonDet : effs)) =>
RequestHandler effs PABReq (STM PABResp)
processTxStatusChangeRequestsSTM @_ @effs)
        RequestHandler effs (Request PABReq) (Response (STM PABResp))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall a. Semigroup a => a -> a -> a
<> RequestHandler effs PABReq (STM PABResp)
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall (effs :: [* -> *]) req resp.
RequestHandler effs req resp
-> RequestHandler effs (Request req) (Response resp)
wrapHandler ((LastMember m effs, MonadIO m,
 Member (Reader BlockchainEnv) effs) =>
RequestHandler effs PABReq (STM PABResp)
forall (m :: * -> *) (effs :: [* -> *]).
(LastMember m effs, MonadIO m,
 Member (Reader BlockchainEnv) effs) =>
RequestHandler effs PABReq (STM PABResp)
processTxOutStatusChangeRequestsSTM @_ @effs)
        RequestHandler effs (Request PABReq) (Response (STM PABResp))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall a. Semigroup a => a -> a -> a
<> Member (Reader InstanceState) effs =>
RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall (effs :: [* -> *]).
Member (Reader InstanceState) effs =>
RequestHandler effs (Request PABReq) (Response (STM PABResp))
processEndpointRequestsSTM @effs
        RequestHandler effs (Request PABReq) (Response (STM PABResp))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall a. Semigroup a => a -> a -> a
<> Member (Reader InstanceState) effs =>
RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall (effs :: [* -> *]).
Member (Reader InstanceState) effs =>
RequestHandler effs (Request PABReq) (Response (STM PABResp))
processUtxoSpentRequestsSTM @effs
        RequestHandler effs (Request PABReq) (Response (STM PABResp))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
-> RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall a. Semigroup a => a -> a -> a
<> Member (Reader InstanceState) effs =>
RequestHandler effs (Request PABReq) (Response (STM PABResp))
forall (effs :: [* -> *]).
Member (Reader InstanceState) effs =>
RequestHandler effs (Request PABReq) (Response (STM PABResp))
processUtxoProducedRequestsSTM @effs

-- | Start the thread for the contract instance
startSTMInstanceThread' ::
    forall t m appBackend effs.
    ( LastMember m effs
    , Contract.PABContract t
    , AppBackendConstraints t m appBackend
    , LastMember m (Reader InstanceState ': Reader ContractInstanceId ': appBackend)
    )
    => STM InstanceState
    -> (ContractInstanceId -> Eff appBackend ~> IO)
    -> ContractActivationArgs (ContractDef t)
    -> ContractInstanceId
    -> Eff effs InstanceState
startSTMInstanceThread' :: STM InstanceState
-> (ContractInstanceId -> Eff appBackend ~> IO)
-> ContractActivationArgs (ContractDef t)
-> ContractInstanceId
-> Eff effs InstanceState
startSTMInstanceThread' STM InstanceState
stmState ContractInstanceId -> Eff appBackend ~> IO
runAppBackend ContractActivationArgs (ContractDef t)
def ContractInstanceId
instanceID =  do
    InstanceState
state <- IO InstanceState -> Eff effs InstanceState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InstanceState -> Eff effs InstanceState)
-> IO InstanceState -> Eff effs InstanceState
forall a b. (a -> b) -> a -> b
$ STM InstanceState -> IO InstanceState
forall a. STM a -> IO a
STM.atomically STM InstanceState
stmState
    ThreadId
_ <- IO ThreadId -> Eff effs ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (IO ThreadId -> Eff effs ThreadId)
-> IO ThreadId -> Eff effs ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO
        (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ ContractInstanceId -> Eff appBackend ~> IO
runAppBackend ContractInstanceId
instanceID
        (Eff appBackend () -> IO ()) -> Eff appBackend () -> IO ()
forall a b. (a -> b) -> a -> b
$ ContractInstanceId
-> Eff (Reader ContractInstanceId : appBackend) ()
-> Eff appBackend ()
forall r (effs :: [* -> *]) a.
r -> Eff (Reader r : effs) a -> Eff effs a
runReader ContractInstanceId
instanceID
        (Eff (Reader ContractInstanceId : appBackend) ()
 -> Eff appBackend ())
-> Eff (Reader ContractInstanceId : appBackend) ()
-> Eff appBackend ()
forall a b. (a -> b) -> a -> b
$ InstanceState
-> Eff
     (Reader InstanceState : Reader ContractInstanceId : appBackend) ()
-> Eff (Reader ContractInstanceId : appBackend) ()
forall r (effs :: [* -> *]) a.
r -> Eff (Reader r : effs) a -> Eff effs a
runReader InstanceState
state
        (Eff
   (Reader InstanceState : Reader ContractInstanceId : appBackend) ()
 -> Eff (Reader ContractInstanceId : appBackend) ())
-> Eff
     (Reader InstanceState : Reader ContractInstanceId : appBackend) ()
-> Eff (Reader ContractInstanceId : appBackend) ()
forall a b. (a -> b) -> a -> b
$ ContractActivationArgs (ContractDef t)
-> ContractInstanceId
-> Eff
     (Reader InstanceState : Reader ContractInstanceId : appBackend) ()
forall t (m :: * -> *) (effs :: [* -> *]).
(AppBackendConstraints t m effs,
 Member (Reader InstanceState) effs,
 Member (Reader ContractInstanceId) effs, PABContract t) =>
ContractActivationArgs (ContractDef t)
-> ContractInstanceId -> Eff effs ()
stmInstanceLoop @t @m @(Reader InstanceState ': Reader ContractInstanceId ': appBackend) ContractActivationArgs (ContractDef t)
def ContractInstanceId
instanceID
    InstanceState -> Eff effs InstanceState
forall (f :: * -> *) a. Applicative f => a -> f a
pure InstanceState
state

-- | Start the thread for the contract instance
startSTMInstanceThread ::
    forall t m appBackend effs.
    ( LastMember m effs
    , Contract.PABContract t
    , AppBackendConstraints t m appBackend
    , LastMember m (Reader InstanceState ': Reader ContractInstanceId ': appBackend)
    )
    => (ContractInstanceId -> Eff appBackend ~> IO)
    -> ContractActivationArgs (ContractDef t)
    -> ContractInstanceId
    -> Eff effs InstanceState
startSTMInstanceThread :: (ContractInstanceId -> Eff appBackend ~> IO)
-> ContractActivationArgs (ContractDef t)
-> ContractInstanceId
-> Eff effs InstanceState
startSTMInstanceThread = STM InstanceState
-> (ContractInstanceId -> Eff appBackend ~> IO)
-> ContractActivationArgs (ContractDef t)
-> ContractInstanceId
-> Eff effs InstanceState
forall t (m :: * -> *) (appBackend :: [* -> *]) (effs :: [* -> *]).
(LastMember m effs, PABContract t,
 AppBackendConstraints t m appBackend,
 LastMember
   m
   (Reader InstanceState : Reader ContractInstanceId : appBackend)) =>
STM InstanceState
-> (ContractInstanceId -> Eff appBackend ~> IO)
-> ContractActivationArgs (ContractDef t)
-> ContractInstanceId
-> Eff effs InstanceState
startSTMInstanceThread' @t @m @appBackend STM InstanceState
emptyInstanceState

type AppBackendConstraints t m effs =
    ( LastMember m effs
    , MonadIO m
    , Member (Error PABError) effs
    , Member (LogMsg (ContractInstanceMsg t)) effs
    , Member ChainIndexQueryEffect effs
    , Member WalletEffect effs
    , Member NodeClientEffect effs
    , Member (LogMsg RequestHandlerLogMsg) effs
    , Member (LogObserve (LogMessage Text.Text)) effs
    , Member (LogMsg TxBalanceMsg) effs
    , Member (Reader BlockchainEnv) effs
    , Member (ContractEffect t) effs
    , Member (ContractStore t) effs
    )

-- | Handle requests using 'respondToRequestsSTM' until the contract is done.
stmInstanceLoop ::
    forall t m effs.
    ( AppBackendConstraints t m effs
    , Member (Reader InstanceState) effs
    , Member (Reader ContractInstanceId) effs
    , Contract.PABContract t
    )
    => ContractActivationArgs (ContractDef t)
    -> ContractInstanceId
    -> Eff effs ()
stmInstanceLoop :: ContractActivationArgs (ContractDef t)
-> ContractInstanceId -> Eff effs ()
stmInstanceLoop ContractActivationArgs (ContractDef t)
def ContractInstanceId
instanceId = do
    (currentState :: Contract.State t) <- ContractInstanceId -> Eff effs (State t)
forall t (effs :: [* -> *]).
Member (ContractStore t) effs =>
ContractInstanceId -> Eff effs (State t)
Contract.getState @t ContractInstanceId
instanceId
    InstanceState{TMVar ()
issStop :: TMVar ()
issStop :: InstanceState -> TMVar ()
issStop} <- Eff effs InstanceState
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask
    let resp :: ContractResponse Value Value PABResp PABReq
resp = Proxy t -> State t -> ContractResponse Value Value PABResp PABReq
forall contract.
PABContract contract =>
Proxy contract
-> State contract -> ContractResponse Value Value PABResp PABReq
serialisableState (Proxy t
forall k (t :: k). Proxy t
Proxy @t) State t
currentState
    ContractResponse Value Value PABResp PABReq -> Eff effs ()
forall (m :: * -> *) (effs :: [* -> *]).
(LastMember m effs, MonadIO m,
 Member (Reader InstanceState) effs) =>
ContractResponse Value Value PABResp PABReq -> Eff effs ()
updateState ContractResponse Value Value PABResp PABReq
resp
    case State t -> [Request PABReq]
forall contract.
PABContract contract =>
State contract -> [Request PABReq]
Contract.requests @t State t
currentState of
        [] -> do
            let ContractResponse{Maybe Value
err :: Maybe Value
err :: forall w e s h. ContractResponse w e s h -> Maybe e
err} = ContractResponse Value Value PABResp PABReq
resp
            Eff effs InstanceState
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask Eff effs InstanceState
-> (InstanceState -> Eff effs ()) -> Eff effs ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Eff effs ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff effs ())
-> (InstanceState -> IO ()) -> InstanceState -> Eff effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ())
-> (InstanceState -> STM ()) -> InstanceState -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Activity -> InstanceState -> STM ()
InstanceState.setActivity (Maybe Value -> Activity
Done Maybe Value
err)
        [Request PABReq]
_ -> do
            STM (Response PABResp)
response <- ContractInstanceId -> State t -> Eff effs (STM (Response PABResp))
forall (m :: * -> *) t (effs :: [* -> *]).
(LastMember m effs, MonadIO m, Member ChainIndexQueryEffect effs,
 Member WalletEffect effs, Member NodeClientEffect effs,
 Member (LogMsg RequestHandlerLogMsg) effs,
 Member (LogObserve (LogMessage Text)) effs,
 Member (LogMsg (ContractInstanceMsg t)) effs,
 Member (Reader ContractInstanceId) effs,
 Member (Reader BlockchainEnv) effs,
 Member (Reader InstanceState) effs, PABContract t) =>
ContractInstanceId -> State t -> Eff effs (STM (Response PABResp))
respondToRequestsSTM @_ @t ContractInstanceId
instanceId State t
currentState
            let rsp' :: STM (Either () (Response PABResp))
rsp' = Response PABResp -> Either () (Response PABResp)
forall a b. b -> Either a b
Right (Response PABResp -> Either () (Response PABResp))
-> STM (Response PABResp) -> STM (Either () (Response PABResp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM (Response PABResp)
response
                stop :: STM (Either () (Response PABResp))
stop = () -> Either () (Response PABResp)
forall a b. a -> Either a b
Left (() -> Either () (Response PABResp))
-> STM () -> STM (Either () (Response PABResp))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TMVar () -> STM ()
forall a. TMVar a -> STM a
STM.takeTMVar TMVar ()
issStop
            Either () (Response PABResp)
event <- IO (Either () (Response PABResp))
-> Eff effs (Either () (Response PABResp))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either () (Response PABResp))
 -> Eff effs (Either () (Response PABResp)))
-> IO (Either () (Response PABResp))
-> Eff effs (Either () (Response PABResp))
forall a b. (a -> b) -> a -> b
$ STM (Either () (Response PABResp))
-> IO (Either () (Response PABResp))
forall a. STM a -> IO a
STM.atomically (STM (Either () (Response PABResp))
stop STM (Either () (Response PABResp))
-> STM (Either () (Response PABResp))
-> STM (Either () (Response PABResp))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> STM (Either () (Response PABResp))
rsp')
            case Either () (Response PABResp)
event of
                Left () -> do
                    Eff effs InstanceState
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask Eff effs InstanceState
-> (InstanceState -> Eff effs ()) -> Eff effs ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Eff effs ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff effs ())
-> (InstanceState -> IO ()) -> InstanceState -> Eff effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ())
-> (InstanceState -> STM ()) -> InstanceState -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Activity -> InstanceState -> STM ()
InstanceState.setActivity Activity
Stopped
                Right Response PABResp
event' -> do
                    (newState :: Contract.State t) <- ContractInstanceId
-> ContractDef t
-> State t
-> Response PABResp
-> Eff effs (State t)
forall t (effs :: [* -> *]).
(Member (ContractEffect t) effs, PABContract t) =>
ContractInstanceId
-> ContractDef t
-> State t
-> Response PABResp
-> Eff effs (State t)
Contract.updateContract @t ContractInstanceId
instanceId (ContractActivationArgs (ContractDef t) -> ContractDef t
forall t. ContractActivationArgs t -> t
caID ContractActivationArgs (ContractDef t)
def) State t
currentState Response PABResp
event'
                    ContractActivationArgs (ContractDef t)
-> ContractInstanceId -> State t -> Eff effs ()
forall t (effs :: [* -> *]).
Member (ContractStore t) effs =>
ContractActivationArgs (ContractDef t)
-> ContractInstanceId -> State t -> Eff effs ()
Contract.putState @t ContractActivationArgs (ContractDef t)
def ContractInstanceId
instanceId State t
newState
                    ContractActivationArgs (ContractDef t)
-> ContractInstanceId -> Eff effs ()
forall t (m :: * -> *) (effs :: [* -> *]).
(AppBackendConstraints t m effs,
 Member (Reader InstanceState) effs,
 Member (Reader ContractInstanceId) effs, PABContract t) =>
ContractActivationArgs (ContractDef t)
-> ContractInstanceId -> Eff effs ()
stmInstanceLoop @t ContractActivationArgs (ContractDef t)
def ContractInstanceId
instanceId

-- | Update the TVars in the 'InstanceState' with data from the list
--   of requests.
updateState ::
    forall m effs.
    ( LastMember m effs
    , MonadIO m
    , Member (Reader InstanceState) effs
    )
    => ContractResponse Value Value PABResp PABReq
    -> Eff effs ()
updateState :: ContractResponse Value Value PABResp PABReq -> Eff effs ()
updateState ContractResponse{newState :: forall w e s h.
ContractResponse w e s h -> State w (CheckpointKey, s)
newState = State{Value
observableState :: Value
observableState :: forall w e. State w e -> w
observableState}, [Request PABReq]
hooks :: [Request PABReq]
hooks :: forall w e s h. ContractResponse w e s h -> [Request h]
hooks} = do
    InstanceState
state <- Eff effs InstanceState
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask
    IO () -> Eff effs ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff effs ()) -> IO () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        InstanceState -> STM ()
InstanceState.clearEndpoints InstanceState
state
        [Request PABReq] -> (Request PABReq -> STM ()) -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Request PABReq]
hooks ((Request PABReq -> STM ()) -> STM ())
-> (Request PABReq -> STM ()) -> STM ()
forall a b. (a -> b) -> a -> b
$ \Request PABReq
r -> do
            case Request PABReq -> PABReq
forall o. Request o -> o
rqRequest Request PABReq
r of
                ExposeEndpointReq ActiveEndpoint
endpoint -> Request ActiveEndpoint -> InstanceState -> STM ()
InstanceState.addEndpoint (Request PABReq
r { rqRequest :: ActiveEndpoint
rqRequest = ActiveEndpoint
endpoint}) InstanceState
state
                AwaitUtxoSpentReq TxOutRef
txOutRef -> Request TxOutRef -> InstanceState -> STM ()
InstanceState.addUtxoSpentReq (Request PABReq
r { rqRequest :: TxOutRef
rqRequest = TxOutRef
txOutRef }) InstanceState
state
                AwaitUtxoProducedReq CardanoAddress
addr  -> Request CardanoAddress -> InstanceState -> STM ()
InstanceState.addUtxoProducedReq (Request PABReq
r { rqRequest :: CardanoAddress
rqRequest = CardanoAddress
addr }) InstanceState
state
                PABReq
_                          -> () -> STM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Value -> InstanceState -> STM ()
InstanceState.setObservableState Value
observableState InstanceState
state

-- | Run the STM-based request handler on a non-empty list
--   of requests.
respondToRequestsSTM ::
    forall m t effs.
    ( LastMember m effs
    , MonadIO m
    , Member ChainIndexQueryEffect effs
    , Member WalletEffect effs
    , Member NodeClientEffect effs
    , Member (LogMsg RequestHandlerLogMsg) effs
    , Member (LogObserve (LogMessage Text.Text)) effs
    , Member (LogMsg (ContractInstanceMsg t)) effs
    , Member (Reader ContractInstanceId) effs
    , Member (Reader BlockchainEnv) effs
    , Member (Reader InstanceState) effs
    , Contract.PABContract t
    )
    => ContractInstanceId
    -> Contract.State t
    -> Eff effs (STM (Response PABResp))
respondToRequestsSTM :: ContractInstanceId -> State t -> Eff effs (STM (Response PABResp))
respondToRequestsSTM ContractInstanceId
instanceId State t
currentState = do
    let rqs :: [Request PABReq]
rqs = State t -> [Request PABReq]
forall contract.
PABContract contract =>
State contract -> [Request PABReq]
Contract.requests @t State t
currentState
    forall (effs :: [* -> *]).
Member (LogMsg (ContractInstanceMsg t)) effs =>
ContractInstanceMsg t -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logDebug @(ContractInstanceMsg t) (ContractInstanceMsg t -> Eff effs ())
-> ContractInstanceMsg t -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ ContractInstanceId -> [Request PABReq] -> ContractInstanceMsg t
forall t.
ContractInstanceId -> [Request PABReq] -> ContractInstanceMsg t
HandlingRequests ContractInstanceId
instanceId [Request PABReq]
rqs
    RequestHandler effs (Request PABReq) (STM (Response PABResp))
-> [Request PABReq] -> Eff effs (STM (Response PABResp))
forall (f :: * -> *) (effs :: [* -> *]) req resp.
(Alternative f, Monad f) =>
RequestHandler effs req (f resp) -> [req] -> Eff effs (f resp)
tryHandler' RequestHandler effs (Request PABReq) (STM (Response PABResp))
forall (m :: * -> *) (effs :: [* -> *]).
(LastMember m effs, MonadIO m, Member ChainIndexQueryEffect effs,
 Member WalletEffect effs, Member NodeClientEffect effs,
 Member (LogMsg RequestHandlerLogMsg) effs,
 Member (LogObserve (LogMessage Text)) effs,
 Member (Reader ContractInstanceId) effs,
 Member (Reader BlockchainEnv) effs,
 Member (Reader InstanceState) effs) =>
RequestHandler effs (Request PABReq) (STM (Response PABResp))
stmRequestHandler [Request PABReq]
rqs