{-# LANGUAGE AllowAmbiguousTypes    #-}
{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE DeriveAnyClass         #-}
{-# LANGUAGE DeriveGeneric          #-}
{-# LANGUAGE DerivingStrategies     #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase             #-}
{-# LANGUAGE NamedFieldPuns         #-}
{-# LANGUAGE NumericUnderscores     #-}
{-# LANGUAGE OverloadedStrings      #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE TemplateHaskell        #-}
{-# LANGUAGE TypeApplications       #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeOperators          #-}
-- | A trace is a sequence of actions by simulated wallets that can be run
--   on the mockchain. This module contains the functions needed to build
--   traces.
module Plutus.Contract.Trace
    ( TraceError(..)
    , EndpointError(..)
    , AsTraceError(..)
    , toNotifyError
    -- * Handle contract requests
    , handleAdjustUnbalancedTx
    , handleSlotNotifications
    , handleTimeNotifications
    , handleOwnAddressesQueries
    , handleCurrentNodeClientSlotQueries
    , handleCurrentChainIndexSlotQueries
    , handleCurrentTimeQueries
    , handleCurrentNodeClientTimeRangeQueries
    , handleTimeToSlotConversions
    , handleUnbalancedTransactions
    , handlePendingTransactions
    , handleChainIndexQueries
    , handleOwnInstanceIdQueries
    , handleYieldedUnbalancedTx
    , handleGetParams
    -- * Initial distributions of emulated chains
    , InitialDistribution
    , defaultDist
    , defaultDistFor
    -- * Wallets
    , EM.Wallet(..)
    , EM.mockWalletAddress
    , EM.mockWalletPaymentPubKey
    , EM.mockWalletPaymentPubKeyHash
    , EM.knownWallets
    , EM.knownWallet
    ) where

import Control.Lens (makeClassyPrisms, preview)
import Control.Monad.Freer (Member)
import Control.Monad.Freer.Extras.Log (LogMessage, LogMsg, LogObserve)
import Control.Monad.Freer.Reader (Reader)
import Data.Aeson.Types qualified as JSON
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Text (Text)
import GHC.Generics (Generic)
import Ledger.Value.CardanoAPI (Value, lovelaceValueOf)
import Plutus.ChainIndex (ChainIndexQueryEffect)
import Plutus.Contract.Effects (PABReq, PABResp)
import Plutus.Contract.Effects qualified as E
import Plutus.Contract.Trace.RequestHandler (RequestHandler, RequestHandlerLogMsg, generalise)
import Plutus.Contract.Trace.RequestHandler qualified as RequestHandler
import Prettyprinter (Pretty, pretty, (<+>))
import Wallet.Effects (NodeClientEffect, WalletEffect)
import Wallet.Emulator (Wallet)
import Wallet.Emulator qualified as EM
import Wallet.Types (ContractInstanceId, EndpointDescription, NotificationError (EndpointNotAvailable))

data EndpointError =
    EndpointNotActive (Maybe Wallet) EndpointDescription
    deriving stock (EndpointError -> EndpointError -> Bool
(EndpointError -> EndpointError -> Bool)
-> (EndpointError -> EndpointError -> Bool) -> Eq EndpointError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EndpointError -> EndpointError -> Bool
$c/= :: EndpointError -> EndpointError -> Bool
== :: EndpointError -> EndpointError -> Bool
$c== :: EndpointError -> EndpointError -> Bool
Eq, Int -> EndpointError -> ShowS
[EndpointError] -> ShowS
EndpointError -> String
(Int -> EndpointError -> ShowS)
-> (EndpointError -> String)
-> ([EndpointError] -> ShowS)
-> Show EndpointError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EndpointError] -> ShowS
$cshowList :: [EndpointError] -> ShowS
show :: EndpointError -> String
$cshow :: EndpointError -> String
showsPrec :: Int -> EndpointError -> ShowS
$cshowsPrec :: Int -> EndpointError -> ShowS
Show, (forall x. EndpointError -> Rep EndpointError x)
-> (forall x. Rep EndpointError x -> EndpointError)
-> Generic EndpointError
forall x. Rep EndpointError x -> EndpointError
forall x. EndpointError -> Rep EndpointError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EndpointError x -> EndpointError
$cfrom :: forall x. EndpointError -> Rep EndpointError x
Generic)
    deriving anyclass ([EndpointError] -> Encoding
[EndpointError] -> Value
EndpointError -> Encoding
EndpointError -> Value
(EndpointError -> Value)
-> (EndpointError -> Encoding)
-> ([EndpointError] -> Value)
-> ([EndpointError] -> Encoding)
-> ToJSON EndpointError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EndpointError] -> Encoding
$ctoEncodingList :: [EndpointError] -> Encoding
toJSONList :: [EndpointError] -> Value
$ctoJSONList :: [EndpointError] -> Value
toEncoding :: EndpointError -> Encoding
$ctoEncoding :: EndpointError -> Encoding
toJSON :: EndpointError -> Value
$ctoJSON :: EndpointError -> Value
JSON.ToJSON, Value -> Parser [EndpointError]
Value -> Parser EndpointError
(Value -> Parser EndpointError)
-> (Value -> Parser [EndpointError]) -> FromJSON EndpointError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EndpointError]
$cparseJSONList :: Value -> Parser [EndpointError]
parseJSON :: Value -> Parser EndpointError
$cparseJSON :: Value -> Parser EndpointError
JSON.FromJSON)

instance Pretty EndpointError where
    pretty :: EndpointError -> Doc ann
pretty = \case
        EndpointNotActive Maybe Wallet
w EndpointDescription
e ->
            Doc ann
"Endpoint not active:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Maybe Wallet -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe Wallet
w Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> EndpointDescription -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty EndpointDescription
e

toNotifyError :: ContractInstanceId -> EndpointError -> NotificationError
toNotifyError :: ContractInstanceId -> EndpointError -> NotificationError
toNotifyError ContractInstanceId
i = \case
    EndpointNotActive Maybe Wallet
_ EndpointDescription
e       -> ContractInstanceId -> EndpointDescription -> NotificationError
EndpointNotAvailable ContractInstanceId
i EndpointDescription
e

-- | Error produced while running a trace. Either a contract-specific
--   error (of type 'e'), or an 'EM.AssertionError' from the emulator.
data TraceError e =
    TraceAssertionError EM.AssertionError
    | TContractError e
    | HookError EndpointError
    deriving (TraceError e -> TraceError e -> Bool
(TraceError e -> TraceError e -> Bool)
-> (TraceError e -> TraceError e -> Bool) -> Eq (TraceError e)
forall e. Eq e => TraceError e -> TraceError e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TraceError e -> TraceError e -> Bool
$c/= :: forall e. Eq e => TraceError e -> TraceError e -> Bool
== :: TraceError e -> TraceError e -> Bool
$c== :: forall e. Eq e => TraceError e -> TraceError e -> Bool
Eq, Int -> TraceError e -> ShowS
[TraceError e] -> ShowS
TraceError e -> String
(Int -> TraceError e -> ShowS)
-> (TraceError e -> String)
-> ([TraceError e] -> ShowS)
-> Show (TraceError e)
forall e. Show e => Int -> TraceError e -> ShowS
forall e. Show e => [TraceError e] -> ShowS
forall e. Show e => TraceError e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraceError e] -> ShowS
$cshowList :: forall e. Show e => [TraceError e] -> ShowS
show :: TraceError e -> String
$cshow :: forall e. Show e => TraceError e -> String
showsPrec :: Int -> TraceError e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> TraceError e -> ShowS
Show)

type InitialDistribution = Map Wallet Value

handleSlotNotifications ::
    ( Member (LogObserve (LogMessage Text)) effs
    , Member (LogMsg RequestHandlerLogMsg) effs
    , Member NodeClientEffect effs
    )
    => RequestHandler effs PABReq PABResp
handleSlotNotifications :: RequestHandler effs PABReq PABResp
handleSlotNotifications =
    (PABReq -> Maybe Slot)
-> (Slot -> PABResp)
-> RequestHandler effs Slot Slot
-> RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]) req req' resp resp'.
(req' -> Maybe req)
-> (resp -> resp')
-> RequestHandler effs req resp
-> RequestHandler effs req' resp'
generalise (Getting (First Slot) PABReq Slot -> PABReq -> Maybe Slot
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Slot) PABReq Slot
Prism' PABReq Slot
E._AwaitSlotReq) Slot -> PABResp
E.AwaitSlotResp RequestHandler effs Slot Slot
forall (effs :: [* -> *]).
(Member NodeClientEffect effs,
 Member (LogObserve (LogMessage Text)) effs,
 Member (LogMsg RequestHandlerLogMsg) effs) =>
RequestHandler effs Slot Slot
RequestHandler.handleSlotNotifications

handleTimeNotifications ::
    ( Member (LogObserve (LogMessage Text)) effs
    , Member (LogMsg RequestHandlerLogMsg) effs
    , Member NodeClientEffect effs
    )
    => RequestHandler effs PABReq PABResp
handleTimeNotifications :: RequestHandler effs PABReq PABResp
handleTimeNotifications =
    (PABReq -> Maybe POSIXTime)
-> (POSIXTime -> PABResp)
-> RequestHandler effs POSIXTime POSIXTime
-> RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]) req req' resp resp'.
(req' -> Maybe req)
-> (resp -> resp')
-> RequestHandler effs req resp
-> RequestHandler effs req' resp'
generalise (Getting (First POSIXTime) PABReq POSIXTime
-> PABReq -> Maybe POSIXTime
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First POSIXTime) PABReq POSIXTime
Prism' PABReq POSIXTime
E._AwaitTimeReq) POSIXTime -> PABResp
E.AwaitTimeResp RequestHandler effs POSIXTime POSIXTime
forall (effs :: [* -> *]).
(Member NodeClientEffect effs,
 Member (LogObserve (LogMessage Text)) effs,
 Member (LogMsg RequestHandlerLogMsg) effs) =>
RequestHandler effs POSIXTime POSIXTime
RequestHandler.handleTimeNotifications

handleCurrentNodeClientSlotQueries ::
    ( Member (LogObserve (LogMessage Text)) effs
    , Member NodeClientEffect effs
    )
    => RequestHandler effs PABReq PABResp
handleCurrentNodeClientSlotQueries :: RequestHandler effs PABReq PABResp
handleCurrentNodeClientSlotQueries =
    (PABReq -> Maybe ())
-> (Slot -> PABResp)
-> RequestHandler effs () Slot
-> RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]) req req' resp resp'.
(req' -> Maybe req)
-> (resp -> resp')
-> RequestHandler effs req resp
-> RequestHandler effs req' resp'
generalise (Getting (First ()) PABReq () -> PABReq -> Maybe ()
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ()) PABReq ()
Prism' PABReq ()
E._CurrentNodeClientSlotReq) Slot -> PABResp
E.CurrentNodeClientSlotResp RequestHandler effs () Slot
forall (effs :: [* -> *]) a.
(Member NodeClientEffect effs,
 Member (LogObserve (LogMessage Text)) effs) =>
RequestHandler effs a Slot
RequestHandler.handleCurrentNodeClientSlot

handleCurrentChainIndexSlotQueries ::
    ( Member (LogObserve (LogMessage Text)) effs
    , Member ChainIndexQueryEffect effs
    )
    => RequestHandler effs PABReq PABResp
handleCurrentChainIndexSlotQueries :: RequestHandler effs PABReq PABResp
handleCurrentChainIndexSlotQueries =
    (PABReq -> Maybe ())
-> (Slot -> PABResp)
-> RequestHandler effs () Slot
-> RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]) req req' resp resp'.
(req' -> Maybe req)
-> (resp -> resp')
-> RequestHandler effs req resp
-> RequestHandler effs req' resp'
generalise (Getting (First ()) PABReq () -> PABReq -> Maybe ()
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ()) PABReq ()
Prism' PABReq ()
E._CurrentChainIndexSlotReq) Slot -> PABResp
E.CurrentChainIndexSlotResp RequestHandler effs () Slot
forall (effs :: [* -> *]) a.
(Member (LogObserve (LogMessage Text)) effs,
 Member ChainIndexQueryEffect effs) =>
RequestHandler effs a Slot
RequestHandler.handleCurrentChainIndexSlot

handleCurrentTimeQueries ::
    ( Member (LogObserve (LogMessage Text)) effs
    , Member NodeClientEffect effs
    )
    => RequestHandler effs PABReq PABResp
handleCurrentTimeQueries :: RequestHandler effs PABReq PABResp
handleCurrentTimeQueries =
    (PABReq -> Maybe ())
-> (POSIXTime -> PABResp)
-> RequestHandler effs () POSIXTime
-> RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]) req req' resp resp'.
(req' -> Maybe req)
-> (resp -> resp')
-> RequestHandler effs req resp
-> RequestHandler effs req' resp'
generalise (Getting (First ()) PABReq () -> PABReq -> Maybe ()
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ()) PABReq ()
Prism' PABReq ()
E._CurrentTimeReq) POSIXTime -> PABResp
E.CurrentTimeResp RequestHandler effs () POSIXTime
forall (effs :: [* -> *]) a.
(Member NodeClientEffect effs,
 Member (LogObserve (LogMessage Text)) effs) =>
RequestHandler effs a POSIXTime
RequestHandler.handleCurrentTime

handleCurrentNodeClientTimeRangeQueries ::
    ( Member (LogObserve (LogMessage Text)) effs
    , Member NodeClientEffect effs
    )
    => RequestHandler effs PABReq PABResp
handleCurrentNodeClientTimeRangeQueries :: RequestHandler effs PABReq PABResp
handleCurrentNodeClientTimeRangeQueries =
    (PABReq -> Maybe ())
-> ((POSIXTime, POSIXTime) -> PABResp)
-> RequestHandler effs () (POSIXTime, POSIXTime)
-> RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]) req req' resp resp'.
(req' -> Maybe req)
-> (resp -> resp')
-> RequestHandler effs req resp
-> RequestHandler effs req' resp'
generalise
        (Getting (First ()) PABReq () -> PABReq -> Maybe ()
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ()) PABReq ()
Prism' PABReq ()
E._CurrentNodeClientTimeRangeReq)
        (POSIXTime, POSIXTime) -> PABResp
E.CurrentNodeClientTimeRangeResp
        RequestHandler effs () (POSIXTime, POSIXTime)
forall (effs :: [* -> *]) a.
(Member NodeClientEffect effs,
 Member (LogObserve (LogMessage Text)) effs) =>
RequestHandler effs a (POSIXTime, POSIXTime)
RequestHandler.handleCurrentNodeClientTimeRange

handleTimeToSlotConversions ::
    ( Member (LogObserve (LogMessage Text)) effs
    , Member NodeClientEffect effs
    )
    => RequestHandler effs PABReq PABResp
handleTimeToSlotConversions :: RequestHandler effs PABReq PABResp
handleTimeToSlotConversions =
    (PABReq -> Maybe POSIXTimeRange)
-> (SlotRange -> PABResp)
-> RequestHandler effs POSIXTimeRange SlotRange
-> RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]) req req' resp resp'.
(req' -> Maybe req)
-> (resp -> resp')
-> RequestHandler effs req resp
-> RequestHandler effs req' resp'
generalise (Getting (First POSIXTimeRange) PABReq POSIXTimeRange
-> PABReq -> Maybe POSIXTimeRange
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First POSIXTimeRange) PABReq POSIXTimeRange
Prism' PABReq POSIXTimeRange
E._PosixTimeRangeToContainedSlotRangeReq) (Either SlotConversionError SlotRange -> PABResp
E.PosixTimeRangeToContainedSlotRangeResp (Either SlotConversionError SlotRange -> PABResp)
-> (SlotRange -> Either SlotConversionError SlotRange)
-> SlotRange
-> PABResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotRange -> Either SlotConversionError SlotRange
forall a b. b -> Either a b
Right) RequestHandler effs POSIXTimeRange SlotRange
forall (effs :: [* -> *]).
(Member NodeClientEffect effs,
 Member (LogObserve (LogMessage Text)) effs) =>
RequestHandler effs POSIXTimeRange SlotRange
RequestHandler.handleTimeToSlotConversions

handleUnbalancedTransactions ::
    ( Member (LogObserve (LogMessage Text)) effs
    , Member (LogMsg RequestHandlerLogMsg) effs
    , Member WalletEffect effs
    )
    => RequestHandler effs PABReq PABResp
handleUnbalancedTransactions :: RequestHandler effs PABReq PABResp
handleUnbalancedTransactions =
    (PABReq -> Maybe UnbalancedTx)
-> (Either WalletAPIError CardanoTx -> PABResp)
-> RequestHandler
     effs UnbalancedTx (Either WalletAPIError CardanoTx)
-> RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]) req req' resp resp'.
(req' -> Maybe req)
-> (resp -> resp')
-> RequestHandler effs req resp
-> RequestHandler effs req' resp'
generalise
        (Getting (First UnbalancedTx) PABReq UnbalancedTx
-> PABReq -> Maybe UnbalancedTx
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First UnbalancedTx) PABReq UnbalancedTx
Prism' PABReq UnbalancedTx
E._BalanceTxReq)
        (BalanceTxResponse -> PABResp
E.BalanceTxResp (BalanceTxResponse -> PABResp)
-> (Either WalletAPIError CardanoTx -> BalanceTxResponse)
-> Either WalletAPIError CardanoTx
-> PABResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WalletAPIError -> BalanceTxResponse)
-> (CardanoTx -> BalanceTxResponse)
-> Either WalletAPIError CardanoTx
-> BalanceTxResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either WalletAPIError -> BalanceTxResponse
E.BalanceTxFailed CardanoTx -> BalanceTxResponse
E.BalanceTxSuccess)
        RequestHandler effs UnbalancedTx (Either WalletAPIError CardanoTx)
forall (effs :: [* -> *]).
(Member WalletEffect effs,
 Member (LogObserve (LogMessage Text)) effs,
 Member (LogMsg RequestHandlerLogMsg) effs) =>
RequestHandler effs UnbalancedTx (Either WalletAPIError CardanoTx)
RequestHandler.handleUnbalancedTransactions

-- | Submit the wallet's pending transactions to the blockchain.
handlePendingTransactions ::
    ( Member (LogObserve (LogMessage Text)) effs
    , Member (LogMsg RequestHandlerLogMsg) effs
    , Member WalletEffect effs
    )
    => RequestHandler effs PABReq PABResp
handlePendingTransactions :: RequestHandler effs PABReq PABResp
handlePendingTransactions =
    (PABReq -> Maybe CardanoTx)
-> (Either WalletAPIError CardanoTx -> PABResp)
-> RequestHandler effs CardanoTx (Either WalletAPIError CardanoTx)
-> RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]) req req' resp resp'.
(req' -> Maybe req)
-> (resp -> resp')
-> RequestHandler effs req resp
-> RequestHandler effs req' resp'
generalise
        (Getting (First CardanoTx) PABReq CardanoTx
-> PABReq -> Maybe CardanoTx
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First CardanoTx) PABReq CardanoTx
Prism' PABReq CardanoTx
E._WriteBalancedTxReq)
        (WriteBalancedTxResponse -> PABResp
E.WriteBalancedTxResp (WriteBalancedTxResponse -> PABResp)
-> (Either WalletAPIError CardanoTx -> WriteBalancedTxResponse)
-> Either WalletAPIError CardanoTx
-> PABResp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WalletAPIError -> WriteBalancedTxResponse)
-> (CardanoTx -> WriteBalancedTxResponse)
-> Either WalletAPIError CardanoTx
-> WriteBalancedTxResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either WalletAPIError -> WriteBalancedTxResponse
E.WriteBalancedTxFailed CardanoTx -> WriteBalancedTxResponse
E.WriteBalancedTxSuccess)
        RequestHandler effs CardanoTx (Either WalletAPIError CardanoTx)
forall (effs :: [* -> *]).
(Member WalletEffect effs,
 Member (LogObserve (LogMessage Text)) effs,
 Member (LogMsg RequestHandlerLogMsg) effs) =>
RequestHandler effs CardanoTx (Either WalletAPIError CardanoTx)
RequestHandler.handlePendingTransactions

handleChainIndexQueries ::
    ( Member (LogObserve (LogMessage Text)) effs
    , Member ChainIndexQueryEffect effs
    )
    => RequestHandler effs PABReq PABResp
handleChainIndexQueries :: RequestHandler effs PABReq PABResp
handleChainIndexQueries =
    (PABReq -> Maybe ChainIndexQuery)
-> (ChainIndexResponse -> PABResp)
-> RequestHandler effs ChainIndexQuery ChainIndexResponse
-> RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]) req req' resp resp'.
(req' -> Maybe req)
-> (resp -> resp')
-> RequestHandler effs req resp
-> RequestHandler effs req' resp'
generalise (Getting (First ChainIndexQuery) PABReq ChainIndexQuery
-> PABReq -> Maybe ChainIndexQuery
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ChainIndexQuery) PABReq ChainIndexQuery
Prism' PABReq ChainIndexQuery
E._ChainIndexQueryReq)
               ChainIndexResponse -> PABResp
E.ChainIndexQueryResp
               RequestHandler effs ChainIndexQuery ChainIndexResponse
forall (effs :: [* -> *]).
(Member (LogObserve (LogMessage Text)) effs,
 Member ChainIndexQueryEffect effs) =>
RequestHandler effs ChainIndexQuery ChainIndexResponse
RequestHandler.handleChainIndexQueries

handleOwnAddressesQueries ::
    ( Member (LogObserve (LogMessage Text)) effs
    , Member WalletEffect effs
    )
    => RequestHandler effs PABReq PABResp
handleOwnAddressesQueries :: RequestHandler effs PABReq PABResp
handleOwnAddressesQueries =
    (PABReq -> Maybe ())
-> (NonEmpty CardanoAddress -> PABResp)
-> RequestHandler effs () (NonEmpty CardanoAddress)
-> RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]) req req' resp resp'.
(req' -> Maybe req)
-> (resp -> resp')
-> RequestHandler effs req resp
-> RequestHandler effs req' resp'
generalise (Getting (First ()) PABReq () -> PABReq -> Maybe ()
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ()) PABReq ()
Prism' PABReq ()
E._OwnAddressesReq) NonEmpty CardanoAddress -> PABResp
E.OwnAddressesResp RequestHandler effs () (NonEmpty CardanoAddress)
forall a (effs :: [* -> *]).
(Member WalletEffect effs,
 Member (LogObserve (LogMessage Text)) effs) =>
RequestHandler effs a (NonEmpty CardanoAddress)
RequestHandler.handleOwnAddresses

handleOwnInstanceIdQueries ::
    ( Member (LogObserve (LogMessage Text)) effs
    , Member (Reader ContractInstanceId) effs
    )
    => RequestHandler effs PABReq PABResp
handleOwnInstanceIdQueries :: RequestHandler effs PABReq PABResp
handleOwnInstanceIdQueries =
    (PABReq -> Maybe ())
-> (ContractInstanceId -> PABResp)
-> RequestHandler effs () ContractInstanceId
-> RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]) req req' resp resp'.
(req' -> Maybe req)
-> (resp -> resp')
-> RequestHandler effs req resp
-> RequestHandler effs req' resp'
generalise (Getting (First ()) PABReq () -> PABReq -> Maybe ()
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ()) PABReq ()
Prism' PABReq ()
E._OwnContractInstanceIdReq) ContractInstanceId -> PABResp
E.OwnContractInstanceIdResp RequestHandler effs () ContractInstanceId
forall (effs :: [* -> *]) a.
(Member (LogObserve (LogMessage Text)) effs,
 Member (Reader ContractInstanceId) effs) =>
RequestHandler effs a ContractInstanceId
RequestHandler.handleOwnInstanceIdQueries

handleYieldedUnbalancedTx ::
    ( Member (LogObserve (LogMessage Text)) effs
    , Member WalletEffect effs
    )
    => RequestHandler effs PABReq PABResp
handleYieldedUnbalancedTx :: RequestHandler effs PABReq PABResp
handleYieldedUnbalancedTx =
    (PABReq -> Maybe UnbalancedTx)
-> (() -> PABResp)
-> RequestHandler effs UnbalancedTx ()
-> RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]) req req' resp resp'.
(req' -> Maybe req)
-> (resp -> resp')
-> RequestHandler effs req resp
-> RequestHandler effs req' resp'
generalise
        (Getting (First UnbalancedTx) PABReq UnbalancedTx
-> PABReq -> Maybe UnbalancedTx
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First UnbalancedTx) PABReq UnbalancedTx
Prism' PABReq UnbalancedTx
E._YieldUnbalancedTxReq)
        () -> PABResp
E.YieldUnbalancedTxResp
        RequestHandler effs UnbalancedTx ()
forall (effs :: [* -> *]).
(Member WalletEffect effs,
 Member (LogObserve (LogMessage Text)) effs) =>
RequestHandler effs UnbalancedTx ()
RequestHandler.handleYieldedUnbalancedTx

handleAdjustUnbalancedTx ::
    ( Member (LogObserve (LogMessage Text)) effs
    , Member (LogMsg RequestHandlerLogMsg) effs
    , Member NodeClientEffect effs
    )
    => RequestHandler effs PABReq PABResp
handleAdjustUnbalancedTx :: RequestHandler effs PABReq PABResp
handleAdjustUnbalancedTx =
    (PABReq -> Maybe UnbalancedTx)
-> (UnbalancedTx -> PABResp)
-> RequestHandler effs UnbalancedTx UnbalancedTx
-> RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]) req req' resp resp'.
(req' -> Maybe req)
-> (resp -> resp')
-> RequestHandler effs req resp
-> RequestHandler effs req' resp'
generalise
        (Getting (First UnbalancedTx) PABReq UnbalancedTx
-> PABReq -> Maybe UnbalancedTx
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First UnbalancedTx) PABReq UnbalancedTx
Prism' PABReq UnbalancedTx
E._AdjustUnbalancedTxReq)
        UnbalancedTx -> PABResp
E.AdjustUnbalancedTxResp
        RequestHandler effs UnbalancedTx UnbalancedTx
forall (effs :: [* -> *]).
(Member (LogObserve (LogMessage Text)) effs,
 Member (LogMsg RequestHandlerLogMsg) effs,
 Member NodeClientEffect effs) =>
RequestHandler effs UnbalancedTx UnbalancedTx
RequestHandler.handleAdjustUnbalancedTx

handleGetParams ::
    ( Member (LogObserve (LogMessage Text)) effs
    , Member NodeClientEffect effs
    )
    => RequestHandler effs PABReq PABResp
handleGetParams :: RequestHandler effs PABReq PABResp
handleGetParams =
    (PABReq -> Maybe ())
-> (Params -> PABResp)
-> RequestHandler effs () Params
-> RequestHandler effs PABReq PABResp
forall (effs :: [* -> *]) req req' resp resp'.
(req' -> Maybe req)
-> (resp -> resp')
-> RequestHandler effs req resp
-> RequestHandler effs req' resp'
generalise
        (Getting (First ()) PABReq () -> PABReq -> Maybe ()
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ()) PABReq ()
Prism' PABReq ()
E._GetParamsReq)
        Params -> PABResp
E.GetParamsResp
        RequestHandler effs () Params
forall (effs :: [* -> *]).
(Member (LogObserve (LogMessage Text)) effs,
 Member NodeClientEffect effs) =>
RequestHandler effs () Params
RequestHandler.handleGetParams

defaultDist :: InitialDistribution
defaultDist :: InitialDistribution
defaultDist = [Wallet] -> InitialDistribution
defaultDistFor [Wallet]
EM.knownWallets

defaultDistFor :: [EM.Wallet] -> InitialDistribution
defaultDistFor :: [Wallet] -> InitialDistribution
defaultDistFor [Wallet]
wallets = [(Wallet, Value)] -> InitialDistribution
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Wallet, Value)] -> InitialDistribution)
-> [(Wallet, Value)] -> InitialDistribution
forall a b. (a -> b) -> a -> b
$ [Wallet] -> [Value] -> [(Wallet, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Wallet]
wallets (Value -> [Value]
forall a. a -> [a]
repeat (Integer -> Value
lovelaceValueOf Integer
100_000_000))

makeClassyPrisms ''TraceError

instance EM.AsAssertionError (TraceError e) where
    _AssertionError :: p AssertionError (f AssertionError)
-> p (TraceError e) (f (TraceError e))
_AssertionError = p AssertionError (f AssertionError)
-> p (TraceError e) (f (TraceError e))
forall r e. AsTraceError r e => Prism' r AssertionError
_TraceAssertionError