{-# LANGUAGE AllowAmbiguousTypes  #-}
{-# LANGUAGE ConstraintKinds      #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DeriveAnyClass       #-}
{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE DerivingStrategies   #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE NamedFieldPuns       #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}

module Plutus.Trace.Emulator.Types(
    EmulatorMessage(..)
    , EmulatorThreads(..)
    , instanceIdThreads
    , EmulatorAgentThreadEffs
    , EmulatedWalletEffects
    , EmulatedWalletEffects'
    , ContractInstanceTag(..)
    , walletInstanceTag
    , ContractHandle(..)
    , Emulator
    , ContractConstraints
    -- * Instance state
    , ContractInstanceState(..)
    , ContractInstanceStateInternal(..)
    , emptyInstanceState
    , addEventInstanceState
    , toInstanceState
    -- * Logging
    , ContractInstanceLog(..)
    , cilId
    , cilMessage
    , cilTag
    , EmulatorRuntimeError(..)
    , ContractInstanceMsg(..)
    , _Started
    , _StoppedNoError
    , _StoppedWithError
    , _ReceiveEndpointCall
    , _NoRequestsHandled
    , _HandledRequest
    , _CurrentRequests
    , _InstErr
    , _ContractLog
    , UserThreadMsg(..)
    ) where

import Cardano.Api (NetworkId)
import Control.Lens
import Control.Monad.Freer.Coroutine
import Control.Monad.Freer.Error
import Control.Monad.Freer.Extras.Log (LogMessage, LogMsg, LogObserve)
import Control.Monad.Freer.Reader (Reader)
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson qualified as JSON
import Data.Map (Map)
import Data.Row (Row)
import Data.Row.Internal qualified as V
import Data.Sequence (Seq)
import Data.String (IsString (..))
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics (Generic)
import Ledger.Blockchain (Block)
import Ledger.Slot (Slot (..))
import Plutus.ChainIndex (ChainIndexQueryEffect)
import Plutus.Contract (Contract (..), WalletAPIError)
import Plutus.Contract.Effects (PABReq, PABResp)
import Plutus.Contract.Resumable (Request (..), Requests (..), Response (..))
import Plutus.Contract.Resumable qualified as State
import Plutus.Contract.Schema (Input, Output)
import Plutus.Contract.Types (ResumableResult (..), SuspendedContract (..))
import Plutus.Contract.Types qualified as Contract.Types
import Plutus.Trace.Scheduler (AgentSystemCall, ThreadId)
import Prettyprinter (Pretty (..), braces, colon, fillSep, hang, parens, squotes, viaShow, vsep, (<+>))
import Wallet.API qualified as WAPI
import Wallet.Effects (NodeClientEffect, WalletEffect)
import Wallet.Emulator.LogMessages (RequestHandlerLogMsg, TxBalanceMsg)
import Wallet.Emulator.Wallet (Wallet (..))
import Wallet.Types (ContractInstanceId, EndpointDescription, Notification (..), NotificationError)

type ContractConstraints s =
    ( V.Forall (Output s) V.Unconstrained1
    , V.Forall (Input s) V.Unconstrained1
    , V.AllUniqueLabels (Input s)
    , V.AllUniqueLabels (Output s)
    , V.Forall (Input s) JSON.FromJSON
    , V.Forall (Input s) JSON.ToJSON
    , V.Forall (Output s) JSON.FromJSON
    , V.Forall (Output s) JSON.ToJSON
    )

-- | Messages sent to, and received by, threads in the emulator.
data EmulatorMessage =
    NewSlot [Block] Slot -- ^ A new slot has begun and some blocks were added.
    | EndpointCall ThreadId EndpointDescription JSON.Value -- ^ Call to an endpoint
    | Freeze -- ^ Tell the contract instance to freeze itself (see note [Freeze and Thaw])
    | ContractInstanceStateRequest ThreadId -- ^ Request for the current state of a contract instance
    | ContractInstanceStateResponse JSON.Value -- ^ Response to a contract instance state request
    deriving stock (EmulatorMessage -> EmulatorMessage -> Bool
(EmulatorMessage -> EmulatorMessage -> Bool)
-> (EmulatorMessage -> EmulatorMessage -> Bool)
-> Eq EmulatorMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmulatorMessage -> EmulatorMessage -> Bool
$c/= :: EmulatorMessage -> EmulatorMessage -> Bool
== :: EmulatorMessage -> EmulatorMessage -> Bool
$c== :: EmulatorMessage -> EmulatorMessage -> Bool
Eq, Int -> EmulatorMessage -> ShowS
[EmulatorMessage] -> ShowS
EmulatorMessage -> String
(Int -> EmulatorMessage -> ShowS)
-> (EmulatorMessage -> String)
-> ([EmulatorMessage] -> ShowS)
-> Show EmulatorMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmulatorMessage] -> ShowS
$cshowList :: [EmulatorMessage] -> ShowS
show :: EmulatorMessage -> String
$cshow :: EmulatorMessage -> String
showsPrec :: Int -> EmulatorMessage -> ShowS
$cshowsPrec :: Int -> EmulatorMessage -> ShowS
Show)

-- | A map of contract instance ID to thread ID
newtype EmulatorThreads =
    EmulatorThreads
        { EmulatorThreads -> Map ContractInstanceId ThreadId
_instanceIdThreads :: Map ContractInstanceId ThreadId
        } deriving newtype (b -> EmulatorThreads -> EmulatorThreads
NonEmpty EmulatorThreads -> EmulatorThreads
EmulatorThreads -> EmulatorThreads -> EmulatorThreads
(EmulatorThreads -> EmulatorThreads -> EmulatorThreads)
-> (NonEmpty EmulatorThreads -> EmulatorThreads)
-> (forall b.
    Integral b =>
    b -> EmulatorThreads -> EmulatorThreads)
-> Semigroup EmulatorThreads
forall b. Integral b => b -> EmulatorThreads -> EmulatorThreads
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> EmulatorThreads -> EmulatorThreads
$cstimes :: forall b. Integral b => b -> EmulatorThreads -> EmulatorThreads
sconcat :: NonEmpty EmulatorThreads -> EmulatorThreads
$csconcat :: NonEmpty EmulatorThreads -> EmulatorThreads
<> :: EmulatorThreads -> EmulatorThreads -> EmulatorThreads
$c<> :: EmulatorThreads -> EmulatorThreads -> EmulatorThreads
Semigroup, Semigroup EmulatorThreads
EmulatorThreads
Semigroup EmulatorThreads
-> EmulatorThreads
-> (EmulatorThreads -> EmulatorThreads -> EmulatorThreads)
-> ([EmulatorThreads] -> EmulatorThreads)
-> Monoid EmulatorThreads
[EmulatorThreads] -> EmulatorThreads
EmulatorThreads -> EmulatorThreads -> EmulatorThreads
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [EmulatorThreads] -> EmulatorThreads
$cmconcat :: [EmulatorThreads] -> EmulatorThreads
mappend :: EmulatorThreads -> EmulatorThreads -> EmulatorThreads
$cmappend :: EmulatorThreads -> EmulatorThreads -> EmulatorThreads
mempty :: EmulatorThreads
$cmempty :: EmulatorThreads
$cp1Monoid :: Semigroup EmulatorThreads
Monoid)

makeLenses ''EmulatorThreads

-- | Effects that are used to handle requests by contract instances.
--   In the emulator these effects are handled by 'Wallet.Emulator.MultiAgent'.
--   In the PAB they are handled by the actual wallet/node/chain index,
--   mediated by the PAB runtime.
type EmulatedWalletEffects' effs =
        WalletEffect
        ': Error WAPI.WalletAPIError
        ': NodeClientEffect
        ': ChainIndexQueryEffect
        ': LogObserve (LogMessage T.Text)
        ': LogMsg RequestHandlerLogMsg
        ': LogMsg TxBalanceMsg
        ': LogMsg T.Text
        ': effs

type EmulatedWalletEffects = EmulatedWalletEffects' '[]

-- | Effects available to emulator agent threads. Includes emulated wallet
--   effects and effects related to threading / waiting for messages.
type EmulatorAgentThreadEffs effs =
    LogMsg ContractInstanceLog

    ': EmulatedWalletEffects' (
        Yield (AgentSystemCall EmulatorMessage) (Maybe EmulatorMessage)
        ': Reader ThreadId
        ': effs
        )

data Emulator

-- | A reference to a running contract in the emulator.
data ContractHandle w s e =
    ContractHandle
        { ContractHandle w s e -> Contract w s e ()
chContract    :: Contract w s e ()
        , ContractHandle w s e -> ContractInstanceId
chInstanceId  :: ContractInstanceId
        , ContractHandle w s e -> ContractInstanceTag
chInstanceTag :: ContractInstanceTag
        , ContractHandle w s e -> NetworkId
chNetworkId   :: NetworkId
        }

data EmulatorRuntimeError =
    ThreadIdNotFound ContractInstanceId
    | InstanceIdNotFound Wallet
    | EmulatorJSONDecodingError String JSON.Value
    | GenericError String
    | EmulatedWalletError WalletAPIError
    | AssertionError String
    deriving stock (EmulatorRuntimeError -> EmulatorRuntimeError -> Bool
(EmulatorRuntimeError -> EmulatorRuntimeError -> Bool)
-> (EmulatorRuntimeError -> EmulatorRuntimeError -> Bool)
-> Eq EmulatorRuntimeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmulatorRuntimeError -> EmulatorRuntimeError -> Bool
$c/= :: EmulatorRuntimeError -> EmulatorRuntimeError -> Bool
== :: EmulatorRuntimeError -> EmulatorRuntimeError -> Bool
$c== :: EmulatorRuntimeError -> EmulatorRuntimeError -> Bool
Eq, Int -> EmulatorRuntimeError -> ShowS
[EmulatorRuntimeError] -> ShowS
EmulatorRuntimeError -> String
(Int -> EmulatorRuntimeError -> ShowS)
-> (EmulatorRuntimeError -> String)
-> ([EmulatorRuntimeError] -> ShowS)
-> Show EmulatorRuntimeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmulatorRuntimeError] -> ShowS
$cshowList :: [EmulatorRuntimeError] -> ShowS
show :: EmulatorRuntimeError -> String
$cshow :: EmulatorRuntimeError -> String
showsPrec :: Int -> EmulatorRuntimeError -> ShowS
$cshowsPrec :: Int -> EmulatorRuntimeError -> ShowS
Show, (forall x. EmulatorRuntimeError -> Rep EmulatorRuntimeError x)
-> (forall x. Rep EmulatorRuntimeError x -> EmulatorRuntimeError)
-> Generic EmulatorRuntimeError
forall x. Rep EmulatorRuntimeError x -> EmulatorRuntimeError
forall x. EmulatorRuntimeError -> Rep EmulatorRuntimeError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EmulatorRuntimeError x -> EmulatorRuntimeError
$cfrom :: forall x. EmulatorRuntimeError -> Rep EmulatorRuntimeError x
Generic)
    deriving anyclass ([EmulatorRuntimeError] -> Encoding
[EmulatorRuntimeError] -> Value
EmulatorRuntimeError -> Encoding
EmulatorRuntimeError -> Value
(EmulatorRuntimeError -> Value)
-> (EmulatorRuntimeError -> Encoding)
-> ([EmulatorRuntimeError] -> Value)
-> ([EmulatorRuntimeError] -> Encoding)
-> ToJSON EmulatorRuntimeError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EmulatorRuntimeError] -> Encoding
$ctoEncodingList :: [EmulatorRuntimeError] -> Encoding
toJSONList :: [EmulatorRuntimeError] -> Value
$ctoJSONList :: [EmulatorRuntimeError] -> Value
toEncoding :: EmulatorRuntimeError -> Encoding
$ctoEncoding :: EmulatorRuntimeError -> Encoding
toJSON :: EmulatorRuntimeError -> Value
$ctoJSON :: EmulatorRuntimeError -> Value
ToJSON, Value -> Parser [EmulatorRuntimeError]
Value -> Parser EmulatorRuntimeError
(Value -> Parser EmulatorRuntimeError)
-> (Value -> Parser [EmulatorRuntimeError])
-> FromJSON EmulatorRuntimeError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EmulatorRuntimeError]
$cparseJSONList :: Value -> Parser [EmulatorRuntimeError]
parseJSON :: Value -> Parser EmulatorRuntimeError
$cparseJSON :: Value -> Parser EmulatorRuntimeError
FromJSON)

instance Pretty EmulatorRuntimeError where
    pretty :: EmulatorRuntimeError -> Doc ann
pretty = \case
        ThreadIdNotFound ContractInstanceId
i            -> Doc ann
"Thread ID not found:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ContractInstanceId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceId
i
        InstanceIdNotFound Wallet
w          -> Doc ann
"Instance ID not found:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Wallet -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Wallet
w
        EmulatorJSONDecodingError String
e Value
v -> Doc ann
"Emulator JSON decoding error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
e Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Value -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow Value
v)
        AssertionError String
n              -> Doc ann
"Assertion failed: " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
squotes (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
n)
        GenericError String
e                -> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
e
        EmulatedWalletError WalletAPIError
e         -> WalletAPIError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty WalletAPIError
e

-- | A user-defined tag for a contract instance. Used to find the instance's
--   log messages in the emulator log.
data ContractInstanceTag = ContractInstanceTag { ContractInstanceTag -> Text
unContractInstanceTag :: Text, ContractInstanceTag -> Text
shortContractInstanceTag :: Text }
    deriving stock (ContractInstanceTag -> ContractInstanceTag -> Bool
(ContractInstanceTag -> ContractInstanceTag -> Bool)
-> (ContractInstanceTag -> ContractInstanceTag -> Bool)
-> Eq ContractInstanceTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContractInstanceTag -> ContractInstanceTag -> Bool
$c/= :: ContractInstanceTag -> ContractInstanceTag -> Bool
== :: ContractInstanceTag -> ContractInstanceTag -> Bool
$c== :: ContractInstanceTag -> ContractInstanceTag -> Bool
Eq, Eq ContractInstanceTag
Eq ContractInstanceTag
-> (ContractInstanceTag -> ContractInstanceTag -> Ordering)
-> (ContractInstanceTag -> ContractInstanceTag -> Bool)
-> (ContractInstanceTag -> ContractInstanceTag -> Bool)
-> (ContractInstanceTag -> ContractInstanceTag -> Bool)
-> (ContractInstanceTag -> ContractInstanceTag -> Bool)
-> (ContractInstanceTag
    -> ContractInstanceTag -> ContractInstanceTag)
-> (ContractInstanceTag
    -> ContractInstanceTag -> ContractInstanceTag)
-> Ord ContractInstanceTag
ContractInstanceTag -> ContractInstanceTag -> Bool
ContractInstanceTag -> ContractInstanceTag -> Ordering
ContractInstanceTag -> ContractInstanceTag -> ContractInstanceTag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ContractInstanceTag -> ContractInstanceTag -> ContractInstanceTag
$cmin :: ContractInstanceTag -> ContractInstanceTag -> ContractInstanceTag
max :: ContractInstanceTag -> ContractInstanceTag -> ContractInstanceTag
$cmax :: ContractInstanceTag -> ContractInstanceTag -> ContractInstanceTag
>= :: ContractInstanceTag -> ContractInstanceTag -> Bool
$c>= :: ContractInstanceTag -> ContractInstanceTag -> Bool
> :: ContractInstanceTag -> ContractInstanceTag -> Bool
$c> :: ContractInstanceTag -> ContractInstanceTag -> Bool
<= :: ContractInstanceTag -> ContractInstanceTag -> Bool
$c<= :: ContractInstanceTag -> ContractInstanceTag -> Bool
< :: ContractInstanceTag -> ContractInstanceTag -> Bool
$c< :: ContractInstanceTag -> ContractInstanceTag -> Bool
compare :: ContractInstanceTag -> ContractInstanceTag -> Ordering
$ccompare :: ContractInstanceTag -> ContractInstanceTag -> Ordering
$cp1Ord :: Eq ContractInstanceTag
Ord, Int -> ContractInstanceTag -> ShowS
[ContractInstanceTag] -> ShowS
ContractInstanceTag -> String
(Int -> ContractInstanceTag -> ShowS)
-> (ContractInstanceTag -> String)
-> ([ContractInstanceTag] -> ShowS)
-> Show ContractInstanceTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContractInstanceTag] -> ShowS
$cshowList :: [ContractInstanceTag] -> ShowS
show :: ContractInstanceTag -> String
$cshow :: ContractInstanceTag -> String
showsPrec :: Int -> ContractInstanceTag -> ShowS
$cshowsPrec :: Int -> ContractInstanceTag -> ShowS
Show, (forall x. ContractInstanceTag -> Rep ContractInstanceTag x)
-> (forall x. Rep ContractInstanceTag x -> ContractInstanceTag)
-> Generic ContractInstanceTag
forall x. Rep ContractInstanceTag x -> ContractInstanceTag
forall x. ContractInstanceTag -> Rep ContractInstanceTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContractInstanceTag x -> ContractInstanceTag
$cfrom :: forall x. ContractInstanceTag -> Rep ContractInstanceTag x
Generic)
    deriving anyclass ([ContractInstanceTag] -> Encoding
[ContractInstanceTag] -> Value
ContractInstanceTag -> Encoding
ContractInstanceTag -> Value
(ContractInstanceTag -> Value)
-> (ContractInstanceTag -> Encoding)
-> ([ContractInstanceTag] -> Value)
-> ([ContractInstanceTag] -> Encoding)
-> ToJSON ContractInstanceTag
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ContractInstanceTag] -> Encoding
$ctoEncodingList :: [ContractInstanceTag] -> Encoding
toJSONList :: [ContractInstanceTag] -> Value
$ctoJSONList :: [ContractInstanceTag] -> Value
toEncoding :: ContractInstanceTag -> Encoding
$ctoEncoding :: ContractInstanceTag -> Encoding
toJSON :: ContractInstanceTag -> Value
$ctoJSON :: ContractInstanceTag -> Value
ToJSON, Value -> Parser [ContractInstanceTag]
Value -> Parser ContractInstanceTag
(Value -> Parser ContractInstanceTag)
-> (Value -> Parser [ContractInstanceTag])
-> FromJSON ContractInstanceTag
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ContractInstanceTag]
$cparseJSONList :: Value -> Parser [ContractInstanceTag]
parseJSON :: Value -> Parser ContractInstanceTag
$cparseJSON :: Value -> Parser ContractInstanceTag
FromJSON)

instance Pretty ContractInstanceTag where
  pretty :: ContractInstanceTag -> Doc ann
pretty = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann)
-> (ContractInstanceTag -> Text) -> ContractInstanceTag -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractInstanceTag -> Text
shortContractInstanceTag

instance IsString ContractInstanceTag where
  fromString :: String -> ContractInstanceTag
fromString String
s = Text -> Text -> ContractInstanceTag
ContractInstanceTag (String -> Text
forall a. IsString a => String -> a
fromString String
s) (String -> Text
forall a. IsString a => String -> a
fromString String
s)

-- | The 'ContractInstanceTag' for the contract instance of a wallet. See note
--   [Wallet contract instances]
walletInstanceTag :: Wallet -> ContractInstanceTag
walletInstanceTag :: Wallet -> ContractInstanceTag
walletInstanceTag Wallet
w =
  let wstring :: String
wstring = Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String) -> Doc Any -> String
forall a b. (a -> b) -> a -> b
$ Wallet -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty Wallet
w in
  Text -> Text -> ContractInstanceTag
ContractInstanceTag (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Contract instance for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
wstring) (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Wallet " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
5 String
wstring)

-- | Log message produced by the user (main) thread
data UserThreadMsg =
    UserThreadErr EmulatorRuntimeError
    | UserLog String
    deriving stock (UserThreadMsg -> UserThreadMsg -> Bool
(UserThreadMsg -> UserThreadMsg -> Bool)
-> (UserThreadMsg -> UserThreadMsg -> Bool) -> Eq UserThreadMsg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserThreadMsg -> UserThreadMsg -> Bool
$c/= :: UserThreadMsg -> UserThreadMsg -> Bool
== :: UserThreadMsg -> UserThreadMsg -> Bool
$c== :: UserThreadMsg -> UserThreadMsg -> Bool
Eq, Int -> UserThreadMsg -> ShowS
[UserThreadMsg] -> ShowS
UserThreadMsg -> String
(Int -> UserThreadMsg -> ShowS)
-> (UserThreadMsg -> String)
-> ([UserThreadMsg] -> ShowS)
-> Show UserThreadMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserThreadMsg] -> ShowS
$cshowList :: [UserThreadMsg] -> ShowS
show :: UserThreadMsg -> String
$cshow :: UserThreadMsg -> String
showsPrec :: Int -> UserThreadMsg -> ShowS
$cshowsPrec :: Int -> UserThreadMsg -> ShowS
Show, (forall x. UserThreadMsg -> Rep UserThreadMsg x)
-> (forall x. Rep UserThreadMsg x -> UserThreadMsg)
-> Generic UserThreadMsg
forall x. Rep UserThreadMsg x -> UserThreadMsg
forall x. UserThreadMsg -> Rep UserThreadMsg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserThreadMsg x -> UserThreadMsg
$cfrom :: forall x. UserThreadMsg -> Rep UserThreadMsg x
Generic)
    deriving anyclass ([UserThreadMsg] -> Encoding
[UserThreadMsg] -> Value
UserThreadMsg -> Encoding
UserThreadMsg -> Value
(UserThreadMsg -> Value)
-> (UserThreadMsg -> Encoding)
-> ([UserThreadMsg] -> Value)
-> ([UserThreadMsg] -> Encoding)
-> ToJSON UserThreadMsg
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UserThreadMsg] -> Encoding
$ctoEncodingList :: [UserThreadMsg] -> Encoding
toJSONList :: [UserThreadMsg] -> Value
$ctoJSONList :: [UserThreadMsg] -> Value
toEncoding :: UserThreadMsg -> Encoding
$ctoEncoding :: UserThreadMsg -> Encoding
toJSON :: UserThreadMsg -> Value
$ctoJSON :: UserThreadMsg -> Value
ToJSON, Value -> Parser [UserThreadMsg]
Value -> Parser UserThreadMsg
(Value -> Parser UserThreadMsg)
-> (Value -> Parser [UserThreadMsg]) -> FromJSON UserThreadMsg
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UserThreadMsg]
$cparseJSONList :: Value -> Parser [UserThreadMsg]
parseJSON :: Value -> Parser UserThreadMsg
$cparseJSON :: Value -> Parser UserThreadMsg
FromJSON)

instance Pretty UserThreadMsg where
    pretty :: UserThreadMsg -> Doc ann
pretty = \case
        UserLog String
str     -> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
str
        UserThreadErr EmulatorRuntimeError
e -> Doc ann
"Error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> EmulatorRuntimeError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty EmulatorRuntimeError
e

-- | Log messages produced by contract instances
data ContractInstanceMsg =
    Started
    | StoppedNoError
    | StoppedWithError String
    | ReceiveEndpointCall EndpointDescription JSON.Value
    | ReceiveEndpointCallSuccess
    | ReceiveEndpointCallFailure NotificationError
    | NoRequestsHandled
    | HandledRequest (Response JSON.Value)
    | CurrentRequests [Request JSON.Value]
    | InstErr EmulatorRuntimeError
    | ContractLog JSON.Value
    | SendingNotification Notification
    | NotificationSuccess Notification
    | NotificationFailure NotificationError
    | SendingContractState ThreadId
    | Freezing
    deriving stock (ContractInstanceMsg -> ContractInstanceMsg -> Bool
(ContractInstanceMsg -> ContractInstanceMsg -> Bool)
-> (ContractInstanceMsg -> ContractInstanceMsg -> Bool)
-> Eq ContractInstanceMsg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContractInstanceMsg -> ContractInstanceMsg -> Bool
$c/= :: ContractInstanceMsg -> ContractInstanceMsg -> Bool
== :: ContractInstanceMsg -> ContractInstanceMsg -> Bool
$c== :: ContractInstanceMsg -> ContractInstanceMsg -> Bool
Eq, Int -> ContractInstanceMsg -> ShowS
[ContractInstanceMsg] -> ShowS
ContractInstanceMsg -> String
(Int -> ContractInstanceMsg -> ShowS)
-> (ContractInstanceMsg -> String)
-> ([ContractInstanceMsg] -> ShowS)
-> Show ContractInstanceMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContractInstanceMsg] -> ShowS
$cshowList :: [ContractInstanceMsg] -> ShowS
show :: ContractInstanceMsg -> String
$cshow :: ContractInstanceMsg -> String
showsPrec :: Int -> ContractInstanceMsg -> ShowS
$cshowsPrec :: Int -> ContractInstanceMsg -> ShowS
Show, (forall x. ContractInstanceMsg -> Rep ContractInstanceMsg x)
-> (forall x. Rep ContractInstanceMsg x -> ContractInstanceMsg)
-> Generic ContractInstanceMsg
forall x. Rep ContractInstanceMsg x -> ContractInstanceMsg
forall x. ContractInstanceMsg -> Rep ContractInstanceMsg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContractInstanceMsg x -> ContractInstanceMsg
$cfrom :: forall x. ContractInstanceMsg -> Rep ContractInstanceMsg x
Generic)
    deriving anyclass ([ContractInstanceMsg] -> Encoding
[ContractInstanceMsg] -> Value
ContractInstanceMsg -> Encoding
ContractInstanceMsg -> Value
(ContractInstanceMsg -> Value)
-> (ContractInstanceMsg -> Encoding)
-> ([ContractInstanceMsg] -> Value)
-> ([ContractInstanceMsg] -> Encoding)
-> ToJSON ContractInstanceMsg
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ContractInstanceMsg] -> Encoding
$ctoEncodingList :: [ContractInstanceMsg] -> Encoding
toJSONList :: [ContractInstanceMsg] -> Value
$ctoJSONList :: [ContractInstanceMsg] -> Value
toEncoding :: ContractInstanceMsg -> Encoding
$ctoEncoding :: ContractInstanceMsg -> Encoding
toJSON :: ContractInstanceMsg -> Value
$ctoJSON :: ContractInstanceMsg -> Value
ToJSON, Value -> Parser [ContractInstanceMsg]
Value -> Parser ContractInstanceMsg
(Value -> Parser ContractInstanceMsg)
-> (Value -> Parser [ContractInstanceMsg])
-> FromJSON ContractInstanceMsg
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ContractInstanceMsg]
$cparseJSONList :: Value -> Parser [ContractInstanceMsg]
parseJSON :: Value -> Parser ContractInstanceMsg
$cparseJSON :: Value -> Parser ContractInstanceMsg
FromJSON)

instance Pretty ContractInstanceMsg where
    pretty :: ContractInstanceMsg -> Doc ann
pretty = \case
        ContractInstanceMsg
Started -> Doc ann
"Contract instance started"
        ContractInstanceMsg
StoppedNoError -> Doc ann
"Contract instance stopped (no errors)"
        StoppedWithError String
e -> Doc ann
"Contract instance stopped with error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
e
        ReceiveEndpointCall EndpointDescription
d Value
v -> Doc ann
"Receive endpoint call on" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
squotes (EndpointDescription -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty EndpointDescription
d) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"for" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Value -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow Value
v
        ContractInstanceMsg
ReceiveEndpointCallSuccess -> Doc ann
"Endpoint call succeeded"
        ReceiveEndpointCallFailure NotificationError
f -> Doc ann
"Endpoint call failed:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NotificationError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty NotificationError
f
        ContractInstanceMsg
NoRequestsHandled -> Doc ann
"No requests handled"
        HandledRequest Response Value
rsp -> Doc ann
"Handled request:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Response String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
50 ShowS -> (Value -> String) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
forall a. Show a => a -> String
show (ByteString -> String) -> (Value -> ByteString) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encode (Value -> String) -> Response Value -> Response String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response Value
rsp)
        CurrentRequests [Request Value]
lst -> Doc ann
"Current requests" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Request Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Request Value]
lst)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep (Request String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Request String -> Doc ann)
-> (Request Value -> Request String) -> Request Value -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> String) -> Request Value -> Request String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
50 ShowS -> (Value -> String) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
forall a. Show a => a -> String
show (ByteString -> String) -> (Value -> ByteString) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encode) (Request Value -> Doc ann) -> [Request Value] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Request Value]
lst)
        InstErr EmulatorRuntimeError
e -> Doc ann
"Error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> EmulatorRuntimeError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty EmulatorRuntimeError
e
        ContractLog Value
v -> Doc ann
"Contract log:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Value -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow Value
v
        SendingNotification Notification{ContractInstanceId
notificationContractID :: Notification -> ContractInstanceId
notificationContractID :: ContractInstanceId
notificationContractID,EndpointDescription
notificationContractEndpoint :: Notification -> EndpointDescription
notificationContractEndpoint :: EndpointDescription
notificationContractEndpoint} ->
            Doc ann
"Sending notification" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> EndpointDescription -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty EndpointDescription
notificationContractEndpoint Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"to" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ContractInstanceId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceId
notificationContractID
        NotificationSuccess Notification{ContractInstanceId
notificationContractID :: ContractInstanceId
notificationContractID :: Notification -> ContractInstanceId
notificationContractID,EndpointDescription
notificationContractEndpoint :: EndpointDescription
notificationContractEndpoint :: Notification -> EndpointDescription
notificationContractEndpoint} ->
            Doc ann
"Notification" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> EndpointDescription -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty EndpointDescription
notificationContractEndpoint Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"of" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ContractInstanceId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceId
notificationContractID Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"succeeded"
        NotificationFailure NotificationError
e ->
            Doc ann
"Notification failed:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NotificationError -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow NotificationError
e
        ContractInstanceMsg
Freezing -> Doc ann
"Freezing contract instance"
        SendingContractState ThreadId
t -> Doc ann
"Sending contract state to" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ThreadId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ThreadId
t

data ContractInstanceLog =
    ContractInstanceLog
        { ContractInstanceLog -> ContractInstanceMsg
_cilMessage :: ContractInstanceMsg
        , ContractInstanceLog -> ContractInstanceId
_cilId      :: ContractInstanceId
        , ContractInstanceLog -> ContractInstanceTag
_cilTag     :: ContractInstanceTag
        }
    deriving stock (ContractInstanceLog -> ContractInstanceLog -> Bool
(ContractInstanceLog -> ContractInstanceLog -> Bool)
-> (ContractInstanceLog -> ContractInstanceLog -> Bool)
-> Eq ContractInstanceLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContractInstanceLog -> ContractInstanceLog -> Bool
$c/= :: ContractInstanceLog -> ContractInstanceLog -> Bool
== :: ContractInstanceLog -> ContractInstanceLog -> Bool
$c== :: ContractInstanceLog -> ContractInstanceLog -> Bool
Eq, Int -> ContractInstanceLog -> ShowS
[ContractInstanceLog] -> ShowS
ContractInstanceLog -> String
(Int -> ContractInstanceLog -> ShowS)
-> (ContractInstanceLog -> String)
-> ([ContractInstanceLog] -> ShowS)
-> Show ContractInstanceLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContractInstanceLog] -> ShowS
$cshowList :: [ContractInstanceLog] -> ShowS
show :: ContractInstanceLog -> String
$cshow :: ContractInstanceLog -> String
showsPrec :: Int -> ContractInstanceLog -> ShowS
$cshowsPrec :: Int -> ContractInstanceLog -> ShowS
Show, (forall x. ContractInstanceLog -> Rep ContractInstanceLog x)
-> (forall x. Rep ContractInstanceLog x -> ContractInstanceLog)
-> Generic ContractInstanceLog
forall x. Rep ContractInstanceLog x -> ContractInstanceLog
forall x. ContractInstanceLog -> Rep ContractInstanceLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContractInstanceLog x -> ContractInstanceLog
$cfrom :: forall x. ContractInstanceLog -> Rep ContractInstanceLog x
Generic)
    deriving anyclass ([ContractInstanceLog] -> Encoding
[ContractInstanceLog] -> Value
ContractInstanceLog -> Encoding
ContractInstanceLog -> Value
(ContractInstanceLog -> Value)
-> (ContractInstanceLog -> Encoding)
-> ([ContractInstanceLog] -> Value)
-> ([ContractInstanceLog] -> Encoding)
-> ToJSON ContractInstanceLog
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ContractInstanceLog] -> Encoding
$ctoEncodingList :: [ContractInstanceLog] -> Encoding
toJSONList :: [ContractInstanceLog] -> Value
$ctoJSONList :: [ContractInstanceLog] -> Value
toEncoding :: ContractInstanceLog -> Encoding
$ctoEncoding :: ContractInstanceLog -> Encoding
toJSON :: ContractInstanceLog -> Value
$ctoJSON :: ContractInstanceLog -> Value
ToJSON, Value -> Parser [ContractInstanceLog]
Value -> Parser ContractInstanceLog
(Value -> Parser ContractInstanceLog)
-> (Value -> Parser [ContractInstanceLog])
-> FromJSON ContractInstanceLog
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ContractInstanceLog]
$cparseJSONList :: Value -> Parser [ContractInstanceLog]
parseJSON :: Value -> Parser ContractInstanceLog
$cparseJSON :: Value -> Parser ContractInstanceLog
FromJSON)

instance Pretty ContractInstanceLog where
    pretty :: ContractInstanceLog -> Doc ann
pretty ContractInstanceLog{ContractInstanceMsg
_cilMessage :: ContractInstanceMsg
_cilMessage :: ContractInstanceLog -> ContractInstanceMsg
_cilMessage, ContractInstanceId
_cilId :: ContractInstanceId
_cilId :: ContractInstanceLog -> ContractInstanceId
_cilId, ContractInstanceTag
_cilTag :: ContractInstanceTag
_cilTag :: ContractInstanceLog -> ContractInstanceTag
_cilTag} =
        Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [ContractInstanceId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceId
_cilId Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (ContractInstanceTag -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceTag
_cilTag) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon, ContractInstanceMsg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceMsg
_cilMessage]

-- | State of the contract instance, internal to the contract instance thread.
--   It contains both the serialisable state of the contract instance and the
--   non-serialisable continuations in 'SuspendedContract'.
data ContractInstanceStateInternal w (s :: Row *) e a =
    ContractInstanceStateInternal
        { ContractInstanceStateInternal w s e a
-> SuspendedContract w e PABResp PABReq a
cisiSuspState       :: SuspendedContract w e PABResp PABReq a
        , ContractInstanceStateInternal w s e a -> Seq (Response PABResp)
cisiEvents          :: Seq (Response PABResp)
        , ContractInstanceStateInternal w s e a -> Seq [Request PABReq]
cisiHandlersHistory :: Seq [State.Request PABReq]
        }

-- | Extract the serialisable 'ContractInstanceState' from the
--   'ContractInstanceStateInternal'. We need to do this when
--   we want to send the instance state to another thread.
toInstanceState :: ContractInstanceStateInternal w (s :: Row *) e a -> ContractInstanceState w s e a
toInstanceState :: ContractInstanceStateInternal w s e a
-> ContractInstanceState w s e a
toInstanceState ContractInstanceStateInternal{cisiSuspState :: forall w (s :: Row *) e a.
ContractInstanceStateInternal w s e a
-> SuspendedContract w e PABResp PABReq a
cisiSuspState=SuspendedContract{ResumableResult w e PABResp PABReq a
_resumableResult :: forall w e i o a.
SuspendedContract w e i o a -> ResumableResult w e i o a
_resumableResult :: ResumableResult w e PABResp PABReq a
_resumableResult}, Seq (Response PABResp)
cisiEvents :: Seq (Response PABResp)
cisiEvents :: forall w (s :: Row *) e a.
ContractInstanceStateInternal w s e a -> Seq (Response PABResp)
cisiEvents, Seq [Request PABReq]
cisiHandlersHistory :: Seq [Request PABReq]
cisiHandlersHistory :: forall w (s :: Row *) e a.
ContractInstanceStateInternal w s e a -> Seq [Request PABReq]
cisiHandlersHistory} =
    ContractInstanceState :: forall w (s :: Row *) e a.
ResumableResult w e PABResp PABReq a
-> Seq (Response PABResp)
-> Seq [Request PABReq]
-> ContractInstanceState w s e a
ContractInstanceState
        { instContractState :: ResumableResult w e PABResp PABReq a
instContractState = ResumableResult w e PABResp PABReq a
_resumableResult
        , instEvents :: Seq (Response PABResp)
instEvents = Seq (Response PABResp)
cisiEvents
        , instHandlersHistory :: Seq [Request PABReq]
instHandlersHistory = Seq [Request PABReq]
cisiHandlersHistory
        }

-- | The state of a running contract instance with schema @s@ and error type @e@
--   Serialisable to JSON.
data ContractInstanceState w (s :: Row *) e a =
    ContractInstanceState
        { ContractInstanceState w s e a
-> ResumableResult w e PABResp PABReq a
instContractState   :: ResumableResult w e PABResp PABReq a
        , ContractInstanceState w s e a -> Seq (Response PABResp)
instEvents          :: Seq (Response PABResp) -- ^ Events received by the contract instance. (Used for debugging purposes)
        , ContractInstanceState w s e a -> Seq [Request PABReq]
instHandlersHistory :: Seq [State.Request PABReq] -- ^ Requests issued by the contract instance (Used for debugging purposes)
        }
        deriving stock (forall x.
 ContractInstanceState w s e a
 -> Rep (ContractInstanceState w s e a) x)
-> (forall x.
    Rep (ContractInstanceState w s e a) x
    -> ContractInstanceState w s e a)
-> Generic (ContractInstanceState w s e a)
forall x.
Rep (ContractInstanceState w s e a) x
-> ContractInstanceState w s e a
forall x.
ContractInstanceState w s e a
-> Rep (ContractInstanceState w s e a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall w (s :: Row *) e a x.
Rep (ContractInstanceState w s e a) x
-> ContractInstanceState w s e a
forall w (s :: Row *) e a x.
ContractInstanceState w s e a
-> Rep (ContractInstanceState w s e a) x
$cto :: forall w (s :: Row *) e a x.
Rep (ContractInstanceState w s e a) x
-> ContractInstanceState w s e a
$cfrom :: forall w (s :: Row *) e a x.
ContractInstanceState w s e a
-> Rep (ContractInstanceState w s e a) x
Generic

deriving anyclass instance  (JSON.ToJSON e, JSON.ToJSON a, JSON.ToJSON w) => JSON.ToJSON (ContractInstanceState w s e a)
deriving anyclass instance  (JSON.FromJSON e, JSON.FromJSON a, JSON.FromJSON w) => JSON.FromJSON (ContractInstanceState w s e a)

emptyInstanceState ::
    forall w (s :: Row *) e a.
    Monoid w
    => Contract w s e a
    -> ContractInstanceStateInternal w s e a
emptyInstanceState :: Contract w s e a -> ContractInstanceStateInternal w s e a
emptyInstanceState (Contract Eff (ContractEffs w e) a
c) =
    ContractInstanceStateInternal :: forall w (s :: Row *) e a.
SuspendedContract w e PABResp PABReq a
-> Seq (Response PABResp)
-> Seq [Request PABReq]
-> ContractInstanceStateInternal w s e a
ContractInstanceStateInternal
        { cisiSuspState :: SuspendedContract w e PABResp PABReq a
cisiSuspState = CheckpointStore
-> Eff (ContractEffs w e) a
-> SuspendedContract w e PABResp PABReq a
forall w e a.
Monoid w =>
CheckpointStore
-> Eff (ContractEffs w e) a
-> SuspendedContract w e PABResp PABReq a
Contract.Types.suspend CheckpointStore
forall a. Monoid a => a
mempty Eff (ContractEffs w e) a
c
        , cisiEvents :: Seq (Response PABResp)
cisiEvents = Seq (Response PABResp)
forall a. Monoid a => a
mempty
        , cisiHandlersHistory :: Seq [Request PABReq]
cisiHandlersHistory = Seq [Request PABReq]
forall a. Monoid a => a
mempty
        }

addEventInstanceState :: forall w s e a.
    Monoid w
    => Response PABResp
    -> ContractInstanceStateInternal w s e a
    -> Maybe (ContractInstanceStateInternal w s e a)
addEventInstanceState :: Response PABResp
-> ContractInstanceStateInternal w s e a
-> Maybe (ContractInstanceStateInternal w s e a)
addEventInstanceState Response PABResp
event ContractInstanceStateInternal{SuspendedContract w e PABResp PABReq a
cisiSuspState :: SuspendedContract w e PABResp PABReq a
cisiSuspState :: forall w (s :: Row *) e a.
ContractInstanceStateInternal w s e a
-> SuspendedContract w e PABResp PABReq a
cisiSuspState, Seq (Response PABResp)
cisiEvents :: Seq (Response PABResp)
cisiEvents :: forall w (s :: Row *) e a.
ContractInstanceStateInternal w s e a -> Seq (Response PABResp)
cisiEvents, Seq [Request PABReq]
cisiHandlersHistory :: Seq [Request PABReq]
cisiHandlersHistory :: forall w (s :: Row *) e a.
ContractInstanceStateInternal w s e a -> Seq [Request PABReq]
cisiHandlersHistory} =
    case SuspendedContract w e PABResp PABReq a
-> Response PABResp
-> Maybe (SuspendedContract w e PABResp PABReq a)
forall w e a.
Monoid w =>
SuspendedContract w e PABResp PABReq a
-> Response PABResp
-> Maybe (SuspendedContract w e PABResp PABReq a)
Contract.Types.runStep SuspendedContract w e PABResp PABReq a
cisiSuspState Response PABResp
event of
        Maybe (SuspendedContract w e PABResp PABReq a)
Nothing -> Maybe (ContractInstanceStateInternal w s e a)
forall a. Maybe a
Nothing
        Just SuspendedContract w e PABResp PABReq a
newState ->
            let SuspendedContract{_resumableResult :: forall w e i o a.
SuspendedContract w e i o a -> ResumableResult w e i o a
_resumableResult=ResumableResult{_requests :: forall w e i o a. ResumableResult w e i o a -> Requests o
_requests=Requests [Request PABReq]
rq}} = SuspendedContract w e PABResp PABReq a
cisiSuspState in
            ContractInstanceStateInternal w s e a
-> Maybe (ContractInstanceStateInternal w s e a)
forall a. a -> Maybe a
Just ContractInstanceStateInternal :: forall w (s :: Row *) e a.
SuspendedContract w e PABResp PABReq a
-> Seq (Response PABResp)
-> Seq [Request PABReq]
-> ContractInstanceStateInternal w s e a
ContractInstanceStateInternal
                { cisiSuspState :: SuspendedContract w e PABResp PABReq a
cisiSuspState = SuspendedContract w e PABResp PABReq a
newState
                , cisiEvents :: Seq (Response PABResp)
cisiEvents = Seq (Response PABResp)
cisiEvents Seq (Response PABResp)
-> Response PABResp -> Seq (Response PABResp)
forall s a. Snoc s s a a => s -> a -> s
|> Response PABResp
event
                , cisiHandlersHistory :: Seq [Request PABReq]
cisiHandlersHistory = Seq [Request PABReq]
cisiHandlersHistory Seq [Request PABReq] -> [Request PABReq] -> Seq [Request PABReq]
forall s a. Snoc s s a a => s -> a -> s
|> [Request PABReq]
rq
                }

makeLenses ''ContractInstanceLog
makePrisms ''ContractInstanceMsg


-- | What to do when the initial thread finishes.
data OnInitialThreadStopped =
    KeepGoing -- ^ Keep going until all threads have finished.
    | Stop -- ^ Stop right away.
    deriving stock (OnInitialThreadStopped -> OnInitialThreadStopped -> Bool
(OnInitialThreadStopped -> OnInitialThreadStopped -> Bool)
-> (OnInitialThreadStopped -> OnInitialThreadStopped -> Bool)
-> Eq OnInitialThreadStopped
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OnInitialThreadStopped -> OnInitialThreadStopped -> Bool
$c/= :: OnInitialThreadStopped -> OnInitialThreadStopped -> Bool
== :: OnInitialThreadStopped -> OnInitialThreadStopped -> Bool
$c== :: OnInitialThreadStopped -> OnInitialThreadStopped -> Bool
Eq, Eq OnInitialThreadStopped
Eq OnInitialThreadStopped
-> (OnInitialThreadStopped -> OnInitialThreadStopped -> Ordering)
-> (OnInitialThreadStopped -> OnInitialThreadStopped -> Bool)
-> (OnInitialThreadStopped -> OnInitialThreadStopped -> Bool)
-> (OnInitialThreadStopped -> OnInitialThreadStopped -> Bool)
-> (OnInitialThreadStopped -> OnInitialThreadStopped -> Bool)
-> (OnInitialThreadStopped
    -> OnInitialThreadStopped -> OnInitialThreadStopped)
-> (OnInitialThreadStopped
    -> OnInitialThreadStopped -> OnInitialThreadStopped)
-> Ord OnInitialThreadStopped
OnInitialThreadStopped -> OnInitialThreadStopped -> Bool
OnInitialThreadStopped -> OnInitialThreadStopped -> Ordering
OnInitialThreadStopped
-> OnInitialThreadStopped -> OnInitialThreadStopped
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OnInitialThreadStopped
-> OnInitialThreadStopped -> OnInitialThreadStopped
$cmin :: OnInitialThreadStopped
-> OnInitialThreadStopped -> OnInitialThreadStopped
max :: OnInitialThreadStopped
-> OnInitialThreadStopped -> OnInitialThreadStopped
$cmax :: OnInitialThreadStopped
-> OnInitialThreadStopped -> OnInitialThreadStopped
>= :: OnInitialThreadStopped -> OnInitialThreadStopped -> Bool
$c>= :: OnInitialThreadStopped -> OnInitialThreadStopped -> Bool
> :: OnInitialThreadStopped -> OnInitialThreadStopped -> Bool
$c> :: OnInitialThreadStopped -> OnInitialThreadStopped -> Bool
<= :: OnInitialThreadStopped -> OnInitialThreadStopped -> Bool
$c<= :: OnInitialThreadStopped -> OnInitialThreadStopped -> Bool
< :: OnInitialThreadStopped -> OnInitialThreadStopped -> Bool
$c< :: OnInitialThreadStopped -> OnInitialThreadStopped -> Bool
compare :: OnInitialThreadStopped -> OnInitialThreadStopped -> Ordering
$ccompare :: OnInitialThreadStopped -> OnInitialThreadStopped -> Ordering
$cp1Ord :: Eq OnInitialThreadStopped
Ord, Int -> OnInitialThreadStopped -> ShowS
[OnInitialThreadStopped] -> ShowS
OnInitialThreadStopped -> String
(Int -> OnInitialThreadStopped -> ShowS)
-> (OnInitialThreadStopped -> String)
-> ([OnInitialThreadStopped] -> ShowS)
-> Show OnInitialThreadStopped
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OnInitialThreadStopped] -> ShowS
$cshowList :: [OnInitialThreadStopped] -> ShowS
show :: OnInitialThreadStopped -> String
$cshow :: OnInitialThreadStopped -> String
showsPrec :: Int -> OnInitialThreadStopped -> ShowS
$cshowsPrec :: Int -> OnInitialThreadStopped -> ShowS
Show)