{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-overlapping-patterns #-}
module Wallet.Emulator.MultiAgent where
import Control.Lens (AReview, Getter, Lens', Prism', anon, at, folded, makeLenses, prism', reversed, review, to, unto,
view, (&), (.~), (^.), (^..))
import Control.Monad (join)
import Control.Monad.Freer (Eff, Member, Members, interpret, send, subsume, type (~>))
import Control.Monad.Freer.Error (Error, throwError)
import Control.Monad.Freer.Extras.Log (LogMessage, LogMsg, LogObserve, handleObserveLog, mapLog)
import Control.Monad.Freer.Extras.Modify (handleZoomedState, raiseEnd, writeIntoState)
import Control.Monad.Freer.State (State, get)
import Data.Aeson (FromJSON, ToJSON)
import Data.Default (def)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import Data.Text qualified as T
import Data.Text.Extras (tshow)
import GHC.Generics (Generic)
import Prettyprinter (Pretty (pretty), colon, (<+>))
import Cardano.Node.Emulator.Chain qualified as Chain
import Cardano.Node.Emulator.Params (Params (..))
import Cardano.Node.Emulator.Validation qualified as Validation
import Data.Foldable (fold)
import Ledger hiding (to, value)
import Ledger.Ada qualified as Ada
import Ledger.AddressMap qualified as AM
import Ledger.CardanoWallet qualified as CW
import Ledger.Index qualified as Index
import Ledger.Tx.CardanoAPI (fromPlutusIndex, toCardanoTxOut)
import Ledger.Value qualified as Value
import Plutus.ChainIndex.Emulator qualified as ChainIndex
import Plutus.Contract.Error (AssertionError (GenericAssertion))
import Plutus.Trace.Emulator.Types (ContractInstanceLog, EmulatedWalletEffects, EmulatedWalletEffects', UserThreadMsg)
import Plutus.Trace.Scheduler qualified as Scheduler
import Plutus.V2.Ledger.Tx qualified as V2
import Wallet.API qualified as WAPI
import Wallet.Emulator.LogMessages (RequestHandlerLogMsg, TxBalanceMsg)
import Wallet.Emulator.NodeClient qualified as NC
import Wallet.Emulator.Wallet (Wallet)
import Wallet.Emulator.Wallet qualified as Wallet
data Assertion
= IsValidated CardanoTx
| OwnFundsEqual Wallet Value
data EmulatorTimeEvent e =
EmulatorTimeEvent
{ EmulatorTimeEvent e -> Slot
_eteEmulatorTime :: Slot
, EmulatorTimeEvent e -> e
_eteEvent :: e
}
deriving stock (EmulatorTimeEvent e -> EmulatorTimeEvent e -> Bool
(EmulatorTimeEvent e -> EmulatorTimeEvent e -> Bool)
-> (EmulatorTimeEvent e -> EmulatorTimeEvent e -> Bool)
-> Eq (EmulatorTimeEvent e)
forall e.
Eq e =>
EmulatorTimeEvent e -> EmulatorTimeEvent e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmulatorTimeEvent e -> EmulatorTimeEvent e -> Bool
$c/= :: forall e.
Eq e =>
EmulatorTimeEvent e -> EmulatorTimeEvent e -> Bool
== :: EmulatorTimeEvent e -> EmulatorTimeEvent e -> Bool
$c== :: forall e.
Eq e =>
EmulatorTimeEvent e -> EmulatorTimeEvent e -> Bool
Eq, Int -> EmulatorTimeEvent e -> ShowS
[EmulatorTimeEvent e] -> ShowS
EmulatorTimeEvent e -> String
(Int -> EmulatorTimeEvent e -> ShowS)
-> (EmulatorTimeEvent e -> String)
-> ([EmulatorTimeEvent e] -> ShowS)
-> Show (EmulatorTimeEvent e)
forall e. Show e => Int -> EmulatorTimeEvent e -> ShowS
forall e. Show e => [EmulatorTimeEvent e] -> ShowS
forall e. Show e => EmulatorTimeEvent e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmulatorTimeEvent e] -> ShowS
$cshowList :: forall e. Show e => [EmulatorTimeEvent e] -> ShowS
show :: EmulatorTimeEvent e -> String
$cshow :: forall e. Show e => EmulatorTimeEvent e -> String
showsPrec :: Int -> EmulatorTimeEvent e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> EmulatorTimeEvent e -> ShowS
Show, (forall x. EmulatorTimeEvent e -> Rep (EmulatorTimeEvent e) x)
-> (forall x. Rep (EmulatorTimeEvent e) x -> EmulatorTimeEvent e)
-> Generic (EmulatorTimeEvent e)
forall x. Rep (EmulatorTimeEvent e) x -> EmulatorTimeEvent e
forall x. EmulatorTimeEvent e -> Rep (EmulatorTimeEvent e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e x. Rep (EmulatorTimeEvent e) x -> EmulatorTimeEvent e
forall e x. EmulatorTimeEvent e -> Rep (EmulatorTimeEvent e) x
$cto :: forall e x. Rep (EmulatorTimeEvent e) x -> EmulatorTimeEvent e
$cfrom :: forall e x. EmulatorTimeEvent e -> Rep (EmulatorTimeEvent e) x
Generic, a -> EmulatorTimeEvent b -> EmulatorTimeEvent a
(a -> b) -> EmulatorTimeEvent a -> EmulatorTimeEvent b
(forall a b.
(a -> b) -> EmulatorTimeEvent a -> EmulatorTimeEvent b)
-> (forall a b. a -> EmulatorTimeEvent b -> EmulatorTimeEvent a)
-> Functor EmulatorTimeEvent
forall a b. a -> EmulatorTimeEvent b -> EmulatorTimeEvent a
forall a b. (a -> b) -> EmulatorTimeEvent a -> EmulatorTimeEvent b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> EmulatorTimeEvent b -> EmulatorTimeEvent a
$c<$ :: forall a b. a -> EmulatorTimeEvent b -> EmulatorTimeEvent a
fmap :: (a -> b) -> EmulatorTimeEvent a -> EmulatorTimeEvent b
$cfmap :: forall a b. (a -> b) -> EmulatorTimeEvent a -> EmulatorTimeEvent b
Functor, EmulatorTimeEvent a -> Bool
(a -> m) -> EmulatorTimeEvent a -> m
(a -> b -> b) -> b -> EmulatorTimeEvent a -> b
(forall m. Monoid m => EmulatorTimeEvent m -> m)
-> (forall m a. Monoid m => (a -> m) -> EmulatorTimeEvent a -> m)
-> (forall m a. Monoid m => (a -> m) -> EmulatorTimeEvent a -> m)
-> (forall a b. (a -> b -> b) -> b -> EmulatorTimeEvent a -> b)
-> (forall a b. (a -> b -> b) -> b -> EmulatorTimeEvent a -> b)
-> (forall b a. (b -> a -> b) -> b -> EmulatorTimeEvent a -> b)
-> (forall b a. (b -> a -> b) -> b -> EmulatorTimeEvent a -> b)
-> (forall a. (a -> a -> a) -> EmulatorTimeEvent a -> a)
-> (forall a. (a -> a -> a) -> EmulatorTimeEvent a -> a)
-> (forall a. EmulatorTimeEvent a -> [a])
-> (forall a. EmulatorTimeEvent a -> Bool)
-> (forall a. EmulatorTimeEvent a -> Int)
-> (forall a. Eq a => a -> EmulatorTimeEvent a -> Bool)
-> (forall a. Ord a => EmulatorTimeEvent a -> a)
-> (forall a. Ord a => EmulatorTimeEvent a -> a)
-> (forall a. Num a => EmulatorTimeEvent a -> a)
-> (forall a. Num a => EmulatorTimeEvent a -> a)
-> Foldable EmulatorTimeEvent
forall a. Eq a => a -> EmulatorTimeEvent a -> Bool
forall a. Num a => EmulatorTimeEvent a -> a
forall a. Ord a => EmulatorTimeEvent a -> a
forall m. Monoid m => EmulatorTimeEvent m -> m
forall a. EmulatorTimeEvent a -> Bool
forall a. EmulatorTimeEvent a -> Int
forall a. EmulatorTimeEvent a -> [a]
forall a. (a -> a -> a) -> EmulatorTimeEvent a -> a
forall m a. Monoid m => (a -> m) -> EmulatorTimeEvent a -> m
forall b a. (b -> a -> b) -> b -> EmulatorTimeEvent a -> b
forall a b. (a -> b -> b) -> b -> EmulatorTimeEvent a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: EmulatorTimeEvent a -> a
$cproduct :: forall a. Num a => EmulatorTimeEvent a -> a
sum :: EmulatorTimeEvent a -> a
$csum :: forall a. Num a => EmulatorTimeEvent a -> a
minimum :: EmulatorTimeEvent a -> a
$cminimum :: forall a. Ord a => EmulatorTimeEvent a -> a
maximum :: EmulatorTimeEvent a -> a
$cmaximum :: forall a. Ord a => EmulatorTimeEvent a -> a
elem :: a -> EmulatorTimeEvent a -> Bool
$celem :: forall a. Eq a => a -> EmulatorTimeEvent a -> Bool
length :: EmulatorTimeEvent a -> Int
$clength :: forall a. EmulatorTimeEvent a -> Int
null :: EmulatorTimeEvent a -> Bool
$cnull :: forall a. EmulatorTimeEvent a -> Bool
toList :: EmulatorTimeEvent a -> [a]
$ctoList :: forall a. EmulatorTimeEvent a -> [a]
foldl1 :: (a -> a -> a) -> EmulatorTimeEvent a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> EmulatorTimeEvent a -> a
foldr1 :: (a -> a -> a) -> EmulatorTimeEvent a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> EmulatorTimeEvent a -> a
foldl' :: (b -> a -> b) -> b -> EmulatorTimeEvent a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> EmulatorTimeEvent a -> b
foldl :: (b -> a -> b) -> b -> EmulatorTimeEvent a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> EmulatorTimeEvent a -> b
foldr' :: (a -> b -> b) -> b -> EmulatorTimeEvent a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> EmulatorTimeEvent a -> b
foldr :: (a -> b -> b) -> b -> EmulatorTimeEvent a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> EmulatorTimeEvent a -> b
foldMap' :: (a -> m) -> EmulatorTimeEvent a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> EmulatorTimeEvent a -> m
foldMap :: (a -> m) -> EmulatorTimeEvent a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> EmulatorTimeEvent a -> m
fold :: EmulatorTimeEvent m -> m
$cfold :: forall m. Monoid m => EmulatorTimeEvent m -> m
Foldable, Functor EmulatorTimeEvent
Foldable EmulatorTimeEvent
Functor EmulatorTimeEvent
-> Foldable EmulatorTimeEvent
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EmulatorTimeEvent a -> f (EmulatorTimeEvent b))
-> (forall (f :: * -> *) a.
Applicative f =>
EmulatorTimeEvent (f a) -> f (EmulatorTimeEvent a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EmulatorTimeEvent a -> m (EmulatorTimeEvent b))
-> (forall (m :: * -> *) a.
Monad m =>
EmulatorTimeEvent (m a) -> m (EmulatorTimeEvent a))
-> Traversable EmulatorTimeEvent
(a -> f b) -> EmulatorTimeEvent a -> f (EmulatorTimeEvent b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
EmulatorTimeEvent (m a) -> m (EmulatorTimeEvent a)
forall (f :: * -> *) a.
Applicative f =>
EmulatorTimeEvent (f a) -> f (EmulatorTimeEvent a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EmulatorTimeEvent a -> m (EmulatorTimeEvent b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EmulatorTimeEvent a -> f (EmulatorTimeEvent b)
sequence :: EmulatorTimeEvent (m a) -> m (EmulatorTimeEvent a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
EmulatorTimeEvent (m a) -> m (EmulatorTimeEvent a)
mapM :: (a -> m b) -> EmulatorTimeEvent a -> m (EmulatorTimeEvent b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> EmulatorTimeEvent a -> m (EmulatorTimeEvent b)
sequenceA :: EmulatorTimeEvent (f a) -> f (EmulatorTimeEvent a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
EmulatorTimeEvent (f a) -> f (EmulatorTimeEvent a)
traverse :: (a -> f b) -> EmulatorTimeEvent a -> f (EmulatorTimeEvent b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> EmulatorTimeEvent a -> f (EmulatorTimeEvent b)
$cp2Traversable :: Foldable EmulatorTimeEvent
$cp1Traversable :: Functor EmulatorTimeEvent
Traversable)
deriving anyclass ([EmulatorTimeEvent e] -> Encoding
[EmulatorTimeEvent e] -> Value
EmulatorTimeEvent e -> Encoding
EmulatorTimeEvent e -> Value
(EmulatorTimeEvent e -> Value)
-> (EmulatorTimeEvent e -> Encoding)
-> ([EmulatorTimeEvent e] -> Value)
-> ([EmulatorTimeEvent e] -> Encoding)
-> ToJSON (EmulatorTimeEvent e)
forall e. ToJSON e => [EmulatorTimeEvent e] -> Encoding
forall e. ToJSON e => [EmulatorTimeEvent e] -> Value
forall e. ToJSON e => EmulatorTimeEvent e -> Encoding
forall e. ToJSON e => EmulatorTimeEvent e -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EmulatorTimeEvent e] -> Encoding
$ctoEncodingList :: forall e. ToJSON e => [EmulatorTimeEvent e] -> Encoding
toJSONList :: [EmulatorTimeEvent e] -> Value
$ctoJSONList :: forall e. ToJSON e => [EmulatorTimeEvent e] -> Value
toEncoding :: EmulatorTimeEvent e -> Encoding
$ctoEncoding :: forall e. ToJSON e => EmulatorTimeEvent e -> Encoding
toJSON :: EmulatorTimeEvent e -> Value
$ctoJSON :: forall e. ToJSON e => EmulatorTimeEvent e -> Value
ToJSON, Value -> Parser [EmulatorTimeEvent e]
Value -> Parser (EmulatorTimeEvent e)
(Value -> Parser (EmulatorTimeEvent e))
-> (Value -> Parser [EmulatorTimeEvent e])
-> FromJSON (EmulatorTimeEvent e)
forall e. FromJSON e => Value -> Parser [EmulatorTimeEvent e]
forall e. FromJSON e => Value -> Parser (EmulatorTimeEvent e)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EmulatorTimeEvent e]
$cparseJSONList :: forall e. FromJSON e => Value -> Parser [EmulatorTimeEvent e]
parseJSON :: Value -> Parser (EmulatorTimeEvent e)
$cparseJSON :: forall e. FromJSON e => Value -> Parser (EmulatorTimeEvent e)
FromJSON)
makeLenses ''EmulatorTimeEvent
instance Pretty e => Pretty (EmulatorTimeEvent e) where
pretty :: EmulatorTimeEvent e -> Doc ann
pretty EmulatorTimeEvent{Slot
_eteEmulatorTime :: Slot
_eteEmulatorTime :: forall e. EmulatorTimeEvent e -> Slot
_eteEmulatorTime, e
_eteEvent :: e
_eteEvent :: forall e. EmulatorTimeEvent e -> e
_eteEvent} =
Slot -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Slot
_eteEmulatorTime Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> e -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty e
_eteEvent
emulatorTimeEvent :: Slot -> Prism' (EmulatorTimeEvent e) e
emulatorTimeEvent :: Slot -> Prism' (EmulatorTimeEvent e) e
emulatorTimeEvent Slot
t = (e -> EmulatorTimeEvent e)
-> (EmulatorTimeEvent e -> Maybe e)
-> Prism' (EmulatorTimeEvent e) e
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (Slot -> e -> EmulatorTimeEvent e
forall e. Slot -> e -> EmulatorTimeEvent e
EmulatorTimeEvent Slot
t) (\case { EmulatorTimeEvent Slot
s e
e | Slot
s Slot -> Slot -> Bool
forall a. Eq a => a -> a -> Bool
== Slot
t -> e -> Maybe e
forall a. a -> Maybe a
Just e
e; EmulatorTimeEvent e
_ -> Maybe e
forall a. Maybe a
Nothing})
data EmulatorEvent' =
ChainEvent Chain.ChainEvent
| ClientEvent Wallet NC.NodeClientEvent
| WalletEvent Wallet Wallet.WalletEvent
| ChainIndexEvent Wallet ChainIndex.ChainIndexLog
| SchedulerEvent Scheduler.SchedulerLog
| InstanceEvent ContractInstanceLog
| UserThreadEvent UserThreadMsg
deriving stock (EmulatorEvent' -> EmulatorEvent' -> Bool
(EmulatorEvent' -> EmulatorEvent' -> Bool)
-> (EmulatorEvent' -> EmulatorEvent' -> Bool) -> Eq EmulatorEvent'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmulatorEvent' -> EmulatorEvent' -> Bool
$c/= :: EmulatorEvent' -> EmulatorEvent' -> Bool
== :: EmulatorEvent' -> EmulatorEvent' -> Bool
$c== :: EmulatorEvent' -> EmulatorEvent' -> Bool
Eq, Int -> EmulatorEvent' -> ShowS
[EmulatorEvent'] -> ShowS
EmulatorEvent' -> String
(Int -> EmulatorEvent' -> ShowS)
-> (EmulatorEvent' -> String)
-> ([EmulatorEvent'] -> ShowS)
-> Show EmulatorEvent'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmulatorEvent'] -> ShowS
$cshowList :: [EmulatorEvent'] -> ShowS
show :: EmulatorEvent' -> String
$cshow :: EmulatorEvent' -> String
showsPrec :: Int -> EmulatorEvent' -> ShowS
$cshowsPrec :: Int -> EmulatorEvent' -> ShowS
Show, (forall x. EmulatorEvent' -> Rep EmulatorEvent' x)
-> (forall x. Rep EmulatorEvent' x -> EmulatorEvent')
-> Generic EmulatorEvent'
forall x. Rep EmulatorEvent' x -> EmulatorEvent'
forall x. EmulatorEvent' -> Rep EmulatorEvent' x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EmulatorEvent' x -> EmulatorEvent'
$cfrom :: forall x. EmulatorEvent' -> Rep EmulatorEvent' x
Generic)
deriving anyclass ([EmulatorEvent'] -> Encoding
[EmulatorEvent'] -> Value
EmulatorEvent' -> Encoding
EmulatorEvent' -> Value
(EmulatorEvent' -> Value)
-> (EmulatorEvent' -> Encoding)
-> ([EmulatorEvent'] -> Value)
-> ([EmulatorEvent'] -> Encoding)
-> ToJSON EmulatorEvent'
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EmulatorEvent'] -> Encoding
$ctoEncodingList :: [EmulatorEvent'] -> Encoding
toJSONList :: [EmulatorEvent'] -> Value
$ctoJSONList :: [EmulatorEvent'] -> Value
toEncoding :: EmulatorEvent' -> Encoding
$ctoEncoding :: EmulatorEvent' -> Encoding
toJSON :: EmulatorEvent' -> Value
$ctoJSON :: EmulatorEvent' -> Value
ToJSON, Value -> Parser [EmulatorEvent']
Value -> Parser EmulatorEvent'
(Value -> Parser EmulatorEvent')
-> (Value -> Parser [EmulatorEvent']) -> FromJSON EmulatorEvent'
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EmulatorEvent']
$cparseJSONList :: Value -> Parser [EmulatorEvent']
parseJSON :: Value -> Parser EmulatorEvent'
$cparseJSON :: Value -> Parser EmulatorEvent'
FromJSON)
instance Pretty EmulatorEvent' where
pretty :: EmulatorEvent' -> Doc ann
pretty = \case
ClientEvent Wallet
w NodeClientEvent
e -> Wallet -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Wallet
w Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NodeClientEvent -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty NodeClientEvent
e
ChainEvent ChainEvent
e -> ChainEvent -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ChainEvent
e
WalletEvent Wallet
w WalletEvent
e -> Wallet -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Wallet
w Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> WalletEvent -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty WalletEvent
e
ChainIndexEvent Wallet
w ChainIndexLog
e -> Wallet -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Wallet
w Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ChainIndexLog -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ChainIndexLog
e
SchedulerEvent SchedulerLog
e -> SchedulerLog -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty SchedulerLog
e
InstanceEvent ContractInstanceLog
e -> ContractInstanceLog -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceLog
e
UserThreadEvent UserThreadMsg
e -> UserThreadMsg -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty UserThreadMsg
e
type EmulatorEvent = EmulatorTimeEvent EmulatorEvent'
chainEvent :: Prism' EmulatorEvent' Chain.ChainEvent
chainEvent :: p ChainEvent (f ChainEvent) -> p EmulatorEvent' (f EmulatorEvent')
chainEvent = (ChainEvent -> EmulatorEvent')
-> (EmulatorEvent' -> Maybe ChainEvent)
-> Prism EmulatorEvent' EmulatorEvent' ChainEvent ChainEvent
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' ChainEvent -> EmulatorEvent'
ChainEvent (\case { ChainEvent ChainEvent
c -> ChainEvent -> Maybe ChainEvent
forall a. a -> Maybe a
Just ChainEvent
c; EmulatorEvent'
_ -> Maybe ChainEvent
forall a. Maybe a
Nothing })
walletClientEvent :: Wallet -> Prism' EmulatorEvent' NC.NodeClientEvent
walletClientEvent :: Wallet -> Prism' EmulatorEvent' NodeClientEvent
walletClientEvent Wallet
w = (NodeClientEvent -> EmulatorEvent')
-> (EmulatorEvent' -> Maybe NodeClientEvent)
-> Prism' EmulatorEvent' NodeClientEvent
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (Wallet -> NodeClientEvent -> EmulatorEvent'
ClientEvent Wallet
w) (\case { ClientEvent Wallet
w' NodeClientEvent
c | Wallet
w Wallet -> Wallet -> Bool
forall a. Eq a => a -> a -> Bool
== Wallet
w' -> NodeClientEvent -> Maybe NodeClientEvent
forall a. a -> Maybe a
Just NodeClientEvent
c; EmulatorEvent'
_ -> Maybe NodeClientEvent
forall a. Maybe a
Nothing })
walletEvent :: Wallet -> Prism' EmulatorEvent' Wallet.WalletEvent
walletEvent :: Wallet -> Prism' EmulatorEvent' WalletEvent
walletEvent Wallet
w = (WalletEvent -> EmulatorEvent')
-> (EmulatorEvent' -> Maybe WalletEvent)
-> Prism' EmulatorEvent' WalletEvent
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (Wallet -> WalletEvent -> EmulatorEvent'
WalletEvent Wallet
w) (\case { WalletEvent Wallet
w' WalletEvent
c | Wallet
w Wallet -> Wallet -> Bool
forall a. Eq a => a -> a -> Bool
== Wallet
w' -> WalletEvent -> Maybe WalletEvent
forall a. a -> Maybe a
Just WalletEvent
c; EmulatorEvent'
_ -> Maybe WalletEvent
forall a. Maybe a
Nothing })
walletEvent' :: Prism' EmulatorEvent' (Wallet, Wallet.WalletEvent)
walletEvent' :: p (Wallet, WalletEvent) (f (Wallet, WalletEvent))
-> p EmulatorEvent' (f EmulatorEvent')
walletEvent' = ((Wallet, WalletEvent) -> EmulatorEvent')
-> (EmulatorEvent' -> Maybe (Wallet, WalletEvent))
-> Prism
EmulatorEvent'
EmulatorEvent'
(Wallet, WalletEvent)
(Wallet, WalletEvent)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' ((Wallet -> WalletEvent -> EmulatorEvent')
-> (Wallet, WalletEvent) -> EmulatorEvent'
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Wallet -> WalletEvent -> EmulatorEvent'
WalletEvent) (\case { WalletEvent Wallet
w WalletEvent
c -> (Wallet, WalletEvent) -> Maybe (Wallet, WalletEvent)
forall a. a -> Maybe a
Just (Wallet
w, WalletEvent
c); EmulatorEvent'
_ -> Maybe (Wallet, WalletEvent)
forall a. Maybe a
Nothing })
chainIndexEvent :: Wallet -> Prism' EmulatorEvent' ChainIndex.ChainIndexLog
chainIndexEvent :: Wallet -> Prism' EmulatorEvent' ChainIndexLog
chainIndexEvent Wallet
w = (ChainIndexLog -> EmulatorEvent')
-> (EmulatorEvent' -> Maybe ChainIndexLog)
-> Prism' EmulatorEvent' ChainIndexLog
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (Wallet -> ChainIndexLog -> EmulatorEvent'
ChainIndexEvent Wallet
w) (\case { ChainIndexEvent Wallet
w' ChainIndexLog
c | Wallet
w Wallet -> Wallet -> Bool
forall a. Eq a => a -> a -> Bool
== Wallet
w' -> ChainIndexLog -> Maybe ChainIndexLog
forall a. a -> Maybe a
Just ChainIndexLog
c; EmulatorEvent'
_ -> Maybe ChainIndexLog
forall a. Maybe a
Nothing })
schedulerEvent :: Prism' EmulatorEvent' Scheduler.SchedulerLog
schedulerEvent :: p SchedulerLog (f SchedulerLog)
-> p EmulatorEvent' (f EmulatorEvent')
schedulerEvent = (SchedulerLog -> EmulatorEvent')
-> (EmulatorEvent' -> Maybe SchedulerLog)
-> Prism EmulatorEvent' EmulatorEvent' SchedulerLog SchedulerLog
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' SchedulerLog -> EmulatorEvent'
SchedulerEvent (\case { SchedulerEvent SchedulerLog
e -> SchedulerLog -> Maybe SchedulerLog
forall a. a -> Maybe a
Just SchedulerLog
e; EmulatorEvent'
_ -> Maybe SchedulerLog
forall a. Maybe a
Nothing })
instanceEvent :: Prism' EmulatorEvent' ContractInstanceLog
instanceEvent :: p ContractInstanceLog (f ContractInstanceLog)
-> p EmulatorEvent' (f EmulatorEvent')
instanceEvent = (ContractInstanceLog -> EmulatorEvent')
-> (EmulatorEvent' -> Maybe ContractInstanceLog)
-> Prism
EmulatorEvent'
EmulatorEvent'
ContractInstanceLog
ContractInstanceLog
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' ContractInstanceLog -> EmulatorEvent'
InstanceEvent (\case { InstanceEvent ContractInstanceLog
e -> ContractInstanceLog -> Maybe ContractInstanceLog
forall a. a -> Maybe a
Just ContractInstanceLog
e; EmulatorEvent'
_ -> Maybe ContractInstanceLog
forall a. Maybe a
Nothing })
userThreadEvent :: Prism' EmulatorEvent' UserThreadMsg
userThreadEvent :: p UserThreadMsg (f UserThreadMsg)
-> p EmulatorEvent' (f EmulatorEvent')
userThreadEvent = (UserThreadMsg -> EmulatorEvent')
-> (EmulatorEvent' -> Maybe UserThreadMsg)
-> Prism EmulatorEvent' EmulatorEvent' UserThreadMsg UserThreadMsg
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' UserThreadMsg -> EmulatorEvent'
UserThreadEvent (\case { UserThreadEvent UserThreadMsg
e -> UserThreadMsg -> Maybe UserThreadMsg
forall a. a -> Maybe a
Just UserThreadMsg
e ; EmulatorEvent'
_ -> Maybe UserThreadMsg
forall a. Maybe a
Nothing })
type EmulatedWalletControlEffects =
'[ NC.NodeClientControlEffect
, ChainIndex.ChainIndexControlEffect
, Wallet.SigningProcessControlEffect
, LogObserve (LogMessage T.Text)
, LogMsg T.Text
]
data MultiAgentEffect r where
WalletAction :: Wallet -> Eff EmulatedWalletEffects r -> MultiAgentEffect r
data MultiAgentControlEffect r where
WalletControlAction :: Wallet -> Eff EmulatedWalletControlEffects r -> MultiAgentControlEffect r
Assertion :: Assertion -> MultiAgentControlEffect ()
walletAction
:: (Member MultiAgentEffect effs)
=> Wallet
-> Eff EmulatedWalletEffects r
-> Eff effs r
walletAction :: Wallet -> Eff EmulatedWalletEffects r -> Eff effs r
walletAction Wallet
wallet Eff EmulatedWalletEffects r
act = MultiAgentEffect r -> Eff effs r
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send (Wallet -> Eff EmulatedWalletEffects r -> MultiAgentEffect r
forall r.
Wallet -> Eff EmulatedWalletEffects r -> MultiAgentEffect r
WalletAction Wallet
wallet Eff EmulatedWalletEffects r
act)
handleMultiAgentEffects ::
forall effs.
Member MultiAgentEffect effs
=> Wallet
-> Eff (EmulatedWalletEffects' effs)
~> Eff effs
handleMultiAgentEffects :: Wallet -> Eff (EmulatedWalletEffects' effs) ~> Eff effs
handleMultiAgentEffects Wallet
wallet =
(LogMsg Text ~> Eff effs) -> Eff (LogMsg Text : effs) ~> Eff effs
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Wallet -> LogMsg Text ~> Eff effs
forall (f :: * -> *) (effs :: [* -> *]).
(Member f EmulatedWalletEffects, Member MultiAgentEffect effs) =>
Wallet -> f ~> Eff effs
raiseWallet @(LogMsg T.Text) Wallet
wallet)
(Eff (LogMsg Text : effs) x -> Eff effs x)
-> (Eff (EmulatedWalletEffects' effs) x
-> Eff (LogMsg Text : effs) x)
-> Eff (EmulatedWalletEffects' effs) x
-> Eff effs x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg TxBalanceMsg ~> Eff (LogMsg Text : effs))
-> Eff (LogMsg TxBalanceMsg : LogMsg Text : effs)
~> Eff (LogMsg Text : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Wallet -> LogMsg TxBalanceMsg ~> Eff (LogMsg Text : effs)
forall (f :: * -> *) (effs :: [* -> *]).
(Member f EmulatedWalletEffects, Member MultiAgentEffect effs) =>
Wallet -> f ~> Eff effs
raiseWallet @(LogMsg TxBalanceMsg) Wallet
wallet)
(Eff (LogMsg TxBalanceMsg : LogMsg Text : effs) x
-> Eff (LogMsg Text : effs) x)
-> (Eff (EmulatedWalletEffects' effs) x
-> Eff (LogMsg TxBalanceMsg : LogMsg Text : effs) x)
-> Eff (EmulatedWalletEffects' effs) x
-> Eff (LogMsg Text : effs) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMsg RequestHandlerLogMsg
~> Eff (LogMsg TxBalanceMsg : LogMsg Text : effs))
-> Eff
(LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
~> Eff (LogMsg TxBalanceMsg : LogMsg Text : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Wallet
-> LogMsg RequestHandlerLogMsg
~> Eff (LogMsg TxBalanceMsg : LogMsg Text : effs)
forall (f :: * -> *) (effs :: [* -> *]).
(Member f EmulatedWalletEffects, Member MultiAgentEffect effs) =>
Wallet -> f ~> Eff effs
raiseWallet @(LogMsg RequestHandlerLogMsg) Wallet
wallet)
(Eff
(LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
x
-> Eff (LogMsg TxBalanceMsg : LogMsg Text : effs) x)
-> (Eff (EmulatedWalletEffects' effs) x
-> Eff
(LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
x)
-> Eff (EmulatedWalletEffects' effs) x
-> Eff (LogMsg TxBalanceMsg : LogMsg Text : effs) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogObserve (LogMessage Text)
~> Eff
(LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs))
-> Eff
(LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: effs)
~> Eff
(LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Wallet
-> LogObserve (LogMessage Text)
~> Eff
(LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
forall (f :: * -> *) (effs :: [* -> *]).
(Member f EmulatedWalletEffects, Member MultiAgentEffect effs) =>
Wallet -> f ~> Eff effs
raiseWallet @(LogObserve (LogMessage T.Text)) Wallet
wallet)
(Eff
(LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: effs)
x
-> Eff
(LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
x)
-> (Eff (EmulatedWalletEffects' effs) x
-> Eff
(LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: effs)
x)
-> Eff (EmulatedWalletEffects' effs) x
-> Eff
(LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainIndexQueryEffect
~> Eff
(LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: effs))
-> Eff
(ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
~> Eff
(LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Wallet
-> ChainIndexQueryEffect
~> Eff
(LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: effs)
forall (f :: * -> *) (effs :: [* -> *]).
(Member f EmulatedWalletEffects, Member MultiAgentEffect effs) =>
Wallet -> f ~> Eff effs
raiseWallet @ChainIndex.ChainIndexQueryEffect Wallet
wallet)
(Eff
(ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
x
-> Eff
(LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: effs)
x)
-> (Eff (EmulatedWalletEffects' effs) x
-> Eff
(ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
x)
-> Eff (EmulatedWalletEffects' effs) x
-> Eff
(LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: effs)
x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeClientEffect
~> Eff
(ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs))
-> Eff
(NodeClientEffect
: ChainIndexQueryEffect : LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: effs)
~> Eff
(ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Wallet
-> NodeClientEffect
~> Eff
(ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
forall (f :: * -> *) (effs :: [* -> *]).
(Member f EmulatedWalletEffects, Member MultiAgentEffect effs) =>
Wallet -> f ~> Eff effs
raiseWallet @WAPI.NodeClientEffect Wallet
wallet)
(Eff
(NodeClientEffect
: ChainIndexQueryEffect : LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: effs)
x
-> Eff
(ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
x)
-> (Eff (EmulatedWalletEffects' effs) x
-> Eff
(NodeClientEffect
: ChainIndexQueryEffect : LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: effs)
x)
-> Eff (EmulatedWalletEffects' effs) x
-> Eff
(ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Error WalletAPIError
~> Eff
(NodeClientEffect
: ChainIndexQueryEffect : LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: effs))
-> Eff
(Error WalletAPIError
: NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
~> Eff
(NodeClientEffect
: ChainIndexQueryEffect : LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Wallet
-> Error WalletAPIError
~> Eff
(NodeClientEffect
: ChainIndexQueryEffect : LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: effs)
forall (f :: * -> *) (effs :: [* -> *]).
(Member f EmulatedWalletEffects, Member MultiAgentEffect effs) =>
Wallet -> f ~> Eff effs
raiseWallet @(Error WAPI.WalletAPIError) Wallet
wallet)
(Eff
(Error WalletAPIError
: NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
x
-> Eff
(NodeClientEffect
: ChainIndexQueryEffect : LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: effs)
x)
-> (Eff (EmulatedWalletEffects' effs) x
-> Eff
(Error WalletAPIError
: NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
x)
-> Eff (EmulatedWalletEffects' effs) x
-> Eff
(NodeClientEffect
: ChainIndexQueryEffect : LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: effs)
x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WalletEffect
~> Eff
(Error WalletAPIError
: NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs))
-> Eff (EmulatedWalletEffects' effs)
~> Eff
(Error WalletAPIError
: NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Wallet
-> WalletEffect
~> Eff
(Error WalletAPIError
: NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : effs)
forall (f :: * -> *) (effs :: [* -> *]).
(Member f EmulatedWalletEffects, Member MultiAgentEffect effs) =>
Wallet -> f ~> Eff effs
raiseWallet @WAPI.WalletEffect Wallet
wallet)
raiseWallet :: forall f effs.
( Member f EmulatedWalletEffects
, Member MultiAgentEffect effs
)
=> Wallet
-> f
~> Eff effs
raiseWallet :: Wallet -> f ~> Eff effs
raiseWallet Wallet
wllt = Wallet -> Eff EmulatedWalletEffects x -> Eff effs x
forall (effs :: [* -> *]) r.
Member MultiAgentEffect effs =>
Wallet -> Eff EmulatedWalletEffects r -> Eff effs r
walletAction Wallet
wllt (Eff EmulatedWalletEffects x -> Eff effs x)
-> (f x -> Eff EmulatedWalletEffects x) -> f x -> Eff effs x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f x -> Eff EmulatedWalletEffects x
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send
walletControlAction
:: (Member MultiAgentControlEffect effs)
=> Wallet
-> Eff EmulatedWalletControlEffects r
-> Eff effs r
walletControlAction :: Wallet -> Eff EmulatedWalletControlEffects r -> Eff effs r
walletControlAction Wallet
wallet = MultiAgentControlEffect r -> Eff effs r
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send (MultiAgentControlEffect r -> Eff effs r)
-> (Eff EmulatedWalletControlEffects r
-> MultiAgentControlEffect r)
-> Eff EmulatedWalletControlEffects r
-> Eff effs r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet
-> Eff EmulatedWalletControlEffects r -> MultiAgentControlEffect r
forall r.
Wallet
-> Eff EmulatedWalletControlEffects r -> MultiAgentControlEffect r
WalletControlAction Wallet
wallet
assertion :: (Member MultiAgentControlEffect effs) => Assertion -> Eff effs ()
assertion :: Assertion -> Eff effs ()
assertion Assertion
a = MultiAgentControlEffect () -> Eff effs ()
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send (Assertion -> MultiAgentControlEffect ()
Assertion Assertion
a)
assertOwnFundsEq :: (Member MultiAgentControlEffect effs) => Wallet -> Value -> Eff effs ()
assertOwnFundsEq :: Wallet -> Value -> Eff effs ()
assertOwnFundsEq Wallet
wallet = Assertion -> Eff effs ()
forall (effs :: [* -> *]).
Member MultiAgentControlEffect effs =>
Assertion -> Eff effs ()
assertion (Assertion -> Eff effs ())
-> (Value -> Assertion) -> Value -> Eff effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> Value -> Assertion
OwnFundsEqual Wallet
wallet
assertIsValidated :: (Member MultiAgentControlEffect effs) => CardanoTx -> Eff effs ()
assertIsValidated :: CardanoTx -> Eff effs ()
assertIsValidated = Assertion -> Eff effs ()
forall (effs :: [* -> *]).
Member MultiAgentControlEffect effs =>
Assertion -> Eff effs ()
assertion (Assertion -> Eff effs ())
-> (CardanoTx -> Assertion) -> CardanoTx -> Eff effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoTx -> Assertion
IsValidated
data EmulatorState = EmulatorState {
EmulatorState -> ChainState
_chainState :: Chain.ChainState,
EmulatorState -> Map Wallet WalletState
_walletStates :: Map Wallet Wallet.WalletState,
EmulatorState -> [LogMessage EmulatorEvent]
_emulatorLog :: [LogMessage EmulatorEvent]
} deriving (Int -> EmulatorState -> ShowS
[EmulatorState] -> ShowS
EmulatorState -> String
(Int -> EmulatorState -> ShowS)
-> (EmulatorState -> String)
-> ([EmulatorState] -> ShowS)
-> Show EmulatorState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmulatorState] -> ShowS
$cshowList :: [EmulatorState] -> ShowS
show :: EmulatorState -> String
$cshow :: EmulatorState -> String
showsPrec :: Int -> EmulatorState -> ShowS
$cshowsPrec :: Int -> EmulatorState -> ShowS
Show)
makeLenses ''EmulatorState
walletState :: Wallet -> Lens' EmulatorState Wallet.WalletState
walletState :: Wallet -> Lens' EmulatorState WalletState
walletState Wallet
wallet = (Map Wallet WalletState -> f (Map Wallet WalletState))
-> EmulatorState -> f EmulatorState
Lens' EmulatorState (Map Wallet WalletState)
walletStates ((Map Wallet WalletState -> f (Map Wallet WalletState))
-> EmulatorState -> f EmulatorState)
-> ((WalletState -> f WalletState)
-> Map Wallet WalletState -> f (Map Wallet WalletState))
-> (WalletState -> f WalletState)
-> EmulatorState
-> f EmulatorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Wallet WalletState)
-> Lens'
(Map Wallet WalletState) (Maybe (IxValue (Map Wallet WalletState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Wallet WalletState)
Wallet
wallet ((Maybe WalletState -> f (Maybe WalletState))
-> Map Wallet WalletState -> f (Map Wallet WalletState))
-> ((WalletState -> f WalletState)
-> Maybe WalletState -> f (Maybe WalletState))
-> (WalletState -> f WalletState)
-> Map Wallet WalletState
-> f (Map Wallet WalletState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WalletState
-> (WalletState -> Bool) -> Iso' (Maybe WalletState) WalletState
forall a. a -> (a -> Bool) -> Iso' (Maybe a) a
anon WalletState
emptyState (Bool -> WalletState -> Bool
forall a b. a -> b -> a
const Bool
False) where
emptyState :: WalletState
emptyState = WalletState -> Maybe WalletState -> WalletState
forall a. a -> Maybe a -> a
fromMaybe (String -> WalletState
forall a. HasCallStack => String -> a
error (String -> WalletState) -> String -> WalletState
forall a b. (a -> b) -> a -> b
$ String
"walletState: not a known wallet: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Wallet -> String
forall a. Show a => a -> String
show Wallet
wallet) (Wallet -> Maybe WalletState
Wallet.emptyWalletState Wallet
wallet)
chainOldestFirst :: Lens' EmulatorState Blockchain
chainOldestFirst :: (Blockchain -> f Blockchain) -> EmulatorState -> f EmulatorState
chainOldestFirst = (ChainState -> f ChainState) -> EmulatorState -> f EmulatorState
Lens' EmulatorState ChainState
chainState ((ChainState -> f ChainState) -> EmulatorState -> f EmulatorState)
-> ((Blockchain -> f Blockchain) -> ChainState -> f ChainState)
-> (Blockchain -> f Blockchain)
-> EmulatorState
-> f EmulatorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Blockchain -> f Blockchain) -> ChainState -> f ChainState
Lens' ChainState Blockchain
Chain.chainNewestFirst ((Blockchain -> f Blockchain) -> ChainState -> f ChainState)
-> ((Blockchain -> f Blockchain) -> Blockchain -> f Blockchain)
-> (Blockchain -> f Blockchain)
-> ChainState
-> f ChainState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Blockchain -> f Blockchain) -> Blockchain -> f Blockchain
forall a. Reversing a => Iso' a a
reversed
chainUtxo :: Getter EmulatorState AM.AddressMap
chainUtxo :: (AddressMap -> f AddressMap) -> EmulatorState -> f EmulatorState
chainUtxo = (ChainState -> f ChainState) -> EmulatorState -> f EmulatorState
Lens' EmulatorState ChainState
chainState ((ChainState -> f ChainState) -> EmulatorState -> f EmulatorState)
-> ((AddressMap -> f AddressMap) -> ChainState -> f ChainState)
-> (AddressMap -> f AddressMap)
-> EmulatorState
-> f EmulatorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Blockchain -> f Blockchain) -> ChainState -> f ChainState
Lens' ChainState Blockchain
Chain.chainNewestFirst ((Blockchain -> f Blockchain) -> ChainState -> f ChainState)
-> ((AddressMap -> f AddressMap) -> Blockchain -> f Blockchain)
-> (AddressMap -> f AddressMap)
-> ChainState
-> f ChainState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Blockchain -> AddressMap)
-> (AddressMap -> f AddressMap) -> Blockchain -> f Blockchain
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Blockchain -> AddressMap
AM.fromChain
fundsDistribution :: EmulatorState -> Map Wallet Value
fundsDistribution :: EmulatorState -> Map Wallet Value
fundsDistribution EmulatorState
st =
let fullState :: AddressMap
fullState = Getting AddressMap EmulatorState AddressMap
-> EmulatorState -> AddressMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting AddressMap EmulatorState AddressMap
Getter EmulatorState AddressMap
chainUtxo EmulatorState
st
wallets :: [Wallet]
wallets = EmulatorState
st EmulatorState
-> Getting (Endo [Wallet]) EmulatorState Wallet -> [Wallet]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Map Wallet WalletState
-> Const (Endo [Wallet]) (Map Wallet WalletState))
-> EmulatorState -> Const (Endo [Wallet]) EmulatorState
Lens' EmulatorState (Map Wallet WalletState)
walletStates ((Map Wallet WalletState
-> Const (Endo [Wallet]) (Map Wallet WalletState))
-> EmulatorState -> Const (Endo [Wallet]) EmulatorState)
-> ((Wallet -> Const (Endo [Wallet]) Wallet)
-> Map Wallet WalletState
-> Const (Endo [Wallet]) (Map Wallet WalletState))
-> Getting (Endo [Wallet]) EmulatorState Wallet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Wallet WalletState -> [Wallet])
-> Optic'
(->) (Const (Endo [Wallet])) (Map Wallet WalletState) [Wallet]
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Map Wallet WalletState -> [Wallet]
forall k a. Map k a -> [k]
Map.keys Optic'
(->) (Const (Endo [Wallet])) (Map Wallet WalletState) [Wallet]
-> ((Wallet -> Const (Endo [Wallet]) Wallet)
-> [Wallet] -> Const (Endo [Wallet]) [Wallet])
-> (Wallet -> Const (Endo [Wallet]) Wallet)
-> Map Wallet WalletState
-> Const (Endo [Wallet]) (Map Wallet WalletState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Wallet -> Const (Endo [Wallet]) Wallet)
-> [Wallet] -> Const (Endo [Wallet]) [Wallet]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded
walletFunds :: [(Wallet, Value)]
walletFunds = ((Wallet -> (Wallet, Value)) -> [Wallet] -> [(Wallet, Value)])
-> [Wallet] -> (Wallet -> (Wallet, Value)) -> [(Wallet, Value)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Wallet -> (Wallet, Value)) -> [Wallet] -> [(Wallet, Value)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Wallet]
wallets ((Wallet -> (Wallet, Value)) -> [(Wallet, Value)])
-> (Wallet -> (Wallet, Value)) -> [(Wallet, Value)]
forall a b. (a -> b) -> a -> b
$ \Wallet
w ->
(Wallet
w, ((CardanoTx, TxOut) -> Value)
-> Map TxOutRef (CardanoTx, TxOut) -> Value
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (TxOut -> Value
txOutValue (TxOut -> Value)
-> ((CardanoTx, TxOut) -> TxOut) -> (CardanoTx, TxOut) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoTx, TxOut) -> TxOut
forall a b. (a, b) -> b
snd) (Map TxOutRef (CardanoTx, TxOut) -> Value)
-> Map TxOutRef (CardanoTx, TxOut) -> Value
forall a b. (a -> b) -> a -> b
$ Getting
(Map TxOutRef (CardanoTx, TxOut))
AddressMap
(Map TxOutRef (CardanoTx, TxOut))
-> AddressMap -> Map TxOutRef (CardanoTx, TxOut)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (CardanoAddress
-> Lens' AddressMap (Map TxOutRef (CardanoTx, TxOut))
AM.fundsAt (Wallet -> CardanoAddress
Wallet.mockWalletAddress Wallet
w)) AddressMap
fullState)
in [(Wallet, Value)] -> Map Wallet Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Wallet, Value)]
walletFunds
emLog :: EmulatorState -> [LogMessage EmulatorEvent]
emLog :: EmulatorState -> [LogMessage EmulatorEvent]
emLog = Getting
[LogMessage EmulatorEvent] EmulatorState [LogMessage EmulatorEvent]
-> EmulatorState -> [LogMessage EmulatorEvent]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
[LogMessage EmulatorEvent] EmulatorState [LogMessage EmulatorEvent]
Lens' EmulatorState [LogMessage EmulatorEvent]
emulatorLog
emptyEmulatorState :: EmulatorState
emptyEmulatorState :: EmulatorState
emptyEmulatorState = EmulatorState :: ChainState
-> Map Wallet WalletState
-> [LogMessage EmulatorEvent]
-> EmulatorState
EmulatorState {
_chainState :: ChainState
_chainState = ChainState
Chain.emptyChainState,
_walletStates :: Map Wallet WalletState
_walletStates = Map Wallet WalletState
forall a. Monoid a => a
mempty,
_emulatorLog :: [LogMessage EmulatorEvent]
_emulatorLog = [LogMessage EmulatorEvent]
forall a. Monoid a => a
mempty
}
emulatorState :: Blockchain -> EmulatorState
emulatorState :: Blockchain -> EmulatorState
emulatorState Blockchain
bc = EmulatorState
emptyEmulatorState
EmulatorState -> (EmulatorState -> EmulatorState) -> EmulatorState
forall a b. a -> (a -> b) -> b
& (ChainState -> Identity ChainState)
-> EmulatorState -> Identity EmulatorState
Lens' EmulatorState ChainState
chainState ((ChainState -> Identity ChainState)
-> EmulatorState -> Identity EmulatorState)
-> ((Blockchain -> Identity Blockchain)
-> ChainState -> Identity ChainState)
-> (Blockchain -> Identity Blockchain)
-> EmulatorState
-> Identity EmulatorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Blockchain -> Identity Blockchain)
-> ChainState -> Identity ChainState
Lens' ChainState Blockchain
Chain.chainNewestFirst ((Blockchain -> Identity Blockchain)
-> EmulatorState -> Identity EmulatorState)
-> Blockchain -> EmulatorState -> EmulatorState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Blockchain
bc
EmulatorState -> (EmulatorState -> EmulatorState) -> EmulatorState
forall a b. a -> (a -> b) -> b
& (ChainState -> Identity ChainState)
-> EmulatorState -> Identity EmulatorState
Lens' EmulatorState ChainState
chainState ((ChainState -> Identity ChainState)
-> EmulatorState -> Identity EmulatorState)
-> ((UtxoIndex -> Identity UtxoIndex)
-> ChainState -> Identity ChainState)
-> (UtxoIndex -> Identity UtxoIndex)
-> EmulatorState
-> Identity EmulatorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UtxoIndex -> Identity UtxoIndex)
-> ChainState -> Identity ChainState
Lens' ChainState UtxoIndex
Chain.index ((UtxoIndex -> Identity UtxoIndex)
-> EmulatorState -> Identity EmulatorState)
-> UtxoIndex -> EmulatorState -> EmulatorState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Blockchain -> UtxoIndex
Index.initialise Blockchain
bc
emulatorStatePool :: Chain.TxPool -> EmulatorState
emulatorStatePool :: TxPool -> EmulatorState
emulatorStatePool TxPool
tp = EmulatorState
emptyEmulatorState
EmulatorState -> (EmulatorState -> EmulatorState) -> EmulatorState
forall a b. a -> (a -> b) -> b
& (ChainState -> Identity ChainState)
-> EmulatorState -> Identity EmulatorState
Lens' EmulatorState ChainState
chainState ((ChainState -> Identity ChainState)
-> EmulatorState -> Identity EmulatorState)
-> ((TxPool -> Identity TxPool)
-> ChainState -> Identity ChainState)
-> (TxPool -> Identity TxPool)
-> EmulatorState
-> Identity EmulatorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxPool -> Identity TxPool) -> ChainState -> Identity ChainState
Lens' ChainState TxPool
Chain.txPool ((TxPool -> Identity TxPool)
-> EmulatorState -> Identity EmulatorState)
-> TxPool -> EmulatorState -> EmulatorState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxPool
tp
emulatorStateInitialDist :: Params -> Map PaymentPubKeyHash Value -> Either ToCardanoError EmulatorState
emulatorStateInitialDist :: Params
-> Map PaymentPubKeyHash Value
-> Either ToCardanoError EmulatorState
emulatorStateInitialDist Params
params Map PaymentPubKeyHash Value
mp = do
Ada
minAdaEmptyTxOut <- Either ToCardanoError Ada
mMinAdaTxOut
[TxOut CtxTx BabbageEra]
outs <- (TxOut -> Either ToCardanoError (TxOut CtxTx BabbageEra))
-> [TxOut] -> Either ToCardanoError [TxOut CtxTx BabbageEra]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (NetworkId
-> TxOut -> Either ToCardanoError (TxOut CtxTx BabbageEra)
toCardanoTxOut (NetworkId
-> TxOut -> Either ToCardanoError (TxOut CtxTx BabbageEra))
-> NetworkId
-> TxOut
-> Either ToCardanoError (TxOut CtxTx BabbageEra)
forall a b. (a -> b) -> a -> b
$ Params -> NetworkId
pNetworkId Params
params) ([TxOut] -> Either ToCardanoError [TxOut CtxTx BabbageEra])
-> [TxOut] -> Either ToCardanoError [TxOut CtxTx BabbageEra]
forall a b. (a -> b) -> a -> b
$ Map PaymentPubKeyHash Value -> [(PaymentPubKeyHash, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList Map PaymentPubKeyHash Value
mp [(PaymentPubKeyHash, Value)]
-> ((PaymentPubKeyHash, Value) -> [TxOut]) -> [TxOut]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ada -> (PaymentPubKeyHash, Value) -> [TxOut]
mkOutputs Ada
minAdaEmptyTxOut
let tx :: Tx
tx = Tx
forall a. Monoid a => a
mempty
{ txOutputs :: [TxOut]
txOutputs = TxOut CtxTx BabbageEra -> TxOut
TxOut (TxOut CtxTx BabbageEra -> TxOut)
-> [TxOut CtxTx BabbageEra] -> [TxOut]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOut CtxTx BabbageEra]
outs
, txMint :: Value
txMint = Map PaymentPubKeyHash Value -> Value
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map PaymentPubKeyHash Value
mp
, txValidRange :: SlotRange
txValidRange = SlotRange
WAPI.defaultSlotRange
}
cUtxoIndex :: UTxO (BabbageEra StandardCrypto)
cUtxoIndex = (Either ValidationErrorInPhase ToCardanoError
-> UTxO (BabbageEra StandardCrypto))
-> (UTxO (BabbageEra StandardCrypto)
-> UTxO (BabbageEra StandardCrypto))
-> Either
(Either ValidationErrorInPhase ToCardanoError)
(UTxO (BabbageEra StandardCrypto))
-> UTxO (BabbageEra StandardCrypto)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> UTxO (BabbageEra StandardCrypto)
forall a. HasCallStack => String -> a
error (String -> UTxO (BabbageEra StandardCrypto))
-> (Either ValidationErrorInPhase ToCardanoError -> String)
-> Either ValidationErrorInPhase ToCardanoError
-> UTxO (BabbageEra StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ValidationErrorInPhase ToCardanoError -> String
forall a. Show a => a -> String
show) UTxO (BabbageEra StandardCrypto)
-> UTxO (BabbageEra StandardCrypto)
forall a. a -> a
id (Either
(Either ValidationErrorInPhase ToCardanoError)
(UTxO (BabbageEra StandardCrypto))
-> UTxO (BabbageEra StandardCrypto))
-> Either
(Either ValidationErrorInPhase ToCardanoError)
(UTxO (BabbageEra StandardCrypto))
-> UTxO (BabbageEra StandardCrypto)
forall a b. (a -> b) -> a -> b
$ UtxoIndex
-> Either
(Either ValidationErrorInPhase ToCardanoError)
(UTxO (BabbageEra StandardCrypto))
fromPlutusIndex UtxoIndex
forall a. Monoid a => a
mempty
cTx :: CardanoTx
cTx = Params
-> UTxO (BabbageEra StandardCrypto)
-> Tx
-> Map PaymentPubKey PaymentPrivateKey
-> CardanoTx
Validation.fromPlutusTxSigned Params
forall a. Default a => a
def UTxO (BabbageEra StandardCrypto)
cUtxoIndex Tx
tx Map PaymentPubKey PaymentPrivateKey
CW.knownPaymentKeys
EmulatorState -> Either ToCardanoError EmulatorState
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EmulatorState -> Either ToCardanoError EmulatorState)
-> EmulatorState -> Either ToCardanoError EmulatorState
forall a b. (a -> b) -> a -> b
$ TxPool -> EmulatorState
emulatorStatePool [CardanoTx
cTx]
where
mMinAdaTxOut :: Either ToCardanoError Ada
mMinAdaTxOut = do
let k :: PaymentPubKeyHash
k = (PaymentPubKeyHash, Value) -> PaymentPubKeyHash
forall a b. (a, b) -> a
fst ((PaymentPubKeyHash, Value) -> PaymentPubKeyHash)
-> (PaymentPubKeyHash, Value) -> PaymentPubKeyHash
forall a b. (a -> b) -> a -> b
$ [(PaymentPubKeyHash, Value)] -> (PaymentPubKeyHash, Value)
forall a. [a] -> a
head ([(PaymentPubKeyHash, Value)] -> (PaymentPubKeyHash, Value))
-> [(PaymentPubKeyHash, Value)] -> (PaymentPubKeyHash, Value)
forall a b. (a -> b) -> a -> b
$ Map PaymentPubKeyHash Value -> [(PaymentPubKeyHash, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList Map PaymentPubKeyHash Value
mp
TxOut CtxTx BabbageEra
emptyTxOut <- NetworkId
-> TxOut -> Either ToCardanoError (TxOut CtxTx BabbageEra)
toCardanoTxOut (Params -> NetworkId
pNetworkId Params
params) (TxOut -> Either ToCardanoError (TxOut CtxTx BabbageEra))
-> TxOut -> Either ToCardanoError (TxOut CtxTx BabbageEra)
forall a b. (a -> b) -> a -> b
$ PaymentPubKeyHash -> Value -> TxOut
mkOutput PaymentPubKeyHash
k Value
forall a. Monoid a => a
mempty
Ada -> Either ToCardanoError Ada
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ada -> Either ToCardanoError Ada)
-> Ada -> Either ToCardanoError Ada
forall a b. (a -> b) -> a -> b
$ PParams (BabbageEra StandardCrypto) -> TxOut -> Ada
minAdaTxOut (Params -> PParams (BabbageEra StandardCrypto)
emulatorPParams Params
params) (TxOut CtxTx BabbageEra -> TxOut
TxOut TxOut CtxTx BabbageEra
emptyTxOut)
mkOutputs :: Ada -> (PaymentPubKeyHash, Value) -> [TxOut]
mkOutputs Ada
minAda (PaymentPubKeyHash
key, Value
vl) = PaymentPubKeyHash -> Value -> TxOut
mkOutput PaymentPubKeyHash
key (Value -> TxOut) -> [Value] -> [TxOut]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Ada -> [Value]
splitInto10 Value
vl Ada
minAda
splitInto10 :: Value -> Ada -> [Value]
splitInto10 Value
vl Ada
minAda = if Ada
count Ada -> Ada -> Bool
forall a. Ord a => a -> a -> Bool
<= Ada
1
then [Value
vl]
else Int -> Value -> [Value]
forall a. Int -> a -> [a]
replicate (Ada -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Ada
count) (Ada -> Value
Ada.toValue (Ada
ada Ada -> Ada -> Ada
forall a. Integral a => a -> a -> a
`div` Ada
count)) [Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++ [Value]
remainder
where
ada :: Ada
ada = if Value -> Bool
Value.isAdaOnlyValue Value
vl
then Value -> Ada
Ada.fromValue Value
vl
else Value -> Ada
Ada.fromValue Value
vl Ada -> Ada -> Ada
forall a. Num a => a -> a -> a
- Ada
minAda
count :: Ada
count = Ada -> Ada -> Ada
forall a. Ord a => a -> a -> a
min Ada
10 (Ada -> Ada) -> Ada -> Ada
forall a b. (a -> b) -> a -> b
$ Ada
ada Ada -> Ada -> Ada
forall a. Integral a => a -> a -> a
`div` Ada
minAda
remainder :: [Value]
remainder = [ Value
vl Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Ada -> Value
Ada.toValue (-Ada
ada) | Bool -> Bool
not (Value -> Bool
Value.isAdaOnlyValue Value
vl) ]
mkOutput :: PaymentPubKeyHash -> Value -> TxOut
mkOutput PaymentPubKeyHash
key Value
vl = Value -> PubKeyHash -> TxOut
V2.pubKeyHashTxOut Value
vl (PaymentPubKeyHash -> PubKeyHash
unPaymentPubKeyHash PaymentPubKeyHash
key)
type MultiAgentEffs =
'[ State EmulatorState
, LogMsg EmulatorEvent'
, Error WAPI.WalletAPIError
, Error ChainIndex.ChainIndexError
, Error AssertionError
, Chain.ChainEffect
, Chain.ChainControlEffect
]
handleMultiAgentControl
:: forall effs. Members MultiAgentEffs effs
=> Eff (MultiAgentControlEffect ': effs) ~> Eff effs
handleMultiAgentControl :: Eff (MultiAgentControlEffect : effs) ~> Eff effs
handleMultiAgentControl = (MultiAgentControlEffect ~> Eff effs)
-> Eff (MultiAgentControlEffect : effs) ~> Eff effs
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((MultiAgentControlEffect ~> Eff effs)
-> Eff (MultiAgentControlEffect : effs) ~> Eff effs)
-> (MultiAgentControlEffect ~> Eff effs)
-> Eff (MultiAgentControlEffect : effs) ~> Eff effs
forall a b. (a -> b) -> a -> b
$ \case
WalletControlAction wallet act -> do
let
p1 :: AReview EmulatorEvent' Wallet.WalletEvent
p1 :: AReview EmulatorEvent' WalletEvent
p1 = Wallet -> Prism' EmulatorEvent' WalletEvent
walletEvent Wallet
wallet
p2 :: AReview EmulatorEvent' NC.NodeClientEvent
p2 :: AReview EmulatorEvent' NodeClientEvent
p2 = Wallet -> Prism' EmulatorEvent' NodeClientEvent
walletClientEvent Wallet
wallet
p3 :: AReview EmulatorEvent' ChainIndex.ChainIndexLog
p3 :: AReview EmulatorEvent' ChainIndexLog
p3 = Wallet -> Prism' EmulatorEvent' ChainIndexLog
chainIndexEvent Wallet
wallet
p4 :: AReview EmulatorEvent' T.Text
p4 :: AReview EmulatorEvent' Text
p4 = Wallet -> Prism' EmulatorEvent' WalletEvent
walletEvent Wallet
wallet AReview EmulatorEvent' WalletEvent
-> (Tagged Text (Identity Text)
-> Tagged WalletEvent (Identity WalletEvent))
-> AReview EmulatorEvent' Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged Text (Identity Text)
-> Tagged WalletEvent (Identity WalletEvent)
Prism' WalletEvent Text
Wallet._GenericLog
Eff EmulatedWalletControlEffects x
act
Eff EmulatedWalletControlEffects x
-> (Eff EmulatedWalletControlEffects x
-> Eff
(NodeClientControlEffect
: ChainIndexControlEffect : SigningProcessControlEffect
: LogObserve (LogMessage Text) : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x)
-> Eff
(NodeClientControlEffect
: ChainIndexControlEffect : SigningProcessControlEffect
: LogObserve (LogMessage Text) : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall a b. a -> (a -> b) -> b
& Eff EmulatedWalletControlEffects x
-> Eff
(NodeClientControlEffect
: ChainIndexControlEffect : SigningProcessControlEffect
: LogObserve (LogMessage Text) : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall (effs :: [* -> *]) (as :: [* -> *]).
CanWeakenEnd as effs =>
Eff as ~> Eff effs
raiseEnd
Eff
(NodeClientControlEffect
: ChainIndexControlEffect : SigningProcessControlEffect
: LogObserve (LogMessage Text) : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> (Eff
(NodeClientControlEffect
: ChainIndexControlEffect : SigningProcessControlEffect
: LogObserve (LogMessage Text) : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(ChainIndexControlEffect
: SigningProcessControlEffect : LogObserve (LogMessage Text)
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x)
-> Eff
(ChainIndexControlEffect
: SigningProcessControlEffect : LogObserve (LogMessage Text)
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
forall a b. a -> (a -> b) -> b
& Eff
(NodeClientControlEffect
: ChainIndexControlEffect : SigningProcessControlEffect
: LogObserve (LogMessage Text) : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(ChainIndexControlEffect
: SigningProcessControlEffect : LogObserve (LogMessage Text)
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
forall (effs :: [* -> *]).
Members NodeClientEffs effs =>
Eff (NodeClientControlEffect : effs) ~> Eff effs
NC.handleNodeControl
Eff
(ChainIndexControlEffect
: SigningProcessControlEffect : LogObserve (LogMessage Text)
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> (Eff
(ChainIndexControlEffect
: SigningProcessControlEffect : LogObserve (LogMessage Text)
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> Eff
(SigningProcessControlEffect
: LogObserve (LogMessage Text) : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x)
-> Eff
(SigningProcessControlEffect
: LogObserve (LogMessage Text) : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall a b. a -> (a -> b) -> b
& (ChainIndexControlEffect
~> Eff
(SigningProcessControlEffect
: LogObserve (LogMessage Text) : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs))
-> Eff
(ChainIndexControlEffect
: SigningProcessControlEffect : LogObserve (LogMessage Text)
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
~> Eff
(SigningProcessControlEffect
: LogObserve (LogMessage Text) : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
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
(SigningProcessControlEffect
: LogObserve (LogMessage Text) : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
ChainIndex.handleControl
Eff
(SigningProcessControlEffect
: LogObserve (LogMessage Text) : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> (Eff
(SigningProcessControlEffect
: LogObserve (LogMessage Text) : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(LogObserve (LogMessage Text)
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x)
-> Eff
(LogObserve (LogMessage Text)
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
forall a b. a -> (a -> b) -> b
& Eff
(SigningProcessControlEffect
: LogObserve (LogMessage Text) : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(LogObserve (LogMessage Text)
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
forall (effs :: [* -> *]).
Members SigningProcessEffs effs =>
Eff (SigningProcessControlEffect : effs) ~> Eff effs
Wallet.handleSigningProcessControl
Eff
(LogObserve (LogMessage Text)
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> (Eff
(LogObserve (LogMessage Text)
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> Eff
(LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x)
-> Eff
(LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall a b. a -> (a -> b) -> b
& Eff
(LogObserve (LogMessage Text)
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> Eff
(LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall (effs :: [* -> *]).
Member (LogMsg Text) effs =>
Eff (LogObserve (LogMessage Text) : effs) ~> Eff effs
handleObserveLog
Eff
(LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> (Eff
(LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x)
-> Eff
(State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall a b. a -> (a -> b) -> b
& (LogMsg Text
~> Eff
(State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs))
-> Eff
(LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
~> Eff
(State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((Text -> EmulatorEvent')
-> LogMsg Text
~> Eff
(State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog (AReview EmulatorEvent' Text -> Text -> EmulatorEvent'
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview EmulatorEvent' Text
p4))
Eff
(State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> (Eff
(State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x)
-> Eff
(LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
forall a b. a -> (a -> b) -> b
& (State WalletState
~> Eff
(LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs))
-> Eff
(State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
~> Eff
(LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Lens' EmulatorState WalletState
-> State WalletState
~> Eff
(LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
forall s2 (effs :: [* -> *]) s1.
Member (State s2) effs =>
Lens' s2 s1 -> State s1 ~> Eff effs
handleZoomedState (Wallet -> Lens' EmulatorState WalletState
walletState Wallet
wallet))
Eff
(LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> (Eff
(LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> Eff
(State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x)
-> Eff
(State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall a b. a -> (a -> b) -> b
& (LogMsg WalletEvent
~> Eff
(State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs))
-> Eff
(LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
~> Eff
(State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((WalletEvent -> EmulatorEvent')
-> LogMsg WalletEvent
~> Eff
(State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog (AReview EmulatorEvent' WalletEvent -> WalletEvent -> EmulatorEvent'
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview EmulatorEvent' WalletEvent
p1))
Eff
(State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> (Eff
(State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x)
-> Eff
(LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
forall a b. a -> (a -> b) -> b
& (State NodeClientState
~> Eff
(LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs))
-> Eff
(State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
~> Eff
(LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Lens' EmulatorState NodeClientState
-> State NodeClientState
~> Eff
(LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
forall s2 (effs :: [* -> *]) s1.
Member (State s2) effs =>
Lens' s2 s1 -> State s1 ~> Eff effs
handleZoomedState (Wallet -> Lens' EmulatorState WalletState
walletState Wallet
wallet ((WalletState -> f WalletState)
-> EmulatorState -> f EmulatorState)
-> ((NodeClientState -> f NodeClientState)
-> WalletState -> f WalletState)
-> (NodeClientState -> f NodeClientState)
-> EmulatorState
-> f EmulatorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeClientState -> f NodeClientState)
-> WalletState -> f WalletState
Lens' WalletState NodeClientState
Wallet.nodeClient))
Eff
(LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> (Eff
(LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> Eff
(State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x)
-> Eff
(State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall a b. a -> (a -> b) -> b
& (LogMsg NodeClientEvent
~> Eff
(State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs))
-> Eff
(LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
~> Eff
(State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((NodeClientEvent -> EmulatorEvent')
-> LogMsg NodeClientEvent
~> Eff
(State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog (AReview EmulatorEvent' NodeClientEvent
-> NodeClientEvent -> EmulatorEvent'
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview EmulatorEvent' NodeClientEvent
p2))
Eff
(State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> (Eff
(State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x)
-> Eff
(LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
forall a b. a -> (a -> b) -> b
& (State ChainIndexEmulatorState
~> Eff
(LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs))
-> Eff
(State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
~> Eff
(LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Lens' EmulatorState ChainIndexEmulatorState
-> State ChainIndexEmulatorState
~> Eff
(LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
forall s2 (effs :: [* -> *]) s1.
Member (State s2) effs =>
Lens' s2 s1 -> State s1 ~> Eff effs
handleZoomedState (Wallet -> Lens' EmulatorState WalletState
walletState Wallet
wallet ((WalletState -> f WalletState)
-> EmulatorState -> f EmulatorState)
-> ((ChainIndexEmulatorState -> f ChainIndexEmulatorState)
-> WalletState -> f WalletState)
-> (ChainIndexEmulatorState -> f ChainIndexEmulatorState)
-> EmulatorState
-> f EmulatorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainIndexEmulatorState -> f ChainIndexEmulatorState)
-> WalletState -> f WalletState
Lens' WalletState ChainIndexEmulatorState
Wallet.chainIndexEmulatorState))
Eff
(LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> (Eff
(LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> Eff
(State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x)
-> Eff
(State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall a b. a -> (a -> b) -> b
& (LogMsg ChainIndexLog
~> Eff
(State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs))
-> Eff
(LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
~> Eff
(State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((ChainIndexLog -> EmulatorEvent')
-> LogMsg ChainIndexLog
~> Eff
(State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog (AReview EmulatorEvent' ChainIndexLog
-> ChainIndexLog -> EmulatorEvent'
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview EmulatorEvent' ChainIndexLog
p3))
Eff
(State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> (Eff
(State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff (Writer [LogMessage EmulatorEvent] : effs) x)
-> Eff (Writer [LogMessage EmulatorEvent] : effs) x
forall a b. a -> (a -> b) -> b
& (State (Maybe SigningProcess)
~> Eff (Writer [LogMessage EmulatorEvent] : effs))
-> Eff
(State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
~> Eff (Writer [LogMessage EmulatorEvent] : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Lens' EmulatorState (Maybe SigningProcess)
-> State (Maybe SigningProcess)
~> Eff (Writer [LogMessage EmulatorEvent] : effs)
forall s2 (effs :: [* -> *]) s1.
Member (State s2) effs =>
Lens' s2 s1 -> State s1 ~> Eff effs
handleZoomedState (Wallet -> Lens' EmulatorState WalletState
walletState Wallet
wallet ((WalletState -> f WalletState)
-> EmulatorState -> f EmulatorState)
-> ((Maybe SigningProcess -> f (Maybe SigningProcess))
-> WalletState -> f WalletState)
-> (Maybe SigningProcess -> f (Maybe SigningProcess))
-> EmulatorState
-> f EmulatorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe SigningProcess -> f (Maybe SigningProcess))
-> WalletState -> f WalletState
Lens' WalletState (Maybe SigningProcess)
Wallet.signingProcess))
Eff (Writer [LogMessage EmulatorEvent] : effs) x
-> (Eff (Writer [LogMessage EmulatorEvent] : effs) x -> Eff effs x)
-> Eff effs x
forall a b. a -> (a -> b) -> b
& (Writer [LogMessage EmulatorEvent] ~> Eff effs)
-> Eff (Writer [LogMessage EmulatorEvent] : effs) ~> Eff effs
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Setter' EmulatorState [LogMessage EmulatorEvent]
-> Writer [LogMessage EmulatorEvent] ~> Eff effs
forall s1 s2 (effs :: [* -> *]).
(Monoid s1, Member (State s2) effs) =>
Setter' s2 s1 -> Writer s1 ~> Eff effs
writeIntoState Lens' EmulatorState [LogMessage EmulatorEvent]
Setter' EmulatorState [LogMessage EmulatorEvent]
emulatorLog)
Assertion a -> Assertion -> Eff effs ()
forall (effs :: [* -> *]).
Members MultiAgentEffs effs =>
Assertion -> Eff effs ()
assert Assertion
a
handleMultiAgent
:: forall effs. Members MultiAgentEffs effs
=> Eff (MultiAgentEffect ': effs) ~> Eff effs
handleMultiAgent :: Eff (MultiAgentEffect : effs) ~> Eff effs
handleMultiAgent = (MultiAgentEffect ~> Eff effs)
-> Eff (MultiAgentEffect : effs) ~> Eff effs
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((MultiAgentEffect ~> Eff effs)
-> Eff (MultiAgentEffect : effs) ~> Eff effs)
-> (MultiAgentEffect ~> Eff effs)
-> Eff (MultiAgentEffect : effs) ~> Eff effs
forall a b. (a -> b) -> a -> b
$ \case
WalletAction wallet act -> do
let
p1 :: AReview EmulatorEvent' Wallet.WalletEvent
p1 :: AReview EmulatorEvent' WalletEvent
p1 = Wallet -> Prism' EmulatorEvent' WalletEvent
walletEvent Wallet
wallet
p2 :: AReview EmulatorEvent' NC.NodeClientEvent
p2 :: AReview EmulatorEvent' NodeClientEvent
p2 = Wallet -> Prism' EmulatorEvent' NodeClientEvent
walletClientEvent Wallet
wallet
p3 :: AReview EmulatorEvent' ChainIndex.ChainIndexLog
p3 :: AReview EmulatorEvent' ChainIndexLog
p3 = Wallet -> Prism' EmulatorEvent' ChainIndexLog
chainIndexEvent Wallet
wallet
p4 :: AReview EmulatorEvent' T.Text
p4 :: AReview EmulatorEvent' Text
p4 = Wallet -> Prism' EmulatorEvent' WalletEvent
walletEvent Wallet
wallet AReview EmulatorEvent' WalletEvent
-> (Tagged Text (Identity Text)
-> Tagged WalletEvent (Identity WalletEvent))
-> AReview EmulatorEvent' Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged Text (Identity Text)
-> Tagged WalletEvent (Identity WalletEvent)
Prism' WalletEvent Text
Wallet._GenericLog
p5 :: AReview EmulatorEvent' RequestHandlerLogMsg
p5 :: AReview EmulatorEvent' RequestHandlerLogMsg
p5 = Wallet -> Prism' EmulatorEvent' WalletEvent
walletEvent Wallet
wallet AReview EmulatorEvent' WalletEvent
-> (Tagged RequestHandlerLogMsg (Identity RequestHandlerLogMsg)
-> Tagged WalletEvent (Identity WalletEvent))
-> AReview EmulatorEvent' RequestHandlerLogMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged RequestHandlerLogMsg (Identity RequestHandlerLogMsg)
-> Tagged WalletEvent (Identity WalletEvent)
Prism' WalletEvent RequestHandlerLogMsg
Wallet._RequestHandlerLog
p6 :: AReview EmulatorEvent' TxBalanceMsg
p6 :: AReview EmulatorEvent' TxBalanceMsg
p6 = Wallet -> Prism' EmulatorEvent' WalletEvent
walletEvent Wallet
wallet AReview EmulatorEvent' WalletEvent
-> (Tagged TxBalanceMsg (Identity TxBalanceMsg)
-> Tagged WalletEvent (Identity WalletEvent))
-> AReview EmulatorEvent' TxBalanceMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged TxBalanceMsg (Identity TxBalanceMsg)
-> Tagged WalletEvent (Identity WalletEvent)
Prism' WalletEvent TxBalanceMsg
Wallet._TxBalanceLog
Eff EmulatedWalletEffects x
act
Eff EmulatedWalletEffects x
-> (Eff EmulatedWalletEffects x
-> Eff
(WalletEffect
: Error WalletAPIError : NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x)
-> Eff
(WalletEffect
: Error WalletAPIError : NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall a b. a -> (a -> b) -> b
& Eff EmulatedWalletEffects x
-> Eff
(WalletEffect
: Error WalletAPIError : NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall (effs :: [* -> *]) (as :: [* -> *]).
CanWeakenEnd as effs =>
Eff as ~> Eff effs
raiseEnd
Eff
(WalletEffect
: Error WalletAPIError : NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> (Eff
(WalletEffect
: Error WalletAPIError : NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(Error WalletAPIError
: NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x)
-> Eff
(Error WalletAPIError
: NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall a b. a -> (a -> b) -> b
& (WalletEffect
~> Eff
(Error WalletAPIError
: NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs))
-> Eff
(WalletEffect
: Error WalletAPIError : NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
~> Eff
(Error WalletAPIError
: NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret 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
(Error WalletAPIError
: NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
Wallet.handleWallet
Eff
(Error WalletAPIError
: NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> (Eff
(Error WalletAPIError
: NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(NodeClientEffect
: ChainIndexQueryEffect : LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x)
-> Eff
(NodeClientEffect
: ChainIndexQueryEffect : LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall a b. a -> (a -> b) -> b
& Eff
(Error WalletAPIError
: NodeClientEffect : ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(NodeClientEffect
: ChainIndexQueryEffect : LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall (eff :: * -> *) (effs :: [* -> *]).
Member eff effs =>
Eff (eff : effs) ~> Eff effs
subsume
Eff
(NodeClientEffect
: ChainIndexQueryEffect : LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> (Eff
(NodeClientEffect
: ChainIndexQueryEffect : LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x)
-> Eff
(ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall a b. a -> (a -> b) -> b
& Eff
(NodeClientEffect
: ChainIndexQueryEffect : LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall (effs :: [* -> *]).
Members NodeClientEffs effs =>
Eff (NodeClientEffect : effs) ~> Eff effs
NC.handleNodeClient
Eff
(ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> (Eff
(ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x)
-> Eff
(LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall a b. a -> (a -> b) -> b
& (ChainIndexQueryEffect
~> Eff
(LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs))
-> Eff
(ChainIndexQueryEffect
: LogObserve (LogMessage Text) : LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
~> Eff
(LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
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
(LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
ChainIndex.handleQuery
Eff
(LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> (Eff
(LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x)
-> Eff
(LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall a b. a -> (a -> b) -> b
& Eff
(LogObserve (LogMessage Text)
: LogMsg RequestHandlerLogMsg : LogMsg TxBalanceMsg : LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall (effs :: [* -> *]).
Member (LogMsg Text) effs =>
Eff (LogObserve (LogMessage Text) : effs) ~> Eff effs
handleObserveLog
Eff
(LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> (Eff
(LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(LogMsg TxBalanceMsg
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x)
-> Eff
(LogMsg TxBalanceMsg
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
forall a b. a -> (a -> b) -> b
& (LogMsg RequestHandlerLogMsg
~> Eff
(LogMsg TxBalanceMsg
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs))
-> Eff
(LogMsg RequestHandlerLogMsg
: LogMsg TxBalanceMsg : LogMsg Text : State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
~> Eff
(LogMsg TxBalanceMsg
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((RequestHandlerLogMsg -> EmulatorEvent')
-> LogMsg RequestHandlerLogMsg
~> Eff
(LogMsg TxBalanceMsg
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog (AReview EmulatorEvent' RequestHandlerLogMsg
-> RequestHandlerLogMsg -> EmulatorEvent'
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview EmulatorEvent' RequestHandlerLogMsg
p5))
Eff
(LogMsg TxBalanceMsg
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> (Eff
(LogMsg TxBalanceMsg
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> Eff
(LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x)
-> Eff
(LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall a b. a -> (a -> b) -> b
& (LogMsg TxBalanceMsg
~> Eff
(LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs))
-> Eff
(LogMsg TxBalanceMsg
: LogMsg Text : State WalletState : LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
~> Eff
(LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((TxBalanceMsg -> EmulatorEvent')
-> LogMsg TxBalanceMsg
~> Eff
(LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog (AReview EmulatorEvent' TxBalanceMsg
-> TxBalanceMsg -> EmulatorEvent'
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview EmulatorEvent' TxBalanceMsg
p6))
Eff
(LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> (Eff
(LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x)
-> Eff
(State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall a b. a -> (a -> b) -> b
& (LogMsg Text
~> Eff
(State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs))
-> Eff
(LogMsg Text
: State WalletState : LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
~> Eff
(State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((Text -> EmulatorEvent')
-> LogMsg Text
~> Eff
(State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog (AReview EmulatorEvent' Text -> Text -> EmulatorEvent'
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview EmulatorEvent' Text
p4))
Eff
(State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> (Eff
(State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x)
-> Eff
(LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
forall a b. a -> (a -> b) -> b
& (State WalletState
~> Eff
(LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs))
-> Eff
(State WalletState
: LogMsg WalletEvent : State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
~> Eff
(LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Lens' EmulatorState WalletState
-> State WalletState
~> Eff
(LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
forall s2 (effs :: [* -> *]) s1.
Member (State s2) effs =>
Lens' s2 s1 -> State s1 ~> Eff effs
handleZoomedState (Wallet -> Lens' EmulatorState WalletState
walletState Wallet
wallet))
Eff
(LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> (Eff
(LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> Eff
(State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x)
-> Eff
(State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall a b. a -> (a -> b) -> b
& (LogMsg WalletEvent
~> Eff
(State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs))
-> Eff
(LogMsg WalletEvent
: State NodeClientState : LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
~> Eff
(State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((WalletEvent -> EmulatorEvent')
-> LogMsg WalletEvent
~> Eff
(State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog (AReview EmulatorEvent' WalletEvent -> WalletEvent -> EmulatorEvent'
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview EmulatorEvent' WalletEvent
p1))
Eff
(State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> (Eff
(State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x)
-> Eff
(LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
forall a b. a -> (a -> b) -> b
& (State NodeClientState
~> Eff
(LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs))
-> Eff
(State NodeClientState
: LogMsg NodeClientEvent : State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
~> Eff
(LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Lens' EmulatorState NodeClientState
-> State NodeClientState
~> Eff
(LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
forall s2 (effs :: [* -> *]) s1.
Member (State s2) effs =>
Lens' s2 s1 -> State s1 ~> Eff effs
handleZoomedState (Wallet -> Lens' EmulatorState WalletState
walletState Wallet
wallet ((WalletState -> f WalletState)
-> EmulatorState -> f EmulatorState)
-> ((NodeClientState -> f NodeClientState)
-> WalletState -> f WalletState)
-> (NodeClientState -> f NodeClientState)
-> EmulatorState
-> f EmulatorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeClientState -> f NodeClientState)
-> WalletState -> f WalletState
Lens' WalletState NodeClientState
Wallet.nodeClient))
Eff
(LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> (Eff
(LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> Eff
(State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x)
-> Eff
(State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall a b. a -> (a -> b) -> b
& (LogMsg NodeClientEvent
~> Eff
(State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs))
-> Eff
(LogMsg NodeClientEvent
: State ChainIndexEmulatorState : LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
~> Eff
(State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((NodeClientEvent -> EmulatorEvent')
-> LogMsg NodeClientEvent
~> Eff
(State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog (AReview EmulatorEvent' NodeClientEvent
-> NodeClientEvent -> EmulatorEvent'
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview EmulatorEvent' NodeClientEvent
p2))
Eff
(State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> (Eff
(State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff
(LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x)
-> Eff
(LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
forall a b. a -> (a -> b) -> b
& (State ChainIndexEmulatorState
~> Eff
(LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs))
-> Eff
(State ChainIndexEmulatorState
: LogMsg ChainIndexLog : State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
~> Eff
(LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Lens' EmulatorState ChainIndexEmulatorState
-> State ChainIndexEmulatorState
~> Eff
(LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
forall s2 (effs :: [* -> *]) s1.
Member (State s2) effs =>
Lens' s2 s1 -> State s1 ~> Eff effs
handleZoomedState (Wallet -> Lens' EmulatorState WalletState
walletState Wallet
wallet ((WalletState -> f WalletState)
-> EmulatorState -> f EmulatorState)
-> ((ChainIndexEmulatorState -> f ChainIndexEmulatorState)
-> WalletState -> f WalletState)
-> (ChainIndexEmulatorState -> f ChainIndexEmulatorState)
-> EmulatorState
-> f EmulatorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainIndexEmulatorState -> f ChainIndexEmulatorState)
-> WalletState -> f WalletState
Lens' WalletState ChainIndexEmulatorState
Wallet.chainIndexEmulatorState))
Eff
(LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> (Eff
(LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
x
-> Eff
(State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x)
-> Eff
(State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
forall a b. a -> (a -> b) -> b
& (LogMsg ChainIndexLog
~> Eff
(State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs))
-> Eff
(LogMsg ChainIndexLog
: State (Maybe SigningProcess) : Writer [LogMessage EmulatorEvent]
: effs)
~> Eff
(State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret ((ChainIndexLog -> EmulatorEvent')
-> LogMsg ChainIndexLog
~> Eff
(State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
forall a b (effs :: [* -> *]).
Member (LogMsg b) effs =>
(a -> b) -> LogMsg a ~> Eff effs
mapLog (AReview EmulatorEvent' ChainIndexLog
-> ChainIndexLog -> EmulatorEvent'
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview EmulatorEvent' ChainIndexLog
p3))
Eff
(State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> (Eff
(State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
x
-> Eff (Writer [LogMessage EmulatorEvent] : effs) x)
-> Eff (Writer [LogMessage EmulatorEvent] : effs) x
forall a b. a -> (a -> b) -> b
& (State (Maybe SigningProcess)
~> Eff (Writer [LogMessage EmulatorEvent] : effs))
-> Eff
(State (Maybe SigningProcess)
: Writer [LogMessage EmulatorEvent] : effs)
~> Eff (Writer [LogMessage EmulatorEvent] : effs)
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Lens' EmulatorState (Maybe SigningProcess)
-> State (Maybe SigningProcess)
~> Eff (Writer [LogMessage EmulatorEvent] : effs)
forall s2 (effs :: [* -> *]) s1.
Member (State s2) effs =>
Lens' s2 s1 -> State s1 ~> Eff effs
handleZoomedState (Wallet -> Lens' EmulatorState WalletState
walletState Wallet
wallet ((WalletState -> f WalletState)
-> EmulatorState -> f EmulatorState)
-> ((Maybe SigningProcess -> f (Maybe SigningProcess))
-> WalletState -> f WalletState)
-> (Maybe SigningProcess -> f (Maybe SigningProcess))
-> EmulatorState
-> f EmulatorState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe SigningProcess -> f (Maybe SigningProcess))
-> WalletState -> f WalletState
Lens' WalletState (Maybe SigningProcess)
Wallet.signingProcess))
Eff (Writer [LogMessage EmulatorEvent] : effs) x
-> (Eff (Writer [LogMessage EmulatorEvent] : effs) x -> Eff effs x)
-> Eff effs x
forall a b. a -> (a -> b) -> b
& (Writer [LogMessage EmulatorEvent] ~> Eff effs)
-> Eff (Writer [LogMessage EmulatorEvent] : effs) ~> Eff effs
forall (eff :: * -> *) (effs :: [* -> *]).
(eff ~> Eff effs) -> Eff (eff : effs) ~> Eff effs
interpret (Setter' EmulatorState [LogMessage EmulatorEvent]
-> Writer [LogMessage EmulatorEvent] ~> Eff effs
forall s1 s2 (effs :: [* -> *]).
(Monoid s1, Member (State s2) effs) =>
Setter' s2 s1 -> Writer s1 ~> Eff effs
writeIntoState Lens' EmulatorState [LogMessage EmulatorEvent]
Setter' EmulatorState [LogMessage EmulatorEvent]
emulatorLog)
assert :: (Members MultiAgentEffs effs) => Assertion -> Eff effs ()
assert :: Assertion -> Eff effs ()
assert (IsValidated CardanoTx
txn) = CardanoTx -> Eff effs ()
forall (effs :: [* -> *]).
Members MultiAgentEffs effs =>
CardanoTx -> Eff effs ()
isValidated CardanoTx
txn
assert (OwnFundsEqual Wallet
wallet Value
value) = Wallet -> Value -> Eff effs ()
forall (effs :: [* -> *]).
Members MultiAgentEffs effs =>
Wallet -> Value -> Eff effs ()
ownFundsEqual Wallet
wallet Value
value
ownFundsEqual :: (Members MultiAgentEffs effs) => Wallet -> Value -> Eff effs ()
ownFundsEqual :: Wallet -> Value -> Eff effs ()
ownFundsEqual Wallet
wallet Value
value = do
EmulatorState
es <- Eff effs EmulatorState
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get
let total :: Value
total = ((CardanoTx, TxOut) -> Value)
-> Map TxOutRef (CardanoTx, TxOut) -> Value
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (TxOut -> Value
txOutValue (TxOut -> Value)
-> ((CardanoTx, TxOut) -> TxOut) -> (CardanoTx, TxOut) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoTx, TxOut) -> TxOut
forall a b. (a, b) -> b
snd) (Map TxOutRef (CardanoTx, TxOut) -> Value)
-> Map TxOutRef (CardanoTx, TxOut) -> Value
forall a b. (a -> b) -> a -> b
$ EmulatorState
es EmulatorState
-> Getting
(Map TxOutRef (CardanoTx, TxOut))
EmulatorState
(Map TxOutRef (CardanoTx, TxOut))
-> Map TxOutRef (CardanoTx, TxOut)
forall s a. s -> Getting a s a -> a
^. (AddressMap -> Const (Map TxOutRef (CardanoTx, TxOut)) AddressMap)
-> EmulatorState
-> Const (Map TxOutRef (CardanoTx, TxOut)) EmulatorState
Getter EmulatorState AddressMap
chainUtxo ((AddressMap -> Const (Map TxOutRef (CardanoTx, TxOut)) AddressMap)
-> EmulatorState
-> Const (Map TxOutRef (CardanoTx, TxOut)) EmulatorState)
-> Getting
(Map TxOutRef (CardanoTx, TxOut))
AddressMap
(Map TxOutRef (CardanoTx, TxOut))
-> Getting
(Map TxOutRef (CardanoTx, TxOut))
EmulatorState
(Map TxOutRef (CardanoTx, TxOut))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoAddress
-> Lens' AddressMap (Map TxOutRef (CardanoTx, TxOut))
AM.fundsAt (Wallet -> CardanoAddress
Wallet.mockWalletAddress Wallet
wallet)
if Value
value Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
total
then () -> Eff effs ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
else AssertionError -> Eff effs ()
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (AssertionError -> Eff effs ()) -> AssertionError -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ Text -> AssertionError
GenericAssertion (Text -> AssertionError) -> Text -> AssertionError
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text
"Funds in wallet", Wallet -> Text
forall a. Show a => a -> Text
tshow Wallet
wallet, Text
"were", Value -> Text
forall a. Show a => a -> Text
tshow Value
total, Text
". Expected:", Value -> Text
forall a. Show a => a -> Text
tshow Value
value]
isValidated :: (Members MultiAgentEffs effs) => CardanoTx -> Eff effs ()
isValidated :: CardanoTx -> Eff effs ()
isValidated CardanoTx
txn = do
EmulatorState
emState <- Eff effs EmulatorState
forall s (effs :: [* -> *]). Member (State s) effs => Eff effs s
get
if OnChainTx -> [OnChainTx] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem (CardanoTx -> OnChainTx
Valid CardanoTx
txn) (Blockchain -> [OnChainTx]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Blockchain -> [OnChainTx]) -> Blockchain -> [OnChainTx]
forall a b. (a -> b) -> a -> b
$ EmulatorState
emState EmulatorState
-> Getting Blockchain EmulatorState Blockchain -> Blockchain
forall s a. s -> Getting a s a -> a
^. (ChainState -> Const Blockchain ChainState)
-> EmulatorState -> Const Blockchain EmulatorState
Lens' EmulatorState ChainState
chainState ((ChainState -> Const Blockchain ChainState)
-> EmulatorState -> Const Blockchain EmulatorState)
-> ((Blockchain -> Const Blockchain Blockchain)
-> ChainState -> Const Blockchain ChainState)
-> Getting Blockchain EmulatorState Blockchain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Blockchain -> Const Blockchain Blockchain)
-> ChainState -> Const Blockchain ChainState
Lens' ChainState Blockchain
Chain.chainNewestFirst)
then AssertionError -> Eff effs ()
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (AssertionError -> Eff effs ()) -> AssertionError -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ Text -> AssertionError
GenericAssertion (Text -> AssertionError) -> Text -> AssertionError
forall a b. (a -> b) -> a -> b
$ Text
"Txn not validated: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (CardanoTx -> String
forall a. Show a => a -> String
show CardanoTx
txn)
else () -> Eff effs ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
_singleton :: AReview [a] a
_singleton :: AReview [a] a
_singleton = (a -> [a]) -> AReview [a] a
forall (p :: * -> * -> *) (f :: * -> *) b t s a.
(Profunctor p, Bifunctor p, Functor f) =>
(b -> t) -> Optic p f s t a b
unto a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return