{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Plutus.PAB.Webserver.Handler
( apiHandler
, swagger
, getFullReport
, contractSchema
) where
import Cardano.Wallet.LocalClient.ExportTx (ExportTx)
import Control.Lens (preview)
import Control.Monad (join, unless)
import Control.Monad.Freer.Error (throwError)
import Data.Aeson qualified as JSON
import Data.Foldable (traverse_)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe, mapMaybe)
import Data.OpenApi.Schema (ToSchema)
import Data.Proxy (Proxy (Proxy))
import Data.Text (Text)
import Plutus.Contract.Effects (PABReq, _ExposeEndpointReq)
import Plutus.PAB.Core (PABAction)
import Plutus.PAB.Core qualified as Core
import Plutus.PAB.Effects.Contract qualified as Contract
import Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse (hooks), fromResp)
import Plutus.PAB.Types (PABError (ContractInstanceNotFound, EndpointCallError))
import Plutus.PAB.Webserver.API (API)
import Plutus.PAB.Webserver.Types (ContractActivationArgs (ContractActivationArgs, caID, caWallet),
ContractInstanceClientState (ContractInstanceClientState, cicContract, cicCurrentState, cicDefinition, cicStatus, cicWallet, cicYieldedExportTxs),
ContractReport (ContractReport, crActiveContractStates, crAvailableContracts),
ContractSignatureResponse (ContractSignatureResponse),
FullReport (FullReport, chainReport, contractReport), emptyChainReport)
import Servant ((:<|>) ((:<|>)))
import Servant.OpenApi (toOpenApi)
import Servant.Server qualified as Servant
import Servant.Swagger.UI (SwaggerSchemaUI', swaggerSchemaUIServer)
import Wallet.Emulator.Wallet (Wallet, WalletId, getWalletId, knownWallet)
import Wallet.Types (ContractActivityStatus (Active), ContractInstanceId, parseContractActivityStatus)
healthcheck :: forall t env. PABAction t env ()
healthcheck :: PABAction t env ()
healthcheck = () -> PABAction t env ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
getContractReport :: forall t env. Contract.PABContract t => PABAction t env (ContractReport (Contract.ContractDef t))
getContractReport :: PABAction t env (ContractReport (ContractDef t))
getContractReport = do
[ContractDef t]
contracts <- forall (effs :: [* -> *]).
Member (ContractDefinition t) effs =>
Eff effs [ContractDef t]
forall t (effs :: [* -> *]).
Member (ContractDefinition t) effs =>
Eff effs [ContractDef t]
Contract.getDefinitions @t
[ContractInstanceId]
activeContractIDs <- ((ContractInstanceId, ContractActivationArgs (ContractDef t))
-> ContractInstanceId)
-> [(ContractInstanceId, ContractActivationArgs (ContractDef t))]
-> [ContractInstanceId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ContractInstanceId, ContractActivationArgs (ContractDef t))
-> ContractInstanceId
forall a b. (a, b) -> a
fst ([(ContractInstanceId, ContractActivationArgs (ContractDef t))]
-> [ContractInstanceId])
-> (Map ContractInstanceId (ContractActivationArgs (ContractDef t))
-> [(ContractInstanceId, ContractActivationArgs (ContractDef t))])
-> Map ContractInstanceId (ContractActivationArgs (ContractDef t))
-> [ContractInstanceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ContractInstanceId (ContractActivationArgs (ContractDef t))
-> [(ContractInstanceId, ContractActivationArgs (ContractDef t))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map ContractInstanceId (ContractActivationArgs (ContractDef t))
-> [ContractInstanceId])
-> Eff
(PABEffects t env)
(Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
-> Eff (PABEffects t env) [ContractInstanceId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (effs :: [* -> *]).
Member (ContractStore t) effs =>
Eff
effs
(Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
forall t (effs :: [* -> *]).
Member (ContractStore t) effs =>
Eff
effs
(Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
Contract.getActiveContracts @t
[ContractSignatureResponse (ContractDef t)]
crAvailableContracts <- [ContractSignatureResponse (ContractDef t)]
-> Eff
(PABEffects t env) [ContractSignatureResponse (ContractDef t)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ContractSignatureResponse (ContractDef t)]
-> Eff
(PABEffects t env) [ContractSignatureResponse (ContractDef t)])
-> [ContractSignatureResponse (ContractDef t)]
-> Eff
(PABEffects t env) [ContractSignatureResponse (ContractDef t)]
forall a b. (a -> b) -> a -> b
$ (ContractDef t -> ContractSignatureResponse (ContractDef t))
-> [ContractDef t] -> [ContractSignatureResponse (ContractDef t)]
forall a b. (a -> b) -> [a] -> [b]
map ContractDef t -> ContractSignatureResponse (ContractDef t)
forall t. t -> ContractSignatureResponse t
ContractSignatureResponse [ContractDef t]
contracts
[(ContractInstanceId, PartiallyDecodedResponse PABReq)]
crActiveContractStates <- (ContractInstanceId
-> Eff
(PABEffects t env)
(ContractInstanceId, PartiallyDecodedResponse PABReq))
-> [ContractInstanceId]
-> Eff
(PABEffects t env)
[(ContractInstanceId, PartiallyDecodedResponse PABReq)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\ContractInstanceId
i -> ContractInstanceId -> Eff (PABEffects t env) (State t)
forall t (effs :: [* -> *]).
Member (ContractStore t) effs =>
ContractInstanceId -> Eff effs (State t)
Contract.getState @t ContractInstanceId
i Eff (PABEffects t env) (State t)
-> (State t
-> Eff
(PABEffects t env)
(ContractInstanceId, PartiallyDecodedResponse PABReq))
-> Eff
(PABEffects t env)
(ContractInstanceId, PartiallyDecodedResponse PABReq)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \State t
s -> (ContractInstanceId, PartiallyDecodedResponse PABReq)
-> Eff
(PABEffects t env)
(ContractInstanceId, PartiallyDecodedResponse PABReq)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ContractInstanceId
i, ContractResponse Value Value PABResp PABReq
-> PartiallyDecodedResponse PABReq
forall s v.
ContractResponse Value Value s v -> PartiallyDecodedResponse v
fromResp (ContractResponse Value Value PABResp PABReq
-> PartiallyDecodedResponse PABReq)
-> ContractResponse Value Value PABResp PABReq
-> PartiallyDecodedResponse PABReq
forall a b. (a -> b) -> a -> b
$ Proxy t -> State t -> ContractResponse Value Value PABResp PABReq
forall contract.
PABContract contract =>
Proxy contract
-> State contract -> ContractResponse Value Value PABResp PABReq
Contract.serialisableState (Proxy t
forall k (t :: k). Proxy t
Proxy @t) State t
s)) [ContractInstanceId]
activeContractIDs
ContractReport (ContractDef t)
-> PABAction t env (ContractReport (ContractDef t))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContractReport :: forall t.
[ContractSignatureResponse t]
-> [(ContractInstanceId, PartiallyDecodedResponse PABReq)]
-> ContractReport t
ContractReport {[ContractSignatureResponse (ContractDef t)]
crAvailableContracts :: [ContractSignatureResponse (ContractDef t)]
crAvailableContracts :: [ContractSignatureResponse (ContractDef t)]
crAvailableContracts, [(ContractInstanceId, PartiallyDecodedResponse PABReq)]
crActiveContractStates :: [(ContractInstanceId, PartiallyDecodedResponse PABReq)]
crActiveContractStates :: [(ContractInstanceId, PartiallyDecodedResponse PABReq)]
crActiveContractStates}
getFullReport :: forall t env. Contract.PABContract t => PABAction t env (FullReport (Contract.ContractDef t))
getFullReport :: PABAction t env (FullReport (ContractDef t))
getFullReport = do
ContractReport (ContractDef t)
contractReport <- forall env.
PABContract t =>
PABAction t env (ContractReport (ContractDef t))
forall t env.
PABContract t =>
PABAction t env (ContractReport (ContractDef t))
getContractReport @t
FullReport (ContractDef t)
-> PABAction t env (FullReport (ContractDef t))
forall (f :: * -> *) a. Applicative f => a -> f a
pure FullReport :: forall t. ContractReport t -> ChainReport -> FullReport t
FullReport {ContractReport (ContractDef t)
contractReport :: ContractReport (ContractDef t)
contractReport :: ContractReport (ContractDef t)
contractReport, chainReport :: ChainReport
chainReport = ChainReport
emptyChainReport}
contractSchema :: forall t env. ContractInstanceId -> PABAction t env (ContractSignatureResponse (Contract.ContractDef t))
contractSchema :: ContractInstanceId
-> PABAction t env (ContractSignatureResponse (ContractDef t))
contractSchema ContractInstanceId
contractId = do
Maybe (ContractActivationArgs (ContractDef t))
def <- ContractInstanceId
-> Eff
(PABEffects t env) (Maybe (ContractActivationArgs (ContractDef t)))
forall t (effs :: [* -> *]).
Member (ContractStore t) effs =>
ContractInstanceId
-> Eff effs (Maybe (ContractActivationArgs (ContractDef t)))
Contract.getDefinition @t ContractInstanceId
contractId
case Maybe (ContractActivationArgs (ContractDef t))
def of
Just ContractActivationArgs{ContractDef t
caID :: ContractDef t
caID :: forall t. ContractActivationArgs t -> t
caID} -> ContractSignatureResponse (ContractDef t)
-> PABAction t env (ContractSignatureResponse (ContractDef t))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ContractSignatureResponse (ContractDef t)
-> PABAction t env (ContractSignatureResponse (ContractDef t)))
-> ContractSignatureResponse (ContractDef t)
-> PABAction t env (ContractSignatureResponse (ContractDef t))
forall a b. (a -> b) -> a -> b
$ ContractDef t -> ContractSignatureResponse (ContractDef t)
forall t. t -> ContractSignatureResponse t
ContractSignatureResponse ContractDef t
caID
Maybe (ContractActivationArgs (ContractDef t))
Nothing -> PABError
-> PABAction t env (ContractSignatureResponse (ContractDef t))
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (ContractInstanceId -> PABError
ContractInstanceNotFound ContractInstanceId
contractId)
apiHandler ::
forall t env.
Contract.PABContract t =>
PABAction t env ()
:<|> PABAction t env (FullReport (Contract.ContractDef t))
:<|> (ContractActivationArgs (Contract.ContractDef t) -> PABAction t env ContractInstanceId)
:<|> (ContractInstanceId -> PABAction t env (ContractInstanceClientState (Contract.ContractDef t))
:<|> PABAction t env (ContractSignatureResponse (Contract.ContractDef t))
:<|> (String -> JSON.Value -> PABAction t env ())
:<|> PABAction t env ()
)
:<|> (WalletId -> Maybe Text -> PABAction t env [ContractInstanceClientState (Contract.ContractDef t)])
:<|> (Maybe Text -> PABAction t env [ContractInstanceClientState (Contract.ContractDef t)])
:<|> PABAction t env [ContractSignatureResponse (Contract.ContractDef t)]
apiHandler :: PABAction t env ()
:<|> (PABAction t env (FullReport (ContractDef t))
:<|> ((ContractActivationArgs (ContractDef t)
-> PABAction t env ContractInstanceId)
:<|> ((ContractInstanceId
-> PABAction t env (ContractInstanceClientState (ContractDef t))
:<|> (PABAction t env (ContractSignatureResponse (ContractDef t))
:<|> ((String -> Value -> PABAction t env ())
:<|> PABAction t env ())))
:<|> ((WalletId
-> Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> ((Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> PABAction
t env [ContractSignatureResponse (ContractDef t)])))))
apiHandler =
PABAction t env ()
forall t env. PABAction t env ()
healthcheck
PABAction t env ()
-> (PABAction t env (FullReport (ContractDef t))
:<|> ((ContractActivationArgs (ContractDef t)
-> PABAction t env ContractInstanceId)
:<|> ((ContractInstanceId
-> PABAction t env (ContractInstanceClientState (ContractDef t))
:<|> (PABAction t env (ContractSignatureResponse (ContractDef t))
:<|> ((String -> Value -> PABAction t env ())
:<|> PABAction t env ())))
:<|> ((WalletId
-> Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> ((Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> PABAction
t env [ContractSignatureResponse (ContractDef t)])))))
-> PABAction t env ()
:<|> (PABAction t env (FullReport (ContractDef t))
:<|> ((ContractActivationArgs (ContractDef t)
-> PABAction t env ContractInstanceId)
:<|> ((ContractInstanceId
-> PABAction t env (ContractInstanceClientState (ContractDef t))
:<|> (PABAction t env (ContractSignatureResponse (ContractDef t))
:<|> ((String -> Value -> PABAction t env ())
:<|> PABAction t env ())))
:<|> ((WalletId
-> Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> ((Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> PABAction
t env [ContractSignatureResponse (ContractDef t)])))))
forall a b. a -> b -> a :<|> b
:<|> PABAction t env (FullReport (ContractDef t))
forall t env.
PABContract t =>
PABAction t env (FullReport (ContractDef t))
getFullReport
PABAction t env (FullReport (ContractDef t))
-> ((ContractActivationArgs (ContractDef t)
-> PABAction t env ContractInstanceId)
:<|> ((ContractInstanceId
-> PABAction t env (ContractInstanceClientState (ContractDef t))
:<|> (PABAction t env (ContractSignatureResponse (ContractDef t))
:<|> ((String -> Value -> PABAction t env ())
:<|> PABAction t env ())))
:<|> ((WalletId
-> Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> ((Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> PABAction
t env [ContractSignatureResponse (ContractDef t)]))))
-> PABAction t env (FullReport (ContractDef t))
:<|> ((ContractActivationArgs (ContractDef t)
-> PABAction t env ContractInstanceId)
:<|> ((ContractInstanceId
-> PABAction t env (ContractInstanceClientState (ContractDef t))
:<|> (PABAction t env (ContractSignatureResponse (ContractDef t))
:<|> ((String -> Value -> PABAction t env ())
:<|> PABAction t env ())))
:<|> ((WalletId
-> Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> ((Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> PABAction
t env [ContractSignatureResponse (ContractDef t)]))))
forall a b. a -> b -> a :<|> b
:<|> ContractActivationArgs (ContractDef t)
-> PABAction t env ContractInstanceId
forall t env.
PABContract t =>
ContractActivationArgs (ContractDef t)
-> PABAction t env ContractInstanceId
activateContract
(ContractActivationArgs (ContractDef t)
-> PABAction t env ContractInstanceId)
-> ((ContractInstanceId
-> PABAction t env (ContractInstanceClientState (ContractDef t))
:<|> (PABAction t env (ContractSignatureResponse (ContractDef t))
:<|> ((String -> Value -> PABAction t env ())
:<|> PABAction t env ())))
:<|> ((WalletId
-> Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> ((Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> PABAction t env [ContractSignatureResponse (ContractDef t)])))
-> (ContractActivationArgs (ContractDef t)
-> PABAction t env ContractInstanceId)
:<|> ((ContractInstanceId
-> PABAction t env (ContractInstanceClientState (ContractDef t))
:<|> (PABAction t env (ContractSignatureResponse (ContractDef t))
:<|> ((String -> Value -> PABAction t env ())
:<|> PABAction t env ())))
:<|> ((WalletId
-> Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> ((Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> PABAction t env [ContractSignatureResponse (ContractDef t)])))
forall a b. a -> b -> a :<|> b
:<|> (\ContractInstanceId
cid -> ContractInstanceId
-> PABAction t env (ContractInstanceClientState (ContractDef t))
forall t env.
PABContract t =>
ContractInstanceId
-> PABAction t env (ContractInstanceClientState (ContractDef t))
contractInstanceState ContractInstanceId
cid PABAction t env (ContractInstanceClientState (ContractDef t))
-> (PABAction t env (ContractSignatureResponse (ContractDef t))
:<|> ((String -> Value -> PABAction t env ())
:<|> PABAction t env ()))
-> PABAction t env (ContractInstanceClientState (ContractDef t))
:<|> (PABAction t env (ContractSignatureResponse (ContractDef t))
:<|> ((String -> Value -> PABAction t env ())
:<|> PABAction t env ()))
forall a b. a -> b -> a :<|> b
:<|> ContractInstanceId
-> PABAction t env (ContractSignatureResponse (ContractDef t))
forall t env.
ContractInstanceId
-> PABAction t env (ContractSignatureResponse (ContractDef t))
contractSchema ContractInstanceId
cid PABAction t env (ContractSignatureResponse (ContractDef t))
-> ((String -> Value -> PABAction t env ())
:<|> PABAction t env ())
-> PABAction t env (ContractSignatureResponse (ContractDef t))
:<|> ((String -> Value -> PABAction t env ())
:<|> PABAction t env ())
forall a b. a -> b -> a :<|> b
:<|> (\String
y Value
z -> ContractInstanceId -> String -> Value -> PABAction t env ()
forall t env.
ContractInstanceId -> String -> Value -> PABAction t env ()
callEndpoint ContractInstanceId
cid String
y Value
z) (String -> Value -> PABAction t env ())
-> PABAction t env ()
-> (String -> Value -> PABAction t env ()) :<|> PABAction t env ()
forall a b. a -> b -> a :<|> b
:<|> ContractInstanceId -> PABAction t env ()
forall t env. ContractInstanceId -> PABAction t env ()
shutdown ContractInstanceId
cid)
(ContractInstanceId
-> PABAction t env (ContractInstanceClientState (ContractDef t))
:<|> (PABAction t env (ContractSignatureResponse (ContractDef t))
:<|> ((String -> Value -> PABAction t env ())
:<|> PABAction t env ())))
-> ((WalletId
-> Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> ((Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> PABAction t env [ContractSignatureResponse (ContractDef t)]))
-> (ContractInstanceId
-> PABAction t env (ContractInstanceClientState (ContractDef t))
:<|> (PABAction t env (ContractSignatureResponse (ContractDef t))
:<|> ((String -> Value -> PABAction t env ())
:<|> PABAction t env ())))
:<|> ((WalletId
-> Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> ((Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> PABAction t env [ContractSignatureResponse (ContractDef t)]))
forall a b. a -> b -> a :<|> b
:<|> WalletId
-> Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)]
forall t env.
PABContract t =>
WalletId
-> Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)]
instancesForWallets
(WalletId
-> Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
-> ((Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> PABAction t env [ContractSignatureResponse (ContractDef t)])
-> (WalletId
-> Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> ((Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> PABAction t env [ContractSignatureResponse (ContractDef t)])
forall a b. a -> b -> a :<|> b
:<|> Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)]
forall t env.
PABContract t =>
Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)]
allInstanceStates
(Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
-> PABAction t env [ContractSignatureResponse (ContractDef t)]
-> (Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)])
:<|> PABAction t env [ContractSignatureResponse (ContractDef t)]
forall a b. a -> b -> a :<|> b
:<|> PABAction t env [ContractSignatureResponse (ContractDef t)]
forall t env.
PABAction t env [ContractSignatureResponse (ContractDef t)]
availableContracts
swagger :: forall t api dir. (Servant.Server api ~ Servant.Handler JSON.Value, ToSchema (Contract.ContractDef t)) => Servant.Server (SwaggerSchemaUI' dir api)
swagger :: Server (SwaggerSchemaUI' dir api)
swagger = OpenApi -> Server (SwaggerSchemaUI' dir api)
forall api a (dir :: Symbol).
(Server api ~ Handler Value, ToJSON a) =>
a -> Server (SwaggerSchemaUI' dir api)
swaggerSchemaUIServer (OpenApi -> Server (SwaggerSchemaUI' dir api))
-> OpenApi -> Server (SwaggerSchemaUI' dir api)
forall a b. (a -> b) -> a -> b
$ Proxy (API (ContractDef t) Integer) -> OpenApi
forall k (api :: k). HasOpenApi api => Proxy api -> OpenApi
toOpenApi (Proxy (API (ContractDef t) Integer)
forall k (t :: k). Proxy t
Proxy @(API (Contract.ContractDef t) Integer))
fromInternalState
:: t
-> ContractInstanceId
-> ContractActivityStatus
-> Wallet
-> [ExportTx]
-> PartiallyDecodedResponse PABReq
-> ContractInstanceClientState t
fromInternalState :: t
-> ContractInstanceId
-> ContractActivityStatus
-> Wallet
-> [ExportTx]
-> PartiallyDecodedResponse PABReq
-> ContractInstanceClientState t
fromInternalState t
t ContractInstanceId
i ContractActivityStatus
s Wallet
wallet [ExportTx]
yieldedExportTxs PartiallyDecodedResponse PABReq
resp =
ContractInstanceClientState :: forall t.
ContractInstanceId
-> PartiallyDecodedResponse ActiveEndpoint
-> Wallet
-> t
-> ContractActivityStatus
-> [ExportTx]
-> ContractInstanceClientState t
ContractInstanceClientState
{ cicContract :: ContractInstanceId
cicContract = ContractInstanceId
i
, cicCurrentState :: PartiallyDecodedResponse ActiveEndpoint
cicCurrentState =
let hks' :: [Request ActiveEndpoint]
hks' = (Request PABReq -> Maybe (Request ActiveEndpoint))
-> [Request PABReq] -> [Request ActiveEndpoint]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((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 (Getting (First ActiveEndpoint) PABReq ActiveEndpoint
-> PABReq -> Maybe ActiveEndpoint
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ActiveEndpoint) PABReq ActiveEndpoint
Prism' PABReq ActiveEndpoint
_ExposeEndpointReq)) (PartiallyDecodedResponse PABReq -> [Request PABReq]
forall v. PartiallyDecodedResponse v -> [Request v]
hooks PartiallyDecodedResponse PABReq
resp)
in PartiallyDecodedResponse PABReq
resp { hooks :: [Request ActiveEndpoint]
hooks = [Request ActiveEndpoint]
hks' }
, cicWallet :: Wallet
cicWallet = Wallet
wallet
, cicDefinition :: t
cicDefinition = t
t
, cicStatus :: ContractActivityStatus
cicStatus = ContractActivityStatus
s
, cicYieldedExportTxs :: [ExportTx]
cicYieldedExportTxs = [ExportTx]
yieldedExportTxs
}
activateContract :: forall t env. Contract.PABContract t => ContractActivationArgs (Contract.ContractDef t) -> PABAction t env ContractInstanceId
activateContract :: ContractActivationArgs (ContractDef t)
-> PABAction t env ContractInstanceId
activateContract 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
Wallet -> ContractDef t -> PABAction t env ContractInstanceId
forall t env.
PABContract t =>
Wallet -> ContractDef t -> PABAction t env ContractInstanceId
Core.activateContract (Wallet -> Maybe Wallet -> Wallet
forall a. a -> Maybe a -> a
fromMaybe (Integer -> Wallet
knownWallet Integer
1) Maybe Wallet
caWallet) ContractDef t
caID
contractInstanceState
:: forall t env. Contract.PABContract t
=> ContractInstanceId
-> PABAction t env (ContractInstanceClientState (Contract.ContractDef t))
contractInstanceState :: ContractInstanceId
-> PABAction t env (ContractInstanceClientState (ContractDef t))
contractInstanceState ContractInstanceId
i = do
Maybe (ContractActivationArgs (ContractDef t))
definition <- ContractInstanceId
-> Eff
(PABEffects t env) (Maybe (ContractActivationArgs (ContractDef t)))
forall t (effs :: [* -> *]).
Member (ContractStore t) effs =>
ContractInstanceId
-> Eff effs (Maybe (ContractActivationArgs (ContractDef t)))
Contract.getDefinition @t ContractInstanceId
i
ContractActivityStatus
s <- ContractInstanceId -> PABAction t env ContractActivityStatus
forall t env.
ContractInstanceId -> PABAction t env ContractActivityStatus
Core.waitForInstanceStateWithResult ContractInstanceId
i
case Maybe (ContractActivationArgs (ContractDef t))
definition of
Just ContractActivationArgs{Maybe Wallet
caWallet :: Maybe Wallet
caWallet :: forall t. ContractActivationArgs t -> Maybe Wallet
caWallet, ContractDef t
caID :: ContractDef t
caID :: forall t. ContractActivationArgs t -> t
caID} -> do
let wallet :: Wallet
wallet = Wallet -> Maybe Wallet -> Wallet
forall a. a -> Maybe a -> a
fromMaybe (Integer -> Wallet
knownWallet Integer
1) Maybe Wallet
caWallet
[ExportTx]
yieldedExportedTxs <- ContractInstanceId -> PABAction t env [ExportTx]
forall t env. ContractInstanceId -> PABAction t env [ExportTx]
Core.yieldedExportTxs ContractInstanceId
i
ContractInstanceClientState (ContractDef t)
istate <- (State t -> ContractInstanceClientState (ContractDef t))
-> Eff (PABEffects t env) (State t)
-> PABAction t env (ContractInstanceClientState (ContractDef t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( ContractDef t
-> ContractInstanceId
-> ContractActivityStatus
-> Wallet
-> [ExportTx]
-> PartiallyDecodedResponse PABReq
-> ContractInstanceClientState (ContractDef t)
forall t.
t
-> ContractInstanceId
-> ContractActivityStatus
-> Wallet
-> [ExportTx]
-> PartiallyDecodedResponse PABReq
-> ContractInstanceClientState t
fromInternalState ContractDef t
caID ContractInstanceId
i ContractActivityStatus
s Wallet
wallet [ExportTx]
yieldedExportedTxs
(PartiallyDecodedResponse PABReq
-> ContractInstanceClientState (ContractDef t))
-> (State t -> PartiallyDecodedResponse PABReq)
-> State t
-> ContractInstanceClientState (ContractDef t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractResponse Value Value PABResp PABReq
-> PartiallyDecodedResponse PABReq
forall s v.
ContractResponse Value Value s v -> PartiallyDecodedResponse v
fromResp
(ContractResponse Value Value PABResp PABReq
-> PartiallyDecodedResponse PABReq)
-> (State t -> ContractResponse Value Value PABResp PABReq)
-> State t
-> PartiallyDecodedResponse PABReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy t -> State t -> ContractResponse Value Value PABResp PABReq
forall contract.
PABContract contract =>
Proxy contract
-> State contract -> ContractResponse Value Value PABResp PABReq
Contract.serialisableState (Proxy t
forall k (t :: k). Proxy t
Proxy @t)
) (Eff (PABEffects t env) (State t)
-> PABAction t env (ContractInstanceClientState (ContractDef t)))
-> Eff (PABEffects t env) (State t)
-> PABAction t env (ContractInstanceClientState (ContractDef t))
forall a b. (a -> b) -> a -> b
$ ContractInstanceId -> Eff (PABEffects t env) (State t)
forall t (effs :: [* -> *]).
Member (ContractStore t) effs =>
ContractInstanceId -> Eff effs (State t)
Contract.getState @t ContractInstanceId
i
ContractActivityStatus -> ContractInstanceId -> PABAction t env ()
forall t env.
ContractActivityStatus -> ContractInstanceId -> PABAction t env ()
removeUnlessActive ContractActivityStatus
s ContractInstanceId
i
ContractInstanceClientState (ContractDef t)
-> PABAction t env (ContractInstanceClientState (ContractDef t))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContractInstanceClientState (ContractDef t)
istate
Maybe (ContractActivationArgs (ContractDef t))
_ -> PABError
-> PABAction t env (ContractInstanceClientState (ContractDef t))
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError @PABError (ContractInstanceId -> PABError
ContractInstanceNotFound ContractInstanceId
i)
removeUnlessActive :: ContractActivityStatus -> ContractInstanceId -> PABAction t env ()
removeUnlessActive :: ContractActivityStatus -> ContractInstanceId -> PABAction t env ()
removeUnlessActive ContractActivityStatus
s ContractInstanceId
i = Bool -> PABAction t env () -> PABAction t env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ContractActivityStatus
s ContractActivityStatus -> ContractActivityStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ContractActivityStatus
Active) (ContractInstanceId -> PABAction t env ()
forall t env. ContractInstanceId -> PABAction t env ()
Core.removeInstance ContractInstanceId
i)
callEndpoint :: forall t env. ContractInstanceId -> String -> JSON.Value -> PABAction t env ()
callEndpoint :: ContractInstanceId -> String -> Value -> PABAction t env ()
callEndpoint ContractInstanceId
a String
b Value
v = ContractInstanceId
-> String -> Value -> PABAction t env (Maybe NotificationError)
forall t env a.
ToJSON a =>
ContractInstanceId
-> String -> a -> PABAction t env (Maybe NotificationError)
Core.callEndpointOnInstance ContractInstanceId
a String
b Value
v PABAction t env (Maybe NotificationError)
-> (Maybe NotificationError -> PABAction t env ())
-> PABAction t env ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (NotificationError -> Eff (PABEffects t env) Any)
-> Maybe NotificationError -> PABAction t env ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (effs :: [* -> *]) a.
Member (Error PABError) effs =>
PABError -> Eff effs a
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError @PABError (PABError -> Eff (PABEffects t env) Any)
-> (NotificationError -> PABError)
-> NotificationError
-> Eff (PABEffects t env) Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NotificationError -> PABError
EndpointCallError)
instancesForWallets :: forall t env. Contract.PABContract t => WalletId -> Maybe Text -> PABAction t env [ContractInstanceClientState (Contract.ContractDef t)]
instancesForWallets :: WalletId
-> Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)]
instancesForWallets WalletId
wallet Maybe Text
mStatus = (ContractInstanceClientState (ContractDef t) -> Bool)
-> [ContractInstanceClientState (ContractDef t)]
-> [ContractInstanceClientState (ContractDef t)]
forall a. (a -> Bool) -> [a] -> [a]
filter (WalletId -> WalletId -> Bool
forall a. Eq a => a -> a -> Bool
(==) WalletId
wallet (WalletId -> Bool)
-> (ContractInstanceClientState (ContractDef t) -> WalletId)
-> ContractInstanceClientState (ContractDef t)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> WalletId
getWalletId (Wallet -> WalletId)
-> (ContractInstanceClientState (ContractDef t) -> Wallet)
-> ContractInstanceClientState (ContractDef t)
-> WalletId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractInstanceClientState (ContractDef t) -> Wallet
forall t. ContractInstanceClientState t -> Wallet
cicWallet) ([ContractInstanceClientState (ContractDef t)]
-> [ContractInstanceClientState (ContractDef t)])
-> PABAction t env [ContractInstanceClientState (ContractDef t)]
-> PABAction t env [ContractInstanceClientState (ContractDef t)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)]
forall t env.
PABContract t =>
Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)]
allInstanceStates Maybe Text
mStatus
allInstanceStates :: forall t env. Contract.PABContract t => Maybe Text -> PABAction t env [ContractInstanceClientState (Contract.ContractDef t)]
allInstanceStates :: Maybe Text
-> PABAction t env [ContractInstanceClientState (ContractDef t)]
allInstanceStates Maybe Text
mStatus = do
Map ContractInstanceId ContractActivityStatus
instWithStatuses <- PABAction t env (Map ContractInstanceId ContractActivityStatus)
forall t env.
PABAction t env (Map ContractInstanceId ContractActivityStatus)
Core.instancesWithStatuses
let mActivityStatus :: Maybe ContractActivityStatus
mActivityStatus = Maybe (Maybe ContractActivityStatus)
-> Maybe ContractActivityStatus
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe ContractActivityStatus)
-> Maybe ContractActivityStatus)
-> Maybe (Maybe ContractActivityStatus)
-> Maybe ContractActivityStatus
forall a b. (a -> b) -> a -> b
$ Text -> Maybe ContractActivityStatus
parseContractActivityStatus (Text -> Maybe ContractActivityStatus)
-> Maybe Text -> Maybe (Maybe ContractActivityStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mStatus
isInstanceStatusMatch :: ContractActivityStatus -> Bool
isInstanceStatusMatch ContractActivityStatus
s = Bool
-> (ContractActivityStatus -> Bool)
-> Maybe ContractActivityStatus
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (ContractActivityStatus -> ContractActivityStatus -> Bool
forall a. Eq a => a -> a -> Bool
(==) ContractActivityStatus
s) Maybe ContractActivityStatus
mActivityStatus
getStatus :: (ContractInstanceId, ContractActivationArgs (ContractDef t))
-> Maybe
(ContractInstanceId, ContractActivationArgs (ContractDef t),
ContractActivityStatus)
getStatus (ContractInstanceId
i, ContractActivationArgs (ContractDef t)
args) = (ContractInstanceId
i, ContractActivationArgs (ContractDef t)
args,) (ContractActivityStatus
-> (ContractInstanceId, ContractActivationArgs (ContractDef t),
ContractActivityStatus))
-> Maybe ContractActivityStatus
-> Maybe
(ContractInstanceId, ContractActivationArgs (ContractDef t),
ContractActivityStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContractInstanceId
-> Map ContractInstanceId ContractActivityStatus
-> Maybe ContractActivityStatus
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ContractInstanceId
i Map ContractInstanceId ContractActivityStatus
instWithStatuses
get :: (ContractInstanceId, ContractActivationArgs (ContractDef t),
ContractActivityStatus)
-> Eff
(PABEffects t env) (ContractInstanceClientState (ContractDef t))
get (ContractInstanceId
i, ContractActivationArgs{Maybe Wallet
caWallet :: Maybe Wallet
caWallet :: forall t. ContractActivationArgs t -> Maybe Wallet
caWallet, ContractDef t
caID :: ContractDef t
caID :: forall t. ContractActivationArgs t -> t
caID}, ContractActivityStatus
s) =
let wallet :: Wallet
wallet = Wallet -> Maybe Wallet -> Wallet
forall a. a -> Maybe a -> a
fromMaybe (Integer -> Wallet
knownWallet Integer
1) Maybe Wallet
caWallet
in do
[ExportTx]
yieldedExportedTxs <- ContractInstanceId -> PABAction t env [ExportTx]
forall t env. ContractInstanceId -> PABAction t env [ExportTx]
Core.yieldedExportTxs ContractInstanceId
i
(State t -> ContractInstanceClientState (ContractDef t))
-> Eff (PABEffects t env) (State t)
-> Eff
(PABEffects t env) (ContractInstanceClientState (ContractDef t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( ContractDef t
-> ContractInstanceId
-> ContractActivityStatus
-> Wallet
-> [ExportTx]
-> PartiallyDecodedResponse PABReq
-> ContractInstanceClientState (ContractDef t)
forall t.
t
-> ContractInstanceId
-> ContractActivityStatus
-> Wallet
-> [ExportTx]
-> PartiallyDecodedResponse PABReq
-> ContractInstanceClientState t
fromInternalState ContractDef t
caID ContractInstanceId
i ContractActivityStatus
s Wallet
wallet [ExportTx]
yieldedExportedTxs
(PartiallyDecodedResponse PABReq
-> ContractInstanceClientState (ContractDef t))
-> (State t -> PartiallyDecodedResponse PABReq)
-> State t
-> ContractInstanceClientState (ContractDef t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractResponse Value Value PABResp PABReq
-> PartiallyDecodedResponse PABReq
forall s v.
ContractResponse Value Value s v -> PartiallyDecodedResponse v
fromResp
(ContractResponse Value Value PABResp PABReq
-> PartiallyDecodedResponse PABReq)
-> (State t -> ContractResponse Value Value PABResp PABReq)
-> State t
-> PartiallyDecodedResponse PABReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy t -> State t -> ContractResponse Value Value PABResp PABReq
forall contract.
PABContract contract =>
Proxy contract
-> State contract -> ContractResponse Value Value PABResp PABReq
Contract.serialisableState (Proxy t
forall k (t :: k). Proxy t
Proxy @t)
) (Eff (PABEffects t env) (State t)
-> Eff
(PABEffects t env) (ContractInstanceClientState (ContractDef t)))
-> Eff (PABEffects t env) (State t)
-> Eff
(PABEffects t env) (ContractInstanceClientState (ContractDef t))
forall a b. (a -> b) -> a -> b
$ ContractInstanceId -> Eff (PABEffects t env) (State t)
forall t (effs :: [* -> *]).
Member (ContractStore t) effs =>
ContractInstanceId -> Eff effs (State t)
Contract.getState @t ContractInstanceId
i
Map ContractInstanceId (ContractActivationArgs (ContractDef t))
mp <- Maybe ContractActivityStatus
-> Eff
(PABEffects t env)
(Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
forall t (effs :: [* -> *]).
Member (ContractStore t) effs =>
Maybe ContractActivityStatus
-> Eff
effs
(Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
Contract.getContracts @t Maybe ContractActivityStatus
mActivityStatus
(ContractInstanceClientState (ContractDef t) -> Bool)
-> [ContractInstanceClientState (ContractDef t)]
-> [ContractInstanceClientState (ContractDef t)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ContractActivityStatus -> Bool
isInstanceStatusMatch (ContractActivityStatus -> Bool)
-> (ContractInstanceClientState (ContractDef t)
-> ContractActivityStatus)
-> ContractInstanceClientState (ContractDef t)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractInstanceClientState (ContractDef t)
-> ContractActivityStatus
forall t. ContractInstanceClientState t -> ContractActivityStatus
cicStatus)
([ContractInstanceClientState (ContractDef t)]
-> [ContractInstanceClientState (ContractDef t)])
-> PABAction t env [ContractInstanceClientState (ContractDef t)]
-> PABAction t env [ContractInstanceClientState (ContractDef t)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ContractInstanceId, ContractActivationArgs (ContractDef t),
ContractActivityStatus)
-> Eff
(PABEffects t env) (ContractInstanceClientState (ContractDef t)))
-> [(ContractInstanceId, ContractActivationArgs (ContractDef t),
ContractActivityStatus)]
-> PABAction t env [ContractInstanceClientState (ContractDef t)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (ContractInstanceId, ContractActivationArgs (ContractDef t),
ContractActivityStatus)
-> Eff
(PABEffects t env) (ContractInstanceClientState (ContractDef t))
get (((ContractInstanceId, ContractActivationArgs (ContractDef t))
-> Maybe
(ContractInstanceId, ContractActivationArgs (ContractDef t),
ContractActivityStatus))
-> [(ContractInstanceId, ContractActivationArgs (ContractDef t))]
-> [(ContractInstanceId, ContractActivationArgs (ContractDef t),
ContractActivityStatus)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ContractInstanceId, ContractActivationArgs (ContractDef t))
-> Maybe
(ContractInstanceId, ContractActivationArgs (ContractDef t),
ContractActivityStatus)
getStatus ([(ContractInstanceId, ContractActivationArgs (ContractDef t))]
-> [(ContractInstanceId, ContractActivationArgs (ContractDef t),
ContractActivityStatus)])
-> [(ContractInstanceId, ContractActivationArgs (ContractDef t))]
-> [(ContractInstanceId, ContractActivationArgs (ContractDef t),
ContractActivityStatus)]
forall a b. (a -> b) -> a -> b
$ Map ContractInstanceId (ContractActivationArgs (ContractDef t))
-> [(ContractInstanceId, ContractActivationArgs (ContractDef t))]
forall k a. Map k a -> [(k, a)]
Map.toList Map ContractInstanceId (ContractActivationArgs (ContractDef t))
mp)
availableContracts :: forall t env. PABAction t env [ContractSignatureResponse (Contract.ContractDef t)]
availableContracts :: PABAction t env [ContractSignatureResponse (ContractDef t)]
availableContracts = do
(ContractDef t -> ContractSignatureResponse (ContractDef t))
-> [ContractDef t] -> [ContractSignatureResponse (ContractDef t)]
forall a b. (a -> b) -> [a] -> [b]
map ContractDef t -> ContractSignatureResponse (ContractDef t)
forall t. t -> ContractSignatureResponse t
ContractSignatureResponse ([ContractDef t] -> [ContractSignatureResponse (ContractDef t)])
-> Eff (PABEffects t env) [ContractDef t]
-> PABAction t env [ContractSignatureResponse (ContractDef t)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (effs :: [* -> *]).
Member (ContractDefinition t) effs =>
Eff effs [ContractDef t]
forall t (effs :: [* -> *]).
Member (ContractDefinition t) effs =>
Eff effs [ContractDef t]
Contract.getDefinitions @t
shutdown :: forall t env. ContractInstanceId -> PABAction t env ()
shutdown :: ContractInstanceId -> PABAction t env ()
shutdown ContractInstanceId
cid = do
ContractInstanceId -> PABAction t env ()
forall t env. ContractInstanceId -> PABAction t env ()
Core.stopInstance ContractInstanceId
cid
ContractInstanceId -> PABAction t env ()
forall t env. ContractInstanceId -> PABAction t env ()
Core.removeInstance ContractInstanceId
cid