{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE TypeOperators       #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-

An emulator trace is a contract trace that can be run in the Plutus emulator.

-}
module Plutus.Trace.Emulator(
    Emulator
    , EmulatorTrace
    , EmulatorEffects
    , BaseEmulatorEffects
    , Wallet.Emulator.Stream.EmulatorErr(..)
    , Plutus.Trace.Emulator.Types.ContractHandle(..)
    , ContractInstanceTag
    , ContractConstraints
    -- * Constructing Traces
    , Assert.assert
    , RunContract.activateContract
    , RunContract.activateContractWallet
    , RunContract.walletInstanceTag
    , RunContract.callEndpoint
    , RunContract.getContractState
    , RunContract.observableState
    , RunContract.activeEndpoints
    , EmulatedWalletAPI.liftWallet
    , EmulatedWalletAPI.payToWallet
    , Waiting.nextSlot
    , Waiting.waitUntilSlot
    , Waiting.waitUntilTime
    , Waiting.waitNSlots
    , Waiting.waitNMilliSeconds
    , EmulatorControl.freezeContractInstance
    , EmulatorControl.thawContractInstance
    -- ** Inspecting the chain state
    , EmulatorControl.setSigningProcess
    , EmulatorControl.chainState
    , EmulatorControl.getSlotConfig
    , ChainState.chainNewestFirst
    , ChainState.txPool
    , ChainState.index
    , ChainState.chainCurrentSlot
    -- ** Inspecting the agent states
    , EmulatorControl.agentState
    , Wallet.ownPaymentPrivateKey
    , Wallet.nodeClient
    , Wallet.signingProcess
    -- * Throwing errors
    , throwError
    , EmulatorRuntimeError(..)
    -- * Running traces
    , EmulatorConfig(..)
    , initialChainState
    , params
    , runEmulatorStream
    , TraceConfig(..)
    , traceConfigShowEventExample
    , runEmulatorTrace
    , evalEmulatorTrace
    , PrintEffect(..)
    , runEmulatorTraceEff
    , runEmulatorTraceIO
    , runEmulatorTraceIO'
    -- * Interpreter
    , interpretEmulatorTrace
    ) where

import Cardano.Api qualified as C
import Cardano.Node.Emulator.Internal.Node (ChainControlEffect, Params (..))
import Cardano.Node.Emulator.Internal.Node qualified as ChainState
import Control.Foldl (generalize, list)
import Control.Lens hiding ((:>))
import Control.Monad (forM_, void)
import Control.Monad.Freer (Eff, Member, interpret, interpretM, raise, reinterpret, run, runM, subsume)
import Control.Monad.Freer.Coroutine (Yield)
import Control.Monad.Freer.Error (Error, handleError, throwError)
import Control.Monad.Freer.Extras.Log (LogLevel (Info), LogMessage (LogMessage), LogMsg, mapLog)
import Control.Monad.Freer.Extras.Modify (raiseEnd)
import Control.Monad.Freer.Reader (Reader)
import Control.Monad.Freer.State (State, evalState)
import Control.Monad.Freer.TH (makeEffect)
import Data.Aeson qualified as A
import Data.Default (Default (def))
import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import Data.Text qualified as Text
import Ledger.CardanoWallet qualified as CW
import Ledger.Slot (getSlot)
import Plutus.Trace.Effects.Assert (Assert, handleAssert)
import Plutus.Trace.Effects.Assert qualified as Assert
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.EmulatorControl (EmulatorControl, handleEmulatorControl)
import Plutus.Trace.Effects.EmulatorControl qualified as EmulatorControl
import Plutus.Trace.Effects.RunContract (RunContract, StartContract, handleRunContract, handleStartContract)
import Plutus.Trace.Effects.RunContract qualified as RunContract
import Plutus.Trace.Effects.Waiting (Waiting, handleWaiting)
import Plutus.Trace.Effects.Waiting qualified as Waiting
import Plutus.Trace.Emulator.System (launchSystemThreads)
import Plutus.Trace.Emulator.Types (ContractConstraints, ContractInstanceLog (ContractInstanceLog),
                                    ContractInstanceMsg (ContractLog, CurrentRequests, HandledRequest, NoRequestsHandled, StoppedWithError),
                                    ContractInstanceTag, Emulator, EmulatorMessage,
                                    EmulatorRuntimeError (EmulatedWalletError), EmulatorThreads,
                                    UserThreadMsg (UserLog))
import Plutus.Trace.Emulator.Types qualified
import Plutus.Trace.Scheduler (EmSystemCall, ThreadId, exit, runThreads)
import Prettyprinter (defaultLayoutOptions, layoutPretty, pretty)
import Prettyprinter.Render.String (renderString)
import Prettyprinter.Render.Text (renderStrict)
import Streaming (Stream)
import Streaming.Prelude (Of ((:>)))
import System.IO (Handle, hPutStrLn, stdout)
import Wallet.Emulator.MultiAgent (EmulatorEvent,
                                   EmulatorEvent' (InstanceEvent, SchedulerEvent, UserThreadEvent, WalletEvent),
                                   EmulatorState (_chainState, _walletStates), EmulatorTimeEvent (EmulatorTimeEvent),
                                   MultiAgentControlEffect, MultiAgentEffect, schedulerEvent)
import Wallet.Emulator.Stream (EmulatorConfig (_initialChainState, _params), EmulatorErr, filterLogLevel, foldStreamM,
                               initialChainState, params, runTraceStream)
import Wallet.Emulator.Stream qualified
import Wallet.Emulator.Wallet (Entity, balances)
import Wallet.Emulator.Wallet qualified as Wallet

-- | A very simple effect for interpreting the output printing done by the
-- trace printing functions:
--
-- * 'runEmulatorTraceEff'
-- * 'runEmulatorTraceIO'
-- * 'runEmulatorTraceIOWithConfig'
data PrintEffect r where
  PrintLn :: String -> PrintEffect ()
makeEffect ''PrintEffect


type EmulatorEffects = StartContract
                    ': BaseEmulatorEffects

type BaseEmulatorEffects =
             [ RunContract
             , Assert
             , Waiting
             , EmulatorControl
             , EmulatedWalletAPI
             , LogMsg String
             , Error EmulatorRuntimeError
             ]

type EmulatorTrace = Eff EmulatorEffects

handleEmulatorTrace ::
    forall effs a.
    ( Member MultiAgentEffect effs
    , Member MultiAgentControlEffect effs
    , Member (State EmulatorThreads) effs
    , Member (State EmulatorState) effs
    , Member (Error EmulatorRuntimeError) effs
    , Member (LogMsg EmulatorEvent') effs
    , Member ContractInstanceIdEff effs
    )
    => Params
    -> EmulatorTrace a
    -> Eff (Reader ThreadId ': Yield (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage) ': effs) ()
handleEmulatorTrace :: Params
-> EmulatorTrace a
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     ()
handleEmulatorTrace params :: Params
params@Params{NetworkId
pNetworkId :: Params -> NetworkId
pNetworkId :: NetworkId
pNetworkId, SlotConfig
pSlotConfig :: Params -> SlotConfig
pSlotConfig :: SlotConfig
pSlotConfig} EmulatorTrace a
action = do
    a
result <- forall (effs :: [* -> *]).
Member (Error EmulatorRuntimeError) effs =>
Eff (Error EmulatorRuntimeError : effs) ~> Eff effs
forall (eff :: * -> *) (effs :: [* -> *]).
Member eff effs =>
Eff (eff : effs) ~> Eff effs
subsume @(Error EmulatorRuntimeError)
            (Eff
   (Error EmulatorRuntimeError
      : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)
   a
 -> Eff
      (Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a)
-> (Eff
      (StartContract
         : RunContract : Assert : Waiting : EmulatorControl
         : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a
    -> Eff
         (Error EmulatorRuntimeError
            : Reader ThreadId
            : Yield
                (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
            : effs)
         a)
-> Eff
     (StartContract
        : RunContract : Assert : Waiting : EmulatorControl
        : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
        : 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
. (LogMsg String
 ~> Eff
      (Error EmulatorRuntimeError
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs))
-> Eff
     (LogMsg String
        : Error EmulatorRuntimeError : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
   ~> Eff
        (Error EmulatorRuntimeError
           : Reader ThreadId
           : Yield
               (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
           : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((String -> EmulatorEvent')
-> LogMsg String
   ~> Eff
        (Error EmulatorRuntimeError
           : Reader ThreadId
           : Yield
               (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
           : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog (UserThreadMsg -> EmulatorEvent'
UserThreadEvent (UserThreadMsg -> EmulatorEvent')
-> (String -> UserThreadMsg) -> String -> EmulatorEvent'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> UserThreadMsg
UserLog))
            (Eff
   (LogMsg String
      : Error EmulatorRuntimeError : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)
   a
 -> Eff
      (Error EmulatorRuntimeError
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a)
-> (Eff
      (StartContract
         : RunContract : Assert : Waiting : EmulatorControl
         : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a
    -> Eff
         (LogMsg String
            : Error EmulatorRuntimeError : Reader ThreadId
            : Yield
                (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
            : effs)
         a)
-> Eff
     (StartContract
        : RunContract : Assert : Waiting : EmulatorControl
        : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
-> Eff
     (Error EmulatorRuntimeError
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Eff
   (Error WalletAPIError
      : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)
   a
 -> (WalletAPIError
     -> Eff
          (LogMsg String
             : Error EmulatorRuntimeError : Reader ThreadId
             : Yield
                 (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
             : effs)
          a)
 -> Eff
      (LogMsg String
         : Error EmulatorRuntimeError : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a)
-> (WalletAPIError
    -> Eff
         (LogMsg String
            : Error EmulatorRuntimeError : Reader ThreadId
            : Yield
                (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
            : effs)
         a)
-> Eff
     (Error WalletAPIError
        : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
-> Eff
     (LogMsg String
        : Error EmulatorRuntimeError : 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
     : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
     : Yield
         (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
     : effs)
  a
-> (WalletAPIError
    -> Eff
         (LogMsg String
            : Error EmulatorRuntimeError : Reader ThreadId
            : Yield
                (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
            : effs)
         a)
-> Eff
     (LogMsg String
        : Error EmulatorRuntimeError : 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
     (LogMsg String
        : Error EmulatorRuntimeError : 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
      (LogMsg String
         : Error EmulatorRuntimeError : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a)
-> (WalletAPIError -> EmulatorRuntimeError)
-> WalletAPIError
-> Eff
     (LogMsg String
        : Error EmulatorRuntimeError : 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
      : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)
   a
 -> Eff
      (LogMsg String
         : Error EmulatorRuntimeError : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a)
-> (Eff
      (StartContract
         : RunContract : Assert : Waiting : EmulatorControl
         : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a
    -> Eff
         (Error WalletAPIError
            : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
            : Yield
                (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
            : effs)
         a)
-> Eff
     (StartContract
        : RunContract : Assert : Waiting : EmulatorControl
        : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
-> Eff
     (LogMsg String
        : Error EmulatorRuntimeError : 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
         : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs))
-> Eff
     (EmulatedWalletAPI
        : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
   ~> Eff
        (Error WalletAPIError
           : LogMsg String : Error EmulatorRuntimeError : 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
        : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
handleEmulatedWalletAPI
            (Eff
   (EmulatedWalletAPI
      : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)
   a
 -> Eff
      (Error WalletAPIError
         : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a)
-> (Eff
      (StartContract
         : RunContract : Assert : Waiting : EmulatorControl
         : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a
    -> Eff
         (EmulatedWalletAPI
            : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
            : Yield
                (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
            : effs)
         a)
-> Eff
     (StartContract
        : RunContract : Assert : Waiting : EmulatorControl
        : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
-> Eff
     (Error WalletAPIError
        : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EmulatorControl
 ~> Eff
      (EmulatedWalletAPI
         : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs))
-> Eff
     (EmulatorControl
        : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
   ~> Eff
        (EmulatedWalletAPI
           : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
           : Yield
               (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
           : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Params
-> EmulatorControl
   ~> Eff
        (EmulatedWalletAPI
           : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
           : Yield
               (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
           : effs)
forall (effs :: [* -> *]) (effs2 :: [* -> *]) a.
(Member (State EmulatorThreads) effs,
 Member (State EmulatorState) effs,
 Member (Error EmulatorRuntimeError) effs,
 Member MultiAgentControlEffect effs,
 Member
   (Yield
      (EmSystemCall effs2 EmulatorMessage a) (Maybe EmulatorMessage))
   effs) =>
Params -> EmulatorControl ~> Eff effs
handleEmulatorControl @_ @effs @a Params
params)
            (Eff
   (EmulatorControl
      : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
      : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)
   a
 -> Eff
      (EmulatedWalletAPI
         : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a)
-> (Eff
      (StartContract
         : RunContract : Assert : Waiting : EmulatorControl
         : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a
    -> Eff
         (EmulatorControl
            : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
            : Reader ThreadId
            : Yield
                (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
            : effs)
         a)
-> Eff
     (StartContract
        : RunContract : Assert : Waiting : EmulatorControl
        : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
-> Eff
     (EmulatedWalletAPI
        : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Waiting
 ~> Eff
      (EmulatorControl
         : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs))
-> Eff
     (Waiting
        : EmulatorControl : EmulatedWalletAPI : LogMsg String
        : Error EmulatorRuntimeError : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
   ~> Eff
        (EmulatorControl
           : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
           : 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
        (EmulatorControl
           : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
           : 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 SlotConfig
pSlotConfig)
            (Eff
   (Waiting
      : EmulatorControl : EmulatedWalletAPI : LogMsg String
      : Error EmulatorRuntimeError : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)
   a
 -> Eff
      (EmulatorControl
         : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a)
-> (Eff
      (StartContract
         : RunContract : Assert : Waiting : EmulatorControl
         : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a
    -> Eff
         (Waiting
            : EmulatorControl : EmulatedWalletAPI : LogMsg String
            : Error EmulatorRuntimeError : Reader ThreadId
            : Yield
                (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
            : effs)
         a)
-> Eff
     (StartContract
        : RunContract : Assert : Waiting : EmulatorControl
        : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
-> Eff
     (EmulatorControl
        : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Assert
 ~> Eff
      (Waiting
         : EmulatorControl : EmulatedWalletAPI : LogMsg String
         : Error EmulatorRuntimeError : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs))
-> Eff
     (Assert
        : Waiting : EmulatorControl : EmulatedWalletAPI : LogMsg String
        : Error EmulatorRuntimeError : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
   ~> Eff
        (Waiting
           : EmulatorControl : EmulatedWalletAPI : LogMsg String
           : Error EmulatorRuntimeError : Reader ThreadId
           : Yield
               (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
           : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((Member
   (Yield
      (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage))
   (Waiting
      : EmulatorControl : EmulatedWalletAPI : LogMsg String
      : Error EmulatorRuntimeError : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs),
 Member
   (Error EmulatorRuntimeError)
   (Waiting
      : EmulatorControl : EmulatedWalletAPI : LogMsg String
      : Error EmulatorRuntimeError : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs),
 Member
   (State EmulatorState)
   (Waiting
      : EmulatorControl : EmulatedWalletAPI : LogMsg String
      : Error EmulatorRuntimeError : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)) =>
Assert
~> Eff
     (Waiting
        : EmulatorControl : EmulatedWalletAPI : LogMsg String
        : Error EmulatorRuntimeError : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
forall (effs :: [* -> *]) (effs2 :: [* -> *]) a.
(Member
   (Yield
      (EmSystemCall effs2 EmulatorMessage a) (Maybe EmulatorMessage))
   effs,
 Member (Error EmulatorRuntimeError) effs,
 Member (State EmulatorState) effs) =>
Assert ~> Eff effs
handleAssert @_ @effs @a)
            (Eff
   (Assert
      : Waiting : EmulatorControl : EmulatedWalletAPI : LogMsg String
      : Error EmulatorRuntimeError : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)
   a
 -> Eff
      (Waiting
         : EmulatorControl : EmulatedWalletAPI : LogMsg String
         : Error EmulatorRuntimeError : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a)
-> (Eff
      (StartContract
         : RunContract : Assert : Waiting : EmulatorControl
         : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a
    -> Eff
         (Assert
            : Waiting : EmulatorControl : EmulatedWalletAPI : LogMsg String
            : Error EmulatorRuntimeError : Reader ThreadId
            : Yield
                (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
            : effs)
         a)
-> Eff
     (StartContract
        : RunContract : Assert : Waiting : EmulatorControl
        : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
-> Eff
     (Waiting
        : EmulatorControl : EmulatedWalletAPI : LogMsg String
        : Error EmulatorRuntimeError : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RunContract
 ~> Eff
      (Assert
         : Waiting : EmulatorControl : EmulatedWalletAPI : LogMsg String
         : Error EmulatorRuntimeError : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs))
-> Eff
     (RunContract
        : Assert : Waiting : EmulatorControl : EmulatedWalletAPI
        : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
   ~> Eff
        (Assert
           : Waiting : EmulatorControl : EmulatedWalletAPI : LogMsg String
           : Error EmulatorRuntimeError : Reader ThreadId
           : Yield
               (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
           : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((Member (State EmulatorThreads) effs,
 Member (Error EmulatorRuntimeError) effs,
 Member
   (Error EmulatorRuntimeError)
   (Assert
      : Waiting : EmulatorControl : EmulatedWalletAPI : LogMsg String
      : Error EmulatorRuntimeError : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs),
 Member
   (LogMsg EmulatorEvent')
   (Assert
      : Waiting : EmulatorControl : EmulatedWalletAPI : LogMsg String
      : Error EmulatorRuntimeError : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs),
 Member
   (State EmulatorThreads)
   (Assert
      : Waiting : EmulatorControl : EmulatedWalletAPI : LogMsg String
      : Error EmulatorRuntimeError : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs),
 Member
   (Reader ThreadId)
   (Assert
      : Waiting : EmulatorControl : EmulatedWalletAPI : LogMsg String
      : Error EmulatorRuntimeError : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs),
 Member
   (Yield
      (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage))
   (Assert
      : Waiting : EmulatorControl : EmulatedWalletAPI : LogMsg String
      : Error EmulatorRuntimeError : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)) =>
RunContract
~> Eff
     (Assert
        : Waiting : EmulatorControl : EmulatedWalletAPI : LogMsg String
        : Error EmulatorRuntimeError : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
forall (effs :: [* -> *]) (effs2 :: [* -> *]) a.
(Member (State EmulatorThreads) effs2,
 Member (Error EmulatorRuntimeError) effs2,
 Member (Error EmulatorRuntimeError) effs,
 Member (LogMsg EmulatorEvent') effs,
 Member (State EmulatorThreads) effs, Member (Reader ThreadId) effs,
 Member
   (Yield
      (EmSystemCall effs2 EmulatorMessage a) (Maybe EmulatorMessage))
   effs) =>
RunContract ~> Eff effs
handleRunContract @_ @effs @a)
            (Eff
   (RunContract
      : Assert : Waiting : EmulatorControl : EmulatedWalletAPI
      : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)
   a
 -> Eff
      (Assert
         : Waiting : EmulatorControl : EmulatedWalletAPI : LogMsg String
         : Error EmulatorRuntimeError : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a)
-> (Eff
      (StartContract
         : RunContract : Assert : Waiting : EmulatorControl
         : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
         : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a
    -> Eff
         (RunContract
            : Assert : Waiting : EmulatorControl : EmulatedWalletAPI
            : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
            : Yield
                (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
            : effs)
         a)
-> Eff
     (StartContract
        : RunContract : Assert : Waiting : EmulatorControl
        : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
-> Eff
     (Assert
        : Waiting : EmulatorControl : EmulatedWalletAPI : LogMsg String
        : Error EmulatorRuntimeError : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StartContract
 ~> Eff
      (RunContract
         : Assert : Waiting : EmulatorControl : EmulatedWalletAPI
         : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs))
-> Eff
     (StartContract
        : RunContract : Assert : Waiting : EmulatorControl
        : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
   ~> Eff
        (RunContract
           : Assert : Waiting : EmulatorControl : EmulatedWalletAPI
           : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
           : Yield
               (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
           : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (NetworkId
-> StartContract
   ~> Eff
        (RunContract
           : Assert : Waiting : EmulatorControl : EmulatedWalletAPI
           : LogMsg String : Error EmulatorRuntimeError : Reader ThreadId
           : Yield
               (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
           : effs)
forall (effs :: [* -> *]) (effs2 :: [* -> *]) a.
(Member (State EmulatorThreads) effs2,
 Member (Error EmulatorRuntimeError) effs2,
 Member MultiAgentEffect effs2,
 Member (LogMsg EmulatorEvent') effs2,
 Member ContractInstanceIdEff effs,
 Member
   (Yield
      (EmSystemCall effs2 EmulatorMessage a) (Maybe EmulatorMessage))
   effs) =>
NetworkId -> StartContract ~> Eff effs
handleStartContract @_ @effs @a NetworkId
pNetworkId)
            (Eff
   (StartContract
      : RunContract : Assert : Waiting : EmulatorControl
      : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
      : Reader ThreadId
      : Yield
          (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
      : effs)
   a
 -> Eff
      (Reader ThreadId
         : Yield
             (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
         : effs)
      a)
-> Eff
     (StartContract
        : RunContract : Assert : Waiting : EmulatorControl
        : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
        : 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
$ EmulatorTrace a
-> Eff
     (StartContract
        : RunContract : Assert : Waiting : EmulatorControl
        : EmulatedWalletAPI : LogMsg String : Error EmulatorRuntimeError
        : Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     a
forall (effs :: [* -> *]) (as :: [* -> *]).
CanWeakenEnd as effs =>
Eff as ~> Eff effs
raiseEnd EmulatorTrace 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 Emulator', streaming the log messages as they arrive
runEmulatorStream :: forall effs a.
    EmulatorConfig
    -> EmulatorTrace a
    -> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) (Either EmulatorErr a, EmulatorState)
runEmulatorStream :: EmulatorConfig
-> EmulatorTrace a
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff effs)
     (Either EmulatorErr a, EmulatorState)
runEmulatorStream EmulatorConfig
conf = 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))
-> (EmulatorTrace a
    -> Eff
         '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
           MultiAgentControlEffect, ChainEffect, ChainControlEffect,
           Error EmulatorRuntimeError]
         (Maybe a))
-> EmulatorTrace a
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff effs)
     (Either EmulatorErr a, EmulatorState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmulatorConfig
-> EmulatorTrace a
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
forall (effs :: [* -> *]) a.
(Member MultiAgentEffect effs, Member MultiAgentControlEffect effs,
 Member (Error EmulatorRuntimeError) effs,
 Member ChainControlEffect effs,
 Member (LogMsg EmulatorEvent') effs,
 Member (State EmulatorState) effs) =>
EmulatorConfig -> EmulatorTrace a -> Eff effs (Maybe a)
interpretEmulatorTrace EmulatorConfig
conf

-- | Interpret a 'Trace Emulator' action in the multi agent and emulated
--   blockchain effects.
interpretEmulatorTrace :: forall effs a.
    ( Member MultiAgentEffect effs
    , Member MultiAgentControlEffect effs
    , Member (Error EmulatorRuntimeError) effs
    , Member ChainControlEffect effs
    , Member (LogMsg EmulatorEvent') effs
    , Member (State EmulatorState) effs
    )
    => EmulatorConfig
    -> EmulatorTrace a
    -> Eff effs (Maybe a)
interpretEmulatorTrace :: EmulatorConfig -> EmulatorTrace a -> Eff effs (Maybe a)
interpretEmulatorTrace EmulatorConfig
conf EmulatorTrace a
action =
    -- add a wait action to the beginning to ensure that the
    -- initial transaction gets validated before the wallets
    -- try to spend their funds
    let action' :: EmulatorTrace a
action' = do
          Eff EmulatorEffects Slot -> Eff EmulatorEffects ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Eff EmulatorEffects Slot
forall (effs :: [* -> *]). Member Waiting effs => Eff effs Slot
Waiting.nextSlot
          a
res <- EmulatorTrace a
action
          Eff EmulatorEffects Slot -> Eff EmulatorEffects ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Eff EmulatorEffects Slot
forall (effs :: [* -> *]). Member Waiting effs => Eff effs Slot
Waiting.nextSlot
          a -> EmulatorTrace a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res
        wallets :: [Wallet]
wallets = [Wallet] -> Maybe [Wallet] -> [Wallet]
forall a. a -> Maybe a -> a
fromMaybe (MockWallet -> Wallet
Wallet.toMockWallet (MockWallet -> Wallet) -> [MockWallet] -> [Wallet]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MockWallet]
CW.knownMockWallets) (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
    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
$ Eff
  (ContractInstanceIdEff : State EmulatorThreads : effs) (Maybe a)
-> Eff (State EmulatorThreads : effs) (Maybe a)
forall (effs :: [* -> *]).
Eff (ContractInstanceIdEff : effs) ~> Eff effs
handleDeterministicIds
        (Eff
   (ContractInstanceIdEff : State EmulatorThreads : effs) (Maybe a)
 -> Eff (State EmulatorThreads : effs) (Maybe a))
-> Eff
     (ContractInstanceIdEff : State EmulatorThreads : effs) (Maybe a)
-> Eff (State EmulatorThreads : effs) (Maybe a)
forall a b. (a -> b) -> a -> b
$ (LogMsg SchedulerLog
 ~> Eff (ContractInstanceIdEff : State EmulatorThreads : effs))
-> Eff
     (LogMsg SchedulerLog
        : ContractInstanceIdEff : State EmulatorThreads : effs)
   ~> Eff (ContractInstanceIdEff : State EmulatorThreads : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((SchedulerLog -> EmulatorEvent')
-> LogMsg SchedulerLog
   ~> Eff (ContractInstanceIdEff : 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 EmulatorThreads : effs)
   (Maybe a)
 -> Eff
      (ContractInstanceIdEff : State EmulatorThreads : effs) (Maybe a))
-> Eff
     (LogMsg SchedulerLog
        : ContractInstanceIdEff : State EmulatorThreads : effs)
     (Maybe a)
-> Eff
     (ContractInstanceIdEff : State EmulatorThreads : effs) (Maybe a)
forall a b. (a -> b) -> a -> b
$ Eff
  (Reader ThreadId
     : Yield
         (EmSystemCall
            (LogMsg SchedulerLog
               : ContractInstanceIdEff : State EmulatorThreads : effs)
            EmulatorMessage
            a)
         (Maybe EmulatorMessage)
     : LogMsg SchedulerLog : ContractInstanceIdEff
     : State EmulatorThreads : effs)
  ()
-> Eff
     (LogMsg SchedulerLog
        : ContractInstanceIdEff : 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 EmulatorThreads : effs)
             EmulatorMessage
             a)
          (Maybe EmulatorMessage)
      : LogMsg SchedulerLog : ContractInstanceIdEff
      : State EmulatorThreads : effs)
   ()
 -> Eff
      (LogMsg SchedulerLog
         : ContractInstanceIdEff : State EmulatorThreads : effs)
      (Maybe a))
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall
               (LogMsg SchedulerLog
                  : ContractInstanceIdEff : State EmulatorThreads : effs)
               EmulatorMessage
               a)
            (Maybe EmulatorMessage)
        : LogMsg SchedulerLog : ContractInstanceIdEff
        : State EmulatorThreads : effs)
     ()
-> Eff
     (LogMsg SchedulerLog
        : ContractInstanceIdEff : State EmulatorThreads : effs)
     (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
            Eff
  (Yield
     (EmSystemCall
        (LogMsg SchedulerLog
           : ContractInstanceIdEff : State EmulatorThreads : effs)
        EmulatorMessage
        a)
     (Maybe EmulatorMessage)
     : LogMsg SchedulerLog : ContractInstanceIdEff
     : State EmulatorThreads : effs)
  ()
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall
               (LogMsg SchedulerLog
                  : ContractInstanceIdEff : State EmulatorThreads : effs)
               EmulatorMessage
               a)
            (Maybe EmulatorMessage)
        : LogMsg SchedulerLog : ContractInstanceIdEff
        : State EmulatorThreads : effs)
     ()
forall (effs :: [* -> *]) a (e :: * -> *).
Eff effs a -> Eff (e : effs) a
raise (Eff
   (Yield
      (EmSystemCall
         (LogMsg SchedulerLog
            : ContractInstanceIdEff : State EmulatorThreads : effs)
         EmulatorMessage
         a)
      (Maybe EmulatorMessage)
      : LogMsg SchedulerLog : ContractInstanceIdEff
      : State EmulatorThreads : effs)
   ()
 -> Eff
      (Reader ThreadId
         : Yield
             (EmSystemCall
                (LogMsg SchedulerLog
                   : ContractInstanceIdEff : State EmulatorThreads : effs)
                EmulatorMessage
                a)
             (Maybe EmulatorMessage)
         : LogMsg SchedulerLog : ContractInstanceIdEff
         : State EmulatorThreads : effs)
      ())
-> Eff
     (Yield
        (EmSystemCall
           (LogMsg SchedulerLog
              : ContractInstanceIdEff : State EmulatorThreads : effs)
           EmulatorMessage
           a)
        (Maybe EmulatorMessage)
        : LogMsg SchedulerLog : ContractInstanceIdEff
        : State EmulatorThreads : effs)
     ()
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall
               (LogMsg SchedulerLog
                  : ContractInstanceIdEff : State EmulatorThreads : effs)
               EmulatorMessage
               a)
            (Maybe EmulatorMessage)
        : LogMsg SchedulerLog : ContractInstanceIdEff
        : State EmulatorThreads : effs)
     ()
forall a b. (a -> b) -> a -> b
$ [Wallet]
-> Eff
     (Yield
        (EmSystemCall
           (LogMsg SchedulerLog
              : ContractInstanceIdEff : State EmulatorThreads : effs)
           EmulatorMessage
           a)
        (Maybe EmulatorMessage)
        : LogMsg SchedulerLog : ContractInstanceIdEff
        : 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
            Params
-> EmulatorTrace a
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall
               (LogMsg SchedulerLog
                  : ContractInstanceIdEff : State EmulatorThreads : effs)
               EmulatorMessage
               a)
            (Maybe EmulatorMessage)
        : LogMsg SchedulerLog : ContractInstanceIdEff
        : State EmulatorThreads : effs)
     ()
forall (effs :: [* -> *]) a.
(Member MultiAgentEffect effs, Member MultiAgentControlEffect effs,
 Member (State EmulatorThreads) effs,
 Member (State EmulatorState) effs,
 Member (Error EmulatorRuntimeError) effs,
 Member (LogMsg EmulatorEvent') effs,
 Member ContractInstanceIdEff effs) =>
Params
-> EmulatorTrace a
-> Eff
     (Reader ThreadId
        : Yield
            (EmSystemCall effs EmulatorMessage a) (Maybe EmulatorMessage)
        : effs)
     ()
handleEmulatorTrace (EmulatorConfig -> Params
_params EmulatorConfig
conf) EmulatorTrace a
action'

-- | Options for how to set up and print the trace.
data TraceConfig = TraceConfig
  { TraceConfig -> LogMessage EmulatorEvent -> Maybe String
traceConfigShowEvent    :: LogMessage EmulatorEvent -> Maybe String
  -- ^ Function to decide how to print the particular events.
  , TraceConfig -> Handle
traceConfigOutputHandle :: Handle
  -- ^ Where to print the outputs to. Default: 'System.IO.stdout'
  , TraceConfig -> LogLevel
traceConfigMinLogLevel  :: LogLevel
  }

instance Default TraceConfig where
  def :: TraceConfig
def = TraceConfig :: (LogMessage EmulatorEvent -> Maybe String)
-> Handle -> LogLevel -> TraceConfig
TraceConfig
      { traceConfigShowEvent :: LogMessage EmulatorEvent -> Maybe String
traceConfigShowEvent = String -> Maybe String
forall a. a -> Maybe a
Just
                             (String -> Maybe String)
-> (LogMessage EmulatorEvent -> String)
-> LogMessage EmulatorEvent
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack
                             (Text -> String)
-> (LogMessage EmulatorEvent -> Text)
-> LogMessage EmulatorEvent
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream Any -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict
                             (SimpleDocStream Any -> Text)
-> (LogMessage EmulatorEvent -> SimpleDocStream Any)
-> LogMessage EmulatorEvent
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions
                             (Doc Any -> SimpleDocStream Any)
-> (LogMessage EmulatorEvent -> Doc Any)
-> LogMessage EmulatorEvent
-> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogMessage EmulatorEvent -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty
      , traceConfigOutputHandle :: Handle
traceConfigOutputHandle = Handle
stdout
      , traceConfigMinLogLevel :: LogLevel
traceConfigMinLogLevel = LogLevel
Info
      }

-- | Some example of how to configure the 'traceConfigShowEvent'.
traceConfigShowEventExample :: LogMessage EmulatorEvent -> Maybe String
traceConfigShowEventExample :: LogMessage EmulatorEvent -> Maybe String
traceConfigShowEventExample (LogMessage LogLevel
_minLogLevel (EmulatorTimeEvent Slot
slot EmulatorEvent'
e)) =
    let logMsgMaybe :: Maybe String
logMsgMaybe = case EmulatorEvent'
e of
          UserThreadEvent (UserLog String
msg) ->
              String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"*** USER LOG: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg
          InstanceEvent (ContractInstanceLog (ContractLog (A.String Text
msg)) ContractInstanceId
_ ContractInstanceTag
_) ->
              String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"*** CONTRACT LOG: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
msg
          InstanceEvent (ContractInstanceLog (StoppedWithError String
err)       ContractInstanceId
_ ContractInstanceTag
_) ->
              String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"*** CONTRACT STOPPED WITH ERROR: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
err
          InstanceEvent (ContractInstanceLog ContractInstanceMsg
NoRequestsHandled            ContractInstanceId
_ ContractInstanceTag
_) ->
              Maybe String
forall a. Maybe a
Nothing
          InstanceEvent (ContractInstanceLog (HandledRequest Response Value
_)           ContractInstanceId
_ ContractInstanceTag
_) ->
              Maybe String
forall a. Maybe a
Nothing
          InstanceEvent (ContractInstanceLog (CurrentRequests [Request Value]
_)          ContractInstanceId
_ ContractInstanceTag
_) ->
              Maybe String
forall a. Maybe a
Nothing
          SchedulerEvent SchedulerLog
_ ->
              Maybe String
forall a. Maybe a
Nothing
          WalletEvent Wallet
_ WalletEvent
_ ->
              Maybe String
forall a. Maybe a
Nothing
          EmulatorEvent'
ev ->
              String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (EmulatorEvent' -> String) -> EmulatorEvent' -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream Any -> String
forall ann. SimpleDocStream ann -> String
renderString (SimpleDocStream Any -> String)
-> (EmulatorEvent' -> SimpleDocStream Any)
-> EmulatorEvent'
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions (Doc Any -> SimpleDocStream Any)
-> (EmulatorEvent' -> Doc Any)
-> EmulatorEvent'
-> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmulatorEvent' -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty (EmulatorEvent' -> Maybe String) -> EmulatorEvent' -> Maybe String
forall a b. (a -> b) -> a -> b
$ EmulatorEvent'
ev
        paddedSlotNo :: String
paddedSlotNo = Int -> Integer -> String
pad Int
5 (Slot -> Integer
getSlot Slot
slot)
     in (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
m -> String
"Slot " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
paddedSlotNo String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
m) Maybe String
logMsgMaybe
 where
    pad :: Int -> Integer -> String
    pad :: Int -> Integer -> String
pad Int
n = (\String
x -> Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x) Char
'0' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x) (String -> String) -> (Integer -> String) -> Integer -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show

evalEmulatorTrace
    :: TraceConfig
    -> EmulatorConfig
    -> EmulatorTrace a
    -> Either EmulatorErr a
evalEmulatorTrace :: TraceConfig
-> EmulatorConfig -> EmulatorTrace a -> Either EmulatorErr a
evalEmulatorTrace TraceConfig
tcfg EmulatorConfig
cfg EmulatorTrace a
trace = case TraceConfig
-> EmulatorConfig
-> EmulatorTrace a
-> ([LogMessage EmulatorEvent], Either EmulatorErr a,
    EmulatorState)
forall a.
TraceConfig
-> EmulatorConfig
-> EmulatorTrace a
-> ([LogMessage EmulatorEvent], Either EmulatorErr a,
    EmulatorState)
runEmulatorTrace TraceConfig
tcfg EmulatorConfig
cfg EmulatorTrace a
trace of
  ([LogMessage EmulatorEvent]
_, Either EmulatorErr a
r, EmulatorState
_) -> Either EmulatorErr a
r

-- | Run an emulator trace to completion, returning a tuple of the final state
-- of the emulator, the events, and any error, if any.
runEmulatorTrace
    :: TraceConfig
    -> EmulatorConfig
    -> EmulatorTrace a
    -> ([LogMessage EmulatorEvent], Either EmulatorErr a, EmulatorState)
runEmulatorTrace :: TraceConfig
-> EmulatorConfig
-> EmulatorTrace a
-> ([LogMessage EmulatorEvent], Either EmulatorErr a,
    EmulatorState)
runEmulatorTrace TraceConfig { LogLevel
traceConfigMinLogLevel :: LogLevel
traceConfigMinLogLevel :: TraceConfig -> LogLevel
traceConfigMinLogLevel } EmulatorConfig
cfg EmulatorTrace a
trace =
    (\([LogMessage EmulatorEvent]
xs :> (Either EmulatorErr a
y, EmulatorState
z)) -> ([LogMessage EmulatorEvent]
xs, Either EmulatorErr a
y, EmulatorState
z))
    (Of
   [LogMessage EmulatorEvent] (Either EmulatorErr a, EmulatorState)
 -> ([LogMessage EmulatorEvent], Either EmulatorErr a,
     EmulatorState))
-> Of
     [LogMessage EmulatorEvent] (Either EmulatorErr a, EmulatorState)
-> ([LogMessage EmulatorEvent], Either EmulatorErr a,
    EmulatorState)
forall a b. (a -> b) -> a -> b
$ Eff
  '[]
  (Of
     [LogMessage EmulatorEvent] (Either EmulatorErr a, EmulatorState))
-> Of
     [LogMessage EmulatorEvent] (Either EmulatorErr a, EmulatorState)
forall a. Eff '[] a -> a
run
    (Eff
   '[]
   (Of
      [LogMessage EmulatorEvent] (Either EmulatorErr a, EmulatorState))
 -> Of
      [LogMessage EmulatorEvent] (Either EmulatorErr a, EmulatorState))
-> Eff
     '[]
     (Of
        [LogMessage EmulatorEvent] (Either EmulatorErr a, EmulatorState))
-> Of
     [LogMessage EmulatorEvent] (Either EmulatorErr a, EmulatorState)
forall a b. (a -> b) -> a -> b
$ FoldM
  (Eff '[]) (LogMessage EmulatorEvent) [LogMessage EmulatorEvent]
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff '[])
     (Either EmulatorErr a, EmulatorState)
-> Eff
     '[]
     (Of
        [LogMessage EmulatorEvent] (Either EmulatorErr a, EmulatorState))
forall (m :: * -> *) a b c.
Monad m =>
FoldM m a b -> Stream (Of a) m c -> m (Of b c)
foldStreamM (Fold (LogMessage EmulatorEvent) [LogMessage EmulatorEvent]
-> FoldM
     (Eff '[]) (LogMessage EmulatorEvent) [LogMessage EmulatorEvent]
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
generalize Fold (LogMessage EmulatorEvent) [LogMessage EmulatorEvent]
forall a. Fold a [a]
list)
    (Stream
   (Of (LogMessage EmulatorEvent))
   (Eff '[])
   (Either EmulatorErr a, EmulatorState)
 -> Eff
      '[]
      (Of
         [LogMessage EmulatorEvent] (Either EmulatorErr a, EmulatorState)))
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff '[])
     (Either EmulatorErr a, EmulatorState)
-> Eff
     '[]
     (Of
        [LogMessage EmulatorEvent] (Either EmulatorErr a, EmulatorState))
forall a b. (a -> b) -> a -> b
$ LogLevel
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff '[])
     (Either EmulatorErr a, EmulatorState)
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff '[])
     (Either EmulatorErr a, EmulatorState)
forall (effs :: [* -> *]) a.
LogLevel
-> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) a
-> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) a
filterLogLevel LogLevel
traceConfigMinLogLevel
    (Stream
   (Of (LogMessage EmulatorEvent))
   (Eff '[])
   (Either EmulatorErr a, EmulatorState)
 -> Stream
      (Of (LogMessage EmulatorEvent))
      (Eff '[])
      (Either EmulatorErr a, EmulatorState))
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff '[])
     (Either EmulatorErr a, EmulatorState)
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff '[])
     (Either EmulatorErr a, EmulatorState)
forall a b. (a -> b) -> a -> b
$ EmulatorConfig
-> EmulatorTrace a
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff '[])
     (Either EmulatorErr a, EmulatorState)
forall (effs :: [* -> *]) a.
EmulatorConfig
-> EmulatorTrace a
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff effs)
     (Either EmulatorErr a, EmulatorState)
runEmulatorStream EmulatorConfig
cfg EmulatorTrace a
trace

-- | Run the emulator trace returning an effect that can be evaluated by
-- interpreting the 'PrintEffect's.
runEmulatorTraceEff :: forall effs. Member PrintEffect effs
    => TraceConfig
    -> EmulatorConfig
    -> EmulatorTrace ()
    -> Eff effs ()
runEmulatorTraceEff :: TraceConfig
-> EmulatorConfig -> Eff EmulatorEffects () -> Eff effs ()
runEmulatorTraceEff TraceConfig
tcfg EmulatorConfig
cfg Eff EmulatorEffects ()
trace =
  let ([LogMessage EmulatorEvent]
xs, Either EmulatorErr ()
me, EmulatorState
e) = TraceConfig
-> EmulatorConfig
-> Eff EmulatorEffects ()
-> ([LogMessage EmulatorEvent], Either EmulatorErr (),
    EmulatorState)
forall a.
TraceConfig
-> EmulatorConfig
-> EmulatorTrace a
-> ([LogMessage EmulatorEvent], Either EmulatorErr a,
    EmulatorState)
runEmulatorTrace TraceConfig
tcfg EmulatorConfig
cfg Eff EmulatorEffects ()
trace
      balances' :: Map Entity Value
balances' = ChainState -> WalletSet -> Map Entity Value
balances (EmulatorState -> ChainState
_chainState EmulatorState
e) (EmulatorState -> WalletSet
_walletStates EmulatorState
e)
   in do
      case Either EmulatorErr ()
me of
        Right ()
_  -> () -> Eff effs ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Left EmulatorErr
err -> String -> Eff effs ()
forall (effs :: [* -> *]).
Member PrintEffect effs =>
String -> Eff effs ()
printLn (String -> Eff effs ()) -> String -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ String
"ERROR: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> EmulatorErr -> String
forall a. Show a => a -> String
show EmulatorErr
err

      [LogMessage EmulatorEvent]
-> (LogMessage EmulatorEvent -> Eff effs ()) -> Eff effs ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [LogMessage EmulatorEvent]
xs ((LogMessage EmulatorEvent -> Eff effs ()) -> Eff effs ())
-> (LogMessage EmulatorEvent -> Eff effs ()) -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ \LogMessage EmulatorEvent
ete -> do
        case TraceConfig -> LogMessage EmulatorEvent -> Maybe String
traceConfigShowEvent TraceConfig
tcfg LogMessage EmulatorEvent
ete of
          Maybe String
Nothing -> () -> Eff effs ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just String
s  -> String -> Eff effs ()
forall (effs :: [* -> *]).
Member PrintEffect effs =>
String -> Eff effs ()
printLn String
s

      String -> Eff effs ()
forall (effs :: [* -> *]).
Member PrintEffect effs =>
String -> Eff effs ()
printLn String
"Final balances"
      Map Entity Value -> Eff effs ()
forall (effs :: [* -> *]).
Member PrintEffect effs =>
Map Entity Value -> Eff effs ()
printBalances Map Entity Value
balances'

-- | Runs the trace with 'runEmulatorTrace', with default configuration that
-- prints a selection of events to stdout.
--
-- Example:
--
-- >>> runEmulatorTraceIO (void $ Trace.waitNSlots 1)
runEmulatorTraceIO
    :: EmulatorTrace ()
    -> IO ()
runEmulatorTraceIO :: Eff EmulatorEffects () -> IO ()
runEmulatorTraceIO = TraceConfig -> EmulatorConfig -> Eff EmulatorEffects () -> IO ()
runEmulatorTraceIO' TraceConfig
forall a. Default a => a
def EmulatorConfig
forall a. Default a => a
def

-- | Runs the trace with a given configuration for the trace and the config.
--
-- Example of running a trace and saving the output to a file:
--
-- >>> withFile "/tmp/trace-log.txt" WriteMode $ \h -> runEmulatorTraceIO' (def { traceConfigOutputHandle = h }) def (void $ Trace.waitNSlots 1)
runEmulatorTraceIOWithConfig
    :: TraceConfig
    -> EmulatorConfig
    -> EmulatorTrace ()
    -> IO ()
runEmulatorTraceIOWithConfig :: TraceConfig -> EmulatorConfig -> Eff EmulatorEffects () -> IO ()
runEmulatorTraceIOWithConfig TraceConfig
tcfg EmulatorConfig
cfg Eff EmulatorEffects ()
trace
  = Handle -> Eff '[PrintEffect, IO] () -> IO ()
forall r. Handle -> Eff '[PrintEffect, IO] r -> IO r
runPrintEffectIO (TraceConfig -> Handle
traceConfigOutputHandle TraceConfig
tcfg) (Eff '[PrintEffect, IO] () -> IO ())
-> Eff '[PrintEffect, IO] () -> IO ()
forall a b. (a -> b) -> a -> b
$ TraceConfig
-> EmulatorConfig
-> Eff EmulatorEffects ()
-> Eff '[PrintEffect, IO] ()
forall (effs :: [* -> *]).
Member PrintEffect effs =>
TraceConfig
-> EmulatorConfig -> Eff EmulatorEffects () -> Eff effs ()
runEmulatorTraceEff TraceConfig
tcfg EmulatorConfig
cfg Eff EmulatorEffects ()
trace

{-# DEPRECATED runEmulatorTraceIO' "Renamed to runEmulatorTraceIOWithConfig" #-}
runEmulatorTraceIO'
    :: TraceConfig
    -> EmulatorConfig
    -> EmulatorTrace ()
    -> IO ()
runEmulatorTraceIO' :: TraceConfig -> EmulatorConfig -> Eff EmulatorEffects () -> IO ()
runEmulatorTraceIO' = TraceConfig -> EmulatorConfig -> Eff EmulatorEffects () -> IO ()
runEmulatorTraceIOWithConfig

runPrintEffectIO
    :: Handle
    -> Eff '[PrintEffect, IO] r
    -> IO r
runPrintEffectIO :: Handle -> Eff '[PrintEffect, IO] r -> IO r
runPrintEffectIO Handle
hdl = Eff '[IO] r -> IO r
forall (m :: * -> *) a. Monad m => Eff '[m] a -> m a
runM (Eff '[IO] r -> IO r)
-> (Eff '[PrintEffect, IO] r -> Eff '[IO] r)
-> Eff '[PrintEffect, IO] r
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrintEffect ~> IO) -> Eff '[PrintEffect, IO] ~> Eff '[IO]
forall (eff :: * -> *) (m :: * -> *) (effs :: [* -> *]).
(Monad m, LastMember m effs) =>
(eff ~> m) -> Eff (eff : effs) ~> Eff effs
interpretM PrintEffect ~> IO
f
  where
    f :: PrintEffect r -> IO r
    f :: PrintEffect r -> IO r
f = \case
      PrintLn String
s -> Handle -> String -> IO ()
hPutStrLn Handle
hdl String
s

printBalances :: forall effs. Member PrintEffect effs
              => Map.Map Entity C.Value
              -> Eff effs ()
printBalances :: Map Entity Value -> Eff effs ()
printBalances Map Entity Value
m = do
    [(Entity, Value)]
-> ((Entity, Value) -> Eff effs ()) -> Eff effs ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Entity Value -> [(Entity, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Entity Value
m) (((Entity, Value) -> Eff effs ()) -> Eff effs ())
-> ((Entity, Value) -> Eff effs ()) -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ \(Entity
e, Value
v) -> do
        String -> Eff effs ()
forall (effs :: [* -> *]).
Member PrintEffect effs =>
String -> Eff effs ()
printLn (String -> Eff effs ()) -> String -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ Entity -> String
forall a. Show a => a -> String
show Entity
e String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (Value -> Text
C.renderValuePretty Value
v)