{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DerivingStrategies  #-}
{-# LANGUAGE EmptyDataDeriving   #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE TypeOperators       #-}

{-
Builtin contracts that are compiled together with the PAB.
-}
module Plutus.PAB.Effects.Contract.Builtin(
    Builtin
    , ContractConstraints
    , SomeBuiltin(..)
    , SomeBuiltinState(..)
    , BuiltinHandler(..)
    , handleBuiltin
    -- * Extracting schemas from contracts
    , type (.\\)
    , type (.\/)
    , EmptySchema
    , Empty
    , getResponse
    , fromResponse
    , HasDefinitions(..)
    ) where


import Control.Monad (unless)
import Control.Monad.Freer
import Control.Monad.Freer.Error (Error, throwError)
import Control.Monad.Freer.Extras.Log (LogMsg (LMessage), logDebug, logError)
import Data.Aeson (FromJSON, ToJSON, Value)
import Data.Aeson qualified as JSON
import Data.Foldable (foldlM, traverse_)
import Data.OpenApi qualified as OpenApi
import Data.Proxy (Proxy (Proxy))
import Data.Row
import GHC.Generics (Generic)
import Plutus.Contract (ContractInstanceId, EmptySchema, IsContract (toContract))
import Plutus.Contract.Effects (PABReq, PABResp)
import Plutus.Contract.Resumable (Response, responses)
import Plutus.Contract.Schema (Input, Output)
import Plutus.Contract.State (ContractResponse (ContractResponse, newState), State (State, record))
import Plutus.Contract.State qualified as ContractState
import Plutus.Contract.Types (ResumableResult (ResumableResult, _finalState, _lastLogs, _lastState),
                              SuspendedContract (SuspendedContract, _resumableResult))
import Plutus.PAB.Core.ContractInstance.RequestHandlers (ContractInstanceMsg (ContractLog, ProcessFirstInboxMessage))
import Plutus.PAB.Effects.Contract (ContractEffect (InitialState, UpdateContract),
                                    PABContract (ContractDef, State, serialisableState))
import Plutus.PAB.Monitoring.PABLogMsg (PABMultiAgentMsg (ContractInstanceLog))
import Plutus.PAB.Types (PABError (ContractCommandError))
import Plutus.Trace.Emulator.Types (ContractInstanceStateInternal (ContractInstanceStateInternal, cisiSuspState))
import Plutus.Trace.Emulator.Types qualified as Emulator

-- | Contracts that are built into the PAB (ie. compiled with it) and receive
--   an initial value of type 'a'.
--
-- We have a dummy constructor so that we can convert this datatype in
-- Purescript with '(equal <*> (genericShow <*> mkSumType)) (Proxy @(Builtin A))'.
data Builtin a = Builtin deriving (Builtin a -> Builtin a -> Bool
(Builtin a -> Builtin a -> Bool)
-> (Builtin a -> Builtin a -> Bool) -> Eq (Builtin a)
forall a. Builtin a -> Builtin a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Builtin a -> Builtin a -> Bool
$c/= :: forall a. Builtin a -> Builtin a -> Bool
== :: Builtin a -> Builtin a -> Bool
$c== :: forall a. Builtin a -> Builtin a -> Bool
Eq, (forall x. Builtin a -> Rep (Builtin a) x)
-> (forall x. Rep (Builtin a) x -> Builtin a)
-> Generic (Builtin a)
forall x. Rep (Builtin a) x -> Builtin a
forall x. Builtin a -> Rep (Builtin a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Builtin a) x -> Builtin a
forall a x. Builtin a -> Rep (Builtin a) x
$cto :: forall a x. Rep (Builtin a) x -> Builtin a
$cfrom :: forall a x. Builtin a -> Rep (Builtin a) x
Generic)

instance OpenApi.ToSchema t => OpenApi.ToSchema (Builtin t) where
    declareNamedSchema :: Proxy (Builtin t) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Builtin t)
_ = Proxy t -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
OpenApi.declareNamedSchema (Proxy t
forall k (t :: k). Proxy t
Proxy :: Proxy t)

type ContractConstraints w schema error =
    ( Monoid w
    , Forall (Output schema) ToJSON
    , Forall (Input schema) ToJSON
    , Forall (Input schema) FromJSON
    , ToJSON error
    , ToJSON w
    , FromJSON w
    , AllUniqueLabels (Input schema)
    )

-- | Plutus contract with all parameters existentially quantified. Can be any contract that satisfies the
--   'ContractConstraints'.
data SomeBuiltin where
    SomeBuiltin
        :: forall contract w schema error a.
         ( ContractConstraints w schema error
         , IsContract contract
         )
        => contract w schema error a -> SomeBuiltin

data SomeBuiltinState a where
    SomeBuiltinState ::
        forall a w schema error b.
        ContractConstraints w schema error
        => Emulator.ContractInstanceStateInternal w schema error b -- ^ Internal state
        -> w -- ^ Observable state (stored separately)
        -> SomeBuiltinState a

instance PABContract (Builtin a) where
    type ContractDef (Builtin a) = a
    type State (Builtin a) = SomeBuiltinState a
    serialisableState :: Proxy (Builtin a)
-> State (Builtin a) -> ContractResponse Value Value PABResp PABReq
serialisableState Proxy (Builtin a)
_ = State (Builtin a) -> ContractResponse Value Value PABResp PABReq
forall a.
SomeBuiltinState a -> ContractResponse Value Value PABResp PABReq
getResponse

-- | Allows contract type `a` to specify its available contract definitions.
-- Also, for each contract type, we specify its contract function and its
-- schemas.
class HasDefinitions a where
    getDefinitions :: [a] -- ^ Available contract definitions for a contract type `a`
    getContract :: a -> SomeBuiltin -- ^ The actual contract function of contract type `a`

-- | Defined in order to prevent type errors like: "Couldn't match type 'effs'
-- with 'effs1'".
newtype BuiltinHandler a = BuiltinHandler
    { BuiltinHandler a
-> forall (effs :: [* -> *]).
   (Member (Error PABError) effs,
    Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs) =>
   ContractEffect (Builtin a) ~> Eff effs
contractHandler :: forall effs.
                         ( Member (Error PABError) effs
                         , Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs
                         )
                      => ContractEffect (Builtin a) ~> Eff effs
    }

-- | Handle the 'ContractEffect' for a builtin contract type with parameter
--   @a@.
handleBuiltin :: HasDefinitions a => BuiltinHandler a
handleBuiltin :: BuiltinHandler a
handleBuiltin = (forall (effs :: [* -> *]).
 (Member (Error PABError) effs,
  Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs) =>
 ContractEffect (Builtin a) ~> Eff effs)
-> BuiltinHandler a
forall a.
(forall (effs :: [* -> *]).
 (Member (Error PABError) effs,
  Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs) =>
 ContractEffect (Builtin a) ~> Eff effs)
-> BuiltinHandler a
BuiltinHandler ((forall (effs :: [* -> *]).
  (Member (Error PABError) effs,
   Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs) =>
  ContractEffect (Builtin a) ~> Eff effs)
 -> BuiltinHandler a)
-> (forall (effs :: [* -> *]).
    (Member (Error PABError) effs,
     Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs) =>
    ContractEffect (Builtin a) ~> Eff effs)
-> BuiltinHandler a
forall a b. (a -> b) -> a -> b
$ \case
    InitialState ContractInstanceId
i ContractDef (Builtin a)
c           -> case a -> SomeBuiltin
forall a. HasDefinitions a => a -> SomeBuiltin
getContract a
ContractDef (Builtin a)
c of SomeBuiltin contract w schema error a
c' -> ContractInstanceId
-> contract w schema error a -> Eff effs (SomeBuiltinState a)
forall (effs :: [* -> *]) a (contract :: * -> Row * -> * -> * -> *)
       w (schema :: Row *) error b.
(ContractConstraints w schema error,
 Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs,
 IsContract contract) =>
ContractInstanceId
-> contract w schema error b -> Eff effs (SomeBuiltinState a)
initBuiltin ContractInstanceId
i contract w schema error a
c'
    UpdateContract ContractInstanceId
i ContractDef (Builtin a)
_ State (Builtin a)
state Response PABResp
p -> case State (Builtin a)
state of SomeBuiltinState s w -> ContractInstanceId
-> ContractInstanceStateInternal w schema error b
-> w
-> Response PABResp
-> Eff effs (SomeBuiltinState a)
forall (effs :: [* -> *]) a w (schema :: Row *) error b.
(ContractConstraints w schema error, Member (Error PABError) effs,
 Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs) =>
ContractInstanceId
-> ContractInstanceStateInternal w schema error b
-> w
-> Response PABResp
-> Eff effs (SomeBuiltinState a)
updateBuiltin ContractInstanceId
i ContractInstanceStateInternal w schema error b
s w
w Response PABResp
p

getResponse :: forall a. SomeBuiltinState a -> ContractResponse Value Value PABResp PABReq
getResponse :: SomeBuiltinState a -> ContractResponse Value Value PABResp PABReq
getResponse (SomeBuiltinState ContractInstanceStateInternal w schema error b
s w
w) =
    (error -> Value)
-> ContractResponse Value error PABResp PABReq
-> ContractResponse Value Value PABResp PABReq
forall e f w s h.
(e -> f) -> ContractResponse w e s h -> ContractResponse w f s h
ContractState.mapE error -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON
    (ContractResponse Value error PABResp PABReq
 -> ContractResponse Value Value PABResp PABReq)
-> ContractResponse Value error PABResp PABReq
-> ContractResponse Value Value PABResp PABReq
forall a b. (a -> b) -> a -> b
$ (w -> Value)
-> ContractResponse w error PABResp PABReq
-> ContractResponse Value error PABResp PABReq
forall w q e s h.
(w -> q) -> ContractResponse w e s h -> ContractResponse q e s h
ContractState.mapW w -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON
    (ContractResponse w error PABResp PABReq
 -> ContractResponse Value error PABResp PABReq)
-> ContractResponse w error PABResp PABReq
-> ContractResponse Value error PABResp PABReq
forall a b. (a -> b) -> a -> b
$ w
-> ResumableResult w error PABResp PABReq b
-> ContractResponse w error PABResp PABReq
forall w e s h a.
Monoid w =>
w -> ResumableResult w e s h a -> ContractResponse w e s h
ContractState.mkResponse w
w
    (ResumableResult w error PABResp PABReq b
 -> ContractResponse w error PABResp PABReq)
-> ResumableResult w error PABResp PABReq b
-> ContractResponse w error PABResp PABReq
forall a b. (a -> b) -> a -> b
$ ContractInstanceState w schema error b
-> ResumableResult w error PABResp PABReq b
forall w (s :: Row *) e a.
ContractInstanceState w s e a
-> ResumableResult w e PABResp PABReq a
Emulator.instContractState
    (ContractInstanceState w schema error b
 -> ResumableResult w error PABResp PABReq b)
-> ContractInstanceState w schema error b
-> ResumableResult w error PABResp PABReq b
forall a b. (a -> b) -> a -> b
$ ContractInstanceStateInternal w schema error b
-> ContractInstanceState w schema error b
forall w (s :: Row *) e a.
ContractInstanceStateInternal w s e a
-> ContractInstanceState w s e a
Emulator.toInstanceState ContractInstanceStateInternal w schema error b
s

-- | Reconstruct a state from a serialised response by replaying back the
-- actions.
fromResponse :: forall a effs.
  ( Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs
  , Member (Error PABError) effs
  )
  => ContractInstanceId
  -> SomeBuiltin
  -> ContractResponse Value Value PABResp PABReq
  -> Eff effs (SomeBuiltinState a)
fromResponse :: ContractInstanceId
-> SomeBuiltin
-> ContractResponse Value Value PABResp PABReq
-> Eff effs (SomeBuiltinState a)
fromResponse ContractInstanceId
cid (SomeBuiltin contract w schema error a
contract) ContractResponse{newState :: forall w e s h.
ContractResponse w e s h -> State w (CheckpointKey, s)
newState=State{Responses (CheckpointKey, PABResp)
record :: Responses (CheckpointKey, PABResp)
record :: forall w e. State w e -> Responses e
record}} = do
  SomeBuiltinState a
initialState <- ContractInstanceId
-> contract w schema error a -> Eff effs (SomeBuiltinState a)
forall (effs :: [* -> *]) a (contract :: * -> Row * -> * -> * -> *)
       w (schema :: Row *) error b.
(ContractConstraints w schema error,
 Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs,
 IsContract contract) =>
ContractInstanceId
-> contract w schema error b -> Eff effs (SomeBuiltinState a)
initBuiltinSilently @effs @a ContractInstanceId
cid contract w schema error a
contract
  let runUpdate :: SomeBuiltinState a
-> Response (CheckpointKey, PABResp)
-> Eff effs (SomeBuiltinState a)
runUpdate (SomeBuiltinState ContractInstanceStateInternal w schema error b
oldS w
oldW) Response (CheckpointKey, PABResp)
n = do
          ContractInstanceId
-> ContractInstanceStateInternal w schema error b
-> w
-> Response PABResp
-> Eff effs (SomeBuiltinState a)
forall (effs :: [* -> *]) a w (schema :: Row *) error b.
(ContractConstraints w schema error, Member (Error PABError) effs,
 Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs) =>
ContractInstanceId
-> ContractInstanceStateInternal w schema error b
-> w
-> Response PABResp
-> Eff effs (SomeBuiltinState a)
updateBuiltinSilently @effs @a ContractInstanceId
cid ContractInstanceStateInternal w schema error b
oldS w
oldW ((CheckpointKey, PABResp) -> PABResp
forall a b. (a, b) -> b
snd ((CheckpointKey, PABResp) -> PABResp)
-> Response (CheckpointKey, PABResp) -> Response PABResp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response (CheckpointKey, PABResp)
n)
  (SomeBuiltinState a
 -> Response (CheckpointKey, PABResp)
 -> Eff effs (SomeBuiltinState a))
-> SomeBuiltinState a
-> [Response (CheckpointKey, PABResp)]
-> Eff effs (SomeBuiltinState a)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM SomeBuiltinState a
-> Response (CheckpointKey, PABResp)
-> Eff effs (SomeBuiltinState a)
runUpdate SomeBuiltinState a
initialState (Responses (CheckpointKey, PABResp)
-> [Response (CheckpointKey, PABResp)]
forall i. Responses i -> [Response i]
responses Responses (CheckpointKey, PABResp)
record)

initBuiltin, initBuiltinSilently ::
    forall effs a contract w schema error b.
    ( ContractConstraints w schema error
    , Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs
    , IsContract contract
    )
    => ContractInstanceId
    -> contract w schema error b
    -> Eff effs (SomeBuiltinState a)
initBuiltin :: ContractInstanceId
-> contract w schema error b -> Eff effs (SomeBuiltinState a)
initBuiltin = Bool
-> ContractInstanceId
-> contract w schema error b
-> Eff effs (SomeBuiltinState a)
forall (effs :: [* -> *]) a (contract :: * -> Row * -> * -> * -> *)
       w (schema :: Row *) error b.
(ContractConstraints w schema error,
 Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs,
 IsContract contract) =>
Bool
-> ContractInstanceId
-> contract w schema error b
-> Eff effs (SomeBuiltinState a)
initBuiltin' Bool
False
initBuiltinSilently :: ContractInstanceId
-> contract w schema error b -> Eff effs (SomeBuiltinState a)
initBuiltinSilently = Bool
-> ContractInstanceId
-> contract w schema error b
-> Eff effs (SomeBuiltinState a)
forall (effs :: [* -> *]) a (contract :: * -> Row * -> * -> * -> *)
       w (schema :: Row *) error b.
(ContractConstraints w schema error,
 Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs,
 IsContract contract) =>
Bool
-> ContractInstanceId
-> contract w schema error b
-> Eff effs (SomeBuiltinState a)
initBuiltin' Bool
True

initBuiltin' ::
    forall effs a contract w schema error b.
    ( ContractConstraints w schema error
    , Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs
    , IsContract contract
    )
    => Bool -- ^ If True, log new messages, otherwise stay silent.
    -> ContractInstanceId
    -> contract w schema error b
    -> Eff effs (SomeBuiltinState a)
initBuiltin' :: Bool
-> ContractInstanceId
-> contract w schema error b
-> Eff effs (SomeBuiltinState a)
initBuiltin' Bool
silent ContractInstanceId
i contract w schema error b
con = do
    let initialState :: ContractInstanceStateInternal w schema error b
initialState = Contract w schema error b
-> ContractInstanceStateInternal w schema error b
forall w (s :: Row *) e a.
Monoid w =>
Contract w s e a -> ContractInstanceStateInternal w s e a
Emulator.emptyInstanceState (contract w schema error b -> Contract w schema error b
forall (c :: * -> Row * -> * -> * -> *) w (s :: Row *) e a.
IsContract c =>
c w s e a -> Contract w s e a
toContract contract w schema error b
con)
    Bool -> Eff effs () -> Eff effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
silent (Eff effs () -> Eff effs ()) -> Eff effs () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ ContractInstanceId
-> ContractInstanceStateInternal w schema error b -> Eff effs ()
forall b w (s :: Row *) e a (effs :: [* -> *]).
(Member (LogMsg (PABMultiAgentMsg (Builtin b))) effs, ToJSON e) =>
ContractInstanceId
-> ContractInstanceStateInternal w s e a -> Eff effs ()
logNewMessages @a ContractInstanceId
i ContractInstanceStateInternal w schema error b
initialState
    SomeBuiltinState a -> Eff effs (SomeBuiltinState a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeBuiltinState a -> Eff effs (SomeBuiltinState a))
-> SomeBuiltinState a -> Eff effs (SomeBuiltinState a)
forall a b. (a -> b) -> a -> b
$ ContractInstanceStateInternal w schema error b
-> w -> SomeBuiltinState a
forall a w (schema :: Row *) error b.
ContractConstraints w schema error =>
ContractInstanceStateInternal w schema error b
-> w -> SomeBuiltinState a
SomeBuiltinState ContractInstanceStateInternal w schema error b
initialState w
forall a. Monoid a => a
mempty

updateBuiltin, updateBuiltinSilently ::
    forall effs a w schema error b.
    ( ContractConstraints w schema error
    , Member (Error PABError) effs
    , Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs
    )
    => ContractInstanceId
    -> Emulator.ContractInstanceStateInternal w schema error b
    -> w
    -> Response PABResp
    -> Eff effs (SomeBuiltinState a)
updateBuiltin :: ContractInstanceId
-> ContractInstanceStateInternal w schema error b
-> w
-> Response PABResp
-> Eff effs (SomeBuiltinState a)
updateBuiltin = Bool
-> ContractInstanceId
-> ContractInstanceStateInternal w schema error b
-> w
-> Response PABResp
-> Eff effs (SomeBuiltinState a)
forall (effs :: [* -> *]) a w (schema :: Row *) error b.
(ContractConstraints w schema error, Member (Error PABError) effs,
 Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs) =>
Bool
-> ContractInstanceId
-> ContractInstanceStateInternal w schema error b
-> w
-> Response PABResp
-> Eff effs (SomeBuiltinState a)
updateBuiltin' Bool
False
updateBuiltinSilently :: ContractInstanceId
-> ContractInstanceStateInternal w schema error b
-> w
-> Response PABResp
-> Eff effs (SomeBuiltinState a)
updateBuiltinSilently = Bool
-> ContractInstanceId
-> ContractInstanceStateInternal w schema error b
-> w
-> Response PABResp
-> Eff effs (SomeBuiltinState a)
forall (effs :: [* -> *]) a w (schema :: Row *) error b.
(ContractConstraints w schema error, Member (Error PABError) effs,
 Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs) =>
Bool
-> ContractInstanceId
-> ContractInstanceStateInternal w schema error b
-> w
-> Response PABResp
-> Eff effs (SomeBuiltinState a)
updateBuiltin' Bool
True

updateBuiltin' ::
    forall effs a w schema error b.
    ( ContractConstraints w schema error
    , Member (Error PABError) effs
    , Member (LogMsg (PABMultiAgentMsg (Builtin a))) effs
    )
    => Bool
    -> ContractInstanceId
    -> Emulator.ContractInstanceStateInternal w schema error b
    -> w
    -> Response PABResp
    -> Eff effs (SomeBuiltinState a)
updateBuiltin' :: Bool
-> ContractInstanceId
-> ContractInstanceStateInternal w schema error b
-> w
-> Response PABResp
-> Eff effs (SomeBuiltinState a)
updateBuiltin' Bool
silent ContractInstanceId
i ContractInstanceStateInternal w schema error b
oldState w
oldW Response PABResp
resp = do
    let newState :: Maybe (ContractInstanceStateInternal w schema error b)
newState = Response PABResp
-> ContractInstanceStateInternal w schema error b
-> Maybe (ContractInstanceStateInternal w schema error b)
forall w (s :: Row *) e a.
Monoid w =>
Response PABResp
-> ContractInstanceStateInternal w s e a
-> Maybe (ContractInstanceStateInternal w s e a)
Emulator.addEventInstanceState Response PABResp
resp ContractInstanceStateInternal w schema error b
oldState
    case Maybe (ContractInstanceStateInternal w schema error b)
newState of
        Just ContractInstanceStateInternal w schema error b
k -> do
            PABMultiAgentMsg (Builtin a) -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logDebug @(PABMultiAgentMsg (Builtin a))
                     (ContractInstanceMsg (Builtin a) -> PABMultiAgentMsg (Builtin a)
forall t. ContractInstanceMsg t -> PABMultiAgentMsg t
ContractInstanceLog (ContractInstanceMsg (Builtin a) -> PABMultiAgentMsg (Builtin a))
-> ContractInstanceMsg (Builtin a) -> PABMultiAgentMsg (Builtin a)
forall a b. (a -> b) -> a -> b
$ ContractInstanceId
-> Response PABResp -> ContractInstanceMsg (Builtin a)
forall t.
ContractInstanceId -> Response PABResp -> ContractInstanceMsg t
ProcessFirstInboxMessage ContractInstanceId
i Response PABResp
resp)
            Bool -> Eff effs () -> Eff effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
silent (Eff effs () -> Eff effs ()) -> Eff effs () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ ContractInstanceId
-> ContractInstanceStateInternal w schema error b -> Eff effs ()
forall b w (s :: Row *) e a (effs :: [* -> *]).
(Member (LogMsg (PABMultiAgentMsg (Builtin b))) effs, ToJSON e) =>
ContractInstanceId
-> ContractInstanceStateInternal w s e a -> Eff effs ()
logNewMessages @a ContractInstanceId
i ContractInstanceStateInternal w schema error b
k
            let newW :: w
newW = w
oldW w -> w -> w
forall a. Semigroup a => a -> a -> a
<> (ResumableResult w error PABResp PABReq b -> w
forall w e i o a. ResumableResult w e i o a -> w
_lastState (ResumableResult w error PABResp PABReq b -> w)
-> ResumableResult w error PABResp PABReq b -> w
forall a b. (a -> b) -> a -> b
$ SuspendedContract w error PABResp PABReq b
-> ResumableResult w error PABResp PABReq b
forall w e i o a.
SuspendedContract w e i o a -> ResumableResult w e i o a
_resumableResult (SuspendedContract w error PABResp PABReq b
 -> ResumableResult w error PABResp PABReq b)
-> SuspendedContract w error PABResp PABReq b
-> ResumableResult w error PABResp PABReq b
forall a b. (a -> b) -> a -> b
$ ContractInstanceStateInternal w schema error b
-> SuspendedContract w error PABResp PABReq b
forall w (s :: Row *) e a.
ContractInstanceStateInternal w s e a
-> SuspendedContract w e PABResp PABReq a
Emulator.cisiSuspState ContractInstanceStateInternal w schema error b
oldState)
            SomeBuiltinState a -> Eff effs (SomeBuiltinState a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ContractInstanceStateInternal w schema error b
-> w -> SomeBuiltinState a
forall a w (schema :: Row *) error b.
ContractConstraints w schema error =>
ContractInstanceStateInternal w schema error b
-> w -> SomeBuiltinState a
SomeBuiltinState ContractInstanceStateInternal w schema error b
k w
newW)
        Maybe (ContractInstanceStateInternal w schema error b)
_      -> PABError -> Eff effs (SomeBuiltinState a)
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (PABError -> Eff effs (SomeBuiltinState a))
-> PABError -> Eff effs (SomeBuiltinState a)
forall a b. (a -> b) -> a -> b
$ Int -> Text -> PABError
ContractCommandError Int
0 Text
"failed to update contract"

logNewMessages ::
    forall b w s e a effs.
    ( Member (LogMsg (PABMultiAgentMsg (Builtin b))) effs
    , ToJSON e
    )
    => ContractInstanceId
    -> ContractInstanceStateInternal w s e a
    -> Eff effs ()
logNewMessages :: ContractInstanceId
-> ContractInstanceStateInternal w s e a -> Eff effs ()
logNewMessages
    ContractInstanceId
i
    ContractInstanceStateInternal
        { cisiSuspState :: forall w (s :: Row *) e a.
ContractInstanceStateInternal w s e a
-> SuspendedContract w e PABResp PABReq a
cisiSuspState = SuspendedContract
            { _resumableResult :: forall w e i o a.
SuspendedContract w e i o a -> ResumableResult w e i o a
_resumableResult = ResumableResult { Seq (LogMessage Value)
_lastLogs :: Seq (LogMessage Value)
_lastLogs :: forall w e i o a.
ResumableResult w e i o a -> Seq (LogMessage Value)
_lastLogs, Either e (Maybe a)
_finalState :: Either e (Maybe a)
_finalState :: forall w e i o a. ResumableResult w e i o a -> Either e (Maybe a)
_finalState }}
        } = do
    (LogMessage Value -> Eff effs ())
-> Seq (LogMessage Value) -> Eff effs ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
        ( forall (effs :: [* -> *]) a.
Member (LogMsg (PABMultiAgentMsg (Builtin b))) effs =>
LogMsg (PABMultiAgentMsg (Builtin b)) a -> Eff effs a
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send @(LogMsg (PABMultiAgentMsg (Builtin b)))
        (LogMsg (PABMultiAgentMsg (Builtin b)) () -> Eff effs ())
-> (LogMessage Value -> LogMsg (PABMultiAgentMsg (Builtin b)) ())
-> LogMessage Value
-> Eff effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogMessage (PABMultiAgentMsg (Builtin b))
-> LogMsg (PABMultiAgentMsg (Builtin b)) ()
forall a. LogMessage a -> LogMsg a ()
LMessage
        (LogMessage (PABMultiAgentMsg (Builtin b))
 -> LogMsg (PABMultiAgentMsg (Builtin b)) ())
-> (LogMessage Value -> LogMessage (PABMultiAgentMsg (Builtin b)))
-> LogMessage Value
-> LogMsg (PABMultiAgentMsg (Builtin b)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> PABMultiAgentMsg (Builtin b))
-> LogMessage Value -> LogMessage (PABMultiAgentMsg (Builtin b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ContractInstanceMsg (Builtin b) -> PABMultiAgentMsg (Builtin b)
forall t. ContractInstanceMsg t -> PABMultiAgentMsg t
ContractInstanceLog (ContractInstanceMsg (Builtin b) -> PABMultiAgentMsg (Builtin b))
-> (Value -> ContractInstanceMsg (Builtin b))
-> Value
-> PABMultiAgentMsg (Builtin b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractInstanceId -> Value -> ContractInstanceMsg (Builtin b)
forall t. ContractInstanceId -> Value -> ContractInstanceMsg t
ContractLog ContractInstanceId
i)
        )
        Seq (LogMessage Value)
_lastLogs

    -- If an error was thrown in a 'Contract', we log it.
    (e -> Eff effs ())
-> (Maybe a -> Eff effs ()) -> Either e (Maybe a) -> Eff effs ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        ( forall (effs :: [* -> *]).
Member (LogMsg (PABMultiAgentMsg (Builtin b))) effs =>
PABMultiAgentMsg (Builtin b) -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logError @(PABMultiAgentMsg (Builtin b))
        (PABMultiAgentMsg (Builtin b) -> Eff effs ())
-> (e -> PABMultiAgentMsg (Builtin b)) -> e -> Eff effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractInstanceMsg (Builtin b) -> PABMultiAgentMsg (Builtin b)
forall t. ContractInstanceMsg t -> PABMultiAgentMsg t
ContractInstanceLog
        (ContractInstanceMsg (Builtin b) -> PABMultiAgentMsg (Builtin b))
-> (e -> ContractInstanceMsg (Builtin b))
-> e
-> PABMultiAgentMsg (Builtin b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractInstanceId -> Value -> ContractInstanceMsg (Builtin b)
forall t. ContractInstanceId -> Value -> ContractInstanceMsg t
ContractLog ContractInstanceId
i
        (Value -> ContractInstanceMsg (Builtin b))
-> (e -> Value) -> e -> ContractInstanceMsg (Builtin b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON
        )
        (Eff effs () -> Maybe a -> Eff effs ()
forall a b. a -> b -> a
const (Eff effs () -> Maybe a -> Eff effs ())
-> Eff effs () -> Maybe a -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ () -> Eff effs ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
        Either e (Maybe a)
_finalState