{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE TypeFamilies      #-}
{-# LANGUAGE TypeOperators     #-}

module Plutus.Trace.Playground(
    PlaygroundTrace
    -- * Constructing traces
    , Waiting.waitUntilSlot
    , Waiting.waitNSlots
    , Waiting.nextSlot
    , EmulatedWalletAPI.payToWallet
    , RunContractPlayground.callEndpoint
    -- * Running traces
    , EmulatorConfig(..)
    , initialChainState
    , runPlaygroundStream
    -- * Interpreter
    , interpretPlaygroundTrace
    , walletInstanceTag
    ) where

import Control.Lens
import Control.Monad (void)
import Control.Monad.Freer (Eff, Member, interpret, raise, reinterpret, subsume)
import Control.Monad.Freer.Coroutine (Yield)
import Control.Monad.Freer.Error (Error, handleError, throwError)
import Control.Monad.Freer.Extras.Log (LogMessage, LogMsg (..), mapLog)
import Control.Monad.Freer.Extras.Modify (raiseEnd)
import Control.Monad.Freer.Reader (Reader)
import Control.Monad.Freer.State (State, evalState)
import Data.Aeson qualified as JSON
import Data.Foldable (traverse_)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe)

import Cardano.Node.Emulator.Internal.Node (ChainControlEffect, pNetworkId, pSlotConfig)
import Plutus.Contract (Contract (..))
import Plutus.Trace.Effects.ContractInstanceId (ContractInstanceIdEff, handleDeterministicIds)
import Plutus.Trace.Effects.EmulatedWalletAPI (EmulatedWalletAPI, handleEmulatedWalletAPI)
import Plutus.Trace.Effects.EmulatedWalletAPI qualified as EmulatedWalletAPI
import Plutus.Trace.Effects.RunContractPlayground (RunContractPlayground, handleRunContractPlayground)
import Plutus.Trace.Effects.RunContractPlayground qualified as RunContractPlayground
import Plutus.Trace.Effects.Waiting (Waiting, handleWaiting)
import Plutus.Trace.Effects.Waiting qualified as Waiting
import Plutus.Trace.Emulator.ContractInstance (EmulatorRuntimeError)
import Plutus.Trace.Emulator.System (launchSystemThreads)
import Plutus.Trace.Emulator.Types (ContractConstraints, EmulatorMessage (..),
                                    EmulatorRuntimeError (EmulatedWalletError), EmulatorThreads, walletInstanceTag)
import Plutus.Trace.Scheduler (EmSystemCall, ThreadId, exit, runThreads)
import Streaming (Stream)
import Streaming.Prelude (Of)
import Wallet.Emulator.MultiAgent (EmulatorEvent, EmulatorEvent' (..), EmulatorState, MultiAgentControlEffect,
                                   MultiAgentEffect, schedulerEvent)
import Wallet.Emulator.Stream (EmulatorConfig (..), EmulatorErr (..), initialChainState, runTraceStream)
import Wallet.Emulator.Wallet (Wallet (..), knownWallets)
import Wallet.Types (ContractInstanceId)

{- Note [Playground traces]

The list of effects we can use in traces for the Plutus playground is slightly
different from that for regular traces:

* There is only a single contract
* We don't need to start contract instances manually (see note
  [Wallet contract instances])
* We have fewer actions. Only "call endpoint" and "wait" are supported in the
  UI.

Therefore we can get by with a smaller list of effects for the 'PlaygroundTrace'
type.

Of particular note is the absence of
'Plutus.Trace.Effects.EmulatorControl.EmulatorControl'. This means that we can,
theoretically, run playground traces not just against the simulated environment
but also against a live system. See note [The EmulatorControl effect]

-}

type PlaygroundTrace a =
    Eff
        '[ RunContractPlayground
         , Error EmulatorRuntimeError
         , Waiting
         , EmulatedWalletAPI
        ] a

handlePlaygroundTrace ::
    forall w s e effs a.
    ( ContractConstraints s
    , Show e
    , JSON.ToJSON e
    , JSON.ToJSON w
    , Monoid w
    , Member MultiAgentEffect effs
    , Member (LogMsg EmulatorEvent') effs
    , Member (Error EmulatorRuntimeError) effs
    , Member (State (Map Wallet ContractInstanceId)) effs
    , Member (State EmulatorThreads) effs
    , Member ContractInstanceIdEff effs
    )
    => EmulatorConfig
    -> Contract w s e ()
    -> PlaygroundTrace a
    -> Eff (Reader ThreadId ': Yield (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage) ': effs) ()
handlePlaygroundTrace :: EmulatorConfig
-> Contract w s e ()
-> PlaygroundTrace a
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     ()
handlePlaygroundTrace EmulatorConfig
conf Contract w s e ()
contract PlaygroundTrace a
action = do
    a
result <- (Eff
   (Error WalletAPIError
      : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)
   a
 -> (WalletAPIError
     -> Eff
          (Reader ThreadId
             : Yield
                 (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
             : effs)
          a)
 -> Eff
      (Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a)
-> (WalletAPIError
    -> Eff
         (Reader ThreadId
            : Yield
                (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
            : effs)
         a)
-> Eff
     (Error WalletAPIError
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Eff
  (Error WalletAPIError
     : Reader ThreadId
     : Yield
         (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
     : effs)
  a
-> (WalletAPIError
    -> Eff
         (Reader ThreadId
            : Yield
                (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
            : effs)
         a)
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> (e -> Eff effs a) -> Eff effs a
handleError (EmulatorRuntimeError
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (EmulatorRuntimeError
 -> Eff
      (Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a)
-> (WalletAPIError -> EmulatorRuntimeError)
-> WalletAPIError
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletAPIError -> EmulatorRuntimeError
EmulatedWalletError)
            (Eff
   (Error WalletAPIError
      : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)
   a
 -> Eff
      (Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a)
-> (Eff
      (RunContractPlayground
         : Error EmulatorRuntimeError : Waiting : EmulatedWalletAPI
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a
    -> Eff
         (Error WalletAPIError
            : Reader ThreadId
            : Yield
                (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
            : effs)
         a)
-> Eff
     (RunContractPlayground
        : Error EmulatorRuntimeError : Waiting : EmulatedWalletAPI
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EmulatedWalletAPI
 ~> Eff
      (Error WalletAPIError
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs))
-> Eff
     (EmulatedWalletAPI
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
   ~> Eff
        (Error WalletAPIError
           : Reader ThreadId
           : Yield
               (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
           : effs)
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret forall (effs :: [* -> *]).
Member MultiAgentEffect effs =>
EmulatedWalletAPI ~> Eff effs
EmulatedWalletAPI
~> Eff
     (Error WalletAPIError
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
handleEmulatedWalletAPI
            (Eff
   (EmulatedWalletAPI
      : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)
   a
 -> Eff
      (Error WalletAPIError
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a)
-> (Eff
      (RunContractPlayground
         : Error EmulatorRuntimeError : Waiting : EmulatedWalletAPI
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a
    -> Eff
         (EmulatedWalletAPI
            : Reader ThreadId
            : Yield
                (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
            : effs)
         a)
-> Eff
     (RunContractPlayground
        : Error EmulatorRuntimeError : Waiting : EmulatedWalletAPI
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
-> Eff
     (Error WalletAPIError
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Waiting
 ~> Eff
      (EmulatedWalletAPI
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs))
-> Eff
     (Waiting
        : EmulatedWalletAPI : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
   ~> Eff
        (EmulatedWalletAPI
           : Reader ThreadId
           : Yield
               (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
           : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (SlotConfig
-> Waiting
   ~> Eff
        (EmulatedWalletAPI
           : Reader ThreadId
           : Yield
               (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
           : effs)
forall (effs :: [* -> *]) (effs2 :: [* -> *]) a.
Member
  (Yield
     (EmSystemCall effs2 EmulatorMessage a) (Maybe EmulatorMessage))
  effs =>
SlotConfig -> Waiting ~> Eff effs
handleWaiting @_ @effs @a (Params -> SlotConfig
pSlotConfig (Params -> SlotConfig) -> Params -> SlotConfig
forall a b. (a -> b) -> a -> b
$ EmulatorConfig -> Params
_params EmulatorConfig
conf))
            (Eff
   (Waiting
      : EmulatedWalletAPI : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)
   a
 -> Eff
      (EmulatedWalletAPI
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a)
-> (Eff
      (RunContractPlayground
         : Error EmulatorRuntimeError : Waiting : EmulatedWalletAPI
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a
    -> Eff
         (Waiting
            : EmulatedWalletAPI : Reader ThreadId
            : Yield
                (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
            : effs)
         a)
-> Eff
     (RunContractPlayground
        : Error EmulatorRuntimeError : Waiting : EmulatedWalletAPI
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
-> Eff
     (EmulatedWalletAPI
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff
  (Error EmulatorRuntimeError
     : Waiting : EmulatedWalletAPI : Reader ThreadId
     : Yield
         (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
     : effs)
  a
-> Eff
     (Waiting
        : EmulatedWalletAPI : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
forall (eff :: * -> *) (effs :: [* -> *]).
Member eff effs =>
Eff (eff : effs) ~> Eff effs
subsume
            (Eff
   (Error EmulatorRuntimeError
      : Waiting : EmulatedWalletAPI : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)
   a
 -> Eff
      (Waiting
         : EmulatedWalletAPI : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a)
-> (Eff
      (RunContractPlayground
         : Error EmulatorRuntimeError : Waiting : EmulatedWalletAPI
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a
    -> Eff
         (Error EmulatorRuntimeError
            : Waiting : EmulatedWalletAPI : Reader ThreadId
            : Yield
                (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
            : effs)
         a)
-> Eff
     (RunContractPlayground
        : Error EmulatorRuntimeError : Waiting : EmulatedWalletAPI
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
-> Eff
     (Waiting
        : EmulatedWalletAPI : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RunContractPlayground
 ~> Eff
      (Error EmulatorRuntimeError
         : Waiting : EmulatedWalletAPI : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs))
-> Eff
     (RunContractPlayground
        : Error EmulatorRuntimeError : Waiting : EmulatedWalletAPI
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
   ~> Eff
        (Error EmulatorRuntimeError
           : Waiting : EmulatedWalletAPI : Reader ThreadId
           : Yield
               (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
           : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (NetworkId
-> Contract w s e ()
-> RunContractPlayground
   ~> Eff
        (Error EmulatorRuntimeError
           : Waiting : EmulatedWalletAPI : Reader ThreadId
           : Yield
               (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
           : effs)
forall w (s :: Row *) e (effs :: [* -> *]) (effs2 :: [* -> *]) a.
(ContractConstraints s, Show e, ToJSON e, ToJSON w, Monoid w,
 Member ContractInstanceIdEff effs,
 Member
   (Yield
      (EmSystemCall effs2 EmulatorMessage a) (Maybe EmulatorMessage))
   effs,
 Member (LogMsg EmulatorEvent') effs2,
 Member (Error EmulatorRuntimeError) effs2,
 Member (State EmulatorThreads) effs2,
 Member MultiAgentEffect effs2,
 Member (State (Map Wallet ContractInstanceId)) effs2,
 Member (State (Map Wallet ContractInstanceId)) effs) =>
NetworkId -> Contract w s e () -> RunContractPlayground ~> Eff effs
handleRunContractPlayground @w @s @e @_ @effs @a (Params -> NetworkId
pNetworkId (Params -> NetworkId) -> Params -> NetworkId
forall a b. (a -> b) -> a -> b
$ EmulatorConfig -> Params
_params EmulatorConfig
conf) Contract w s e ()
contract)
            (Eff
   (RunContractPlayground
      : Error EmulatorRuntimeError : Waiting : EmulatedWalletAPI
      : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)
   a
 -> Eff
      (Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a)
-> Eff
     (RunContractPlayground
        : Error EmulatorRuntimeError : Waiting : EmulatedWalletAPI
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
forall a b. (a -> b) -> a -> b
$ PlaygroundTrace a
-> Eff
     (RunContractPlayground
        : Error EmulatorRuntimeError : Waiting : EmulatedWalletAPI
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
forall (effs :: [* -> *]) (as :: [* -> *]).
CanWeakenEnd as effs =>
Eff as ~> Eff effs
raiseEnd PlaygroundTrace a
action
    Eff
  (Reader ThreadId
     : Yield
         (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
     : effs)
  (Maybe EmulatorMessage)
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff
   (Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)
   (Maybe EmulatorMessage)
 -> Eff
      (Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      ())
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     (Maybe EmulatorMessage)
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     ()
forall a b. (a -> b) -> a -> b
$ a
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     (Maybe EmulatorMessage)
forall (effs :: [* -> *]) systemEvent (effs2 :: [* -> *]) a.
Member
  (Yield (EmSystemCall effs systemEvent a) (Maybe systemEvent))
  effs2 =>
a -> Eff effs2 (Maybe systemEvent)
exit @effs @EmulatorMessage a
result

-- | Run a 'Trace Playground', streaming the log messages as they arrive
runPlaygroundStream :: forall w s e effs a.
    ( ContractConstraints s
    , Show e
    , JSON.ToJSON e
    , JSON.ToJSON w
    , Monoid w
    )
    => EmulatorConfig
    -> Contract w s e ()
    -> PlaygroundTrace a
    -> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) (Either EmulatorErr a, EmulatorState)
runPlaygroundStream :: EmulatorConfig
-> Contract w s e ()
-> PlaygroundTrace a
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff effs)
     (Either EmulatorErr a, EmulatorState)
runPlaygroundStream EmulatorConfig
conf Contract w s e ()
contract =
    let wallets :: [Wallet]
wallets = [Wallet] -> Maybe [Wallet] -> [Wallet]
forall a. a -> Maybe a -> a
fromMaybe [Wallet]
knownWallets (Getting (First [Wallet]) EmulatorConfig [Wallet]
-> EmulatorConfig -> Maybe [Wallet]
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((InitialChainState -> Const (First [Wallet]) InitialChainState)
-> EmulatorConfig -> Const (First [Wallet]) EmulatorConfig
Lens' EmulatorConfig InitialChainState
initialChainState ((InitialChainState -> Const (First [Wallet]) InitialChainState)
 -> EmulatorConfig -> Const (First [Wallet]) EmulatorConfig)
-> (([Wallet] -> Const (First [Wallet]) [Wallet])
    -> InitialChainState -> Const (First [Wallet]) InitialChainState)
-> Getting (First [Wallet]) EmulatorConfig [Wallet]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Wallet Value -> Const (First [Wallet]) (Map Wallet Value))
-> InitialChainState -> Const (First [Wallet]) InitialChainState
forall a c b. Prism (Either a c) (Either b c) a b
_Left ((Map Wallet Value -> Const (First [Wallet]) (Map Wallet Value))
 -> InitialChainState -> Const (First [Wallet]) InitialChainState)
-> (([Wallet] -> Const (First [Wallet]) [Wallet])
    -> Map Wallet Value -> Const (First [Wallet]) (Map Wallet Value))
-> ([Wallet] -> Const (First [Wallet]) [Wallet])
-> InitialChainState
-> Const (First [Wallet]) InitialChainState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Wallet Value -> [Wallet])
-> ([Wallet] -> Const (First [Wallet]) [Wallet])
-> Map Wallet Value
-> Const (First [Wallet]) (Map Wallet Value)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Map Wallet Value -> [Wallet]
forall k a. Map k a -> [k]
Map.keys) EmulatorConfig
conf)
    in EmulatorConfig
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff effs)
     (Either EmulatorErr a, EmulatorState)
forall (effs :: [* -> *]) a.
EmulatorConfig
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff effs)
     (Either EmulatorErr a, EmulatorState)
runTraceStream EmulatorConfig
conf (Eff
   '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
     MultiAgentControlEffect, ChainEffect, ChainControlEffect,
     Error EmulatorRuntimeError]
   (Maybe a)
 -> Stream
      (Of (LogMessage EmulatorEvent))
      (Eff effs)
      (Either EmulatorErr a, EmulatorState))
-> (PlaygroundTrace a
    -> Eff
         '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
           MultiAgentControlEffect, ChainEffect, ChainControlEffect,
           Error EmulatorRuntimeError]
         (Maybe a))
-> PlaygroundTrace a
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff effs)
     (Either EmulatorErr a, EmulatorState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmulatorConfig
-> Contract w s e ()
-> [Wallet]
-> PlaygroundTrace a
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
forall w (s :: Row *) e (effs :: [* -> *]) a.
(Member MultiAgentEffect effs, Member MultiAgentControlEffect effs,
 Member (Error EmulatorRuntimeError) effs,
 Member ChainControlEffect effs,
 Member (LogMsg EmulatorEvent') effs, ContractConstraints s, Show e,
 ToJSON e, ToJSON w, Monoid w) =>
EmulatorConfig
-> Contract w s e ()
-> [Wallet]
-> PlaygroundTrace a
-> Eff effs (Maybe a)
interpretPlaygroundTrace EmulatorConfig
conf Contract w s e ()
contract [Wallet]
wallets

interpretPlaygroundTrace :: forall w s e effs a.
    ( Member MultiAgentEffect effs
    , Member MultiAgentControlEffect effs
    , Member (Error EmulatorRuntimeError) effs
    , Member ChainControlEffect effs
    , Member (LogMsg EmulatorEvent') effs
    , ContractConstraints s
    , Show e
    , JSON.ToJSON e
    , JSON.ToJSON w
    , Monoid w
    )
    => EmulatorConfig
    -> Contract w s e () -- ^ The contract
    -> [Wallet] -- ^ Wallets that should be simulated in the emulator
    -> PlaygroundTrace a
    -> Eff effs (Maybe a)
interpretPlaygroundTrace :: EmulatorConfig
-> Contract w s e ()
-> [Wallet]
-> PlaygroundTrace a
-> Eff effs (Maybe a)
interpretPlaygroundTrace EmulatorConfig
conf Contract w s e ()
contract [Wallet]
wallets PlaygroundTrace a
action =
        EmulatorThreads
-> Eff (State EmulatorThreads : effs) (Maybe a)
-> Eff effs (Maybe a)
forall s (effs :: [* -> *]) a.
s -> Eff (State s : effs) a -> Eff effs a
evalState @EmulatorThreads EmulatorThreads
forall a. Monoid a => a
mempty
        (Eff (State EmulatorThreads : effs) (Maybe a)
 -> Eff effs (Maybe a))
-> Eff (State EmulatorThreads : effs) (Maybe a)
-> Eff effs (Maybe a)
forall a b. (a -> b) -> a -> b
$ Map Wallet ContractInstanceId
-> Eff
     (State (Map Wallet ContractInstanceId)
        : State EmulatorThreads : effs)
     (Maybe a)
-> Eff (State EmulatorThreads : effs) (Maybe a)
forall s (effs :: [* -> *]) a.
s -> Eff (State s : effs) a -> Eff effs a
evalState @(Map Wallet ContractInstanceId) Map Wallet ContractInstanceId
forall k a. Map k a
Map.empty
        (Eff
   (State (Map Wallet ContractInstanceId)
      : State EmulatorThreads : effs)
   (Maybe a)
 -> Eff (State EmulatorThreads : effs) (Maybe a))
-> Eff
     (State (Map Wallet ContractInstanceId)
        : State EmulatorThreads : effs)
     (Maybe a)
-> Eff (State EmulatorThreads : effs) (Maybe a)
forall a b. (a -> b) -> a -> b
$ Eff
  (ContractInstanceIdEff
     : State (Map Wallet ContractInstanceId) : State EmulatorThreads
     : effs)
  (Maybe a)
-> Eff
     (State (Map Wallet ContractInstanceId)
        : State EmulatorThreads : effs)
     (Maybe a)
forall (effs :: [* -> *]).
Eff (ContractInstanceIdEff : effs) ~> Eff effs
handleDeterministicIds
        (Eff
   (ContractInstanceIdEff
      : State (Map Wallet ContractInstanceId) : State EmulatorThreads
      : effs)
   (Maybe a)
 -> Eff
      (State (Map Wallet ContractInstanceId)
         : State EmulatorThreads : effs)
      (Maybe a))
-> Eff
     (ContractInstanceIdEff
        : State (Map Wallet ContractInstanceId) : State EmulatorThreads
        : effs)
     (Maybe a)
-> Eff
     (State (Map Wallet ContractInstanceId)
        : State EmulatorThreads : effs)
     (Maybe a)
forall a b. (a -> b) -> a -> b
$ (LogMsg SchedulerLog
 ~> Eff
      (ContractInstanceIdEff
         : State (Map Wallet ContractInstanceId) : State EmulatorThreads
         : effs))
-> Eff
     (LogMsg SchedulerLog
        : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
        : State EmulatorThreads : effs)
   ~> Eff
        (ContractInstanceIdEff
           : State (Map Wallet ContractInstanceId) : State EmulatorThreads
           : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((SchedulerLog -> EmulatorEvent')
-> LogMsg SchedulerLog
   ~> Eff
        (ContractInstanceIdEff
           : State (Map Wallet ContractInstanceId) : State EmulatorThreads
           : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog (AReview EmulatorEvent' SchedulerLog
-> SchedulerLog -> EmulatorEvent'
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview EmulatorEvent' SchedulerLog
Prism' EmulatorEvent' SchedulerLog
schedulerEvent))
        (Eff
   (LogMsg SchedulerLog
      : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
      : State EmulatorThreads : effs)
   (Maybe a)
 -> Eff
      (ContractInstanceIdEff
         : State (Map Wallet ContractInstanceId) : State EmulatorThreads
         : effs)
      (Maybe a))
-> Eff
     (LogMsg SchedulerLog
        : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
        : State EmulatorThreads : effs)
     (Maybe a)
-> Eff
     (ContractInstanceIdEff
        : State (Map Wallet ContractInstanceId) : State EmulatorThreads
        : effs)
     (Maybe a)
forall a b. (a -> b) -> a -> b
$ Eff
  (Reader ThreadId
     : Yield
         (EmSystemCall
            (LogMsg SchedulerLog
               : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
               : State EmulatorThreads : effs)
            EmulatorMessage
            a)
         (Maybe EmulatorMessage)
     : LogMsg SchedulerLog : ContractInstanceIdEff
     : State (Map Wallet ContractInstanceId) : State EmulatorThreads
     : effs)
  ()
-> Eff
     (LogMsg SchedulerLog
        : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
        : State EmulatorThreads : effs)
     (Maybe a)
forall a (effs :: [* -> *]) systemEvent.
(Eq systemEvent, Member (LogMsg SchedulerLog) effs) =>
Eff
  (Reader ThreadId
     : Yield (EmSystemCall effs systemEvent a) (Maybe systemEvent)
     : effs)
  ()
-> Eff effs (Maybe a)
runThreads
        (Eff
   (Reader ThreadId
      : Yield
          (EmSystemCall
             (LogMsg SchedulerLog
                : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
                : State EmulatorThreads : effs)
             EmulatorMessage
             a)
          (Maybe EmulatorMessage)
      : LogMsg SchedulerLog : ContractInstanceIdEff
      : State (Map Wallet ContractInstanceId) : State EmulatorThreads
      : effs)
   ()
 -> Eff
      (LogMsg SchedulerLog
         : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
         : State EmulatorThreads : effs)
      (Maybe a))
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall
               (LogMsg SchedulerLog
                  : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
                  : State EmulatorThreads : effs)
               EmulatorMessage
               a)
            (Maybe EmulatorMessage)
        : LogMsg SchedulerLog : ContractInstanceIdEff
        : State (Map Wallet ContractInstanceId) : State EmulatorThreads
        : effs)
     ()
-> Eff
     (LogMsg SchedulerLog
        : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
        : State EmulatorThreads : effs)
     (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
            Eff
  (Yield
     (EmSystemCall
        (LogMsg SchedulerLog
           : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
           : State EmulatorThreads : effs)
        EmulatorMessage
        a)
     (Maybe EmulatorMessage)
     : LogMsg SchedulerLog : ContractInstanceIdEff
     : State (Map Wallet ContractInstanceId) : State EmulatorThreads
     : effs)
  ()
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall
               (LogMsg SchedulerLog
                  : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
                  : State EmulatorThreads : effs)
               EmulatorMessage
               a)
            (Maybe EmulatorMessage)
        : LogMsg SchedulerLog : ContractInstanceIdEff
        : State (Map Wallet ContractInstanceId) : State EmulatorThreads
        : effs)
     ()
forall (effs :: [* -> *]) a (e :: * -> *).
Eff effs a -> Eff (e : effs) a
raise (Eff
   (Yield
      (EmSystemCall
         (LogMsg SchedulerLog
            : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
            : State EmulatorThreads : effs)
         EmulatorMessage
         a)
      (Maybe EmulatorMessage)
      : LogMsg SchedulerLog : ContractInstanceIdEff
      : State (Map Wallet ContractInstanceId) : State EmulatorThreads
      : effs)
   ()
 -> Eff
      (Reader ThreadId
         : Yield
             (EmSystemCall
                (LogMsg SchedulerLog
                   : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
                   : State EmulatorThreads : effs)
                EmulatorMessage
                a)
             (Maybe EmulatorMessage)
         : LogMsg SchedulerLog : ContractInstanceIdEff
         : State (Map Wallet ContractInstanceId) : State EmulatorThreads
         : effs)
      ())
-> Eff
     (Yield
        (EmSystemCall
           (LogMsg SchedulerLog
              : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
              : State EmulatorThreads : effs)
           EmulatorMessage
           a)
        (Maybe EmulatorMessage)
        : LogMsg SchedulerLog : ContractInstanceIdEff
        : State (Map Wallet ContractInstanceId) : State EmulatorThreads
        : effs)
     ()
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall
               (LogMsg SchedulerLog
                  : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
                  : State EmulatorThreads : effs)
               EmulatorMessage
               a)
            (Maybe EmulatorMessage)
        : LogMsg SchedulerLog : ContractInstanceIdEff
        : State (Map Wallet ContractInstanceId) : State EmulatorThreads
        : effs)
     ()
forall a b. (a -> b) -> a -> b
$ [Wallet]
-> Eff
     (Yield
        (EmSystemCall
           (LogMsg SchedulerLog
              : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
              : State EmulatorThreads : effs)
           EmulatorMessage
           a)
        (Maybe EmulatorMessage)
        : LogMsg SchedulerLog : ContractInstanceIdEff
        : State (Map Wallet ContractInstanceId) : State EmulatorThreads
        : effs)
     ()
forall (effs :: [* -> *]) a.
(Member ChainControlEffect effs, Member MultiAgentEffect effs,
 Member MultiAgentControlEffect effs) =>
[Wallet]
-> Eff
     (Yield
        (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     ()
launchSystemThreads [Wallet]
wallets
            EmulatorConfig
-> Contract w s e ()
-> PlaygroundTrace a
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall
               (LogMsg SchedulerLog
                  : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
                  : State EmulatorThreads : effs)
               EmulatorMessage
               a)
            (Maybe EmulatorMessage)
        : LogMsg SchedulerLog : ContractInstanceIdEff
        : State (Map Wallet ContractInstanceId) : State EmulatorThreads
        : effs)
     ()
forall w (s :: Row *) e (effs :: [* -> *]) a.
(ContractConstraints s, Show e, ToJSON e, ToJSON w, Monoid w,
 Member MultiAgentEffect effs, Member (LogMsg EmulatorEvent') effs,
 Member (Error EmulatorRuntimeError) effs,
 Member (State (Map Wallet ContractInstanceId)) effs,
 Member (State EmulatorThreads) effs,
 Member ContractInstanceIdEff effs) =>
EmulatorConfig
-> Contract w s e ()
-> PlaygroundTrace a
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     ()
handlePlaygroundTrace EmulatorConfig
conf Contract w s e ()
contract (PlaygroundTrace a
 -> Eff
      (Reader ThreadId
         : Yield
             (EmSystemCall
                (LogMsg SchedulerLog
                   : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
                   : State EmulatorThreads : effs)
                EmulatorMessage
                a)
             (Maybe EmulatorMessage)
         : LogMsg SchedulerLog : ContractInstanceIdEff
         : State (Map Wallet ContractInstanceId) : State EmulatorThreads
         : effs)
      ())
-> PlaygroundTrace a
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall
               (LogMsg SchedulerLog
                  : ContractInstanceIdEff : State (Map Wallet ContractInstanceId)
                  : State EmulatorThreads : effs)
               EmulatorMessage
               a)
            (Maybe EmulatorMessage)
        : LogMsg SchedulerLog : ContractInstanceIdEff
        : State (Map Wallet ContractInstanceId) : State EmulatorThreads
        : effs)
     ()
forall a b. (a -> b) -> a -> b
$ do
                Eff
  '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
    EmulatedWalletAPI]
  Slot
-> Eff
     '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
       EmulatedWalletAPI]
     ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Eff
  '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
    EmulatedWalletAPI]
  Slot
forall (effs :: [* -> *]). Member Waiting effs => Eff effs Slot
Waiting.nextSlot
                (Wallet
 -> Eff
      '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
        EmulatedWalletAPI]
      ())
-> [Wallet]
-> Eff
     '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
       EmulatedWalletAPI]
     ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Wallet
-> Eff
     '[RunContractPlayground, Error EmulatorRuntimeError, Waiting,
       EmulatedWalletAPI]
     ()
forall (effs :: [* -> *]).
Member RunContractPlayground effs =>
Wallet -> Eff effs ()
RunContractPlayground.launchContract [Wallet]
wallets
                PlaygroundTrace a
action