{-# LANGUAGE AllowAmbiguousTypes  #-}
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE DerivingVia          #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE KindSignatures       #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE NamedFieldPuns       #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns         #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

-- | Testing contracts with HUnit and Tasty
module Plutus.Contract.Test(
      module X
    , TracePredicateF(..)
    , TracePredicate
    , ContractConstraints
    , Plutus.Contract.Test.not
    , (.&&.)
    , (.||.)
    , w1, w2, w3, w4, w5, w6, w7, w8, w9, w10
    -- * Assertions
    , endpointAvailable
    , assertDone
    , assertNotDone
    , assertContractError
    , Outcome(..)
    , assertOutcome
    , assertInstanceLog
    , assertNoFailedTransactions
    , assertValidatedTransactionCount
    , assertValidatedTransactionCountOfTotal
    , assertFailedTransaction
    , assertEvaluationError
    , assertHooks
    , assertResponses
    , assertUserLog
    , assertBlockchain
    , assertChainEvents
    , assertChainEvents'
    , assertAccumState
    , Shrinking(..)
    , assertResumableResult
    , assertUnbalancedTx
    , anyUnbalancedTx
    , assertEvents
    , walletFundsChangePlutus
    , walletFundsChange
    , walletFundsExactChange
    , walletFundsAssetClassChange
    , walletPaidFees
    , waitingForSlot
    , valueAtAddress
    , plutusValueAtAddress
    , dataAtAddress
    , reasonable
    , reasonable'
    -- * Checking predicates
    , checkPredicate
    , checkPredicateCoverage
    , checkPredicateCoverageOptions
    , checkPredicateOptions
    , checkPredicateGen
    , checkPredicateGenOptions
    , checkPredicateInner
    , checkPredicateInnerStream
    , checkEmulatorFails
    , CheckOptions(..)
    , defaultCheckOptions
    , minLogLevel
    , emulatorConfig
    , changeInitialWalletValue
    , increaseTransactionLimits
    -- * Etc
    , goldenPir
    ) where

import Control.Applicative (liftA2)
import Control.Foldl (FoldM)
import Control.Foldl qualified as L
import Control.Lens (_1, _Left, anyOf, at, folded, ix, makeLenses, makePrisms, over, preview, (&), (.~), (^.))
import Control.Monad (guard, unless, void)
import Control.Monad.Freer (Eff, interpretM, runM)
import Control.Monad.Freer.Error (Error, runError)
import Control.Monad.Freer.Extras.Log (LogLevel (..), LogMessage (..))
import Control.Monad.Freer.Reader
import Control.Monad.Freer.Writer (Writer (..), tell)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Default (Default (..))
import Data.Foldable (fold, toList, traverse_)
import Data.IORef
import Data.Maybe (fromJust, mapMaybe)
import Data.OpenUnion
import Data.Proxy (Proxy (..))
import Data.String (IsString (..))
import Data.Text qualified as Text
import Data.Void
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import Plutus.Contract.Effects (ActiveEndpoint (..), PABReq, PABResp)
import Prettyprinter
import Prettyprinter.Render.Text (renderStrict)


import Hedgehog (Property, forAll, property)
import Hedgehog qualified
import Test.Tasty.Golden (goldenVsString)
import Test.Tasty.HUnit qualified as HUnit
import Test.Tasty.Providers (TestTree)

import Cardano.Api qualified as C
import Cardano.Node.Emulator.Generators (GeneratorModel, Mockchain (..))
import Cardano.Node.Emulator.Generators qualified as Gen
import Cardano.Node.Emulator.Internal.Node (ChainEvent)
import Cardano.Node.Emulator.Internal.Node.Params qualified as Params
import Ledger qualified
import Ledger.Address (CardanoAddress, toPlutusAddress)
import Ledger.Index (ValidationError)
import Ledger.Slot (Slot)
import Ledger.Tx.Constraints.OffChain (UnbalancedTx)
import Ledger.Tx.Internal
import Ledger.Value.CardanoAPI (fromCardanoValue, lovelaceToValue, toCardanoValue)
import Plutus.Contract.Effects qualified as Requests
import Plutus.Contract.Request qualified as Request
import Plutus.Contract.Resumable (Request (..), Response (..))
import Plutus.Contract.Resumable qualified as State
import Plutus.Contract.Test.Coverage
import Plutus.Contract.Test.MissingLovelace (calculateDelta)
import Plutus.Contract.Trace as X
import Plutus.Contract.Types (Contract (..), IsContract (..), ResumableResult, shrinkResumableResult)
import Plutus.Trace.Emulator (EmulatorConfig (..), EmulatorTrace, params, runEmulatorStream)
import Plutus.Trace.Emulator.Types (ContractConstraints, ContractInstanceLog, ContractInstanceState (..),
                                    ContractInstanceTag, UserThreadMsg)
import Plutus.V1.Ledger.Scripts qualified as PV1
import Plutus.V1.Ledger.Value qualified as Plutus
import PlutusTx (CompiledCode, FromData (..), getPir)
import PlutusTx.Coverage
import Streaming qualified as S
import Streaming.Prelude qualified as S
import Wallet.Emulator (EmulatorEvent, EmulatorTimeEvent)
import Wallet.Emulator.Error (WalletAPIError)
import Wallet.Emulator.Folds (EmulatorFoldErr (..), Outcome (..), describeError, postMapM)
import Wallet.Emulator.Folds qualified as Folds
import Wallet.Emulator.Stream (EmulatorErr, filterLogLevel, foldEmulatorStreamM, initialChainState, initialDist)

makePrisms ''Ledger.ScriptError
makePrisms ''WalletAPIError

type TestEffects = '[Reader InitialDistribution, Error EmulatorFoldErr, Writer (Doc Void), Writer CoverageData]
newtype TracePredicateF a = TracePredicate (forall effs. Members TestEffects effs => FoldM (Eff effs) EmulatorEvent a)
  deriving (a -> TracePredicateF b -> TracePredicateF a
(a -> b) -> TracePredicateF a -> TracePredicateF b
(forall a b. (a -> b) -> TracePredicateF a -> TracePredicateF b)
-> (forall a b. a -> TracePredicateF b -> TracePredicateF a)
-> Functor TracePredicateF
forall a b. a -> TracePredicateF b -> TracePredicateF a
forall a b. (a -> b) -> TracePredicateF a -> TracePredicateF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TracePredicateF b -> TracePredicateF a
$c<$ :: forall a b. a -> TracePredicateF b -> TracePredicateF a
fmap :: (a -> b) -> TracePredicateF a -> TracePredicateF b
$cfmap :: forall a b. (a -> b) -> TracePredicateF a -> TracePredicateF b
Functor)
instance Applicative TracePredicateF where
  pure :: a -> TracePredicateF a
pure a
a = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent a)
 -> TracePredicateF a)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
forall a b. (a -> b) -> a -> b
$ a -> FoldM (Eff effs) EmulatorEvent a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
  TracePredicate forall (effs :: [* -> *]).
Members TestEffects effs =>
FoldM (Eff effs) EmulatorEvent (a -> b)
f <*> :: TracePredicateF (a -> b) -> TracePredicateF a -> TracePredicateF b
<*> TracePredicate forall (effs :: [* -> *]).
Members TestEffects effs =>
FoldM (Eff effs) EmulatorEvent a
a = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent b)
-> TracePredicateF b
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate (FoldM (Eff effs) EmulatorEvent (a -> b)
forall (effs :: [* -> *]).
Members TestEffects effs =>
FoldM (Eff effs) EmulatorEvent (a -> b)
f FoldM (Eff effs) EmulatorEvent (a -> b)
-> FoldM (Eff effs) EmulatorEvent a
-> FoldM (Eff effs) EmulatorEvent b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FoldM (Eff effs) EmulatorEvent a
forall (effs :: [* -> *]).
Members TestEffects effs =>
FoldM (Eff effs) EmulatorEvent a
a)
type TracePredicate = TracePredicateF Bool

infixl 3 .&&.
infixl 2 .||.

(.&&.) :: TracePredicate -> TracePredicate -> TracePredicate
.&&. :: TracePredicate -> TracePredicate -> TracePredicate
(.&&.) = (Bool -> Bool -> Bool)
-> TracePredicate -> TracePredicate -> TracePredicate
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&)

(.||.) :: TracePredicate -> TracePredicate -> TracePredicate
.||. :: TracePredicate -> TracePredicate -> TracePredicate
(.||.) = (Bool -> Bool -> Bool)
-> TracePredicate -> TracePredicate -> TracePredicate
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||)

not :: TracePredicate -> TracePredicate
not :: TracePredicate -> TracePredicate
not = (Bool -> Bool) -> TracePredicate -> TracePredicate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
Prelude.not

-- | Options for running the
data CheckOptions =
    CheckOptions
        { CheckOptions -> LogLevel
_minLogLevel    :: LogLevel -- ^ Minimum log level for emulator log messages to be included in the test output (printed if the test fails)
        , CheckOptions -> EmulatorConfig
_emulatorConfig :: EmulatorConfig
        }

makeLenses ''CheckOptions

defaultCheckOptions :: CheckOptions
defaultCheckOptions :: CheckOptions
defaultCheckOptions =
    CheckOptions :: LogLevel -> EmulatorConfig -> CheckOptions
CheckOptions
        { _minLogLevel :: LogLevel
_minLogLevel = LogLevel
Info
        , _emulatorConfig :: EmulatorConfig
_emulatorConfig = EmulatorConfig
forall a. Default a => a
def
        }

-- | Modify the value assigned to the given wallet in the initial distribution.
changeInitialWalletValue :: Wallet -> (C.Value -> C.Value) -> CheckOptions -> CheckOptions
changeInitialWalletValue :: Wallet -> (Value -> Value) -> CheckOptions -> CheckOptions
changeInitialWalletValue Wallet
wallet = ASetter CheckOptions CheckOptions Value Value
-> (Value -> Value) -> CheckOptions -> CheckOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((EmulatorConfig -> Identity EmulatorConfig)
-> CheckOptions -> Identity CheckOptions
Lens' CheckOptions EmulatorConfig
emulatorConfig ((EmulatorConfig -> Identity EmulatorConfig)
 -> CheckOptions -> Identity CheckOptions)
-> ((Value -> Identity Value)
    -> EmulatorConfig -> Identity EmulatorConfig)
-> ASetter CheckOptions CheckOptions Value Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InitialChainState -> Identity InitialChainState)
-> EmulatorConfig -> Identity EmulatorConfig
Lens' EmulatorConfig InitialChainState
initialChainState ((InitialChainState -> Identity InitialChainState)
 -> EmulatorConfig -> Identity EmulatorConfig)
-> ((Value -> Identity Value)
    -> InitialChainState -> Identity InitialChainState)
-> (Value -> Identity Value)
-> EmulatorConfig
-> Identity EmulatorConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InitialDistribution -> Identity InitialDistribution)
-> InitialChainState -> Identity InitialChainState
forall a c b. Prism (Either a c) (Either b c) a b
_Left ((InitialDistribution -> Identity InitialDistribution)
 -> InitialChainState -> Identity InitialChainState)
-> ((Value -> Identity Value)
    -> InitialDistribution -> Identity InitialDistribution)
-> (Value -> Identity Value)
-> InitialChainState
-> Identity InitialChainState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index InitialDistribution
-> Traversal' InitialDistribution (IxValue InitialDistribution)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index InitialDistribution
Wallet
wallet)

-- | Set higher limits on transaction size and execution units.
-- This can be used to work around @MaxTxSizeUTxO@ and @ExUnitsTooBigUTxO@ errors.
-- Note that if you need this your Plutus script will probably not validate on Mainnet.
increaseTransactionLimits :: CheckOptions -> CheckOptions
increaseTransactionLimits :: CheckOptions -> CheckOptions
increaseTransactionLimits = ASetter CheckOptions CheckOptions Params Params
-> (Params -> Params) -> CheckOptions -> CheckOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((EmulatorConfig -> Identity EmulatorConfig)
-> CheckOptions -> Identity CheckOptions
Lens' CheckOptions EmulatorConfig
emulatorConfig ((EmulatorConfig -> Identity EmulatorConfig)
 -> CheckOptions -> Identity CheckOptions)
-> ((Params -> Identity Params)
    -> EmulatorConfig -> Identity EmulatorConfig)
-> ASetter CheckOptions CheckOptions Params Params
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Params -> Identity Params)
-> EmulatorConfig -> Identity EmulatorConfig
Lens' EmulatorConfig Params
params) Params -> Params
Params.increaseTransactionLimits

-- | Check if the emulator trace meets the condition
checkPredicate ::
    String -- ^ Descriptive name of the test
    -> TracePredicate -- ^ The predicate to check
    -> EmulatorTrace ()
    -> TestTree
checkPredicate :: String -> TracePredicate -> EmulatorTrace () -> TestTree
checkPredicate = CheckOptions
-> String -> TracePredicate -> EmulatorTrace () -> TestTree
checkPredicateOptions CheckOptions
defaultCheckOptions

checkPredicateCoverage ::
       String -- ^ Descriptive name of the test
    -> CoverageRef
    -> TracePredicate -- ^ The predicate to check
    -> EmulatorTrace ()
    -> TestTree
checkPredicateCoverage :: String
-> CoverageRef -> TracePredicate -> EmulatorTrace () -> TestTree
checkPredicateCoverage String
nm CoverageRef
cr TracePredicate
predicate EmulatorTrace ()
action =
  CheckOptions
-> String
-> CoverageRef
-> TracePredicate
-> EmulatorTrace ()
-> TestTree
checkPredicateCoverageOptions CheckOptions
defaultCheckOptions String
nm CoverageRef
cr TracePredicate
predicate EmulatorTrace ()
action

checkPredicateCoverageOptions ::
    CheckOptions -- ^ Options to use
    -> String -- ^ Descriptive name of the test
    -> CoverageRef
    -> TracePredicate -- ^ The predicate to check
    -> EmulatorTrace ()
    -> TestTree
checkPredicateCoverageOptions :: CheckOptions
-> String
-> CoverageRef
-> TracePredicate
-> EmulatorTrace ()
-> TestTree
checkPredicateCoverageOptions CheckOptions
options String
nm (CoverageRef IORef CoverageData
ioref) TracePredicate
predicate EmulatorTrace ()
action =
  String -> ((String -> IO ()) -> IO ()) -> TestTree
HUnit.testCaseSteps String
nm (((String -> IO ()) -> IO ()) -> TestTree)
-> ((String -> IO ()) -> IO ()) -> TestTree
forall a b. (a -> b) -> a -> b
$ \String -> IO ()
step -> do
        IO (Either EmulatorErr ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either EmulatorErr ()) -> IO ())
-> IO (Either EmulatorErr ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ CheckOptions
-> TracePredicate
-> EmulatorTrace ()
-> (String -> IO ())
-> (Bool -> IO ())
-> (CoverageData -> IO ())
-> IO (Either EmulatorErr ())
forall (m :: * -> *) a.
Monad m =>
CheckOptions
-> TracePredicate
-> EmulatorTrace a
-> (String -> m ())
-> (Bool -> m ())
-> (CoverageData -> m ())
-> m (Either EmulatorErr a)
checkPredicateInner CheckOptions
options TracePredicate
predicate EmulatorTrace ()
action String -> IO ()
step (HasCallStack => String -> Bool -> IO ()
String -> Bool -> IO ()
HUnit.assertBool String
nm) (\ CoverageData
rep -> IORef CoverageData -> (CoverageData -> CoverageData) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef CoverageData
ioref (CoverageData
repCoverageData -> CoverageData -> CoverageData
forall a. Semigroup a => a -> a -> a
<>))

-- | Check if the emulator trace fails with the condition
checkEmulatorFails ::
    String -- ^ Descriptive name of the test
    -> CheckOptions
    -> TracePredicate
    -> EmulatorTrace () -- ^ The trace that should fail
    -> TestTree
checkEmulatorFails :: String
-> CheckOptions -> TracePredicate -> EmulatorTrace () -> TestTree
checkEmulatorFails String
nm CheckOptions
options TracePredicate
predicate EmulatorTrace ()
action = do
    String -> ((String -> IO ()) -> IO ()) -> TestTree
HUnit.testCaseSteps String
nm (((String -> IO ()) -> IO ()) -> TestTree)
-> ((String -> IO ()) -> IO ()) -> TestTree
forall a b. (a -> b) -> a -> b
$ \String -> IO ()
step -> do
        IO (Either EmulatorErr ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either EmulatorErr ()) -> IO ())
-> IO (Either EmulatorErr ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ CheckOptions
-> TracePredicate
-> EmulatorTrace ()
-> (String -> IO ())
-> (Bool -> IO ())
-> (CoverageData -> IO ())
-> IO (Either EmulatorErr ())
forall (m :: * -> *) a.
Monad m =>
CheckOptions
-> TracePredicate
-> EmulatorTrace a
-> (String -> m ())
-> (Bool -> m ())
-> (CoverageData -> m ())
-> m (Either EmulatorErr a)
checkPredicateInner CheckOptions
options TracePredicate
predicate EmulatorTrace ()
action String -> IO ()
step (HasCallStack => String -> Bool -> IO ()
String -> Bool -> IO ()
HUnit.assertBool String
nm (Bool -> IO ()) -> (Bool -> Bool) -> Bool -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
Prelude.not) (IO () -> CoverageData -> IO ()
forall a b. a -> b -> a
const (IO () -> CoverageData -> IO ()) -> IO () -> CoverageData -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Check if the emulator trace meets the condition, using the
--   'GeneratorModel' to generate initial transactions for the blockchain
checkPredicateGen ::
    GeneratorModel
    -> TracePredicate
    -> EmulatorTrace ()
    -> Property
checkPredicateGen :: GeneratorModel -> TracePredicate -> EmulatorTrace () -> Property
checkPredicateGen = CheckOptions
-> GeneratorModel -> TracePredicate -> EmulatorTrace () -> Property
checkPredicateGenOptions CheckOptions
defaultCheckOptions

-- | Evaluate a trace predicate on an emulator trace, printing out debug information
--   and making assertions as we go.
checkPredicateInner :: forall m a.
    Monad m
    => CheckOptions
    -> TracePredicate
    -> EmulatorTrace a
    -> (String -> m ()) -- ^ Print out debug information in case of test failures
    -- TODO: can we generalize Bool here? We need it to get extractPropertyResult
    -- to work
    -> (Bool -> m ()) -- ^ assert
    -> (CoverageData -> m ())
    -> m (Either EmulatorErr a)
checkPredicateInner :: CheckOptions
-> TracePredicate
-> EmulatorTrace a
-> (String -> m ())
-> (Bool -> m ())
-> (CoverageData -> m ())
-> m (Either EmulatorErr a)
checkPredicateInner opts :: CheckOptions
opts@CheckOptions{EmulatorConfig
_emulatorConfig :: EmulatorConfig
_emulatorConfig :: CheckOptions -> EmulatorConfig
_emulatorConfig} TracePredicate
predicate EmulatorTrace a
action =
    CheckOptions
-> TracePredicate
-> (forall (effs :: [* -> *]).
    Stream
      (Of (LogMessage EmulatorEvent)) (Eff effs) (Either EmulatorErr a))
-> (String -> m ())
-> (Bool -> m ())
-> (CoverageData -> m ())
-> m (Either EmulatorErr a)
forall (m :: * -> *) a.
Monad m =>
CheckOptions
-> TracePredicate
-> (forall (effs :: [* -> *]).
    Stream
      (Of (LogMessage EmulatorEvent)) (Eff effs) (Either EmulatorErr a))
-> (String -> m ())
-> (Bool -> m ())
-> (CoverageData -> m ())
-> m (Either EmulatorErr a)
checkPredicateInnerStream CheckOptions
opts TracePredicate
predicate ((forall (effs :: [* -> *]).
  Stream
    (Of (LogMessage EmulatorEvent)) (Eff effs) (Either EmulatorErr a))
 -> (String -> m ())
 -> (Bool -> m ())
 -> (CoverageData -> m ())
 -> m (Either EmulatorErr a))
-> (forall (effs :: [* -> *]).
    Stream
      (Of (LogMessage EmulatorEvent)) (Eff effs) (Either EmulatorErr a))
-> (String -> m ())
-> (Bool -> m ())
-> (CoverageData -> m ())
-> m (Either EmulatorErr a)
forall a b. (a -> b) -> a -> b
$ ((Either EmulatorErr a, EmulatorState) -> Either EmulatorErr a)
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff effs)
     (Either EmulatorErr a, EmulatorState)
-> Stream
     (Of (LogMessage EmulatorEvent)) (Eff effs) (Either EmulatorErr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either EmulatorErr a, EmulatorState) -> Either EmulatorErr a
forall a b. (a, b) -> a
fst (EmulatorConfig
-> EmulatorTrace a
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff effs)
     (Either EmulatorErr a, EmulatorState)
forall (effs :: [* -> *]) a.
EmulatorConfig
-> EmulatorTrace a
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff effs)
     (Either EmulatorErr a, EmulatorState)
runEmulatorStream EmulatorConfig
_emulatorConfig EmulatorTrace a
action)

checkPredicateInnerStream :: forall m a.
    Monad m
    => CheckOptions
    -> TracePredicate
    -> (forall effs. S.Stream (S.Of (LogMessage EmulatorEvent)) (Eff effs) (Either EmulatorErr a))
    -> (String -> m ()) -- ^ Print out debug information in case of test failures
    -> (Bool -> m ()) -- ^ assert
    -> (CoverageData -> m ())
    -> m (Either EmulatorErr a)
checkPredicateInnerStream :: CheckOptions
-> TracePredicate
-> (forall (effs :: [* -> *]).
    Stream
      (Of (LogMessage EmulatorEvent)) (Eff effs) (Either EmulatorErr a))
-> (String -> m ())
-> (Bool -> m ())
-> (CoverageData -> m ())
-> m (Either EmulatorErr a)
checkPredicateInnerStream CheckOptions{LogLevel
_minLogLevel :: LogLevel
_minLogLevel :: CheckOptions -> LogLevel
_minLogLevel, EmulatorConfig
_emulatorConfig :: EmulatorConfig
_emulatorConfig :: CheckOptions -> EmulatorConfig
_emulatorConfig}
                          (TracePredicate forall (effs :: [* -> *]).
Members TestEffects effs =>
FoldM (Eff effs) EmulatorEvent Bool
predicate) forall (effs :: [* -> *]).
Stream
  (Of (LogMessage EmulatorEvent)) (Eff effs) (Either EmulatorErr a)
theStream String -> m ()
annot Bool -> m ()
assert CoverageData -> m ()
cover = do
    let dist :: InitialDistribution
dist = EmulatorConfig -> InitialDistribution
initialDist EmulatorConfig
_emulatorConfig
        consumedStream :: Eff (TestEffects :++: '[m]) (S.Of Bool (Either EmulatorErr a))
        consumedStream :: Eff (TestEffects :++: '[m]) (Of Bool (Either EmulatorErr a))
consumedStream = FoldM
  (Eff
     '[Reader InitialDistribution, Error EmulatorFoldErr,
       Writer (Doc Void), Writer CoverageData, m])
  EmulatorEvent
  Bool
-> Stream
     (Of (LogMessage EmulatorEvent))
     (Eff
        '[Reader InitialDistribution, Error EmulatorFoldErr,
          Writer (Doc Void), Writer CoverageData, m])
     (Either EmulatorErr a)
-> Eff
     '[Reader InitialDistribution, Error EmulatorFoldErr,
       Writer (Doc Void), Writer CoverageData, m]
     (Of Bool (Either EmulatorErr a))
forall (effs :: [* -> *]) a b.
FoldM (Eff effs) EmulatorEvent b
-> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) a
-> Eff effs (Of b a)
foldEmulatorStreamM ((Bool -> Bool -> Bool)
-> FoldM
     (Eff
        '[Reader InitialDistribution, Error EmulatorFoldErr,
          Writer (Doc Void), Writer CoverageData, m])
     EmulatorEvent
     Bool
-> FoldM
     (Eff
        '[Reader InitialDistribution, Error EmulatorFoldErr,
          Writer (Doc Void), Writer CoverageData, m])
     EmulatorEvent
     Bool
-> FoldM
     (Eff
        '[Reader InitialDistribution, Error EmulatorFoldErr,
          Writer (Doc Void), Writer CoverageData, m])
     EmulatorEvent
     Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) FoldM
  (Eff
     '[Reader InitialDistribution, Error EmulatorFoldErr,
       Writer (Doc Void), Writer CoverageData, m])
  EmulatorEvent
  Bool
forall (effs :: [* -> *]).
Members TestEffects effs =>
FoldM (Eff effs) EmulatorEvent Bool
predicate FoldM
  (Eff
     '[Reader InitialDistribution, Error EmulatorFoldErr,
       Writer (Doc Void), Writer CoverageData, m])
  EmulatorEvent
  Bool
generateCoverage) Stream
  (Of (LogMessage EmulatorEvent))
  (Eff
     '[Reader InitialDistribution, Error EmulatorFoldErr,
       Writer (Doc Void), Writer CoverageData, m])
  (Either EmulatorErr a)
forall (effs :: [* -> *]).
Stream
  (Of (LogMessage EmulatorEvent)) (Eff effs) (Either EmulatorErr a)
theStream

        generateCoverage :: FoldM
  (Eff
     '[Reader InitialDistribution, Error EmulatorFoldErr,
       Writer (Doc Void), Writer CoverageData, m])
  EmulatorEvent
  Bool
generateCoverage = (([EmulatorEvent]
  -> Eff
       '[Reader InitialDistribution, Error EmulatorFoldErr,
         Writer (Doc Void), Writer CoverageData, m]
       Bool)
 -> FoldM
      (Eff
         '[Reader InitialDistribution, Error EmulatorFoldErr,
           Writer (Doc Void), Writer CoverageData, m])
      EmulatorEvent
      [EmulatorEvent]
 -> FoldM
      (Eff
         '[Reader InitialDistribution, Error EmulatorFoldErr,
           Writer (Doc Void), Writer CoverageData, m])
      EmulatorEvent
      Bool)
-> FoldM
     (Eff
        '[Reader InitialDistribution, Error EmulatorFoldErr,
          Writer (Doc Void), Writer CoverageData, m])
     EmulatorEvent
     [EmulatorEvent]
-> ([EmulatorEvent]
    -> Eff
         '[Reader InitialDistribution, Error EmulatorFoldErr,
           Writer (Doc Void), Writer CoverageData, m]
         Bool)
-> FoldM
     (Eff
        '[Reader InitialDistribution, Error EmulatorFoldErr,
          Writer (Doc Void), Writer CoverageData, m])
     EmulatorEvent
     Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([EmulatorEvent]
 -> Eff
      '[Reader InitialDistribution, Error EmulatorFoldErr,
        Writer (Doc Void), Writer CoverageData, m]
      Bool)
-> FoldM
     (Eff
        '[Reader InitialDistribution, Error EmulatorFoldErr,
          Writer (Doc Void), Writer CoverageData, m])
     EmulatorEvent
     [EmulatorEvent]
-> FoldM
     (Eff
        '[Reader InitialDistribution, Error EmulatorFoldErr,
          Writer (Doc Void), Writer CoverageData, m])
     EmulatorEvent
     Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Fold EmulatorEvent [EmulatorEvent]
-> FoldM
     (Eff
        '[Reader InitialDistribution, Error EmulatorFoldErr,
          Writer (Doc Void), Writer CoverageData, m])
     EmulatorEvent
     [EmulatorEvent]
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize Fold EmulatorEvent [EmulatorEvent]
Folds.emulatorLog)
                         (([EmulatorEvent]
  -> Eff
       '[Reader InitialDistribution, Error EmulatorFoldErr,
         Writer (Doc Void), Writer CoverageData, m]
       Bool)
 -> FoldM
      (Eff
         '[Reader InitialDistribution, Error EmulatorFoldErr,
           Writer (Doc Void), Writer CoverageData, m])
      EmulatorEvent
      Bool)
-> ([EmulatorEvent]
    -> Eff
         '[Reader InitialDistribution, Error EmulatorFoldErr,
           Writer (Doc Void), Writer CoverageData, m]
         Bool)
-> FoldM
     (Eff
        '[Reader InitialDistribution, Error EmulatorFoldErr,
          Writer (Doc Void), Writer CoverageData, m])
     EmulatorEvent
     Bool
forall a b. (a -> b) -> a -> b
$ (Bool
True Bool
-> Eff
     '[Reader InitialDistribution, Error EmulatorFoldErr,
       Writer (Doc Void), Writer CoverageData, m]
     ()
-> Eff
     '[Reader InitialDistribution, Error EmulatorFoldErr,
       Writer (Doc Void), Writer CoverageData, m]
     Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (Eff
   '[Reader InitialDistribution, Error EmulatorFoldErr,
     Writer (Doc Void), Writer CoverageData, m]
   ()
 -> Eff
      '[Reader InitialDistribution, Error EmulatorFoldErr,
        Writer (Doc Void), Writer CoverageData, m]
      Bool)
-> ([EmulatorEvent]
    -> Eff
         '[Reader InitialDistribution, Error EmulatorFoldErr,
           Writer (Doc Void), Writer CoverageData, m]
         ())
-> [EmulatorEvent]
-> Eff
     '[Reader InitialDistribution, Error EmulatorFoldErr,
       Writer (Doc Void), Writer CoverageData, m]
     Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (effs :: [* -> *]).
Member (Writer CoverageData) effs =>
CoverageData -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @CoverageData (CoverageData
 -> Eff
      '[Reader InitialDistribution, Error EmulatorFoldErr,
        Writer (Doc Void), Writer CoverageData, m]
      ())
-> ([EmulatorEvent] -> CoverageData)
-> [EmulatorEvent]
-> Eff
     '[Reader InitialDistribution, Error EmulatorFoldErr,
       Writer (Doc Void), Writer CoverageData, m]
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EmulatorEvent] -> CoverageData
getCoverageData

        annotate :: Doc Void -> m ()
        annotate :: Doc Void -> m ()
annotate = String -> m ()
annot (String -> m ()) -> (Doc Void -> String) -> Doc Void -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> String) -> (Doc Void -> Text) -> Doc Void -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream Void -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict (SimpleDocStream Void -> Text)
-> (Doc Void -> SimpleDocStream Void) -> Doc Void -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Void -> SimpleDocStream Void
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions

    Either EmulatorFoldErr (Of Bool (Either EmulatorErr a))
result <- Eff '[m] (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a)))
-> m (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a)))
forall (m :: * -> *) a. Monad m => Eff '[m] a -> m a
runM
            (Eff '[m] (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a)))
 -> m (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a))))
-> (Eff
      '[Reader InitialDistribution, Error EmulatorFoldErr,
        Writer (Doc Void), Writer CoverageData, m]
      (Of Bool (Either EmulatorErr a))
    -> Eff
         '[m] (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a))))
-> Eff
     '[Reader InitialDistribution, Error EmulatorFoldErr,
       Writer (Doc Void), Writer CoverageData, m]
     (Of Bool (Either EmulatorErr a))
-> m (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Writer CoverageData ~> m)
-> Eff '[Writer CoverageData, m] ~> Eff '[m]
forall (eff :: * -> *) (m :: * -> *) (effs :: [* -> *]).
(Monad m, LastMember m effs) =>
(eff ~> m) -> Eff (eff : effs) ~> Eff effs
interpretM @(Writer CoverageData) @m (\case { Tell CoverageData
r -> CoverageData -> m ()
cover CoverageData
r })
            (Eff
   '[Writer CoverageData, m]
   (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a)))
 -> Eff
      '[m] (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a))))
-> (Eff
      '[Reader InitialDistribution, Error EmulatorFoldErr,
        Writer (Doc Void), Writer CoverageData, m]
      (Of Bool (Either EmulatorErr a))
    -> Eff
         '[Writer CoverageData, m]
         (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a))))
-> Eff
     '[Reader InitialDistribution, Error EmulatorFoldErr,
       Writer (Doc Void), Writer CoverageData, m]
     (Of Bool (Either EmulatorErr a))
-> Eff
     '[m] (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Writer (Doc Void) ~> m)
-> Eff '[Writer (Doc Void), Writer CoverageData, m]
   ~> Eff '[Writer CoverageData, m]
forall (eff :: * -> *) (m :: * -> *) (effs :: [* -> *]).
(Monad m, LastMember m effs) =>
(eff ~> m) -> Eff (eff : effs) ~> Eff effs
interpretM @(Writer (Doc Void)) @m (\case { Tell Doc Void
d -> Doc Void -> m ()
annotate Doc Void
d })
            (Eff
   '[Writer (Doc Void), Writer CoverageData, m]
   (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a)))
 -> Eff
      '[Writer CoverageData, m]
      (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a))))
-> (Eff
      '[Reader InitialDistribution, Error EmulatorFoldErr,
        Writer (Doc Void), Writer CoverageData, m]
      (Of Bool (Either EmulatorErr a))
    -> Eff
         '[Writer (Doc Void), Writer CoverageData, m]
         (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a))))
-> Eff
     '[Reader InitialDistribution, Error EmulatorFoldErr,
       Writer (Doc Void), Writer CoverageData, m]
     (Of Bool (Either EmulatorErr a))
-> Eff
     '[Writer CoverageData, m]
     (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff
  '[Error EmulatorFoldErr, Writer (Doc Void), Writer CoverageData, m]
  (Of Bool (Either EmulatorErr a))
-> Eff
     '[Writer (Doc Void), Writer CoverageData, m]
     (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a)))
forall e (effs :: [* -> *]) a.
Eff (Error e : effs) a -> Eff effs (Either e a)
runError
            (Eff
   '[Error EmulatorFoldErr, Writer (Doc Void), Writer CoverageData, m]
   (Of Bool (Either EmulatorErr a))
 -> Eff
      '[Writer (Doc Void), Writer CoverageData, m]
      (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a))))
-> (Eff
      '[Reader InitialDistribution, Error EmulatorFoldErr,
        Writer (Doc Void), Writer CoverageData, m]
      (Of Bool (Either EmulatorErr a))
    -> Eff
         '[Error EmulatorFoldErr, Writer (Doc Void), Writer CoverageData, m]
         (Of Bool (Either EmulatorErr a)))
-> Eff
     '[Reader InitialDistribution, Error EmulatorFoldErr,
       Writer (Doc Void), Writer CoverageData, m]
     (Of Bool (Either EmulatorErr a))
-> Eff
     '[Writer (Doc Void), Writer CoverageData, m]
     (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InitialDistribution
-> Eff
     '[Reader InitialDistribution, Error EmulatorFoldErr,
       Writer (Doc Void), Writer CoverageData, m]
     (Of Bool (Either EmulatorErr a))
-> Eff
     '[Error EmulatorFoldErr, Writer (Doc Void), Writer CoverageData, m]
     (Of Bool (Either EmulatorErr a))
forall r (effs :: [* -> *]) a.
r -> Eff (Reader r : effs) a -> Eff effs a
runReader InitialDistribution
dist
            (Eff
   '[Reader InitialDistribution, Error EmulatorFoldErr,
     Writer (Doc Void), Writer CoverageData, m]
   (Of Bool (Either EmulatorErr a))
 -> m (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a))))
-> Eff
     '[Reader InitialDistribution, Error EmulatorFoldErr,
       Writer (Doc Void), Writer CoverageData, m]
     (Of Bool (Either EmulatorErr a))
-> m (Either EmulatorFoldErr (Of Bool (Either EmulatorErr a)))
forall a b. (a -> b) -> a -> b
$ Eff
  '[Reader InitialDistribution, Error EmulatorFoldErr,
    Writer (Doc Void), Writer CoverageData, m]
  (Of Bool (Either EmulatorErr a))
Eff (TestEffects :++: '[m]) (Of Bool (Either EmulatorErr a))
consumedStream

    let logEmulator :: m (Either EmulatorErr a)
logEmulator = do
          String -> m ()
annot String
"Emulator log:"
          (String -> m ())
-> Stream (Of String) m (Either EmulatorErr a)
-> m (Either EmulatorErr a)
forall (m :: * -> *) a x r.
Monad m =>
(a -> m x) -> Stream (Of a) m r -> m r
S.mapM_ String -> m ()
annot
              (Stream (Of String) m (Either EmulatorErr a)
 -> m (Either EmulatorErr a))
-> Stream (Of String) m (Either EmulatorErr a)
-> m (Either EmulatorErr a)
forall a b. (a -> b) -> a -> b
$ (forall a. Eff '[m] a -> m a)
-> Stream (Of String) (Eff '[m]) (Either EmulatorErr a)
-> Stream (Of String) m (Either EmulatorErr a)
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
S.hoist forall a. Eff '[m] a -> m a
forall (m :: * -> *) a. Monad m => Eff '[m] a -> m a
runM
              (Stream (Of String) (Eff '[m]) (Either EmulatorErr a)
 -> Stream (Of String) m (Either EmulatorErr a))
-> Stream (Of String) (Eff '[m]) (Either EmulatorErr a)
-> Stream (Of String) m (Either EmulatorErr a)
forall a b. (a -> b) -> a -> b
$ (LogMessage EmulatorEvent -> String)
-> Stream
     (Of (LogMessage EmulatorEvent)) (Eff '[m]) (Either EmulatorErr a)
-> Stream (Of String) (Eff '[m]) (Either EmulatorErr a)
forall (m :: * -> *) a b r.
Monad m =>
(a -> b) -> Stream (Of a) m r -> Stream (Of b) m r
S.map (Text -> String
Text.unpack (Text -> String)
-> (LogMessage EmulatorEvent -> Text)
-> LogMessage EmulatorEvent
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream Any -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict (SimpleDocStream Any -> Text)
-> (LogMessage EmulatorEvent -> SimpleDocStream Any)
-> LogMessage EmulatorEvent
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions (Doc Any -> SimpleDocStream Any)
-> (LogMessage EmulatorEvent -> Doc Any)
-> LogMessage EmulatorEvent
-> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogMessage EmulatorEvent -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty)
              (Stream
   (Of (LogMessage EmulatorEvent)) (Eff '[m]) (Either EmulatorErr a)
 -> Stream (Of String) (Eff '[m]) (Either EmulatorErr a))
-> Stream
     (Of (LogMessage EmulatorEvent)) (Eff '[m]) (Either EmulatorErr a)
-> Stream (Of String) (Eff '[m]) (Either EmulatorErr a)
forall a b. (a -> b) -> a -> b
$ LogLevel
-> Stream
     (Of (LogMessage EmulatorEvent)) (Eff '[m]) (Either EmulatorErr a)
-> Stream
     (Of (LogMessage EmulatorEvent)) (Eff '[m]) (Either EmulatorErr a)
forall (effs :: [* -> *]) a.
LogLevel
-> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) a
-> Stream (Of (LogMessage EmulatorEvent)) (Eff effs) a
filterLogLevel LogLevel
_minLogLevel
              Stream
  (Of (LogMessage EmulatorEvent)) (Eff '[m]) (Either EmulatorErr a)
forall (effs :: [* -> *]).
Stream
  (Of (LogMessage EmulatorEvent)) (Eff effs) (Either EmulatorErr a)
theStream

    case Either EmulatorFoldErr (Of Bool (Either EmulatorErr a))
result of
      Right (Bool
True  S.:> Either EmulatorErr a
res) -> do
        -- Also log on success. The test runner suppresses the output on success so this has no effect on succesful tests.
        -- But this makes `checkPredicateInnerStream` more modular: When another test function calls it,
        -- and that function has a failure, the logs will be shown.
        m (Either EmulatorErr a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m (Either EmulatorErr a)
logEmulator
        Either EmulatorErr a -> m (Either EmulatorErr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Either EmulatorErr a
res
      Right (Bool
False S.:> Either EmulatorErr a
res) -> do
        String -> m ()
annot String
"Test failed."
        m (Either EmulatorErr a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m (Either EmulatorErr a)
logEmulator
        Bool -> m ()
assert Bool
False
        Either EmulatorErr a -> m (Either EmulatorErr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Either EmulatorErr a
res
      Left EmulatorFoldErr
err -> do
        String -> m ()
annot String
"Test failed."
        m (Either EmulatorErr a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m (Either EmulatorErr a)
logEmulator
        String -> m ()
annot String
"Error:"
        String -> m ()
annot (EmulatorFoldErr -> String
describeError EmulatorFoldErr
err)
        String -> m ()
annot (EmulatorFoldErr -> String
forall a. Show a => a -> String
show EmulatorFoldErr
err)
        String -> m (Either EmulatorErr a)
forall a. HasCallStack => String -> a
error (String -> m (Either EmulatorErr a))
-> String -> m (Either EmulatorErr a)
forall a b. (a -> b) -> a -> b
$ String
"Unexpected: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ EmulatorFoldErr -> String
forall a. Show a => a -> String
show EmulatorFoldErr
err

-- | A version of 'checkPredicateGen' with configurable 'CheckOptions'.
--
--   Note that the 'InitialChainState' in the 'EmulatorConfig' of the
--   'CheckOptions' will be replaced with the 'mockchainInitialTxPool' generated
--   by the model.
checkPredicateGenOptions ::
    CheckOptions
    -> GeneratorModel
    -> TracePredicate
    -> EmulatorTrace ()
    -> Property
checkPredicateGenOptions :: CheckOptions
-> GeneratorModel -> TracePredicate -> EmulatorTrace () -> Property
checkPredicateGenOptions CheckOptions
options GeneratorModel
gm TracePredicate
predicate EmulatorTrace ()
action = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
    Mockchain{[CardanoTx]
mockchainInitialTxPool :: Mockchain -> [CardanoTx]
mockchainInitialTxPool :: [CardanoTx]
mockchainInitialTxPool} <- Gen Mockchain -> PropertyT IO Mockchain
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (GeneratorModel -> Gen Mockchain
Gen.genMockchain' GeneratorModel
gm)
    let options' :: CheckOptions
options' = CheckOptions
options CheckOptions -> (CheckOptions -> CheckOptions) -> CheckOptions
forall a b. a -> (a -> b) -> b
& (EmulatorConfig -> Identity EmulatorConfig)
-> CheckOptions -> Identity CheckOptions
Lens' CheckOptions EmulatorConfig
emulatorConfig ((EmulatorConfig -> Identity EmulatorConfig)
 -> CheckOptions -> Identity CheckOptions)
-> ((InitialChainState -> Identity InitialChainState)
    -> EmulatorConfig -> Identity EmulatorConfig)
-> (InitialChainState -> Identity InitialChainState)
-> CheckOptions
-> Identity CheckOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InitialChainState -> Identity InitialChainState)
-> EmulatorConfig -> Identity EmulatorConfig
Lens' EmulatorConfig InitialChainState
initialChainState ((InitialChainState -> Identity InitialChainState)
 -> CheckOptions -> Identity CheckOptions)
-> InitialChainState -> CheckOptions -> CheckOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [CardanoTx] -> InitialChainState
forall a b. b -> Either a b
Right [CardanoTx]
mockchainInitialTxPool
    PropertyT IO (Either EmulatorErr ()) -> PropertyT IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (PropertyT IO (Either EmulatorErr ()) -> PropertyT IO ())
-> PropertyT IO (Either EmulatorErr ()) -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ CheckOptions
-> TracePredicate
-> EmulatorTrace ()
-> (String -> PropertyT IO ())
-> (Bool -> PropertyT IO ())
-> (CoverageData -> PropertyT IO ())
-> PropertyT IO (Either EmulatorErr ())
forall (m :: * -> *) a.
Monad m =>
CheckOptions
-> TracePredicate
-> EmulatorTrace a
-> (String -> m ())
-> (Bool -> m ())
-> (CoverageData -> m ())
-> m (Either EmulatorErr a)
checkPredicateInner CheckOptions
options' TracePredicate
predicate EmulatorTrace ()
action String -> PropertyT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => String -> m ()
Hedgehog.annotate Bool -> PropertyT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
Hedgehog.assert (PropertyT IO () -> CoverageData -> PropertyT IO ()
forall a b. a -> b -> a
const (PropertyT IO () -> CoverageData -> PropertyT IO ())
-> PropertyT IO () -> CoverageData -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ () -> PropertyT IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | A version of 'checkPredicate' with configurable 'CheckOptions'
checkPredicateOptions ::
    CheckOptions -- ^ Options to use
    -> String -- ^ Descriptive name of the test
    -> TracePredicate -- ^ The predicate to check
    -> EmulatorTrace ()
    -> TestTree
checkPredicateOptions :: CheckOptions
-> String -> TracePredicate -> EmulatorTrace () -> TestTree
checkPredicateOptions CheckOptions
options String
nm TracePredicate
predicate EmulatorTrace ()
action = do
    String -> ((String -> IO ()) -> IO ()) -> TestTree
HUnit.testCaseSteps String
nm (((String -> IO ()) -> IO ()) -> TestTree)
-> ((String -> IO ()) -> IO ()) -> TestTree
forall a b. (a -> b) -> a -> b
$ \String -> IO ()
step -> do
        IO (Either EmulatorErr ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either EmulatorErr ()) -> IO ())
-> IO (Either EmulatorErr ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ CheckOptions
-> TracePredicate
-> EmulatorTrace ()
-> (String -> IO ())
-> (Bool -> IO ())
-> (CoverageData -> IO ())
-> IO (Either EmulatorErr ())
forall (m :: * -> *) a.
Monad m =>
CheckOptions
-> TracePredicate
-> EmulatorTrace a
-> (String -> m ())
-> (Bool -> m ())
-> (CoverageData -> m ())
-> m (Either EmulatorErr a)
checkPredicateInner CheckOptions
options TracePredicate
predicate EmulatorTrace ()
action String -> IO ()
step (HasCallStack => String -> Bool -> IO ()
String -> Bool -> IO ()
HUnit.assertBool String
nm) (IO () -> CoverageData -> IO ()
forall a b. a -> b -> a
const (IO () -> CoverageData -> IO ()) -> IO () -> CoverageData -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

endpointAvailable
    :: forall (l :: Symbol) w s e a.
       ( KnownSymbol l
       , Monoid w
       )
    => Contract w s e a
    -> ContractInstanceTag
    -> TracePredicate
endpointAvailable :: Contract w s e a -> ContractInstanceTag -> TracePredicate
endpointAvailable Contract w s e a
contract ContractInstanceTag
inst = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$
    let desc :: EndpointDescription
desc = Proxy l -> EndpointDescription
forall (l :: Symbol).
KnownSymbol l =>
Proxy l -> EndpointDescription
Request.endpointDescription (Proxy l
forall k (t :: k). Proxy t
Proxy @l) in
    (([Request PABReq] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent [Request PABReq]
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM (Eff effs) EmulatorEvent [Request PABReq]
-> ([Request PABReq] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Request PABReq] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent [Request PABReq]
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Contract w s e a
-> ContractInstanceTag
-> FoldM (Eff effs) EmulatorEvent [Request PABReq]
forall w (s :: Row *) e a (effs :: [* -> *]).
(Member (Error EmulatorFoldErr) effs, Monoid w) =>
Contract w s e a
-> ContractInstanceTag -> EmulatorEventFoldM effs [Request PABReq]
Folds.instanceRequests Contract w s e a
contract ContractInstanceTag
inst) (([Request PABReq] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> ([Request PABReq] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \[Request PABReq]
rqs -> do
        let hks :: [Request ActiveEndpoint]
            hks :: [Request ActiveEndpoint]
hks = (Request PABReq -> Maybe (Request ActiveEndpoint))
-> [Request PABReq] -> [Request ActiveEndpoint]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((PABReq -> Maybe ActiveEndpoint)
-> Request PABReq -> Maybe (Request ActiveEndpoint)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Getting (First ActiveEndpoint) PABReq ActiveEndpoint
-> PABReq -> Maybe ActiveEndpoint
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ActiveEndpoint) PABReq ActiveEndpoint
Prism' PABReq ActiveEndpoint
Requests._ExposeEndpointReq)) [Request PABReq]
rqs
        if (ActiveEndpoint -> Bool) -> [ActiveEndpoint] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ActiveEndpoint{EndpointDescription
aeDescription :: ActiveEndpoint -> EndpointDescription
aeDescription :: EndpointDescription
aeDescription} -> EndpointDescription
aeDescription EndpointDescription -> EndpointDescription -> Bool
forall a. Eq a => a -> a -> Bool
== EndpointDescription
desc) (Request ActiveEndpoint -> ActiveEndpoint
forall o. Request o -> o
rqRequest (Request ActiveEndpoint -> ActiveEndpoint)
-> [Request ActiveEndpoint] -> [ActiveEndpoint]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Request ActiveEndpoint]
hks)
            then Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            else do
                Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void
"missing endpoint:" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc Void
forall a. IsString a => String -> a
fromString (Proxy l -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy l
forall k (t :: k). Proxy t
Proxy :: Proxy l)))
                Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

assertUnbalancedTx
    :: forall w s e a.
       ( Monoid w
       )
    => Contract w s e a
    -> ContractInstanceTag
    -> (UnbalancedTx -> Bool)
    -> String
    -> TracePredicate
assertUnbalancedTx :: Contract w s e a
-> ContractInstanceTag
-> (UnbalancedTx -> Bool)
-> String
-> TracePredicate
assertUnbalancedTx Contract w s e a
contract ContractInstanceTag
inst UnbalancedTx -> Bool
flt String
nm = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$
    (([UnbalancedTx] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent [UnbalancedTx]
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM (Eff effs) EmulatorEvent [UnbalancedTx]
-> ([UnbalancedTx] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([UnbalancedTx] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent [UnbalancedTx]
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Contract w s e a
-> ContractInstanceTag
-> FoldM (Eff effs) EmulatorEvent [UnbalancedTx]
forall w (s :: Row *) e a (effs :: [* -> *]).
(Member (Error EmulatorFoldErr) effs, Monoid w) =>
Contract w s e a
-> ContractInstanceTag -> EmulatorEventFoldM effs [UnbalancedTx]
Folds.instanceTransactions Contract w s e a
contract ContractInstanceTag
inst) (([UnbalancedTx] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> ([UnbalancedTx] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \[UnbalancedTx]
unbalancedTxns -> do
        if (UnbalancedTx -> Bool) -> [UnbalancedTx] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any UnbalancedTx -> Bool
flt [UnbalancedTx]
unbalancedTxns
        then Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        else do
            forall (effs :: [* -> *]).
Member (Writer (Doc Void)) effs =>
Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void -> Eff effs ()) -> Doc Void -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ [Doc Void] -> Doc Void
forall ann. [Doc ann] -> Doc ann
hsep
                [ Doc Void
"Unbalanced transactions of" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ContractInstanceTag -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceTag
inst Doc Void -> Doc Void -> Doc Void
forall a. Semigroup a => a -> a -> a
<> Doc Void
forall ann. Doc ann
colon
                    Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc Void -> Doc Void
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ([Doc Void] -> Doc Void
forall ann. [Doc ann] -> Doc ann
vsep ((UnbalancedTx -> Doc Void) -> [UnbalancedTx] -> [Doc Void]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnbalancedTx -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty [UnbalancedTx]
unbalancedTxns))
                , Doc Void
"No transaction with '" Doc Void -> Doc Void -> Doc Void
forall a. Semigroup a => a -> a -> a
<> String -> Doc Void
forall a. IsString a => String -> a
fromString String
nm Doc Void -> Doc Void -> Doc Void
forall a. Semigroup a => a -> a -> a
<> Doc Void
"'"]
            Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

assertEvents
    :: forall w s e a.
       ( Monoid w
       )
    => Contract w s e a
    -> ContractInstanceTag
    -> ([PABResp] -> Bool)
    -> String
    -> TracePredicate
assertEvents :: Contract w s e a
-> ContractInstanceTag
-> ([PABResp] -> Bool)
-> String
-> TracePredicate
assertEvents Contract w s e a
contract ContractInstanceTag
inst [PABResp] -> Bool
pr String
nm = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$
    (([Response PABResp] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent [Response PABResp]
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM (Eff effs) EmulatorEvent [Response PABResp]
-> ([Response PABResp] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Response PABResp] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent [Response PABResp]
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Contract w s e a
-> ContractInstanceTag
-> FoldM (Eff effs) EmulatorEvent [Response PABResp]
forall w (s :: Row *) e a (effs :: [* -> *]).
(Member (Error EmulatorFoldErr) effs, Monoid w) =>
Contract w s e a
-> ContractInstanceTag
-> EmulatorEventFoldM effs [Response PABResp]
Folds.instanceResponses Contract w s e a
contract ContractInstanceTag
inst) (([Response PABResp] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> ([Response PABResp] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \[Response PABResp]
rqs -> do
        let responses :: [PABResp]
responses = (Response PABResp -> PABResp) -> [Response PABResp] -> [PABResp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Response PABResp -> PABResp
forall i. Response i -> i
State.rspResponse [Response PABResp]
rqs
            result :: Bool
result = [PABResp] -> Bool
pr [PABResp]
responses
        Bool -> Eff effs () -> Eff effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
result (Eff effs () -> Eff effs ()) -> Eff effs () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ do
            forall (effs :: [* -> *]).
Member (Writer (Doc Void)) effs =>
Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void -> Eff effs ()) -> Doc Void -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ [Doc Void] -> Doc Void
forall ann. [Doc ann] -> Doc ann
vsep
                [ Doc Void
"Event log for" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ContractInstanceTag -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceTag
inst Doc Void -> Doc Void -> Doc Void
forall a. Semigroup a => a -> a -> a
<> Doc Void
":"
                , Int -> Doc Void -> Doc Void
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ([Doc Void] -> Doc Void
forall ann. [Doc ann] -> Doc ann
vsep ((PABResp -> Doc Void) -> [PABResp] -> [Doc Void]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PABResp -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty [PABResp]
responses))
                , Doc Void
"Fails" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann
squotes (String -> Doc Void
forall a. IsString a => String -> a
fromString String
nm)
                ]
        Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
result

-- | Check that the funds at an address meet some condition.
valueAtAddress :: CardanoAddress -> (C.Value -> Bool) -> TracePredicate
valueAtAddress :: CardanoAddress -> (Value -> Bool) -> TracePredicate
valueAtAddress CardanoAddress
address Value -> Bool
check = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$
    ((Value -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent Value
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM (Eff effs) EmulatorEvent Value
-> (Value -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Value -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Value
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Fold EmulatorEvent Value -> FoldM (Eff effs) EmulatorEvent Value
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize (Fold EmulatorEvent Value -> FoldM (Eff effs) EmulatorEvent Value)
-> Fold EmulatorEvent Value -> FoldM (Eff effs) EmulatorEvent Value
forall a b. (a -> b) -> a -> b
$ CardanoAddress -> Fold EmulatorEvent Value
Folds.valueAtAddress CardanoAddress
address) ((Value -> Eff effs Bool) -> FoldM (Eff effs) EmulatorEvent Bool)
-> (Value -> Eff effs Bool) -> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \Value
vl -> do
        let result :: Bool
result = Value -> Bool
check Value
vl
        Bool -> Eff effs () -> Eff effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
result (Eff effs () -> Eff effs ()) -> Eff effs () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ do
            Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void
"Funds at address" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Address -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty (CardanoAddress -> Address
forall era. AddressInEra era -> Address
toPlutusAddress CardanoAddress
address) Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Void
"were" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Value -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty Value
vl)
        Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
result

plutusValueAtAddress :: CardanoAddress -> (Plutus.Value -> Bool) -> TracePredicate
plutusValueAtAddress :: CardanoAddress -> (Value -> Bool) -> TracePredicate
plutusValueAtAddress CardanoAddress
addr Value -> Bool
p = CardanoAddress -> (Value -> Bool) -> TracePredicate
valueAtAddress CardanoAddress
addr (Value -> Bool
p (Value -> Bool) -> (Value -> Value) -> Value -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Value
fromCardanoValue)


dataAtAddress :: forall d . FromData d => CardanoAddress -> ([d] -> Bool) -> TracePredicate
dataAtAddress :: CardanoAddress -> ([d] -> Bool) -> TracePredicate
dataAtAddress CardanoAddress
address [d] -> Bool
check = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$
    ((UtxoMap -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent UtxoMap
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM (Eff effs) EmulatorEvent UtxoMap
-> (UtxoMap -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (UtxoMap -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent UtxoMap
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Fold EmulatorEvent UtxoMap
-> FoldM (Eff effs) EmulatorEvent UtxoMap
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize (Fold EmulatorEvent UtxoMap
 -> FoldM (Eff effs) EmulatorEvent UtxoMap)
-> Fold EmulatorEvent UtxoMap
-> FoldM (Eff effs) EmulatorEvent UtxoMap
forall a b. (a -> b) -> a -> b
$ CardanoAddress -> Fold EmulatorEvent UtxoMap
Folds.utxoAtAddress CardanoAddress
address) ((UtxoMap -> Eff effs Bool) -> FoldM (Eff effs) EmulatorEvent Bool)
-> (UtxoMap -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \UtxoMap
utxo -> do
      let
        datums :: [d]
datums = ((CardanoTx, TxOut) -> Maybe d) -> [(CardanoTx, TxOut)] -> [d]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(CardanoTx
_txId, TxOut
txOut) -> TxOut -> Maybe d
forall d. FromData d => TxOut -> Maybe d
Ledger.Tx.Internal.txOutDatum TxOut
txOut) ([(CardanoTx, TxOut)] -> [d]) -> [(CardanoTx, TxOut)] -> [d]
forall a b. (a -> b) -> a -> b
$ UtxoMap -> [(CardanoTx, TxOut)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList UtxoMap
utxo
        result :: Bool
result = [d] -> Bool
check [d]
datums
      Bool -> Eff effs () -> Eff effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
result (Eff effs () -> Eff effs ()) -> Eff effs () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ do
          Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void
"Data at address" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Address -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty (CardanoAddress -> Address
forall era. AddressInEra era -> Address
toPlutusAddress CardanoAddress
address) Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Void
"was"
              Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ((CardanoTx, TxOut) -> Doc Void) -> UtxoMap -> Doc Void
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Datum -> Doc Void) -> Map DatumHash Datum -> Doc Void
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Datum -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty (Map DatumHash Datum -> Doc Void)
-> ((CardanoTx, TxOut) -> Map DatumHash Datum)
-> (CardanoTx, TxOut)
-> Doc Void
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoTx -> Map DatumHash Datum
Ledger.getCardanoTxData (CardanoTx -> Map DatumHash Datum)
-> ((CardanoTx, TxOut) -> CardanoTx)
-> (CardanoTx, TxOut)
-> Map DatumHash Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoTx, TxOut) -> CardanoTx
forall a b. (a, b) -> a
fst) UtxoMap
utxo)
      Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
result

waitingForSlot
    :: forall w s e a.
       ( Monoid w
       )
    => Contract w s e a
    -> ContractInstanceTag
    -> Slot
    -> TracePredicate
waitingForSlot :: Contract w s e a -> ContractInstanceTag -> Slot -> TracePredicate
waitingForSlot Contract w s e a
contract ContractInstanceTag
inst Slot
sl = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$
    (([Request PABReq] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent [Request PABReq]
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM (Eff effs) EmulatorEvent [Request PABReq]
-> ([Request PABReq] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Request PABReq] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent [Request PABReq]
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Contract w s e a
-> ContractInstanceTag
-> FoldM (Eff effs) EmulatorEvent [Request PABReq]
forall w (s :: Row *) e a (effs :: [* -> *]).
(Member (Error EmulatorFoldErr) effs, Monoid w) =>
Contract w s e a
-> ContractInstanceTag -> EmulatorEventFoldM effs [Request PABReq]
Folds.instanceRequests Contract w s e a
contract ContractInstanceTag
inst) (([Request PABReq] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> ([Request PABReq] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \[Request PABReq]
rqs -> do
        let hks :: [Request Slot]
            hks :: [Request Slot]
hks = (Request PABReq -> Maybe (Request Slot))
-> [Request PABReq] -> [Request Slot]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((PABReq -> Maybe Slot) -> Request PABReq -> Maybe (Request Slot)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (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
Requests._AwaitSlotReq)) [Request PABReq]
rqs
        case (Slot -> Bool) -> [Slot] -> [Slot]
forall a. (a -> Bool) -> [a] -> [a]
filter (Slot -> Slot -> Bool
forall a. Eq a => a -> a -> Bool
(==) Slot
sl) (Request Slot -> Slot
forall o. Request o -> o
rqRequest (Request Slot -> Slot) -> [Request Slot] -> [Slot]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Request Slot]
hks) of
            [] -> do
                forall (effs :: [* -> *]).
Member (Writer (Doc Void)) effs =>
Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void -> Eff effs ()) -> Doc Void -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ ContractInstanceTag -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceTag
inst Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Void
"not waiting for any slot notifications. Expected:" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+>  Slot -> Doc Void
forall a ann. Show a => a -> Doc ann
viaShow Slot
sl
                Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
            [Slot]
_ -> Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

anyUnbalancedTx
    :: forall w s e a.
       ( Monoid w
       )
    => Contract w s e a
    -> ContractInstanceTag
    -> TracePredicate
anyUnbalancedTx :: Contract w s e a -> ContractInstanceTag -> TracePredicate
anyUnbalancedTx Contract w s e a
contract ContractInstanceTag
inst = Contract w s e a
-> ContractInstanceTag
-> (UnbalancedTx -> Bool)
-> String
-> TracePredicate
forall w (s :: Row *) e a.
Monoid w =>
Contract w s e a
-> ContractInstanceTag
-> (UnbalancedTx -> Bool)
-> String
-> TracePredicate
assertUnbalancedTx Contract w s e a
contract ContractInstanceTag
inst (Bool -> UnbalancedTx -> Bool
forall a b. a -> b -> a
const Bool
True) String
"anyUnbalancedTx"

assertHooks
    :: forall w s e a.
       ( Monoid w
       )
    => Contract w s e a
    -> ContractInstanceTag
    -> ([PABReq] -> Bool)
    -> String
    -> TracePredicate
assertHooks :: Contract w s e a
-> ContractInstanceTag
-> ([PABReq] -> Bool)
-> String
-> TracePredicate
assertHooks Contract w s e a
contract ContractInstanceTag
inst [PABReq] -> Bool
p String
nm = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$
    (([Request PABReq] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent [Request PABReq]
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM (Eff effs) EmulatorEvent [Request PABReq]
-> ([Request PABReq] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Request PABReq] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent [Request PABReq]
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Contract w s e a
-> ContractInstanceTag
-> FoldM (Eff effs) EmulatorEvent [Request PABReq]
forall w (s :: Row *) e a (effs :: [* -> *]).
(Member (Error EmulatorFoldErr) effs, Monoid w) =>
Contract w s e a
-> ContractInstanceTag -> EmulatorEventFoldM effs [Request PABReq]
Folds.instanceRequests Contract w s e a
contract ContractInstanceTag
inst) (([Request PABReq] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> ([Request PABReq] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \[Request PABReq]
rqs -> do
        let hks :: [PABReq]
hks = Request PABReq -> PABReq
forall o. Request o -> o
rqRequest (Request PABReq -> PABReq) -> [Request PABReq] -> [PABReq]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Request PABReq]
rqs
            result :: Bool
result = [PABReq] -> Bool
p [PABReq]
hks
        Bool -> Eff effs () -> Eff effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
result (Eff effs () -> Eff effs ()) -> Eff effs () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ do
            forall (effs :: [* -> *]).
Member (Writer (Doc Void)) effs =>
Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void -> Eff effs ()) -> Doc Void -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ [Doc Void] -> Doc Void
forall ann. [Doc ann] -> Doc ann
vsep
                [ Doc Void
"Handlers for" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ContractInstanceTag -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceTag
inst Doc Void -> Doc Void -> Doc Void
forall a. Semigroup a => a -> a -> a
<> Doc Void
forall ann. Doc ann
colon
                , Int -> Doc Void -> Doc Void
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ([PABReq] -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty [PABReq]
hks)
                , Doc Void
"Failed" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann
squotes (String -> Doc Void
forall a. IsString a => String -> a
fromString String
nm)
                ]
        Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
result

-- | Make an assertion about the responses provided to the contract instance.
assertResponses
    :: forall w s e a.
       ( Monoid w
       )
    => Contract w s e a
    -> ContractInstanceTag
    -> ([Response PABResp] -> Bool)
    -> String
    -> TracePredicate
assertResponses :: Contract w s e a
-> ContractInstanceTag
-> ([Response PABResp] -> Bool)
-> String
-> TracePredicate
assertResponses Contract w s e a
contract ContractInstanceTag
inst [Response PABResp] -> Bool
p String
nm = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$
    (([Response PABResp] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent [Response PABResp]
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM (Eff effs) EmulatorEvent [Response PABResp]
-> ([Response PABResp] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Response PABResp] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent [Response PABResp]
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Contract w s e a
-> ContractInstanceTag
-> FoldM (Eff effs) EmulatorEvent [Response PABResp]
forall w (s :: Row *) e a (effs :: [* -> *]).
(Member (Error EmulatorFoldErr) effs, Monoid w) =>
Contract w s e a
-> ContractInstanceTag
-> EmulatorEventFoldM effs [Response PABResp]
Folds.instanceResponses Contract w s e a
contract ContractInstanceTag
inst) (([Response PABResp] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> ([Response PABResp] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \[Response PABResp]
rqs -> do
        let result :: Bool
result = [Response PABResp] -> Bool
p [Response PABResp]
rqs
        Bool -> Eff effs () -> Eff effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
result (Eff effs () -> Eff effs ()) -> Eff effs () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ do
            forall (effs :: [* -> *]).
Member (Writer (Doc Void)) effs =>
Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void -> Eff effs ()) -> Doc Void -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ [Doc Void] -> Doc Void
forall ann. [Doc ann] -> Doc ann
vsep
                [ Doc Void
"Record:"
                , Int -> Doc Void -> Doc Void
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 ([Response PABResp] -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty [Response PABResp]
rqs)
                , Doc Void
"Failed" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann
squotes (String -> Doc Void
forall a. IsString a => String -> a
fromString String
nm)
                ]
        Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
result

data Shrinking = DoShrink | DontShrink
    deriving (Shrinking -> Shrinking -> Bool
(Shrinking -> Shrinking -> Bool)
-> (Shrinking -> Shrinking -> Bool) -> Eq Shrinking
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Shrinking -> Shrinking -> Bool
$c/= :: Shrinking -> Shrinking -> Bool
== :: Shrinking -> Shrinking -> Bool
$c== :: Shrinking -> Shrinking -> Bool
Eq, Eq Shrinking
Eq Shrinking
-> (Shrinking -> Shrinking -> Ordering)
-> (Shrinking -> Shrinking -> Bool)
-> (Shrinking -> Shrinking -> Bool)
-> (Shrinking -> Shrinking -> Bool)
-> (Shrinking -> Shrinking -> Bool)
-> (Shrinking -> Shrinking -> Shrinking)
-> (Shrinking -> Shrinking -> Shrinking)
-> Ord Shrinking
Shrinking -> Shrinking -> Bool
Shrinking -> Shrinking -> Ordering
Shrinking -> Shrinking -> Shrinking
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 :: Shrinking -> Shrinking -> Shrinking
$cmin :: Shrinking -> Shrinking -> Shrinking
max :: Shrinking -> Shrinking -> Shrinking
$cmax :: Shrinking -> Shrinking -> Shrinking
>= :: Shrinking -> Shrinking -> Bool
$c>= :: Shrinking -> Shrinking -> Bool
> :: Shrinking -> Shrinking -> Bool
$c> :: Shrinking -> Shrinking -> Bool
<= :: Shrinking -> Shrinking -> Bool
$c<= :: Shrinking -> Shrinking -> Bool
< :: Shrinking -> Shrinking -> Bool
$c< :: Shrinking -> Shrinking -> Bool
compare :: Shrinking -> Shrinking -> Ordering
$ccompare :: Shrinking -> Shrinking -> Ordering
$cp1Ord :: Eq Shrinking
Ord, Int -> Shrinking -> String -> String
[Shrinking] -> String -> String
Shrinking -> String
(Int -> Shrinking -> String -> String)
-> (Shrinking -> String)
-> ([Shrinking] -> String -> String)
-> Show Shrinking
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Shrinking] -> String -> String
$cshowList :: [Shrinking] -> String -> String
show :: Shrinking -> String
$cshow :: Shrinking -> String
showsPrec :: Int -> Shrinking -> String -> String
$cshowsPrec :: Int -> Shrinking -> String -> String
Show)

-- | make an assertion about the 'ContractInstanceState' of a contract
--   instance
assertResumableResult ::
    forall w s e a.
    ( Monoid w
    , Show e
    , Show a
    , Show w
    )
    => Contract w s e a
    -> ContractInstanceTag
    -> Shrinking
    -> (ResumableResult w e PABResp PABReq a -> Bool)
    -> String
    -> TracePredicate
assertResumableResult :: Contract w s e a
-> ContractInstanceTag
-> Shrinking
-> (ResumableResult w e PABResp PABReq a -> Bool)
-> String
-> TracePredicate
assertResumableResult Contract w s e a
contract ContractInstanceTag
inst Shrinking
shrinking ResumableResult w e PABResp PABReq a -> Bool
p String
nm = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$
    let f :: ResumableResult w e PABResp PABReq a
-> ResumableResult w e PABResp PABReq a
f = case Shrinking
shrinking of { Shrinking
DontShrink -> ResumableResult w e PABResp PABReq a
-> ResumableResult w e PABResp PABReq a
forall a. a -> a
id; Shrinking
DoShrink -> ResumableResult w e PABResp PABReq a
-> ResumableResult w e PABResp PABReq a
forall w e i o a.
ResumableResult w e i o a -> ResumableResult w e i o a
shrinkResumableResult } in
    ((Maybe (ContractInstanceState w s e a) -> Eff effs Bool)
 -> FoldM
      (Eff effs) EmulatorEvent (Maybe (ContractInstanceState w s e a))
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM
     (Eff effs) EmulatorEvent (Maybe (ContractInstanceState w s e a))
-> (Maybe (ContractInstanceState w s e a) -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe (ContractInstanceState w s e a) -> Eff effs Bool)
-> FoldM
     (Eff effs) EmulatorEvent (Maybe (ContractInstanceState w s e a))
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Contract w s e a
-> ContractInstanceTag
-> FoldM
     (Eff effs) 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))
Folds.instanceState Contract w s e a
contract ContractInstanceTag
inst) ((Maybe (ContractInstanceState w s e a) -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> (Maybe (ContractInstanceState w s e a) -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \case
        Maybe (ContractInstanceState w s e a)
Nothing -> do
            forall (effs :: [* -> *]).
Member (Writer (Doc Void)) effs =>
Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void -> Eff effs ()) -> Doc Void -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ Doc Void
"No state for " Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ContractInstanceTag -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceTag
inst
            Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        Just ContractInstanceState{ResumableResult w e PABResp PABReq a
instContractState :: forall w (s :: Row *) e a.
ContractInstanceState w s e a
-> ResumableResult w e PABResp PABReq a
instContractState :: ResumableResult w e PABResp PABReq a
instContractState} -> do
            let shrunkState :: ResumableResult w e PABResp PABReq a
shrunkState = ResumableResult w e PABResp PABReq a
-> ResumableResult w e PABResp PABReq a
f ResumableResult w e PABResp PABReq a
instContractState
                result :: Bool
result = ResumableResult w e PABResp PABReq a -> Bool
p ResumableResult w e PABResp PABReq a
shrunkState
            Bool -> Eff effs () -> Eff effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
result (Eff effs () -> Eff effs ()) -> Eff effs () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ do
                forall (effs :: [* -> *]).
Member (Writer (Doc Void)) effs =>
Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void -> Eff effs ()) -> Doc Void -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ [Doc Void] -> Doc Void
forall ann. [Doc ann] -> Doc ann
vsep
                    [ Doc Void
"Resumable result for" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ContractInstanceTag -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceTag
inst
                    , ResumableResult w e PABResp PABReq a -> Doc Void
forall a ann. Show a => a -> Doc ann
viaShow ResumableResult w e PABResp PABReq a
shrunkState
                    , Doc Void
"Failed" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann
squotes (String -> Doc Void
forall a. IsString a => String -> a
fromString String
nm)
                    ]
            Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
result

-- | A 'TracePredicate' checking that the wallet's contract instance finished
--   without errors.
assertDone
    :: forall contract w s e a.
    ( Monoid w
    , IsContract contract
    )
    => contract w s e a
    -> ContractInstanceTag
    -> (a -> Bool)
    -> String
    -> TracePredicate
assertDone :: contract w s e a
-> ContractInstanceTag -> (a -> Bool) -> String -> TracePredicate
assertDone contract w s e a
contract ContractInstanceTag
inst a -> Bool
pr = contract w s e a
-> ContractInstanceTag
-> (Outcome e a -> Bool)
-> String
-> TracePredicate
forall (contract :: * -> Row * -> * -> * -> *) w (s :: Row *) e a.
(Monoid w, IsContract contract) =>
contract w s e a
-> ContractInstanceTag
-> (Outcome e a -> Bool)
-> String
-> TracePredicate
assertOutcome contract w s e a
contract ContractInstanceTag
inst (\case { Done a
a -> a -> Bool
pr a
a; Outcome e a
_ -> Bool
False})

-- | A 'TracePredicate' checking that the wallet's contract instance is
--   waiting for input.
assertNotDone
    :: forall contract w s e a.
    ( Monoid w
    , IsContract contract
    )
    => contract w s e a
    -> ContractInstanceTag
    -> String
    -> TracePredicate
assertNotDone :: contract w s e a -> ContractInstanceTag -> String -> TracePredicate
assertNotDone contract w s e a
contract ContractInstanceTag
inst = contract w s e a
-> ContractInstanceTag
-> (Outcome e a -> Bool)
-> String
-> TracePredicate
forall (contract :: * -> Row * -> * -> * -> *) w (s :: Row *) e a.
(Monoid w, IsContract contract) =>
contract w s e a
-> ContractInstanceTag
-> (Outcome e a -> Bool)
-> String
-> TracePredicate
assertOutcome contract w s e a
contract ContractInstanceTag
inst (\case { Outcome e a
NotDone -> Bool
True; Outcome e a
_ -> Bool
False})

-- | A 'TracePredicate' checking that the wallet's contract instance
--   failed with an error.
assertContractError
    :: forall contract w s e a.
    ( Monoid w
    , IsContract contract
    )
    => contract w s e a
    -> ContractInstanceTag
    -> (e -> Bool)
    -> String
    -> TracePredicate
assertContractError :: contract w s e a
-> ContractInstanceTag -> (e -> Bool) -> String -> TracePredicate
assertContractError contract w s e a
contract ContractInstanceTag
inst e -> Bool
p = contract w s e a
-> ContractInstanceTag
-> (Outcome e a -> Bool)
-> String
-> TracePredicate
forall (contract :: * -> Row * -> * -> * -> *) w (s :: Row *) e a.
(Monoid w, IsContract contract) =>
contract w s e a
-> ContractInstanceTag
-> (Outcome e a -> Bool)
-> String
-> TracePredicate
assertOutcome contract w s e a
contract ContractInstanceTag
inst (\case { Failed e
err -> e -> Bool
p e
err; Outcome e a
_ -> Bool
False })

assertOutcome
    :: forall contract w s e a.
       ( Monoid w
       , IsContract contract
       )
    => contract w s e a
    -> ContractInstanceTag
    -> (Outcome e a -> Bool)
    -> String
    -> TracePredicate
assertOutcome :: contract w s e a
-> ContractInstanceTag
-> (Outcome e a -> Bool)
-> String
-> TracePredicate
assertOutcome contract w s e a
contract ContractInstanceTag
inst Outcome e a -> Bool
p String
nm = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$
    ((Outcome e a -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent (Outcome e a)
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM (Eff effs) EmulatorEvent (Outcome e a)
-> (Outcome e a -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Outcome e a -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent (Outcome e a)
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Contract w s e a
-> ContractInstanceTag
-> FoldM (Eff effs) EmulatorEvent (Outcome e a)
forall w (s :: Row *) e a (effs :: [* -> *]).
(Member (Error EmulatorFoldErr) effs, Monoid w) =>
Contract w s e a
-> ContractInstanceTag -> EmulatorEventFoldM effs (Outcome e a)
Folds.instanceOutcome (contract w s e a -> Contract w s e a
forall (c :: * -> Row * -> * -> * -> *) w (s :: Row *) e a.
IsContract c =>
c w s e a -> Contract w s e a
toContract contract w s e a
contract) ContractInstanceTag
inst) ((Outcome e a -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> (Outcome e a -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \Outcome e a
outcome -> do
        let result :: Bool
result = Outcome e a -> Bool
p Outcome e a
outcome
        Bool -> Eff effs () -> Eff effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
result (Eff effs () -> Eff effs ()) -> Eff effs () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ do
            forall (effs :: [* -> *]).
Member (Writer (Doc Void)) effs =>
Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void -> Eff effs ()) -> Doc Void -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ [Doc Void] -> Doc Void
forall ann. [Doc ann] -> Doc ann
vsep
                [ Doc Void
"Outcome of" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ContractInstanceTag -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceTag
inst Doc Void -> Doc Void -> Doc Void
forall a. Semigroup a => a -> a -> a
<> Doc Void
forall ann. Doc ann
colon
                , Int -> Doc Void -> Doc Void
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Bool -> Doc Void
forall a ann. Show a => a -> Doc ann
viaShow Bool
result)
                , Doc Void
"Failed" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann
squotes (String -> Doc Void
forall a. IsString a => String -> a
fromString String
nm)
                ]
        Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
result

-- | Check that the funds in the wallet have changed by the given amount, exluding fees, using the Plutus `Value` type.
walletFundsChangePlutus :: Wallet -> Plutus.Value -> TracePredicate
walletFundsChangePlutus :: Wallet -> Value -> TracePredicate
walletFundsChangePlutus Wallet
w Value
v = case Value -> Either ToCardanoError Value
toCardanoValue Value
v of
    Left ToCardanoError
_   -> (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$ Bool -> FoldM (Eff effs) EmulatorEvent Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    Right Value
cv -> Bool -> Wallet -> Value -> TracePredicate
walletFundsChangeImpl Bool
False Wallet
w Value
cv

-- | Check that the funds in the wallet have changed by the given amount, exluding fees.
walletFundsChange :: Wallet -> C.Value -> TracePredicate
walletFundsChange :: Wallet -> Value -> TracePredicate
walletFundsChange = Bool -> Wallet -> Value -> TracePredicate
walletFundsChangeImpl Bool
False
-- | Check that the funds in the wallet have changed by the given amount, including fees.
walletFundsExactChange :: Wallet -> C.Value -> TracePredicate
walletFundsExactChange :: Wallet -> Value -> TracePredicate
walletFundsExactChange = Bool -> Wallet -> Value -> TracePredicate
walletFundsChangeImpl Bool
True

walletFundsChangeImpl :: Bool -> Wallet -> C.Value -> TracePredicate
walletFundsChangeImpl :: Bool -> Wallet -> Value -> TracePredicate
walletFundsChangeImpl Bool
exact Wallet
w Value
dlt' =
    Wallet
-> (Value -> Value -> Lovelace -> [Lovelace] -> Maybe [Doc Void])
-> TracePredicate
walletFundsCheck Wallet
w ((Value -> Value -> Lovelace -> [Lovelace] -> Maybe [Doc Void])
 -> TracePredicate)
-> (Value -> Value -> Lovelace -> [Lovelace] -> Maybe [Doc Void])
-> TracePredicate
forall a b. (a -> b) -> a -> b
$ \Value
initialValue Value
finalValue' Lovelace
fees [Lovelace]
allWalletsTxOutCosts ->
        let finalValue :: Value
finalValue = Value
finalValue' Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> if Bool
exact then Value
forall a. Monoid a => a
mempty else Lovelace -> Value
lovelaceToValue Lovelace
fees
            dlt :: Value
dlt = Value -> Lovelace -> Lovelace -> [Lovelace] -> Value
calculateDelta Value
dlt' (Value -> Lovelace
C.selectLovelace Value
initialValue) (Value -> Lovelace
C.selectLovelace Value
finalValue) [Lovelace]
allWalletsTxOutCosts
            result :: Bool
result = Value
initialValue Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
dlt Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
finalValue
        in if Bool
result then Maybe [Doc Void]
forall a. Maybe a
Nothing else [Doc Void] -> Maybe [Doc Void]
forall a. a -> Maybe a
Just ([Doc Void] -> Maybe [Doc Void]) -> [Doc Void] -> Maybe [Doc Void]
forall a b. (a -> b) -> a -> b
$
            [ Doc Void
"Expected funds of" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Wallet -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty Wallet
w Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Void
"to change by"
            , Doc Void
" " Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Value -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty Value
dlt] [Doc Void] -> [Doc Void] -> [Doc Void]
forall a. [a] -> [a] -> [a]
++
            (Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
exact [()] -> [Doc Void] -> [Doc Void]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Doc Void
"  (excluding" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lovelace -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty Lovelace
fees Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Void
"lovelace in fees)" ]) [Doc Void] -> [Doc Void] -> [Doc Void]
forall a. [a] -> [a] -> [a]
++
            if Value
initialValue Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
finalValue
            then [Doc Void
"but they did not change"]
            else [Doc Void
"but they changed by", Doc Void
" " Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Value -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty (Value
finalValue Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
C.negateValue Value
initialValue),
                    Doc Void
"a discrepancy of",    Doc Void
" " Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Value -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty (Value
finalValue Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
C.negateValue (Value
initialValue Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
dlt))]

walletPaidFees :: Wallet -> C.Lovelace -> TracePredicate
walletPaidFees :: Wallet -> Lovelace -> TracePredicate
walletPaidFees Wallet
w Lovelace
val = Wallet
-> (Value -> Value -> Lovelace -> [Lovelace] -> Maybe [Doc Void])
-> TracePredicate
walletFundsCheck Wallet
w ((Value -> Value -> Lovelace -> [Lovelace] -> Maybe [Doc Void])
 -> TracePredicate)
-> (Value -> Value -> Lovelace -> [Lovelace] -> Maybe [Doc Void])
-> TracePredicate
forall a b. (a -> b) -> a -> b
$ \Value
_ Value
_ Lovelace
fees [Lovelace]
_ -> do
    if Lovelace
fees Lovelace -> Lovelace -> Bool
forall a. Eq a => a -> a -> Bool
== Lovelace
val then Maybe [Doc Void]
forall a. Maybe a
Nothing else [Doc Void] -> Maybe [Doc Void]
forall a. a -> Maybe a
Just
        [ Doc Void
"Expected" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Wallet -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty Wallet
w Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Void
"to pay"
        , Doc Void
" " Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lovelace -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty Lovelace
val
        , Doc Void
"lovelace in fees, but they paid"
        , Doc Void
" " Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Lovelace -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty Lovelace
fees ]

walletFundsAssetClassChange :: Wallet -> C.AssetId -> Integer -> TracePredicate
walletFundsAssetClassChange :: Wallet -> AssetId -> Integer -> TracePredicate
walletFundsAssetClassChange Wallet
w AssetId
ac Integer
dlt =
    Wallet
-> (Value -> Value -> Lovelace -> [Lovelace] -> Maybe [Doc Void])
-> TracePredicate
walletFundsCheck Wallet
w ((Value -> Value -> Lovelace -> [Lovelace] -> Maybe [Doc Void])
 -> TracePredicate)
-> (Value -> Value -> Lovelace -> [Lovelace] -> Maybe [Doc Void])
-> TracePredicate
forall a b. (a -> b) -> a -> b
$ \Value
initialValue Value
finalValue Lovelace
_ [Lovelace]
_ ->
        let C.Quantity Integer
realDlt = (Value
finalValue Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value -> Value
C.negateValue Value
initialValue) Value -> AssetId -> Quantity
`C.selectAsset` AssetId
ac
        in if Integer
realDlt Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
dlt then Maybe [Doc Void]
forall a. Maybe a
Nothing else [Doc Void] -> Maybe [Doc Void]
forall a. a -> Maybe a
Just ([Doc Void] -> Maybe [Doc Void]) -> [Doc Void] -> Maybe [Doc Void]
forall a b. (a -> b) -> a -> b
$
            [ Doc Void
"Expected amount of" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> AssetId -> Doc Void
forall a ann. Show a => a -> Doc ann
viaShow AssetId
ac Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Void
"in" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Wallet -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty Wallet
w Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Void
"to change by"
            , Doc Void
" " Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty Integer
dlt Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Void
" but they changed by"
            , Doc Void
" " Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty Integer
realDlt ]

walletFundsCheck :: Wallet -> (C.Value -> C.Value -> C.Lovelace -> [C.Lovelace] -> Maybe [Doc Void]) -> TracePredicate
walletFundsCheck :: Wallet
-> (Value -> Value -> Lovelace -> [Lovelace] -> Maybe [Doc Void])
-> TracePredicate
walletFundsCheck Wallet
w Value -> Value -> Lovelace -> [Lovelace] -> Maybe [Doc Void]
check = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$
    (((Value, Lovelace, [Lovelace]) -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent (Value, Lovelace, [Lovelace])
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM (Eff effs) EmulatorEvent (Value, Lovelace, [Lovelace])
-> ((Value, Lovelace, [Lovelace]) -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Value, Lovelace, [Lovelace]) -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent (Value, Lovelace, [Lovelace])
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Fold EmulatorEvent (Value, Lovelace, [Lovelace])
-> FoldM (Eff effs) EmulatorEvent (Value, Lovelace, [Lovelace])
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize (Fold EmulatorEvent (Value, Lovelace, [Lovelace])
 -> FoldM (Eff effs) EmulatorEvent (Value, Lovelace, [Lovelace]))
-> Fold EmulatorEvent (Value, Lovelace, [Lovelace])
-> FoldM (Eff effs) EmulatorEvent (Value, Lovelace, [Lovelace])
forall a b. (a -> b) -> a -> b
$ (,,) (Value -> Lovelace -> [Lovelace] -> (Value, Lovelace, [Lovelace]))
-> Fold EmulatorEvent Value
-> Fold
     EmulatorEvent
     (Lovelace -> [Lovelace] -> (Value, Lovelace, [Lovelace]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wallet -> Fold EmulatorEvent Value
Folds.walletFunds Wallet
w Fold
  EmulatorEvent
  (Lovelace -> [Lovelace] -> (Value, Lovelace, [Lovelace]))
-> Fold EmulatorEvent Lovelace
-> Fold EmulatorEvent ([Lovelace] -> (Value, Lovelace, [Lovelace]))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Wallet -> Fold EmulatorEvent Lovelace
Folds.walletFees Wallet
w Fold EmulatorEvent ([Lovelace] -> (Value, Lovelace, [Lovelace]))
-> Fold EmulatorEvent [Lovelace]
-> Fold EmulatorEvent (Value, Lovelace, [Lovelace])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fold EmulatorEvent [Lovelace]
Folds.walletsAdjustedTxEvents) (((Value, Lovelace, [Lovelace]) -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> ((Value, Lovelace, [Lovelace]) -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \(Value
finalValue, Lovelace
fees, [Lovelace]
allWalletsTxOutCosts) -> do
        InitialDistribution
dist <- forall (effs :: [* -> *]).
Member (Reader InitialDistribution) effs =>
Eff effs InitialDistribution
forall r (effs :: [* -> *]). Member (Reader r) effs => Eff effs r
ask @InitialDistribution
        let initialValue :: Value
initialValue = Maybe Value -> Value
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (InitialDistribution
dist InitialDistribution
-> Getting (Maybe Value) InitialDistribution (Maybe Value)
-> Maybe Value
forall s a. s -> Getting a s a -> a
^. Index InitialDistribution
-> Lens' InitialDistribution (Maybe (IxValue InitialDistribution))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index InitialDistribution
Wallet
w)
            result :: Maybe [Doc Void]
result = Value -> Value -> Lovelace -> [Lovelace] -> Maybe [Doc Void]
check Value
initialValue Value
finalValue Lovelace
fees [Lovelace]
allWalletsTxOutCosts
        case Maybe [Doc Void]
result of
            Maybe [Doc Void]
Nothing -> Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            Just [Doc Void]
docLines -> do
                Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell (Doc Void -> Eff effs ()) -> Doc Void -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ [Doc Void] -> Doc Void
forall ann. [Doc ann] -> Doc ann
vsep [Doc Void]
docLines
                Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

-- | An assertion about the blockchain
assertBlockchain :: ([Ledger.Block] -> Bool) -> TracePredicate
assertBlockchain :: ([Block] -> Bool) -> TracePredicate
assertBlockchain [Block] -> Bool
predicate = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$
    (([Block] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent [Block]
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM (Eff effs) EmulatorEvent [Block]
-> ([Block] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Block] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent [Block]
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Fold EmulatorEvent [Block]
-> FoldM (Eff effs) EmulatorEvent [Block]
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize Fold EmulatorEvent [Block]
Folds.blockchain) (([Block] -> Eff effs Bool) -> FoldM (Eff effs) EmulatorEvent Bool)
-> ([Block] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \[Block]
chain -> do
        let passing :: Bool
passing = [Block] -> Bool
predicate [Block]
chain
        Bool -> Eff effs () -> Eff effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
passing (Eff effs () -> Eff effs ()) -> Eff effs () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ do
            forall (effs :: [* -> *]).
Member (Writer (Doc Void)) effs =>
Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void -> Eff effs ()) -> Doc Void -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ Doc Void
"Blockchain does not match predicate."
        Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
passing

-- | An assertion about the chain events
assertChainEvents :: ([ChainEvent] -> Bool) -> TracePredicate
assertChainEvents :: ([ChainEvent] -> Bool) -> TracePredicate
assertChainEvents = ([ChainEvent] -> String)
-> ([ChainEvent] -> Bool) -> TracePredicate
assertChainEvents' (String -> [ChainEvent] -> String
forall a b. a -> b -> a
const String
"")

-- | An assertion about the chain events with a custom error message
assertChainEvents' :: ([ChainEvent] -> String) -> ([ChainEvent] -> Bool) -> TracePredicate
assertChainEvents' :: ([ChainEvent] -> String)
-> ([ChainEvent] -> Bool) -> TracePredicate
assertChainEvents' [ChainEvent] -> String
logMsg [ChainEvent] -> Bool
predicate = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$
    (([ChainEvent] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent [ChainEvent]
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM (Eff effs) EmulatorEvent [ChainEvent]
-> ([ChainEvent] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([ChainEvent] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent [ChainEvent]
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Fold EmulatorEvent [ChainEvent]
-> FoldM (Eff effs) EmulatorEvent [ChainEvent]
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize Fold EmulatorEvent [ChainEvent]
Folds.chainEvents) (([ChainEvent] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> ([ChainEvent] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \[ChainEvent]
evts -> do
        let passing :: Bool
passing = [ChainEvent] -> Bool
predicate [ChainEvent]
evts
        Bool -> Eff effs () -> Eff effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
passing (Eff effs () -> Eff effs ()) -> Eff effs () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ do
            let msg :: String
msg = [ChainEvent] -> String
logMsg [ChainEvent]
evts
            forall (effs :: [* -> *]).
Member (Writer (Doc Void)) effs =>
Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void -> Eff effs ()) -> Doc Void -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ Doc Void
"Chain events do not match predicate" Doc Void -> Doc Void -> Doc Void
forall a. Semigroup a => a -> a -> a
<> if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
msg then Doc Void
"" else Doc Void
":" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc Void
forall a. IsString a => String -> a
fromString String
msg
            (ChainEvent -> Eff effs ()) -> [ChainEvent] -> Eff effs ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (effs :: [* -> *]).
Member (Writer (Doc Void)) effs =>
Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void -> Eff effs ())
-> (ChainEvent -> Doc Void) -> ChainEvent -> Eff effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainEvent -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty) [ChainEvent]
evts
        Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
passing

-- | Assert that at least one transaction failed to validate, and that all
--   transactions that failed meet the predicate.
assertFailedTransaction :: (Ledger.CardanoTx -> ValidationError -> Bool) -> TracePredicate
assertFailedTransaction :: (CardanoTx -> ValidationError -> Bool) -> TracePredicate
assertFailedTransaction CardanoTx -> ValidationError -> Bool
predicate = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$
    (([(CardanoTx, ValidationError, Value)] -> Eff effs Bool)
 -> FoldM
      (Eff effs) EmulatorEvent [(CardanoTx, ValidationError, Value)]
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM
     (Eff effs) EmulatorEvent [(CardanoTx, ValidationError, Value)]
-> ([(CardanoTx, ValidationError, Value)] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([(CardanoTx, ValidationError, Value)] -> Eff effs Bool)
-> FoldM
     (Eff effs) EmulatorEvent [(CardanoTx, ValidationError, Value)]
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Fold EmulatorEvent [(CardanoTx, ValidationError, Value)]
-> FoldM
     (Eff effs) EmulatorEvent [(CardanoTx, ValidationError, Value)]
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize (Fold EmulatorEvent [(CardanoTx, ValidationError, Value)]
 -> FoldM
      (Eff effs) EmulatorEvent [(CardanoTx, ValidationError, Value)])
-> Fold EmulatorEvent [(CardanoTx, ValidationError, Value)]
-> FoldM
     (Eff effs) EmulatorEvent [(CardanoTx, ValidationError, Value)]
forall a b. (a -> b) -> a -> b
$ Maybe ValidationPhase
-> Fold EmulatorEvent [(CardanoTx, ValidationError, Value)]
Folds.failedTransactions Maybe ValidationPhase
forall a. Maybe a
Nothing) (([(CardanoTx, ValidationError, Value)] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> ([(CardanoTx, ValidationError, Value)] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \case
        [] -> do
            forall (effs :: [* -> *]).
Member (Writer (Doc Void)) effs =>
Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void -> Eff effs ()) -> Doc Void -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ Doc Void
"No transactions failed to validate."
            Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        [(CardanoTx, ValidationError, Value)]
xs -> Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (((CardanoTx, ValidationError, Value) -> Bool)
-> [(CardanoTx, ValidationError, Value)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(CardanoTx
t, ValidationError
e, Value
_) -> CardanoTx -> ValidationError -> Bool
predicate CardanoTx
t ValidationError
e) [(CardanoTx, ValidationError, Value)]
xs)

-- | Assert that at least one transaction failed to validate with an EvaluationError
-- containing the given text.
assertEvaluationError :: Text.Text -> TracePredicate
assertEvaluationError :: Text -> TracePredicate
assertEvaluationError Text
errCode =
  (CardanoTx -> ValidationError -> Bool) -> TracePredicate
assertFailedTransaction
    ((ValidationError -> Bool) -> CardanoTx -> ValidationError -> Bool
forall a b. a -> b -> a
const ((ValidationError -> Bool) -> CardanoTx -> ValidationError -> Bool)
-> (ValidationError -> Bool)
-> CardanoTx
-> ValidationError
-> Bool
forall a b. (a -> b) -> a -> b
$ Getting Any ValidationError Text
-> (Text -> Bool) -> ValidationError -> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf ((ScriptError -> Const Any ScriptError)
-> ValidationError -> Const Any ValidationError
Prism' ValidationError ScriptError
Ledger._ScriptFailure ((ScriptError -> Const Any ScriptError)
 -> ValidationError -> Const Any ValidationError)
-> ((Text -> Const Any Text)
    -> ScriptError -> Const Any ScriptError)
-> Getting Any ValidationError Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Text], String) -> Const Any ([Text], String))
-> ScriptError -> Const Any ScriptError
Prism' ScriptError ([Text], String)
_EvaluationError ((([Text], String) -> Const Any ([Text], String))
 -> ScriptError -> Const Any ScriptError)
-> ((Text -> Const Any Text)
    -> ([Text], String) -> Const Any ([Text], String))
-> (Text -> Const Any Text)
-> ScriptError
-> Const Any ScriptError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> Const Any [Text])
-> ([Text], String) -> Const Any ([Text], String)
forall s t a b. Field1 s t a b => Lens s t a b
_1 (([Text] -> Const Any [Text])
 -> ([Text], String) -> Const Any ([Text], String))
-> ((Text -> Const Any Text) -> [Text] -> Const Any [Text])
-> (Text -> Const Any Text)
-> ([Text], String)
-> Const Any ([Text], String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Any Text) -> [Text] -> Const Any [Text]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded) (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
errCode))


-- | Assert that no transaction failed to validate.
assertNoFailedTransactions :: TracePredicate
assertNoFailedTransactions :: TracePredicate
assertNoFailedTransactions = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$
    (([(CardanoTx, ValidationError, Value)] -> Eff effs Bool)
 -> FoldM
      (Eff effs) EmulatorEvent [(CardanoTx, ValidationError, Value)]
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM
     (Eff effs) EmulatorEvent [(CardanoTx, ValidationError, Value)]
-> ([(CardanoTx, ValidationError, Value)] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([(CardanoTx, ValidationError, Value)] -> Eff effs Bool)
-> FoldM
     (Eff effs) EmulatorEvent [(CardanoTx, ValidationError, Value)]
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Fold EmulatorEvent [(CardanoTx, ValidationError, Value)]
-> FoldM
     (Eff effs) EmulatorEvent [(CardanoTx, ValidationError, Value)]
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize (Fold EmulatorEvent [(CardanoTx, ValidationError, Value)]
 -> FoldM
      (Eff effs) EmulatorEvent [(CardanoTx, ValidationError, Value)])
-> Fold EmulatorEvent [(CardanoTx, ValidationError, Value)]
-> FoldM
     (Eff effs) EmulatorEvent [(CardanoTx, ValidationError, Value)]
forall a b. (a -> b) -> a -> b
$ Maybe ValidationPhase
-> Fold EmulatorEvent [(CardanoTx, ValidationError, Value)]
Folds.failedTransactions Maybe ValidationPhase
forall a. Maybe a
Nothing) (([(CardanoTx, ValidationError, Value)] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> ([(CardanoTx, ValidationError, Value)] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \case
        [] -> Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
        [(CardanoTx, ValidationError, Value)]
xs -> do
            let prettyTxFail :: (CardanoTx, a, c) -> Doc ann
prettyTxFail (CardanoTx
tx, a
err, c
_) = TxId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (CardanoTx -> TxId
Ledger.getCardanoTxId CardanoTx
tx) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
err
            forall (effs :: [* -> *]).
Member (Writer (Doc Void)) effs =>
Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void -> Eff effs ()) -> Doc Void -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ [Doc Void] -> Doc Void
forall ann. [Doc ann] -> Doc ann
vsep (Doc Void
"Transactions failed to validate:" Doc Void -> [Doc Void] -> [Doc Void]
forall a. a -> [a] -> [a]
: ((CardanoTx, ValidationError, Value) -> Doc Void)
-> [(CardanoTx, ValidationError, Value)] -> [Doc Void]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CardanoTx, ValidationError, Value) -> Doc Void
forall a c ann. Pretty a => (CardanoTx, a, c) -> Doc ann
prettyTxFail [(CardanoTx, ValidationError, Value)]
xs)
            Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

-- | Assert that n transactions validated, and no transaction failed to validate.
assertValidatedTransactionCount :: Int -> TracePredicate
assertValidatedTransactionCount :: Int -> TracePredicate
assertValidatedTransactionCount Int
expected = Int -> Int -> TracePredicate
assertValidatedTransactionCountOfTotal Int
expected Int
expected

-- | Assert that n transactions validated, and the rest failed.
assertValidatedTransactionCountOfTotal :: Int -> Int -> TracePredicate
assertValidatedTransactionCountOfTotal :: Int -> Int -> TracePredicate
assertValidatedTransactionCountOfTotal Int
expectedValid Int
expectedTotal =
    (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((([(OnChainTx, RedeemerReport)] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent [(OnChainTx, RedeemerReport)]
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM (Eff effs) EmulatorEvent [(OnChainTx, RedeemerReport)]
-> ([(OnChainTx, RedeemerReport)] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([(OnChainTx, RedeemerReport)] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent [(OnChainTx, RedeemerReport)]
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Fold EmulatorEvent [(OnChainTx, RedeemerReport)]
-> FoldM (Eff effs) EmulatorEvent [(OnChainTx, RedeemerReport)]
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize Fold EmulatorEvent [(OnChainTx, RedeemerReport)]
Folds.validatedTransactions) (([(OnChainTx, RedeemerReport)] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> ([(OnChainTx, RedeemerReport)] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \[(OnChainTx, RedeemerReport)]
xs ->
        let actual :: Int
actual = [(OnChainTx, RedeemerReport)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(OnChainTx, RedeemerReport)]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 in -- ignore the initial wallet distribution transaction
        if Int
actual Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
expectedValid then Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True else do
            forall (effs :: [* -> *]).
Member (Writer (Doc Void)) effs =>
Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void -> Eff effs ()) -> Doc Void -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ Doc Void
"Unexpected number of validated transactions:" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty Int
actual
            Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    ) TracePredicate -> TracePredicate -> TracePredicate
.&&.
    (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((([(CardanoTx, ValidationError, Value)] -> Eff effs Bool)
 -> FoldM
      (Eff effs) EmulatorEvent [(CardanoTx, ValidationError, Value)]
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM
     (Eff effs) EmulatorEvent [(CardanoTx, ValidationError, Value)]
-> ([(CardanoTx, ValidationError, Value)] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([(CardanoTx, ValidationError, Value)] -> Eff effs Bool)
-> FoldM
     (Eff effs) EmulatorEvent [(CardanoTx, ValidationError, Value)]
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Fold EmulatorEvent [(CardanoTx, ValidationError, Value)]
-> FoldM
     (Eff effs) EmulatorEvent [(CardanoTx, ValidationError, Value)]
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize (Fold EmulatorEvent [(CardanoTx, ValidationError, Value)]
 -> FoldM
      (Eff effs) EmulatorEvent [(CardanoTx, ValidationError, Value)])
-> Fold EmulatorEvent [(CardanoTx, ValidationError, Value)]
-> FoldM
     (Eff effs) EmulatorEvent [(CardanoTx, ValidationError, Value)]
forall a b. (a -> b) -> a -> b
$ Maybe ValidationPhase
-> Fold EmulatorEvent [(CardanoTx, ValidationError, Value)]
Folds.failedTransactions Maybe ValidationPhase
forall a. Maybe a
Nothing) (([(CardanoTx, ValidationError, Value)] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> ([(CardanoTx, ValidationError, Value)] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \[(CardanoTx, ValidationError, Value)]
xs ->
        let actual :: Int
actual = [(CardanoTx, ValidationError, Value)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(CardanoTx, ValidationError, Value)]
xs in
        if Int
actual Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
expectedTotal Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
expectedValid then Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True else do
            forall (effs :: [* -> *]).
Member (Writer (Doc Void)) effs =>
Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void -> Eff effs ()) -> Doc Void -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ Doc Void
"Unexpected number of invalid transactions:" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty Int
actual
            Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    )

assertInstanceLog ::
    ContractInstanceTag
    -> ([EmulatorTimeEvent ContractInstanceLog] -> Bool)
    -> TracePredicate
assertInstanceLog :: ContractInstanceTag
-> ([EmulatorTimeEvent ContractInstanceLog] -> Bool)
-> TracePredicate
assertInstanceLog ContractInstanceTag
tag [EmulatorTimeEvent ContractInstanceLog] -> Bool
pred' = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$ (([EmulatorTimeEvent ContractInstanceLog] -> Eff effs Bool)
 -> FoldM
      (Eff effs) EmulatorEvent [EmulatorTimeEvent ContractInstanceLog]
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM
     (Eff effs) EmulatorEvent [EmulatorTimeEvent ContractInstanceLog]
-> ([EmulatorTimeEvent ContractInstanceLog] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([EmulatorTimeEvent ContractInstanceLog] -> Eff effs Bool)
-> FoldM
     (Eff effs) EmulatorEvent [EmulatorTimeEvent ContractInstanceLog]
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Fold EmulatorEvent [EmulatorTimeEvent ContractInstanceLog]
-> FoldM
     (Eff effs) EmulatorEvent [EmulatorTimeEvent ContractInstanceLog]
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize (Fold EmulatorEvent [EmulatorTimeEvent ContractInstanceLog]
 -> FoldM
      (Eff effs) EmulatorEvent [EmulatorTimeEvent ContractInstanceLog])
-> Fold EmulatorEvent [EmulatorTimeEvent ContractInstanceLog]
-> FoldM
     (Eff effs) EmulatorEvent [EmulatorTimeEvent ContractInstanceLog]
forall a b. (a -> b) -> a -> b
$ ContractInstanceTag
-> Fold EmulatorEvent [EmulatorTimeEvent ContractInstanceLog]
Folds.instanceLog ContractInstanceTag
tag) (([EmulatorTimeEvent ContractInstanceLog] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> ([EmulatorTimeEvent ContractInstanceLog] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \[EmulatorTimeEvent ContractInstanceLog]
lg -> do
    let result :: Bool
result = [EmulatorTimeEvent ContractInstanceLog] -> Bool
pred' [EmulatorTimeEvent ContractInstanceLog]
lg
    Bool -> Eff effs () -> Eff effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
result (forall (effs :: [* -> *]).
Member (Writer (Doc Void)) effs =>
Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void -> Eff effs ()) -> Doc Void -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ [Doc Void] -> Doc Void
forall ann. [Doc ann] -> Doc ann
vsep (Doc Void
"Contract instance log failed to validate:" Doc Void -> [Doc Void] -> [Doc Void]
forall a. a -> [a] -> [a]
: (EmulatorTimeEvent ContractInstanceLog -> Doc Void)
-> [EmulatorTimeEvent ContractInstanceLog] -> [Doc Void]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EmulatorTimeEvent ContractInstanceLog -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty [EmulatorTimeEvent ContractInstanceLog]
lg))
    Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
result

assertUserLog ::
    ([EmulatorTimeEvent UserThreadMsg] -> Bool)
    -> TracePredicate
assertUserLog :: ([EmulatorTimeEvent UserThreadMsg] -> Bool) -> TracePredicate
assertUserLog [EmulatorTimeEvent UserThreadMsg] -> Bool
pred' = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$ (([EmulatorTimeEvent UserThreadMsg] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent [EmulatorTimeEvent UserThreadMsg]
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM (Eff effs) EmulatorEvent [EmulatorTimeEvent UserThreadMsg]
-> ([EmulatorTimeEvent UserThreadMsg] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([EmulatorTimeEvent UserThreadMsg] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent [EmulatorTimeEvent UserThreadMsg]
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Fold EmulatorEvent [EmulatorTimeEvent UserThreadMsg]
-> FoldM (Eff effs) EmulatorEvent [EmulatorTimeEvent UserThreadMsg]
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
L.generalize Fold EmulatorEvent [EmulatorTimeEvent UserThreadMsg]
Folds.userLog) (([EmulatorTimeEvent UserThreadMsg] -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> ([EmulatorTimeEvent UserThreadMsg] -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \[EmulatorTimeEvent UserThreadMsg]
lg -> do
    let result :: Bool
result = [EmulatorTimeEvent UserThreadMsg] -> Bool
pred' [EmulatorTimeEvent UserThreadMsg]
lg
    Bool -> Eff effs () -> Eff effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
result (forall (effs :: [* -> *]).
Member (Writer (Doc Void)) effs =>
Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void -> Eff effs ()) -> Doc Void -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ [Doc Void] -> Doc Void
forall ann. [Doc ann] -> Doc ann
vsep (Doc Void
"User log failed to validate:" Doc Void -> [Doc Void] -> [Doc Void]
forall a. a -> [a] -> [a]
: (EmulatorTimeEvent UserThreadMsg -> Doc Void)
-> [EmulatorTimeEvent UserThreadMsg] -> [Doc Void]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EmulatorTimeEvent UserThreadMsg -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty [EmulatorTimeEvent UserThreadMsg]
lg))
    Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
result

-- | Make an assertion about the accumulated state @w@ of
--   a contract instance.
assertAccumState ::
    forall contract w s e a.
    ( Monoid w
    , Show w
    , IsContract contract
    )
    => contract w s e a
    -> ContractInstanceTag
    -> (w -> Bool)
    -> String
    -> TracePredicate
assertAccumState :: contract w s e a
-> ContractInstanceTag -> (w -> Bool) -> String -> TracePredicate
assertAccumState contract w s e a
contract ContractInstanceTag
inst w -> Bool
p String
nm = (forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a.
(forall (effs :: [* -> *]).
 Members TestEffects effs =>
 FoldM (Eff effs) EmulatorEvent a)
-> TracePredicateF a
TracePredicate ((forall (effs :: [* -> *]).
  Members TestEffects effs =>
  FoldM (Eff effs) EmulatorEvent Bool)
 -> TracePredicate)
-> (forall (effs :: [* -> *]).
    Members TestEffects effs =>
    FoldM (Eff effs) EmulatorEvent Bool)
-> TracePredicate
forall a b. (a -> b) -> a -> b
$
    ((w -> Eff effs Bool)
 -> FoldM (Eff effs) EmulatorEvent w
 -> FoldM (Eff effs) EmulatorEvent Bool)
-> FoldM (Eff effs) EmulatorEvent w
-> (w -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (w -> Eff effs Bool)
-> FoldM (Eff effs) EmulatorEvent w
-> FoldM (Eff effs) EmulatorEvent Bool
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> FoldM m a b -> FoldM m a c
postMapM (Contract w s e a
-> ContractInstanceTag -> FoldM (Eff effs) EmulatorEvent w
forall w (s :: Row *) e a (effs :: [* -> *]).
(Member (Error EmulatorFoldErr) effs, Monoid w) =>
Contract w s e a
-> ContractInstanceTag -> EmulatorEventFoldM effs w
Folds.instanceAccumState (contract w s e a -> Contract w s e a
forall (c :: * -> Row * -> * -> * -> *) w (s :: Row *) e a.
IsContract c =>
c w s e a -> Contract w s e a
toContract contract w s e a
contract) ContractInstanceTag
inst) ((w -> Eff effs Bool) -> FoldM (Eff effs) EmulatorEvent Bool)
-> (w -> Eff effs Bool) -> FoldM (Eff effs) EmulatorEvent Bool
forall a b. (a -> b) -> a -> b
$ \w
w -> do
        let result :: Bool
result = w -> Bool
p w
w
        Bool -> Eff effs () -> Eff effs ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
result (Eff effs () -> Eff effs ()) -> Eff effs () -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ do
            forall (effs :: [* -> *]).
Member (Writer (Doc Void)) effs =>
Doc Void -> Eff effs ()
forall w (effs :: [* -> *]).
Member (Writer w) effs =>
w -> Eff effs ()
tell @(Doc Void) (Doc Void -> Eff effs ()) -> Doc Void -> Eff effs ()
forall a b. (a -> b) -> a -> b
$ [Doc Void] -> Doc Void
forall ann. [Doc ann] -> Doc ann
vsep
                [ Doc Void
"Accumulated state of" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ContractInstanceTag -> Doc Void
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceTag
inst Doc Void -> Doc Void -> Doc Void
forall a. Semigroup a => a -> a -> a
<> Doc Void
forall ann. Doc ann
colon
                , Int -> Doc Void -> Doc Void
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (w -> Doc Void
forall a ann. Show a => a -> Doc ann
viaShow w
w)
                , Doc Void
"Failed" Doc Void -> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Void -> Doc Void
forall ann. Doc ann -> Doc ann
squotes (String -> Doc Void
forall a. IsString a => String -> a
fromString String
nm)
                ]
        Bool -> Eff effs Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
result

-- | Assert that the size of a 'Validator' is below
--   the maximum.
reasonable :: PV1.Validator -> Integer -> HUnit.Assertion
reasonable :: Validator -> Integer -> IO ()
reasonable = (String -> IO ()) -> Validator -> Integer -> IO ()
reasonable' String -> IO ()
putStrLn

reasonable' :: (String -> IO ()) -> PV1.Validator -> Integer -> HUnit.Assertion
reasonable' :: (String -> IO ()) -> Validator -> Integer -> IO ()
reasonable' String -> IO ()
logger (Validator -> Script
Ledger.unValidatorScript -> Script
s) Integer
maxSize = do
    let sz :: Integer
sz = Script -> Integer
Ledger.scriptSize Script
s
        msg :: String
msg = String
"Script too big! Max. size: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
maxSize String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
". Actual size: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
sz
    -- so the actual size is visible in the log
    IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
logger (String
"Script size: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
sz)
    HasCallStack => String -> Bool -> IO ()
String -> Bool -> IO ()
HUnit.assertBool String
msg (Integer
sz Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
maxSize)

-- | Compare a golden PIR file to the provided 'CompiledCode'.
goldenPir :: FilePath -> CompiledCode a -> TestTree
goldenPir :: String -> CompiledCode a -> TestTree
goldenPir String
path CompiledCode a
code = String -> String -> IO ByteString -> TestTree
goldenVsString String
"PIR" String
path (ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String) -> Doc Any -> String
forall a b. (a -> b) -> a -> b
$ Program TyName Name DefaultUni DefaultFun () -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty (Program TyName Name DefaultUni DefaultFun () -> Doc Any)
-> Program TyName Name DefaultUni DefaultFun () -> Doc Any
forall a b. (a -> b) -> a -> b
$ Maybe (Program TyName Name DefaultUni DefaultFun ())
-> Program TyName Name DefaultUni DefaultFun ()
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Program TyName Name DefaultUni DefaultFun ())
 -> Program TyName Name DefaultUni DefaultFun ())
-> Maybe (Program TyName Name DefaultUni DefaultFun ())
-> Program TyName Name DefaultUni DefaultFun ()
forall a b. (a -> b) -> a -> b
$ CompiledCode a
-> Maybe (Program TyName Name DefaultUni DefaultFun ())
forall (uni :: * -> *) fun a.
(Closed uni, Everywhere uni Flat, Flat fun) =>
CompiledCodeIn uni fun a -> Maybe (Program TyName Name uni fun ())
getPir CompiledCode a
code)

w1, w2, w3, w4, w5, w6, w7, w8, w9, w10 :: Wallet
w1 :: Wallet
w1 = Integer -> Wallet
X.knownWallet Integer
1
w2 :: Wallet
w2 = Integer -> Wallet
X.knownWallet Integer
2
w3 :: Wallet
w3 = Integer -> Wallet
X.knownWallet Integer
3
w4 :: Wallet
w4 = Integer -> Wallet
X.knownWallet Integer
4
w5 :: Wallet
w5 = Integer -> Wallet
X.knownWallet Integer
5
w6 :: Wallet
w6 = Integer -> Wallet
X.knownWallet Integer
6
w7 :: Wallet
w7 = Integer -> Wallet
X.knownWallet Integer
7
w8 :: Wallet
w8 = Integer -> Wallet
X.knownWallet Integer
8
w9 :: Wallet
w9 = Integer -> Wallet
X.knownWallet Integer
9
w10 :: Wallet
w10 = Integer -> Wallet
X.knownWallet Integer
10