{-# LANGUAGE DataKinds        #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs            #-}
{-# LANGUAGE LambdaCase       #-}
{-# LANGUAGE NamedFieldPuns   #-}
{-# LANGUAGE RankNTypes       #-}
{-# LANGUAGE RecordWildCards  #-}
{-# LANGUAGE TemplateHaskell  #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators    #-}
-- | Running emulator actions that produce streams of events
module Wallet.Emulator.Stream(
    -- * Emulator streams
    EmulatorConfig(..)
    , EmulatorErr(..)
    , InitialChainState
    , initialChainState
    , initialDist
    , initialState
    , params
    , runTraceStream
    -- * Stream manipulation
    , takeUntilSlot
    , filterLogLevel
    -- * Consuming streams
    , foldStreamM
    , foldEmulatorStreamM
    ) where

import Cardano.Node.Emulator.Internal.Node (ChainControlEffect, ChainEffect, _SlotAdd, unsafeMakeValid)
import Control.Foldl qualified as L
import Control.Lens (filtered, makeLenses, preview, view)
import Control.Monad.Freer (Eff, Member, interpret, reinterpret, run, subsume, type (~>))
import Control.Monad.Freer.Coroutine (Yield, yield)
import Control.Monad.Freer.Error (Error, runError)
import Control.Monad.Freer.Extras (raiseEnd, wrapError)
import Control.Monad.Freer.Extras.Log (LogLevel, LogMessage, LogMsg (LMessage), logLevel, logMessageContent, mapMLog)
import Control.Monad.Freer.Extras.Stream (runStream)
import Control.Monad.Freer.State (State, gets, runState)
import Data.Bifunctor (first)
import Data.Default (Default (def))
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import Data.Set qualified as Set
import Ledger.AddressMap qualified as AM
import Ledger.Blockchain (Block)
import Ledger.Slot (Slot)
import Ledger.Tx (CardanoTx)
import Plutus.ChainIndex (ChainIndexError)
import Streaming (Stream)
import Streaming qualified as S
import Streaming.Prelude (Of)
import Streaming.Prelude qualified as S
import Wallet.API (Params, WalletAPIError)
import Wallet.Emulator (EmulatorEvent, EmulatorEvent')
import Wallet.Emulator qualified as EM
import Wallet.Emulator.MultiAgent (EmulatorState, EmulatorTimeEvent (EmulatorTimeEvent), MultiAgentControlEffect,
                                   MultiAgentEffect, chainEvent, eteEvent)
import Wallet.Emulator.Wallet (Wallet, mockWalletAddress)

import Cardano.Api qualified as C
import Plutus.Contract.Trace (InitialDistribution, defaultDist, knownWallets)
import Plutus.Trace.Emulator.ContractInstance (EmulatorRuntimeError)

{- Note [Emulator event stream]

The primary way of observing the outcome of a trace is by looking at the
stream of events it produces, via 'runTraceStream'. This has the following
reasons:

* A totally ordered stream of events is a good way to characterise the
  behaviour of a dynamic system.
* By taking the stream of events as the main output of running a trace, we
  can potentially run the trace against a live system. (To really do that we'll have to change the type of log messages - 'EmulatorEvent' contains some events only make sense in the emulator. But the underlying mechanism of how the stream is produces is still the same.) See note [The Emulator Control effect]
* We have the potential of saving some work because the stream is produced
  on-demand. This also makes it possible to deal with infinite traces: We just
  evaluate them to a finite number of steps.

-}

-- | Finish the stream at the end of the given slot.
takeUntilSlot :: forall effs a. Slot -> S.Stream (S.Of (LogMessage EmulatorEvent)) (Eff effs) a -> S.Stream (S.Of (LogMessage EmulatorEvent)) (Eff effs) ()
takeUntilSlot :: Slot
-> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) a
-> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) ()
takeUntilSlot Slot
maxSlot = (LogMessage EmulatorEvent -> Bool)
-> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) a
-> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) ()
forall (m :: * -> *) a r.
Monad m =>
(a -> Bool) -> Stream (Of a) m r -> Stream (Of a) m ()
S.takeWhile (Bool -> (Slot -> Bool) -> Maybe Slot -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (\Slot
sl -> Slot
sl Slot -> Slot -> Bool
forall a. Ord a => a -> a -> Bool
<= Slot
maxSlot) (Maybe Slot -> Bool)
-> (LogMessage EmulatorEvent -> Maybe Slot)
-> LogMessage EmulatorEvent
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Slot) (LogMessage EmulatorEvent) Slot
-> LogMessage EmulatorEvent -> Maybe Slot
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((EmulatorEvent -> Const (First Slot) EmulatorEvent)
-> LogMessage EmulatorEvent
-> Const (First Slot) (LogMessage EmulatorEvent)
forall a1 a2. Lens (LogMessage a1) (LogMessage a2) a1 a2
logMessageContent ((EmulatorEvent -> Const (First Slot) EmulatorEvent)
 -> LogMessage EmulatorEvent
 -> Const (First Slot) (LogMessage EmulatorEvent))
-> ((Slot -> Const (First Slot) Slot)
    -> EmulatorEvent -> Const (First Slot) EmulatorEvent)
-> Getting (First Slot) (LogMessage EmulatorEvent) Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EmulatorEvent' -> Const (First Slot) EmulatorEvent')
-> EmulatorEvent -> Const (First Slot) EmulatorEvent
forall e e2. Lens (EmulatorTimeEvent e) (EmulatorTimeEvent e2) e e2
eteEvent ((EmulatorEvent' -> Const (First Slot) EmulatorEvent')
 -> EmulatorEvent -> Const (First Slot) EmulatorEvent)
-> ((Slot -> Const (First Slot) Slot)
    -> EmulatorEvent' -> Const (First Slot) EmulatorEvent')
-> (Slot -> Const (First Slot) Slot)
-> EmulatorEvent
-> Const (First Slot) EmulatorEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainEvent -> Const (First Slot) ChainEvent)
-> EmulatorEvent' -> Const (First Slot) EmulatorEvent'
Prism' EmulatorEvent' ChainEvent
chainEvent ((ChainEvent -> Const (First Slot) ChainEvent)
 -> EmulatorEvent' -> Const (First Slot) EmulatorEvent')
-> ((Slot -> Const (First Slot) Slot)
    -> ChainEvent -> Const (First Slot) ChainEvent)
-> (Slot -> Const (First Slot) Slot)
-> EmulatorEvent'
-> Const (First Slot) EmulatorEvent'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Slot -> Const (First Slot) Slot)
-> ChainEvent -> Const (First Slot) ChainEvent
Prism' ChainEvent Slot
_SlotAdd))

-- | Remove from the stream all log messages whose log level is lower than the
--   the given level.
filterLogLevel :: forall effs a. LogLevel -> S.Stream (S.Of (LogMessage EmulatorEvent)) (Eff effs) a -> S.Stream (S.Of (LogMessage EmulatorEvent)) (Eff effs) a
filterLogLevel :: LogLevel
-> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) a
-> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) a
filterLogLevel LogLevel
lvl = (LogMessage EmulatorEvent -> Maybe (LogMessage EmulatorEvent))
-> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) a
-> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) a
forall (m :: * -> *) a b r.
Monad m =>
(a -> Maybe b) -> Stream (Of a) m r -> Stream (Of b) m r
S.mapMaybe (Getting
  (First (LogMessage EmulatorEvent))
  (LogMessage EmulatorEvent)
  (LogMessage EmulatorEvent)
-> LogMessage EmulatorEvent -> Maybe (LogMessage EmulatorEvent)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((LogMessage EmulatorEvent -> Bool)
-> Getting
     (First (LogMessage EmulatorEvent))
     (LogMessage EmulatorEvent)
     (LogMessage EmulatorEvent)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ((LogLevel
lvl LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
<=) (LogLevel -> Bool)
-> (LogMessage EmulatorEvent -> LogLevel)
-> LogMessage EmulatorEvent
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting LogLevel (LogMessage EmulatorEvent) LogLevel
-> LogMessage EmulatorEvent -> LogLevel
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting LogLevel (LogMessage EmulatorEvent) LogLevel
forall a. Lens' (LogMessage a) LogLevel
logLevel)))

-- | Apply a fold to an effectful stream of events.
foldStreamM :: forall m a b c.
    Monad m
    => L.FoldM m a b
    -> S.Stream (S.Of a) m c
    -> m (S.Of b c)
foldStreamM :: FoldM m a b -> Stream (Of a) m c -> m (Of b c)
foldStreamM = (forall x.
 (x -> a -> m x)
 -> m x -> (x -> m b) -> Stream (Of a) m c -> m (Of b c))
-> FoldM m a b -> Stream (Of a) m c -> m (Of b c)
forall a (m :: * -> *) b r.
(forall x. (x -> a -> m x) -> m x -> (x -> m b) -> r)
-> FoldM m a b -> r
L.impurely forall x.
(x -> a -> m x)
-> m x -> (x -> m b) -> Stream (Of a) m c -> m (Of b c)
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> m x)
-> m x -> (x -> m b) -> Stream (Of a) m r -> m (Of b r)
S.foldM

-- | Consume an emulator event stream.
foldEmulatorStreamM :: forall effs a b.
    L.FoldM (Eff effs) EmulatorEvent b
    -> S.Stream (S.Of (LogMessage EmulatorEvent)) (Eff effs) a
    -> Eff effs (S.Of b a)
foldEmulatorStreamM :: FoldM (Eff effs) EmulatorEvent b
-> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) a
-> Eff effs (Of b a)
foldEmulatorStreamM FoldM (Eff effs) EmulatorEvent b
theFold =
    FoldM (Eff effs) (LogMessage EmulatorEvent) b
-> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) a
-> Eff effs (Of b a)
forall (m :: * -> *) a b c.
Monad m =>
FoldM m a b -> Stream (Of a) m c -> m (Of b c)
foldStreamM ((LogMessage EmulatorEvent -> Eff effs EmulatorEvent)
-> FoldM (Eff effs) EmulatorEvent b
-> FoldM (Eff effs) (LogMessage EmulatorEvent) b
forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> FoldM m b r -> FoldM m a r
L.premapM (EmulatorEvent -> Eff effs EmulatorEvent
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EmulatorEvent -> Eff effs EmulatorEvent)
-> (LogMessage EmulatorEvent -> EmulatorEvent)
-> LogMessage EmulatorEvent
-> Eff effs EmulatorEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting EmulatorEvent (LogMessage EmulatorEvent) EmulatorEvent
-> LogMessage EmulatorEvent -> EmulatorEvent
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting EmulatorEvent (LogMessage EmulatorEvent) EmulatorEvent
forall a1 a2. Lens (LogMessage a1) (LogMessage a2) a1 a2
logMessageContent) FoldM (Eff effs) EmulatorEvent b
theFold)

-- | Turn an emulator action into a 'Stream' of emulator log messages, returning
--   the final state of the emulator.
runTraceStream :: 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
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff effs)
     (Either EmulatorErr a, EmulatorState)
runTraceStream conf :: EmulatorConfig
conf@EmulatorConfig{Params
_params :: EmulatorConfig -> Params
_params :: Params
_params} =
    ((Either EmulatorErr (Maybe a), EmulatorState)
 -> (Either EmulatorErr a, EmulatorState))
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff effs)
     (Either EmulatorErr (Maybe a), EmulatorState)
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff effs)
     (Either EmulatorErr a, EmulatorState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either EmulatorErr (Maybe a) -> Either EmulatorErr a)
-> (Either EmulatorErr (Maybe a), EmulatorState)
-> (Either EmulatorErr a, EmulatorState)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Either EmulatorErr (Maybe a) -> Either EmulatorErr a)
 -> (Either EmulatorErr (Maybe a), EmulatorState)
 -> (Either EmulatorErr a, EmulatorState))
-> (Either EmulatorErr (Maybe a) -> Either EmulatorErr a)
-> (Either EmulatorErr (Maybe a), EmulatorState)
-> (Either EmulatorErr a, EmulatorState)
forall a b. (a -> b) -> a -> b
$ (EmulatorErr -> Either EmulatorErr a)
-> (Maybe a -> Either EmulatorErr a)
-> Either EmulatorErr (Maybe a)
-> Either EmulatorErr a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either EmulatorErr -> Either EmulatorErr a
forall a b. a -> Either a b
Left ((Maybe a -> Either EmulatorErr a)
 -> Either EmulatorErr (Maybe a) -> Either EmulatorErr a)
-> (Maybe a -> Either EmulatorErr a)
-> Either EmulatorErr (Maybe a)
-> Either EmulatorErr a
forall a b. (a -> b) -> a -> b
$ Either EmulatorErr a
-> (a -> Either EmulatorErr a) -> Maybe a -> Either EmulatorErr a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (EmulatorErr -> Either EmulatorErr a
forall a b. a -> Either a b
Left EmulatorErr
ExitWasNeverCalled) a -> Either EmulatorErr a
forall a b. b -> Either a b
Right)
    (Stream
   (Of (LogMessage EmulatorEvent))
   (Eff effs)
   (Either EmulatorErr (Maybe a), EmulatorState)
 -> Stream
      (Of (LogMessage EmulatorEvent))
      (Eff effs)
      (Either EmulatorErr a, EmulatorState))
-> (Eff
      '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
        MultiAgentControlEffect, ChainEffect, ChainControlEffect,
        Error EmulatorRuntimeError]
      (Maybe a)
    -> Stream
         (Of (LogMessage EmulatorEvent))
         (Eff effs)
         (Either EmulatorErr (Maybe a), EmulatorState))
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff effs)
     (Either EmulatorErr a, EmulatorState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eff '[] a -> Eff effs a)
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff '[])
     (Either EmulatorErr (Maybe a), EmulatorState)
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff effs)
     (Either EmulatorErr (Maybe a), EmulatorState)
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
S.hoist (a -> Eff effs a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Eff effs a) -> (Eff '[] a -> a) -> Eff '[] a -> Eff effs a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff '[] a -> a
forall a. Eff '[] a -> a
run)
    (Stream
   (Of (LogMessage EmulatorEvent))
   (Eff '[])
   (Either EmulatorErr (Maybe a), EmulatorState)
 -> Stream
      (Of (LogMessage EmulatorEvent))
      (Eff effs)
      (Either EmulatorErr (Maybe a), EmulatorState))
-> (Eff
      '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
        MultiAgentControlEffect, ChainEffect, ChainControlEffect,
        Error EmulatorRuntimeError]
      (Maybe a)
    -> Stream
         (Of (LogMessage EmulatorEvent))
         (Eff '[])
         (Either EmulatorErr (Maybe a), EmulatorState))
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff effs)
     (Either EmulatorErr (Maybe a), EmulatorState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff
  '[Yield (LogMessage EmulatorEvent) ()]
  (Either EmulatorErr (Maybe a), EmulatorState)
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff '[])
     (Either EmulatorErr (Maybe a), EmulatorState)
forall e a (effs :: [* -> *]).
Eff (Yield e () : effs) a -> Stream (Of e) (Eff effs) a
runStream @(LogMessage EmulatorEvent) @_ @'[]
    (Eff
   '[Yield (LogMessage EmulatorEvent) ()]
   (Either EmulatorErr (Maybe a), EmulatorState)
 -> Stream
      (Of (LogMessage EmulatorEvent))
      (Eff '[])
      (Either EmulatorErr (Maybe a), EmulatorState))
-> (Eff
      '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
        MultiAgentControlEffect, ChainEffect, ChainControlEffect,
        Error EmulatorRuntimeError]
      (Maybe a)
    -> Eff
         '[Yield (LogMessage EmulatorEvent) ()]
         (Either EmulatorErr (Maybe a), EmulatorState))
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff '[])
     (Either EmulatorErr (Maybe a), EmulatorState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmulatorState
-> Eff
     '[State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
     (Either EmulatorErr (Maybe a))
-> Eff
     '[Yield (LogMessage EmulatorEvent) ()]
     (Either EmulatorErr (Maybe a), EmulatorState)
forall s (effs :: [* -> *]) a.
s -> Eff (State s : effs) a -> Eff effs (a, s)
runState (EmulatorConfig -> EmulatorState
initialState EmulatorConfig
conf)
    (Eff
   '[State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
   (Either EmulatorErr (Maybe a))
 -> Eff
      '[Yield (LogMessage EmulatorEvent) ()]
      (Either EmulatorErr (Maybe a), EmulatorState))
-> (Eff
      '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
        MultiAgentControlEffect, ChainEffect, ChainControlEffect,
        Error EmulatorRuntimeError]
      (Maybe a)
    -> Eff
         '[State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
         (Either EmulatorErr (Maybe a)))
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
-> Eff
     '[Yield (LogMessage EmulatorEvent) ()]
     (Either EmulatorErr (Maybe a), EmulatorState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg EmulatorEvent
 ~> Eff '[State EmulatorState, Yield (LogMessage EmulatorEvent) ()])
-> Eff
     '[LogMsg EmulatorEvent, State EmulatorState,
       Yield (LogMessage EmulatorEvent) ()]
   ~> Eff '[State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret LogMsg EmulatorEvent
~> Eff '[State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
forall e (effs :: [* -> *]).
Member (Yield (LogMessage e) ()) effs =>
LogMsg e ~> Eff effs
handleLogCoroutine
    (Eff
   '[LogMsg EmulatorEvent, State EmulatorState,
     Yield (LogMessage EmulatorEvent) ()]
   (Either EmulatorErr (Maybe a))
 -> Eff
      '[State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
      (Either EmulatorErr (Maybe a)))
-> (Eff
      '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
        MultiAgentControlEffect, ChainEffect, ChainControlEffect,
        Error EmulatorRuntimeError]
      (Maybe a)
    -> Eff
         '[LogMsg EmulatorEvent, State EmulatorState,
           Yield (LogMessage EmulatorEvent) ()]
         (Either EmulatorErr (Maybe a)))
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
-> Eff
     '[State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
     (Either EmulatorErr (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg EmulatorEvent'
 ~> Eff
      '[LogMsg EmulatorEvent, State EmulatorState,
        Yield (LogMessage EmulatorEvent) ()])
-> Eff
     '[LogMsg EmulatorEvent', State EmulatorState,
       Yield (LogMessage EmulatorEvent) ()]
   ~> Eff
        '[LogMsg EmulatorEvent, State EmulatorState,
          Yield (LogMessage EmulatorEvent) ()]
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret @_ @(LogMsg EmulatorEvent) (forall (effs :: [* -> *]).
(Member (LogMsg EmulatorEvent) effs,
 Member (State EmulatorState) effs) =>
LogMsg EmulatorEvent' ~> Eff effs
forall a (effs :: [* -> *]).
(Member (LogMsg (EmulatorTimeEvent a)) effs,
 Member (State EmulatorState) effs) =>
LogMsg a ~> Eff effs
mkTimedLogs @EmulatorEvent')
    (Eff
   '[LogMsg EmulatorEvent', State EmulatorState,
     Yield (LogMessage EmulatorEvent) ()]
   (Either EmulatorErr (Maybe a))
 -> Eff
      '[LogMsg EmulatorEvent, State EmulatorState,
        Yield (LogMessage EmulatorEvent) ()]
      (Either EmulatorErr (Maybe a)))
-> (Eff
      '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
        MultiAgentControlEffect, ChainEffect, ChainControlEffect,
        Error EmulatorRuntimeError]
      (Maybe a)
    -> Eff
         '[LogMsg EmulatorEvent', State EmulatorState,
           Yield (LogMessage EmulatorEvent) ()]
         (Either EmulatorErr (Maybe a)))
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
-> Eff
     '[LogMsg EmulatorEvent, State EmulatorState,
       Yield (LogMessage EmulatorEvent) ()]
     (Either EmulatorErr (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff
  '[Error EmulatorErr, LogMsg EmulatorEvent', State EmulatorState,
    Yield (LogMessage EmulatorEvent) ()]
  (Maybe a)
-> Eff
     '[LogMsg EmulatorEvent', State EmulatorState,
       Yield (LogMessage EmulatorEvent) ()]
     (Either EmulatorErr (Maybe a))
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> Eff effs (Either e a)
runError
    (Eff
   '[Error EmulatorErr, LogMsg EmulatorEvent', State EmulatorState,
     Yield (LogMessage EmulatorEvent) ()]
   (Maybe a)
 -> Eff
      '[LogMsg EmulatorEvent', State EmulatorState,
        Yield (LogMessage EmulatorEvent) ()]
      (Either EmulatorErr (Maybe a)))
-> (Eff
      '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
        MultiAgentControlEffect, ChainEffect, ChainControlEffect,
        Error EmulatorRuntimeError]
      (Maybe a)
    -> Eff
         '[Error EmulatorErr, LogMsg EmulatorEvent', State EmulatorState,
           Yield (LogMessage EmulatorEvent) ()]
         (Maybe a))
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
-> Eff
     '[LogMsg EmulatorEvent', State EmulatorState,
       Yield (LogMessage EmulatorEvent) ()]
     (Either EmulatorErr (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WalletAPIError -> EmulatorErr)
-> Eff
     '[Error WalletAPIError, Error EmulatorErr, LogMsg EmulatorEvent',
       State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
   ~> Eff
        '[Error EmulatorErr, LogMsg EmulatorEvent', State EmulatorState,
          Yield (LogMessage EmulatorEvent) ()]
forall e f (effs :: [* -> *]).
Member (Error f) effs =>
(e -> f) -> Eff (Error e : effs) ~> Eff effs
wrapError WalletAPIError -> EmulatorErr
WalletErr
    (Eff
   '[Error WalletAPIError, Error EmulatorErr, LogMsg EmulatorEvent',
     State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
   (Maybe a)
 -> Eff
      '[Error EmulatorErr, LogMsg EmulatorEvent', State EmulatorState,
        Yield (LogMessage EmulatorEvent) ()]
      (Maybe a))
-> (Eff
      '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
        MultiAgentControlEffect, ChainEffect, ChainControlEffect,
        Error EmulatorRuntimeError]
      (Maybe a)
    -> Eff
         '[Error WalletAPIError, Error EmulatorErr, LogMsg EmulatorEvent',
           State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
         (Maybe a))
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
-> Eff
     '[Error EmulatorErr, LogMsg EmulatorEvent', State EmulatorState,
       Yield (LogMessage EmulatorEvent) ()]
     (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainIndexError -> EmulatorErr)
-> Eff
     '[Error ChainIndexError, Error WalletAPIError, Error EmulatorErr,
       LogMsg EmulatorEvent', State EmulatorState,
       Yield (LogMessage EmulatorEvent) ()]
   ~> Eff
        '[Error WalletAPIError, Error EmulatorErr, LogMsg EmulatorEvent',
          State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
forall e f (effs :: [* -> *]).
Member (Error f) effs =>
(e -> f) -> Eff (Error e : effs) ~> Eff effs
wrapError ChainIndexError -> EmulatorErr
ChainIndexErr
    (Eff
   '[Error ChainIndexError, Error WalletAPIError, Error EmulatorErr,
     LogMsg EmulatorEvent', State EmulatorState,
     Yield (LogMessage EmulatorEvent) ()]
   (Maybe a)
 -> Eff
      '[Error WalletAPIError, Error EmulatorErr, LogMsg EmulatorEvent',
        State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
      (Maybe a))
-> (Eff
      '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
        MultiAgentControlEffect, ChainEffect, ChainControlEffect,
        Error EmulatorRuntimeError]
      (Maybe a)
    -> Eff
         '[Error ChainIndexError, Error WalletAPIError, Error EmulatorErr,
           LogMsg EmulatorEvent', State EmulatorState,
           Yield (LogMessage EmulatorEvent) ()]
         (Maybe a))
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
-> Eff
     '[Error WalletAPIError, Error EmulatorErr, LogMsg EmulatorEvent',
       State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
     (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AssertionError -> EmulatorErr)
-> Eff
     '[Error AssertionError, Error ChainIndexError,
       Error WalletAPIError, Error EmulatorErr, LogMsg EmulatorEvent',
       State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
   ~> Eff
        '[Error ChainIndexError, Error WalletAPIError, Error EmulatorErr,
          LogMsg EmulatorEvent', State EmulatorState,
          Yield (LogMessage EmulatorEvent) ()]
forall e f (effs :: [* -> *]).
Member (Error f) effs =>
(e -> f) -> Eff (Error e : effs) ~> Eff effs
wrapError AssertionError -> EmulatorErr
AssertionErr
    (Eff
   '[Error AssertionError, Error ChainIndexError,
     Error WalletAPIError, Error EmulatorErr, LogMsg EmulatorEvent',
     State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
   (Maybe a)
 -> Eff
      '[Error ChainIndexError, Error WalletAPIError, Error EmulatorErr,
        LogMsg EmulatorEvent', State EmulatorState,
        Yield (LogMessage EmulatorEvent) ()]
      (Maybe a))
-> (Eff
      '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
        MultiAgentControlEffect, ChainEffect, ChainControlEffect,
        Error EmulatorRuntimeError]
      (Maybe a)
    -> Eff
         '[Error AssertionError, Error ChainIndexError,
           Error WalletAPIError, Error EmulatorErr, LogMsg EmulatorEvent',
           State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
         (Maybe a))
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
-> Eff
     '[Error ChainIndexError, Error WalletAPIError, Error EmulatorErr,
       LogMsg EmulatorEvent', State EmulatorState,
       Yield (LogMessage EmulatorEvent) ()]
     (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EmulatorRuntimeError -> EmulatorErr)
-> Eff
     '[Error EmulatorRuntimeError, Error AssertionError,
       Error ChainIndexError, Error WalletAPIError, Error EmulatorErr,
       LogMsg EmulatorEvent', State EmulatorState,
       Yield (LogMessage EmulatorEvent) ()]
   ~> Eff
        '[Error AssertionError, Error ChainIndexError,
          Error WalletAPIError, Error EmulatorErr, LogMsg EmulatorEvent',
          State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
forall e f (effs :: [* -> *]).
Member (Error f) effs =>
(e -> f) -> Eff (Error e : effs) ~> Eff effs
wrapError EmulatorRuntimeError -> EmulatorErr
InstanceErr
    (Eff
   '[Error EmulatorRuntimeError, Error AssertionError,
     Error ChainIndexError, Error WalletAPIError, Error EmulatorErr,
     LogMsg EmulatorEvent', State EmulatorState,
     Yield (LogMessage EmulatorEvent) ()]
   (Maybe a)
 -> Eff
      '[Error AssertionError, Error ChainIndexError,
        Error WalletAPIError, Error EmulatorErr, LogMsg EmulatorEvent',
        State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
      (Maybe a))
-> (Eff
      '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
        MultiAgentControlEffect, ChainEffect, ChainControlEffect,
        Error EmulatorRuntimeError]
      (Maybe a)
    -> Eff
         '[Error EmulatorRuntimeError, Error AssertionError,
           Error ChainIndexError, Error WalletAPIError, Error EmulatorErr,
           LogMsg EmulatorEvent', State EmulatorState,
           Yield (LogMessage EmulatorEvent) ()]
         (Maybe a))
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
-> Eff
     '[Error AssertionError, Error ChainIndexError,
       Error WalletAPIError, Error EmulatorErr, LogMsg EmulatorEvent',
       State EmulatorState, Yield (LogMessage EmulatorEvent) ()]
     (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params
-> Eff
     '[MultiAgentEffect, MultiAgentControlEffect, ChainEffect,
       ChainControlEffect, Error EmulatorRuntimeError,
       Error AssertionError, Error ChainIndexError, Error WalletAPIError,
       Error EmulatorErr, LogMsg EmulatorEvent', State EmulatorState,
       Yield (LogMessage EmulatorEvent) ()]
   ~> Eff
        '[Error EmulatorRuntimeError, Error AssertionError,
          Error ChainIndexError, Error WalletAPIError, Error EmulatorErr,
          LogMsg EmulatorEvent', State EmulatorState,
          Yield (LogMessage EmulatorEvent) ()]
forall (effs :: [* -> *]).
(Member (Error WalletAPIError) effs,
 Member (Error ChainIndexError) effs,
 Member (State EmulatorState) effs,
 Member (LogMsg EmulatorEvent') effs) =>
Params
-> Eff
     (MultiAgentEffect
        : MultiAgentControlEffect : ChainEffect : ChainControlEffect
        : effs)
   ~> Eff effs
EM.processEmulated Params
_params
    (Eff
   '[MultiAgentEffect, MultiAgentControlEffect, ChainEffect,
     ChainControlEffect, Error EmulatorRuntimeError,
     Error AssertionError, Error ChainIndexError, Error WalletAPIError,
     Error EmulatorErr, LogMsg EmulatorEvent', State EmulatorState,
     Yield (LogMessage EmulatorEvent) ()]
   (Maybe a)
 -> Eff
      '[Error EmulatorRuntimeError, Error AssertionError,
        Error ChainIndexError, Error WalletAPIError, Error EmulatorErr,
        LogMsg EmulatorEvent', State EmulatorState,
        Yield (LogMessage EmulatorEvent) ()]
      (Maybe a))
-> (Eff
      '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
        MultiAgentControlEffect, ChainEffect, ChainControlEffect,
        Error EmulatorRuntimeError]
      (Maybe a)
    -> Eff
         '[MultiAgentEffect, MultiAgentControlEffect, ChainEffect,
           ChainControlEffect, Error EmulatorRuntimeError,
           Error AssertionError, Error ChainIndexError, Error WalletAPIError,
           Error EmulatorErr, LogMsg EmulatorEvent', State EmulatorState,
           Yield (LogMessage EmulatorEvent) ()]
         (Maybe a))
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
-> Eff
     '[Error EmulatorRuntimeError, Error AssertionError,
       Error ChainIndexError, Error WalletAPIError, Error EmulatorErr,
       LogMsg EmulatorEvent', State EmulatorState,
       Yield (LogMessage EmulatorEvent) ()]
     (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff
  '[LogMsg EmulatorEvent', MultiAgentEffect, MultiAgentControlEffect,
    ChainEffect, ChainControlEffect, Error EmulatorRuntimeError,
    Error AssertionError, Error ChainIndexError, Error WalletAPIError,
    Error EmulatorErr, LogMsg EmulatorEvent', State EmulatorState,
    Yield (LogMessage EmulatorEvent) ()]
  (Maybe a)
-> Eff
     '[MultiAgentEffect, MultiAgentControlEffect, ChainEffect,
       ChainControlEffect, Error EmulatorRuntimeError,
       Error AssertionError, Error ChainIndexError, Error WalletAPIError,
       Error EmulatorErr, LogMsg EmulatorEvent', State EmulatorState,
       Yield (LogMessage EmulatorEvent) ()]
     (Maybe a)
forall (eff :: * -> *) (effs :: [* -> *]).
Member eff effs =>
Eff (eff : effs) ~> Eff effs
subsume
    (Eff
   '[LogMsg EmulatorEvent', MultiAgentEffect, MultiAgentControlEffect,
     ChainEffect, ChainControlEffect, Error EmulatorRuntimeError,
     Error AssertionError, Error ChainIndexError, Error WalletAPIError,
     Error EmulatorErr, LogMsg EmulatorEvent', State EmulatorState,
     Yield (LogMessage EmulatorEvent) ()]
   (Maybe a)
 -> Eff
      '[MultiAgentEffect, MultiAgentControlEffect, ChainEffect,
        ChainControlEffect, Error EmulatorRuntimeError,
        Error AssertionError, Error ChainIndexError, Error WalletAPIError,
        Error EmulatorErr, LogMsg EmulatorEvent', State EmulatorState,
        Yield (LogMessage EmulatorEvent) ()]
      (Maybe a))
-> (Eff
      '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
        MultiAgentControlEffect, ChainEffect, ChainControlEffect,
        Error EmulatorRuntimeError]
      (Maybe a)
    -> Eff
         '[LogMsg EmulatorEvent', MultiAgentEffect, MultiAgentControlEffect,
           ChainEffect, ChainControlEffect, Error EmulatorRuntimeError,
           Error AssertionError, Error ChainIndexError, Error WalletAPIError,
           Error EmulatorErr, LogMsg EmulatorEvent', State EmulatorState,
           Yield (LogMessage EmulatorEvent) ()]
         (Maybe a))
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
-> Eff
     '[MultiAgentEffect, MultiAgentControlEffect, ChainEffect,
       ChainControlEffect, Error EmulatorRuntimeError,
       Error AssertionError, Error ChainIndexError, Error WalletAPIError,
       Error EmulatorErr, LogMsg EmulatorEvent', State EmulatorState,
       Yield (LogMessage EmulatorEvent) ()]
     (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (effs :: [* -> *]).
Member (State EmulatorState) effs =>
Eff (State EmulatorState : effs) ~> Eff effs
forall (eff :: * -> *) (effs :: [* -> *]).
Member eff effs =>
Eff (eff : effs) ~> Eff effs
subsume @(State EmulatorState)
    (Eff
   '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
     MultiAgentControlEffect, ChainEffect, ChainControlEffect,
     Error EmulatorRuntimeError, Error AssertionError,
     Error ChainIndexError, Error WalletAPIError, Error EmulatorErr,
     LogMsg EmulatorEvent', State EmulatorState,
     Yield (LogMessage EmulatorEvent) ()]
   (Maybe a)
 -> Eff
      '[LogMsg EmulatorEvent', MultiAgentEffect, MultiAgentControlEffect,
        ChainEffect, ChainControlEffect, Error EmulatorRuntimeError,
        Error AssertionError, Error ChainIndexError, Error WalletAPIError,
        Error EmulatorErr, LogMsg EmulatorEvent', State EmulatorState,
        Yield (LogMessage EmulatorEvent) ()]
      (Maybe a))
-> (Eff
      '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
        MultiAgentControlEffect, ChainEffect, ChainControlEffect,
        Error EmulatorRuntimeError]
      (Maybe a)
    -> Eff
         '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
           MultiAgentControlEffect, ChainEffect, ChainControlEffect,
           Error EmulatorRuntimeError, Error AssertionError,
           Error ChainIndexError, Error WalletAPIError, Error EmulatorErr,
           LogMsg EmulatorEvent', State EmulatorState,
           Yield (LogMessage EmulatorEvent) ()]
         (Maybe a))
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError]
     (Maybe a)
-> Eff
     '[LogMsg EmulatorEvent', MultiAgentEffect, MultiAgentControlEffect,
       ChainEffect, ChainControlEffect, Error EmulatorRuntimeError,
       Error AssertionError, Error ChainIndexError, Error WalletAPIError,
       Error EmulatorErr, LogMsg EmulatorEvent', State EmulatorState,
       Yield (LogMessage EmulatorEvent) ()]
     (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff
  '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
    MultiAgentControlEffect, ChainEffect, ChainControlEffect,
    Error EmulatorRuntimeError]
  (Maybe a)
-> Eff
     '[State EmulatorState, LogMsg EmulatorEvent', MultiAgentEffect,
       MultiAgentControlEffect, ChainEffect, ChainControlEffect,
       Error EmulatorRuntimeError, Error AssertionError,
       Error ChainIndexError, Error WalletAPIError, Error EmulatorErr,
       LogMsg EmulatorEvent', State EmulatorState,
       Yield (LogMessage EmulatorEvent) ()]
     (Maybe a)
forall (effs :: [* -> *]) (as :: [* -> *]).
CanWeakenEnd as effs =>
Eff as ~> Eff effs
raiseEnd

data EmulatorConfig =
    EmulatorConfig
        { EmulatorConfig -> InitialChainState
_initialChainState :: InitialChainState -- ^ State of the blockchain at the beginning of the simulation. Can be given as a map of funds to wallets, or as a block of transactions.
        , EmulatorConfig -> Params
_params            :: Params -- ^ Set the protocol parameters, network ID and slot configuration for the emulator.
        } deriving (EmulatorConfig -> EmulatorConfig -> Bool
(EmulatorConfig -> EmulatorConfig -> Bool)
-> (EmulatorConfig -> EmulatorConfig -> Bool) -> Eq EmulatorConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmulatorConfig -> EmulatorConfig -> Bool
$c/= :: EmulatorConfig -> EmulatorConfig -> Bool
== :: EmulatorConfig -> EmulatorConfig -> Bool
$c== :: EmulatorConfig -> EmulatorConfig -> Bool
Eq, Int -> EmulatorConfig -> ShowS
[EmulatorConfig] -> ShowS
EmulatorConfig -> String
(Int -> EmulatorConfig -> ShowS)
-> (EmulatorConfig -> String)
-> ([EmulatorConfig] -> ShowS)
-> Show EmulatorConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmulatorConfig] -> ShowS
$cshowList :: [EmulatorConfig] -> ShowS
show :: EmulatorConfig -> String
$cshow :: EmulatorConfig -> String
showsPrec :: Int -> EmulatorConfig -> ShowS
$cshowsPrec :: Int -> EmulatorConfig -> ShowS
Show)

type InitialChainState = Either InitialDistribution [CardanoTx]

-- | The wallets' initial funds
initialDist :: EmulatorConfig -> InitialDistribution
initialDist :: EmulatorConfig -> InitialDistribution
initialDist EmulatorConfig{InitialChainState
Params
_params :: Params
_initialChainState :: InitialChainState
_initialChainState :: EmulatorConfig -> InitialChainState
_params :: EmulatorConfig -> Params
..} = (InitialDistribution -> InitialDistribution)
-> ([CardanoTx] -> InitialDistribution)
-> InitialChainState
-> InitialDistribution
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either InitialDistribution -> InitialDistribution
forall a. a -> a
id (Block -> InitialDistribution
walletFunds (Block -> InitialDistribution)
-> ([CardanoTx] -> Block) -> [CardanoTx] -> InitialDistribution
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoTx -> OnChainTx) -> [CardanoTx] -> Block
forall a b. (a -> b) -> [a] -> [b]
map CardanoTx -> OnChainTx
unsafeMakeValid) InitialChainState
_initialChainState where
    walletFunds :: Block -> Map Wallet C.Value
    walletFunds :: Block -> InitialDistribution
walletFunds Block
theBlock =
        let values :: Map CardanoAddress Value
values = AddressMap -> Map CardanoAddress Value
AM.values (AddressMap -> Map CardanoAddress Value)
-> AddressMap -> Map CardanoAddress Value
forall a b. (a -> b) -> a -> b
$ Blockchain -> AddressMap
AM.fromChain [Block
theBlock]
            getFunds :: Wallet -> Value
getFunds Wallet
wllt = Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
forall a. Monoid a => a
mempty (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ CardanoAddress -> Map CardanoAddress Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Wallet -> CardanoAddress
mockWalletAddress Wallet
wllt) Map CardanoAddress Value
values
        in (Wallet -> Value) -> Set Wallet -> InitialDistribution
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet Wallet -> Value
getFunds ([Wallet] -> Set Wallet
forall a. Ord a => [a] -> Set a
Set.fromList [Wallet]
knownWallets)

instance Default EmulatorConfig where
  def :: EmulatorConfig
def = EmulatorConfig :: InitialChainState -> Params -> EmulatorConfig
EmulatorConfig
          { _initialChainState :: InitialChainState
_initialChainState = InitialDistribution -> InitialChainState
forall a b. a -> Either a b
Left InitialDistribution
defaultDist
          , _params :: Params
_params = Params
forall a. Default a => a
def
          }

initialState :: EmulatorConfig -> EM.EmulatorState
initialState :: EmulatorConfig -> EmulatorState
initialState EmulatorConfig{InitialChainState
Params
_params :: Params
_initialChainState :: InitialChainState
_initialChainState :: EmulatorConfig -> InitialChainState
_params :: EmulatorConfig -> Params
..} = let
    withInitialWalletValues :: InitialDistribution -> EmulatorState
withInitialWalletValues = (ToCardanoError -> EmulatorState)
-> (EmulatorState -> EmulatorState)
-> Either ToCardanoError EmulatorState
-> EmulatorState
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
          (String -> EmulatorState
forall a. HasCallStack => String -> a
error (String -> EmulatorState)
-> (ToCardanoError -> String) -> ToCardanoError -> EmulatorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Cannot build the initial state: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (ToCardanoError -> String) -> ToCardanoError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToCardanoError -> String
forall a. Show a => a -> String
show)
          EmulatorState -> EmulatorState
forall a. a -> a
id
          (Either ToCardanoError EmulatorState -> EmulatorState)
-> (InitialDistribution -> Either ToCardanoError EmulatorState)
-> InitialDistribution
-> EmulatorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params
-> Map PaymentPubKeyHash Value
-> Either ToCardanoError EmulatorState
EM.emulatorStateInitialDist Params
_params (Map PaymentPubKeyHash Value
 -> Either ToCardanoError EmulatorState)
-> (InitialDistribution -> Map PaymentPubKeyHash Value)
-> InitialDistribution
-> Either ToCardanoError EmulatorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Wallet -> PaymentPubKeyHash)
-> InitialDistribution -> Map PaymentPubKeyHash Value
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys Wallet -> PaymentPubKeyHash
EM.mockWalletPaymentPubKeyHash
    in (InitialDistribution -> EmulatorState)
-> ([CardanoTx] -> EmulatorState)
-> InitialChainState
-> EmulatorState
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either InitialDistribution -> EmulatorState
withInitialWalletValues ([CardanoTx] -> EmulatorState
EM.emulatorStatePool) InitialChainState
_initialChainState


data EmulatorErr =
    WalletErr WalletAPIError
    | ChainIndexErr ChainIndexError
    | AssertionErr EM.AssertionError
    | InstanceErr EmulatorRuntimeError
    | ExitWasNeverCalled
    deriving (Int -> EmulatorErr -> ShowS
[EmulatorErr] -> ShowS
EmulatorErr -> String
(Int -> EmulatorErr -> ShowS)
-> (EmulatorErr -> String)
-> ([EmulatorErr] -> ShowS)
-> Show EmulatorErr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmulatorErr] -> ShowS
$cshowList :: [EmulatorErr] -> ShowS
show :: EmulatorErr -> String
$cshow :: EmulatorErr -> String
showsPrec :: Int -> EmulatorErr -> ShowS
$cshowsPrec :: Int -> EmulatorErr -> ShowS
Show)

handleLogCoroutine :: forall e effs.
    Member (Yield (LogMessage e) ()) effs
    => LogMsg e
    ~> Eff effs
handleLogCoroutine :: LogMsg e ~> Eff effs
handleLogCoroutine = \case LMessage LogMessage e
m -> LogMessage e -> (x -> x) -> Eff effs x
forall a b (effs :: [* -> *]) c.
Member (Yield a b) effs =>
a -> (b -> c) -> Eff effs c
yield LogMessage e
m x -> x
forall a. a -> a
id

-- | Annotate emulator log messages with the current system time
--   (slot number)
mkTimedLogs :: forall a effs.
    ( Member (LogMsg (EmulatorTimeEvent a)) effs
    , Member (State EmulatorState) effs
    )
    => LogMsg a
    ~> Eff effs
mkTimedLogs :: LogMsg a ~> Eff effs
mkTimedLogs = (a -> Eff effs (EmulatorTimeEvent a)) -> LogMsg a ~> Eff effs
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> Eff effs b) -> LogMsg a ~> Eff effs
mapMLog a -> Eff effs (EmulatorTimeEvent a)
f where
    f :: a -> Eff effs (EmulatorTimeEvent a)
    f :: a -> Eff effs (EmulatorTimeEvent a)
f a
a =
        Slot -> a -> EmulatorTimeEvent a
forall e. Slot -> e -> EmulatorTimeEvent e
EmulatorTimeEvent
            (Slot -> a -> EmulatorTimeEvent a)
-> Eff effs Slot -> Eff effs (a -> EmulatorTimeEvent a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EmulatorState -> Slot) -> Eff effs Slot
forall s a (effs :: [* -> *]).
Member (State s) effs =>
(s -> a) -> Eff effs a
gets (Getting Slot EmulatorState Slot -> EmulatorState -> Slot
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting Slot EmulatorState Slot -> EmulatorState -> Slot)
-> Getting Slot EmulatorState Slot -> EmulatorState -> Slot
forall a b. (a -> b) -> a -> b
$ (ChainState -> Const Slot ChainState)
-> EmulatorState -> Const Slot EmulatorState
Lens' EmulatorState ChainState
EM.chainState ((ChainState -> Const Slot ChainState)
 -> EmulatorState -> Const Slot EmulatorState)
-> ((Slot -> Const Slot Slot)
    -> ChainState -> Const Slot ChainState)
-> Getting Slot EmulatorState Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Slot -> Const Slot Slot) -> ChainState -> Const Slot ChainState
Lens' ChainState Slot
EM.chainCurrentSlot)
            Eff effs (a -> EmulatorTimeEvent a)
-> Eff effs a -> Eff effs (EmulatorTimeEvent a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> Eff effs a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

makeLenses ''EmulatorConfig