{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE MonoLocalBinds     #-}
{-# LANGUAGE RankNTypes         #-}
{-# LANGUAGE TypeApplications   #-}
{-
This module provides a list of folds over the emulator event stream. To apply
the folds in this module to a stream of events, use
'Wallet.Emulator.Stream.foldEmulatorStreamM'. See note [Emulator event stream].

-}
module Wallet.Emulator.Folds (
    EmulatorEventFold
    , EmulatorEventFoldM
    , EmulatorFoldErr(..)
    , describeError
    -- * Folds for contract instances
    , instanceState
    , instanceRequests
    , instanceResponses
    , instanceOutcome
    , instanceTransactions
    , Outcome(..)
    , instanceLog
    , instanceAccumState
    -- * Folds for transactions and the UTXO set
    , chainEvents
    , failedTransactions
    , validatedTransactions
    , utxoAtAddress
    , valueAtAddress
    -- * Folds for individual wallets (emulated agents)
    , walletFunds
    , walletFees
    , walletTxBalanceEvents
    , walletsAdjustedTxEvents
    -- * Folds that are used in the Playground
    , annotatedBlockchain
    , blockchain
    , emulatorLog
    , userLog
    -- * Etc.
    , renderLines
    , preMapMaybeM
    , preMapMaybe
    , postMapM
    , mkTxLogs
    ) where

import Cardano.Api qualified as C
import Cardano.Node.Emulator.Internal.Node (ChainEvent (SlotAdd, TxnValidation), _TxnValidation, chainEventOnChainTx)
import Control.Applicative ((<|>))
import Control.Foldl (Fold (Fold), FoldM (FoldM))
import Control.Foldl qualified as L
import Control.Lens hiding (Empty, Fold)
import Control.Monad ((>=>))
import Control.Monad.Freer (Eff, Member)
import Control.Monad.Freer.Error (Error, throwError)
import Data.Aeson qualified as JSON
import Data.Foldable (toList)
import Data.Map qualified as Map
import Data.Maybe (mapMaybe)
import Data.Monoid (Endo (..))
import Data.Set qualified as Set
import Data.Text (Text)
import Ledger (Block, CardanoAddress, OnChainTx, unOnChain)
import Ledger.AddressMap (UtxoMap)
import Ledger.AddressMap qualified as AM
import Ledger.Index (RedeemerReport, ValidationError, ValidationPhase (Phase1, Phase2), _FailPhase1, _FailPhase2,
                     _Success, toOnChain)
import Ledger.Tx (CardanoTx, getCardanoTxFee, getCardanoTxId, txOutValue)
import Ledger.Tx.Constraints.OffChain (UnbalancedTx (..))
import Plutus.Contract (Contract)
import Plutus.Contract.Effects (PABReq, PABResp, _BalanceTxReq)
import Plutus.Contract.Request (MkTxLog)
import Plutus.Contract.Resumable (Request, Response)
import Plutus.Contract.Resumable qualified as State
import Plutus.Contract.Types (ResumableResult (_finalState, _observableState, _requests))
import Plutus.Trace.Emulator.ContractInstance (ContractInstanceState, addEventInstanceState, emptyInstanceState,
                                               instContractState, instEvents, instHandlersHistory)
import Plutus.Trace.Emulator.Types (ContractInstanceLog, ContractInstanceMsg (ContractLog), ContractInstanceTag,
                                    UserThreadMsg, _HandledRequest, cilMessage, cilTag, toInstanceState)
import Prettyprinter (Pretty (..), defaultLayoutOptions, layoutPretty, vsep)
import Prettyprinter.Render.Text (renderStrict)
import Wallet.Emulator.LogMessages (_AdjustingUnbalancedTx, _BalancingUnbalancedTx, _ValidationFailed)
import Wallet.Emulator.MultiAgent (EmulatorEvent, EmulatorTimeEvent, chainEvent, eteEvent, instanceEvent,
                                   userThreadEvent, walletClientEvent, walletEvent')
import Wallet.Emulator.NodeClient (_TxSubmit)
import Wallet.Emulator.Wallet (Wallet, _RequestHandlerLog, _TxBalanceLog, mockWalletAddress)
import Wallet.Rollup qualified as Rollup
import Wallet.Rollup.Types (AnnotatedTx)

type EmulatorEventFold a = Fold EmulatorEvent a

-- | A fold over emulator events that can fail with 'EmulatorFoldErr'
type EmulatorEventFoldM effs a = FoldM (Eff effs) EmulatorEvent a

-- | Transactions that failed to validate, in the given validation phase (if specified).
failedTransactions :: Maybe ValidationPhase -> EmulatorEventFold [(CardanoTx, ValidationError, C.Value)]
failedTransactions :: Maybe ValidationPhase
-> EmulatorEventFold [(CardanoTx, ValidationError, Value)]
failedTransactions Maybe ValidationPhase
phase = (EmulatorTimeEvent EmulatorEvent'
 -> Maybe (CardanoTx, ValidationError, Value))
-> Fold
     (CardanoTx, ValidationError, Value)
     [(CardanoTx, ValidationError, Value)]
-> EmulatorEventFold [(CardanoTx, ValidationError, Value)]
forall a b r. (a -> Maybe b) -> Fold b r -> Fold a r
preMapMaybe (EmulatorTimeEvent EmulatorEvent'
-> Maybe (ValidationPhase, CardanoTx, ValidationError, Value)
f (EmulatorTimeEvent EmulatorEvent'
 -> Maybe (ValidationPhase, CardanoTx, ValidationError, Value))
-> ((ValidationPhase, CardanoTx, ValidationError, Value)
    -> Maybe (CardanoTx, ValidationError, Value))
-> EmulatorTimeEvent EmulatorEvent'
-> Maybe (CardanoTx, ValidationError, Value)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Maybe ValidationPhase
-> (ValidationPhase, CardanoTx, ValidationError, Value)
-> Maybe (CardanoTx, ValidationError, Value)
forall a a b c. Eq a => Maybe a -> (a, a, b, c) -> Maybe (a, b, c)
filterPhase Maybe ValidationPhase
phase) Fold
  (CardanoTx, ValidationError, Value)
  [(CardanoTx, ValidationError, Value)]
forall a. Fold a [a]
L.list
    where
        f :: EmulatorTimeEvent EmulatorEvent'
-> Maybe (ValidationPhase, CardanoTx, ValidationError, Value)
f EmulatorTimeEvent EmulatorEvent'
e = Getting
  (First (ValidationPhase, CardanoTx, ValidationError, Value))
  (EmulatorTimeEvent EmulatorEvent')
  (ValidationPhase, CardanoTx, ValidationError, Value)
-> EmulatorTimeEvent EmulatorEvent'
-> Maybe (ValidationPhase, CardanoTx, ValidationError, Value)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((EmulatorEvent'
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      EmulatorEvent')
-> EmulatorTimeEvent EmulatorEvent'
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     (EmulatorTimeEvent EmulatorEvent')
forall e1 e2.
Lens (EmulatorTimeEvent e1) (EmulatorTimeEvent e2) e1 e2
eteEvent ((EmulatorEvent'
  -> Const
       (First (ValidationPhase, CardanoTx, ValidationError, Value))
       EmulatorEvent')
 -> EmulatorTimeEvent EmulatorEvent'
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      (EmulatorTimeEvent EmulatorEvent'))
-> (((ValidationPhase, CardanoTx, ValidationError, Value)
     -> Const
          (First (ValidationPhase, CardanoTx, ValidationError, Value))
          (ValidationPhase, CardanoTx, ValidationError, Value))
    -> EmulatorEvent'
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         EmulatorEvent')
-> Getting
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     (EmulatorTimeEvent EmulatorEvent')
     (ValidationPhase, CardanoTx, ValidationError, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainEvent
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      ChainEvent)
-> EmulatorEvent'
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     EmulatorEvent'
Prism' EmulatorEvent' ChainEvent
chainEvent ((ChainEvent
  -> Const
       (First (ValidationPhase, CardanoTx, ValidationError, Value))
       ChainEvent)
 -> EmulatorEvent'
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      EmulatorEvent')
-> (((ValidationPhase, CardanoTx, ValidationError, Value)
     -> Const
          (First (ValidationPhase, CardanoTx, ValidationError, Value))
          (ValidationPhase, CardanoTx, ValidationError, Value))
    -> ChainEvent
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         ChainEvent)
-> ((ValidationPhase, CardanoTx, ValidationError, Value)
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         (ValidationPhase, CardanoTx, ValidationError, Value))
-> EmulatorEvent'
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     EmulatorEvent'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidationResult
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      ValidationResult)
-> ChainEvent
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     ChainEvent
Prism' ChainEvent ValidationResult
_TxnValidation ((ValidationResult
  -> Const
       (First (ValidationPhase, CardanoTx, ValidationError, Value))
       ValidationResult)
 -> ChainEvent
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      ChainEvent)
-> (((ValidationPhase, CardanoTx, ValidationError, Value)
     -> Const
          (First (ValidationPhase, CardanoTx, ValidationError, Value))
          (ValidationPhase, CardanoTx, ValidationError, Value))
    -> ValidationResult
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         ValidationResult)
-> ((ValidationPhase, CardanoTx, ValidationError, Value)
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         (ValidationPhase, CardanoTx, ValidationError, Value))
-> ChainEvent
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     ChainEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CardanoTx, ValidationError)
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      (CardanoTx, ValidationError))
-> ValidationResult
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     ValidationResult
Prism' ValidationResult (CardanoTx, ValidationError)
_FailPhase1 (((CardanoTx, ValidationError)
  -> Const
       (First (ValidationPhase, CardanoTx, ValidationError, Value))
       (CardanoTx, ValidationError))
 -> ValidationResult
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      ValidationResult)
-> (((ValidationPhase, CardanoTx, ValidationError, Value)
     -> Const
          (First (ValidationPhase, CardanoTx, ValidationError, Value))
          (ValidationPhase, CardanoTx, ValidationError, Value))
    -> (CardanoTx, ValidationError)
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         (CardanoTx, ValidationError))
-> ((ValidationPhase, CardanoTx, ValidationError, Value)
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         (ValidationPhase, CardanoTx, ValidationError, Value))
-> ValidationResult
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     ValidationResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CardanoTx, ValidationError)
 -> (ValidationPhase, CardanoTx, ValidationError, Value))
-> ((ValidationPhase, CardanoTx, ValidationError, Value)
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         (ValidationPhase, CardanoTx, ValidationError, Value))
-> (CardanoTx, ValidationError)
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     (CardanoTx, ValidationError)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\(CardanoTx
tx, ValidationError
err) -> (ValidationPhase
Phase1, CardanoTx
tx, ValidationError
err, Value
forall a. Monoid a => a
mempty))) EmulatorTimeEvent EmulatorEvent'
e
          Maybe (ValidationPhase, CardanoTx, ValidationError, Value)
-> Maybe (ValidationPhase, CardanoTx, ValidationError, Value)
-> Maybe (ValidationPhase, CardanoTx, ValidationError, Value)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Getting
  (First (ValidationPhase, CardanoTx, ValidationError, Value))
  (EmulatorTimeEvent EmulatorEvent')
  (ValidationPhase, CardanoTx, ValidationError, Value)
-> EmulatorTimeEvent EmulatorEvent'
-> Maybe (ValidationPhase, CardanoTx, ValidationError, Value)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((EmulatorEvent'
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      EmulatorEvent')
-> EmulatorTimeEvent EmulatorEvent'
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     (EmulatorTimeEvent EmulatorEvent')
forall e1 e2.
Lens (EmulatorTimeEvent e1) (EmulatorTimeEvent e2) e1 e2
eteEvent ((EmulatorEvent'
  -> Const
       (First (ValidationPhase, CardanoTx, ValidationError, Value))
       EmulatorEvent')
 -> EmulatorTimeEvent EmulatorEvent'
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      (EmulatorTimeEvent EmulatorEvent'))
-> (((ValidationPhase, CardanoTx, ValidationError, Value)
     -> Const
          (First (ValidationPhase, CardanoTx, ValidationError, Value))
          (ValidationPhase, CardanoTx, ValidationError, Value))
    -> EmulatorEvent'
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         EmulatorEvent')
-> Getting
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     (EmulatorTimeEvent EmulatorEvent')
     (ValidationPhase, CardanoTx, ValidationError, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainEvent
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      ChainEvent)
-> EmulatorEvent'
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     EmulatorEvent'
Prism' EmulatorEvent' ChainEvent
chainEvent ((ChainEvent
  -> Const
       (First (ValidationPhase, CardanoTx, ValidationError, Value))
       ChainEvent)
 -> EmulatorEvent'
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      EmulatorEvent')
-> (((ValidationPhase, CardanoTx, ValidationError, Value)
     -> Const
          (First (ValidationPhase, CardanoTx, ValidationError, Value))
          (ValidationPhase, CardanoTx, ValidationError, Value))
    -> ChainEvent
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         ChainEvent)
-> ((ValidationPhase, CardanoTx, ValidationError, Value)
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         (ValidationPhase, CardanoTx, ValidationError, Value))
-> EmulatorEvent'
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     EmulatorEvent'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidationResult
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      ValidationResult)
-> ChainEvent
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     ChainEvent
Prism' ChainEvent ValidationResult
_TxnValidation ((ValidationResult
  -> Const
       (First (ValidationPhase, CardanoTx, ValidationError, Value))
       ValidationResult)
 -> ChainEvent
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      ChainEvent)
-> (((ValidationPhase, CardanoTx, ValidationError, Value)
     -> Const
          (First (ValidationPhase, CardanoTx, ValidationError, Value))
          (ValidationPhase, CardanoTx, ValidationError, Value))
    -> ValidationResult
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         ValidationResult)
-> ((ValidationPhase, CardanoTx, ValidationError, Value)
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         (ValidationPhase, CardanoTx, ValidationError, Value))
-> ChainEvent
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     ChainEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((OnChainTx, ValidationError, Value)
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      (OnChainTx, ValidationError, Value))
-> ValidationResult
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     ValidationResult
Prism' ValidationResult (OnChainTx, ValidationError, Value)
_FailPhase2(((OnChainTx, ValidationError, Value)
  -> Const
       (First (ValidationPhase, CardanoTx, ValidationError, Value))
       (OnChainTx, ValidationError, Value))
 -> ValidationResult
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      ValidationResult)
-> (((ValidationPhase, CardanoTx, ValidationError, Value)
     -> Const
          (First (ValidationPhase, CardanoTx, ValidationError, Value))
          (ValidationPhase, CardanoTx, ValidationError, Value))
    -> (OnChainTx, ValidationError, Value)
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         (OnChainTx, ValidationError, Value))
-> ((ValidationPhase, CardanoTx, ValidationError, Value)
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         (ValidationPhase, CardanoTx, ValidationError, Value))
-> ValidationResult
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     ValidationResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((OnChainTx, ValidationError, Value)
 -> (ValidationPhase, CardanoTx, ValidationError, Value))
-> ((ValidationPhase, CardanoTx, ValidationError, Value)
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         (ValidationPhase, CardanoTx, ValidationError, Value))
-> (OnChainTx, ValidationError, Value)
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     (OnChainTx, ValidationError, Value)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\(OnChainTx
tx, ValidationError
err, Value
v) -> (ValidationPhase
Phase2, OnChainTx -> CardanoTx
unOnChain OnChainTx
tx, ValidationError
err, Value
v))) EmulatorTimeEvent EmulatorEvent'
e
          Maybe (ValidationPhase, CardanoTx, ValidationError, Value)
-> Maybe (ValidationPhase, CardanoTx, ValidationError, Value)
-> Maybe (ValidationPhase, CardanoTx, ValidationError, Value)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Getting
  (First (ValidationPhase, CardanoTx, ValidationError, Value))
  (EmulatorTimeEvent EmulatorEvent')
  (ValidationPhase, CardanoTx, ValidationError, Value)
-> EmulatorTimeEvent EmulatorEvent'
-> Maybe (ValidationPhase, CardanoTx, ValidationError, Value)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((EmulatorEvent'
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      EmulatorEvent')
-> EmulatorTimeEvent EmulatorEvent'
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     (EmulatorTimeEvent EmulatorEvent')
forall e1 e2.
Lens (EmulatorTimeEvent e1) (EmulatorTimeEvent e2) e1 e2
eteEvent ((EmulatorEvent'
  -> Const
       (First (ValidationPhase, CardanoTx, ValidationError, Value))
       EmulatorEvent')
 -> EmulatorTimeEvent EmulatorEvent'
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      (EmulatorTimeEvent EmulatorEvent'))
-> (((ValidationPhase, CardanoTx, ValidationError, Value)
     -> Const
          (First (ValidationPhase, CardanoTx, ValidationError, Value))
          (ValidationPhase, CardanoTx, ValidationError, Value))
    -> EmulatorEvent'
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         EmulatorEvent')
-> Getting
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     (EmulatorTimeEvent EmulatorEvent')
     (ValidationPhase, CardanoTx, ValidationError, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Wallet, WalletEvent)
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      (Wallet, WalletEvent))
-> EmulatorEvent'
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     EmulatorEvent'
Prism' EmulatorEvent' (Wallet, WalletEvent)
walletEvent' (((Wallet, WalletEvent)
  -> Const
       (First (ValidationPhase, CardanoTx, ValidationError, Value))
       (Wallet, WalletEvent))
 -> EmulatorEvent'
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      EmulatorEvent')
-> (((ValidationPhase, CardanoTx, ValidationError, Value)
     -> Const
          (First (ValidationPhase, CardanoTx, ValidationError, Value))
          (ValidationPhase, CardanoTx, ValidationError, Value))
    -> (Wallet, WalletEvent)
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         (Wallet, WalletEvent))
-> ((ValidationPhase, CardanoTx, ValidationError, Value)
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         (ValidationPhase, CardanoTx, ValidationError, Value))
-> EmulatorEvent'
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     EmulatorEvent'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WalletEvent
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      WalletEvent)
-> (Wallet, WalletEvent)
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     (Wallet, WalletEvent)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((WalletEvent
  -> Const
       (First (ValidationPhase, CardanoTx, ValidationError, Value))
       WalletEvent)
 -> (Wallet, WalletEvent)
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      (Wallet, WalletEvent))
-> (((ValidationPhase, CardanoTx, ValidationError, Value)
     -> Const
          (First (ValidationPhase, CardanoTx, ValidationError, Value))
          (ValidationPhase, CardanoTx, ValidationError, Value))
    -> WalletEvent
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         WalletEvent)
-> ((ValidationPhase, CardanoTx, ValidationError, Value)
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         (ValidationPhase, CardanoTx, ValidationError, Value))
-> (Wallet, WalletEvent)
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     (Wallet, WalletEvent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxBalanceMsg
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      TxBalanceMsg)
-> WalletEvent
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     WalletEvent
Prism' WalletEvent TxBalanceMsg
_TxBalanceLog ((TxBalanceMsg
  -> Const
       (First (ValidationPhase, CardanoTx, ValidationError, Value))
       TxBalanceMsg)
 -> WalletEvent
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      WalletEvent)
-> (((ValidationPhase, CardanoTx, ValidationError, Value)
     -> Const
          (First (ValidationPhase, CardanoTx, ValidationError, Value))
          (ValidationPhase, CardanoTx, ValidationError, Value))
    -> TxBalanceMsg
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         TxBalanceMsg)
-> ((ValidationPhase, CardanoTx, ValidationError, Value)
    -> Const
         (First (ValidationPhase, CardanoTx, ValidationError, Value))
         (ValidationPhase, CardanoTx, ValidationError, Value))
-> WalletEvent
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     WalletEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ValidationPhase, CardanoTx, ValidationError, Value)
 -> Const
      (First (ValidationPhase, CardanoTx, ValidationError, Value))
      (ValidationPhase, CardanoTx, ValidationError, Value))
-> TxBalanceMsg
-> Const
     (First (ValidationPhase, CardanoTx, ValidationError, Value))
     TxBalanceMsg
Prism'
  TxBalanceMsg (ValidationPhase, CardanoTx, ValidationError, Value)
_ValidationFailed) EmulatorTimeEvent EmulatorEvent'
e
        filterPhase :: Maybe a -> (a, a, b, c) -> Maybe (a, b, c)
filterPhase Maybe a
Nothing (a
_, a
t, b
v, c
c)   = (a, b, c) -> Maybe (a, b, c)
forall a. a -> Maybe a
Just (a
t, b
v, c
c)
        filterPhase (Just a
p) (a
p', a
t, b
v, c
c) = if a
p a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
p' then (a, b, c) -> Maybe (a, b, c)
forall a. a -> Maybe a
Just (a
t, b
v, c
c) else Maybe (a, b, c)
forall a. Maybe a
Nothing

-- | Transactions that were validated
validatedTransactions :: EmulatorEventFold [(OnChainTx, RedeemerReport)]
validatedTransactions :: EmulatorEventFold [(OnChainTx, RedeemerReport)]
validatedTransactions = (EmulatorTimeEvent EmulatorEvent'
 -> Maybe (OnChainTx, RedeemerReport))
-> Fold (OnChainTx, RedeemerReport) [(OnChainTx, RedeemerReport)]
-> EmulatorEventFold [(OnChainTx, RedeemerReport)]
forall a b r. (a -> Maybe b) -> Fold b r -> Fold a r
preMapMaybe (Getting
  (First (OnChainTx, RedeemerReport))
  (EmulatorTimeEvent EmulatorEvent')
  (OnChainTx, RedeemerReport)
-> EmulatorTimeEvent EmulatorEvent'
-> Maybe (OnChainTx, RedeemerReport)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((EmulatorEvent'
 -> Const (First (OnChainTx, RedeemerReport)) EmulatorEvent')
-> EmulatorTimeEvent EmulatorEvent'
-> Const
     (First (OnChainTx, RedeemerReport))
     (EmulatorTimeEvent EmulatorEvent')
forall e1 e2.
Lens (EmulatorTimeEvent e1) (EmulatorTimeEvent e2) e1 e2
eteEvent ((EmulatorEvent'
  -> Const (First (OnChainTx, RedeemerReport)) EmulatorEvent')
 -> EmulatorTimeEvent EmulatorEvent'
 -> Const
      (First (OnChainTx, RedeemerReport))
      (EmulatorTimeEvent EmulatorEvent'))
-> (((OnChainTx, RedeemerReport)
     -> Const
          (First (OnChainTx, RedeemerReport)) (OnChainTx, RedeemerReport))
    -> EmulatorEvent'
    -> Const (First (OnChainTx, RedeemerReport)) EmulatorEvent')
-> Getting
     (First (OnChainTx, RedeemerReport))
     (EmulatorTimeEvent EmulatorEvent')
     (OnChainTx, RedeemerReport)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainEvent
 -> Const (First (OnChainTx, RedeemerReport)) ChainEvent)
-> EmulatorEvent'
-> Const (First (OnChainTx, RedeemerReport)) EmulatorEvent'
Prism' EmulatorEvent' ChainEvent
chainEvent ((ChainEvent
  -> Const (First (OnChainTx, RedeemerReport)) ChainEvent)
 -> EmulatorEvent'
 -> Const (First (OnChainTx, RedeemerReport)) EmulatorEvent')
-> (((OnChainTx, RedeemerReport)
     -> Const
          (First (OnChainTx, RedeemerReport)) (OnChainTx, RedeemerReport))
    -> ChainEvent
    -> Const (First (OnChainTx, RedeemerReport)) ChainEvent)
-> ((OnChainTx, RedeemerReport)
    -> Const
         (First (OnChainTx, RedeemerReport)) (OnChainTx, RedeemerReport))
-> EmulatorEvent'
-> Const (First (OnChainTx, RedeemerReport)) EmulatorEvent'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidationResult
 -> Const (First (OnChainTx, RedeemerReport)) ValidationResult)
-> ChainEvent
-> Const (First (OnChainTx, RedeemerReport)) ChainEvent
Prism' ChainEvent ValidationResult
_TxnValidation ((ValidationResult
  -> Const (First (OnChainTx, RedeemerReport)) ValidationResult)
 -> ChainEvent
 -> Const (First (OnChainTx, RedeemerReport)) ChainEvent)
-> (((OnChainTx, RedeemerReport)
     -> Const
          (First (OnChainTx, RedeemerReport)) (OnChainTx, RedeemerReport))
    -> ValidationResult
    -> Const (First (OnChainTx, RedeemerReport)) ValidationResult)
-> ((OnChainTx, RedeemerReport)
    -> Const
         (First (OnChainTx, RedeemerReport)) (OnChainTx, RedeemerReport))
-> ChainEvent
-> Const (First (OnChainTx, RedeemerReport)) ChainEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((OnChainTx, RedeemerReport)
 -> Const
      (First (OnChainTx, RedeemerReport)) (OnChainTx, RedeemerReport))
-> ValidationResult
-> Const (First (OnChainTx, RedeemerReport)) ValidationResult
Prism' ValidationResult (OnChainTx, RedeemerReport)
_Success)) Fold (OnChainTx, RedeemerReport) [(OnChainTx, RedeemerReport)]
forall a. Fold a [a]
L.list

-- | Unbalanced transactions that are sent to the wallet for balancing
walletTxBalanceEvents :: EmulatorEventFold [UnbalancedTx]
walletTxBalanceEvents :: EmulatorEventFold [UnbalancedTx]
walletTxBalanceEvents = ((CardanoBuildTx, UtxoIndex) -> UnbalancedTx)
-> [(CardanoBuildTx, UtxoIndex)] -> [UnbalancedTx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CardanoBuildTx -> UtxoIndex -> UnbalancedTx)
-> (CardanoBuildTx, UtxoIndex) -> UnbalancedTx
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CardanoBuildTx -> UtxoIndex -> UnbalancedTx
UnbalancedCardanoTx) ([(CardanoBuildTx, UtxoIndex)] -> [UnbalancedTx])
-> Fold
     (EmulatorTimeEvent EmulatorEvent') [(CardanoBuildTx, UtxoIndex)]
-> EmulatorEventFold [UnbalancedTx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EmulatorTimeEvent EmulatorEvent'
 -> Maybe (CardanoBuildTx, UtxoIndex))
-> Fold (CardanoBuildTx, UtxoIndex) [(CardanoBuildTx, UtxoIndex)]
-> Fold
     (EmulatorTimeEvent EmulatorEvent') [(CardanoBuildTx, UtxoIndex)]
forall a b r. (a -> Maybe b) -> Fold b r -> Fold a r
preMapMaybe (Getting
  (First (CardanoBuildTx, UtxoIndex))
  (EmulatorTimeEvent EmulatorEvent')
  (CardanoBuildTx, UtxoIndex)
-> EmulatorTimeEvent EmulatorEvent'
-> Maybe (CardanoBuildTx, UtxoIndex)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((EmulatorEvent'
 -> Const (First (CardanoBuildTx, UtxoIndex)) EmulatorEvent')
-> EmulatorTimeEvent EmulatorEvent'
-> Const
     (First (CardanoBuildTx, UtxoIndex))
     (EmulatorTimeEvent EmulatorEvent')
forall e1 e2.
Lens (EmulatorTimeEvent e1) (EmulatorTimeEvent e2) e1 e2
eteEvent ((EmulatorEvent'
  -> Const (First (CardanoBuildTx, UtxoIndex)) EmulatorEvent')
 -> EmulatorTimeEvent EmulatorEvent'
 -> Const
      (First (CardanoBuildTx, UtxoIndex))
      (EmulatorTimeEvent EmulatorEvent'))
-> (((CardanoBuildTx, UtxoIndex)
     -> Const
          (First (CardanoBuildTx, UtxoIndex)) (CardanoBuildTx, UtxoIndex))
    -> EmulatorEvent'
    -> Const (First (CardanoBuildTx, UtxoIndex)) EmulatorEvent')
-> Getting
     (First (CardanoBuildTx, UtxoIndex))
     (EmulatorTimeEvent EmulatorEvent')
     (CardanoBuildTx, UtxoIndex)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Wallet, WalletEvent)
 -> Const (First (CardanoBuildTx, UtxoIndex)) (Wallet, WalletEvent))
-> EmulatorEvent'
-> Const (First (CardanoBuildTx, UtxoIndex)) EmulatorEvent'
Prism' EmulatorEvent' (Wallet, WalletEvent)
walletEvent' (((Wallet, WalletEvent)
  -> Const (First (CardanoBuildTx, UtxoIndex)) (Wallet, WalletEvent))
 -> EmulatorEvent'
 -> Const (First (CardanoBuildTx, UtxoIndex)) EmulatorEvent')
-> (((CardanoBuildTx, UtxoIndex)
     -> Const
          (First (CardanoBuildTx, UtxoIndex)) (CardanoBuildTx, UtxoIndex))
    -> (Wallet, WalletEvent)
    -> Const (First (CardanoBuildTx, UtxoIndex)) (Wallet, WalletEvent))
-> ((CardanoBuildTx, UtxoIndex)
    -> Const
         (First (CardanoBuildTx, UtxoIndex)) (CardanoBuildTx, UtxoIndex))
-> EmulatorEvent'
-> Const (First (CardanoBuildTx, UtxoIndex)) EmulatorEvent'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WalletEvent
 -> Const (First (CardanoBuildTx, UtxoIndex)) WalletEvent)
-> (Wallet, WalletEvent)
-> Const (First (CardanoBuildTx, UtxoIndex)) (Wallet, WalletEvent)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((WalletEvent
  -> Const (First (CardanoBuildTx, UtxoIndex)) WalletEvent)
 -> (Wallet, WalletEvent)
 -> Const (First (CardanoBuildTx, UtxoIndex)) (Wallet, WalletEvent))
-> (((CardanoBuildTx, UtxoIndex)
     -> Const
          (First (CardanoBuildTx, UtxoIndex)) (CardanoBuildTx, UtxoIndex))
    -> WalletEvent
    -> Const (First (CardanoBuildTx, UtxoIndex)) WalletEvent)
-> ((CardanoBuildTx, UtxoIndex)
    -> Const
         (First (CardanoBuildTx, UtxoIndex)) (CardanoBuildTx, UtxoIndex))
-> (Wallet, WalletEvent)
-> Const (First (CardanoBuildTx, UtxoIndex)) (Wallet, WalletEvent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxBalanceMsg
 -> Const (First (CardanoBuildTx, UtxoIndex)) TxBalanceMsg)
-> WalletEvent
-> Const (First (CardanoBuildTx, UtxoIndex)) WalletEvent
Prism' WalletEvent TxBalanceMsg
_TxBalanceLog ((TxBalanceMsg
  -> Const (First (CardanoBuildTx, UtxoIndex)) TxBalanceMsg)
 -> WalletEvent
 -> Const (First (CardanoBuildTx, UtxoIndex)) WalletEvent)
-> (((CardanoBuildTx, UtxoIndex)
     -> Const
          (First (CardanoBuildTx, UtxoIndex)) (CardanoBuildTx, UtxoIndex))
    -> TxBalanceMsg
    -> Const (First (CardanoBuildTx, UtxoIndex)) TxBalanceMsg)
-> ((CardanoBuildTx, UtxoIndex)
    -> Const
         (First (CardanoBuildTx, UtxoIndex)) (CardanoBuildTx, UtxoIndex))
-> WalletEvent
-> Const (First (CardanoBuildTx, UtxoIndex)) WalletEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CardanoBuildTx, UtxoIndex)
 -> Const
      (First (CardanoBuildTx, UtxoIndex)) (CardanoBuildTx, UtxoIndex))
-> TxBalanceMsg
-> Const (First (CardanoBuildTx, UtxoIndex)) TxBalanceMsg
Prism' TxBalanceMsg (CardanoBuildTx, UtxoIndex)
_BalancingUnbalancedTx)) Fold (CardanoBuildTx, UtxoIndex) [(CardanoBuildTx, UtxoIndex)]
forall a. Fold a [a]
L.list

-- | Min lovelace of 'txOut's from adjusted unbalanced transactions for all wallets
walletsAdjustedTxEvents :: EmulatorEventFold [C.Lovelace]
walletsAdjustedTxEvents :: EmulatorEventFold [Lovelace]
walletsAdjustedTxEvents = Set Lovelace -> [Lovelace]
forall a. Set a -> [a]
Set.toList (Set Lovelace -> [Lovelace])
-> ([[Lovelace]] -> Set Lovelace) -> [[Lovelace]] -> [Lovelace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Lovelace] -> Set Lovelace
forall a. Ord a => [a] -> Set a
Set.fromList ([Lovelace] -> Set Lovelace)
-> ([[Lovelace]] -> [Lovelace]) -> [[Lovelace]] -> Set Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Lovelace]] -> [Lovelace]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Lovelace]] -> [Lovelace])
-> Fold (EmulatorTimeEvent EmulatorEvent') [[Lovelace]]
-> EmulatorEventFold [Lovelace]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (EmulatorTimeEvent EmulatorEvent' -> Maybe [Lovelace])
-> Fold [Lovelace] [[Lovelace]]
-> Fold (EmulatorTimeEvent EmulatorEvent') [[Lovelace]]
forall a b r. (a -> Maybe b) -> Fold b r -> Fold a r
preMapMaybe (Getting
  (First [Lovelace]) (EmulatorTimeEvent EmulatorEvent') [Lovelace]
-> EmulatorTimeEvent EmulatorEvent' -> Maybe [Lovelace]
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((EmulatorEvent' -> Const (First [Lovelace]) EmulatorEvent')
-> EmulatorTimeEvent EmulatorEvent'
-> Const (First [Lovelace]) (EmulatorTimeEvent EmulatorEvent')
forall e1 e2.
Lens (EmulatorTimeEvent e1) (EmulatorTimeEvent e2) e1 e2
eteEvent ((EmulatorEvent' -> Const (First [Lovelace]) EmulatorEvent')
 -> EmulatorTimeEvent EmulatorEvent'
 -> Const (First [Lovelace]) (EmulatorTimeEvent EmulatorEvent'))
-> (([Lovelace] -> Const (First [Lovelace]) [Lovelace])
    -> EmulatorEvent' -> Const (First [Lovelace]) EmulatorEvent')
-> Getting
     (First [Lovelace]) (EmulatorTimeEvent EmulatorEvent') [Lovelace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Wallet, WalletEvent)
 -> Const (First [Lovelace]) (Wallet, WalletEvent))
-> EmulatorEvent' -> Const (First [Lovelace]) EmulatorEvent'
Prism' EmulatorEvent' (Wallet, WalletEvent)
walletEvent' (((Wallet, WalletEvent)
  -> Const (First [Lovelace]) (Wallet, WalletEvent))
 -> EmulatorEvent' -> Const (First [Lovelace]) EmulatorEvent')
-> (([Lovelace] -> Const (First [Lovelace]) [Lovelace])
    -> (Wallet, WalletEvent)
    -> Const (First [Lovelace]) (Wallet, WalletEvent))
-> ([Lovelace] -> Const (First [Lovelace]) [Lovelace])
-> EmulatorEvent'
-> Const (First [Lovelace]) EmulatorEvent'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WalletEvent -> Const (First [Lovelace]) WalletEvent)
-> (Wallet, WalletEvent)
-> Const (First [Lovelace]) (Wallet, WalletEvent)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((WalletEvent -> Const (First [Lovelace]) WalletEvent)
 -> (Wallet, WalletEvent)
 -> Const (First [Lovelace]) (Wallet, WalletEvent))
-> (([Lovelace] -> Const (First [Lovelace]) [Lovelace])
    -> WalletEvent -> Const (First [Lovelace]) WalletEvent)
-> ([Lovelace] -> Const (First [Lovelace]) [Lovelace])
-> (Wallet, WalletEvent)
-> Const (First [Lovelace]) (Wallet, WalletEvent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RequestHandlerLogMsg
 -> Const (First [Lovelace]) RequestHandlerLogMsg)
-> WalletEvent -> Const (First [Lovelace]) WalletEvent
Prism' WalletEvent RequestHandlerLogMsg
_RequestHandlerLog ((RequestHandlerLogMsg
  -> Const (First [Lovelace]) RequestHandlerLogMsg)
 -> WalletEvent -> Const (First [Lovelace]) WalletEvent)
-> (([Lovelace] -> Const (First [Lovelace]) [Lovelace])
    -> RequestHandlerLogMsg
    -> Const (First [Lovelace]) RequestHandlerLogMsg)
-> ([Lovelace] -> Const (First [Lovelace]) [Lovelace])
-> WalletEvent
-> Const (First [Lovelace]) WalletEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Lovelace] -> Const (First [Lovelace]) [Lovelace])
-> RequestHandlerLogMsg
-> Const (First [Lovelace]) RequestHandlerLogMsg
Prism' RequestHandlerLogMsg [Lovelace]
_AdjustingUnbalancedTx)) Fold [Lovelace] [[Lovelace]]
forall a. Fold a [a]
L.list

mkTxLogs :: EmulatorEventFold [MkTxLog]
mkTxLogs :: EmulatorEventFold [MkTxLog]
mkTxLogs =
    let getTxLogEvent :: ContractInstanceMsg -> Maybe MkTxLog
        getTxLogEvent :: ContractInstanceMsg -> Maybe MkTxLog
getTxLogEvent (ContractLog Value
vl) = case Value -> Result MkTxLog
forall a. FromJSON a => Value -> Result a
JSON.fromJSON Value
vl of
            JSON.Error String
_   -> Maybe MkTxLog
forall a. Maybe a
Nothing
            JSON.Success MkTxLog
a -> MkTxLog -> Maybe MkTxLog
forall a. a -> Maybe a
Just MkTxLog
a
        getTxLogEvent ContractInstanceMsg
_ = Maybe MkTxLog
forall a. Maybe a
Nothing

        flt :: EmulatorEvent -> Maybe MkTxLog
        flt :: EmulatorTimeEvent EmulatorEvent' -> Maybe MkTxLog
flt = (EmulatorTimeEvent ContractInstanceLog -> ContractInstanceMsg)
-> Maybe (EmulatorTimeEvent ContractInstanceLog)
-> Maybe ContractInstanceMsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting
  ContractInstanceMsg
  (EmulatorTimeEvent ContractInstanceLog)
  ContractInstanceMsg
-> EmulatorTimeEvent ContractInstanceLog -> ContractInstanceMsg
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ContractInstanceLog
 -> Const ContractInstanceMsg ContractInstanceLog)
-> EmulatorTimeEvent ContractInstanceLog
-> Const
     ContractInstanceMsg (EmulatorTimeEvent ContractInstanceLog)
forall e1 e2.
Lens (EmulatorTimeEvent e1) (EmulatorTimeEvent e2) e1 e2
eteEvent ((ContractInstanceLog
  -> Const ContractInstanceMsg ContractInstanceLog)
 -> EmulatorTimeEvent ContractInstanceLog
 -> Const
      ContractInstanceMsg (EmulatorTimeEvent ContractInstanceLog))
-> ((ContractInstanceMsg
     -> Const ContractInstanceMsg ContractInstanceMsg)
    -> ContractInstanceLog
    -> Const ContractInstanceMsg ContractInstanceLog)
-> Getting
     ContractInstanceMsg
     (EmulatorTimeEvent ContractInstanceLog)
     ContractInstanceMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractInstanceMsg
 -> Const ContractInstanceMsg ContractInstanceMsg)
-> ContractInstanceLog
-> Const ContractInstanceMsg ContractInstanceLog
Lens' ContractInstanceLog ContractInstanceMsg
cilMessage)) (Maybe (EmulatorTimeEvent ContractInstanceLog)
 -> Maybe ContractInstanceMsg)
-> (EmulatorTimeEvent EmulatorEvent'
    -> Maybe (EmulatorTimeEvent ContractInstanceLog))
-> EmulatorTimeEvent EmulatorEvent'
-> Maybe ContractInstanceMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EmulatorEvent' -> Maybe ContractInstanceLog)
-> EmulatorTimeEvent EmulatorEvent'
-> Maybe (EmulatorTimeEvent ContractInstanceLog)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Getting
  (First ContractInstanceLog) EmulatorEvent' ContractInstanceLog
-> EmulatorEvent' -> Maybe ContractInstanceLog
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting
  (First ContractInstanceLog) EmulatorEvent' ContractInstanceLog
Prism' EmulatorEvent' ContractInstanceLog
instanceEvent) (EmulatorTimeEvent EmulatorEvent' -> Maybe ContractInstanceMsg)
-> (ContractInstanceMsg -> Maybe MkTxLog)
-> EmulatorTimeEvent EmulatorEvent'
-> Maybe MkTxLog
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ContractInstanceMsg -> Maybe MkTxLog
getTxLogEvent
    in (EmulatorTimeEvent EmulatorEvent' -> Maybe MkTxLog)
-> Fold MkTxLog [MkTxLog] -> EmulatorEventFold [MkTxLog]
forall a b r. (a -> Maybe b) -> Fold b r -> Fold a r
preMapMaybe EmulatorTimeEvent EmulatorEvent' -> Maybe MkTxLog
flt Fold MkTxLog [MkTxLog]
forall a. Fold a [a]
L.list

-- | The state of a contract instance, recovered from the emulator log.
instanceState ::
    forall w s e a effs.
    ( Member (Error EmulatorFoldErr) effs
    , Monoid w
    )
    => Contract w s e a
    -> ContractInstanceTag
    -> EmulatorEventFoldM effs (Maybe (ContractInstanceState w s e a))
instanceState :: Contract w s e a
-> ContractInstanceTag
-> EmulatorEventFoldM effs (Maybe (ContractInstanceState w s e a))
instanceState Contract w s e a
con ContractInstanceTag
tag =
    let flt :: EmulatorEvent -> Maybe (Response JSON.Value)
        flt :: EmulatorTimeEvent EmulatorEvent' -> Maybe (Response Value)
flt = Getting
  (First (Response Value))
  (EmulatorTimeEvent EmulatorEvent')
  (Response Value)
-> EmulatorTimeEvent EmulatorEvent' -> Maybe (Response Value)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((EmulatorEvent' -> Const (First (Response Value)) EmulatorEvent')
-> EmulatorTimeEvent EmulatorEvent'
-> Const
     (First (Response Value)) (EmulatorTimeEvent EmulatorEvent')
forall e1 e2.
Lens (EmulatorTimeEvent e1) (EmulatorTimeEvent e2) e1 e2
eteEvent ((EmulatorEvent' -> Const (First (Response Value)) EmulatorEvent')
 -> EmulatorTimeEvent EmulatorEvent'
 -> Const
      (First (Response Value)) (EmulatorTimeEvent EmulatorEvent'))
-> ((Response Value
     -> Const (First (Response Value)) (Response Value))
    -> EmulatorEvent' -> Const (First (Response Value)) EmulatorEvent')
-> Getting
     (First (Response Value))
     (EmulatorTimeEvent EmulatorEvent')
     (Response Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractInstanceLog
 -> Const (First (Response Value)) ContractInstanceLog)
-> EmulatorEvent' -> Const (First (Response Value)) EmulatorEvent'
Prism' EmulatorEvent' ContractInstanceLog
instanceEvent ((ContractInstanceLog
  -> Const (First (Response Value)) ContractInstanceLog)
 -> EmulatorEvent' -> Const (First (Response Value)) EmulatorEvent')
-> ((Response Value
     -> Const (First (Response Value)) (Response Value))
    -> ContractInstanceLog
    -> Const (First (Response Value)) ContractInstanceLog)
-> (Response Value
    -> Const (First (Response Value)) (Response Value))
-> EmulatorEvent'
-> Const (First (Response Value)) EmulatorEvent'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractInstanceLog -> Bool)
-> Optic'
     (->)
     (Const (First (Response Value)))
     ContractInstanceLog
     ContractInstanceLog
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (ContractInstanceTag -> ContractInstanceTag -> Bool
forall a. Eq a => a -> a -> Bool
(==) ContractInstanceTag
tag (ContractInstanceTag -> Bool)
-> (ContractInstanceLog -> ContractInstanceTag)
-> ContractInstanceLog
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ContractInstanceTag ContractInstanceLog ContractInstanceTag
-> ContractInstanceLog -> ContractInstanceTag
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractInstanceTag ContractInstanceLog ContractInstanceTag
Lens' ContractInstanceLog ContractInstanceTag
cilTag) Optic'
  (->)
  (Const (First (Response Value)))
  ContractInstanceLog
  ContractInstanceLog
-> ((Response Value
     -> Const (First (Response Value)) (Response Value))
    -> ContractInstanceLog
    -> Const (First (Response Value)) ContractInstanceLog)
-> (Response Value
    -> Const (First (Response Value)) (Response Value))
-> ContractInstanceLog
-> Const (First (Response Value)) ContractInstanceLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractInstanceMsg
 -> Const (First (Response Value)) ContractInstanceMsg)
-> ContractInstanceLog
-> Const (First (Response Value)) ContractInstanceLog
Lens' ContractInstanceLog ContractInstanceMsg
cilMessage ((ContractInstanceMsg
  -> Const (First (Response Value)) ContractInstanceMsg)
 -> ContractInstanceLog
 -> Const (First (Response Value)) ContractInstanceLog)
-> ((Response Value
     -> Const (First (Response Value)) (Response Value))
    -> ContractInstanceMsg
    -> Const (First (Response Value)) ContractInstanceMsg)
-> (Response Value
    -> Const (First (Response Value)) (Response Value))
-> ContractInstanceLog
-> Const (First (Response Value)) ContractInstanceLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Response Value -> Const (First (Response Value)) (Response Value))
-> ContractInstanceMsg
-> Const (First (Response Value)) ContractInstanceMsg
Prism' ContractInstanceMsg (Response Value)
_HandledRequest)
        decode :: forall effs'. Member (Error EmulatorFoldErr) effs' => EmulatorEvent -> Eff effs' (Maybe (Response PABResp))
        decode :: EmulatorTimeEvent EmulatorEvent'
-> Eff effs' (Maybe (Response PABResp))
decode EmulatorTimeEvent EmulatorEvent'
e = do
            case EmulatorTimeEvent EmulatorEvent' -> Maybe (Response Value)
flt EmulatorTimeEvent EmulatorEvent'
e of
                Maybe (Response Value)
Nothing -> Maybe (Response PABResp) -> Eff effs' (Maybe (Response PABResp))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Response PABResp)
forall a. Maybe a
Nothing
                Just Response Value
response -> case (Value -> Result PABResp)
-> Response Value -> Result (Response PABResp)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FromJSON PABResp => Value -> Result PABResp
forall a. FromJSON a => Value -> Result a
JSON.fromJSON @PABResp) Response Value
response of
                    JSON.Error String
e'   -> EmulatorFoldErr -> Eff effs' (Maybe (Response PABResp))
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (EmulatorFoldErr -> Eff effs' (Maybe (Response PABResp)))
-> EmulatorFoldErr -> Eff effs' (Maybe (Response PABResp))
forall a b. (a -> b) -> a -> b
$ String -> Response Value -> EmulatorFoldErr
InstanceStateJSONDecodingError String
e' Response Value
response
                    JSON.Success Response PABResp
e' -> Maybe (Response PABResp) -> Eff effs' (Maybe (Response PABResp))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response PABResp -> Maybe (Response PABResp)
forall a. a -> Maybe a
Just Response PABResp
e')

    in (EmulatorTimeEvent EmulatorEvent'
 -> Eff effs (Maybe (Response PABResp)))
-> FoldM
     (Eff effs)
     (Response PABResp)
     (Maybe (ContractInstanceState w s e a))
-> EmulatorEventFoldM effs (Maybe (ContractInstanceState w s e a))
forall (m :: * -> *) a b r.
Monad m =>
(a -> m (Maybe b)) -> FoldM m b r -> FoldM m a r
preMapMaybeM EmulatorTimeEvent EmulatorEvent'
-> Eff effs (Maybe (Response PABResp))
forall (effs' :: [* -> *]).
Member (Error EmulatorFoldErr) effs' =>
EmulatorTimeEvent EmulatorEvent'
-> Eff effs' (Maybe (Response PABResp))
decode (FoldM
   (Eff effs)
   (Response PABResp)
   (Maybe (ContractInstanceState w s e a))
 -> EmulatorEventFoldM effs (Maybe (ContractInstanceState w s e a)))
-> FoldM
     (Eff effs)
     (Response PABResp)
     (Maybe (ContractInstanceState w s e a))
-> EmulatorEventFoldM effs (Maybe (ContractInstanceState w s e a))
forall a b. (a -> b) -> a -> b
$ Fold (Response PABResp) (Maybe (ContractInstanceState w s e a))
-> FoldM
     (Eff effs)
     (Response PABResp)
     (Maybe (ContractInstanceState w s e a))
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize (Fold (Response PABResp) (Maybe (ContractInstanceState w s e a))
 -> FoldM
      (Eff effs)
      (Response PABResp)
      (Maybe (ContractInstanceState w s e a)))
-> Fold (Response PABResp) (Maybe (ContractInstanceState w s e a))
-> FoldM
     (Eff effs)
     (Response PABResp)
     (Maybe (ContractInstanceState w s e a))
forall a b. (a -> b) -> a -> b
$ (Maybe (ContractInstanceStateInternal w s e a)
 -> Response PABResp
 -> Maybe (ContractInstanceStateInternal w s e a))
-> Maybe (ContractInstanceStateInternal w s e a)
-> (Maybe (ContractInstanceStateInternal w s e a)
    -> Maybe (ContractInstanceState w s e a))
-> Fold (Response PABResp) (Maybe (ContractInstanceState w s e a))
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\Maybe (ContractInstanceStateInternal w s e a)
s Response PABResp
r -> Maybe (ContractInstanceStateInternal w s e a)
s Maybe (ContractInstanceStateInternal w s e a)
-> (ContractInstanceStateInternal w s e a
    -> Maybe (ContractInstanceStateInternal w s e a))
-> Maybe (ContractInstanceStateInternal w s e a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Response PABResp
-> ContractInstanceStateInternal w s e a
-> Maybe (ContractInstanceStateInternal w s e a)
forall w (s :: Row *) e a.
Monoid w =>
Response PABResp
-> ContractInstanceStateInternal w s e a
-> Maybe (ContractInstanceStateInternal w s e a)
addEventInstanceState Response PABResp
r) (ContractInstanceStateInternal w s e a
-> Maybe (ContractInstanceStateInternal w s e a)
forall a. a -> Maybe a
Just (ContractInstanceStateInternal w s e a
 -> Maybe (ContractInstanceStateInternal w s e a))
-> ContractInstanceStateInternal w s e a
-> Maybe (ContractInstanceStateInternal w s e a)
forall a b. (a -> b) -> a -> b
$ Contract w s e a -> ContractInstanceStateInternal w s e a
forall w (s :: Row *) e a.
Monoid w =>
Contract w s e a -> ContractInstanceStateInternal w s e a
emptyInstanceState Contract w s e a
con) ((ContractInstanceStateInternal w s e a
 -> ContractInstanceState w s e a)
-> Maybe (ContractInstanceStateInternal w s e a)
-> Maybe (ContractInstanceState w s e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ContractInstanceStateInternal w s e a
-> ContractInstanceState w s e a
forall w (s :: Row *) e a.
ContractInstanceStateInternal w s e a
-> ContractInstanceState w s e a
toInstanceState)

-- | The list of open requests of the contract instance at its latest iteration
instanceRequests ::
    forall w s e a effs.
    ( Member (Error EmulatorFoldErr) effs
    , Monoid w
    )
    => Contract w s e a
    -> ContractInstanceTag
    -> EmulatorEventFoldM effs [Request PABReq]
instanceRequests :: Contract w s e a
-> ContractInstanceTag -> EmulatorEventFoldM effs [Request PABReq]
instanceRequests Contract w s e a
con = (Maybe (ContractInstanceState w s e a) -> [Request PABReq])
-> FoldM
     (Eff effs)
     (EmulatorTimeEvent EmulatorEvent')
     (Maybe (ContractInstanceState w s e a))
-> EmulatorEventFoldM effs [Request PABReq]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (ContractInstanceState w s e a) -> [Request PABReq]
forall w (s :: Row *) e a.
Maybe (ContractInstanceState w s e a) -> [Request PABReq]
g (FoldM
   (Eff effs)
   (EmulatorTimeEvent EmulatorEvent')
   (Maybe (ContractInstanceState w s e a))
 -> EmulatorEventFoldM effs [Request PABReq])
-> (ContractInstanceTag
    -> FoldM
         (Eff effs)
         (EmulatorTimeEvent EmulatorEvent')
         (Maybe (ContractInstanceState w s e a)))
-> ContractInstanceTag
-> EmulatorEventFoldM effs [Request PABReq]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract w s e a
-> ContractInstanceTag
-> FoldM
     (Eff effs)
     (EmulatorTimeEvent EmulatorEvent')
     (Maybe (ContractInstanceState w s e a))
forall w (s :: Row *) e a (effs :: [* -> *]).
(Member (Error EmulatorFoldErr) effs, Monoid w) =>
Contract w s e a
-> ContractInstanceTag
-> EmulatorEventFoldM effs (Maybe (ContractInstanceState w s e a))
instanceState Contract w s e a
con where
    g :: Maybe (ContractInstanceState w s e a) -> [Request PABReq]
g = [Request PABReq]
-> (ContractInstanceState w s e a -> [Request PABReq])
-> Maybe (ContractInstanceState w s e a)
-> [Request PABReq]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Requests PABReq -> [Request PABReq]
forall o. Requests o -> [Request o]
State.unRequests (Requests PABReq -> [Request PABReq])
-> (ContractInstanceState w s e a -> Requests PABReq)
-> ContractInstanceState w s e a
-> [Request PABReq]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResumableResult w e PABResp PABReq a -> Requests PABReq
forall w e i o a. ResumableResult w e i o a -> Requests o
_requests (ResumableResult w e PABResp PABReq a -> Requests PABReq)
-> (ContractInstanceState w s e a
    -> ResumableResult w e PABResp PABReq a)
-> ContractInstanceState w s e a
-> Requests PABReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractInstanceState w s e a
-> ResumableResult w e PABResp PABReq a
forall w (s :: Row *) e a.
ContractInstanceState w s e a
-> ResumableResult w e PABResp PABReq a
instContractState)

-- | The unbalanced transactions generated by the contract instance.
instanceTransactions ::
    forall w s e a effs.
    ( Member (Error EmulatorFoldErr) effs
    , Monoid w
    )
    => Contract w s e a
    -> ContractInstanceTag
    -> EmulatorEventFoldM effs [UnbalancedTx]
instanceTransactions :: Contract w s e a
-> ContractInstanceTag -> EmulatorEventFoldM effs [UnbalancedTx]
instanceTransactions Contract w s e a
con = (Maybe (ContractInstanceState w s e a) -> [UnbalancedTx])
-> FoldM
     (Eff effs)
     (EmulatorTimeEvent EmulatorEvent')
     (Maybe (ContractInstanceState w s e a))
-> EmulatorEventFoldM effs [UnbalancedTx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (ContractInstanceState w s e a) -> [UnbalancedTx]
g (FoldM
   (Eff effs)
   (EmulatorTimeEvent EmulatorEvent')
   (Maybe (ContractInstanceState w s e a))
 -> EmulatorEventFoldM effs [UnbalancedTx])
-> (ContractInstanceTag
    -> FoldM
         (Eff effs)
         (EmulatorTimeEvent EmulatorEvent')
         (Maybe (ContractInstanceState w s e a)))
-> ContractInstanceTag
-> EmulatorEventFoldM effs [UnbalancedTx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract w s e a
-> ContractInstanceTag
-> FoldM
     (Eff effs)
     (EmulatorTimeEvent EmulatorEvent')
     (Maybe (ContractInstanceState w s e a))
forall w (s :: Row *) e a (effs :: [* -> *]).
(Member (Error EmulatorFoldErr) effs, Monoid w) =>
Contract w s e a
-> ContractInstanceTag
-> EmulatorEventFoldM effs (Maybe (ContractInstanceState w s e a))
instanceState @w @s @e @a @effs Contract w s e a
con where
    g :: Maybe (ContractInstanceState w s e a) -> [UnbalancedTx]
    g :: Maybe (ContractInstanceState w s e a) -> [UnbalancedTx]
g = [UnbalancedTx]
-> (ContractInstanceState w s e a -> [UnbalancedTx])
-> Maybe (ContractInstanceState w s e a)
-> [UnbalancedTx]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Request PABReq -> Maybe UnbalancedTx)
-> [Request PABReq] -> [UnbalancedTx]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (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
_BalanceTxReq (PABReq -> Maybe UnbalancedTx)
-> (Request PABReq -> PABReq)
-> Request PABReq
-> Maybe UnbalancedTx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request PABReq -> PABReq
forall o. Request o -> o
State.rqRequest) ([Request PABReq] -> [UnbalancedTx])
-> (ContractInstanceState w s e a -> [Request PABReq])
-> ContractInstanceState w s e a
-> [UnbalancedTx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Request PABReq]] -> [Request PABReq]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Request PABReq]] -> [Request PABReq])
-> (ContractInstanceState w s e a -> [[Request PABReq]])
-> ContractInstanceState w s e a
-> [Request PABReq]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq [Request PABReq] -> [[Request PABReq]]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq [Request PABReq] -> [[Request PABReq]])
-> (ContractInstanceState w s e a -> Seq [Request PABReq])
-> ContractInstanceState w s e a
-> [[Request PABReq]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractInstanceState w s e a -> Seq [Request PABReq]
forall w (s :: Row *) e a.
ContractInstanceState w s e a -> Seq [Request PABReq]
instHandlersHistory)


-- | The reponses received by the contract instance
instanceResponses ::
    forall w s e a effs.
    ( Member (Error EmulatorFoldErr) effs
    , Monoid w
    )
    => Contract w s e a
    -> ContractInstanceTag
    -> EmulatorEventFoldM effs [Response PABResp]
instanceResponses :: Contract w s e a
-> ContractInstanceTag
-> EmulatorEventFoldM effs [Response PABResp]
instanceResponses Contract w s e a
con = (Maybe (ContractInstanceState w s e a) -> [Response PABResp])
-> FoldM
     (Eff effs)
     (EmulatorTimeEvent EmulatorEvent')
     (Maybe (ContractInstanceState w s e a))
-> EmulatorEventFoldM effs [Response PABResp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Response PABResp]
-> (ContractInstanceState w s e a -> [Response PABResp])
-> Maybe (ContractInstanceState w s e a)
-> [Response PABResp]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Seq (Response PABResp) -> [Response PABResp]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (Response PABResp) -> [Response PABResp])
-> (ContractInstanceState w s e a -> Seq (Response PABResp))
-> ContractInstanceState w s e a
-> [Response PABResp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractInstanceState w s e a -> Seq (Response PABResp)
forall w (s :: Row *) e a.
ContractInstanceState w s e a -> Seq (Response PABResp)
instEvents)) (FoldM
   (Eff effs)
   (EmulatorTimeEvent EmulatorEvent')
   (Maybe (ContractInstanceState w s e a))
 -> EmulatorEventFoldM effs [Response PABResp])
-> (ContractInstanceTag
    -> FoldM
         (Eff effs)
         (EmulatorTimeEvent EmulatorEvent')
         (Maybe (ContractInstanceState w s e a)))
-> ContractInstanceTag
-> EmulatorEventFoldM effs [Response PABResp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract w s e a
-> ContractInstanceTag
-> FoldM
     (Eff effs)
     (EmulatorTimeEvent EmulatorEvent')
     (Maybe (ContractInstanceState w s e a))
forall w (s :: Row *) e a (effs :: [* -> *]).
(Member (Error EmulatorFoldErr) effs, Monoid w) =>
Contract w s e a
-> ContractInstanceTag
-> EmulatorEventFoldM effs (Maybe (ContractInstanceState w s e a))
instanceState Contract w s e a
con

-- | Accumulated state of the contract instance
instanceAccumState ::
    forall w s e a effs.
    ( Member (Error EmulatorFoldErr) effs
    , Monoid w
    )
    => Contract w s e a
    -> ContractInstanceTag
    -> EmulatorEventFoldM effs w
instanceAccumState :: Contract w s e a
-> ContractInstanceTag -> EmulatorEventFoldM effs w
instanceAccumState Contract w s e a
con = (Maybe (ContractInstanceState w s e a) -> w)
-> FoldM
     (Eff effs)
     (EmulatorTimeEvent EmulatorEvent')
     (Maybe (ContractInstanceState w s e a))
-> EmulatorEventFoldM effs w
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (w
-> (ContractInstanceState w s e a -> w)
-> Maybe (ContractInstanceState w s e a)
-> w
forall b a. b -> (a -> b) -> Maybe a -> b
maybe w
forall a. Monoid a => a
mempty (ResumableResult w e PABResp PABReq a -> w
forall w e i o a. ResumableResult w e i o a -> w
_observableState (ResumableResult w e PABResp PABReq a -> w)
-> (ContractInstanceState w s e a
    -> ResumableResult w e PABResp PABReq a)
-> ContractInstanceState w s e a
-> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractInstanceState w s e a
-> ResumableResult w e PABResp PABReq a
forall w (s :: Row *) e a.
ContractInstanceState w s e a
-> ResumableResult w e PABResp PABReq a
instContractState)) (FoldM
   (Eff effs)
   (EmulatorTimeEvent EmulatorEvent')
   (Maybe (ContractInstanceState w s e a))
 -> EmulatorEventFoldM effs w)
-> (ContractInstanceTag
    -> FoldM
         (Eff effs)
         (EmulatorTimeEvent EmulatorEvent')
         (Maybe (ContractInstanceState w s e a)))
-> ContractInstanceTag
-> EmulatorEventFoldM effs w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract w s e a
-> ContractInstanceTag
-> FoldM
     (Eff effs)
     (EmulatorTimeEvent EmulatorEvent')
     (Maybe (ContractInstanceState w s e a))
forall w (s :: Row *) e a (effs :: [* -> *]).
(Member (Error EmulatorFoldErr) effs, Monoid w) =>
Contract w s e a
-> ContractInstanceTag
-> EmulatorEventFoldM effs (Maybe (ContractInstanceState w s e a))
instanceState Contract w s e a
con

-- | The log messages produced by the contract instance.
instanceLog :: ContractInstanceTag -> EmulatorEventFold [EmulatorTimeEvent ContractInstanceLog]
instanceLog :: ContractInstanceTag
-> EmulatorEventFold [EmulatorTimeEvent ContractInstanceLog]
instanceLog ContractInstanceTag
tag =
    let flt :: EmulatorEvent -> Maybe (EmulatorTimeEvent ContractInstanceLog)
        flt :: EmulatorTimeEvent EmulatorEvent'
-> Maybe (EmulatorTimeEvent ContractInstanceLog)
flt = (EmulatorEvent' -> Maybe ContractInstanceLog)
-> EmulatorTimeEvent EmulatorEvent'
-> Maybe (EmulatorTimeEvent ContractInstanceLog)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Getting
  (First ContractInstanceLog) EmulatorEvent' ContractInstanceLog
-> EmulatorEvent' -> Maybe ContractInstanceLog
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Getting
  (First ContractInstanceLog) EmulatorEvent' ContractInstanceLog
Prism' EmulatorEvent' ContractInstanceLog
instanceEvent Getting
  (First ContractInstanceLog) EmulatorEvent' ContractInstanceLog
-> ((ContractInstanceLog
     -> Const (First ContractInstanceLog) ContractInstanceLog)
    -> ContractInstanceLog
    -> Const (First ContractInstanceLog) ContractInstanceLog)
-> Getting
     (First ContractInstanceLog) EmulatorEvent' ContractInstanceLog
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContractInstanceLog -> Bool)
-> (ContractInstanceLog
    -> Const (First ContractInstanceLog) ContractInstanceLog)
-> ContractInstanceLog
-> Const (First ContractInstanceLog) ContractInstanceLog
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (ContractInstanceTag -> ContractInstanceTag -> Bool
forall a. Eq a => a -> a -> Bool
(==) ContractInstanceTag
tag (ContractInstanceTag -> Bool)
-> (ContractInstanceLog -> ContractInstanceTag)
-> ContractInstanceLog
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ContractInstanceTag ContractInstanceLog ContractInstanceTag
-> ContractInstanceLog -> ContractInstanceTag
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractInstanceTag ContractInstanceLog ContractInstanceTag
Lens' ContractInstanceLog ContractInstanceTag
cilTag)))
    in (EmulatorTimeEvent EmulatorEvent'
 -> Maybe (EmulatorTimeEvent ContractInstanceLog))
-> Fold
     (EmulatorTimeEvent ContractInstanceLog)
     [EmulatorTimeEvent ContractInstanceLog]
-> EmulatorEventFold [EmulatorTimeEvent ContractInstanceLog]
forall a b r. (a -> Maybe b) -> Fold b r -> Fold a r
preMapMaybe EmulatorTimeEvent EmulatorEvent'
-> Maybe (EmulatorTimeEvent ContractInstanceLog)
flt Fold
  (EmulatorTimeEvent ContractInstanceLog)
  [EmulatorTimeEvent ContractInstanceLog]
forall a. Fold a [a]
L.list

-- | Log and error messages produced by the main (user) thread in the emulator
userLog :: EmulatorEventFold [EmulatorTimeEvent UserThreadMsg]
userLog :: EmulatorEventFold [EmulatorTimeEvent UserThreadMsg]
userLog =
    let flt :: EmulatorEvent -> Maybe (EmulatorTimeEvent UserThreadMsg)
        flt :: EmulatorTimeEvent EmulatorEvent'
-> Maybe (EmulatorTimeEvent UserThreadMsg)
flt = (EmulatorEvent' -> Maybe UserThreadMsg)
-> EmulatorTimeEvent EmulatorEvent'
-> Maybe (EmulatorTimeEvent UserThreadMsg)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Getting (First UserThreadMsg) EmulatorEvent' UserThreadMsg
-> EmulatorEvent' -> Maybe UserThreadMsg
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First UserThreadMsg) EmulatorEvent' UserThreadMsg
Prism' EmulatorEvent' UserThreadMsg
userThreadEvent)
    in (EmulatorTimeEvent EmulatorEvent'
 -> Maybe (EmulatorTimeEvent UserThreadMsg))
-> Fold
     (EmulatorTimeEvent UserThreadMsg) [EmulatorTimeEvent UserThreadMsg]
-> EmulatorEventFold [EmulatorTimeEvent UserThreadMsg]
forall a b r. (a -> Maybe b) -> Fold b r -> Fold a r
preMapMaybe EmulatorTimeEvent EmulatorEvent'
-> Maybe (EmulatorTimeEvent UserThreadMsg)
flt Fold
  (EmulatorTimeEvent UserThreadMsg) [EmulatorTimeEvent UserThreadMsg]
forall a. Fold a [a]
L.list

data Outcome e a =
    Done a
    -- ^ The contract finished without errors and produced a result
    | NotDone
    -- ^ The contract is waiting for more input.
    | Failed e
    -- ^ The contract failed with an error.
    deriving (Outcome e a -> Outcome e a -> Bool
(Outcome e a -> Outcome e a -> Bool)
-> (Outcome e a -> Outcome e a -> Bool) -> Eq (Outcome e a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a. (Eq a, Eq e) => Outcome e a -> Outcome e a -> Bool
/= :: Outcome e a -> Outcome e a -> Bool
$c/= :: forall e a. (Eq a, Eq e) => Outcome e a -> Outcome e a -> Bool
== :: Outcome e a -> Outcome e a -> Bool
$c== :: forall e a. (Eq a, Eq e) => Outcome e a -> Outcome e a -> Bool
Eq, Int -> Outcome e a -> ShowS
[Outcome e a] -> ShowS
Outcome e a -> String
(Int -> Outcome e a -> ShowS)
-> (Outcome e a -> String)
-> ([Outcome e a] -> ShowS)
-> Show (Outcome e a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show a, Show e) => Int -> Outcome e a -> ShowS
forall e a. (Show a, Show e) => [Outcome e a] -> ShowS
forall e a. (Show a, Show e) => Outcome e a -> String
showList :: [Outcome e a] -> ShowS
$cshowList :: forall e a. (Show a, Show e) => [Outcome e a] -> ShowS
show :: Outcome e a -> String
$cshow :: forall e a. (Show a, Show e) => Outcome e a -> String
showsPrec :: Int -> Outcome e a -> ShowS
$cshowsPrec :: forall e a. (Show a, Show e) => Int -> Outcome e a -> ShowS
Show)

fromResumableResult :: ResumableResult w e i o a -> Outcome e a
fromResumableResult :: ResumableResult w e i o a -> Outcome e a
fromResumableResult = (e -> Outcome e a)
-> (Maybe a -> Outcome e a) -> Either e (Maybe a) -> Outcome e a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Outcome e a
forall e a. e -> Outcome e a
Failed (Outcome e a -> (a -> Outcome e a) -> Maybe a -> Outcome e a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Outcome e a
forall e a. Outcome e a
NotDone a -> Outcome e a
forall e a. a -> Outcome e a
Done) (Either e (Maybe a) -> Outcome e a)
-> (ResumableResult w e i o a -> Either e (Maybe a))
-> ResumableResult w e i o a
-> Outcome e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResumableResult w e i o a -> Either e (Maybe a)
forall w e i o a. ResumableResult w e i o a -> Either e (Maybe a)
_finalState

-- | The final state of the instance
instanceOutcome ::
    forall w s e a effs.
    ( Member (Error EmulatorFoldErr) effs
    , Monoid w
    )
    => Contract w s e a
    -> ContractInstanceTag
    -> EmulatorEventFoldM effs (Outcome e a)
instanceOutcome :: Contract w s e a
-> ContractInstanceTag -> EmulatorEventFoldM effs (Outcome e a)
instanceOutcome Contract w s e a
con =
    (Maybe (ContractInstanceState w s e a) -> Outcome e a)
-> FoldM
     (Eff effs)
     (EmulatorTimeEvent EmulatorEvent')
     (Maybe (ContractInstanceState w s e a))
-> EmulatorEventFoldM effs (Outcome e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Outcome e a
-> (ContractInstanceState w s e a -> Outcome e a)
-> Maybe (ContractInstanceState w s e a)
-> Outcome e a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Outcome e a
forall e a. Outcome e a
NotDone (ResumableResult w e PABResp PABReq a -> Outcome e a
forall w e i o a. ResumableResult w e i o a -> Outcome e a
fromResumableResult (ResumableResult w e PABResp PABReq a -> Outcome e a)
-> (ContractInstanceState w s e a
    -> ResumableResult w e PABResp PABReq a)
-> ContractInstanceState w s e a
-> Outcome e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractInstanceState w s e a
-> ResumableResult w e PABResp PABReq a
forall w (s :: Row *) e a.
ContractInstanceState w s e a
-> ResumableResult w e PABResp PABReq a
instContractState)) (FoldM
   (Eff effs)
   (EmulatorTimeEvent EmulatorEvent')
   (Maybe (ContractInstanceState w s e a))
 -> EmulatorEventFoldM effs (Outcome e a))
-> (ContractInstanceTag
    -> FoldM
         (Eff effs)
         (EmulatorTimeEvent EmulatorEvent')
         (Maybe (ContractInstanceState w s e a)))
-> ContractInstanceTag
-> EmulatorEventFoldM effs (Outcome e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract w s e a
-> ContractInstanceTag
-> FoldM
     (Eff effs)
     (EmulatorTimeEvent EmulatorEvent')
     (Maybe (ContractInstanceState w s e a))
forall w (s :: Row *) e a (effs :: [* -> *]).
(Member (Error EmulatorFoldErr) effs, Monoid w) =>
Contract w s e a
-> ContractInstanceTag
-> EmulatorEventFoldM effs (Maybe (ContractInstanceState w s e a))
instanceState Contract w s e a
con

-- | Unspent outputs at an address
utxoAtAddress :: CardanoAddress -> EmulatorEventFold UtxoMap
utxoAtAddress :: CardanoAddress -> EmulatorEventFold UtxoMap
utxoAtAddress CardanoAddress
addr =
    (EmulatorTimeEvent EmulatorEvent' -> Maybe ChainEvent)
-> Fold ChainEvent UtxoMap -> EmulatorEventFold UtxoMap
forall a b r. (a -> Maybe b) -> Fold b r -> Fold a r
preMapMaybe (Getting
  (First ChainEvent) (EmulatorTimeEvent EmulatorEvent') ChainEvent
-> EmulatorTimeEvent EmulatorEvent' -> Maybe ChainEvent
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((EmulatorEvent' -> Const (First ChainEvent) EmulatorEvent')
-> EmulatorTimeEvent EmulatorEvent'
-> Const (First ChainEvent) (EmulatorTimeEvent EmulatorEvent')
forall e1 e2.
Lens (EmulatorTimeEvent e1) (EmulatorTimeEvent e2) e1 e2
eteEvent ((EmulatorEvent' -> Const (First ChainEvent) EmulatorEvent')
 -> EmulatorTimeEvent EmulatorEvent'
 -> Const (First ChainEvent) (EmulatorTimeEvent EmulatorEvent'))
-> ((ChainEvent -> Const (First ChainEvent) ChainEvent)
    -> EmulatorEvent' -> Const (First ChainEvent) EmulatorEvent')
-> Getting
     (First ChainEvent) (EmulatorTimeEvent EmulatorEvent') ChainEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainEvent -> Const (First ChainEvent) ChainEvent)
-> EmulatorEvent' -> Const (First ChainEvent) EmulatorEvent'
Prism' EmulatorEvent' ChainEvent
chainEvent))
    (Fold ChainEvent UtxoMap -> EmulatorEventFold UtxoMap)
-> Fold ChainEvent UtxoMap -> EmulatorEventFold UtxoMap
forall a b. (a -> b) -> a -> b
$ (AddressMap -> ChainEvent -> AddressMap)
-> AddressMap -> (AddressMap -> UtxoMap) -> Fold ChainEvent UtxoMap
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold ((ChainEvent -> AddressMap -> AddressMap)
-> AddressMap -> ChainEvent -> AddressMap
forall a b c. (a -> b -> c) -> b -> a -> c
flip ChainEvent -> AddressMap -> AddressMap
step) (CardanoAddress -> AddressMap -> AddressMap
AM.addAddress CardanoAddress
addr AddressMap
forall a. Monoid a => a
mempty) (Getting UtxoMap AddressMap UtxoMap -> AddressMap -> UtxoMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (CardanoAddress -> Lens' AddressMap UtxoMap
AM.fundsAt CardanoAddress
addr))
    where
        step :: ChainEvent -> AddressMap -> AddressMap
step = (Unwrapped (Endo AddressMap) -> Endo AddressMap)
-> ((OnChainTx -> Endo AddressMap)
    -> Maybe OnChainTx -> Endo AddressMap)
-> (OnChainTx -> Unwrapped (Endo AddressMap))
-> Maybe OnChainTx
-> Unwrapped (Endo AddressMap)
forall (f :: * -> *) (g :: * -> *) s t.
(Functor f, Functor g, Rewrapping s t) =>
(Unwrapped s -> s)
-> (f t -> g s) -> f (Unwrapped t) -> g (Unwrapped s)
alaf Unwrapped (Endo AddressMap) -> Endo AddressMap
forall a. (a -> a) -> Endo a
Endo (OnChainTx -> Endo AddressMap)
-> Maybe OnChainTx -> Endo AddressMap
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap OnChainTx -> Unwrapped (Endo AddressMap)
OnChainTx -> AddressMap -> AddressMap
AM.updateAddresses (Maybe OnChainTx -> AddressMap -> AddressMap)
-> (ChainEvent -> Maybe OnChainTx)
-> ChainEvent
-> AddressMap
-> AddressMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainEvent -> Maybe OnChainTx
chainEventOnChainTx

-- | The total value of unspent outputs at an address
valueAtAddress :: CardanoAddress -> EmulatorEventFold C.Value
valueAtAddress :: CardanoAddress -> EmulatorEventFold Value
valueAtAddress = (UtxoMap -> Value)
-> EmulatorEventFold UtxoMap -> EmulatorEventFold Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((CardanoTx, TxOut) -> Value) -> UtxoMap -> 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)) (EmulatorEventFold UtxoMap -> EmulatorEventFold Value)
-> (CardanoAddress -> EmulatorEventFold UtxoMap)
-> CardanoAddress
-> EmulatorEventFold Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoAddress -> EmulatorEventFold UtxoMap
utxoAtAddress

-- | The funds belonging to a wallet
walletFunds :: Wallet -> EmulatorEventFold C.Value
walletFunds :: Wallet -> EmulatorEventFold Value
walletFunds = CardanoAddress -> EmulatorEventFold Value
valueAtAddress (CardanoAddress -> EmulatorEventFold Value)
-> (Wallet -> CardanoAddress) -> Wallet -> EmulatorEventFold Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> CardanoAddress
mockWalletAddress

-- | The fees paid by a wallet
walletFees :: Wallet -> EmulatorEventFold C.Lovelace
walletFees :: Wallet -> EmulatorEventFold Lovelace
walletFees Wallet
w = Map TxId Lovelace
-> [(OnChainTx, RedeemerReport)]
-> [(CardanoTx, ValidationError, Value)]
-> Lovelace
forall (t :: * -> *) (t :: * -> *) a b b.
(Foldable t, Foldable t) =>
Map TxId a
-> t (OnChainTx, b) -> t (CardanoTx, b, Value) -> Lovelace
fees (Map TxId Lovelace
 -> [(OnChainTx, RedeemerReport)]
 -> [(CardanoTx, ValidationError, Value)]
 -> Lovelace)
-> Fold (EmulatorTimeEvent EmulatorEvent') (Map TxId Lovelace)
-> Fold
     (EmulatorTimeEvent EmulatorEvent')
     ([(OnChainTx, RedeemerReport)]
      -> [(CardanoTx, ValidationError, Value)] -> Lovelace)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fold (EmulatorTimeEvent EmulatorEvent') (Map TxId Lovelace)
walletSubmittedFees Fold
  (EmulatorTimeEvent EmulatorEvent')
  ([(OnChainTx, RedeemerReport)]
   -> [(CardanoTx, ValidationError, Value)] -> Lovelace)
-> EmulatorEventFold [(OnChainTx, RedeemerReport)]
-> Fold
     (EmulatorTimeEvent EmulatorEvent')
     ([(CardanoTx, ValidationError, Value)] -> Lovelace)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EmulatorEventFold [(OnChainTx, RedeemerReport)]
validatedTransactions Fold
  (EmulatorTimeEvent EmulatorEvent')
  ([(CardanoTx, ValidationError, Value)] -> Lovelace)
-> EmulatorEventFold [(CardanoTx, ValidationError, Value)]
-> EmulatorEventFold Lovelace
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ValidationPhase
-> EmulatorEventFold [(CardanoTx, ValidationError, Value)]
failedTransactions (ValidationPhase -> Maybe ValidationPhase
forall a. a -> Maybe a
Just ValidationPhase
Phase2)
    where
        fees :: Map TxId a
-> t (OnChainTx, b) -> t (CardanoTx, b, Value) -> Lovelace
fees Map TxId a
submitted t (OnChainTx, b)
txsV t (CardanoTx, b, Value)
txsF =
            ((OnChainTx, b) -> TxId)
-> ((OnChainTx, b) -> Lovelace)
-> Map TxId a
-> t (OnChainTx, b)
-> Lovelace
forall (t :: * -> *) m k t a.
(Foldable t, Monoid m, Ord k) =>
(t -> k) -> (t -> m) -> Map k a -> t t -> m
findFees (\(OnChainTx
tx, b
_) -> CardanoTx -> TxId
getCardanoTxId (CardanoTx -> TxId) -> CardanoTx -> TxId
forall a b. (a -> b) -> a -> b
$ OnChainTx -> CardanoTx
unOnChain OnChainTx
tx) (\(OnChainTx
tx, b
_) -> CardanoTx -> Lovelace
getCardanoTxFee (CardanoTx -> Lovelace) -> CardanoTx -> Lovelace
forall a b. (a -> b) -> a -> b
$ OnChainTx -> CardanoTx
unOnChain OnChainTx
tx) Map TxId a
submitted t (OnChainTx, b)
txsV
            Lovelace -> Lovelace -> Lovelace
forall a. Semigroup a => a -> a -> a
<>
            ((CardanoTx, b, Value) -> TxId)
-> ((CardanoTx, b, Value) -> Lovelace)
-> Map TxId a
-> t (CardanoTx, b, Value)
-> Lovelace
forall (t :: * -> *) m k t a.
(Foldable t, Monoid m, Ord k) =>
(t -> k) -> (t -> m) -> Map k a -> t t -> m
findFees (\(CardanoTx
tx, b
_, Value
_) -> CardanoTx -> TxId
getCardanoTxId CardanoTx
tx) (\(CardanoTx
_, b
_, Value
collateral) -> Value -> Lovelace
C.selectLovelace Value
collateral) Map TxId a
submitted t (CardanoTx, b, Value)
txsF
        findFees :: (t -> k) -> (t -> m) -> Map k a -> t t -> m
findFees t -> k
getId t -> m
getFees Map k a
submitted = (t -> m) -> t t -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\t
t -> if k -> Map k a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member (t -> k
getId t
t) Map k a
submitted then t -> m
getFees t
t else m
forall a. Monoid a => a
mempty)
        walletSubmittedFees :: Fold (EmulatorTimeEvent EmulatorEvent') (Map TxId Lovelace)
walletSubmittedFees = Handler (EmulatorTimeEvent EmulatorEvent') (TxId, Lovelace)
-> Fold (TxId, Lovelace) (Map TxId Lovelace)
-> Fold (EmulatorTimeEvent EmulatorEvent') (Map TxId Lovelace)
forall a b r. Handler a b -> Fold b r -> Fold a r
L.handles ((EmulatorEvent' -> Const (Dual (Endo x)) EmulatorEvent')
-> EmulatorTimeEvent EmulatorEvent'
-> Const (Dual (Endo x)) (EmulatorTimeEvent EmulatorEvent')
forall e1 e2.
Lens (EmulatorTimeEvent e1) (EmulatorTimeEvent e2) e1 e2
eteEvent ((EmulatorEvent' -> Const (Dual (Endo x)) EmulatorEvent')
 -> EmulatorTimeEvent EmulatorEvent'
 -> Const (Dual (Endo x)) (EmulatorTimeEvent EmulatorEvent'))
-> (((TxId, Lovelace) -> Const (Dual (Endo x)) (TxId, Lovelace))
    -> EmulatorEvent' -> Const (Dual (Endo x)) EmulatorEvent')
-> ((TxId, Lovelace) -> Const (Dual (Endo x)) (TxId, Lovelace))
-> EmulatorTimeEvent EmulatorEvent'
-> Const (Dual (Endo x)) (EmulatorTimeEvent EmulatorEvent')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wallet -> Prism' EmulatorEvent' NodeClientEvent
walletClientEvent Wallet
w ((NodeClientEvent -> Const (Dual (Endo x)) NodeClientEvent)
 -> EmulatorEvent' -> Const (Dual (Endo x)) EmulatorEvent')
-> (((TxId, Lovelace) -> Const (Dual (Endo x)) (TxId, Lovelace))
    -> NodeClientEvent -> Const (Dual (Endo x)) NodeClientEvent)
-> ((TxId, Lovelace) -> Const (Dual (Endo x)) (TxId, Lovelace))
-> EmulatorEvent'
-> Const (Dual (Endo x)) EmulatorEvent'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxId, Lovelace) -> Const (Dual (Endo x)) (TxId, Lovelace))
-> NodeClientEvent -> Const (Dual (Endo x)) NodeClientEvent
Iso' NodeClientEvent (TxId, Lovelace)
_TxSubmit) Fold (TxId, Lovelace) (Map TxId Lovelace)
forall a b. Ord a => Fold (a, b) (Map a b)
L.map

-- | Annotate the transactions that were validated by the node
annotatedBlockchain :: EmulatorEventFold [[AnnotatedTx]]
annotatedBlockchain :: EmulatorEventFold [[AnnotatedTx]]
annotatedBlockchain =
    (EmulatorTimeEvent EmulatorEvent' -> Maybe ChainEvent)
-> Fold ChainEvent [[AnnotatedTx]]
-> EmulatorEventFold [[AnnotatedTx]]
forall a b r. (a -> Maybe b) -> Fold b r -> Fold a r
preMapMaybe (Getting
  (First ChainEvent) (EmulatorTimeEvent EmulatorEvent') ChainEvent
-> EmulatorTimeEvent EmulatorEvent' -> Maybe ChainEvent
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((EmulatorEvent' -> Const (First ChainEvent) EmulatorEvent')
-> EmulatorTimeEvent EmulatorEvent'
-> Const (First ChainEvent) (EmulatorTimeEvent EmulatorEvent')
forall e1 e2.
Lens (EmulatorTimeEvent e1) (EmulatorTimeEvent e2) e1 e2
eteEvent ((EmulatorEvent' -> Const (First ChainEvent) EmulatorEvent')
 -> EmulatorTimeEvent EmulatorEvent'
 -> Const (First ChainEvent) (EmulatorTimeEvent EmulatorEvent'))
-> ((ChainEvent -> Const (First ChainEvent) ChainEvent)
    -> EmulatorEvent' -> Const (First ChainEvent) EmulatorEvent')
-> Getting
     (First ChainEvent) (EmulatorTimeEvent EmulatorEvent') ChainEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainEvent -> Const (First ChainEvent) ChainEvent)
-> EmulatorEvent' -> Const (First ChainEvent) EmulatorEvent'
Prism' EmulatorEvent' ChainEvent
chainEvent))
    (Fold ChainEvent [[AnnotatedTx]]
 -> EmulatorEventFold [[AnnotatedTx]])
-> Fold ChainEvent [[AnnotatedTx]]
-> EmulatorEventFold [[AnnotatedTx]]
forall a b. (a -> b) -> a -> b
$ (RollupState -> ChainEvent -> RollupState)
-> RollupState
-> (RollupState -> [[AnnotatedTx]])
-> Fold ChainEvent [[AnnotatedTx]]
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold RollupState -> ChainEvent -> RollupState
Rollup.handleChainEvent RollupState
Rollup.initialState RollupState -> [[AnnotatedTx]]
Rollup.getAnnotatedTransactions

-- | All chain events emitted by the node
chainEvents :: EmulatorEventFold [ChainEvent]
chainEvents :: EmulatorEventFold [ChainEvent]
chainEvents = (EmulatorTimeEvent EmulatorEvent' -> Maybe ChainEvent)
-> Fold ChainEvent [ChainEvent] -> EmulatorEventFold [ChainEvent]
forall a b r. (a -> Maybe b) -> Fold b r -> Fold a r
preMapMaybe (Getting
  (First ChainEvent) (EmulatorTimeEvent EmulatorEvent') ChainEvent
-> EmulatorTimeEvent EmulatorEvent' -> Maybe ChainEvent
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((EmulatorEvent' -> Const (First ChainEvent) EmulatorEvent')
-> EmulatorTimeEvent EmulatorEvent'
-> Const (First ChainEvent) (EmulatorTimeEvent EmulatorEvent')
forall e1 e2.
Lens (EmulatorTimeEvent e1) (EmulatorTimeEvent e2) e1 e2
eteEvent ((EmulatorEvent' -> Const (First ChainEvent) EmulatorEvent')
 -> EmulatorTimeEvent EmulatorEvent'
 -> Const (First ChainEvent) (EmulatorTimeEvent EmulatorEvent'))
-> ((ChainEvent -> Const (First ChainEvent) ChainEvent)
    -> EmulatorEvent' -> Const (First ChainEvent) EmulatorEvent')
-> Getting
     (First ChainEvent) (EmulatorTimeEvent EmulatorEvent') ChainEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainEvent -> Const (First ChainEvent) ChainEvent)
-> EmulatorEvent' -> Const (First ChainEvent) EmulatorEvent'
Prism' EmulatorEvent' ChainEvent
chainEvent)) Fold ChainEvent [ChainEvent]
forall a. Fold a [a]
L.list

-- | All transactions that happened during the simulation
blockchain :: EmulatorEventFold [Block]
blockchain :: EmulatorEventFold [Block]
blockchain =
    let step :: (Block, [Block]) -> ChainEvent -> (Block, [Block])
step (Block
currentBlock, [Block]
otherBlocks) = \case
            SlotAdd Slot
_         -> ([], Block
currentBlock Block -> [Block] -> [Block]
forall a. a -> [a] -> [a]
: [Block]
otherBlocks)
            TxnValidation ValidationResult
res -> (Block -> (OnChainTx -> Block) -> Maybe OnChainTx -> Block
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Block
currentBlock (OnChainTx -> Block -> Block
forall a. a -> [a] -> [a]
: Block
currentBlock) (Maybe OnChainTx -> Block) -> Maybe OnChainTx -> Block
forall a b. (a -> b) -> a -> b
$ ValidationResult -> Maybe OnChainTx
toOnChain ValidationResult
res, [Block]
otherBlocks)
        initial :: ([a], [a])
initial = ([], [])
        extract :: (a, [a]) -> [a]
extract (a
currentBlock, [a]
otherBlocks) =
            (a
currentBlock a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
otherBlocks)
    in (EmulatorTimeEvent EmulatorEvent' -> Maybe ChainEvent)
-> Fold ChainEvent [Block] -> EmulatorEventFold [Block]
forall a b r. (a -> Maybe b) -> Fold b r -> Fold a r
preMapMaybe (Getting
  (First ChainEvent) (EmulatorTimeEvent EmulatorEvent') ChainEvent
-> EmulatorTimeEvent EmulatorEvent' -> Maybe ChainEvent
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((EmulatorEvent' -> Const (First ChainEvent) EmulatorEvent')
-> EmulatorTimeEvent EmulatorEvent'
-> Const (First ChainEvent) (EmulatorTimeEvent EmulatorEvent')
forall e1 e2.
Lens (EmulatorTimeEvent e1) (EmulatorTimeEvent e2) e1 e2
eteEvent ((EmulatorEvent' -> Const (First ChainEvent) EmulatorEvent')
 -> EmulatorTimeEvent EmulatorEvent'
 -> Const (First ChainEvent) (EmulatorTimeEvent EmulatorEvent'))
-> ((ChainEvent -> Const (First ChainEvent) ChainEvent)
    -> EmulatorEvent' -> Const (First ChainEvent) EmulatorEvent')
-> Getting
     (First ChainEvent) (EmulatorTimeEvent EmulatorEvent') ChainEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainEvent -> Const (First ChainEvent) ChainEvent)
-> EmulatorEvent' -> Const (First ChainEvent) EmulatorEvent'
Prism' EmulatorEvent' ChainEvent
chainEvent))
        (Fold ChainEvent [Block] -> EmulatorEventFold [Block])
-> Fold ChainEvent [Block] -> EmulatorEventFold [Block]
forall a b. (a -> b) -> a -> b
$ ((Block, [Block]) -> ChainEvent -> (Block, [Block]))
-> (Block, [Block])
-> ((Block, [Block]) -> [Block])
-> Fold ChainEvent [Block]
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (Block, [Block]) -> ChainEvent -> (Block, [Block])
step (Block, [Block])
forall a a. ([a], [a])
initial (Block, [Block]) -> [Block]
forall a. (a, [a]) -> [a]
extract

-- | The list of all emulator events
emulatorLog :: EmulatorEventFold [EmulatorEvent]
emulatorLog :: EmulatorEventFold [EmulatorTimeEvent EmulatorEvent']
emulatorLog = EmulatorEventFold [EmulatorTimeEvent EmulatorEvent']
forall a. Fold a [a]
L.list

-- | Pretty-print each element into a new line.
renderLines :: forall a. Pretty a => Fold a Text
renderLines :: Fold a Text
renderLines =
    let rnd :: Doc ann -> Text
rnd = SimpleDocStream ann -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict (SimpleDocStream ann -> Text)
-> (Doc ann -> SimpleDocStream ann) -> Doc ann -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc ann -> SimpleDocStream ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions in
    (a -> Doc Any)
-> ([Doc Any] -> Text) -> Fold (Doc Any) [Doc Any] -> Fold a Text
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty (Doc Any -> Text
forall ann. Doc ann -> Text
rnd (Doc Any -> Text) -> ([Doc Any] -> Doc Any) -> [Doc Any] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Any] -> Doc Any
forall ann. [Doc ann] -> Doc ann
vsep) Fold (Doc Any) [Doc Any]
forall a. Fold a [a]
L.list

-- | An effectful 'Data.Maybe.mapMaybe' for 'FoldM'.
preMapMaybeM ::
    Monad m
    => (a -> m (Maybe b))
    -> FoldM m b r
    -> FoldM m a r
preMapMaybeM :: (a -> m (Maybe b)) -> FoldM m b r -> FoldM m a r
preMapMaybeM a -> m (Maybe b)
f (FoldM x -> b -> m x
step m x
begin x -> m r
done) = (x -> a -> m x) -> m x -> (x -> m r) -> FoldM m a r
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step' m x
begin x -> m r
done where
    step' :: x -> a -> m x
step' x
x a
a = do
        Maybe b
result <- a -> m (Maybe b)
f a
a
        case Maybe b
result of
            Maybe b
Nothing -> x -> m x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x
            Just b
a' -> x -> b -> m x
step x
x b
a'

-- | 'Data.Maybe.mapMaybe' for 'Fold'.
preMapMaybe :: (a -> Maybe b) -> Fold b r -> Fold a r
preMapMaybe :: (a -> Maybe b) -> Fold b r -> Fold a r
preMapMaybe a -> Maybe b
f (Fold x -> b -> x
step x
begin x -> r
done) = (x -> a -> x) -> x -> (x -> r) -> Fold a r
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold x -> a -> x
step' x
begin x -> r
done where
    step' :: x -> a -> x
step' x
x a
a = case a -> Maybe b
f a
a of
        Maybe b
Nothing -> x
x
        Just b
b  -> x -> b -> x
step x
x b
b

-- | Effectfully map the result of a 'FoldM'
postMapM ::
    Monad m
    => (b -> m c)
    -> FoldM m a b
    -> FoldM m a c
postMapM :: (b -> m c) -> FoldM m a b -> FoldM m a c
postMapM b -> m c
f (FoldM x -> a -> m x
step m x
begin x -> m b
done) = (x -> a -> m x) -> m x -> (x -> m c) -> FoldM m a c
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FoldM x -> a -> m x
step m x
begin (x -> m b
done (x -> m b) -> (b -> m c) -> x -> m c
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> b -> m c
f)

data EmulatorFoldErr =
    InstanceStateJSONDecodingError String (Response JSON.Value)
    deriving stock (EmulatorFoldErr -> EmulatorFoldErr -> Bool
(EmulatorFoldErr -> EmulatorFoldErr -> Bool)
-> (EmulatorFoldErr -> EmulatorFoldErr -> Bool)
-> Eq EmulatorFoldErr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmulatorFoldErr -> EmulatorFoldErr -> Bool
$c/= :: EmulatorFoldErr -> EmulatorFoldErr -> Bool
== :: EmulatorFoldErr -> EmulatorFoldErr -> Bool
$c== :: EmulatorFoldErr -> EmulatorFoldErr -> Bool
Eq, Eq EmulatorFoldErr
Eq EmulatorFoldErr
-> (EmulatorFoldErr -> EmulatorFoldErr -> Ordering)
-> (EmulatorFoldErr -> EmulatorFoldErr -> Bool)
-> (EmulatorFoldErr -> EmulatorFoldErr -> Bool)
-> (EmulatorFoldErr -> EmulatorFoldErr -> Bool)
-> (EmulatorFoldErr -> EmulatorFoldErr -> Bool)
-> (EmulatorFoldErr -> EmulatorFoldErr -> EmulatorFoldErr)
-> (EmulatorFoldErr -> EmulatorFoldErr -> EmulatorFoldErr)
-> Ord EmulatorFoldErr
EmulatorFoldErr -> EmulatorFoldErr -> Bool
EmulatorFoldErr -> EmulatorFoldErr -> Ordering
EmulatorFoldErr -> EmulatorFoldErr -> EmulatorFoldErr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EmulatorFoldErr -> EmulatorFoldErr -> EmulatorFoldErr
$cmin :: EmulatorFoldErr -> EmulatorFoldErr -> EmulatorFoldErr
max :: EmulatorFoldErr -> EmulatorFoldErr -> EmulatorFoldErr
$cmax :: EmulatorFoldErr -> EmulatorFoldErr -> EmulatorFoldErr
>= :: EmulatorFoldErr -> EmulatorFoldErr -> Bool
$c>= :: EmulatorFoldErr -> EmulatorFoldErr -> Bool
> :: EmulatorFoldErr -> EmulatorFoldErr -> Bool
$c> :: EmulatorFoldErr -> EmulatorFoldErr -> Bool
<= :: EmulatorFoldErr -> EmulatorFoldErr -> Bool
$c<= :: EmulatorFoldErr -> EmulatorFoldErr -> Bool
< :: EmulatorFoldErr -> EmulatorFoldErr -> Bool
$c< :: EmulatorFoldErr -> EmulatorFoldErr -> Bool
compare :: EmulatorFoldErr -> EmulatorFoldErr -> Ordering
$ccompare :: EmulatorFoldErr -> EmulatorFoldErr -> Ordering
$cp1Ord :: Eq EmulatorFoldErr
Ord, Int -> EmulatorFoldErr -> ShowS
[EmulatorFoldErr] -> ShowS
EmulatorFoldErr -> String
(Int -> EmulatorFoldErr -> ShowS)
-> (EmulatorFoldErr -> String)
-> ([EmulatorFoldErr] -> ShowS)
-> Show EmulatorFoldErr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmulatorFoldErr] -> ShowS
$cshowList :: [EmulatorFoldErr] -> ShowS
show :: EmulatorFoldErr -> String
$cshow :: EmulatorFoldErr -> String
showsPrec :: Int -> EmulatorFoldErr -> ShowS
$cshowsPrec :: Int -> EmulatorFoldErr -> ShowS
Show)

-- | A human-readable explanation of the error, to be included in the logs.
describeError :: EmulatorFoldErr -> String
describeError :: EmulatorFoldErr -> String
describeError = \case
    InstanceStateJSONDecodingError String
_ Response Value
_ -> [String] -> String
unwords
        [ String
"Failed to decode a 'Response JSON.Value'."
        , String
"The event is probably for a different 'Contract'."
        , String
"This is often caused by having multiple contract instances share the same 'ContractInstanceTag' (for example, when  using 'activateContractWallet' repeatedly on the same wallet)."
        , String
"To fix this, use 'activateContract' with a unique 'ContractInstanceTag' per instance."
        ]