-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Mirrors 'Michelson.Test.Integrational' module in a Lorentz way.
module Lorentz.Test.Integrational
  (
    -- * Re-exports
    TxData (..)
  , genesisAddresses
  , genesisAddress
  -- * More genesis addresses which can be used in tests
  , genesisAddress1
  , genesisAddress2
  , genesisAddress3
  , genesisAddress4
  , genesisAddress5
  , genesisAddress6

    -- * Testing engine for bare Typed primitives
  , I.tOriginate
  , I.tTransfer
  , I.tExpectStorageConst

    -- * Testing engine
  , IntegrationalScenarioM
  , I.IntegrationalScenario
  , I.TestError (..)
  , I.integrationalTestExpectation
  , I.integrationalTestProp
  , lOriginate
  , lOriginateEmpty
  , lTransfer
  , lCall
  , lCallEP
  , EntryPointRef (..)
  , lCallDef
  , I.integrationalFail
  , I.unexpectedInterpreterError
  , I.setMaxSteps
  , I.setNow
  , I.rewindTime
  , I.withSender
  , I.setChainId
  , I.branchout
  , (I.?-)
  , I.offshoot

  -- * Validators
  , I.expectNoUpdates
  , I.expectNoStorageUpdates
  , lExpectStorageUpdate
  , lExpectBalance
  , lExpectStorage
  , lExpectStorageConst

  -- * Errors
  , I.attempt
  , I.expectError
  , I.catchExpectedError
  , lExpectMichelsonFailed
  , lExpectFailWith
  , lExpectError
  , lExpectErrorNumeric
  , lExpectCustomError
  , lExpectCustomErrorNumeric
  , lExpectCustomError_
  , lExpectCustomErrorNumeric_

  -- ** Consumer
  , lExpectConsumerStorage
  , lExpectViewConsumerStorage

  -- * Deprecated
  , I.integrationalTestProperty
  ) where

import Data.Constraint (Dict(..))
import Data.Typeable (gcast)
import Fmt (Buildable, listF, (+|), (|+))
import Named ((:!), arg)

import Lorentz.Constraints
import Lorentz.EntryPoints
import qualified Lorentz.Errors as L
import qualified Lorentz.Errors.Numeric as L
import Lorentz.Run
import Lorentz.Value
import qualified Lorentz.Value as L
import Michelson.Interpret (InterpretError(..), MichelsonFailed(..))
import Michelson.Runtime
import Michelson.Runtime.GState
import Michelson.Test.Integrational
import qualified Michelson.Test.Integrational as I
import Michelson.TypeCheck (typeCheckValue)
import qualified Michelson.Typed as T
import qualified Michelson.Untyped as U
import Tezos.Core
import Util.Named ((.!))

----------------------------------------------------------------------------
-- Interface
----------------------------------------------------------------------------

-- TODO: how to call they normally? :thinking:
-- Preserving just the same names like @transfer@ or @originate@
-- looks very bad because no one will import this or
-- 'Michelson.Test.Integrational' module qualified
-- and thus finding which exact function is used would become too painful.

-- | Like 'originate', but for Lorentz contracts.
lOriginate
  :: forall cp st.
     (NiceParameterFull cp, NiceStorage st)
  => Contract cp st
  -> Text
  -> st
  -> Mutez
  -> IntegrationalScenarioM (TAddress cp)
lOriginate :: Contract cp st
-> Text -> st -> Mutez -> IntegrationalScenarioM (TAddress cp)
lOriginate contract :: Contract cp st
contract name :: Text
name value :: st
value balance :: Mutez
balance =
  ((KnownValue cp,
  (KnownT (ToT cp), FailOnOperationFound (ContainsOp (ToT cp)),
   FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT cp))))
 :- ParameterScope (ToT cp))
-> (ParameterScope (ToT cp) =>
    IntegrationalScenarioM (TAddress cp))
-> IntegrationalScenarioM (TAddress cp)
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict ((KnownValue cp,
 (KnownT (ToT cp), FailOnOperationFound (ContainsOp (ToT cp)),
  FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT cp))))
:- ParameterScope (ToT cp)
forall a. NiceParameter a :- ParameterScope (ToT a)
niceParameterEvi @cp) ((ParameterScope (ToT cp) => IntegrationalScenarioM (TAddress cp))
 -> IntegrationalScenarioM (TAddress cp))
-> (ParameterScope (ToT cp) =>
    IntegrationalScenarioM (TAddress cp))
-> IntegrationalScenarioM (TAddress cp)
forall a b. (a -> b) -> a -> b
$
  ((KnownValue st,
  (KnownT (ToT st), FailOnOperationFound (ContainsOp (ToT st)),
   FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
   FailOnContractFound (ContainsContract (ToT st))))
 :- StorageScope (ToT st))
-> (StorageScope (ToT st) => IntegrationalScenarioM (TAddress cp))
-> IntegrationalScenarioM (TAddress cp)
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict ((KnownValue st,
 (KnownT (ToT st), FailOnOperationFound (ContainsOp (ToT st)),
  FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
  FailOnContractFound (ContainsContract (ToT st))))
:- StorageScope (ToT st)
forall a. NiceStorage a :- StorageScope (ToT a)
niceStorageEvi @st) ((StorageScope (ToT st) => IntegrationalScenarioM (TAddress cp))
 -> IntegrationalScenarioM (TAddress cp))
-> (StorageScope (ToT st) => IntegrationalScenarioM (TAddress cp))
-> IntegrationalScenarioM (TAddress cp)
forall a b. (a -> b) -> a -> b
$ do
    Address
addr <- Contract (ToT cp) (ToT st)
-> Text
-> Value (ToT st)
-> Mutez
-> IntegrationalScenarioM Address
forall (cp :: T) (st :: T).
(ParameterScope cp, StorageScope st) =>
Contract cp st
-> Text -> Value st -> Mutez -> IntegrationalScenarioM Address
I.tOriginate (Contract cp st -> Contract (ToT cp) (ToT st)
forall cp st.
(NiceParameterFull cp, NiceStorage st) =>
Contract cp st -> Contract (ToT cp) (ToT st)
compileLorentzContract Contract cp st
contract) Text
name (st -> Value (ToT st)
forall a. IsoValue a => a -> Value (ToT a)
T.toVal st
value) Mutez
balance
    return (Address -> TAddress cp
forall k (p :: k). Address -> TAddress p
L.TAddress Address
addr)

-- | Originate a contract with empty balance and default storage.
lOriginateEmpty
  :: (NiceParameterFull cp, NiceStorage st, Default st)
  => Contract cp st
  -> Text
  -> IntegrationalScenarioM (TAddress cp)
lOriginateEmpty :: Contract cp st -> Text -> IntegrationalScenarioM (TAddress cp)
lOriginateEmpty contract :: Contract cp st
contract name :: Text
name = Contract cp st
-> Text -> st -> Mutez -> IntegrationalScenarioM (TAddress cp)
forall cp st.
(NiceParameterFull cp, NiceStorage st) =>
Contract cp st
-> Text -> st -> Mutez -> IntegrationalScenarioM (TAddress cp)
lOriginate Contract cp st
contract Text
name st
forall a. Default a => a
def (HasCallStack => Word64 -> Mutez
Word64 -> Mutez
unsafeMkMutez 0)

-- | Similar to 'transfer', for Lorentz values.
lTransfer
  :: forall cp epRef epArg addr.
     (HasEntryPointArg cp epRef epArg, IsoValue epArg, ToTAddress cp addr)
  => "from" :! Address
  -> "to" :! addr
  -> Mutez
  -> epRef
  -> epArg
  -> IntegrationalScenarioM ()
lTransfer :: ("from" :! Address)
-> ("to" :! addr)
-> Mutez
-> epRef
-> epArg
-> IntegrationalScenarioM ()
lTransfer from :: "from" :! Address
from (forall a. ToTAddress cp a => a -> TAddress cp
forall cp a. ToTAddress cp a => a -> TAddress cp
toTAddress @cp (addr -> TAddress cp)
-> (("to" :! addr) -> addr) -> ("to" :! addr) -> TAddress cp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name "to" -> ("to" :! addr) -> addr
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "to" (Name "to")
Name "to"
#to -> TAddress to :: Address
to) money :: Mutez
money epRef :: epRef
epRef param :: epArg
param =
  case epRef -> (Dict (ParameterScope (ToT epArg)), EpName)
forall k (cp :: k) name arg.
HasEntryPointArg cp name arg =>
name -> (Dict (ParameterScope (ToT arg)), EpName)
useHasEntryPointArg @cp @epRef @epArg epRef
epRef of
    (Dict, epName :: EpName
epName) -> ("from" :! Address)
-> ("to" :! Address)
-> Mutez
-> EpName
-> Value (ToT epArg)
-> IntegrationalScenarioM ()
forall (arg :: T).
ParameterScope arg =>
("from" :! Address)
-> ("to" :! Address)
-> Mutez
-> EpName
-> Value arg
-> IntegrationalScenarioM ()
I.tTransfer "from" :! Address
from (IsLabel "to" (Name "to")
Name "to"
#to Name "to" -> Address -> "to" :! Address
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
.! Address
to) Mutez
money EpName
epName (epArg -> Value (ToT epArg)
forall a. IsoValue a => a -> Value (ToT a)
T.toVal epArg
param)

{-# DEPRECATED lCall "'lCall' will likely be replaced with 'lCallEP' in future version" #-}
-- | Legacy version of 'lCallEP' function. Calls default entrypoint of
-- a contract assuming its argument is the same as contract parameter
-- (which is equivalent to absence of explicit default entrypoint).
--
-- This function is DEPRECATED and exists only for backwards compatibility.
lCall
  :: forall cp defEpName addr.
     ( HasDefEntryPointArg cp defEpName cp
     , IsoValue cp
     , ToTAddress cp addr
     )
  => addr -> cp -> IntegrationalScenarioM ()
lCall :: addr -> cp -> IntegrationalScenarioM ()
lCall = (HasDefEntryPointArg cp defEpName cp, IsoValue cp,
 ToTAddress cp addr) =>
addr -> cp -> IntegrationalScenarioM ()
forall cp defEpName defArg addr.
(HasDefEntryPointArg cp defEpName defArg, IsoValue defArg,
 ToTAddress cp addr) =>
addr -> defArg -> IntegrationalScenarioM ()
lCallDef @cp @defEpName @cp @addr

-- | Call an entrypoint of a contract without caring about the source
-- address. Transfers 0 mutez.
lCallEP
  :: forall cp epRef epArg addr.
     (HasEntryPointArg cp epRef epArg, IsoValue epArg, ToTAddress cp addr)
  => addr -> epRef -> epArg -> IntegrationalScenarioM ()
lCallEP :: addr -> epRef -> epArg -> IntegrationalScenarioM ()
lCallEP addr :: addr
addr epRef :: epRef
epRef param :: epArg
param =
  ("from" :! Address)
-> ("to" :! addr)
-> Mutez
-> epRef
-> epArg
-> IntegrationalScenarioM ()
forall cp epRef epArg addr.
(HasEntryPointArg cp epRef epArg, IsoValue epArg,
 ToTAddress cp addr) =>
("from" :! Address)
-> ("to" :! addr)
-> Mutez
-> epRef
-> epArg
-> IntegrationalScenarioM ()
lTransfer @cp @epRef @epArg
    (IsLabel "from" (Name "from")
Name "from"
#from Name "from" -> Address -> "from" :! Address
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
.! Address
genesisAddress) (IsLabel "to" (Name "to")
Name "to"
#to Name "to" -> addr -> "to" :! addr
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
.! addr
addr)
    (HasCallStack => Word64 -> Mutez
Word64 -> Mutez
unsafeMkMutez 0) epRef
epRef epArg
param

-- | 'lCallEP' for default entrypoint.
lCallDef
  :: forall cp defEpName defArg addr.
     ( HasDefEntryPointArg cp defEpName defArg
     , IsoValue defArg
     , ToTAddress cp addr
     )
  => addr -> defArg -> IntegrationalScenarioM ()
lCallDef :: addr -> defArg -> IntegrationalScenarioM ()
lCallDef addr :: addr
addr =
  addr -> defEpName -> defArg -> IntegrationalScenarioM ()
forall cp epRef epArg addr.
(HasEntryPointArg cp epRef epArg, IsoValue epArg,
 ToTAddress cp addr) =>
addr -> epRef -> epArg -> IntegrationalScenarioM ()
lCallEP @cp @defEpName @defArg addr
addr defEpName
EntryPointRef 'Nothing
CallDefault

----------------------------------------------------------------------------
-- Validators to be used within 'IntegrationalValidator'
----------------------------------------------------------------------------

-- Expect something successful

-- | Internal function that proceeds storage validation from by untyping
-- the value passed to callback.
validateStorageCb
  :: forall st addr.
     (NiceStorage st, ToAddress addr, HasCallStack)
  => (Address -> (U.Value -> Either TestError ()) -> IntegrationalScenario)
  -> addr -> (st -> Either I.TestError ()) -> IntegrationalScenario
validateStorageCb :: (Address
 -> (Value -> Either TestError ()) -> IntegrationalScenarioM ())
-> addr -> (st -> Either TestError ()) -> IntegrationalScenarioM ()
validateStorageCb validator :: Address
-> (Value -> Either TestError ()) -> IntegrationalScenarioM ()
validator (addr -> Address
forall a. ToAddress a => a -> Address
toAddress -> Address
addr) predicate :: st -> Either TestError ()
predicate =
  Address
-> (Value -> Either TestError ()) -> IntegrationalScenarioM ()
validator Address
addr ((Value -> Either TestError ()) -> IntegrationalScenarioM ())
-> (Value -> Either TestError ()) -> IntegrationalScenarioM ()
forall a b. (a -> b) -> a -> b
$ \got :: Value
got -> do
    Value (ToT st)
val <- (TCError -> TestError)
-> Either TCError (Value (ToT st))
-> Either TestError (Value (ToT st))
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first TCError -> TestError
I.UnexpectedTypeCheckError (Either TCError (Value (ToT st))
 -> Either TestError (Value (ToT st)))
-> Either TCError (Value (ToT st))
-> Either TestError (Value (ToT st))
forall a b. (a -> b) -> a -> b
$ Value -> Either TCError (Value (ToT st))
forall (t :: T). SingI t => Value -> Either TCError (Value t)
typeCheck Value
got
    st -> Either TestError ()
predicate (st -> Either TestError ()) -> st -> Either TestError ()
forall a b. (a -> b) -> a -> b
$ Value (ToT st) -> st
forall a. IsoValue a => Value (ToT a) -> a
T.fromVal Value (ToT st)
val
  where
    typeCheck :: Value -> Either TCError (Value t)
typeCheck uval :: Value
uval =
      TypeCheckEnv
-> State TypeCheckEnv (Either TCError (Value t))
-> Either TCError (Value t)
forall s a. s -> State s a -> a
evaluatingState TypeCheckEnv
forall a. a
initSt (State TypeCheckEnv (Either TCError (Value t))
 -> Either TCError (Value t))
-> (ExceptT TCError (StateT TypeCheckEnv Identity) (Value t)
    -> State TypeCheckEnv (Either TCError (Value t)))
-> ExceptT TCError (StateT TypeCheckEnv Identity) (Value t)
-> Either TCError (Value t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT TCError (StateT TypeCheckEnv Identity) (Value t)
-> State TypeCheckEnv (Either TCError (Value t))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT TCError (StateT TypeCheckEnv Identity) (Value t)
 -> Either TCError (Value t))
-> ExceptT TCError (StateT TypeCheckEnv Identity) (Value t)
-> Either TCError (Value t)
forall a b. (a -> b) -> a -> b
$
      InstrCallStack
-> ReaderT InstrCallStack TypeCheck (Value t)
-> ExceptT TCError (StateT TypeCheckEnv Identity) (Value t)
forall r (m :: * -> *) a. r -> ReaderT r m a -> m a
usingReaderT InstrCallStack
forall a. Default a => a
def (ReaderT InstrCallStack TypeCheck (Value t)
 -> ExceptT TCError (StateT TypeCheckEnv Identity) (Value t))
-> ReaderT InstrCallStack TypeCheck (Value t)
-> ExceptT TCError (StateT TypeCheckEnv Identity) (Value t)
forall a b. (a -> b) -> a -> b
$
      Value -> ReaderT InstrCallStack TypeCheck (Value t)
forall (t :: T). SingI t => Value -> TypeCheckInstr (Value t)
typeCheckValue Value
uval
    initSt :: a
initSt = Text -> a
forall a. HasCallStack => Text -> a
error "Typechecker state unavailable"

-- | Similar to 'expectStorage', but for Lorentz values.
lExpectStorage
  :: forall st addr.
     (NiceStorage st, ToAddress addr, HasCallStack)
  => addr -> (st -> Either I.TestError ()) -> IntegrationalScenario
lExpectStorage :: addr -> (st -> Either TestError ()) -> IntegrationalScenarioM ()
lExpectStorage = (Address
 -> (Value -> Either TestError ()) -> IntegrationalScenarioM ())
-> addr -> (st -> Either TestError ()) -> IntegrationalScenarioM ()
forall st addr.
(NiceStorage st, ToAddress addr, HasCallStack) =>
(Address
 -> (Value -> Either TestError ()) -> IntegrationalScenarioM ())
-> addr -> (st -> Either TestError ()) -> IntegrationalScenarioM ()
validateStorageCb Address
-> (Value -> Either TestError ()) -> IntegrationalScenarioM ()
I.expectStorage

-- | Similar to 'expectStorageUpdate', but for Lorentz values.
lExpectStorageUpdate
  :: forall st addr.
     (NiceStorage st, ToAddress addr, HasCallStack)
  => addr -> (st -> Either I.TestError ()) -> IntegrationalScenario
lExpectStorageUpdate :: addr -> (st -> Either TestError ()) -> IntegrationalScenarioM ()
lExpectStorageUpdate = (Address
 -> (Value -> Either TestError ()) -> IntegrationalScenarioM ())
-> addr -> (st -> Either TestError ()) -> IntegrationalScenarioM ()
forall st addr.
(NiceStorage st, ToAddress addr, HasCallStack) =>
(Address
 -> (Value -> Either TestError ()) -> IntegrationalScenarioM ())
-> addr -> (st -> Either TestError ()) -> IntegrationalScenarioM ()
validateStorageCb Address
-> (Value -> Either TestError ()) -> IntegrationalScenarioM ()
I.expectStorageUpdate

-- | Like 'expectBalance', for Lorentz values.
lExpectBalance :: ToAddress addr => addr -> Mutez -> IntegrationalScenario
lExpectBalance :: addr -> Mutez -> IntegrationalScenarioM ()
lExpectBalance (addr -> Address
forall a. ToAddress a => a -> Address
toAddress -> Address
addr) money :: Mutez
money = Address -> Mutez -> IntegrationalScenarioM ()
I.expectBalance Address
addr Mutez
money

-- | Similar to 'expectStorageConst', for Lorentz values.
lExpectStorageConst
  :: forall st addr.
     (NiceStorage st, ToAddress addr)
  => addr -> st -> IntegrationalScenario
lExpectStorageConst :: addr -> st -> IntegrationalScenarioM ()
lExpectStorageConst (addr -> Address
forall a. ToAddress a => a -> Address
toAddress -> Address
addr) expected :: st
expected =
  ((KnownValue st,
  (KnownT (ToT st), FailOnOperationFound (ContainsOp (ToT st)),
   FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
   FailOnContractFound (ContainsContract (ToT st))))
 :- StorageScope (ToT st))
-> (StorageScope (ToT st) => IntegrationalScenarioM ())
-> IntegrationalScenarioM ()
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict ((KnownValue st,
 (KnownT (ToT st), FailOnOperationFound (ContainsOp (ToT st)),
  FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
  FailOnContractFound (ContainsContract (ToT st))))
:- StorageScope (ToT st)
forall a. NiceStorage a :- StorageScope (ToT a)
niceStorageEvi @st) ((StorageScope (ToT st) => IntegrationalScenarioM ())
 -> IntegrationalScenarioM ())
-> (StorageScope (ToT st) => IntegrationalScenarioM ())
-> IntegrationalScenarioM ()
forall a b. (a -> b) -> a -> b
$
    Address -> Value (ToT st) -> IntegrationalScenarioM ()
forall (st :: T).
StorageScope st =>
Address -> Value st -> IntegrationalScenarioM ()
I.tExpectStorageConst Address
addr (st -> Value (ToT st)
forall a. IsoValue a => a -> Value (ToT a)
T.toVal st
expected)

-- Expect errors

-- | Expect that interpretation of contract with given address ended
-- with [FAILED].
lExpectMichelsonFailed
  :: forall addr. (ToAddress addr)
  => (MichelsonFailed -> Bool) -> addr -> ExecutorError -> IntegrationalScenario
lExpectMichelsonFailed :: (MichelsonFailed -> Bool)
-> addr -> ExecutorError -> IntegrationalScenarioM ()
lExpectMichelsonFailed predicate :: MichelsonFailed -> Bool
predicate (addr -> Address
forall a. ToAddress a => a -> Address
toAddress -> Address
addr) =
  (MichelsonFailed -> Bool)
-> Address -> ExecutorError -> IntegrationalScenarioM ()
I.expectMichelsonFailed MichelsonFailed -> Bool
predicate Address
addr

-- | Expect contract to fail with "FAILWITH" instruction and provided value
-- to match against the given predicate.
lExpectFailWith
  :: forall e.
      (T.IsoValue e)
  => (e -> Bool) -> ExecutorError -> IntegrationalScenario
lExpectFailWith :: (e -> Bool) -> ExecutorError -> IntegrationalScenarioM ()
lExpectFailWith predicate :: e -> Bool
predicate err :: ExecutorError
err =
  case ExecutorError
err of
    EEInterpreterFailed _ (RuntimeFailure (MichelsonFailedWith errVal :: Value t
errVal, _)) ->
        case Value t -> Maybe (Value' Instr (ToT e))
forall k (a :: k) (b :: k) (c :: k -> *).
(Typeable a, Typeable b) =>
c a -> Maybe (c b)
gcast Value t
errVal of
          Just errT :: Value' Instr (ToT e)
errT | e -> Bool
predicate (e -> Bool) -> e -> Bool
forall a b. (a -> b) -> a -> b
$ Value' Instr (ToT e) -> e
forall a. IsoValue a => Value (ToT a) -> a
T.fromVal @e Value' Instr (ToT e)
errT -> IntegrationalScenarioM ()
forall (f :: * -> *). Applicative f => f ()
pass
                    | Bool
otherwise ->  ExecutorError -> Text -> IntegrationalScenarioM ()
forall a. ExecutorError -> Text -> IntegrationalScenarioM a
unexpectedInterpreterError ExecutorError
err "predicate failed"
          Nothing -> ExecutorError -> Text -> IntegrationalScenarioM ()
forall a. ExecutorError -> Text -> IntegrationalScenarioM a
unexpectedInterpreterError ExecutorError
err "failed to cast error"
    _ -> ExecutorError -> Text -> IntegrationalScenarioM ()
forall a. ExecutorError -> Text -> IntegrationalScenarioM a
unexpectedInterpreterError ExecutorError
err "expected runtime failure with `FAILWITH`"

-- | Expect contract to fail with given error.
lExpectError
  :: forall e.
      (L.IsError e)
  => (e -> Bool) -> ExecutorError -> IntegrationalScenario
lExpectError :: (e -> Bool) -> ExecutorError -> IntegrationalScenarioM ()
lExpectError = (forall (t :: T). KnownT t => Value t -> Either Text e)
-> (e -> Bool) -> ExecutorError -> IntegrationalScenarioM ()
forall e.
(forall (t :: T). KnownT t => Value t -> Either Text e)
-> (e -> Bool) -> ExecutorError -> IntegrationalScenarioM ()
lExpectError' forall e (t :: T).
(IsError e, KnownT t) =>
Value t -> Either Text e
forall (t :: T). KnownT t => Value t -> Either Text e
L.errorFromVal

-- | Version of 'lExpectError' for the case when numeric
-- representation of errors is used.
lExpectErrorNumeric
  :: forall e.
      (L.IsError e)
  => L.ErrorTagMap -> (e -> Bool) -> ExecutorError -> IntegrationalScenario
lExpectErrorNumeric :: ErrorTagMap
-> (e -> Bool) -> ExecutorError -> IntegrationalScenarioM ()
lExpectErrorNumeric errorTagMap :: ErrorTagMap
errorTagMap =
  (forall (t :: T). KnownT t => Value t -> Either Text e)
-> (e -> Bool) -> ExecutorError -> IntegrationalScenarioM ()
forall e.
(forall (t :: T). KnownT t => Value t -> Either Text e)
-> (e -> Bool) -> ExecutorError -> IntegrationalScenarioM ()
lExpectError' (ErrorTagMap -> Value t -> Either Text e
forall (t :: T) e.
(KnownT t, IsError e) =>
ErrorTagMap -> Value t -> Either Text e
L.errorFromValNumeric ErrorTagMap
errorTagMap)

lExpectError' ::
     forall e.
     (forall t. T.KnownT t => Value t -> Either Text e)
  -> (e -> Bool)
  -> ExecutorError
  -> IntegrationalScenario
lExpectError' :: (forall (t :: T). KnownT t => Value t -> Either Text e)
-> (e -> Bool) -> ExecutorError -> IntegrationalScenarioM ()
lExpectError' errorFromValImpl :: forall (t :: T). KnownT t => Value t -> Either Text e
errorFromValImpl predicate :: e -> Bool
predicate err :: ExecutorError
err =
  case ExecutorError
err of
    EEInterpreterFailed _ (RuntimeFailure (MichelsonFailedWith errVal :: Value t
errVal, _)) ->
      case Value t -> Either Text e
forall (t :: T). KnownT t => Value t -> Either Text e
errorFromValImpl Value t
errVal of
        Right err' :: e
err' | e -> Bool
predicate e
err' -> IntegrationalScenarioM ()
forall (f :: * -> *). Applicative f => f ()
pass
                   | Bool
otherwise -> ExecutorError -> Text -> IntegrationalScenarioM ()
forall a. ExecutorError -> Text -> IntegrationalScenarioM a
unexpectedInterpreterError ExecutorError
err "predicate failed"
        Left reason :: Text
reason -> ExecutorError -> Text -> IntegrationalScenarioM ()
forall a. ExecutorError -> Text -> IntegrationalScenarioM a
unexpectedInterpreterError ExecutorError
err Text
reason
    _ -> ExecutorError -> Text -> IntegrationalScenarioM ()
forall a. ExecutorError -> Text -> IntegrationalScenarioM a
unexpectedInterpreterError ExecutorError
err "expected runtime failure with `FAILWITH`"

-- | Expect contract to fail with given 'CustomError'.
lExpectCustomError
  :: forall tag arg.
      (L.IsError (L.CustomError tag), arg ~ L.ErrorArg tag, Eq arg)
  => Label tag -> arg -> ExecutorError -> IntegrationalScenario
lExpectCustomError :: Label tag -> arg -> ExecutorError -> IntegrationalScenarioM ()
lExpectCustomError l :: Label tag
l a :: arg
a =
  (CustomError tag -> Bool)
-> ExecutorError -> IntegrationalScenarioM ()
forall e.
IsError e =>
(e -> Bool) -> ExecutorError -> IntegrationalScenarioM ()
lExpectError (CustomError tag -> CustomError tag -> Bool
forall a. Eq a => a -> a -> Bool
== Label tag -> ErrorArg tag -> CustomError tag
forall (tag :: Symbol).
Label tag -> ErrorArg tag -> CustomError tag
L.CustomError Label tag
l arg
ErrorArg tag
a)

-- | Version of 'lExpectCustomError' for the case when numeric
-- representation of errors is used.
lExpectCustomErrorNumeric
  :: forall tag arg.
      (L.IsError (L.CustomError tag), arg ~ L.ErrorArg tag, Eq arg)
  => L.ErrorTagMap -> Label tag -> arg -> ExecutorError -> IntegrationalScenario
lExpectCustomErrorNumeric :: ErrorTagMap
-> Label tag -> arg -> ExecutorError -> IntegrationalScenarioM ()
lExpectCustomErrorNumeric errorTagMap :: ErrorTagMap
errorTagMap l :: Label tag
l a :: arg
a =
  ErrorTagMap
-> (CustomError tag -> Bool)
-> ExecutorError
-> IntegrationalScenarioM ()
forall e.
IsError e =>
ErrorTagMap
-> (e -> Bool) -> ExecutorError -> IntegrationalScenarioM ()
lExpectErrorNumeric ErrorTagMap
errorTagMap (CustomError tag -> CustomError tag -> Bool
forall a. Eq a => a -> a -> Bool
== Label tag -> ErrorArg tag -> CustomError tag
forall (tag :: Symbol).
Label tag -> ErrorArg tag -> CustomError tag
L.CustomError Label tag
l arg
ErrorArg tag
a)

-- | Specialization of 'lExpectCustomError' for non-arg error case.
lExpectCustomError_
  :: forall tag.
      (L.IsError (L.CustomError tag), L.ErrorArg tag ~ ())
  => Label tag -> ExecutorError -> IntegrationalScenario
lExpectCustomError_ :: Label tag -> ExecutorError -> IntegrationalScenarioM ()
lExpectCustomError_ l :: Label tag
l =
  Label tag -> () -> ExecutorError -> IntegrationalScenarioM ()
forall (tag :: Symbol) arg.
(IsError (CustomError tag), arg ~ ErrorArg tag, Eq arg) =>
Label tag -> arg -> ExecutorError -> IntegrationalScenarioM ()
lExpectCustomError Label tag
l ()

-- | Version of 'lExpectCustomError_' for the case when numeric
-- representation of errors is used.
lExpectCustomErrorNumeric_
  :: forall tag.
      (L.IsError (L.CustomError tag), L.ErrorArg tag ~ ())
  => L.ErrorTagMap -> Label tag -> ExecutorError -> IntegrationalScenario
lExpectCustomErrorNumeric_ :: ErrorTagMap
-> Label tag -> ExecutorError -> IntegrationalScenarioM ()
lExpectCustomErrorNumeric_ errorTagMap :: ErrorTagMap
errorTagMap l :: Label tag
l =
  ErrorTagMap
-> Label tag -> () -> ExecutorError -> IntegrationalScenarioM ()
forall (tag :: Symbol) arg.
(IsError (CustomError tag), arg ~ ErrorArg tag, Eq arg) =>
ErrorTagMap
-> Label tag -> arg -> ExecutorError -> IntegrationalScenarioM ()
lExpectCustomErrorNumeric ErrorTagMap
errorTagMap Label tag
l ()

-- Consumer

-- | Version of 'lExpectStorageUpdate' specialized to "consumer" contract
-- (see 'Lorentz.Contracts.Consumer.contractConsumer').
lExpectConsumerStorage
  :: forall cp st addr.
     (st ~ [cp], NiceStorage st, ToTAddress cp addr)
  => addr -> (st -> Either I.TestError ()) -> IntegrationalScenario
lExpectConsumerStorage :: addr -> (st -> Either TestError ()) -> IntegrationalScenarioM ()
lExpectConsumerStorage addr :: addr
addr = TAddress cp
-> (st -> Either TestError ()) -> IntegrationalScenarioM ()
forall st addr.
(NiceStorage st, ToAddress addr, HasCallStack) =>
addr -> (st -> Either TestError ()) -> IntegrationalScenarioM ()
lExpectStorageUpdate (addr -> TAddress cp
forall cp a. ToTAddress cp a => a -> TAddress cp
toTAddress @cp addr
addr)

-- | Assuming that "consumer" contract receives a value from 'View', expect
-- this view return value to be the given one.
--
-- Despite consumer stores parameters it was called with in reversed order,
-- this function cares about it, so you should provide a list of expected values
-- in the same order in which the corresponding events were happenning.
lExpectViewConsumerStorage
  :: ( st ~ [cp]
     , Eq cp, Buildable cp
     , NiceStorage st
     , ToTAddress cp addr
     )
  => addr -> [cp] -> IntegrationalScenario
lExpectViewConsumerStorage :: addr -> [cp] -> IntegrationalScenarioM ()
lExpectViewConsumerStorage addr :: addr
addr expected :: [cp]
expected =
  addr -> ([cp] -> Either TestError ()) -> IntegrationalScenarioM ()
forall cp st addr.
(st ~ [cp], NiceStorage st, ToTAddress cp addr) =>
addr -> (st -> Either TestError ()) -> IntegrationalScenarioM ()
lExpectConsumerStorage addr
addr ([cp] -> Either TestError ()
matchExpected ([cp] -> Either TestError ())
-> ([cp] -> [cp]) -> [cp] -> Either TestError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [cp] -> [cp]
forall a. [a] -> [a]
reverse)
  where
    mkError :: Text -> Either TestError b
mkError = TestError -> Either TestError b
forall a b. a -> Either a b
Left (TestError -> Either TestError b)
-> (Text -> TestError) -> Text -> Either TestError b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> TestError
I.CustomTestError
    matchExpected :: [cp] -> Either TestError ()
matchExpected got :: [cp]
got
      | [cp]
got [cp] -> [cp] -> Bool
forall a. Eq a => a -> a -> Bool
== [cp]
expected = Either TestError ()
forall (f :: * -> *). Applicative f => f ()
pass
      | Bool
otherwise = Text -> Either TestError ()
forall b. Text -> Either TestError b
mkError (Text -> Either TestError ()) -> Text -> Either TestError ()
forall a b. (a -> b) -> a -> b
$ "Expected " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| [cp] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
listF [cp]
expected Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+
                              ", but got " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| [cp] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
listF [cp]
got Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""