{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE NumericUnderscores  #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeOperators       #-}

{-

A live, multi-threaded PAB simulator with agent-specific states and actions
on them. Agents are represented by the 'Wallet' type. Each agent corresponds
to one PAB, with its own view of the world, all acting on the same blockchain.

-}
module Plutus.PAB.Simulator(
    Simulation
    , SimulatorState
    -- * Run with user-defined contracts
    , SimulatorContractHandler
    , runSimulationWith
    , SimulatorEffectHandlers
    , mkSimulatorHandlers
    , addWallet
    , addWalletWith
    -- * Logging
    , logString
    -- ** Agent actions
    , payToWallet
    , payToPaymentPublicKeyHash
    , activateContract
    , callEndpointOnInstance
    , handleAgentThread
    , Activity(..)
    , stopInstance
    , instanceActivity
    -- ** Control actions
    , makeBlock
    -- * Querying the state
    , instanceState
    , observableState
    , waitForState
    , waitForInstanceState
    , waitForInstanceStateWithResult
    , activeEndpoints
    , waitForEndpoint
    , waitForTxStatusChange
    , waitForTxOutStatusChange
    , currentSlot
    , waitUntilSlot
    , waitNSlots
    , activeContracts
    , finalResult
    , waitUntilFinished
    , valueAt
    , valueAtSTM
    , walletFees
    , blockchain
    , currentBalances
    , logBalances
    -- ** Transaction counts
    , TxCounts(..)
    , txCounts
    , txCountsSTM
    , txValidated
    , txMemPool
    , waitForValidatedTxCount
    ) where

import Cardano.Api qualified as C
import Cardano.Node.Emulator.Internal.Node (ChainControlEffect, ChainState, Params (..),
                                            SlotConfig (SlotConfig, scSlotLength))
import Cardano.Node.Emulator.Internal.Node.Chain qualified as Chain
import Cardano.Wallet.Mock.Handlers qualified as MockWallet
import Control.Concurrent (forkIO)
import Control.Concurrent.STM (STM, TQueue, TVar)
import Control.Concurrent.STM qualified as STM
import Control.Lens (_Just, at, makeLenses, makeLensesFor, preview, set, unto, view, (&), (.~), (?~), (^.))
import Control.Monad (forM_, forever, guard, void, when)
import Control.Monad.Freer (Eff, LastMember, Member, interpret, reinterpret, reinterpret2, reinterpretN, run, send,
                            type (~>))
import Control.Monad.Freer.Error (Error, handleError, runError, throwError)
import Control.Monad.Freer.Extras qualified as Modify
import Control.Monad.Freer.Extras.Delay (DelayEffect, delayThread, handleDelayEffect)
import Control.Monad.Freer.Extras.Log (LogLevel (Info), LogMessage, LogMsg (LMessage), handleLogWriter, logInfo,
                                       logLevel, mapLog)
import Control.Monad.Freer.Reader (Reader, ask, asks)
import Control.Monad.Freer.State (State (Get, Put), runState)
import Control.Monad.Freer.Writer (Writer, runWriter)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Aeson qualified as JSON
import Data.Default (Default (def))
import Data.Foldable (fold, traverse_)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Set (Set)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import Data.Time.Units (Millisecond)
import Ledger (Blockchain, CardanoAddress, CardanoTx, PaymentPubKeyHash, cardanoTxOutValue, getCardanoTxFee,
               getCardanoTxId, unOnChain)
import Ledger.CardanoWallet (MockWallet)
import Ledger.CardanoWallet qualified as CW
import Ledger.Slot (Slot)
import Ledger.Value.CardanoAPI qualified as CardanoAPI
import Plutus.ChainIndex.Emulator (ChainIndexControlEffect, ChainIndexEmulatorState, ChainIndexError, ChainIndexLog,
                                   ChainIndexQueryEffect (..), TxOutStatus, TxStatus, getTip)
import Plutus.ChainIndex.Emulator qualified as ChainIndex
import Plutus.PAB.Core (EffectHandlers (EffectHandlers, handleContractDefinitionEffect, handleContractEffect, handleContractStoreEffect, handleLogMessages, handleServicesEffects, initialiseEnvironment, onShutdown, onStartup))
import Plutus.PAB.Core qualified as Core
import Plutus.PAB.Core.ContractInstance.BlockchainEnv qualified as BlockchainEnv
import Plutus.PAB.Core.ContractInstance.STM (Activity, BlockchainEnv (beParams), OpenEndpoint)
import Plutus.PAB.Core.ContractInstance.STM qualified as Instances
import Plutus.PAB.Effects.Contract (ContractStore)
import Plutus.PAB.Effects.Contract qualified as Contract
import Plutus.PAB.Effects.Contract.Builtin (HasDefinitions (getDefinitions))
import Plutus.PAB.Effects.TimeEffect (TimeEffect)
import Plutus.PAB.Monitoring.PABLogMsg (PABMultiAgentMsg (EmulatorMsg, UserLog, WalletBalancingMsg))
import Plutus.PAB.Types (PABError (ContractInstanceNotFound, WalletError, WalletNotFound))
import Plutus.PAB.Webserver.Types (ContractActivationArgs)
import Plutus.Script.Utils.Ada qualified as Ada
import Plutus.Script.Utils.Value (Value, flattenValue)
import Plutus.Trace.Emulator.System (appendNewTipBlock)
import Plutus.V1.Ledger.Tx (TxId, TxOutRef)
import Prettyprinter (Pretty (pretty), defaultLayoutOptions, layoutPretty)
import Prettyprinter.Render.Text qualified as Render
import Wallet.API qualified as WAPI
import Wallet.Effects (NodeClientEffect (GetClientParams, GetClientSlot, PublishTx), WalletEffect)
import Wallet.Emulator qualified as Emulator
import Wallet.Emulator.LogMessages (TxBalanceMsg)
import Wallet.Emulator.MultiAgent (EmulatorEvent' (ChainEvent, ChainIndexEvent))
import Wallet.Emulator.Stream qualified as Emulator
import Wallet.Emulator.Wallet (Wallet, knownWallet, knownWallets)
import Wallet.Emulator.Wallet qualified as Wallet
import Wallet.Types (ContractActivityStatus, ContractInstanceId, NotificationError)

-- | The current state of a contract instance
data SimulatorContractInstanceState t =
    SimulatorContractInstanceState
        { SimulatorContractInstanceState t
-> ContractActivationArgs (ContractDef t)
_contractDef   :: ContractActivationArgs (Contract.ContractDef t)
        , SimulatorContractInstanceState t -> State t
_contractState :: Contract.State t
        }

makeLensesFor [("_contractState", "contractState")] ''SimulatorContractInstanceState

data AgentState t =
    AgentState
        { AgentState t -> WalletState
_walletState   :: Wallet.WalletState
        , AgentState t -> Map TxId Lovelace
_submittedFees :: Map C.TxId CardanoAPI.Lovelace
        }

makeLenses ''AgentState

initialAgentState :: forall t. MockWallet -> AgentState t
initialAgentState :: MockWallet -> AgentState t
initialAgentState MockWallet
mw=
    AgentState :: forall t. WalletState -> Map TxId Lovelace -> AgentState t
AgentState
        { _walletState :: WalletState
_walletState   = MockWallet -> WalletState
Wallet.fromMockWallet MockWallet
mw
        , _submittedFees :: Map TxId Lovelace
_submittedFees = Map TxId Lovelace
forall a. Monoid a => a
mempty
        }

data SimulatorState t =
    SimulatorState
        { SimulatorState t -> TQueue (LogMessage (PABMultiAgentMsg t))
_logMessages :: TQueue (LogMessage (PABMultiAgentMsg t))
        , SimulatorState t -> TVar ChainState
_chainState  :: TVar ChainState
        , SimulatorState t -> TVar (Map Wallet (AgentState t))
_agentStates :: TVar (Map Wallet (AgentState t))
        , SimulatorState t -> TVar ChainIndexEmulatorState
_chainIndex  :: TVar ChainIndexEmulatorState
        , SimulatorState t
-> TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
_instances   :: TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
        }

makeLensesFor [("_logMessages", "logMessages"), ("_instances", "instances")] ''SimulatorState

initialState :: forall t. IO (SimulatorState t)
initialState :: IO (SimulatorState t)
initialState = do
    let initialDistribution :: Map Wallet Value
initialDistribution = [(Wallet, Value)] -> Map Wallet Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Wallet, Value)] -> Map Wallet Value)
-> [(Wallet, Value)] -> Map Wallet Value
forall a b. (a -> b) -> a -> b
$ (Wallet -> (Wallet, Value)) -> [Wallet] -> [(Wallet, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, Rational -> Value
CardanoAPI.adaValueOf Rational
100_000) [Wallet]
knownWallets
        Emulator.EmulatorState{ChainState
_chainState :: EmulatorState -> ChainState
_chainState :: ChainState
Emulator._chainState} = EmulatorConfig -> EmulatorState
Emulator.initialState (EmulatorConfig
forall a. Default a => a
def EmulatorConfig
-> (EmulatorConfig -> EmulatorConfig) -> EmulatorConfig
forall a b. a -> (a -> b) -> b
& (InitialChainState -> Identity InitialChainState)
-> EmulatorConfig -> Identity EmulatorConfig
Lens' EmulatorConfig InitialChainState
Emulator.initialChainState ((InitialChainState -> Identity InitialChainState)
 -> EmulatorConfig -> Identity EmulatorConfig)
-> InitialChainState -> EmulatorConfig -> EmulatorConfig
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Wallet Value -> InitialChainState
forall a b. a -> Either a b
Left Map Wallet Value
initialDistribution)
        initialWallets :: Map Wallet (AgentState t)
initialWallets = [(Wallet, AgentState t)] -> Map Wallet (AgentState t)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Wallet, AgentState t)] -> Map Wallet (AgentState t))
-> [(Wallet, AgentState t)] -> Map Wallet (AgentState t)
forall a b. (a -> b) -> a -> b
$ (MockWallet -> (Wallet, AgentState t))
-> [MockWallet] -> [(Wallet, AgentState t)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\MockWallet
w -> (MockWallet -> Wallet
Wallet.toMockWallet MockWallet
w, MockWallet -> AgentState t
forall t. MockWallet -> AgentState t
initialAgentState MockWallet
w)) [MockWallet]
CW.knownMockWallets
    STM (SimulatorState t) -> IO (SimulatorState t)
forall a. STM a -> IO a
STM.atomically (STM (SimulatorState t) -> IO (SimulatorState t))
-> STM (SimulatorState t) -> IO (SimulatorState t)
forall a b. (a -> b) -> a -> b
$
        TQueue (LogMessage (PABMultiAgentMsg t))
-> TVar ChainState
-> TVar (Map Wallet (AgentState t))
-> TVar ChainIndexEmulatorState
-> TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
-> SimulatorState t
forall t.
TQueue (LogMessage (PABMultiAgentMsg t))
-> TVar ChainState
-> TVar (Map Wallet (AgentState t))
-> TVar ChainIndexEmulatorState
-> TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
-> SimulatorState t
SimulatorState
            (TQueue (LogMessage (PABMultiAgentMsg t))
 -> TVar ChainState
 -> TVar (Map Wallet (AgentState t))
 -> TVar ChainIndexEmulatorState
 -> TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
 -> SimulatorState t)
-> STM (TQueue (LogMessage (PABMultiAgentMsg t)))
-> STM
     (TVar ChainState
      -> TVar (Map Wallet (AgentState t))
      -> TVar ChainIndexEmulatorState
      -> TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
      -> SimulatorState t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM (TQueue (LogMessage (PABMultiAgentMsg t)))
forall a. STM (TQueue a)
STM.newTQueue
            STM
  (TVar ChainState
   -> TVar (Map Wallet (AgentState t))
   -> TVar ChainIndexEmulatorState
   -> TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
   -> SimulatorState t)
-> STM (TVar ChainState)
-> STM
     (TVar (Map Wallet (AgentState t))
      -> TVar ChainIndexEmulatorState
      -> TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
      -> SimulatorState t)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ChainState -> STM (TVar ChainState)
forall a. a -> STM (TVar a)
STM.newTVar ChainState
_chainState
            STM
  (TVar (Map Wallet (AgentState t))
   -> TVar ChainIndexEmulatorState
   -> TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
   -> SimulatorState t)
-> STM (TVar (Map Wallet (AgentState t)))
-> STM
     (TVar ChainIndexEmulatorState
      -> TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
      -> SimulatorState t)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map Wallet (AgentState t) -> STM (TVar (Map Wallet (AgentState t)))
forall a. a -> STM (TVar a)
STM.newTVar Map Wallet (AgentState t)
forall t. Map Wallet (AgentState t)
initialWallets
            STM
  (TVar ChainIndexEmulatorState
   -> TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
   -> SimulatorState t)
-> STM (TVar ChainIndexEmulatorState)
-> STM
     (TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
      -> SimulatorState t)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ChainIndexEmulatorState -> STM (TVar ChainIndexEmulatorState)
forall a. a -> STM (TVar a)
STM.newTVar ChainIndexEmulatorState
forall a. Monoid a => a
mempty
            STM
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
   -> SimulatorState t)
-> STM
     (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
-> STM (SimulatorState t)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map ContractInstanceId (SimulatorContractInstanceState t)
-> STM
     (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
forall a. a -> STM (TVar a)
STM.newTVar Map ContractInstanceId (SimulatorContractInstanceState t)
forall a. Monoid a => a
mempty

-- | A handler for the 'ContractEffect' of @t@ that can run contracts in a
--   simulated environment.
type SimulatorContractHandler t =
    forall effs.
        ( Member (Error PABError) effs
        , Member (LogMsg (PABMultiAgentMsg t)) effs
        )
        => Eff (Contract.ContractEffect t ': effs)
        ~> Eff effs

type SimulatorEffectHandlers t = EffectHandlers t (SimulatorState t)

-- | Build 'EffectHandlers' for running a contract in the simulator.
mkSimulatorHandlers ::
    forall t.
    ( Pretty (Contract.ContractDef t)
    , HasDefinitions (Contract.ContractDef t)
    )
    => Params
    -> SimulatorContractHandler t -- ^ Making calls to the contract (see 'Plutus.PAB.Effects.Contract.ContractTest.handleContractTest' for an example)
    -> SimulatorEffectHandlers t
mkSimulatorHandlers :: Params -> SimulatorContractHandler t -> SimulatorEffectHandlers t
mkSimulatorHandlers Params
params SimulatorContractHandler t
handleContractEffect =
    EffectHandlers :: forall t env.
(forall (effs :: [* -> *]).
 (Member (Error PABError) effs, LastMember IO effs) =>
 Eff effs (InstancesState, BlockchainEnv, env))
-> (forall (effs :: [* -> *]).
    (Member (Reader (PABEnvironment t env)) effs,
     Member TimeEffect effs, Member (Error PABError) effs,
     LastMember IO effs) =>
    Eff (LogMsg (PABMultiAgentMsg t) : effs) ~> Eff effs)
-> (forall (effs :: [* -> *]).
    (Member (Reader (PABEnvironment t env)) effs,
     Member (Error PABError) effs, Member TimeEffect effs,
     Member (LogMsg (PABMultiAgentMsg t)) effs, LastMember IO effs) =>
    Eff (ContractStore t : effs) ~> Eff effs)
-> (forall (effs :: [* -> *]).
    (Member (Reader (PABEnvironment t env)) effs,
     Member (Error PABError) effs, Member TimeEffect effs,
     Member (LogMsg (PABMultiAgentMsg t)) effs, LastMember IO effs) =>
    Eff (ContractEffect t : effs) ~> Eff effs)
-> (forall (effs :: [* -> *]).
    (Member (Reader (PABEnvironment t env)) effs,
     Member (Error PABError) effs, Member TimeEffect effs,
     Member (LogMsg (PABMultiAgentMsg t)) effs, LastMember IO effs) =>
    Eff (ContractDefinition t : effs) ~> Eff effs)
-> (forall (effs :: [* -> *]).
    (Member (Reader (PABEnvironment t env)) effs,
     Member (Error PABError) effs, Member TimeEffect effs,
     Member (LogMsg (PABMultiAgentMsg t)) effs, LastMember IO effs) =>
    Wallet
    -> Maybe ContractInstanceId
    -> Eff
         (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs)
       ~> Eff effs)
-> PABAction t env ()
-> PABAction t env ()
-> EffectHandlers t env
EffectHandlers
        { initialiseEnvironment :: forall (effs :: [* -> *]).
(Member (Error PABError) effs, LastMember IO effs) =>
Eff effs (InstancesState, BlockchainEnv, SimulatorState t)
initialiseEnvironment =
            (,,)
                (InstancesState
 -> BlockchainEnv
 -> SimulatorState t
 -> (InstancesState, BlockchainEnv, SimulatorState t))
-> Eff effs InstancesState
-> Eff
     effs
     (BlockchainEnv
      -> SimulatorState t
      -> (InstancesState, BlockchainEnv, SimulatorState t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO InstancesState -> Eff effs InstancesState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO InstancesState
Instances.emptyInstancesState
                Eff
  effs
  (BlockchainEnv
   -> SimulatorState t
   -> (InstancesState, BlockchainEnv, SimulatorState t))
-> Eff effs BlockchainEnv
-> Eff
     effs
     (SimulatorState t
      -> (InstancesState, BlockchainEnv, SimulatorState t))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO BlockchainEnv -> Eff effs BlockchainEnv
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (STM BlockchainEnv -> IO BlockchainEnv
forall a. STM a -> IO a
STM.atomically (STM BlockchainEnv -> IO BlockchainEnv)
-> STM BlockchainEnv -> IO BlockchainEnv
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Params -> STM BlockchainEnv
Instances.emptyBlockchainEnv Maybe Int
forall a. Maybe a
Nothing Params
params)
                Eff
  effs
  (SimulatorState t
   -> (InstancesState, BlockchainEnv, SimulatorState t))
-> Eff effs (SimulatorState t)
-> Eff effs (InstancesState, BlockchainEnv, SimulatorState t)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (SimulatorState t) -> Eff effs (SimulatorState t)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SimulatorState t)
forall t. IO (SimulatorState t)
initialState @t)
        , handleContractStoreEffect :: forall (effs :: [* -> *]).
(Member (Reader (PABEnvironment t (SimulatorState t))) effs,
 Member (Error PABError) effs, Member TimeEffect effs,
 Member (LogMsg (PABMultiAgentMsg t)) effs, LastMember IO effs) =>
Eff (ContractStore t : effs) ~> Eff effs
handleContractStoreEffect =
            (ContractStore t ~> Eff effs)
-> Eff (ContractStore t : effs) ~> Eff effs
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ContractStore t ~> Eff effs
forall t (effs :: [* -> *]).
(LastMember IO effs,
 Member (Reader (PABEnvironment t (SimulatorState t))) effs,
 Member (Error PABError) effs) =>
ContractStore t ~> Eff effs
handleContractStore
        , SimulatorContractHandler t
forall (effs :: [* -> *]) x.
(Member (Reader (PABEnvironment t (SimulatorState t))) effs,
 Member (Error PABError) effs, Member TimeEffect effs,
 Member (LogMsg (PABMultiAgentMsg t)) effs, LastMember IO effs) =>
Eff (ContractEffect t : effs) x -> Eff effs x
handleContractEffect :: SimulatorContractHandler t
handleContractEffect :: forall (effs :: [* -> *]) x.
(Member (Reader (PABEnvironment t (SimulatorState t))) effs,
 Member (Error PABError) effs, Member TimeEffect effs,
 Member (LogMsg (PABMultiAgentMsg t)) effs, LastMember IO effs) =>
Eff (ContractEffect t : effs) x -> Eff effs x
handleContractEffect
        , handleLogMessages :: forall (effs :: [* -> *]).
(Member (Reader (PABEnvironment t (SimulatorState t))) effs,
 Member TimeEffect effs, Member (Error PABError) effs,
 LastMember IO effs) =>
Eff (LogMsg (PABMultiAgentMsg t) : effs) ~> Eff effs
handleLogMessages = forall (effs :: [* -> *]).
(LastMember IO effs,
 Member (Reader (PABEnvironment t (SimulatorState t))) effs) =>
Eff (LogMsg (PABMultiAgentMsg t) : effs) ~> Eff effs
forall t (effs :: [* -> *]).
(LastMember IO effs,
 Member (Reader (PABEnvironment t (SimulatorState t))) effs) =>
Eff (LogMsg (PABMultiAgentMsg t) : effs) ~> Eff effs
handleLogSimulator @t
        , handleServicesEffects :: forall (effs :: [* -> *]).
(Member (Reader (PABEnvironment t (SimulatorState t))) effs,
 Member (Error PABError) effs, Member TimeEffect effs,
 Member (LogMsg (PABMultiAgentMsg t)) effs, LastMember IO effs) =>
Wallet
-> Maybe ContractInstanceId
-> Eff
     (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs)
   ~> Eff effs
handleServicesEffects = Params
-> Wallet
-> Maybe ContractInstanceId
-> Eff
     (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs)
   ~> Eff effs
forall t (effs :: [* -> *]).
(Member (LogMsg (PABMultiAgentMsg t)) effs,
 Member (Reader (PABEnvironment t (SimulatorState t))) effs,
 Member TimeEffect effs, LastMember IO effs,
 Member (Error PABError) effs) =>
Params
-> Wallet
-> Maybe ContractInstanceId
-> Eff
     (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs)
   ~> Eff effs
handleServicesSimulator @t Params
params
        , handleContractDefinitionEffect :: forall (effs :: [* -> *]).
(Member (Reader (PABEnvironment t (SimulatorState t))) effs,
 Member (Error PABError) effs, Member TimeEffect effs,
 Member (LogMsg (PABMultiAgentMsg t)) effs, LastMember IO effs) =>
Eff (ContractDefinition t : effs) ~> Eff effs
handleContractDefinitionEffect =
            (ContractDefinition t ~> Eff effs)
-> Eff (ContractDefinition t : effs) ~> Eff effs
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((ContractDefinition t ~> Eff effs)
 -> Eff (ContractDefinition t : effs) ~> Eff effs)
-> (ContractDefinition t ~> Eff effs)
-> Eff (ContractDefinition t : effs) ~> Eff effs
forall a b. (a -> b) -> a -> b
$ \case
                Contract.AddDefinition _ -> () -> Eff effs ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- not supported
                ContractDefinition t x
Contract.GetDefinitions  -> [ContractDef t] -> Eff effs [ContractDef t]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ContractDef t]
forall a. HasDefinitions a => [a]
getDefinitions
        , onStartup :: PABAction t (SimulatorState t) ()
onStartup = do
            SimulatorState{TQueue (LogMessage (PABMultiAgentMsg t))
_logMessages :: TQueue (LogMessage (PABMultiAgentMsg t))
_logMessages :: forall t.
SimulatorState t -> TQueue (LogMessage (PABMultiAgentMsg t))
_logMessages} <- forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Eff effs (SimulatorState t)
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Eff effs env
Core.askUserEnv @t @(SimulatorState t)
            Eff (PABEffects t (SimulatorState t)) ThreadId
-> PABAction t (SimulatorState t) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff (PABEffects t (SimulatorState t)) ThreadId
 -> PABAction t (SimulatorState t) ())
-> Eff (PABEffects t (SimulatorState t)) ThreadId
-> PABAction t (SimulatorState t) ()
forall a b. (a -> b) -> a -> b
$ IO ThreadId -> Eff (PABEffects t (SimulatorState t)) ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> Eff (PABEffects t (SimulatorState t)) ThreadId)
-> IO ThreadId -> Eff (PABEffects t (SimulatorState t)) ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (TQueue (LogMessage (PABMultiAgentMsg t)) -> IO ()
forall t. Pretty t => TQueue (LogMessage t) -> IO ()
printLogMessages TQueue (LogMessage (PABMultiAgentMsg t))
_logMessages)
            Core.PABRunner{forall a.
PABAction t (SimulatorState t) a -> IO (Either PABError a)
runPABAction :: forall t env.
PABRunner t env
-> forall a. PABAction t env a -> IO (Either PABError a)
runPABAction :: forall a.
PABAction t (SimulatorState t) a -> IO (Either PABError a)
Core.runPABAction} <- PABAction t (SimulatorState t) (PABRunner t (SimulatorState t))
forall t env. PABAction t env (PABRunner t env)
Core.pabRunner
            Eff (PABEffects t (SimulatorState t)) ThreadId
-> PABAction t (SimulatorState t) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
                (Eff (PABEffects t (SimulatorState t)) ThreadId
 -> PABAction t (SimulatorState t) ())
-> Eff (PABEffects t (SimulatorState t)) ThreadId
-> PABAction t (SimulatorState t) ()
forall a b. (a -> b) -> a -> b
$ IO ThreadId -> Eff (PABEffects t (SimulatorState t)) ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
                (IO ThreadId -> Eff (PABEffects t (SimulatorState t)) ThreadId)
-> IO ThreadId -> Eff (PABEffects t (SimulatorState t)) ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO
                (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO (Either PABError ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
                (IO (Either PABError ()) -> IO ())
-> IO (Either PABError ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ PABAction t (SimulatorState t) () -> IO (Either PABError ())
forall a.
PABAction t (SimulatorState t) a -> IO (Either PABError a)
runPABAction
                (PABAction t (SimulatorState t) () -> IO (Either PABError ()))
-> PABAction t (SimulatorState t) () -> IO (Either PABError ())
forall a b. (a -> b) -> a -> b
$ Eff (DelayEffect : PABEffects t (SimulatorState t)) ()
-> PABAction t (SimulatorState t) ()
forall (effs :: [* -> *]) (m :: * -> *).
(LastMember m effs, MonadIO m) =>
Eff (DelayEffect : effs) ~> Eff effs
handleDelayEffect
                (Eff (DelayEffect : PABEffects t (SimulatorState t)) ()
 -> PABAction t (SimulatorState t) ())
-> Eff (DelayEffect : PABEffects t (SimulatorState t)) ()
-> PABAction t (SimulatorState t) ()
forall a b. (a -> b) -> a -> b
$ (Reader (SimulatorState t)
 ~> Eff (DelayEffect : PABEffects t (SimulatorState t)))
-> Eff
     (Reader (SimulatorState t)
        : DelayEffect : PABEffects t (SimulatorState t))
   ~> Eff (DelayEffect : PABEffects t (SimulatorState t))
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Reader (SimulatorState t) ~> Eff effs
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Reader env ~> Eff effs
Core.handleUserEnvReader @t @(SimulatorState t))
                (Eff
   (Reader (SimulatorState t)
      : DelayEffect : PABEffects t (SimulatorState t))
   ()
 -> Eff (DelayEffect : PABEffects t (SimulatorState t)) ())
-> Eff
     (Reader (SimulatorState t)
        : DelayEffect : PABEffects t (SimulatorState t))
     ()
-> Eff (DelayEffect : PABEffects t (SimulatorState t)) ()
forall a b. (a -> b) -> a -> b
$ (Reader InstancesState
 ~> Eff
      (Reader (SimulatorState t)
         : DelayEffect : PABEffects t (SimulatorState t)))
-> Eff
     (Reader InstancesState
        : Reader (SimulatorState t) : DelayEffect
        : PABEffects t (SimulatorState t))
   ~> Eff
        (Reader (SimulatorState t)
           : DelayEffect : PABEffects t (SimulatorState t))
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Reader InstancesState ~> Eff effs
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Reader InstancesState ~> Eff effs
Core.handleInstancesStateReader @t @(SimulatorState t))
                (Eff
   (Reader InstancesState
      : Reader (SimulatorState t) : DelayEffect
      : PABEffects t (SimulatorState t))
   ()
 -> Eff
      (Reader (SimulatorState t)
         : DelayEffect : PABEffects t (SimulatorState t))
      ())
-> Eff
     (Reader InstancesState
        : Reader (SimulatorState t) : DelayEffect
        : PABEffects t (SimulatorState t))
     ()
-> Eff
     (Reader (SimulatorState t)
        : DelayEffect : PABEffects t (SimulatorState t))
     ()
forall a b. (a -> b) -> a -> b
$ (Reader BlockchainEnv
 ~> Eff
      (Reader InstancesState
         : Reader (SimulatorState t) : DelayEffect
         : PABEffects t (SimulatorState t)))
-> Eff
     (Reader BlockchainEnv
        : Reader InstancesState : Reader (SimulatorState t) : DelayEffect
        : PABEffects t (SimulatorState t))
   ~> Eff
        (Reader InstancesState
           : Reader (SimulatorState t) : DelayEffect
           : PABEffects t (SimulatorState t))
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Reader BlockchainEnv ~> Eff effs
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Reader BlockchainEnv ~> Eff effs
Core.handleBlockchainEnvReader @t @(SimulatorState t))
                (Eff
   (Reader BlockchainEnv
      : Reader InstancesState : Reader (SimulatorState t) : DelayEffect
      : PABEffects t (SimulatorState t))
   ()
 -> Eff
      (Reader InstancesState
         : Reader (SimulatorState t) : DelayEffect
         : PABEffects t (SimulatorState t))
      ())
-> Eff
     (Reader BlockchainEnv
        : Reader InstancesState : Reader (SimulatorState t) : DelayEffect
        : PABEffects t (SimulatorState t))
     ()
-> Eff
     (Reader InstancesState
        : Reader (SimulatorState t) : DelayEffect
        : PABEffects t (SimulatorState t))
     ()
forall a b. (a -> b) -> a -> b
$ forall (effs :: [* -> *]).
(LastMember IO effs, Member (Reader (SimulatorState t)) effs,
 Member (Reader BlockchainEnv) effs,
 Member (Reader InstancesState) effs, Member DelayEffect effs,
 Member TimeEffect effs) =>
Eff effs ()
forall t (effs :: [* -> *]).
(LastMember IO effs, Member (Reader (SimulatorState t)) effs,
 Member (Reader BlockchainEnv) effs,
 Member (Reader InstancesState) effs, Member DelayEffect effs,
 Member TimeEffect effs) =>
Eff effs ()
advanceClock @t
            Slot -> PABAction t (SimulatorState t) ()
forall t env. Slot -> PABAction t env ()
Core.waitUntilSlot Slot
1
        , onShutdown :: PABAction t (SimulatorState t) ()
onShutdown = Eff (DelayEffect : PABEffects t (SimulatorState t)) ()
-> PABAction t (SimulatorState t) ()
forall (effs :: [* -> *]) (m :: * -> *).
(LastMember m effs, MonadIO m) =>
Eff (DelayEffect : effs) ~> Eff effs
handleDelayEffect (Eff (DelayEffect : PABEffects t (SimulatorState t)) ()
 -> PABAction t (SimulatorState t) ())
-> Eff (DelayEffect : PABEffects t (SimulatorState t)) ()
-> PABAction t (SimulatorState t) ()
forall a b. (a -> b) -> a -> b
$ Millisecond
-> Eff (DelayEffect : PABEffects t (SimulatorState t)) ()
forall a (effs :: [* -> *]).
(TimeUnit a, Member DelayEffect effs) =>
a -> Eff effs ()
delayThread (Millisecond
500 :: Millisecond) -- need to wait a little to avoid garbled terminal output in GHCi.
        }

handleLogSimulator ::
    forall t effs.
    ( LastMember IO effs
    , Member (Reader (Core.PABEnvironment t (SimulatorState t))) effs
    )
    => Eff (LogMsg (PABMultiAgentMsg t) ': effs)
    ~> Eff effs
handleLogSimulator :: Eff (LogMsg (PABMultiAgentMsg t) : effs) ~> Eff effs
handleLogSimulator =
    (LogMsg (PABMultiAgentMsg t) ~> Eff effs)
-> Eff (LogMsg (PABMultiAgentMsg t) : effs) ~> Eff effs
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((PABEnvironment t (SimulatorState t)
 -> TQueue (LogMessage (PABMultiAgentMsg t)))
-> LogMsg (PABMultiAgentMsg t) ~> Eff effs
forall s1 s2 (effs :: [* -> *]).
(Member (Reader s2) effs, LastMember IO effs) =>
(s2 -> TQueue (LogMessage s1)) -> LogMsg s1 ~> Eff effs
logIntoTQueue @_ @(Core.PABEnvironment t (SimulatorState t)) @effs (Getting
  (TQueue (LogMessage (PABMultiAgentMsg t)))
  (SimulatorState t)
  (TQueue (LogMessage (PABMultiAgentMsg t)))
-> SimulatorState t -> TQueue (LogMessage (PABMultiAgentMsg t))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (TQueue (LogMessage (PABMultiAgentMsg t)))
  (SimulatorState t)
  (TQueue (LogMessage (PABMultiAgentMsg t)))
forall t.
Lens' (SimulatorState t) (TQueue (LogMessage (PABMultiAgentMsg t)))
logMessages (SimulatorState t -> TQueue (LogMessage (PABMultiAgentMsg t)))
-> (PABEnvironment t (SimulatorState t) -> SimulatorState t)
-> PABEnvironment t (SimulatorState t)
-> TQueue (LogMessage (PABMultiAgentMsg t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PABEnvironment t (SimulatorState t) -> SimulatorState t
forall t env. PABEnvironment t env -> env
Core.appEnv))

handleServicesSimulator ::
    forall t effs.
    ( Member (LogMsg (PABMultiAgentMsg t)) effs
    , Member (Reader (Core.PABEnvironment t (SimulatorState t))) effs
    , Member TimeEffect effs
    , LastMember IO effs
    , Member (Error PABError) effs
    )
    => Params
    -> Wallet
    -> Maybe ContractInstanceId
    -> Eff (WalletEffect ': ChainIndexQueryEffect ': NodeClientEffect ': effs)
    ~> Eff effs
handleServicesSimulator :: Params
-> Wallet
-> Maybe ContractInstanceId
-> Eff
     (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs)
   ~> Eff effs
handleServicesSimulator Params
params Wallet
wallet Maybe ContractInstanceId
_ =
    let makeTimedChainIndexEvent :: Wallet
-> Eff (LogMsg ChainIndexLog : NodeClientEffect : effs) x
-> Eff (NodeClientEffect : effs) x
makeTimedChainIndexEvent Wallet
wllt =
            (LogMsg EmulatorEvent ~> Eff (NodeClientEffect : effs))
-> Eff (LogMsg EmulatorEvent : NodeClientEffect : effs)
   ~> Eff (NodeClientEffect : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((EmulatorEvent -> PABMultiAgentMsg t)
-> LogMsg EmulatorEvent ~> Eff (NodeClientEffect : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog @_ @(PABMultiAgentMsg t) EmulatorEvent -> PABMultiAgentMsg t
forall t. EmulatorEvent -> PABMultiAgentMsg t
EmulatorMsg)
            (Eff (LogMsg EmulatorEvent : NodeClientEffect : effs) x
 -> Eff (NodeClientEffect : effs) x)
-> (Eff (LogMsg ChainIndexLog : NodeClientEffect : effs) x
    -> Eff (LogMsg EmulatorEvent : NodeClientEffect : effs) x)
-> Eff (LogMsg ChainIndexLog : NodeClientEffect : effs) x
-> Eff (NodeClientEffect : effs) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg EmulatorEvent'
 ~> Eff (LogMsg EmulatorEvent : NodeClientEffect : effs))
-> Eff (LogMsg EmulatorEvent' : NodeClientEffect : effs)
   ~> Eff (LogMsg EmulatorEvent : NodeClientEffect : effs)
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret (forall (effs :: [* -> *]).
(Member (LogMsg EmulatorEvent) effs, Member TimeEffect effs) =>
LogMsg EmulatorEvent' ~> Eff effs
forall e (effs :: [* -> *]).
(Member (LogMsg (EmulatorTimeEvent e)) effs,
 Member TimeEffect effs) =>
LogMsg e ~> Eff effs
Core.timed @EmulatorEvent')
            (Eff (LogMsg EmulatorEvent' : NodeClientEffect : effs) x
 -> Eff (LogMsg EmulatorEvent : NodeClientEffect : effs) x)
-> (Eff (LogMsg ChainIndexLog : NodeClientEffect : effs) x
    -> Eff (LogMsg EmulatorEvent' : NodeClientEffect : effs) x)
-> Eff (LogMsg ChainIndexLog : NodeClientEffect : effs) x
-> Eff (LogMsg EmulatorEvent : NodeClientEffect : effs) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg ChainIndexLog
 ~> Eff (LogMsg EmulatorEvent' : NodeClientEffect : effs))
-> Eff (LogMsg ChainIndexLog : NodeClientEffect : effs)
   ~> Eff (LogMsg EmulatorEvent' : NodeClientEffect : effs)
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret ((ChainIndexLog -> EmulatorEvent')
-> LogMsg ChainIndexLog
   ~> Eff (LogMsg EmulatorEvent' : NodeClientEffect : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog (Wallet -> ChainIndexLog -> EmulatorEvent'
ChainIndexEvent Wallet
wllt))
        makeTimedChainEvent :: Eff (LogMsg ChainEvent : effs) x -> Eff effs x
makeTimedChainEvent =
            (LogMsg (PABMultiAgentMsg t) ~> Eff effs)
-> Eff (LogMsg (PABMultiAgentMsg t) : effs) ~> Eff effs
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((PABEnvironment t (SimulatorState t)
 -> TQueue (LogMessage (PABMultiAgentMsg t)))
-> LogMsg (PABMultiAgentMsg t) ~> Eff effs
forall s1 s2 (effs :: [* -> *]).
(Member (Reader s2) effs, LastMember IO effs) =>
(s2 -> TQueue (LogMessage s1)) -> LogMsg s1 ~> Eff effs
logIntoTQueue @_ @(Core.PABEnvironment t (SimulatorState t)) @effs (Getting
  (TQueue (LogMessage (PABMultiAgentMsg t)))
  (SimulatorState t)
  (TQueue (LogMessage (PABMultiAgentMsg t)))
-> SimulatorState t -> TQueue (LogMessage (PABMultiAgentMsg t))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (TQueue (LogMessage (PABMultiAgentMsg t)))
  (SimulatorState t)
  (TQueue (LogMessage (PABMultiAgentMsg t)))
forall t.
Lens' (SimulatorState t) (TQueue (LogMessage (PABMultiAgentMsg t)))
logMessages (SimulatorState t -> TQueue (LogMessage (PABMultiAgentMsg t)))
-> (PABEnvironment t (SimulatorState t) -> SimulatorState t)
-> PABEnvironment t (SimulatorState t)
-> TQueue (LogMessage (PABMultiAgentMsg t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PABEnvironment t (SimulatorState t) -> SimulatorState t
forall t env. PABEnvironment t env -> env
Core.appEnv))
            (Eff (LogMsg (PABMultiAgentMsg t) : effs) x -> Eff effs x)
-> (Eff (LogMsg ChainEvent : effs) x
    -> Eff (LogMsg (PABMultiAgentMsg t) : effs) x)
-> Eff (LogMsg ChainEvent : effs) x
-> Eff effs x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg EmulatorEvent ~> Eff (LogMsg (PABMultiAgentMsg t) : effs))
-> Eff (LogMsg EmulatorEvent : effs)
   ~> Eff (LogMsg (PABMultiAgentMsg t) : effs)
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret ((EmulatorEvent -> PABMultiAgentMsg t)
-> LogMsg EmulatorEvent ~> Eff (LogMsg (PABMultiAgentMsg t) : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog @_ @(PABMultiAgentMsg t) EmulatorEvent -> PABMultiAgentMsg t
forall t. EmulatorEvent -> PABMultiAgentMsg t
EmulatorMsg)
            (Eff (LogMsg EmulatorEvent : effs) x
 -> Eff (LogMsg (PABMultiAgentMsg t) : effs) x)
-> (Eff (LogMsg ChainEvent : effs) x
    -> Eff (LogMsg EmulatorEvent : effs) x)
-> Eff (LogMsg ChainEvent : effs) x
-> Eff (LogMsg (PABMultiAgentMsg t) : effs) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg EmulatorEvent' ~> Eff (LogMsg EmulatorEvent : effs))
-> Eff (LogMsg EmulatorEvent' : effs)
   ~> Eff (LogMsg EmulatorEvent : effs)
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret ((Member (LogMsg EmulatorEvent) (LogMsg EmulatorEvent : effs),
 Member TimeEffect (LogMsg EmulatorEvent : effs)) =>
LogMsg EmulatorEvent' ~> Eff (LogMsg EmulatorEvent : effs)
forall e (effs :: [* -> *]).
(Member (LogMsg (EmulatorTimeEvent e)) effs,
 Member TimeEffect effs) =>
LogMsg e ~> Eff effs
Core.timed @EmulatorEvent' @(LogMsg Emulator.EmulatorEvent ': effs))
            (Eff (LogMsg EmulatorEvent' : effs) x
 -> Eff (LogMsg EmulatorEvent : effs) x)
-> (Eff (LogMsg ChainEvent : effs) x
    -> Eff (LogMsg EmulatorEvent' : effs) x)
-> Eff (LogMsg ChainEvent : effs) x
-> Eff (LogMsg EmulatorEvent : effs) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg ChainEvent ~> Eff (LogMsg EmulatorEvent' : effs))
-> Eff (LogMsg ChainEvent : effs)
   ~> Eff (LogMsg EmulatorEvent' : effs)
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret ((ChainEvent -> EmulatorEvent')
-> LogMsg ChainEvent ~> Eff (LogMsg EmulatorEvent' : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog ChainEvent -> EmulatorEvent'
ChainEvent)
    in
        -- handle 'NodeClientEffect'
        Eff (LogMsg ChainEvent : effs) x -> Eff effs x
makeTimedChainEvent
        (Eff (LogMsg ChainEvent : effs) x -> Eff effs x)
-> (Eff
      (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
    -> Eff (LogMsg ChainEvent : effs) x)
-> Eff
     (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
-> Eff effs x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reader BlockchainEnv ~> Eff (LogMsg ChainEvent : effs))
-> Eff (Reader BlockchainEnv : LogMsg ChainEvent : effs)
   ~> Eff (LogMsg ChainEvent : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Reader BlockchainEnv ~> Eff effs
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Reader BlockchainEnv ~> Eff effs
Core.handleBlockchainEnvReader @t @(SimulatorState t))
        (Eff (Reader BlockchainEnv : LogMsg ChainEvent : effs) x
 -> Eff (LogMsg ChainEvent : effs) x)
-> (Eff
      (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
    -> Eff (Reader BlockchainEnv : LogMsg ChainEvent : effs) x)
-> Eff
     (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
-> Eff (LogMsg ChainEvent : effs) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reader (SimulatorState t)
 ~> Eff (Reader BlockchainEnv : LogMsg ChainEvent : effs))
-> Eff
     (Reader (SimulatorState t)
        : Reader BlockchainEnv : LogMsg ChainEvent : effs)
   ~> Eff (Reader BlockchainEnv : LogMsg ChainEvent : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Reader (SimulatorState t) ~> Eff effs
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Reader env ~> Eff effs
Core.handleUserEnvReader @t @(SimulatorState t))
        (Eff
   (Reader (SimulatorState t)
      : Reader BlockchainEnv : LogMsg ChainEvent : effs)
   x
 -> Eff (Reader BlockchainEnv : LogMsg ChainEvent : effs) x)
-> (Eff
      (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
    -> Eff
         (Reader (SimulatorState t)
            : Reader BlockchainEnv : LogMsg ChainEvent : effs)
         x)
-> Eff
     (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
-> Eff (Reader BlockchainEnv : LogMsg ChainEvent : effs) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainEffect
 ~> Eff
      ('[Reader (SimulatorState t), Reader BlockchainEnv,
         LogMsg ChainEvent]
       :++: effs))
-> Eff (ChainEffect : effs)
   ~> Eff
        ('[Reader (SimulatorState t), Reader BlockchainEnv,
           LogMsg ChainEvent]
         :++: effs)
forall (gs :: [* -> *]) (f :: * -> *) (effs :: [* -> *]).
Weakens gs =>
(f ~> Eff (gs :++: effs)) -> Eff (f : effs) ~> Eff (gs :++: effs)
reinterpretN @'[Reader (SimulatorState t), Reader BlockchainEnv, LogMsg _] (Params
-> ChainEffect
   ~> Eff
        (Reader (SimulatorState t)
           : Reader BlockchainEnv : LogMsg ChainEvent : effs)
forall t (effs :: [* -> *]).
(LastMember IO effs, Member (Reader (SimulatorState t)) effs,
 Member (LogMsg ChainEvent) effs) =>
Params -> ChainEffect ~> Eff effs
handleChainEffect @t Params
params)

        (Eff (ChainEffect : effs) x
 -> Eff
      (Reader (SimulatorState t)
         : Reader BlockchainEnv : LogMsg ChainEvent : effs)
      x)
-> (Eff
      (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
    -> Eff (ChainEffect : effs) x)
-> Eff
     (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
-> Eff
     (Reader (SimulatorState t)
        : Reader BlockchainEnv : LogMsg ChainEvent : effs)
     x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reader (SimulatorState t) ~> Eff (ChainEffect : effs))
-> Eff (Reader (SimulatorState t) : ChainEffect : effs)
   ~> Eff (ChainEffect : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Reader (SimulatorState t) ~> Eff effs
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Reader env ~> Eff effs
Core.handleUserEnvReader @t @(SimulatorState t))
        (Eff (Reader (SimulatorState t) : ChainEffect : effs) x
 -> Eff (ChainEffect : effs) x)
-> (Eff
      (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
    -> Eff (Reader (SimulatorState t) : ChainEffect : effs) x)
-> Eff
     (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
-> Eff (ChainEffect : effs) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeClientEffect
 ~> Eff (Reader (SimulatorState t) : ChainEffect : effs))
-> Eff (NodeClientEffect : effs)
   ~> Eff (Reader (SimulatorState t) : ChainEffect : effs)
forall (f :: * -> *) (g :: * -> *) (h :: * -> *)
       (effs :: [* -> *]).
(f ~> Eff (g : h : effs)) -> Eff (f : effs) ~> Eff (g : h : effs)
reinterpret2 (Params
-> Wallet
-> NodeClientEffect
   ~> Eff (Reader (SimulatorState t) : ChainEffect : effs)
forall t (effs :: [* -> *]).
(LastMember IO effs, Member ChainEffect effs,
 Member (Reader (SimulatorState t)) effs) =>
Params -> Wallet -> NodeClientEffect ~> Eff effs
handleNodeClient @t Params
params Wallet
wallet)

        -- handle 'ChainIndexQueryEffect'
        (Eff (NodeClientEffect : effs) x
 -> Eff (Reader (SimulatorState t) : ChainEffect : effs) x)
-> (Eff
      (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
    -> Eff (NodeClientEffect : effs) x)
-> Eff
     (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
-> Eff (Reader (SimulatorState t) : ChainEffect : effs) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet
-> Eff (LogMsg ChainIndexLog : NodeClientEffect : effs) x
-> Eff (NodeClientEffect : effs) x
makeTimedChainIndexEvent Wallet
wallet
        (Eff (LogMsg ChainIndexLog : NodeClientEffect : effs) x
 -> Eff (NodeClientEffect : effs) x)
-> (Eff
      (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
    -> Eff (LogMsg ChainIndexLog : NodeClientEffect : effs) x)
-> Eff
     (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
-> Eff (NodeClientEffect : effs) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reader (SimulatorState t)
 ~> Eff (LogMsg ChainIndexLog : NodeClientEffect : effs))
-> Eff
     (Reader (SimulatorState t)
        : LogMsg ChainIndexLog : NodeClientEffect : effs)
   ~> Eff (LogMsg ChainIndexLog : NodeClientEffect : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Reader (SimulatorState t) ~> Eff effs
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Reader env ~> Eff effs
Core.handleUserEnvReader @t @(SimulatorState t))
        (Eff
   (Reader (SimulatorState t)
      : LogMsg ChainIndexLog : NodeClientEffect : effs)
   x
 -> Eff (LogMsg ChainIndexLog : NodeClientEffect : effs) x)
-> (Eff
      (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
    -> Eff
         (Reader (SimulatorState t)
            : LogMsg ChainIndexLog : NodeClientEffect : effs)
         x)
-> Eff
     (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
-> Eff (LogMsg ChainIndexLog : NodeClientEffect : effs) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainIndexQueryEffect
 ~> Eff
      ('[Reader (SimulatorState t), LogMsg ChainIndexLog]
       :++: (NodeClientEffect : effs)))
-> Eff (ChainIndexQueryEffect : NodeClientEffect : effs)
   ~> Eff
        ('[Reader (SimulatorState t), LogMsg ChainIndexLog]
         :++: (NodeClientEffect : effs))
forall (gs :: [* -> *]) (f :: * -> *) (effs :: [* -> *]).
Weakens gs =>
(f ~> Eff (gs :++: effs)) -> Eff (f : effs) ~> Eff (gs :++: effs)
reinterpretN @'[Reader (SimulatorState t), LogMsg _] (forall (effs :: [* -> *]).
(LastMember IO effs, Member (Reader (SimulatorState t)) effs,
 Member (LogMsg ChainIndexLog) effs) =>
ChainIndexQueryEffect ~> Eff effs
forall t (effs :: [* -> *]).
(LastMember IO effs, Member (Reader (SimulatorState t)) effs,
 Member (LogMsg ChainIndexLog) effs) =>
ChainIndexQueryEffect ~> Eff effs
handleChainIndexEffect @t)

        -- handle 'WalletEffect'
        (Eff (ChainIndexQueryEffect : NodeClientEffect : effs) x
 -> Eff
      (Reader (SimulatorState t)
         : LogMsg ChainIndexLog : NodeClientEffect : effs)
      x)
-> (Eff
      (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
    -> Eff (ChainIndexQueryEffect : NodeClientEffect : effs) x)
-> Eff
     (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
-> Eff
     (Reader (SimulatorState t)
        : LogMsg ChainIndexLog : NodeClientEffect : effs)
     x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg TxBalanceMsg
 ~> Eff (ChainIndexQueryEffect : NodeClientEffect : effs))
-> Eff
     (LogMsg TxBalanceMsg
        : ChainIndexQueryEffect : NodeClientEffect : effs)
   ~> Eff (ChainIndexQueryEffect : NodeClientEffect : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((TxBalanceMsg -> PABMultiAgentMsg t)
-> LogMsg TxBalanceMsg
   ~> Eff (ChainIndexQueryEffect : NodeClientEffect : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog @_ @(PABMultiAgentMsg t) (Wallet -> TxBalanceMsg -> PABMultiAgentMsg t
forall t. Wallet -> TxBalanceMsg -> PABMultiAgentMsg t
WalletBalancingMsg Wallet
wallet))
        (Eff
   (LogMsg TxBalanceMsg
      : ChainIndexQueryEffect : NodeClientEffect : effs)
   x
 -> Eff (ChainIndexQueryEffect : NodeClientEffect : effs) x)
-> (Eff
      (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
    -> Eff
         (LogMsg TxBalanceMsg
            : ChainIndexQueryEffect : NodeClientEffect : effs)
         x)
-> Eff
     (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
-> Eff (ChainIndexQueryEffect : NodeClientEffect : effs) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Eff
   (Error WalletAPIError
      : LogMsg TxBalanceMsg : ChainIndexQueryEffect : NodeClientEffect
      : effs)
   x
 -> (WalletAPIError
     -> Eff
          (LogMsg TxBalanceMsg
             : ChainIndexQueryEffect : NodeClientEffect : effs)
          x)
 -> Eff
      (LogMsg TxBalanceMsg
         : ChainIndexQueryEffect : NodeClientEffect : effs)
      x)
-> (WalletAPIError
    -> Eff
         (LogMsg TxBalanceMsg
            : ChainIndexQueryEffect : NodeClientEffect : effs)
         x)
-> Eff
     (Error WalletAPIError
        : LogMsg TxBalanceMsg : ChainIndexQueryEffect : NodeClientEffect
        : effs)
     x
-> Eff
     (LogMsg TxBalanceMsg
        : ChainIndexQueryEffect : NodeClientEffect : effs)
     x
forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (effs :: [* -> *]) a.
Eff (Error WalletAPIError : effs) a
-> (WalletAPIError -> Eff effs a) -> Eff effs a
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> (e -> Eff effs a) -> Eff effs a
handleError @WAPI.WalletAPIError) (forall (effs :: [* -> *]) a.
Member (Error PABError) effs =>
PABError -> Eff effs a
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError @PABError (PABError
 -> Eff
      (LogMsg TxBalanceMsg
         : ChainIndexQueryEffect : NodeClientEffect : effs)
      x)
-> (WalletAPIError -> PABError)
-> WalletAPIError
-> Eff
     (LogMsg TxBalanceMsg
        : ChainIndexQueryEffect : NodeClientEffect : effs)
     x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletAPIError -> PABError
WalletError)
        (Eff
   (Error WalletAPIError
      : LogMsg TxBalanceMsg : ChainIndexQueryEffect : NodeClientEffect
      : effs)
   x
 -> Eff
      (LogMsg TxBalanceMsg
         : ChainIndexQueryEffect : NodeClientEffect : effs)
      x)
-> (Eff
      (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
    -> Eff
         (Error WalletAPIError
            : LogMsg TxBalanceMsg : ChainIndexQueryEffect : NodeClientEffect
            : effs)
         x)
-> Eff
     (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
-> Eff
     (LogMsg TxBalanceMsg
        : ChainIndexQueryEffect : NodeClientEffect : effs)
     x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reader (SimulatorState t)
 ~> Eff
      (Error WalletAPIError
         : LogMsg TxBalanceMsg : ChainIndexQueryEffect : NodeClientEffect
         : effs))
-> Eff
     (Reader (SimulatorState t)
        : Error WalletAPIError : LogMsg TxBalanceMsg
        : ChainIndexQueryEffect : NodeClientEffect : effs)
   ~> Eff
        (Error WalletAPIError
           : LogMsg TxBalanceMsg : ChainIndexQueryEffect : NodeClientEffect
           : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Reader (SimulatorState t) ~> Eff effs
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Reader env ~> Eff effs
Core.handleUserEnvReader @t @(SimulatorState t))
        (Eff
   (Reader (SimulatorState t)
      : Error WalletAPIError : LogMsg TxBalanceMsg
      : ChainIndexQueryEffect : NodeClientEffect : effs)
   x
 -> Eff
      (Error WalletAPIError
         : LogMsg TxBalanceMsg : ChainIndexQueryEffect : NodeClientEffect
         : effs)
      x)
-> (Eff
      (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
    -> Eff
         (Reader (SimulatorState t)
            : Error WalletAPIError : LogMsg TxBalanceMsg
            : ChainIndexQueryEffect : NodeClientEffect : effs)
         x)
-> Eff
     (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
-> Eff
     (Error WalletAPIError
        : LogMsg TxBalanceMsg : ChainIndexQueryEffect : NodeClientEffect
        : effs)
     x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State WalletState
 ~> Eff
      (Reader (SimulatorState t)
         : Error WalletAPIError : LogMsg TxBalanceMsg
         : ChainIndexQueryEffect : NodeClientEffect : effs))
-> Eff
     (State WalletState
        : Error WalletAPIError : LogMsg TxBalanceMsg
        : ChainIndexQueryEffect : NodeClientEffect : effs)
   ~> Eff
        (Reader (SimulatorState t)
           : Error WalletAPIError : LogMsg TxBalanceMsg
           : ChainIndexQueryEffect : NodeClientEffect : effs)
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret (Wallet
-> State WalletState
   ~> Eff
        (Reader (SimulatorState t)
           : Error WalletAPIError : LogMsg TxBalanceMsg
           : ChainIndexQueryEffect : NodeClientEffect : effs)
forall t (effs :: [* -> *]).
(LastMember IO effs, Member (Error PABError) effs,
 Member (Reader (SimulatorState t)) effs) =>
Wallet -> State WalletState ~> Eff effs
runWalletState @t Wallet
wallet)
        (Eff
   (State WalletState
      : Error WalletAPIError : LogMsg TxBalanceMsg
      : ChainIndexQueryEffect : NodeClientEffect : effs)
   x
 -> Eff
      (Reader (SimulatorState t)
         : Error WalletAPIError : LogMsg TxBalanceMsg
         : ChainIndexQueryEffect : NodeClientEffect : effs)
      x)
-> (Eff
      (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
    -> Eff
         (State WalletState
            : Error WalletAPIError : LogMsg TxBalanceMsg
            : ChainIndexQueryEffect : NodeClientEffect : effs)
         x)
-> Eff
     (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs) x
-> Eff
     (Reader (SimulatorState t)
        : Error WalletAPIError : LogMsg TxBalanceMsg
        : ChainIndexQueryEffect : NodeClientEffect : effs)
     x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WalletEffect
 ~> Eff
      ('[State WalletState, Error WalletAPIError, LogMsg TxBalanceMsg]
       :++: (ChainIndexQueryEffect : NodeClientEffect : effs)))
-> Eff
     (WalletEffect : ChainIndexQueryEffect : NodeClientEffect : effs)
   ~> Eff
        ('[State WalletState, Error WalletAPIError, LogMsg TxBalanceMsg]
         :++: (ChainIndexQueryEffect : NodeClientEffect : effs))
forall (gs :: [* -> *]) (f :: * -> *) (effs :: [* -> *]).
Weakens gs =>
(f ~> Eff (gs :++: effs)) -> Eff (f : effs) ~> Eff (gs :++: effs)
reinterpretN @'[State Wallet.WalletState, Error WAPI.WalletAPIError, LogMsg TxBalanceMsg] forall (effs :: [* -> *]).
(Member (Error WalletAPIError) effs, Member NodeClientEffect effs,
 Member ChainIndexQueryEffect effs, Member (State WalletState) effs,
 Member (LogMsg TxBalanceMsg) effs) =>
WalletEffect ~> Eff effs
WalletEffect
~> Eff
     ('[State WalletState, Error WalletAPIError, LogMsg TxBalanceMsg]
      :++: (ChainIndexQueryEffect : NodeClientEffect : effs))
Wallet.handleWallet

initialStateFromWallet :: Wallet -> AgentState t
initialStateFromWallet :: Wallet -> AgentState t
initialStateFromWallet = AgentState t
-> (WalletState -> AgentState t)
-> Maybe WalletState
-> AgentState t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> AgentState t
forall a. HasCallStack => [Char] -> a
error [Char]
"runWalletState") (MockWallet -> AgentState t
forall t. MockWallet -> AgentState t
initialAgentState (MockWallet -> AgentState t)
-> (WalletState -> MockWallet) -> WalletState -> AgentState t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletState -> MockWallet
Wallet._mockWallet) (Maybe WalletState -> AgentState t)
-> (Wallet -> Maybe WalletState) -> Wallet -> AgentState t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> Maybe WalletState
Wallet.emptyWalletState

-- | Handle the 'State WalletState' effect by reading from and writing
--   to a TVar in the 'SimulatorState'
runWalletState ::
    forall t effs.
    ( LastMember IO effs
    , Member (Error PABError) effs
    , Member (Reader (SimulatorState t)) effs
    )
    => Wallet
    -> State Wallet.WalletState
    ~> Eff effs
runWalletState :: Wallet -> State WalletState ~> Eff effs
runWalletState Wallet
wallet = \case
    State WalletState x
Get -> do
        SimulatorState{TVar (Map Wallet (AgentState t))
_agentStates :: TVar (Map Wallet (AgentState t))
_agentStates :: forall t. SimulatorState t -> TVar (Map Wallet (AgentState t))
_agentStates} <- forall (effs :: [* -> *]).
Member (Reader (SimulatorState t)) effs =>
Eff effs (SimulatorState t)
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask @(SimulatorState t)
        Maybe (AgentState t)
result <- IO (Maybe (AgentState t)) -> Eff effs (Maybe (AgentState t))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (AgentState t)) -> Eff effs (Maybe (AgentState t)))
-> IO (Maybe (AgentState t)) -> Eff effs (Maybe (AgentState t))
forall a b. (a -> b) -> a -> b
$ STM (Maybe (AgentState t)) -> IO (Maybe (AgentState t))
forall a. STM a -> IO a
STM.atomically (STM (Maybe (AgentState t)) -> IO (Maybe (AgentState t)))
-> STM (Maybe (AgentState t)) -> IO (Maybe (AgentState t))
forall a b. (a -> b) -> a -> b
$ do
            Map Wallet (AgentState t)
mp <- TVar (Map Wallet (AgentState t)) -> STM (Map Wallet (AgentState t))
forall a. TVar a -> STM a
STM.readTVar TVar (Map Wallet (AgentState t))
_agentStates
            Maybe (AgentState t) -> STM (Maybe (AgentState t))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (AgentState t) -> STM (Maybe (AgentState t)))
-> Maybe (AgentState t) -> STM (Maybe (AgentState t))
forall a b. (a -> b) -> a -> b
$ Wallet -> Map Wallet (AgentState t) -> Maybe (AgentState t)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Wallet
wallet Map Wallet (AgentState t)
mp
        case Maybe (AgentState t)
result of
            Maybe (AgentState t)
Nothing -> PABError -> Eff effs x
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (PABError -> Eff effs x) -> PABError -> Eff effs x
forall a b. (a -> b) -> a -> b
$ Wallet -> PABError
WalletNotFound Wallet
wallet
            Just AgentState t
s  -> WalletState -> Eff effs WalletState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AgentState t -> WalletState
forall t. AgentState t -> WalletState
_walletState AgentState t
s)
    Put WalletState
s -> do
        SimulatorState{TVar (Map Wallet (AgentState t))
_agentStates :: TVar (Map Wallet (AgentState t))
_agentStates :: forall t. SimulatorState t -> TVar (Map Wallet (AgentState t))
_agentStates} <- forall (effs :: [* -> *]).
Member (Reader (SimulatorState t)) effs =>
Eff effs (SimulatorState t)
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask @(SimulatorState t)
        IO () -> Eff effs ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff effs ()) -> IO () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Map Wallet (AgentState t)
mp <- TVar (Map Wallet (AgentState t)) -> STM (Map Wallet (AgentState t))
forall a. TVar a -> STM a
STM.readTVar TVar (Map Wallet (AgentState t))
_agentStates
            case Wallet -> Map Wallet (AgentState t) -> Maybe (AgentState t)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Wallet
wallet Map Wallet (AgentState t)
mp of
                Maybe (AgentState t)
Nothing -> do
                    let ws :: AgentState Any
ws = AgentState Any
-> (WalletState -> AgentState Any)
-> Maybe WalletState
-> AgentState Any
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> AgentState Any
forall a. HasCallStack => [Char] -> a
error [Char]
"runWalletState") (MockWallet -> AgentState Any
forall t. MockWallet -> AgentState t
initialAgentState (MockWallet -> AgentState Any)
-> (WalletState -> MockWallet) -> WalletState -> AgentState Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletState -> MockWallet
Wallet._mockWallet) (Wallet -> Maybe WalletState
Wallet.emptyWalletState Wallet
wallet)
                        newState :: AgentState t
newState = AgentState Any
ws AgentState Any -> (AgentState Any -> AgentState t) -> AgentState t
forall a b. a -> (a -> b) -> b
& (WalletState -> Identity WalletState)
-> AgentState Any -> Identity (AgentState t)
forall t t.
Lens (AgentState t) (AgentState t) WalletState WalletState
walletState ((WalletState -> Identity WalletState)
 -> AgentState Any -> Identity (AgentState t))
-> WalletState -> AgentState Any -> AgentState t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WalletState
s
                    TVar (Map Wallet (AgentState t))
-> Map Wallet (AgentState t) -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar (Map Wallet (AgentState t))
_agentStates (Wallet
-> AgentState t
-> Map Wallet (AgentState t)
-> Map Wallet (AgentState t)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Wallet
wallet AgentState t
newState Map Wallet (AgentState t)
mp)
                Just AgentState t
s' -> do
                    let newState :: AgentState t
newState = AgentState t
s' AgentState t -> (AgentState t -> AgentState t) -> AgentState t
forall a b. a -> (a -> b) -> b
& (WalletState -> Identity WalletState)
-> AgentState t -> Identity (AgentState t)
forall t t.
Lens (AgentState t) (AgentState t) WalletState WalletState
walletState ((WalletState -> Identity WalletState)
 -> AgentState t -> Identity (AgentState t))
-> WalletState -> AgentState t -> AgentState t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WalletState
s
                    TVar (Map Wallet (AgentState t))
-> Map Wallet (AgentState t) -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar (Map Wallet (AgentState t))
_agentStates (Wallet
-> AgentState t
-> Map Wallet (AgentState t)
-> Map Wallet (AgentState t)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Wallet
wallet AgentState t
newState Map Wallet (AgentState t)
mp)

-- | Start a new instance of a contract
activateContract :: forall t. Contract.PABContract t => Wallet -> Contract.ContractDef t -> Simulation t ContractInstanceId
activateContract :: Wallet -> ContractDef t -> Simulation t ContractInstanceId
activateContract = Wallet -> ContractDef t -> Simulation t ContractInstanceId
forall t env.
PABContract t =>
Wallet -> ContractDef t -> PABAction t env ContractInstanceId
Core.activateContract

-- | Call a named endpoint on a contract instance
callEndpointOnInstance :: forall a t. (JSON.ToJSON a) => ContractInstanceId -> String -> a -> Simulation t (Maybe NotificationError)
callEndpointOnInstance :: ContractInstanceId
-> [Char] -> a -> Simulation t (Maybe NotificationError)
callEndpointOnInstance = ContractInstanceId
-> [Char] -> a -> Simulation t (Maybe NotificationError)
forall t env a.
ToJSON a =>
ContractInstanceId
-> [Char] -> a -> PABAction t env (Maybe NotificationError)
Core.callEndpointOnInstance'

-- | Wait 1 slot length, then add a new block.
makeBlock ::
    forall t effs.
    ( LastMember IO effs
    , Member (Reader (SimulatorState t)) effs
    , Member (Reader BlockchainEnv) effs
    , Member (Reader Instances.InstancesState) effs
    , Member DelayEffect effs
    , Member TimeEffect effs
    )
    => Eff effs ()
makeBlock :: Eff effs ()
makeBlock = do
    BlockchainEnv
env <- forall (effs :: [* -> *]).
Member (Reader BlockchainEnv) effs =>
Eff effs BlockchainEnv
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask @BlockchainEnv
    let Params { pSlotConfig :: Params -> SlotConfig
pSlotConfig = SlotConfig { Integer
scSlotLength :: Integer
scSlotLength :: SlotConfig -> Integer
scSlotLength } } = BlockchainEnv -> Params
beParams BlockchainEnv
env
        makeTimedChainEvent :: Eff (LogMsg ChainEvent : effs) Slot -> Eff effs Slot
makeTimedChainEvent =
            (LogMsg (PABMultiAgentMsg t) ~> Eff effs)
-> Eff (LogMsg (PABMultiAgentMsg t) : effs) ~> Eff effs
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((SimulatorState t -> TQueue (LogMessage (PABMultiAgentMsg t)))
-> LogMsg (PABMultiAgentMsg t) ~> Eff effs
forall s1 s2 (effs :: [* -> *]).
(Member (Reader s2) effs, LastMember IO effs) =>
(s2 -> TQueue (LogMessage s1)) -> LogMsg s1 ~> Eff effs
logIntoTQueue @_ @(SimulatorState t) (Getting
  (TQueue (LogMessage (PABMultiAgentMsg t)))
  (SimulatorState t)
  (TQueue (LogMessage (PABMultiAgentMsg t)))
-> SimulatorState t -> TQueue (LogMessage (PABMultiAgentMsg t))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (TQueue (LogMessage (PABMultiAgentMsg t)))
  (SimulatorState t)
  (TQueue (LogMessage (PABMultiAgentMsg t)))
forall t.
Lens' (SimulatorState t) (TQueue (LogMessage (PABMultiAgentMsg t)))
logMessages))
            (Eff (LogMsg (PABMultiAgentMsg t) : effs) Slot -> Eff effs Slot)
-> (Eff (LogMsg ChainEvent : effs) Slot
    -> Eff (LogMsg (PABMultiAgentMsg t) : effs) Slot)
-> Eff (LogMsg ChainEvent : effs) Slot
-> Eff effs Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg EmulatorEvent ~> Eff (LogMsg (PABMultiAgentMsg t) : effs))
-> Eff (LogMsg EmulatorEvent : effs)
   ~> Eff (LogMsg (PABMultiAgentMsg t) : effs)
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret ((EmulatorEvent -> PABMultiAgentMsg t)
-> LogMsg EmulatorEvent ~> Eff (LogMsg (PABMultiAgentMsg t) : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog @_ @(PABMultiAgentMsg t) EmulatorEvent -> PABMultiAgentMsg t
forall t. EmulatorEvent -> PABMultiAgentMsg t
EmulatorMsg)
            (Eff (LogMsg EmulatorEvent : effs) Slot
 -> Eff (LogMsg (PABMultiAgentMsg t) : effs) Slot)
-> (Eff (LogMsg ChainEvent : effs) Slot
    -> Eff (LogMsg EmulatorEvent : effs) Slot)
-> Eff (LogMsg ChainEvent : effs) Slot
-> Eff (LogMsg (PABMultiAgentMsg t) : effs) Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg EmulatorEvent' ~> Eff (LogMsg EmulatorEvent : effs))
-> Eff (LogMsg EmulatorEvent' : effs)
   ~> Eff (LogMsg EmulatorEvent : effs)
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret (forall (effs :: [* -> *]).
(Member (LogMsg EmulatorEvent) effs, Member TimeEffect effs) =>
LogMsg EmulatorEvent' ~> Eff effs
forall e (effs :: [* -> *]).
(Member (LogMsg (EmulatorTimeEvent e)) effs,
 Member TimeEffect effs) =>
LogMsg e ~> Eff effs
Core.timed @EmulatorEvent')
            (Eff (LogMsg EmulatorEvent' : effs) Slot
 -> Eff (LogMsg EmulatorEvent : effs) Slot)
-> (Eff (LogMsg ChainEvent : effs) Slot
    -> Eff (LogMsg EmulatorEvent' : effs) Slot)
-> Eff (LogMsg ChainEvent : effs) Slot
-> Eff (LogMsg EmulatorEvent : effs) Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg ChainEvent ~> Eff (LogMsg EmulatorEvent' : effs))
-> Eff (LogMsg ChainEvent : effs)
   ~> Eff (LogMsg EmulatorEvent' : effs)
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret ((ChainEvent -> EmulatorEvent')
-> LogMsg ChainEvent ~> Eff (LogMsg EmulatorEvent' : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog ChainEvent -> EmulatorEvent'
ChainEvent)
        makeTimedChainIndexEvent :: Eff (LogMsg ChainIndexLog : LogMsg ChainEvent : effs) Slot
-> Eff (LogMsg ChainEvent : effs) Slot
makeTimedChainIndexEvent =
            (LogMsg (PABMultiAgentMsg t) ~> Eff (LogMsg ChainEvent : effs))
-> Eff (LogMsg (PABMultiAgentMsg t) : LogMsg ChainEvent : effs)
   ~> Eff (LogMsg ChainEvent : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((SimulatorState t -> TQueue (LogMessage (PABMultiAgentMsg t)))
-> LogMsg (PABMultiAgentMsg t) ~> Eff (LogMsg ChainEvent : effs)
forall s1 s2 (effs :: [* -> *]).
(Member (Reader s2) effs, LastMember IO effs) =>
(s2 -> TQueue (LogMessage s1)) -> LogMsg s1 ~> Eff effs
logIntoTQueue @_ @(SimulatorState t) (Getting
  (TQueue (LogMessage (PABMultiAgentMsg t)))
  (SimulatorState t)
  (TQueue (LogMessage (PABMultiAgentMsg t)))
-> SimulatorState t -> TQueue (LogMessage (PABMultiAgentMsg t))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (TQueue (LogMessage (PABMultiAgentMsg t)))
  (SimulatorState t)
  (TQueue (LogMessage (PABMultiAgentMsg t)))
forall t.
Lens' (SimulatorState t) (TQueue (LogMessage (PABMultiAgentMsg t)))
logMessages))
            (Eff (LogMsg (PABMultiAgentMsg t) : LogMsg ChainEvent : effs) Slot
 -> Eff (LogMsg ChainEvent : effs) Slot)
-> (Eff (LogMsg ChainIndexLog : LogMsg ChainEvent : effs) Slot
    -> Eff
         (LogMsg (PABMultiAgentMsg t) : LogMsg ChainEvent : effs) Slot)
-> Eff (LogMsg ChainIndexLog : LogMsg ChainEvent : effs) Slot
-> Eff (LogMsg ChainEvent : effs) Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg EmulatorEvent
 ~> Eff (LogMsg (PABMultiAgentMsg t) : LogMsg ChainEvent : effs))
-> Eff (LogMsg EmulatorEvent : LogMsg ChainEvent : effs)
   ~> Eff (LogMsg (PABMultiAgentMsg t) : LogMsg ChainEvent : effs)
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret ((EmulatorEvent -> PABMultiAgentMsg t)
-> LogMsg EmulatorEvent
   ~> Eff (LogMsg (PABMultiAgentMsg t) : LogMsg ChainEvent : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog @_ @(PABMultiAgentMsg t) EmulatorEvent -> PABMultiAgentMsg t
forall t. EmulatorEvent -> PABMultiAgentMsg t
EmulatorMsg)
            (Eff (LogMsg EmulatorEvent : LogMsg ChainEvent : effs) Slot
 -> Eff
      (LogMsg (PABMultiAgentMsg t) : LogMsg ChainEvent : effs) Slot)
-> (Eff (LogMsg ChainIndexLog : LogMsg ChainEvent : effs) Slot
    -> Eff (LogMsg EmulatorEvent : LogMsg ChainEvent : effs) Slot)
-> Eff (LogMsg ChainIndexLog : LogMsg ChainEvent : effs) Slot
-> Eff
     (LogMsg (PABMultiAgentMsg t) : LogMsg ChainEvent : effs) Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg EmulatorEvent'
 ~> Eff (LogMsg EmulatorEvent : LogMsg ChainEvent : effs))
-> Eff (LogMsg EmulatorEvent' : LogMsg ChainEvent : effs)
   ~> Eff (LogMsg EmulatorEvent : LogMsg ChainEvent : effs)
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret (forall (effs :: [* -> *]).
(Member (LogMsg EmulatorEvent) effs, Member TimeEffect effs) =>
LogMsg EmulatorEvent' ~> Eff effs
forall e (effs :: [* -> *]).
(Member (LogMsg (EmulatorTimeEvent e)) effs,
 Member TimeEffect effs) =>
LogMsg e ~> Eff effs
Core.timed @EmulatorEvent')
            (Eff (LogMsg EmulatorEvent' : LogMsg ChainEvent : effs) Slot
 -> Eff (LogMsg EmulatorEvent : LogMsg ChainEvent : effs) Slot)
-> (Eff (LogMsg ChainIndexLog : LogMsg ChainEvent : effs) Slot
    -> Eff (LogMsg EmulatorEvent' : LogMsg ChainEvent : effs) Slot)
-> Eff (LogMsg ChainIndexLog : LogMsg ChainEvent : effs) Slot
-> Eff (LogMsg EmulatorEvent : LogMsg ChainEvent : effs) Slot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg ChainIndexLog
 ~> Eff (LogMsg EmulatorEvent' : LogMsg ChainEvent : effs))
-> Eff (LogMsg ChainIndexLog : LogMsg ChainEvent : effs)
   ~> Eff (LogMsg EmulatorEvent' : LogMsg ChainEvent : effs)
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret ((ChainIndexLog -> EmulatorEvent')
-> LogMsg ChainIndexLog
   ~> Eff (LogMsg EmulatorEvent' : LogMsg ChainEvent : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog (Wallet -> ChainIndexLog -> EmulatorEvent'
ChainIndexEvent (Integer -> Wallet
knownWallet Integer
1)))
    Millisecond -> Eff effs ()
forall a (effs :: [* -> *]).
(TimeUnit a, Member DelayEffect effs) =>
a -> Eff effs ()
delayThread (Integer -> Millisecond
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
scSlotLength :: Millisecond)
    Eff effs Slot -> Eff effs ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
        (Eff effs Slot -> Eff effs ()) -> Eff effs Slot -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ Eff (LogMsg ChainEvent : effs) Slot -> Eff effs Slot
makeTimedChainEvent
        (Eff (LogMsg ChainEvent : effs) Slot -> Eff effs Slot)
-> Eff (LogMsg ChainEvent : effs) Slot -> Eff effs Slot
forall a b. (a -> b) -> a -> b
$ Eff (LogMsg ChainIndexLog : LogMsg ChainEvent : effs) Slot
-> Eff (LogMsg ChainEvent : effs) Slot
makeTimedChainIndexEvent
        (Eff (LogMsg ChainIndexLog : LogMsg ChainEvent : effs) Slot
 -> Eff (LogMsg ChainEvent : effs) Slot)
-> Eff (LogMsg ChainIndexLog : LogMsg ChainEvent : effs) Slot
-> Eff (LogMsg ChainEvent : effs) Slot
forall a b. (a -> b) -> a -> b
$ (ChainControlEffect
 ~> Eff (LogMsg ChainIndexLog : LogMsg ChainEvent : effs))
-> Eff
     (ChainControlEffect
        : LogMsg ChainIndexLog : LogMsg ChainEvent : effs)
   ~> Eff (LogMsg ChainIndexLog : LogMsg ChainEvent : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (forall (effs :: [* -> *]).
(LastMember IO effs, Member (Reader (SimulatorState t)) effs,
 Member (Reader BlockchainEnv) effs,
 Member (Reader InstancesState) effs,
 Member (LogMsg ChainEvent) effs,
 Member (LogMsg ChainIndexLog) effs) =>
ChainControlEffect ~> Eff effs
forall t (effs :: [* -> *]).
(LastMember IO effs, Member (Reader (SimulatorState t)) effs,
 Member (Reader BlockchainEnv) effs,
 Member (Reader InstancesState) effs,
 Member (LogMsg ChainEvent) effs,
 Member (LogMsg ChainIndexLog) effs) =>
ChainControlEffect ~> Eff effs
handleChainControl @t)
        (Eff
   (ChainControlEffect
      : LogMsg ChainIndexLog : LogMsg ChainEvent : effs)
   Slot
 -> Eff (LogMsg ChainIndexLog : LogMsg ChainEvent : effs) Slot)
-> Eff
     (ChainControlEffect
        : LogMsg ChainIndexLog : LogMsg ChainEvent : effs)
     Slot
-> Eff (LogMsg ChainIndexLog : LogMsg ChainEvent : effs) Slot
forall a b. (a -> b) -> a -> b
$ Eff
  (ChainControlEffect
     : LogMsg ChainIndexLog : LogMsg ChainEvent : effs)
  Block
forall (effs :: [* -> *]).
Member ChainControlEffect effs =>
Eff effs Block
Chain.processBlock Eff
  (ChainControlEffect
     : LogMsg ChainIndexLog : LogMsg ChainEvent : effs)
  Block
-> Eff
     (ChainControlEffect
        : LogMsg ChainIndexLog : LogMsg ChainEvent : effs)
     Slot
-> Eff
     (ChainControlEffect
        : LogMsg ChainIndexLog : LogMsg ChainEvent : effs)
     Slot
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Slot -> Slot)
-> Eff
     (ChainControlEffect
        : LogMsg ChainIndexLog : LogMsg ChainEvent : effs)
     Slot
forall (effs :: [* -> *]).
Member ChainControlEffect effs =>
(Slot -> Slot) -> Eff effs Slot
Chain.modifySlot Slot -> Slot
forall a. Enum a => a -> a
succ

-- | Get the current state of the contract instance.
instanceState :: forall t. Wallet -> ContractInstanceId -> Simulation t (Contract.State t)
instanceState :: Wallet -> ContractInstanceId -> Simulation t (State t)
instanceState = Wallet -> ContractInstanceId -> Simulation t (State t)
forall t env.
Wallet -> ContractInstanceId -> PABAction t env (State t)
Core.instanceState

-- | An STM transaction that returns the observable state of the contract instance.
observableState :: forall t. ContractInstanceId -> Simulation t (STM JSON.Value)
observableState :: ContractInstanceId -> Simulation t (STM Value)
observableState = ContractInstanceId -> Simulation t (STM Value)
forall t env. ContractInstanceId -> PABAction t env (STM Value)
Core.observableState

-- | Wait until the observable state of the instance matches a predicate.
waitForState :: forall t a. (JSON.Value -> Maybe a) -> ContractInstanceId -> Simulation t a
waitForState :: (Value -> Maybe a) -> ContractInstanceId -> Simulation t a
waitForState = (Value -> Maybe a) -> ContractInstanceId -> Simulation t a
forall t env a.
(Value -> Maybe a) -> ContractInstanceId -> PABAction t env a
Core.waitForState

waitForInstanceState ::
  forall t.
  (Instances.InstanceState -> STM (Maybe ContractActivityStatus)) ->
  ContractInstanceId ->
  Simulation t ContractActivityStatus
waitForInstanceState :: (InstanceState -> STM (Maybe ContractActivityStatus))
-> ContractInstanceId -> Simulation t ContractActivityStatus
waitForInstanceState = (InstanceState -> STM (Maybe ContractActivityStatus))
-> ContractInstanceId -> Simulation t ContractActivityStatus
forall t env.
(InstanceState -> STM (Maybe ContractActivityStatus))
-> ContractInstanceId -> PABAction t env ContractActivityStatus
Core.waitForInstanceState

waitForInstanceStateWithResult :: forall t. ContractInstanceId -> Simulation t ContractActivityStatus
waitForInstanceStateWithResult :: ContractInstanceId -> Simulation t ContractActivityStatus
waitForInstanceStateWithResult = ContractInstanceId -> Simulation t ContractActivityStatus
forall t env.
ContractInstanceId -> PABAction t env ContractActivityStatus
Core.waitForInstanceStateWithResult

-- | The list of endpoints that are currently open
activeEndpoints :: forall t. ContractInstanceId -> Simulation t (STM [OpenEndpoint])
activeEndpoints :: ContractInstanceId -> Simulation t (STM [OpenEndpoint])
activeEndpoints = ContractInstanceId -> Simulation t (STM [OpenEndpoint])
forall t env.
ContractInstanceId -> PABAction t env (STM [OpenEndpoint])
Core.activeEndpoints

-- | The final result of the instance (waits until it is available)
finalResult :: forall t. ContractInstanceId -> Simulation t (STM (Maybe JSON.Value))
finalResult :: ContractInstanceId -> Simulation t (STM (Maybe Value))
finalResult = ContractInstanceId -> Simulation t (STM (Maybe Value))
forall t env.
ContractInstanceId -> PABAction t env (STM (Maybe Value))
Core.finalResult

-- | Wait until the contract is done, then return
--   the error (if any)
waitUntilFinished :: forall t. ContractInstanceId -> Simulation t (Maybe JSON.Value)
waitUntilFinished :: ContractInstanceId -> Simulation t (Maybe Value)
waitUntilFinished = ContractInstanceId -> Simulation t (Maybe Value)
forall t env. ContractInstanceId -> PABAction t env (Maybe Value)
Core.waitUntilFinished

-- | Wait until the status of the transaction changes
waitForTxStatusChange :: forall t. TxId -> Simulation t TxStatus
waitForTxStatusChange :: TxId -> Simulation t TxStatus
waitForTxStatusChange = TxId -> Simulation t TxStatus
forall t env. TxId -> PABAction t env TxStatus
Core.waitForTxStatusChange

-- | Wait until the status of the transaction changes
waitForTxOutStatusChange :: forall t. TxOutRef -> Simulation t TxOutStatus
waitForTxOutStatusChange :: TxOutRef -> Simulation t TxOutStatus
waitForTxOutStatusChange = TxOutRef -> Simulation t TxOutStatus
forall t env. TxOutRef -> PABAction t env TxOutStatus
Core.waitForTxOutStatusChange

-- | Wait until the endpoint becomes active.
waitForEndpoint :: forall t. ContractInstanceId -> String -> Simulation t ()
waitForEndpoint :: ContractInstanceId -> [Char] -> Simulation t ()
waitForEndpoint = ContractInstanceId -> [Char] -> Simulation t ()
forall t env. ContractInstanceId -> [Char] -> PABAction t env ()
Core.waitForEndpoint

currentSlot :: forall t. Simulation t (STM Slot)
currentSlot :: Simulation t (STM Slot)
currentSlot = Simulation t (STM Slot)
forall t env. PABAction t env (STM Slot)
Core.currentSlot

-- | Wait until the target slot number has been reached
waitUntilSlot :: forall t. Slot -> Simulation t ()
waitUntilSlot :: Slot -> Simulation t ()
waitUntilSlot = Slot -> Simulation t ()
forall t env. Slot -> PABAction t env ()
Core.waitUntilSlot

-- | Wait for the given number of slots.
waitNSlots :: forall t. Int -> Simulation t ()
waitNSlots :: Int -> Simulation t ()
waitNSlots = Int -> Simulation t ()
forall t env. Int -> PABAction t env ()
Core.waitNSlots

type Simulation t a = Core.PABAction t (SimulatorState t) a

runSimulationWith :: SimulatorEffectHandlers t -> Simulation t a -> IO (Either PABError a)
runSimulationWith :: SimulatorEffectHandlers t
-> Simulation t a -> IO (Either PABError a)
runSimulationWith = Timeout
-> Timeout
-> SimulatorEffectHandlers t
-> Simulation t a
-> IO (Either PABError a)
forall t env a.
Timeout
-> Timeout
-> EffectHandlers t env
-> PABAction t env a
-> IO (Either PABError a)
Core.runPAB Timeout
forall a. Default a => a
def Timeout
forall a. Default a => a
def

-- | Handle a 'LogMsg' effect in terms of a "larger" 'State' effect from which we have a setter.
logIntoTQueue ::
    forall s1 s2 effs.
    ( Member (Reader s2) effs
    , LastMember IO effs
    )
    => (s2 -> TQueue (LogMessage s1))
    -> LogMsg s1
    ~> Eff effs
logIntoTQueue :: (s2 -> TQueue (LogMessage s1)) -> LogMsg s1 ~> Eff effs
logIntoTQueue s2 -> TQueue (LogMessage s1)
f = \case
    LMessage LogMessage s1
w -> do
        TQueue (LogMessage s1)
tv <- (s2 -> TQueue (LogMessage s1)) -> Eff effs (TQueue (LogMessage s1))
forall r (effs :: [* -> *]) a.
Member (Reader r) effs =>
(r -> a) -> Eff effs a
asks s2 -> TQueue (LogMessage s1)
f
        IO () -> Eff effs ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff effs ()) -> IO () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TQueue (LogMessage s1) -> LogMessage s1 -> STM ()
forall a. TQueue a -> a -> STM ()
STM.writeTQueue TQueue (LogMessage s1)
tv LogMessage s1
w

handleChainControl ::
    forall t effs.
    ( LastMember IO effs
    , Member (Reader (SimulatorState t)) effs
    , Member (Reader BlockchainEnv) effs
    , Member (Reader Instances.InstancesState) effs
    , Member (LogMsg Chain.ChainEvent) effs
    , Member (LogMsg ChainIndexLog) effs
    )
    => ChainControlEffect
    ~> Eff effs
handleChainControl :: ChainControlEffect ~> Eff effs
handleChainControl ChainControlEffect x
eff = do
    BlockchainEnv
blockchainEnv <- forall (effs :: [* -> *]).
Member (Reader BlockchainEnv) effs =>
Eff effs BlockchainEnv
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask @BlockchainEnv
    let params :: Params
params = BlockchainEnv -> Params
beParams BlockchainEnv
blockchainEnv
    case ChainControlEffect x
eff of
        ChainControlEffect x
Chain.ProcessBlock -> do
            InstancesState
instancesState <- forall (effs :: [* -> *]).
Member (Reader InstancesState) effs =>
Eff effs InstancesState
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask @Instances.InstancesState
            (Block
txns, Slot
slot) <- Params
-> Eff (ChainEffect : ChainControlEffect : ChainEffs) (Block, Slot)
-> Eff effs (Block, Slot)
forall t a (effs :: [* -> *]).
(Member (Reader (SimulatorState t)) effs,
 Member (LogMsg ChainEvent) effs, LastMember IO effs) =>
Params
-> Eff (ChainEffect : ChainControlEffect : ChainEffs) a
-> Eff effs a
runChainEffects @t @_ Params
params ((,) (Block -> Slot -> (Block, Slot))
-> Eff (ChainEffect : ChainControlEffect : ChainEffs) Block
-> Eff
     (ChainEffect : ChainControlEffect : ChainEffs)
     (Slot -> (Block, Slot))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff (ChainEffect : ChainControlEffect : ChainEffs) Block
forall (effs :: [* -> *]).
Member ChainControlEffect effs =>
Eff effs Block
Chain.processBlock Eff
  (ChainEffect : ChainControlEffect : ChainEffs)
  (Slot -> (Block, Slot))
-> Eff (ChainEffect : ChainControlEffect : ChainEffs) Slot
-> Eff (ChainEffect : ChainControlEffect : ChainEffs) (Block, Slot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Eff (ChainEffect : ChainControlEffect : ChainEffs) Slot
forall (effs :: [* -> *]). Member ChainEffect effs => Eff effs Slot
Chain.getCurrentSlot)

            -- Adds a new tip on the chain index given the block and slot number
            forall t a (m :: * -> *) (effs :: [* -> *]).
(Member (Reader (SimulatorState t)) effs,
 Member (LogMsg ChainIndexLog) effs, LastMember m effs,
 MonadIO m) =>
Eff
  '[ChainIndexQueryEffect, ChainIndexControlEffect,
    State ChainIndexEmulatorState, LogMsg ChainIndexLog,
    Error ChainIndexError]
  a
-> Eff effs a
forall a (m :: * -> *) (effs :: [* -> *]).
(Member (Reader (SimulatorState t)) effs,
 Member (LogMsg ChainIndexLog) effs, LastMember m effs,
 MonadIO m) =>
Eff
  '[ChainIndexQueryEffect, ChainIndexControlEffect,
    State ChainIndexEmulatorState, LogMsg ChainIndexLog,
    Error ChainIndexError]
  a
-> Eff effs a
runChainIndexEffects @t (Eff
   '[ChainIndexQueryEffect, ChainIndexControlEffect,
     State ChainIndexEmulatorState, LogMsg ChainIndexLog,
     Error ChainIndexError]
   ()
 -> Eff effs ())
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     ()
-> Eff effs ()
forall a b. (a -> b) -> a -> b
$ do
              Tip
currentTip <- Eff
  '[ChainIndexQueryEffect, ChainIndexControlEffect,
    State ChainIndexEmulatorState, LogMsg ChainIndexLog,
    Error ChainIndexError]
  Tip
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
Eff effs Tip
getTip
              Tip
-> Block
-> Slot
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     ()
forall (effs :: [* -> *]).
Member ChainIndexControlEffect effs =>
Tip -> Block -> Slot -> Eff effs ()
appendNewTipBlock Tip
currentTip Block
txns Slot
slot

            Eff effs (Either SyncActionFailure (Slot, BlockNumber))
-> Eff effs ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff effs (Either SyncActionFailure (Slot, BlockNumber))
 -> Eff effs ())
-> Eff effs (Either SyncActionFailure (Slot, BlockNumber))
-> Eff effs ()
forall a b. (a -> b) -> a -> b
$ IO (Either SyncActionFailure (Slot, BlockNumber))
-> Eff effs (Either SyncActionFailure (Slot, BlockNumber))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (InstancesState
-> BlockchainEnv
-> Block
-> Slot
-> IO (STM (Either SyncActionFailure (Slot, BlockNumber)))
BlockchainEnv.processMockBlock InstancesState
instancesState BlockchainEnv
blockchainEnv Block
txns Slot
slot IO (STM (Either SyncActionFailure (Slot, BlockNumber)))
-> (STM (Either SyncActionFailure (Slot, BlockNumber))
    -> IO (Either SyncActionFailure (Slot, BlockNumber)))
-> IO (Either SyncActionFailure (Slot, BlockNumber))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM (Either SyncActionFailure (Slot, BlockNumber))
-> IO (Either SyncActionFailure (Slot, BlockNumber))
forall a. STM a -> IO a
STM.atomically)

            Block -> Eff effs Block
forall (f :: * -> *) a. Applicative f => a -> f a
pure Block
txns
        Chain.ModifySlot Slot -> Slot
f -> Params
-> Eff (ChainEffect : ChainControlEffect : ChainEffs) Slot
-> Eff effs Slot
forall t a (effs :: [* -> *]).
(Member (Reader (SimulatorState t)) effs,
 Member (LogMsg ChainEvent) effs, LastMember IO effs) =>
Params
-> Eff (ChainEffect : ChainControlEffect : ChainEffs) a
-> Eff effs a
runChainEffects @t @_ Params
params ((Slot -> Slot)
-> Eff (ChainEffect : ChainControlEffect : ChainEffs) Slot
forall (effs :: [* -> *]).
Member ChainControlEffect effs =>
(Slot -> Slot) -> Eff effs Slot
Chain.modifySlot Slot -> Slot
f)

runChainEffects ::
    forall t a effs.
    ( Member (Reader (SimulatorState t)) effs
    , Member (LogMsg Chain.ChainEvent) effs
    , LastMember IO effs
    )
    => Params
    -> Eff (Chain.ChainEffect ': Chain.ChainControlEffect ': Chain.ChainEffs) a
    -> Eff effs a
runChainEffects :: Params
-> Eff (ChainEffect : ChainControlEffect : ChainEffs) a
-> Eff effs a
runChainEffects Params
params Eff (ChainEffect : ChainControlEffect : ChainEffs) a
action = do
    SimulatorState{TVar ChainState
_chainState :: TVar ChainState
_chainState :: forall t. SimulatorState t -> TVar ChainState
_chainState} <- forall (effs :: [* -> *]).
Member (Reader (SimulatorState t)) effs =>
Eff effs (SimulatorState t)
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask @(SimulatorState t)
    (a
a, [LogMessage ChainEvent]
logs) <- IO (a, [LogMessage ChainEvent])
-> Eff effs (a, [LogMessage ChainEvent])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, [LogMessage ChainEvent])
 -> Eff effs (a, [LogMessage ChainEvent]))
-> IO (a, [LogMessage ChainEvent])
-> Eff effs (a, [LogMessage ChainEvent])
forall a b. (a -> b) -> a -> b
$ STM (a, [LogMessage ChainEvent]) -> IO (a, [LogMessage ChainEvent])
forall a. STM a -> IO a
STM.atomically (STM (a, [LogMessage ChainEvent])
 -> IO (a, [LogMessage ChainEvent]))
-> STM (a, [LogMessage ChainEvent])
-> IO (a, [LogMessage ChainEvent])
forall a b. (a -> b) -> a -> b
$ do
                        ChainState
oldState <- TVar ChainState -> STM ChainState
forall a. TVar a -> STM a
STM.readTVar TVar ChainState
_chainState
                        let ((a
a, ChainState
newState), [LogMessage ChainEvent]
logs) =
                                Eff '[] ((a, ChainState), [LogMessage ChainEvent])
-> ((a, ChainState), [LogMessage ChainEvent])
forall a. Eff '[] a -> a
run
                                (Eff '[] ((a, ChainState), [LogMessage ChainEvent])
 -> ((a, ChainState), [LogMessage ChainEvent]))
-> Eff '[] ((a, ChainState), [LogMessage ChainEvent])
-> ((a, ChainState), [LogMessage ChainEvent])
forall a b. (a -> b) -> a -> b
$ forall (effs :: [* -> *]) a.
Monoid [LogMessage ChainEvent] =>
Eff (Writer [LogMessage ChainEvent] : effs) a
-> Eff effs (a, [LogMessage ChainEvent])
forall w (effs :: [* -> *]) a.
Monoid w =>
Eff (Writer w : effs) a -> Eff effs (a, w)
runWriter @[LogMessage Chain.ChainEvent]
                                (Eff '[Writer [LogMessage ChainEvent]] (a, ChainState)
 -> Eff '[] ((a, ChainState), [LogMessage ChainEvent]))
-> Eff '[Writer [LogMessage ChainEvent]] (a, ChainState)
-> Eff '[] ((a, ChainState), [LogMessage ChainEvent])
forall a b. (a -> b) -> a -> b
$ (LogMsg ChainEvent ~> Eff '[Writer [LogMessage ChainEvent]])
-> Eff '[LogMsg ChainEvent]
   ~> Eff '[Writer [LogMessage ChainEvent]]
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret @(LogMsg Chain.ChainEvent) @(Writer [LogMessage Chain.ChainEvent]) (AReview [LogMessage ChainEvent] (LogMessage ChainEvent)
-> LogMsg ChainEvent ~> Eff '[Writer [LogMessage ChainEvent]]
forall a w (effs :: [* -> *]).
Member (Writer w) effs =>
AReview w (LogMessage a) -> LogMsg a ~> Eff effs
handleLogWriter (AReview [LogMessage ChainEvent] (LogMessage ChainEvent)
 -> LogMsg ChainEvent ~> Eff '[Writer [LogMessage ChainEvent]])
-> AReview [LogMessage ChainEvent] (LogMessage ChainEvent)
-> LogMsg ChainEvent ~> Eff '[Writer [LogMessage ChainEvent]]
forall a b. (a -> b) -> a -> b
$ (LogMessage ChainEvent -> [LogMessage ChainEvent])
-> AReview [LogMessage ChainEvent] (LogMessage ChainEvent)
forall (p :: * -> * -> *) (f :: * -> *) b t s a.
(Profunctor p, Bifunctor p, Functor f) =>
(b -> t) -> Optic p f s t a b
unto (LogMessage ChainEvent
-> [LogMessage ChainEvent] -> [LogMessage ChainEvent]
forall a. a -> [a] -> [a]
:[]))
                                (Eff '[LogMsg ChainEvent] (a, ChainState)
 -> Eff '[Writer [LogMessage ChainEvent]] (a, ChainState))
-> Eff '[LogMsg ChainEvent] (a, ChainState)
-> Eff '[Writer [LogMessage ChainEvent]] (a, ChainState)
forall a b. (a -> b) -> a -> b
$ ChainState
-> Eff ChainEffs a -> Eff '[LogMsg ChainEvent] (a, ChainState)
forall s (effs :: [* -> *]) a.
s -> Eff (State s : effs) a -> Eff effs (a, s)
runState ChainState
oldState
                                (Eff ChainEffs a -> Eff '[LogMsg ChainEvent] (a, ChainState))
-> Eff ChainEffs a -> Eff '[LogMsg ChainEvent] (a, ChainState)
forall a b. (a -> b) -> a -> b
$ (ChainControlEffect ~> Eff ChainEffs)
-> Eff (ChainControlEffect : ChainEffs) ~> Eff ChainEffs
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Params -> ChainControlEffect ~> Eff ChainEffs
forall (effs :: [* -> *]).
Members ChainEffs effs =>
Params -> ChainControlEffect ~> Eff effs
Chain.handleControlChain Params
params)
                                (Eff (ChainControlEffect : ChainEffs) a -> Eff ChainEffs a)
-> Eff (ChainControlEffect : ChainEffs) a -> Eff ChainEffs a
forall a b. (a -> b) -> a -> b
$ (ChainEffect ~> Eff (ChainControlEffect : ChainEffs))
-> Eff (ChainEffect : ChainControlEffect : ChainEffs) a
-> Eff (ChainControlEffect : ChainEffs) a
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Params -> ChainEffect ~> Eff (ChainControlEffect : ChainEffs)
forall (effs :: [* -> *]).
Members ChainEffs effs =>
Params -> ChainEffect ~> Eff effs
Chain.handleChain Params
params) Eff (ChainEffect : ChainControlEffect : ChainEffs) a
action
                        TVar ChainState -> ChainState -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar ChainState
_chainState ChainState
newState
                        (a, [LogMessage ChainEvent]) -> STM (a, [LogMessage ChainEvent])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, [LogMessage ChainEvent]
logs)
    (LogMessage ChainEvent -> Eff effs ())
-> [LogMessage ChainEvent] -> Eff effs ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (LogMsg ChainEvent () -> Eff effs ()
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send (LogMsg ChainEvent () -> Eff effs ())
-> (LogMessage ChainEvent -> LogMsg ChainEvent ())
-> LogMessage ChainEvent
-> Eff effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogMessage ChainEvent -> LogMsg ChainEvent ()
forall a. LogMessage a -> LogMsg a ()
LMessage) [LogMessage ChainEvent]
logs
    a -> Eff effs a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

runChainIndexEffects ::
    forall t a m effs.
    ( Member (Reader (SimulatorState t)) effs
    , Member (LogMsg ChainIndexLog) effs
    , LastMember m effs
    , MonadIO m
    )
    => Eff (ChainIndexQueryEffect ': ChainIndexControlEffect ': '[State ChainIndexEmulatorState, LogMsg ChainIndexLog, Error ChainIndexError]) a
    -> Eff effs a
runChainIndexEffects :: Eff
  '[ChainIndexQueryEffect, ChainIndexControlEffect,
    State ChainIndexEmulatorState, LogMsg ChainIndexLog,
    Error ChainIndexError]
  a
-> Eff effs a
runChainIndexEffects Eff
  '[ChainIndexQueryEffect, ChainIndexControlEffect,
    State ChainIndexEmulatorState, LogMsg ChainIndexLog,
    Error ChainIndexError]
  a
action = do
    SimulatorState{TVar ChainIndexEmulatorState
_chainIndex :: TVar ChainIndexEmulatorState
_chainIndex :: forall t. SimulatorState t -> TVar ChainIndexEmulatorState
_chainIndex} <- forall (effs :: [* -> *]).
Member (Reader (SimulatorState t)) effs =>
Eff effs (SimulatorState t)
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask @(SimulatorState t)
    (a
a, [LogMessage ChainIndexLog]
logs) <- IO (a, [LogMessage ChainIndexLog])
-> Eff effs (a, [LogMessage ChainIndexLog])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, [LogMessage ChainIndexLog])
 -> Eff effs (a, [LogMessage ChainIndexLog]))
-> IO (a, [LogMessage ChainIndexLog])
-> Eff effs (a, [LogMessage ChainIndexLog])
forall a b. (a -> b) -> a -> b
$ STM (a, [LogMessage ChainIndexLog])
-> IO (a, [LogMessage ChainIndexLog])
forall a. STM a -> IO a
STM.atomically (STM (a, [LogMessage ChainIndexLog])
 -> IO (a, [LogMessage ChainIndexLog]))
-> STM (a, [LogMessage ChainIndexLog])
-> IO (a, [LogMessage ChainIndexLog])
forall a b. (a -> b) -> a -> b
$ do
                    ChainIndexEmulatorState
oldState <- TVar ChainIndexEmulatorState -> STM ChainIndexEmulatorState
forall a. TVar a -> STM a
STM.readTVar TVar ChainIndexEmulatorState
_chainIndex
                    let resultE :: Either
  ChainIndexError
  ((a, ChainIndexEmulatorState), [LogMessage ChainIndexLog])
resultE =
                            Eff
  '[]
  (Either
     ChainIndexError
     ((a, ChainIndexEmulatorState), [LogMessage ChainIndexLog]))
-> Either
     ChainIndexError
     ((a, ChainIndexEmulatorState), [LogMessage ChainIndexLog])
forall a. Eff '[] a -> a
run
                            (Eff
   '[]
   (Either
      ChainIndexError
      ((a, ChainIndexEmulatorState), [LogMessage ChainIndexLog]))
 -> Either
      ChainIndexError
      ((a, ChainIndexEmulatorState), [LogMessage ChainIndexLog]))
-> Eff
     '[]
     (Either
        ChainIndexError
        ((a, ChainIndexEmulatorState), [LogMessage ChainIndexLog]))
-> Either
     ChainIndexError
     ((a, ChainIndexEmulatorState), [LogMessage ChainIndexLog])
forall a b. (a -> b) -> a -> b
$ Eff
  '[Error ChainIndexError]
  ((a, ChainIndexEmulatorState), [LogMessage ChainIndexLog])
-> Eff
     '[]
     (Either
        ChainIndexError
        ((a, ChainIndexEmulatorState), [LogMessage ChainIndexLog]))
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> Eff effs (Either e a)
runError
                            (Eff
   '[Error ChainIndexError]
   ((a, ChainIndexEmulatorState), [LogMessage ChainIndexLog])
 -> Eff
      '[]
      (Either
         ChainIndexError
         ((a, ChainIndexEmulatorState), [LogMessage ChainIndexLog])))
-> Eff
     '[Error ChainIndexError]
     ((a, ChainIndexEmulatorState), [LogMessage ChainIndexLog])
-> Eff
     '[]
     (Either
        ChainIndexError
        ((a, ChainIndexEmulatorState), [LogMessage ChainIndexLog]))
forall a b. (a -> b) -> a -> b
$ forall (effs :: [* -> *]) a.
Monoid [LogMessage ChainIndexLog] =>
Eff (Writer [LogMessage ChainIndexLog] : effs) a
-> Eff effs (a, [LogMessage ChainIndexLog])
forall w (effs :: [* -> *]) a.
Monoid w =>
Eff (Writer w : effs) a -> Eff effs (a, w)
runWriter @[LogMessage ChainIndexLog]
                            (Eff
   '[Writer [LogMessage ChainIndexLog], Error ChainIndexError]
   (a, ChainIndexEmulatorState)
 -> Eff
      '[Error ChainIndexError]
      ((a, ChainIndexEmulatorState), [LogMessage ChainIndexLog]))
-> Eff
     '[Writer [LogMessage ChainIndexLog], Error ChainIndexError]
     (a, ChainIndexEmulatorState)
-> Eff
     '[Error ChainIndexError]
     ((a, ChainIndexEmulatorState), [LogMessage ChainIndexLog])
forall a b. (a -> b) -> a -> b
$ (LogMsg ChainIndexLog
 ~> Eff '[Writer [LogMessage ChainIndexLog], Error ChainIndexError])
-> Eff '[LogMsg ChainIndexLog, Error ChainIndexError]
   ~> Eff '[Writer [LogMessage ChainIndexLog], Error ChainIndexError]
forall (f :: * -> *) (g :: * -> *) (effs :: [* -> *]).
(f ~> Eff (g : effs)) -> Eff (f : effs) ~> Eff (g : effs)
reinterpret @(LogMsg ChainIndexLog) @(Writer [LogMessage ChainIndexLog]) (AReview [LogMessage ChainIndexLog] (LogMessage ChainIndexLog)
-> LogMsg ChainIndexLog
   ~> Eff '[Writer [LogMessage ChainIndexLog], Error ChainIndexError]
forall a w (effs :: [* -> *]).
Member (Writer w) effs =>
AReview w (LogMessage a) -> LogMsg a ~> Eff effs
handleLogWriter (AReview [LogMessage ChainIndexLog] (LogMessage ChainIndexLog)
 -> LogMsg ChainIndexLog
    ~> Eff '[Writer [LogMessage ChainIndexLog], Error ChainIndexError])
-> AReview [LogMessage ChainIndexLog] (LogMessage ChainIndexLog)
-> LogMsg ChainIndexLog
   ~> Eff '[Writer [LogMessage ChainIndexLog], Error ChainIndexError]
forall a b. (a -> b) -> a -> b
$ (LogMessage ChainIndexLog -> [LogMessage ChainIndexLog])
-> AReview [LogMessage ChainIndexLog] (LogMessage ChainIndexLog)
forall (p :: * -> * -> *) (f :: * -> *) b t s a.
(Profunctor p, Bifunctor p, Functor f) =>
(b -> t) -> Optic p f s t a b
unto (LogMessage ChainIndexLog
-> [LogMessage ChainIndexLog] -> [LogMessage ChainIndexLog]
forall a. a -> [a] -> [a]
:[]))
                            (Eff
   '[LogMsg ChainIndexLog, Error ChainIndexError]
   (a, ChainIndexEmulatorState)
 -> Eff
      '[Writer [LogMessage ChainIndexLog], Error ChainIndexError]
      (a, ChainIndexEmulatorState))
-> Eff
     '[LogMsg ChainIndexLog, Error ChainIndexError]
     (a, ChainIndexEmulatorState)
-> Eff
     '[Writer [LogMessage ChainIndexLog], Error ChainIndexError]
     (a, ChainIndexEmulatorState)
forall a b. (a -> b) -> a -> b
$ ChainIndexEmulatorState
-> Eff
     '[State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     a
-> Eff
     '[LogMsg ChainIndexLog, Error ChainIndexError]
     (a, ChainIndexEmulatorState)
forall s (effs :: [* -> *]) a.
s -> Eff (State s : effs) a -> Eff effs (a, s)
runState ChainIndexEmulatorState
oldState
                            (Eff
   '[State ChainIndexEmulatorState, LogMsg ChainIndexLog,
     Error ChainIndexError]
   a
 -> Eff
      '[LogMsg ChainIndexLog, Error ChainIndexError]
      (a, ChainIndexEmulatorState))
-> Eff
     '[State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     a
-> Eff
     '[LogMsg ChainIndexLog, Error ChainIndexError]
     (a, ChainIndexEmulatorState)
forall a b. (a -> b) -> a -> b
$ (ChainIndexControlEffect
 ~> Eff
      '[State ChainIndexEmulatorState, LogMsg ChainIndexLog,
        Error ChainIndexError])
-> Eff
     '[ChainIndexControlEffect, State ChainIndexEmulatorState,
       LogMsg ChainIndexLog, Error ChainIndexError]
   ~> Eff
        '[State ChainIndexEmulatorState, LogMsg ChainIndexLog,
          Error ChainIndexError]
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret forall (effs :: [* -> *]).
(Member (State ChainIndexEmulatorState) effs,
 Member (Error ChainIndexError) effs,
 Member (LogMsg ChainIndexLog) effs) =>
ChainIndexControlEffect ~> Eff effs
ChainIndexControlEffect
~> Eff
     '[State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
ChainIndex.handleControl
                            (Eff
   '[ChainIndexControlEffect, State ChainIndexEmulatorState,
     LogMsg ChainIndexLog, Error ChainIndexError]
   a
 -> Eff
      '[State ChainIndexEmulatorState, LogMsg ChainIndexLog,
        Error ChainIndexError]
      a)
-> Eff
     '[ChainIndexControlEffect, State ChainIndexEmulatorState,
       LogMsg ChainIndexLog, Error ChainIndexError]
     a
-> Eff
     '[State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     a
forall a b. (a -> b) -> a -> b
$ (ChainIndexQueryEffect
 ~> Eff
      '[ChainIndexControlEffect, State ChainIndexEmulatorState,
        LogMsg ChainIndexLog, Error ChainIndexError])
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     a
-> Eff
     '[ChainIndexControlEffect, State ChainIndexEmulatorState,
       LogMsg ChainIndexLog, Error ChainIndexError]
     a
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret forall (effs :: [* -> *]).
(Member (State ChainIndexEmulatorState) effs,
 Member (Error ChainIndexError) effs,
 Member (LogMsg ChainIndexLog) effs) =>
ChainIndexQueryEffect ~> Eff effs
ChainIndexQueryEffect
~> Eff
     '[ChainIndexControlEffect, State ChainIndexEmulatorState,
       LogMsg ChainIndexLog, Error ChainIndexError]
ChainIndex.handleQuery Eff
  '[ChainIndexQueryEffect, ChainIndexControlEffect,
    State ChainIndexEmulatorState, LogMsg ChainIndexLog,
    Error ChainIndexError]
  a
action
                    case Either
  ChainIndexError
  ((a, ChainIndexEmulatorState), [LogMessage ChainIndexLog])
resultE of
                      Left ChainIndexError
e -> [Char] -> STM (a, [LogMessage ChainIndexLog])
forall a. HasCallStack => [Char] -> a
error (ChainIndexError -> [Char]
forall a. Show a => a -> [Char]
show ChainIndexError
e)
                      Right ((a
a, ChainIndexEmulatorState
newState), [LogMessage ChainIndexLog]
logs) -> do
                        TVar ChainIndexEmulatorState -> ChainIndexEmulatorState -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar ChainIndexEmulatorState
_chainIndex ChainIndexEmulatorState
newState
                        (a, [LogMessage ChainIndexLog])
-> STM (a, [LogMessage ChainIndexLog])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, [LogMessage ChainIndexLog]
logs)
    (LogMessage ChainIndexLog -> Eff effs ())
-> [LogMessage ChainIndexLog] -> Eff effs ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (LogMsg ChainIndexLog () -> Eff effs ()
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send (LogMsg ChainIndexLog () -> Eff effs ())
-> (LogMessage ChainIndexLog -> LogMsg ChainIndexLog ())
-> LogMessage ChainIndexLog
-> Eff effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogMessage ChainIndexLog -> LogMsg ChainIndexLog ()
forall a. LogMessage a -> LogMsg a ()
LMessage) [LogMessage ChainIndexLog]
logs
    a -> Eff effs a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

-- | Handle the 'NodeClientEffect' using the 'SimulatorState'.
handleNodeClient ::
    forall t effs.
    ( LastMember IO effs
    , Member Chain.ChainEffect effs
    , Member (Reader (SimulatorState t)) effs
    )
    => Params
    -> Wallet
    -> NodeClientEffect
    ~> Eff effs
handleNodeClient :: Params -> Wallet -> NodeClientEffect ~> Eff effs
handleNodeClient Params
params Wallet
wallet = \case
    PublishTx CardanoTx
tx  -> do
        CardanoTx -> Eff effs ()
forall (effs :: [* -> *]).
Member ChainEffect effs =>
CardanoTx -> Eff effs ()
Chain.queueTx CardanoTx
tx
        SimulatorState{TVar (Map Wallet (AgentState t))
_agentStates :: TVar (Map Wallet (AgentState t))
_agentStates :: forall t. SimulatorState t -> TVar (Map Wallet (AgentState t))
_agentStates} <- forall (effs :: [* -> *]).
Member (Reader (SimulatorState t)) effs =>
Eff effs (SimulatorState t)
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask @(SimulatorState t)
        IO () -> Eff effs ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff effs ()) -> IO () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Map Wallet (AgentState t)
mp <- TVar (Map Wallet (AgentState t)) -> STM (Map Wallet (AgentState t))
forall a. TVar a -> STM a
STM.readTVar TVar (Map Wallet (AgentState t))
_agentStates
            case Wallet -> Map Wallet (AgentState t) -> Maybe (AgentState t)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Wallet
wallet Map Wallet (AgentState t)
mp of
                Maybe (AgentState t)
Nothing -> do
                    let newState :: AgentState t
newState = Wallet -> AgentState Any
forall t. Wallet -> AgentState t
initialStateFromWallet Wallet
wallet AgentState Any -> (AgentState Any -> AgentState t) -> AgentState t
forall a b. a -> (a -> b) -> b
& (Map TxId Lovelace -> Identity (Map TxId Lovelace))
-> AgentState Any -> Identity (AgentState t)
forall t t.
Lens
  (AgentState t)
  (AgentState t)
  (Map TxId Lovelace)
  (Map TxId Lovelace)
submittedFees ((Map TxId Lovelace -> Identity (Map TxId Lovelace))
 -> AgentState Any -> Identity (AgentState t))
-> ((Maybe Lovelace -> Identity (Maybe Lovelace))
    -> Map TxId Lovelace -> Identity (Map TxId Lovelace))
-> (Maybe Lovelace -> Identity (Maybe Lovelace))
-> AgentState Any
-> Identity (AgentState t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map TxId Lovelace)
-> Lens' (Map TxId Lovelace) (Maybe (IxValue (Map TxId Lovelace)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (CardanoTx -> TxId
getCardanoTxId CardanoTx
tx) ((Maybe Lovelace -> Identity (Maybe Lovelace))
 -> AgentState Any -> Identity (AgentState t))
-> Lovelace -> AgentState Any -> AgentState t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CardanoTx -> Lovelace
getCardanoTxFee CardanoTx
tx
                    TVar (Map Wallet (AgentState t))
-> Map Wallet (AgentState t) -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar (Map Wallet (AgentState t))
_agentStates (Wallet
-> AgentState t
-> Map Wallet (AgentState t)
-> Map Wallet (AgentState t)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Wallet
wallet AgentState t
newState Map Wallet (AgentState t)
mp)
                Just AgentState t
s' -> do
                    let newState :: AgentState t
newState = AgentState t
s' AgentState t -> (AgentState t -> AgentState t) -> AgentState t
forall a b. a -> (a -> b) -> b
& (Map TxId Lovelace -> Identity (Map TxId Lovelace))
-> AgentState t -> Identity (AgentState t)
forall t t.
Lens
  (AgentState t)
  (AgentState t)
  (Map TxId Lovelace)
  (Map TxId Lovelace)
submittedFees ((Map TxId Lovelace -> Identity (Map TxId Lovelace))
 -> AgentState t -> Identity (AgentState t))
-> ((Maybe Lovelace -> Identity (Maybe Lovelace))
    -> Map TxId Lovelace -> Identity (Map TxId Lovelace))
-> (Maybe Lovelace -> Identity (Maybe Lovelace))
-> AgentState t
-> Identity (AgentState t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map TxId Lovelace)
-> Lens' (Map TxId Lovelace) (Maybe (IxValue (Map TxId Lovelace)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (CardanoTx -> TxId
getCardanoTxId CardanoTx
tx) ((Maybe Lovelace -> Identity (Maybe Lovelace))
 -> AgentState t -> Identity (AgentState t))
-> Lovelace -> AgentState t -> AgentState t
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ CardanoTx -> Lovelace
getCardanoTxFee CardanoTx
tx
                    TVar (Map Wallet (AgentState t))
-> Map Wallet (AgentState t) -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar (Map Wallet (AgentState t))
_agentStates (Wallet
-> AgentState t
-> Map Wallet (AgentState t)
-> Map Wallet (AgentState t)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Wallet
wallet AgentState t
newState Map Wallet (AgentState t)
mp)
    NodeClientEffect x
GetClientSlot -> Eff effs x
forall (effs :: [* -> *]). Member ChainEffect effs => Eff effs Slot
Chain.getCurrentSlot
    NodeClientEffect x
GetClientParams -> Params -> Eff effs Params
forall (f :: * -> *) a. Applicative f => a -> f a
pure Params
params

-- | Handle the 'Chain.ChainEffect' using the 'SimulatorState'.
handleChainEffect ::
    forall t effs.
    ( LastMember IO effs
    , Member (Reader (SimulatorState t)) effs
    , Member (LogMsg Chain.ChainEvent) effs
    )
    => Params
    -> Chain.ChainEffect
    ~> Eff effs
handleChainEffect :: Params -> ChainEffect ~> Eff effs
handleChainEffect Params
params = \case
    Chain.QueueTx CardanoTx
tx     -> Params
-> Eff (ChainEffect : ChainControlEffect : ChainEffs) ()
-> Eff effs ()
forall t a (effs :: [* -> *]).
(Member (Reader (SimulatorState t)) effs,
 Member (LogMsg ChainEvent) effs, LastMember IO effs) =>
Params
-> Eff (ChainEffect : ChainControlEffect : ChainEffs) a
-> Eff effs a
runChainEffects @t Params
params (Eff (ChainEffect : ChainControlEffect : ChainEffs) ()
 -> Eff effs ())
-> Eff (ChainEffect : ChainControlEffect : ChainEffs) ()
-> Eff effs ()
forall a b. (a -> b) -> a -> b
$ CardanoTx -> Eff (ChainEffect : ChainControlEffect : ChainEffs) ()
forall (effs :: [* -> *]).
Member ChainEffect effs =>
CardanoTx -> Eff effs ()
Chain.queueTx CardanoTx
tx
    ChainEffect x
Chain.GetCurrentSlot -> Params
-> Eff (ChainEffect : ChainControlEffect : ChainEffs) Slot
-> Eff effs Slot
forall t a (effs :: [* -> *]).
(Member (Reader (SimulatorState t)) effs,
 Member (LogMsg ChainEvent) effs, LastMember IO effs) =>
Params
-> Eff (ChainEffect : ChainControlEffect : ChainEffs) a
-> Eff effs a
runChainEffects @t Params
params Eff (ChainEffect : ChainControlEffect : ChainEffs) Slot
forall (effs :: [* -> *]). Member ChainEffect effs => Eff effs Slot
Chain.getCurrentSlot
    ChainEffect x
Chain.GetParams      -> Params -> Eff effs Params
forall (f :: * -> *) a. Applicative f => a -> f a
pure Params
params

handleChainIndexEffect ::
    forall t effs.
    ( LastMember IO effs
    , Member (Reader (SimulatorState t)) effs
    , Member (LogMsg ChainIndexLog) effs
    )
    => ChainIndexQueryEffect
    ~> Eff effs
handleChainIndexEffect :: ChainIndexQueryEffect ~> Eff effs
handleChainIndexEffect = forall t a (m :: * -> *) (effs :: [* -> *]).
(Member (Reader (SimulatorState t)) effs,
 Member (LogMsg ChainIndexLog) effs, LastMember m effs,
 MonadIO m) =>
Eff
  '[ChainIndexQueryEffect, ChainIndexControlEffect,
    State ChainIndexEmulatorState, LogMsg ChainIndexLog,
    Error ChainIndexError]
  a
-> Eff effs a
forall a (m :: * -> *) (effs :: [* -> *]).
(Member (Reader (SimulatorState t)) effs,
 Member (LogMsg ChainIndexLog) effs, LastMember m effs,
 MonadIO m) =>
Eff
  '[ChainIndexQueryEffect, ChainIndexControlEffect,
    State ChainIndexEmulatorState, LogMsg ChainIndexLog,
    Error ChainIndexError]
  a
-> Eff effs a
runChainIndexEffects @t (Eff
   '[ChainIndexQueryEffect, ChainIndexControlEffect,
     State ChainIndexEmulatorState, LogMsg ChainIndexLog,
     Error ChainIndexError]
   x
 -> Eff effs x)
-> (ChainIndexQueryEffect x
    -> Eff
         '[ChainIndexQueryEffect, ChainIndexControlEffect,
           State ChainIndexEmulatorState, LogMsg ChainIndexLog,
           Error ChainIndexError]
         x)
-> ChainIndexQueryEffect x
-> Eff effs x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    DatumFromHash DatumHash
h                  -> DatumHash
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     (Maybe Datum)
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
DatumHash -> Eff effs (Maybe Datum)
ChainIndex.datumFromHash DatumHash
h
    ValidatorFromHash ValidatorHash
h              -> ValidatorHash
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     (Maybe (Versioned Validator))
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
ValidatorHash -> Eff effs (Maybe (Versioned Validator))
ChainIndex.validatorFromHash ValidatorHash
h
    MintingPolicyFromHash MintingPolicyHash
h          -> MintingPolicyHash
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     (Maybe (Versioned MintingPolicy))
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
MintingPolicyHash -> Eff effs (Maybe (Versioned MintingPolicy))
ChainIndex.mintingPolicyFromHash MintingPolicyHash
h
    StakeValidatorFromHash StakeValidatorHash
h         -> StakeValidatorHash
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     (Maybe (Versioned StakeValidator))
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
StakeValidatorHash -> Eff effs (Maybe (Versioned StakeValidator))
ChainIndex.stakeValidatorFromHash StakeValidatorHash
h
    RedeemerFromHash RedeemerHash
h               -> RedeemerHash
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     (Maybe Redeemer)
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
RedeemerHash -> Eff effs (Maybe Redeemer)
ChainIndex.redeemerFromHash RedeemerHash
h
    TxOutFromRef TxOutRef
ref                 -> TxOutRef
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     (Maybe DecoratedTxOut)
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
TxOutRef -> Eff effs (Maybe DecoratedTxOut)
ChainIndex.txOutFromRef TxOutRef
ref
    TxFromTxId TxId
txid                  -> TxId
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     (Maybe ChainIndexTx)
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
TxId -> Eff effs (Maybe ChainIndexTx)
ChainIndex.txFromTxId TxId
txid
    UnspentTxOutFromRef TxOutRef
ref          -> TxOutRef
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     (Maybe DecoratedTxOut)
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
TxOutRef -> Eff effs (Maybe DecoratedTxOut)
ChainIndex.unspentTxOutFromRef TxOutRef
ref
    UtxoSetMembership TxOutRef
ref            -> TxOutRef
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     IsUtxoResponse
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
TxOutRef -> Eff effs IsUtxoResponse
ChainIndex.utxoSetMembership TxOutRef
ref
    UtxoSetAtAddress PageQuery TxOutRef
pq CardanoAddress
addr         -> PageQuery TxOutRef
-> CardanoAddress
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     UtxosResponse
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
PageQuery TxOutRef -> CardanoAddress -> Eff effs UtxosResponse
ChainIndex.utxoSetAtAddress PageQuery TxOutRef
pq CardanoAddress
addr
    UnspentTxOutSetAtAddress PageQuery TxOutRef
pq CardanoAddress
addr -> PageQuery TxOutRef
-> CardanoAddress
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     (QueryResponse [(TxOutRef, DecoratedTxOut)])
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
PageQuery TxOutRef
-> CardanoAddress
-> Eff effs (QueryResponse [(TxOutRef, DecoratedTxOut)])
ChainIndex.unspentTxOutSetAtAddress PageQuery TxOutRef
pq CardanoAddress
addr
    DatumsAtAddress PageQuery TxOutRef
pq CardanoAddress
addr          -> PageQuery TxOutRef
-> CardanoAddress
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     (QueryResponse [Datum])
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
PageQuery TxOutRef
-> CardanoAddress -> Eff effs (QueryResponse [Datum])
ChainIndex.datumsAtAddress PageQuery TxOutRef
pq CardanoAddress
addr
    UtxoSetWithCurrency PageQuery TxOutRef
pq AssetClass
ac        -> PageQuery TxOutRef
-> AssetClass
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     UtxosResponse
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
PageQuery TxOutRef -> AssetClass -> Eff effs UtxosResponse
ChainIndex.utxoSetWithCurrency PageQuery TxOutRef
pq AssetClass
ac
    TxoSetAtAddress PageQuery TxOutRef
pq CardanoAddress
addr          -> PageQuery TxOutRef
-> CardanoAddress
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     TxosResponse
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
PageQuery TxOutRef -> CardanoAddress -> Eff effs TxosResponse
ChainIndex.txoSetAtAddress PageQuery TxOutRef
pq CardanoAddress
addr
    TxsFromTxIds [TxId]
txids               -> [TxId]
-> Eff
     '[ChainIndexQueryEffect, ChainIndexControlEffect,
       State ChainIndexEmulatorState, LogMsg ChainIndexLog,
       Error ChainIndexError]
     [ChainIndexTx]
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
[TxId] -> Eff effs [ChainIndexTx]
ChainIndex.txsFromTxIds [TxId]
txids
    ChainIndexQueryEffect x
GetTip                           -> Eff
  '[ChainIndexQueryEffect, ChainIndexControlEffect,
    State ChainIndexEmulatorState, LogMsg ChainIndexLog,
    Error ChainIndexError]
  x
forall (effs :: [* -> *]).
Member ChainIndexQueryEffect effs =>
Eff effs Tip
ChainIndex.getTip

-- | Start a thread that prints log messages to the terminal when they come in.
printLogMessages ::
    forall t.
    Pretty t
    => TQueue (LogMessage t) -- ^ log messages
    -> IO ()
printLogMessages :: TQueue (LogMessage t) -> IO ()
printLogMessages TQueue (LogMessage t)
queue = IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    LogMessage t
msg <- STM (LogMessage t) -> IO (LogMessage t)
forall a. STM a -> IO a
STM.atomically (STM (LogMessage t) -> IO (LogMessage t))
-> STM (LogMessage t) -> IO (LogMessage t)
forall a b. (a -> b) -> a -> b
$ TQueue (LogMessage t) -> STM (LogMessage t)
forall a. TQueue a -> STM a
STM.readTQueue TQueue (LogMessage t)
queue
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LogMessage t
msg LogMessage t
-> Getting LogLevel (LogMessage t) LogLevel -> LogLevel
forall s a. s -> Getting a s a -> a
^. Getting LogLevel (LogMessage t) LogLevel
forall a. Lens' (LogMessage a) LogLevel
logLevel LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= LogLevel
Info) (Text -> IO ()
Text.putStrLn (LogMessage t -> Text
forall a. Pretty a => a -> Text
render LogMessage t
msg))

-- | Call 'makeBlock' forever.
advanceClock ::
    forall t effs.
    ( LastMember IO effs
    , Member (Reader (SimulatorState t)) effs
    , Member (Reader BlockchainEnv) effs
    , Member (Reader Instances.InstancesState) effs
    , Member DelayEffect effs
    , Member TimeEffect effs
    )
    => Eff effs ()
advanceClock :: Eff effs ()
advanceClock = Eff effs () -> Eff effs ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (forall (effs :: [* -> *]).
(LastMember IO effs, Member (Reader (SimulatorState t)) effs,
 Member (Reader BlockchainEnv) effs,
 Member (Reader InstancesState) effs, Member DelayEffect effs,
 Member TimeEffect effs) =>
Eff effs ()
forall t (effs :: [* -> *]).
(LastMember IO effs, Member (Reader (SimulatorState t)) effs,
 Member (Reader BlockchainEnv) effs,
 Member (Reader InstancesState) effs, Member DelayEffect effs,
 Member TimeEffect effs) =>
Eff effs ()
makeBlock @t)

-- | Handle the 'ContractStore' effect by writing the state to the
--   TVar in 'SimulatorState'
handleContractStore ::
    forall t effs.
    ( LastMember IO effs
    , Member (Reader (Core.PABEnvironment t (SimulatorState t))) effs
    , Member (Error PABError) effs
    )
    => ContractStore t
    ~> Eff effs
handleContractStore :: ContractStore t ~> Eff effs
handleContractStore = \case
    Contract.PutState ContractActivationArgs (ContractDef t)
definition ContractInstanceId
instanceId State t
state -> do
        TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
instancesTVar <- Getting
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
  (SimulatorState t)
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
-> SimulatorState t
-> TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
  (SimulatorState t)
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
forall t.
Lens'
  (SimulatorState t)
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
instances (SimulatorState t
 -> TVar
      (Map ContractInstanceId (SimulatorContractInstanceState t)))
-> Eff effs (SimulatorState t)
-> Eff
     effs
     (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Eff effs (SimulatorState t)
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Eff effs env
Core.askUserEnv @t @(SimulatorState t))
        IO () -> Eff effs ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff effs ()) -> IO () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            let instState :: SimulatorContractInstanceState t
instState = SimulatorContractInstanceState :: forall t.
ContractActivationArgs (ContractDef t)
-> State t -> SimulatorContractInstanceState t
SimulatorContractInstanceState{_contractDef :: ContractActivationArgs (ContractDef t)
_contractDef = ContractActivationArgs (ContractDef t)
definition, _contractState :: State t
_contractState = State t
state}
            TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
-> (Map ContractInstanceId (SimulatorContractInstanceState t)
    -> Map ContractInstanceId (SimulatorContractInstanceState t))
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
STM.modifyTVar TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
instancesTVar (ASetter
  (Map ContractInstanceId (SimulatorContractInstanceState t))
  (Map ContractInstanceId (SimulatorContractInstanceState t))
  (Maybe (SimulatorContractInstanceState t))
  (Maybe (SimulatorContractInstanceState t))
-> Maybe (SimulatorContractInstanceState t)
-> Map ContractInstanceId (SimulatorContractInstanceState t)
-> Map ContractInstanceId (SimulatorContractInstanceState t)
forall s t a b. ASetter s t a b -> b -> s -> t
set (Index (Map ContractInstanceId (SimulatorContractInstanceState t))
-> Lens'
     (Map ContractInstanceId (SimulatorContractInstanceState t))
     (Maybe
        (IxValue
           (Map ContractInstanceId (SimulatorContractInstanceState t))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map ContractInstanceId (SimulatorContractInstanceState t))
ContractInstanceId
instanceId) (SimulatorContractInstanceState t
-> Maybe (SimulatorContractInstanceState t)
forall a. a -> Maybe a
Just SimulatorContractInstanceState t
instState))
    Contract.GetState ContractInstanceId
instanceId -> do
        TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
instancesTVar <- Getting
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
  (SimulatorState t)
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
-> SimulatorState t
-> TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
  (SimulatorState t)
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
forall t.
Lens'
  (SimulatorState t)
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
instances (SimulatorState t
 -> TVar
      (Map ContractInstanceId (SimulatorContractInstanceState t)))
-> Eff effs (SimulatorState t)
-> Eff
     effs
     (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Eff effs (SimulatorState t)
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Eff effs env
Core.askUserEnv @t @(SimulatorState t))
        Maybe x
result <- Getting
  (First x)
  (Map ContractInstanceId (SimulatorContractInstanceState t))
  x
-> Map ContractInstanceId (SimulatorContractInstanceState t)
-> Maybe x
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Index (Map ContractInstanceId (SimulatorContractInstanceState t))
-> Lens'
     (Map ContractInstanceId (SimulatorContractInstanceState t))
     (Maybe
        (IxValue
           (Map ContractInstanceId (SimulatorContractInstanceState t))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map ContractInstanceId (SimulatorContractInstanceState t))
ContractInstanceId
instanceId ((Maybe (SimulatorContractInstanceState t)
  -> Const (First x) (Maybe (SimulatorContractInstanceState t)))
 -> Map ContractInstanceId (SimulatorContractInstanceState t)
 -> Const
      (First x)
      (Map ContractInstanceId (SimulatorContractInstanceState t)))
-> ((x -> Const (First x) x)
    -> Maybe (SimulatorContractInstanceState t)
    -> Const (First x) (Maybe (SimulatorContractInstanceState t)))
-> Getting
     (First x)
     (Map ContractInstanceId (SimulatorContractInstanceState t))
     x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimulatorContractInstanceState t
 -> Const (First x) (SimulatorContractInstanceState t))
-> Maybe (SimulatorContractInstanceState t)
-> Const (First x) (Maybe (SimulatorContractInstanceState t))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((SimulatorContractInstanceState t
  -> Const (First x) (SimulatorContractInstanceState t))
 -> Maybe (SimulatorContractInstanceState t)
 -> Const (First x) (Maybe (SimulatorContractInstanceState t)))
-> ((x -> Const (First x) x)
    -> SimulatorContractInstanceState t
    -> Const (First x) (SimulatorContractInstanceState t))
-> (x -> Const (First x) x)
-> Maybe (SimulatorContractInstanceState t)
-> Const (First x) (Maybe (SimulatorContractInstanceState t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> Const (First x) x)
-> SimulatorContractInstanceState t
-> Const (First x) (SimulatorContractInstanceState t)
forall t. Lens' (SimulatorContractInstanceState t) (State t)
contractState) (Map ContractInstanceId (SimulatorContractInstanceState t)
 -> Maybe x)
-> Eff
     effs (Map ContractInstanceId (SimulatorContractInstanceState t))
-> Eff effs (Maybe x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Map ContractInstanceId (SimulatorContractInstanceState t))
-> Eff
     effs (Map ContractInstanceId (SimulatorContractInstanceState t))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
-> IO (Map ContractInstanceId (SimulatorContractInstanceState t))
forall a. TVar a -> IO a
STM.readTVarIO TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
instancesTVar)
        case Maybe x
result of
            Just x
s  -> x -> Eff effs x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
s
            Maybe x
Nothing -> PABError -> Eff effs x
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (ContractInstanceId -> PABError
ContractInstanceNotFound ContractInstanceId
instanceId)
    Contract.GetContracts Maybe ContractActivityStatus
_ -> do
        TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
instancesTVar <- Getting
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
  (SimulatorState t)
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
-> SimulatorState t
-> TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
  (SimulatorState t)
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
forall t.
Lens'
  (SimulatorState t)
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
instances (SimulatorState t
 -> TVar
      (Map ContractInstanceId (SimulatorContractInstanceState t)))
-> Eff effs (SimulatorState t)
-> Eff
     effs
     (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Eff effs (SimulatorState t)
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Eff effs env
Core.askUserEnv @t @(SimulatorState t))
        (SimulatorContractInstanceState t
 -> ContractActivationArgs (ContractDef t))
-> Map ContractInstanceId (SimulatorContractInstanceState t)
-> Map ContractInstanceId (ContractActivationArgs (ContractDef t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SimulatorContractInstanceState t
-> ContractActivationArgs (ContractDef t)
forall t.
SimulatorContractInstanceState t
-> ContractActivationArgs (ContractDef t)
_contractDef (Map ContractInstanceId (SimulatorContractInstanceState t)
 -> Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
-> Eff
     effs (Map ContractInstanceId (SimulatorContractInstanceState t))
-> Eff
     effs
     (Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Map ContractInstanceId (SimulatorContractInstanceState t))
-> Eff
     effs (Map ContractInstanceId (SimulatorContractInstanceState t))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
-> IO (Map ContractInstanceId (SimulatorContractInstanceState t))
forall a. TVar a -> IO a
STM.readTVarIO TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
instancesTVar)
    Contract.PutStartInstance{} -> () -> Eff effs ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Contract.PutStopInstance{} -> () -> Eff effs ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Contract.DeleteState ContractInstanceId
i -> do
        TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
instancesTVar <- Getting
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
  (SimulatorState t)
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
-> SimulatorState t
-> TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
  (SimulatorState t)
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
forall t.
Lens'
  (SimulatorState t)
  (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
instances (SimulatorState t
 -> TVar
      (Map ContractInstanceId (SimulatorContractInstanceState t)))
-> Eff effs (SimulatorState t)
-> Eff
     effs
     (TVar (Map ContractInstanceId (SimulatorContractInstanceState t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Eff effs (SimulatorState t)
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Eff effs env
Core.askUserEnv @t @(SimulatorState t))
        Eff effs () -> Eff effs ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff effs () -> Eff effs ()) -> Eff effs () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ IO () -> Eff effs ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff effs ()) -> IO () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
-> (Map ContractInstanceId (SimulatorContractInstanceState t)
    -> Map ContractInstanceId (SimulatorContractInstanceState t))
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
STM.modifyTVar TVar (Map ContractInstanceId (SimulatorContractInstanceState t))
instancesTVar (ContractInstanceId
-> Map ContractInstanceId (SimulatorContractInstanceState t)
-> Map ContractInstanceId (SimulatorContractInstanceState t)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete ContractInstanceId
i)

render :: forall a. Pretty a => a -> Text
render :: a -> Text
render = SimpleDocStream Any -> Text
forall ann. SimpleDocStream ann -> Text
Render.renderStrict (SimpleDocStream Any -> Text)
-> (a -> SimpleDocStream Any) -> a -> 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)
-> (a -> Doc Any) -> a -> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty


-- | Statistics about the transactions that have been validated by the emulated
--   node.
data TxCounts =
    TxCounts
        { TxCounts -> Int
_txValidated :: Int
        -- ^ How many transactions were checked and added to the ledger
        , TxCounts -> Int
_txMemPool   :: Int
        -- ^ How many transactions remain in the mempool of the emulated node
        } deriving (TxCounts -> TxCounts -> Bool
(TxCounts -> TxCounts -> Bool)
-> (TxCounts -> TxCounts -> Bool) -> Eq TxCounts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxCounts -> TxCounts -> Bool
$c/= :: TxCounts -> TxCounts -> Bool
== :: TxCounts -> TxCounts -> Bool
$c== :: TxCounts -> TxCounts -> Bool
Eq, Eq TxCounts
Eq TxCounts
-> (TxCounts -> TxCounts -> Ordering)
-> (TxCounts -> TxCounts -> Bool)
-> (TxCounts -> TxCounts -> Bool)
-> (TxCounts -> TxCounts -> Bool)
-> (TxCounts -> TxCounts -> Bool)
-> (TxCounts -> TxCounts -> TxCounts)
-> (TxCounts -> TxCounts -> TxCounts)
-> Ord TxCounts
TxCounts -> TxCounts -> Bool
TxCounts -> TxCounts -> Ordering
TxCounts -> TxCounts -> TxCounts
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TxCounts -> TxCounts -> TxCounts
$cmin :: TxCounts -> TxCounts -> TxCounts
max :: TxCounts -> TxCounts -> TxCounts
$cmax :: TxCounts -> TxCounts -> TxCounts
>= :: TxCounts -> TxCounts -> Bool
$c>= :: TxCounts -> TxCounts -> Bool
> :: TxCounts -> TxCounts -> Bool
$c> :: TxCounts -> TxCounts -> Bool
<= :: TxCounts -> TxCounts -> Bool
$c<= :: TxCounts -> TxCounts -> Bool
< :: TxCounts -> TxCounts -> Bool
$c< :: TxCounts -> TxCounts -> Bool
compare :: TxCounts -> TxCounts -> Ordering
$ccompare :: TxCounts -> TxCounts -> Ordering
$cp1Ord :: Eq TxCounts
Ord, Int -> TxCounts -> ShowS
[TxCounts] -> ShowS
TxCounts -> [Char]
(Int -> TxCounts -> ShowS)
-> (TxCounts -> [Char]) -> ([TxCounts] -> ShowS) -> Show TxCounts
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TxCounts] -> ShowS
$cshowList :: [TxCounts] -> ShowS
show :: TxCounts -> [Char]
$cshow :: TxCounts -> [Char]
showsPrec :: Int -> TxCounts -> ShowS
$cshowsPrec :: Int -> TxCounts -> ShowS
Show)

makeLenses ''TxCounts

-- | Get the 'TxCounts' of the emulated blockchain
txCounts :: forall t. Simulation t TxCounts
txCounts :: Simulation t TxCounts
txCounts = Simulation t (STM TxCounts)
forall t. Simulation t (STM TxCounts)
txCountsSTM Simulation t (STM TxCounts)
-> (STM TxCounts -> Simulation t TxCounts) -> Simulation t TxCounts
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO TxCounts -> Simulation t TxCounts
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TxCounts -> Simulation t TxCounts)
-> (STM TxCounts -> IO TxCounts)
-> STM TxCounts
-> Simulation t TxCounts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM TxCounts -> IO TxCounts
forall a. STM a -> IO a
STM.atomically

-- | Get an STM transaction with the 'TxCounts' of the emulated blockchain
txCountsSTM :: forall t. Simulation t (STM TxCounts)
txCountsSTM :: Simulation t (STM TxCounts)
txCountsSTM = do
    SimulatorState{TVar ChainState
_chainState :: TVar ChainState
_chainState :: forall t. SimulatorState t -> TVar ChainState
_chainState} <- forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Eff effs (SimulatorState t)
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Eff effs env
Core.askUserEnv @t @(SimulatorState t)
    STM TxCounts -> Simulation t (STM TxCounts)
forall (m :: * -> *) a. Monad m => a -> m a
return (STM TxCounts -> Simulation t (STM TxCounts))
-> STM TxCounts -> Simulation t (STM TxCounts)
forall a b. (a -> b) -> a -> b
$ do
        Chain.ChainState{Blockchain
_chainNewestFirst :: ChainState -> Blockchain
_chainNewestFirst :: Blockchain
Chain._chainNewestFirst, TxPool
_txPool :: ChainState -> TxPool
_txPool :: TxPool
Chain._txPool} <- TVar ChainState -> STM ChainState
forall a. TVar a -> STM a
STM.readTVar TVar ChainState
_chainState
        TxCounts -> STM TxCounts
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (TxCounts -> STM TxCounts) -> TxCounts -> STM TxCounts
forall a b. (a -> b) -> a -> b
$ TxCounts :: Int -> Int -> TxCounts
TxCounts
                { _txValidated :: Int
_txValidated = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Block -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Block -> Int) -> Blockchain -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Blockchain
_chainNewestFirst)
                , _txMemPool :: Int
_txMemPool   = TxPool -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length TxPool
_txPool
                }

-- | Wait until at least the given number of valid transactions are on the simulated blockchain.
waitForValidatedTxCount :: forall t. Int -> Simulation t ()
waitForValidatedTxCount :: Int -> Simulation t ()
waitForValidatedTxCount Int
i = do
    STM TxCounts
counts <- Simulation t (STM TxCounts)
forall t. Simulation t (STM TxCounts)
txCountsSTM
    IO () -> Simulation t ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Simulation t ()) -> IO () -> Simulation t ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        TxCounts{Int
_txValidated :: Int
_txValidated :: TxCounts -> Int
_txValidated} <- STM TxCounts
counts
        Bool -> STM ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
_txValidated Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
i)

-- | The set of all active contracts.
activeContracts :: forall t. Simulation t (Set ContractInstanceId)
activeContracts :: Simulation t (Set ContractInstanceId)
activeContracts = Simulation t (Set ContractInstanceId)
forall t env. PABAction t env (Set ContractInstanceId)
Core.activeContracts

-- | The total value currently at an address
valueAtSTM :: forall t. CardanoAddress -> Simulation t (STM CardanoAPI.Value)
valueAtSTM :: CardanoAddress -> Simulation t (STM Value)
valueAtSTM CardanoAddress
address = do
    SimulatorState{TVar ChainState
_chainState :: TVar ChainState
_chainState :: forall t. SimulatorState t -> TVar ChainState
_chainState} <- forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Eff effs (SimulatorState t)
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Eff effs env
Core.askUserEnv @t @(SimulatorState t)
    STM Value -> Simulation t (STM Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (STM Value -> Simulation t (STM Value))
-> STM Value -> Simulation t (STM Value)
forall a b. (a -> b) -> a -> b
$ do
        Chain.ChainState{_index :: ChainState -> UtxoIndex
Chain._index=UtxoIndex
mp} <- TVar ChainState -> STM ChainState
forall a. TVar a -> STM a
STM.readTVar TVar ChainState
_chainState
        Value -> STM Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> STM Value) -> Value -> STM Value
forall a b. (a -> b) -> a -> b
$ (TxOut CtxUTxO BabbageEra -> Value)
-> [TxOut CtxUTxO BabbageEra] -> Value
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut CtxUTxO BabbageEra -> Value
forall ctx era. TxOut ctx era -> Value
cardanoTxOutValue ([TxOut CtxUTxO BabbageEra] -> Value)
-> [TxOut CtxUTxO BabbageEra] -> Value
forall a b. (a -> b) -> a -> b
$ (TxOut CtxUTxO BabbageEra -> Bool)
-> [TxOut CtxUTxO BabbageEra] -> [TxOut CtxUTxO BabbageEra]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(C.TxOut CardanoAddress
addr TxOutValue BabbageEra
_ TxOutDatum CtxUTxO BabbageEra
_ ReferenceScript BabbageEra
_) -> CardanoAddress
addr CardanoAddress -> CardanoAddress -> Bool
forall a. Eq a => a -> a -> Bool
== CardanoAddress
address) ([TxOut CtxUTxO BabbageEra] -> [TxOut CtxUTxO BabbageEra])
-> [TxOut CtxUTxO BabbageEra] -> [TxOut CtxUTxO BabbageEra]
forall a b. (a -> b) -> a -> b
$ ((TxIn, TxOut CtxUTxO BabbageEra) -> TxOut CtxUTxO BabbageEra)
-> [(TxIn, TxOut CtxUTxO BabbageEra)] -> [TxOut CtxUTxO BabbageEra]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxIn, TxOut CtxUTxO BabbageEra) -> TxOut CtxUTxO BabbageEra
forall a b. (a, b) -> b
snd ([(TxIn, TxOut CtxUTxO BabbageEra)] -> [TxOut CtxUTxO BabbageEra])
-> [(TxIn, TxOut CtxUTxO BabbageEra)] -> [TxOut CtxUTxO BabbageEra]
forall a b. (a -> b) -> a -> b
$ Map TxIn (TxOut CtxUTxO BabbageEra)
-> [(TxIn, TxOut CtxUTxO BabbageEra)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TxIn (TxOut CtxUTxO BabbageEra)
 -> [(TxIn, TxOut CtxUTxO BabbageEra)])
-> Map TxIn (TxOut CtxUTxO BabbageEra)
-> [(TxIn, TxOut CtxUTxO BabbageEra)]
forall a b. (a -> b) -> a -> b
$ UtxoIndex -> Map TxIn (TxOut CtxUTxO BabbageEra)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
C.unUTxO UtxoIndex
mp

-- | The total value currently at an address
valueAt :: forall t. CardanoAddress -> Simulation t CardanoAPI.Value
valueAt :: CardanoAddress -> Simulation t Value
valueAt CardanoAddress
address = do
    STM Value
stm <- CardanoAddress -> Simulation t (STM Value)
forall t. CardanoAddress -> Simulation t (STM Value)
valueAtSTM CardanoAddress
address
    IO Value -> Simulation t Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> Simulation t Value) -> IO Value -> Simulation t Value
forall a b. (a -> b) -> a -> b
$ STM Value -> IO Value
forall a. STM a -> IO a
STM.atomically STM Value
stm

-- | The fees paid by the wallet.
walletFees :: forall t. Wallet -> Simulation t CardanoAPI.Lovelace
walletFees :: Wallet -> Simulation t Lovelace
walletFees Wallet
wallet = Map TxId Lovelace -> Blockchain -> Lovelace
succeededFees (Map TxId Lovelace -> Blockchain -> Lovelace)
-> Eff (PABEffects t (SimulatorState t)) (Map TxId Lovelace)
-> Eff (PABEffects t (SimulatorState t)) (Blockchain -> Lovelace)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff (PABEffects t (SimulatorState t)) (Map TxId Lovelace)
walletSubmittedFees Eff (PABEffects t (SimulatorState t)) (Blockchain -> Lovelace)
-> Eff (PABEffects t (SimulatorState t)) Blockchain
-> Simulation t Lovelace
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Eff (PABEffects t (SimulatorState t)) Blockchain
forall t. Simulation t Blockchain
blockchain
    where
        succeededFees :: Map C.TxId CardanoAPI.Lovelace -> Blockchain -> CardanoAPI.Lovelace
        succeededFees :: Map TxId Lovelace -> Blockchain -> Lovelace
succeededFees Map TxId Lovelace
submitted = (Block -> Lovelace) -> Blockchain -> Lovelace
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Block -> Lovelace) -> Blockchain -> Lovelace)
-> ((OnChainTx -> Lovelace) -> Block -> Lovelace)
-> (OnChainTx -> Lovelace)
-> Blockchain
-> Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OnChainTx -> Lovelace) -> Block -> Lovelace
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((OnChainTx -> Lovelace) -> Blockchain -> Lovelace)
-> (OnChainTx -> Lovelace) -> Blockchain -> Lovelace
forall a b. (a -> b) -> a -> b
$ Maybe Lovelace -> Lovelace
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe Lovelace -> Lovelace)
-> (OnChainTx -> Maybe Lovelace) -> OnChainTx -> Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map TxId Lovelace
submitted Map TxId Lovelace -> TxId -> Maybe Lovelace
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!?) (TxId -> Maybe Lovelace)
-> (OnChainTx -> TxId) -> OnChainTx -> Maybe Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoTx -> TxId
getCardanoTxId (CardanoTx -> TxId)
-> (OnChainTx -> CardanoTx) -> OnChainTx -> TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnChainTx -> CardanoTx
unOnChain
        walletSubmittedFees :: Eff (PABEffects t (SimulatorState t)) (Map TxId Lovelace)
walletSubmittedFees = do
            SimulatorState{TVar (Map Wallet (AgentState t))
_agentStates :: TVar (Map Wallet (AgentState t))
_agentStates :: forall t. SimulatorState t -> TVar (Map Wallet (AgentState t))
_agentStates} <- forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Eff effs (SimulatorState t)
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Eff effs env
Core.askUserEnv @t @(SimulatorState t)
            Maybe (AgentState t)
result <- IO (Maybe (AgentState t))
-> Eff (PABEffects t (SimulatorState t)) (Maybe (AgentState t))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (AgentState t))
 -> Eff (PABEffects t (SimulatorState t)) (Maybe (AgentState t)))
-> IO (Maybe (AgentState t))
-> Eff (PABEffects t (SimulatorState t)) (Maybe (AgentState t))
forall a b. (a -> b) -> a -> b
$ STM (Maybe (AgentState t)) -> IO (Maybe (AgentState t))
forall a. STM a -> IO a
STM.atomically (STM (Maybe (AgentState t)) -> IO (Maybe (AgentState t)))
-> STM (Maybe (AgentState t)) -> IO (Maybe (AgentState t))
forall a b. (a -> b) -> a -> b
$ do
                Map Wallet (AgentState t)
mp <- TVar (Map Wallet (AgentState t)) -> STM (Map Wallet (AgentState t))
forall a. TVar a -> STM a
STM.readTVar TVar (Map Wallet (AgentState t))
_agentStates
                Maybe (AgentState t) -> STM (Maybe (AgentState t))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (AgentState t) -> STM (Maybe (AgentState t)))
-> Maybe (AgentState t) -> STM (Maybe (AgentState t))
forall a b. (a -> b) -> a -> b
$ Wallet -> Map Wallet (AgentState t) -> Maybe (AgentState t)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Wallet
wallet Map Wallet (AgentState t)
mp
            case Maybe (AgentState t)
result of
                Maybe (AgentState t)
Nothing -> PABError
-> Eff (PABEffects t (SimulatorState t)) (Map TxId Lovelace)
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (PABError
 -> Eff (PABEffects t (SimulatorState t)) (Map TxId Lovelace))
-> PABError
-> Eff (PABEffects t (SimulatorState t)) (Map TxId Lovelace)
forall a b. (a -> b) -> a -> b
$ Wallet -> PABError
WalletNotFound Wallet
wallet
                Just AgentState t
s  -> Map TxId Lovelace
-> Eff (PABEffects t (SimulatorState t)) (Map TxId Lovelace)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AgentState t -> Map TxId Lovelace
forall t. AgentState t -> Map TxId Lovelace
_submittedFees AgentState t
s)

-- | The entire chain (newest transactions first)
blockchain :: forall t. Simulation t Blockchain
blockchain :: Simulation t Blockchain
blockchain = do
    SimulatorState{TVar ChainState
_chainState :: TVar ChainState
_chainState :: forall t. SimulatorState t -> TVar ChainState
_chainState} <- forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Eff effs (SimulatorState t)
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Eff effs env
Core.askUserEnv @t @(SimulatorState t)
    Chain.ChainState{Blockchain
_chainNewestFirst :: Blockchain
_chainNewestFirst :: ChainState -> Blockchain
Chain._chainNewestFirst} <- IO ChainState -> Eff (PABEffects t (SimulatorState t)) ChainState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChainState -> Eff (PABEffects t (SimulatorState t)) ChainState)
-> IO ChainState
-> Eff (PABEffects t (SimulatorState t)) ChainState
forall a b. (a -> b) -> a -> b
$ TVar ChainState -> IO ChainState
forall a. TVar a -> IO a
STM.readTVarIO TVar ChainState
_chainState
    Blockchain -> Simulation t Blockchain
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blockchain
_chainNewestFirst

handleAgentThread ::
    forall t a.
    Wallet
    -> Maybe ContractInstanceId
    -> Eff (Core.ContractInstanceEffects t (SimulatorState t) '[IO]) a
    -> Simulation t a
handleAgentThread :: Wallet
-> Maybe ContractInstanceId
-> Eff (ContractInstanceEffects t (SimulatorState t) '[IO]) a
-> Simulation t a
handleAgentThread = Wallet
-> Maybe ContractInstanceId
-> Eff (ContractInstanceEffects t (SimulatorState t) '[IO]) a
-> Simulation t a
forall t env a.
Wallet
-> Maybe ContractInstanceId
-> Eff (ContractInstanceEffects t env '[IO]) a
-> PABAction t env a
Core.handleAgentThread

-- | Stop the instance.
stopInstance :: forall t. ContractInstanceId -> Simulation t ()
stopInstance :: ContractInstanceId -> Simulation t ()
stopInstance = ContractInstanceId -> Simulation t ()
forall t env. ContractInstanceId -> PABAction t env ()
Core.stopInstance

-- | The 'Activity' state of the instance
instanceActivity :: forall t. ContractInstanceId -> Simulation t Activity
instanceActivity :: ContractInstanceId -> Simulation t Activity
instanceActivity = ContractInstanceId -> Simulation t Activity
forall t env. ContractInstanceId -> PABAction t env Activity
Core.instanceActivity

-- | Create a new wallet with a random key, give it some funds
--   and add it to the list of simulated wallets.
addWallet :: forall t. Simulation t (Wallet, PaymentPubKeyHash)
addWallet :: Simulation t (Wallet, PaymentPubKeyHash)
addWallet = Maybe Ada -> Simulation t (Wallet, PaymentPubKeyHash)
forall t. Maybe Ada -> Simulation t (Wallet, PaymentPubKeyHash)
addWalletWith Maybe Ada
forall a. Maybe a
Nothing

-- | Create a new wallet with a random key, give it provided funds
--   and add it to the list of simulated wallets.
addWalletWith :: forall t. Maybe Ada.Ada -> Simulation t (Wallet, PaymentPubKeyHash)
addWalletWith :: Maybe Ada -> Simulation t (Wallet, PaymentPubKeyHash)
addWalletWith Maybe Ada
funds = do
    SimulatorState{TVar (Map Wallet (AgentState t))
_agentStates :: TVar (Map Wallet (AgentState t))
_agentStates :: forall t. SimulatorState t -> TVar (Map Wallet (AgentState t))
_agentStates} <- forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Eff effs (SimulatorState t)
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Eff effs env
Core.askUserEnv @t @(SimulatorState t)
    MockWallet
mockWallet <- Eff (PABEffects t (SimulatorState t)) MockWallet
forall (m :: * -> *) (effs :: [* -> *]).
(LastMember m effs, MonadIO m) =>
Eff effs MockWallet
MockWallet.newWallet
    Eff (PABEffects t (SimulatorState t)) ()
-> Eff (PABEffects t (SimulatorState t)) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff (PABEffects t (SimulatorState t)) ()
 -> Eff (PABEffects t (SimulatorState t)) ())
-> Eff (PABEffects t (SimulatorState t)) ()
-> Eff (PABEffects t (SimulatorState t)) ()
forall a b. (a -> b) -> a -> b
$ IO () -> Eff (PABEffects t (SimulatorState t)) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff (PABEffects t (SimulatorState t)) ())
-> IO () -> Eff (PABEffects t (SimulatorState t)) ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Map Wallet (AgentState t)
currentWallets <- TVar (Map Wallet (AgentState t)) -> STM (Map Wallet (AgentState t))
forall a. TVar a -> STM a
STM.readTVar TVar (Map Wallet (AgentState t))
_agentStates
        let newWallets :: Map Wallet (AgentState t)
newWallets = Map Wallet (AgentState t)
currentWallets Map Wallet (AgentState t)
-> (Map Wallet (AgentState t) -> Map Wallet (AgentState t))
-> Map Wallet (AgentState t)
forall a b. a -> (a -> b) -> b
& Index (Map Wallet (AgentState t))
-> Lens'
     (Map Wallet (AgentState t))
     (Maybe (IxValue (Map Wallet (AgentState t))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (MockWallet -> Wallet
Wallet.toMockWallet MockWallet
mockWallet) ((Maybe (AgentState t) -> Identity (Maybe (AgentState t)))
 -> Map Wallet (AgentState t)
 -> Identity (Map Wallet (AgentState t)))
-> AgentState t
-> Map Wallet (AgentState t)
-> Map Wallet (AgentState t)
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ WalletState -> Map TxId Lovelace -> AgentState t
forall t. WalletState -> Map TxId Lovelace -> AgentState t
AgentState (MockWallet -> WalletState
Wallet.fromMockWallet MockWallet
mockWallet) Map TxId Lovelace
forall a. Monoid a => a
mempty
        TVar (Map Wallet (AgentState t))
-> Map Wallet (AgentState t) -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar (Map Wallet (AgentState t))
_agentStates Map Wallet (AgentState t)
newWallets
    Instances.BlockchainEnv{Params
beParams :: Params
beParams :: BlockchainEnv -> Params
beParams} <- forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Eff effs BlockchainEnv
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Eff effs BlockchainEnv
Core.askBlockchainEnv @t @(SimulatorState t)
    CardanoTx
_ <- Wallet
-> Maybe ContractInstanceId
-> Eff
     (ContractInstanceEffects t (SimulatorState t) '[IO]) CardanoTx
-> Simulation t CardanoTx
forall t a.
Wallet
-> Maybe ContractInstanceId
-> Eff (ContractInstanceEffects t (SimulatorState t) '[IO]) a
-> Simulation t a
handleAgentThread (Integer -> Wallet
knownWallet Integer
2) Maybe ContractInstanceId
forall a. Maybe a
Nothing
            (Eff (ContractInstanceEffects t (SimulatorState t) '[IO]) CardanoTx
 -> Simulation t CardanoTx)
-> Eff
     (ContractInstanceEffects t (SimulatorState t) '[IO]) CardanoTx
-> Simulation t CardanoTx
forall a b. (a -> b) -> a -> b
$ (WalletAPIError -> PABError)
-> Eff
     (Error WalletAPIError
        : ContractInstanceEffects t (SimulatorState t) '[IO])
   ~> Eff (ContractInstanceEffects t (SimulatorState t) '[IO])
forall e f (effs :: [* -> *]).
Member (Error f) effs =>
(e -> f) -> Eff (Error e : effs) ~> Eff effs
Modify.wrapError WalletAPIError -> PABError
WalletError
            (Eff
   (Error WalletAPIError
      : ContractInstanceEffects t (SimulatorState t) '[IO])
   CardanoTx
 -> Eff
      (ContractInstanceEffects t (SimulatorState t) '[IO]) CardanoTx)
-> Eff
     (Error WalletAPIError
        : ContractInstanceEffects t (SimulatorState t) '[IO])
     CardanoTx
-> Eff
     (ContractInstanceEffects t (SimulatorState t) '[IO]) CardanoTx
forall a b. (a -> b) -> a -> b
$ Params
-> Maybe Ada
-> PaymentPubKeyHash
-> Eff
     (Error WalletAPIError
        : ContractInstanceEffects t (SimulatorState t) '[IO])
     CardanoTx
forall (effs :: [* -> *]).
(Member WalletEffect effs, Member (Error WalletAPIError) effs,
 Member (LogMsg Text) effs,
 Member (LogMsg RequestHandlerLogMsg) effs) =>
Params -> Maybe Ada -> PaymentPubKeyHash -> Eff effs CardanoTx
MockWallet.distributeNewWalletFunds Params
beParams Maybe Ada
funds (MockWallet -> PaymentPubKeyHash
CW.paymentPubKeyHash MockWallet
mockWallet)
    (Wallet, PaymentPubKeyHash)
-> Simulation t (Wallet, PaymentPubKeyHash)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MockWallet -> Wallet
Wallet.toMockWallet MockWallet
mockWallet, MockWallet -> PaymentPubKeyHash
CW.paymentPubKeyHash MockWallet
mockWallet)

-- | Retrieve the balances of all the entities in the simulator.
currentBalances :: forall t. Simulation t (Map.Map Wallet.Entity CardanoAPI.Value)
currentBalances :: Simulation t (Map Entity Value)
currentBalances = do
  SimulatorState{TVar ChainState
_chainState :: TVar ChainState
_chainState :: forall t. SimulatorState t -> TVar ChainState
_chainState, TVar (Map Wallet (AgentState t))
_agentStates :: TVar (Map Wallet (AgentState t))
_agentStates :: forall t. SimulatorState t -> TVar (Map Wallet (AgentState t))
_agentStates} <- forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Eff effs (SimulatorState t)
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Eff effs env
Core.askUserEnv @t @(SimulatorState t)
  IO (Map Entity Value) -> Simulation t (Map Entity Value)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map Entity Value) -> Simulation t (Map Entity Value))
-> IO (Map Entity Value) -> Simulation t (Map Entity Value)
forall a b. (a -> b) -> a -> b
$ STM (Map Entity Value) -> IO (Map Entity Value)
forall a. STM a -> IO a
STM.atomically (STM (Map Entity Value) -> IO (Map Entity Value))
-> STM (Map Entity Value) -> IO (Map Entity Value)
forall a b. (a -> b) -> a -> b
$ do
    Map Wallet (AgentState t)
currentWallets <- TVar (Map Wallet (AgentState t)) -> STM (Map Wallet (AgentState t))
forall a. TVar a -> STM a
STM.readTVar TVar (Map Wallet (AgentState t))
_agentStates
    ChainState
chainState <- TVar ChainState -> STM ChainState
forall a. TVar a -> STM a
STM.readTVar TVar ChainState
_chainState
    Map Entity Value -> STM (Map Entity Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Entity Value -> STM (Map Entity Value))
-> Map Entity Value -> STM (Map Entity Value)
forall a b. (a -> b) -> a -> b
$ ChainState -> WalletSet -> Map Entity Value
Wallet.balances ChainState
chainState (AgentState t -> WalletState
forall t. AgentState t -> WalletState
_walletState (AgentState t -> WalletState)
-> Map Wallet (AgentState t) -> WalletSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Wallet (AgentState t)
currentWallets)

-- | Write the 'balances' out to the log.
logBalances :: forall t effs. Member (LogMsg (PABMultiAgentMsg t)) effs
            => Map.Map Wallet.Entity Value
            -> Eff effs ()
logBalances :: Map Entity Value -> Eff effs ()
logBalances Map Entity Value
bs = 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
bs) (((Entity, Value) -> Eff effs ()) -> Eff effs ())
-> ((Entity, Value) -> Eff effs ()) -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ \(Entity
e, Value
v) -> do
        forall (effs :: [* -> *]).
Member (LogMsg (PABMultiAgentMsg t)) effs =>
[Char] -> Eff effs ()
forall t (effs :: [* -> *]).
Member (LogMsg (PABMultiAgentMsg t)) effs =>
[Char] -> Eff effs ()
logString @t ([Char] -> Eff effs ()) -> [Char] -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ Entity -> [Char]
forall a. Show a => a -> [Char]
show Entity
e [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
": "
        [(CurrencySymbol, TokenName, Integer)]
-> ((CurrencySymbol, TokenName, Integer) -> Eff effs ())
-> Eff effs ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Value -> [(CurrencySymbol, TokenName, Integer)]
flattenValue Value
v) (((CurrencySymbol, TokenName, Integer) -> Eff effs ())
 -> Eff effs ())
-> ((CurrencySymbol, TokenName, Integer) -> Eff effs ())
-> Eff effs ()
forall a b. (a -> b) -> a -> b
$ \(CurrencySymbol
cs, TokenName
tn, Integer
a) ->
            forall (effs :: [* -> *]).
Member (LogMsg (PABMultiAgentMsg t)) effs =>
[Char] -> Eff effs ()
forall t (effs :: [* -> *]).
Member (LogMsg (PABMultiAgentMsg t)) effs =>
[Char] -> Eff effs ()
logString @t ([Char] -> Eff effs ()) -> [Char] -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ [Char]
"    {" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> CurrencySymbol -> [Char]
forall a. Show a => a -> [Char]
show CurrencySymbol
cs [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
", " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> TokenName -> [Char]
forall a. Show a => a -> [Char]
show TokenName
tn [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"}: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
a

-- | Log some output to the console
logString :: forall t effs. Member (LogMsg (PABMultiAgentMsg t)) effs => String -> Eff effs ()
logString :: [Char] -> Eff effs ()
logString = forall (effs :: [* -> *]).
Member (LogMsg (PABMultiAgentMsg t)) effs =>
PABMultiAgentMsg t -> Eff effs ()
forall a (effs :: [* -> *]).
Member (LogMsg a) effs =>
a -> Eff effs ()
logInfo @(PABMultiAgentMsg t) (PABMultiAgentMsg t -> Eff effs ())
-> ([Char] -> PABMultiAgentMsg t) -> [Char] -> Eff effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> PABMultiAgentMsg t
forall t. Text -> PABMultiAgentMsg t
UserLog (Text -> PABMultiAgentMsg t)
-> ([Char] -> Text) -> [Char] -> PABMultiAgentMsg t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Text.pack

-- | Make a payment from one wallet to another
payToWallet :: forall t. Wallet -> Wallet -> Value -> Simulation t CardanoTx
payToWallet :: Wallet -> Wallet -> Value -> Simulation t CardanoTx
payToWallet Wallet
source Wallet
target = Wallet -> PaymentPubKeyHash -> Value -> Simulation t CardanoTx
forall t.
Wallet -> PaymentPubKeyHash -> Value -> Simulation t CardanoTx
payToPaymentPublicKeyHash Wallet
source (Wallet -> PaymentPubKeyHash
Emulator.mockWalletPaymentPubKeyHash Wallet
target)

-- | Make a payment from one wallet to a public key address
payToPaymentPublicKeyHash :: forall t.  Wallet -> PaymentPubKeyHash -> Value -> Simulation t CardanoTx
payToPaymentPublicKeyHash :: Wallet -> PaymentPubKeyHash -> Value -> Simulation t CardanoTx
payToPaymentPublicKeyHash Wallet
source PaymentPubKeyHash
target Value
amount = do
    Instances.BlockchainEnv{Params
beParams :: Params
beParams :: BlockchainEnv -> Params
beParams} <- forall (effs :: [* -> *]).
Member (Reader (PABEnvironment t (SimulatorState t))) effs =>
Eff effs BlockchainEnv
forall t env (effs :: [* -> *]).
Member (Reader (PABEnvironment t env)) effs =>
Eff effs BlockchainEnv
Core.askBlockchainEnv @t @(SimulatorState t)
    Wallet
-> Maybe ContractInstanceId
-> Eff
     (ContractInstanceEffects t (SimulatorState t) '[IO]) CardanoTx
-> Simulation t CardanoTx
forall t a.
Wallet
-> Maybe ContractInstanceId
-> Eff (ContractInstanceEffects t (SimulatorState t) '[IO]) a
-> Simulation t a
handleAgentThread Wallet
source Maybe ContractInstanceId
forall a. Maybe a
Nothing
        (Eff (ContractInstanceEffects t (SimulatorState t) '[IO]) CardanoTx
 -> Simulation t CardanoTx)
-> Eff
     (ContractInstanceEffects t (SimulatorState t) '[IO]) CardanoTx
-> Simulation t CardanoTx
forall a b. (a -> b) -> a -> b
$ (Eff
   (Error WalletAPIError
      : ContractInstanceEffects t (SimulatorState t) '[IO])
   CardanoTx
 -> (WalletAPIError
     -> Eff
          (ContractInstanceEffects t (SimulatorState t) '[IO]) CardanoTx)
 -> Eff
      (ContractInstanceEffects t (SimulatorState t) '[IO]) CardanoTx)
-> (WalletAPIError
    -> Eff
         (ContractInstanceEffects t (SimulatorState t) '[IO]) CardanoTx)
-> Eff
     (Error WalletAPIError
        : ContractInstanceEffects t (SimulatorState t) '[IO])
     CardanoTx
-> Eff
     (ContractInstanceEffects t (SimulatorState t) '[IO]) CardanoTx
forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (effs :: [* -> *]) a.
Eff (Error WalletAPIError : effs) a
-> (WalletAPIError -> Eff effs a) -> Eff effs a
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> (e -> Eff effs a) -> Eff effs a
handleError @WAPI.WalletAPIError) (PABError
-> Eff
     (ContractInstanceEffects t (SimulatorState t) '[IO]) CardanoTx
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (PABError
 -> Eff
      (ContractInstanceEffects t (SimulatorState t) '[IO]) CardanoTx)
-> (WalletAPIError -> PABError)
-> WalletAPIError
-> Eff
     (ContractInstanceEffects t (SimulatorState t) '[IO]) CardanoTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletAPIError -> PABError
WalletError)
        (Eff
   (Error WalletAPIError
      : ContractInstanceEffects t (SimulatorState t) '[IO])
   CardanoTx
 -> Eff
      (ContractInstanceEffects t (SimulatorState t) '[IO]) CardanoTx)
-> Eff
     (Error WalletAPIError
        : ContractInstanceEffects t (SimulatorState t) '[IO])
     CardanoTx
-> Eff
     (ContractInstanceEffects t (SimulatorState t) '[IO]) CardanoTx
forall a b. (a -> b) -> a -> b
$ Params
-> SlotRange
-> Value
-> PaymentPubKeyHash
-> Eff
     (Error WalletAPIError
        : ContractInstanceEffects t (SimulatorState t) '[IO])
     CardanoTx
forall (effs :: [* -> *]).
(Member WalletEffect effs, Member (Error WalletAPIError) effs,
 Member (LogMsg Text) effs,
 Member (LogMsg RequestHandlerLogMsg) effs) =>
Params
-> SlotRange -> Value -> PaymentPubKeyHash -> Eff effs CardanoTx
WAPI.payToPaymentPublicKeyHash Params
beParams SlotRange
WAPI.defaultSlotRange Value
amount PaymentPubKeyHash
target