{-# OPTIONS_GHC -Wno-deprecations #-}

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

-- | Utilities for integrational testing.
-- Example tests can be found in the 'morley-test' test suite.

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

  -- * Testing engine
  , IntegrationalScenarioM
  , IntegrationalScenario
  , TestError (..)
  , integrationalTestExpectation
  , integrationalTestProp
  , originate
  , tOriginate
  , transfer
  , tTransfer
  , integrationalFail
  , unexpectedInterpreterError
  , setMaxSteps
  , modifyNow
  , setNow
  , rewindTime
  , withSender
  , setChainId
  , branchout
  , (?-)
  , offshoot

  -- * Validators
  , expectNoUpdates
  , expectNoStorageUpdates
  , expectStorageUpdate
  , expectStorageUpdateConst
  , expectBalance
  , expectStorage
  , expectStorageConst
  , tExpectStorageConst

  -- * Errors
  , attempt
  , expectError
  , catchExpectedError
  , expectGasExhaustion
  , expectMichelsonFailed

  -- * Lenses
  , isGState

  -- * Deprecated
  , integrationalTestProperty
  ) where

import Control.Lens (assign, at, makeLenses, makeLensesFor, modifying, (%=), (.=), (<>=), (?=))
import Control.Monad.Except (Except, catchError, runExcept, throwError, withExcept)
import qualified Data.List as List
import Data.Map as Map (empty, insert, lookup)
import Fmt (Buildable(..), blockListF, listF, pretty, (+|), (|+))
import Hedgehog (MonadTest)
import Named ((:!), arg)
import Test.Hspec (Expectation, expectationFailure)
import qualified Test.QuickCheck as QC

import Michelson.Interpret (InterpretError(..), MichelsonFailed(..), RemainingSteps)
import Michelson.Runtime
  (ExecutorError, ExecutorError'(..), ExecutorM, ExecutorOp(..), ExecutorRes(..),
  executeGlobalOperations, executeOrigination, runExecutorM, withGlobalOperation)
import Michelson.Runtime.GState
import Michelson.Runtime.TxData
import Michelson.Test.Dummy
import Michelson.Test.Util (failedProp, failedTest, succeededProp, succeededTest)
import Michelson.TypeCheck (TCError)
import qualified Michelson.Typed as Typed
import Michelson.Typed.Scope (ParameterScope, StorageScope, properParameterEvi, withDict)
import Michelson.Untyped (Contract, EpName, OriginationOperation(..), Value)
import Tezos.Address (Address)
import Tezos.Core (ChainId, Mutez, Timestamp, timestampPlusSeconds, unsafeMkMutez)

----------------------------------------------------------------------------
-- Some internals (they are here because TH makes our very existence much harder)
----------------------------------------------------------------------------

-- | A result of an executed operation.
type ExecutorResOrError a = Either ExecutorError (ExecutorRes, a)
type ExecutorResOrError' = Either ExecutorError ExecutorRes

data InternalState = InternalState
  { InternalState -> RemainingSteps
_isMaxSteps :: RemainingSteps
  , InternalState -> Timestamp
_isNow :: Timestamp
  , InternalState -> GState
_isGState :: GState
  , InternalState -> [ExecutorResOrError']
_isInterpreterLog :: [ExecutorResOrError']
  -- ^ Store result of interpreted operations as they added.
  , InternalState -> Maybe ExecutorRes
_isExecutorResult :: Maybe ExecutorRes
  -- ^ Store the most recent result of interpreted operations.
  , InternalState -> Map Address Text
_isContractsNames :: Map Address Text
  -- ^ Map from contracts addresses to humanreadable names.
  , InternalState -> Maybe Address
_isSender :: Maybe Address
  -- ^ If set, all following transfers will be executed on behalf
  -- of the given contract.
  }

makeLenses ''InternalState

-- | When using 'branch' function for building test scenarios - names
-- of branches we are currently within.
newtype ScenarioBranchName = ScenarioBranchName { ScenarioBranchName -> [Text]
unTestBranch :: [Text] }

instance Buildable ScenarioBranchName where
  build :: ScenarioBranchName -> Builder
build = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (ScenarioBranchName -> [Builder])
-> ScenarioBranchName
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse "/" ([Builder] -> [Builder])
-> (ScenarioBranchName -> [Builder])
-> ScenarioBranchName
-> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Builder) -> [Text] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> Builder
forall p. Buildable p => p -> Builder
build ([Text] -> [Builder])
-> (ScenarioBranchName -> [Text])
-> ScenarioBranchName
-> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioBranchName -> [Text]
unTestBranch

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

-- | A monad inside which integrational tests can be described using
-- do-notation.
type IntegrationalScenarioM = StateT InternalState (Except ScenarioError)

type IntegrationalScenario = IntegrationalScenarioM ()

newtype ExpectedStorage = ExpectedStorage Value deriving stock (Int -> ExpectedStorage -> ShowS
[ExpectedStorage] -> ShowS
ExpectedStorage -> String
(Int -> ExpectedStorage -> ShowS)
-> (ExpectedStorage -> String)
-> ([ExpectedStorage] -> ShowS)
-> Show ExpectedStorage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpectedStorage] -> ShowS
$cshowList :: [ExpectedStorage] -> ShowS
show :: ExpectedStorage -> String
$cshow :: ExpectedStorage -> String
showsPrec :: Int -> ExpectedStorage -> ShowS
$cshowsPrec :: Int -> ExpectedStorage -> ShowS
Show)
newtype ExpectedBalance = ExpectedBalance Mutez deriving stock (Int -> ExpectedBalance -> ShowS
[ExpectedBalance] -> ShowS
ExpectedBalance -> String
(Int -> ExpectedBalance -> ShowS)
-> (ExpectedBalance -> String)
-> ([ExpectedBalance] -> ShowS)
-> Show ExpectedBalance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpectedBalance] -> ShowS
$cshowList :: [ExpectedBalance] -> ShowS
show :: ExpectedBalance -> String
$cshow :: ExpectedBalance -> String
showsPrec :: Int -> ExpectedBalance -> ShowS
$cshowsPrec :: Int -> ExpectedBalance -> ShowS
Show)

data AddressName = AddressName (Maybe Text) Address deriving stock (Int -> AddressName -> ShowS
[AddressName] -> ShowS
AddressName -> String
(Int -> AddressName -> ShowS)
-> (AddressName -> String)
-> ([AddressName] -> ShowS)
-> Show AddressName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressName] -> ShowS
$cshowList :: [AddressName] -> ShowS
show :: AddressName -> String
$cshow :: AddressName -> String
showsPrec :: Int -> AddressName -> ShowS
$cshowsPrec :: Int -> AddressName -> ShowS
Show)

addrToAddrName :: Address -> InternalState -> AddressName
addrToAddrName :: Address -> InternalState -> AddressName
addrToAddrName addr :: Address
addr iState :: InternalState
iState =
  Maybe Text -> Address -> AddressName
AddressName (Address -> Map Address Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
lookup Address
addr (InternalState
iState InternalState
-> Getting (Map Address Text) InternalState (Map Address Text)
-> Map Address Text
forall s a. s -> Getting a s a -> a
^. Getting (Map Address Text) InternalState (Map Address Text)
Lens' InternalState (Map Address Text)
isContractsNames)) Address
addr

addrNameToAddr :: AddressName -> Address
addrNameToAddr :: AddressName -> Address
addrNameToAddr (AddressName _ addr :: Address
addr) = Address
addr

instance Buildable AddressName where
  build :: AddressName -> Builder
build (AddressName mbName :: Maybe Text
mbName addr :: Address
addr) =
    Address -> Builder
forall p. Buildable p => p -> Builder
build Address
addr Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder -> (Text -> Builder) -> Maybe Text -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (\cName :: Text
cName -> " (" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|Text
cName Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ")") Maybe Text
mbName

type IntegrationalExecutorError = ExecutorError' AddressName

data TestError
  = InterpreterError IntegrationalExecutorError
  | UnexpectedInterpreterError Text IntegrationalExecutorError
  | UnexpectedTypeCheckError TCError
  | ExpectingInterpreterToFail
  | IncorrectUpdates TestError [GStateUpdate]
  | IncorrectStorageUpdate AddressName Text
  | InvalidStorage AddressName ExpectedStorage Text
  | StoragePredicateMismatch AddressName Text
  | InvalidBalance AddressName ExpectedBalance Text
  | UnexpectedUpdates (NonEmpty GStateUpdate)
  | ValidatingEmptyScenario
  | CustomTestError Text
  deriving stock (Int -> TestError -> ShowS
[TestError] -> ShowS
TestError -> String
(Int -> TestError -> ShowS)
-> (TestError -> String)
-> ([TestError] -> ShowS)
-> Show TestError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestError] -> ShowS
$cshowList :: [TestError] -> ShowS
show :: TestError -> String
$cshow :: TestError -> String
showsPrec :: Int -> TestError -> ShowS
$cshowsPrec :: Int -> TestError -> ShowS
Show)

instance Buildable TestError where
  build :: TestError -> Builder
build (InterpreterError iErr :: IntegrationalExecutorError
iErr) =
    "Interpreter failed: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| IntegrationalExecutorError
iErr IntegrationalExecutorError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
  build (UnexpectedInterpreterError reason :: Text
reason iErr :: IntegrationalExecutorError
iErr) =
    "Unexpected interpreter error. Reason: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
reason Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ". Got: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| IntegrationalExecutorError
iErr IntegrationalExecutorError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
  build (UnexpectedTypeCheckError tcErr :: TCError
tcErr) =
    "Unexpected type check error. Reason: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| TCError
tcErr TCError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
  build ExpectingInterpreterToFail =
    "Interpreter unexpectedly didn't fail"
  build (IncorrectUpdates vErr :: TestError
vErr updates :: [GStateUpdate]
updates) =
    "Updates are incorrect: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| TestError
vErr TestError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ " . Updates are:"
    Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| [GStateUpdate] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
blockListF [GStateUpdate]
updates Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
  build (IncorrectStorageUpdate addr :: AddressName
addr msg :: Text
msg) =
    "Storage of " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| AddressName
addr AddressName -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ " is updated incorrectly: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
msg Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
  build (InvalidStorage addr :: AddressName
addr (ExpectedStorage expected :: Value
expected) msg :: Text
msg) =
    "Expected " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| AddressName
addr AddressName -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ " to have storage " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Value
expected Value -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ", but " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
msg Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
  build (StoragePredicateMismatch addr :: AddressName
addr msg :: Text
msg) =
    "Expected " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| AddressName
addr AddressName -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ " to have storage that matches the predicate, but" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
msg Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
  build (InvalidBalance addr :: AddressName
addr (ExpectedBalance expected :: Mutez
expected) msg :: Text
msg) =
    "Expected " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| AddressName
addr AddressName -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ " to have balance " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
expected Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ", but " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
msg Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
  build (UnexpectedUpdates updates :: NonEmpty GStateUpdate
updates) =
    "Did not expect certain updates, but there are some: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| NonEmpty GStateUpdate -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
listF NonEmpty GStateUpdate
updates Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
  build ValidatingEmptyScenario =
    "Validating empty scenario"
  build (CustomTestError msg :: Text
msg) = Text -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Text
msg

instance Exception TestError where
  displayException :: TestError -> String
displayException = TestError -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty

-- | Overall information about test scenario error.
data ScenarioError = ScenarioError
  { ScenarioError -> ScenarioBranchName
_seBranch :: ScenarioBranchName
  , ScenarioError -> TestError
_seError :: TestError
  }

makeLensesFor [("_seBranch", "seBranch")] ''ScenarioError

instance Buildable ScenarioError where
  build :: ScenarioError -> Builder
build (ScenarioError br :: ScenarioBranchName
br err :: TestError
err) =
    let builtBranch :: Builder
builtBranch
          | ScenarioBranchName -> Bool
nullScenarioBranch ScenarioBranchName
br = ""
          | Bool
otherwise = "In '" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ScenarioBranchName
br ScenarioBranchName -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ "' branch:\n"
    in Builder
builtBranch Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TestError -> Builder
forall p. Buildable p => p -> Builder
build TestError
err

-- | Integrational test that executes given operations and validates
-- them. It can fail using 'Expectation' capability.
-- It starts with 'initGState' and some reasonable dummy values for
-- gas limit and current timestamp. You can update blockchain state
-- by performing some operations.
integrationalTestExpectation
  :: HasCallStack
  => IntegrationalScenario -> Expectation
integrationalTestExpectation :: IntegrationalScenario -> Expectation
integrationalTestExpectation =
  (Maybe ScenarioError -> Expectation)
-> IntegrationalScenario -> Expectation
forall res.
(Maybe ScenarioError -> res) -> IntegrationalScenario -> res
integrationalTest (Expectation
-> (ScenarioError -> Expectation)
-> Maybe ScenarioError
-> Expectation
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expectation
forall (f :: * -> *). Applicative f => f ()
pass (HasCallStack => String -> Expectation
String -> Expectation
expectationFailure (String -> Expectation)
-> (ScenarioError -> String) -> ScenarioError -> Expectation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioError -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty))

-- | Integrational test similar to 'integrationalTestExpectation'.
-- It can fail using 'QC.Property' capability.
-- It can be used with QuickCheck's @forAll@ to make a
-- property-based test with arbitrary data.
integrationalTestProperty :: IntegrationalScenario -> QC.Property
integrationalTestProperty :: IntegrationalScenario -> Property
integrationalTestProperty =
  (Maybe ScenarioError -> Property)
-> IntegrationalScenario -> Property
forall res.
(Maybe ScenarioError -> res) -> IntegrationalScenario -> res
integrationalTest (Property
-> (ScenarioError -> Property) -> Maybe ScenarioError -> Property
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Property
succeededProp (Text -> Property
failedProp (Text -> Property)
-> (ScenarioError -> Text) -> ScenarioError -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioError -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty))
{-# DEPRECATED integrationalTestProperty "Use 'integrationalTestProp' instead." #-}

-- | Integrational test similar to 'integrationalTestExpectation'.
-- It can fail using 'Property' capability.
-- It can be used with Hedgehog's @forAll@ to make a
-- property-based test with arbitrary data.
integrationalTestProp :: MonadTest m => IntegrationalScenario -> m ()
integrationalTestProp :: IntegrationalScenario -> m ()
integrationalTestProp scenario :: IntegrationalScenario
scenario =
  (Maybe ScenarioError -> m ()) -> IntegrationalScenario -> m ()
forall res.
(Maybe ScenarioError -> res) -> IntegrationalScenario -> res
integrationalTest (m () -> (ScenarioError -> m ()) -> Maybe ScenarioError -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m ()
forall (m :: * -> *). MonadTest m => m ()
succeededTest (Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadTest m) => Text -> m ()
failedTest (Text -> m ()) -> (ScenarioError -> Text) -> ScenarioError -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioError -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty)) IntegrationalScenario
scenario

-- | Helper function which provides the results of the given operations.
interpret :: ExecutorM a -> IntegrationalScenarioM (ExecutorResOrError a)
interpret :: ExecutorM a -> IntegrationalScenarioM (ExecutorResOrError a)
interpret action :: ExecutorM a
action = do
  Timestamp
now <- Getting Timestamp InternalState Timestamp
-> StateT InternalState (Except ScenarioError) Timestamp
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Timestamp InternalState Timestamp
Lens' InternalState Timestamp
isNow
  RemainingSteps
maxSteps <- Getting RemainingSteps InternalState RemainingSteps
-> StateT InternalState (Except ScenarioError) RemainingSteps
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting RemainingSteps InternalState RemainingSteps
Lens' InternalState RemainingSteps
isMaxSteps
  GState
gState <- Getting GState InternalState GState
-> StateT InternalState (Except ScenarioError) GState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GState InternalState GState
Lens' InternalState GState
isGState
  let interpretedResult :: ExecutorResOrError a
interpretedResult = Timestamp
-> RemainingSteps -> GState -> ExecutorM a -> ExecutorResOrError a
forall a.
Timestamp
-> RemainingSteps
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
runExecutorM Timestamp
now RemainingSteps
maxSteps GState
gState ExecutorM a
action
  ExecutorResOrError a
-> ((ExecutorRes, a) -> IntegrationalScenario)
-> IntegrationalScenario
forall (f :: * -> *) l r.
Applicative f =>
Either l r -> (r -> f ()) -> f ()
whenRight ExecutorResOrError a
interpretedResult (((ExecutorRes, a) -> IntegrationalScenario)
 -> IntegrationalScenario)
-> ((ExecutorRes, a) -> IntegrationalScenario)
-> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ \(result :: ExecutorRes
result, _) -> (GState -> Identity GState)
-> InternalState -> Identity InternalState
Lens' InternalState GState
isGState ((GState -> Identity GState)
 -> InternalState -> Identity InternalState)
-> GState -> IntegrationalScenario
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ExecutorRes -> GState
_erGState ExecutorRes
result
  return ExecutorResOrError a
interpretedResult

-- | Interprets provided list of operations.
registerInterpretation :: [ExecutorOp] -> IntegrationalScenarioM ()
registerInterpretation :: [ExecutorOp] -> IntegrationalScenario
registerInterpretation ops :: [ExecutorOp]
ops =
  ExecutorM () -> IntegrationalScenarioM (ExecutorResOrError ())
forall a.
ExecutorM a -> IntegrationalScenarioM (ExecutorResOrError a)
interpret ([ExecutorOp] -> ExecutorM ()
executeGlobalOperations [ExecutorOp]
ops) IntegrationalScenarioM (ExecutorResOrError ())
-> (ExecutorResOrError () -> ExecutorResOrError')
-> StateT InternalState (Except ScenarioError) ExecutorResOrError'
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((ExecutorRes, ()) -> ExecutorRes)
-> ExecutorResOrError () -> ExecutorResOrError'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ExecutorRes, ()) -> ExecutorRes
forall a b. (a, b) -> a
fst StateT InternalState (Except ScenarioError) ExecutorResOrError'
-> (ExecutorResOrError' -> IntegrationalScenario)
-> IntegrationalScenario
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExecutorResOrError' -> IntegrationalScenario
putResult

-- | Originate a contract with given initial storage and balance. Its
-- address is returned.
originate :: Contract -> Text -> Value -> Mutez -> IntegrationalScenarioM Address
originate :: Contract
-> Text -> Value -> Mutez -> IntegrationalScenarioM Address
originate contract :: Contract
contract contractName :: Text
contractName value :: Value
value balance :: Mutez
balance = do
  InternalState
is <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
  ExecutorResOrError Address
result <- ExecutorM Address
-> IntegrationalScenarioM (ExecutorResOrError Address)
forall a.
ExecutorM a -> IntegrationalScenarioM (ExecutorResOrError a)
interpret (ExecutorM Address
 -> IntegrationalScenarioM (ExecutorResOrError Address))
-> ExecutorM Address
-> IntegrationalScenarioM (ExecutorResOrError Address)
forall a b. (a -> b) -> a -> b
$ ExecutorOp -> ExecutorM Address -> ExecutorM Address
forall a. ExecutorOp -> ExecutorM a -> ExecutorM a
withGlobalOperation (OriginationOperation -> ExecutorOp
OriginateOp OriginationOperation
origination)
        (ExecutorM Address -> ExecutorM Address)
-> ExecutorM Address -> ExecutorM Address
forall a b. (a -> b) -> a -> b
$ OriginationOperation -> ExecutorM Address
executeOrigination OriginationOperation
origination
  ExecutorResOrError' -> IntegrationalScenario
putResult (ExecutorResOrError' -> IntegrationalScenario)
-> ExecutorResOrError' -> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ ((ExecutorRes, Address) -> ExecutorRes)
-> ExecutorResOrError Address -> ExecutorResOrError'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ExecutorRes, Address) -> ExecutorRes
forall a b. (a, b) -> a
fst ExecutorResOrError Address
result
  Address
address <- (ExecutorError -> IntegrationalScenarioM Address)
-> ((ExecutorRes, Address) -> IntegrationalScenarioM Address)
-> ExecutorResOrError Address
-> IntegrationalScenarioM Address
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (InternalState -> ExecutorError -> IntegrationalScenarioM Address
forall a.
InternalState -> ExecutorError -> IntegrationalScenarioM a
interpreterError InternalState
is) (Address -> IntegrationalScenarioM Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> IntegrationalScenarioM Address)
-> ((ExecutorRes, Address) -> Address)
-> (ExecutorRes, Address)
-> IntegrationalScenarioM Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExecutorRes, Address) -> Address
forall a b. (a, b) -> b
snd) (ExecutorResOrError Address -> IntegrationalScenarioM Address)
-> ExecutorResOrError Address -> IntegrationalScenarioM Address
forall a b. (a -> b) -> a -> b
$ ExecutorResOrError Address
result

  (Map Address Text -> Identity (Map Address Text))
-> InternalState -> Identity InternalState
Lens' InternalState (Map Address Text)
isContractsNames ((Map Address Text -> Identity (Map Address Text))
 -> InternalState -> Identity InternalState)
-> (Map Address Text -> Map Address Text) -> IntegrationalScenario
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Address -> Text -> Map Address Text -> Map Address Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Address
address Text
contractName
  return Address
address
  where
    interpreterError :: InternalState -> ExecutorError -> IntegrationalScenarioM a
    interpreterError :: InternalState -> ExecutorError -> IntegrationalScenarioM a
interpreterError is :: InternalState
is = TestError -> IntegrationalScenarioM a
forall anything. TestError -> IntegrationalScenarioM anything
integrationalFail (TestError -> IntegrationalScenarioM a)
-> (ExecutorError -> TestError)
-> ExecutorError
-> IntegrationalScenarioM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntegrationalExecutorError -> TestError
InterpreterError (IntegrationalExecutorError -> TestError)
-> (ExecutorError -> IntegrationalExecutorError)
-> ExecutorError
-> TestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalState -> ExecutorError -> IntegrationalExecutorError
mkError InternalState
is

    origination :: OriginationOperation
origination = (Value -> Contract -> OriginationOperation
dummyOrigination Value
value Contract
contract) {ooBalance :: Mutez
ooBalance = Mutez
balance}

-- | Like 'originate', but for typed contract and value.
tOriginate ::
     (ParameterScope cp, StorageScope st)
  => Typed.Contract cp st
  -> Text
  -> Typed.Value st
  -> Mutez
  -> IntegrationalScenarioM Address
tOriginate :: Contract cp st
-> Text -> Value st -> Mutez -> IntegrationalScenarioM Address
tOriginate contract :: Contract cp st
contract name :: Text
name value :: Value st
value balance :: Mutez
balance =
  Contract
-> Text -> Value -> Mutez -> IntegrationalScenarioM Address
originate (Contract cp st -> Contract
forall (param :: T) (store :: T).
(SingI param, SingI store) =>
Contract param store -> Contract
Typed.convertContract Contract cp st
contract) Text
name
    (Value st -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
Typed.untypeValue Value st
value) Mutez
balance

-- | Transfer tokens to a given address.
transfer :: TxData -> Address -> IntegrationalScenarioM ()
transfer :: TxData -> Address -> IntegrationalScenario
transfer txData :: TxData
txData destination :: Address
destination = do
  Maybe Address
mSender <- Getting (Maybe Address) InternalState (Maybe Address)
-> StateT InternalState (Except ScenarioError) (Maybe Address)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe Address) InternalState (Maybe Address)
Lens' InternalState (Maybe Address)
isSender
  let unwrappedData :: TxData
unwrappedData = (TxData -> TxData)
-> (Address -> TxData -> TxData)
-> Maybe Address
-> TxData
-> TxData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TxData -> TxData
forall a. a -> a
id (ASetter TxData TxData Address Address
-> Address -> TxData -> TxData
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter TxData TxData Address Address
Lens' TxData Address
tdSenderAddressL) Maybe Address
mSender TxData
txData
  [ExecutorOp] -> IntegrationalScenario
registerInterpretation [Address -> TxData -> ExecutorOp
TransferOp Address
destination TxData
unwrappedData]

-- | Similar to 'transfer', for typed values.
-- Note that it works with untyped 'Address' and does not check that
-- entrypoint with given name is present and has the expected type.
-- Passed value must correspond to the entrypoint argument type, not
-- the parameter type of the contract (and must be unit for implicit
-- accounts).
tTransfer
  :: forall arg.
     (ParameterScope arg)
  => "from" :! Address
  -> "to" :! Address
  -> Mutez
  -> EpName
  -> Typed.Value arg
  -> IntegrationalScenarioM ()
tTransfer :: ("from" :! Address)
-> ("to" :! Address)
-> Mutez
-> EpName
-> Value arg
-> IntegrationalScenario
tTransfer (Name "from" -> ("from" :! Address) -> Address
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "from" (Name "from")
Name "from"
#from -> Address
from) (Name "to" -> ("to" :! Address) -> Address
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "to" (Name "to")
Name "to"
#to -> Address
to) money :: Mutez
money epName :: EpName
epName param :: Value arg
param =
  let txData :: TxData
txData = $WTxData :: Address -> Value -> EpName -> Mutez -> TxData
TxData
        { tdSenderAddress :: Address
tdSenderAddress = Address
from
        , tdParameter :: Value
tdParameter =
            ((KnownT arg, () :: Constraint, () :: Constraint)
 :- ParameterScope arg)
-> (ParameterScope arg => Value) -> Value
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (ProperParameterBetterErrors arg :- ParameterScope arg
forall (t :: T). ProperParameterBetterErrors t :- ParameterScope t
properParameterEvi @arg) ((ParameterScope arg => Value) -> Value)
-> (ParameterScope arg => Value) -> Value
forall a b. (a -> b) -> a -> b
$
            Value arg -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
Typed.untypeValue Value arg
param
        , tdEntrypoint :: EpName
tdEntrypoint = EpName
epName
        , tdAmount :: Mutez
tdAmount = Mutez
money
        }
  in TxData -> Address -> IntegrationalScenario
transfer TxData
txData Address
to

-- | Validator for integrational testing that expects successful execution.
validate
  :: (InternalState -> GState -> [GStateUpdate] -> Either TestError ())
  -> IntegrationalScenario
validate :: (InternalState -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
validate validator :: InternalState -> GState -> [GStateUpdate] -> Either TestError ()
validator = do
  InternalState
iState <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
  Maybe ExecutorRes
interpreterResult <- Getting (Maybe ExecutorRes) InternalState (Maybe ExecutorRes)
-> StateT InternalState (Except ScenarioError) (Maybe ExecutorRes)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe ExecutorRes) InternalState (Maybe ExecutorRes)
Lens' InternalState (Maybe ExecutorRes)
isExecutorResult
  case Maybe ExecutorRes
interpreterResult of
    Nothing -> TestError -> IntegrationalScenario
forall anything. TestError -> IntegrationalScenarioM anything
integrationalFail TestError
ValidatingEmptyScenario
    Just result :: ExecutorRes
result -> do
      case InternalState -> GState -> [GStateUpdate] -> Either TestError ()
validator InternalState
iState (ExecutorRes -> GState
_erGState ExecutorRes
result) (ExecutorRes -> [GStateUpdate]
_erUpdates ExecutorRes
result) of
        Left bad :: TestError
bad -> TestError -> IntegrationalScenario
forall anything. TestError -> IntegrationalScenarioM anything
integrationalFail (TestError -> IntegrationalScenario)
-> TestError -> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ TestError -> [GStateUpdate] -> TestError
IncorrectUpdates TestError
bad (ExecutorRes -> [GStateUpdate]
_erUpdates ExecutorRes
result)
        Right () -> IntegrationalScenario
forall (f :: * -> *). Applicative f => f ()
pass

-- | Just fail with given error.
integrationalFail :: TestError -> IntegrationalScenarioM anything
integrationalFail :: TestError -> IntegrationalScenarioM anything
integrationalFail = ScenarioError -> IntegrationalScenarioM anything
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ScenarioError -> IntegrationalScenarioM anything)
-> (TestError -> ScenarioError)
-> TestError
-> IntegrationalScenarioM anything
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioBranchName -> TestError -> ScenarioError
ScenarioError ScenarioBranchName
emptyScenarioBranch

-- | Fail a test because an interpreter error happened unexpectedly, with the given reason.
unexpectedInterpreterError :: ExecutorError -> Text -> IntegrationalScenarioM a
unexpectedInterpreterError :: ExecutorError -> Text -> IntegrationalScenarioM a
unexpectedInterpreterError err :: ExecutorError
err reason :: Text
reason = do
  InternalState
iState <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
  TestError -> IntegrationalScenarioM a
forall anything. TestError -> IntegrationalScenarioM anything
integrationalFail (TestError -> IntegrationalScenarioM a)
-> TestError -> IntegrationalScenarioM a
forall a b. (a -> b) -> a -> b
$ Text -> IntegrationalExecutorError -> TestError
UnexpectedInterpreterError Text
reason (InternalState -> ExecutorError -> IntegrationalExecutorError
mkError InternalState
iState ExecutorError
err)

-- | Make all further interpreter calls use the modified timestamp as the current one.
modifyNow :: (Timestamp -> Timestamp) -> IntegrationalScenarioM ()
modifyNow :: (Timestamp -> Timestamp) -> IntegrationalScenario
modifyNow = ASetter InternalState InternalState Timestamp Timestamp
-> (Timestamp -> Timestamp) -> IntegrationalScenario
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter InternalState InternalState Timestamp Timestamp
Lens' InternalState Timestamp
isNow

-- | Make all further interpreter calls use the given timestamp as the current one.
setNow :: Timestamp -> IntegrationalScenarioM ()
setNow :: Timestamp -> IntegrationalScenario
setNow time :: Timestamp
time = (Timestamp -> Timestamp) -> IntegrationalScenario
modifyNow (Timestamp -> Timestamp -> Timestamp
forall a b. a -> b -> a
const Timestamp
time)

-- | Increase current time by the given number of seconds.
rewindTime :: Integer -> IntegrationalScenarioM ()
rewindTime :: Integer -> IntegrationalScenario
rewindTime interval :: Integer
interval = (Timestamp -> Timestamp) -> IntegrationalScenario
modifyNow ((Timestamp -> Integer -> Timestamp)
-> Integer -> Timestamp -> Timestamp
forall a b c. (a -> b -> c) -> b -> a -> c
flip Timestamp -> Integer -> Timestamp
timestampPlusSeconds Integer
interval)

-- | Make all further interpreter calls use the given gas limit.
setMaxSteps :: RemainingSteps -> IntegrationalScenarioM ()
setMaxSteps :: RemainingSteps -> IntegrationalScenario
setMaxSteps = ASetter InternalState InternalState RemainingSteps RemainingSteps
-> RemainingSteps -> IntegrationalScenario
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter InternalState InternalState RemainingSteps RemainingSteps
Lens' InternalState RemainingSteps
isMaxSteps

-- | Pretend that given address initiates all the transfers within the
-- code block (i.e. @SENDER@ instruction will return this address).
withSender :: Address -> IntegrationalScenarioM a -> IntegrationalScenarioM a
withSender :: Address -> IntegrationalScenarioM a -> IntegrationalScenarioM a
withSender addr :: Address
addr scenario :: IntegrationalScenarioM a
scenario = do
  Maybe Address
prevSender <- Getting (Maybe Address) InternalState (Maybe Address)
-> StateT InternalState (Except ScenarioError) (Maybe Address)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe Address) InternalState (Maybe Address)
Lens' InternalState (Maybe Address)
isSender
  (Maybe Address -> Identity (Maybe Address))
-> InternalState -> Identity InternalState
Lens' InternalState (Maybe Address)
isSender ((Maybe Address -> Identity (Maybe Address))
 -> InternalState -> Identity InternalState)
-> Address -> IntegrationalScenario
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Address
addr
  IntegrationalScenarioM a
scenario IntegrationalScenarioM a
-> IntegrationalScenario -> IntegrationalScenarioM a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ((Maybe Address -> Identity (Maybe Address))
-> InternalState -> Identity InternalState
Lens' InternalState (Maybe Address)
isSender ((Maybe Address -> Identity (Maybe Address))
 -> InternalState -> Identity InternalState)
-> Maybe Address -> IntegrationalScenario
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Address
prevSender)

-- | Make all further interpreter calls use the given chain id.
setChainId :: ChainId -> IntegrationalScenarioM ()
setChainId :: ChainId -> IntegrationalScenario
setChainId = ASetter InternalState InternalState ChainId ChainId
-> ChainId -> IntegrationalScenario
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((GState -> Identity GState)
-> InternalState -> Identity InternalState
Lens' InternalState GState
isGState ((GState -> Identity GState)
 -> InternalState -> Identity InternalState)
-> ((ChainId -> Identity ChainId) -> GState -> Identity GState)
-> ASetter InternalState InternalState ChainId ChainId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainId -> Identity ChainId) -> GState -> Identity GState
Lens' GState ChainId
gsChainIdL)

-- | Put an interpreted result to InternalState.
putResult :: ExecutorResOrError' -> IntegrationalScenarioM ()
putResult :: ExecutorResOrError' -> IntegrationalScenario
putResult resOrErr :: ExecutorResOrError'
resOrErr = do
  ([ExecutorResOrError'] -> Identity [ExecutorResOrError'])
-> InternalState -> Identity InternalState
Lens' InternalState [ExecutorResOrError']
isInterpreterLog (([ExecutorResOrError'] -> Identity [ExecutorResOrError'])
 -> InternalState -> Identity InternalState)
-> [ExecutorResOrError'] -> IntegrationalScenario
forall s (m :: * -> *) a.
(MonadState s m, Monoid a) =>
ASetter' s a -> a -> m ()
<>= OneItem [ExecutorResOrError'] -> [ExecutorResOrError']
forall x. One x => OneItem x -> x
one ExecutorResOrError'
OneItem [ExecutorResOrError']
resOrErr
  case ExecutorResOrError'
resOrErr of
    Right res :: ExecutorRes
res -> (Maybe ExecutorRes -> Identity (Maybe ExecutorRes))
-> InternalState -> Identity InternalState
Lens' InternalState (Maybe ExecutorRes)
isExecutorResult ((Maybe ExecutorRes -> Identity (Maybe ExecutorRes))
 -> InternalState -> Identity InternalState)
-> Maybe ExecutorRes -> IntegrationalScenario
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ExecutorRes -> Maybe ExecutorRes
forall a. a -> Maybe a
Just ExecutorRes
res
    Left err :: ExecutorError
err -> do
      InternalState
iState <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
      TestError -> IntegrationalScenario
forall anything. TestError -> IntegrationalScenarioM anything
integrationalFail (TestError -> IntegrationalScenario)
-> TestError -> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ IntegrationalExecutorError -> TestError
InterpreterError (IntegrationalExecutorError -> TestError)
-> IntegrationalExecutorError -> TestError
forall a b. (a -> b) -> a -> b
$ InternalState -> ExecutorError -> IntegrationalExecutorError
mkError InternalState
iState ExecutorError
err

-- | Make branch names for a case when we are not within any branch.
emptyScenarioBranch :: ScenarioBranchName
emptyScenarioBranch :: ScenarioBranchName
emptyScenarioBranch = [Text] -> ScenarioBranchName
ScenarioBranchName []

-- | Add a new branch element to names provided by inner 'branch' calls.
appendScenarioBranch :: Text -> ScenarioBranchName -> ScenarioBranchName
appendScenarioBranch :: Text -> ScenarioBranchName -> ScenarioBranchName
appendScenarioBranch brName :: Text
brName (ScenarioBranchName branches :: [Text]
branches) =
  [Text] -> ScenarioBranchName
ScenarioBranchName (Text
brName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
branches)

nullScenarioBranch :: ScenarioBranchName -> Bool
nullScenarioBranch :: ScenarioBranchName -> Bool
nullScenarioBranch (ScenarioBranchName brs :: [Text]
brs) = [Text] -> Bool
forall t. Container t => t -> Bool
null [Text]
brs

-- | Execute multiple testing scenarios independently, basing
-- them on scenario built till this point.
--
-- The following property holds for this function:
--
-- @ pre >> branchout [a, b, c] = branchout [pre >> a, pre >> b, pre >> c] @.
--
-- In case of property failure in one of the branches no following branch is
-- executed.
--
-- Providing empty list of scenarios to this function causes error;
-- we do not require 'NonEmpty' here though for convenience.
branchout :: HasCallStack => [(Text, IntegrationalScenario)] -> IntegrationalScenario
branchout :: [(Text, IntegrationalScenario)] -> IntegrationalScenario
branchout scenarios :: [(Text, IntegrationalScenario)]
scenarios
  | [(Text, IntegrationalScenario)] -> Bool
forall t. Container t => t -> Bool
null [(Text, IntegrationalScenario)]
scenarios = Text -> IntegrationalScenario
forall a. HasCallStack => Text -> a
error "branch: empty list of scenarios provided"
  | Bool
otherwise = do
      InternalState
st <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
      Except ScenarioError () -> IntegrationalScenario
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Except ScenarioError () -> IntegrationalScenario)
-> (((Text, IntegrationalScenario) -> Except ScenarioError ())
    -> Except ScenarioError ())
-> ((Text, IntegrationalScenario) -> Except ScenarioError ())
-> IntegrationalScenario
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, IntegrationalScenario)]
-> (Element [(Text, IntegrationalScenario)]
    -> Except ScenarioError ())
-> Except ScenarioError ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
t -> (Element t -> m b) -> m ()
forM_ [(Text, IntegrationalScenario)]
scenarios (((Text, IntegrationalScenario) -> Except ScenarioError ())
 -> IntegrationalScenario)
-> ((Text, IntegrationalScenario) -> Except ScenarioError ())
-> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ \(name :: Text
name, scenario :: IntegrationalScenario
scenario) ->
        (ScenarioError -> ScenarioError)
-> Except ScenarioError () -> Except ScenarioError ()
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept ((ScenarioBranchName -> Identity ScenarioBranchName)
-> ScenarioError -> Identity ScenarioError
Lens' ScenarioError ScenarioBranchName
seBranch ((ScenarioBranchName -> Identity ScenarioBranchName)
 -> ScenarioError -> Identity ScenarioError)
-> (ScenarioBranchName -> ScenarioBranchName)
-> ScenarioError
-> ScenarioError
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> ScenarioBranchName -> ScenarioBranchName
appendScenarioBranch Text
name) (Except ScenarioError () -> Except ScenarioError ())
-> Except ScenarioError () -> Except ScenarioError ()
forall a b. (a -> b) -> a -> b
$
        IntegrationalScenario -> InternalState -> Except ScenarioError ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT IntegrationalScenario
scenario InternalState
st

-- | Make a tuple with name without extra syntactic noise.
(?-) :: Text -> a -> (Text, a)
?- :: Text -> a -> (Text, a)
(?-) = (,)
infixr 0 ?-

-- | Test given scenario with the state gathered till this moment;
-- if this scenario passes, go on as if it never happened.
offshoot :: Text -> IntegrationalScenario -> IntegrationalScenario
offshoot :: Text -> IntegrationalScenario -> IntegrationalScenario
offshoot name :: Text
name scenario :: IntegrationalScenario
scenario = do
  InternalState
st <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
  Except ScenarioError () -> IntegrationalScenario
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Except ScenarioError () -> IntegrationalScenario)
-> Except ScenarioError () -> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$
    (ScenarioError -> ScenarioError)
-> Except ScenarioError () -> Except ScenarioError ()
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept ((ScenarioBranchName -> Identity ScenarioBranchName)
-> ScenarioError -> Identity ScenarioError
Lens' ScenarioError ScenarioBranchName
seBranch ((ScenarioBranchName -> Identity ScenarioBranchName)
 -> ScenarioError -> Identity ScenarioError)
-> (ScenarioBranchName -> ScenarioBranchName)
-> ScenarioError
-> ScenarioError
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> ScenarioBranchName -> ScenarioBranchName
appendScenarioBranch Text
name) (Except ScenarioError () -> Except ScenarioError ())
-> Except ScenarioError () -> Except ScenarioError ()
forall a b. (a -> b) -> a -> b
$
    IntegrationalScenario -> InternalState -> Except ScenarioError ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT IntegrationalScenario
scenario InternalState
st

----------------------------------------------------------------------------
-- Validators
----------------------------------------------------------------------------

-- | Check that there were no updates.
expectNoUpdates :: IntegrationalScenario
expectNoUpdates :: IntegrationalScenario
expectNoUpdates = (InternalState -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
validate ((InternalState -> GState -> [GStateUpdate] -> Either TestError ())
 -> IntegrationalScenario)
-> (InternalState
    -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ \_ _ updates :: [GStateUpdate]
updates ->
  Either TestError ()
-> (NonEmpty GStateUpdate -> Either TestError ())
-> Maybe (NonEmpty GStateUpdate)
-> Either TestError ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either TestError ()
forall (f :: * -> *). Applicative f => f ()
pass (TestError -> Either TestError ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TestError -> Either TestError ())
-> (NonEmpty GStateUpdate -> TestError)
-> NonEmpty GStateUpdate
-> Either TestError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty GStateUpdate -> TestError
UnexpectedUpdates) (Maybe (NonEmpty GStateUpdate) -> Either TestError ())
-> ([GStateUpdate] -> Maybe (NonEmpty GStateUpdate))
-> [GStateUpdate]
-> Either TestError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GStateUpdate] -> Maybe (NonEmpty GStateUpdate)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([GStateUpdate] -> Either TestError ())
-> [GStateUpdate] -> Either TestError ()
forall a b. (a -> b) -> a -> b
$ [GStateUpdate]
updates

-- | Check that there were no storage updates.
expectNoStorageUpdates :: IntegrationalScenario
expectNoStorageUpdates :: IntegrationalScenario
expectNoStorageUpdates = (InternalState -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
validate ((InternalState -> GState -> [GStateUpdate] -> Either TestError ())
 -> IntegrationalScenario)
-> (InternalState
    -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ \_ _ updates :: [GStateUpdate]
updates ->
  Either TestError ()
-> (NonEmpty GStateUpdate -> Either TestError ())
-> Maybe (NonEmpty GStateUpdate)
-> Either TestError ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either TestError ()
forall (f :: * -> *). Applicative f => f ()
pass (TestError -> Either TestError ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TestError -> Either TestError ())
-> (NonEmpty GStateUpdate -> TestError)
-> NonEmpty GStateUpdate
-> Either TestError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty GStateUpdate -> TestError
UnexpectedUpdates) (Maybe (NonEmpty GStateUpdate) -> Either TestError ())
-> ([GStateUpdate] -> Maybe (NonEmpty GStateUpdate))
-> [GStateUpdate]
-> Either TestError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GStateUpdate] -> Maybe (NonEmpty GStateUpdate)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([GStateUpdate] -> Either TestError ())
-> [GStateUpdate] -> Either TestError ()
forall a b. (a -> b) -> a -> b
$
  (GStateUpdate -> Bool) -> [GStateUpdate] -> [GStateUpdate]
forall a. (a -> Bool) -> [a] -> [a]
filter GStateUpdate -> Bool
isStorageUpdate [GStateUpdate]
updates
  where
    isStorageUpdate :: GStateUpdate -> Bool
isStorageUpdate = \case
      GSSetStorageValue {} -> Bool
True
      _ -> Bool
False

-- | Check that storage value satisfies the given predicate.
expectStorage
  :: Address
  -> (Value -> Either TestError ())
  -> IntegrationalScenario
expectStorage :: Address -> (Value -> Either TestError ()) -> IntegrationalScenario
expectStorage addr :: Address
addr predicate :: Value -> Either TestError ()
predicate = (InternalState -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
validate ((InternalState -> GState -> [GStateUpdate] -> Either TestError ())
 -> IntegrationalScenario)
-> (InternalState
    -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ \is :: InternalState
is gs :: GState
gs _ ->
  let intro :: Text -> TestError
intro = AddressName -> Text -> TestError
StoragePredicateMismatch (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) in
  case GState -> Map Address AddressState
gsAddresses GState
gs Map Address AddressState
-> Getting
     (Maybe AddressState)
     (Map Address AddressState)
     (Maybe AddressState)
-> Maybe AddressState
forall s a. s -> Getting a s a -> a
^. Index (Map Address AddressState)
-> Lens'
     (Map Address AddressState)
     (Maybe (IxValue (Map Address AddressState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Address AddressState)
Address
addr of
    Just (ASContract cs :: ContractState
cs) ->
      Value -> Either TestError ()
predicate (Value -> Either TestError ()) -> Value -> Either TestError ()
forall a b. (a -> b) -> a -> b
$ ContractState -> Value
csStorage ContractState
cs
    Just (ASSimple {}) ->
      TestError -> Either TestError ()
forall a b. a -> Either a b
Left (TestError -> Either TestError ())
-> TestError -> Either TestError ()
forall a b. (a -> b) -> a -> b
$ Text -> TestError
intro (Text -> TestError) -> Text -> TestError
forall a b. (a -> b) -> a -> b
$ "it's a simple address"
    Nothing -> TestError -> Either TestError ()
forall a b. a -> Either a b
Left (TestError -> Either TestError ())
-> TestError -> Either TestError ()
forall a b. (a -> b) -> a -> b
$ Text -> TestError
intro (Text -> TestError) -> Text -> TestError
forall a b. (a -> b) -> a -> b
$ "it's unknown"

-- | Check that storage value is updated for given address. Takes a
-- predicate that is used to check the value.
--
-- It works even if updates are not filtered (i. e. a value can be
-- updated more than once).
expectStorageUpdate
  :: Address
  -> (Value -> Either TestError ())
  -> IntegrationalScenario
expectStorageUpdate :: Address -> (Value -> Either TestError ()) -> IntegrationalScenario
expectStorageUpdate addr :: Address
addr predicate :: Value -> Either TestError ()
predicate = (InternalState -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
validate ((InternalState -> GState -> [GStateUpdate] -> Either TestError ())
 -> IntegrationalScenario)
-> (InternalState
    -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ \is :: InternalState
is _ updates :: [GStateUpdate]
updates ->
  case (GStateUpdate -> Bool) -> [GStateUpdate] -> Maybe GStateUpdate
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find GStateUpdate -> Bool
checkAddr ([GStateUpdate] -> [GStateUpdate]
forall a. [a] -> [a]
reverse [GStateUpdate]
updates) of
    Nothing -> TestError -> Either TestError ()
forall a b. a -> Either a b
Left (TestError -> Either TestError ())
-> TestError -> Either TestError ()
forall a b. (a -> b) -> a -> b
$
      AddressName -> Text -> TestError
IncorrectStorageUpdate (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) "storage wasn't updated"
    Just (GSSetStorageValue _ val :: Value
val _) ->
      (TestError -> TestError)
-> Either TestError () -> Either TestError ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (AddressName -> Text -> TestError
IncorrectStorageUpdate (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) (Text -> TestError)
-> (TestError -> Text) -> TestError -> TestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestError -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) (Either TestError () -> Either TestError ())
-> Either TestError () -> Either TestError ()
forall a b. (a -> b) -> a -> b
$
      Value -> Either TestError ()
predicate Value
val
    -- 'checkAddr' ensures that only 'GSSetStorageValue' can be found
    Just _ -> Text -> Either TestError ()
forall a. HasCallStack => Text -> a
error "expectStorageUpdate: internal error"
  where
    checkAddr :: GStateUpdate -> Bool
checkAddr (GSSetStorageValue addr' :: Address
addr' _ _) = Address
addr' Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address
addr
    checkAddr _ = Bool
False

-- | Like 'expectStorageUpdate', but expects a constant.
expectStorageUpdateConst
  :: Address
  -> Value
  -> IntegrationalScenario
expectStorageUpdateConst :: Address -> Value -> IntegrationalScenario
expectStorageUpdateConst addr :: Address
addr expected :: Value
expected = do
  InternalState
is <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
  let
    predicate :: Value -> Either TestError ()
predicate val :: Value
val
      | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
expected = Either TestError ()
forall (f :: * -> *). Applicative f => f ()
pass
      | Bool
otherwise = TestError -> Either TestError ()
forall a b. a -> Either a b
Left (TestError -> Either TestError ())
-> TestError -> Either TestError ()
forall a b. (a -> b) -> a -> b
$
        AddressName -> Text -> TestError
IncorrectStorageUpdate (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) (Value -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Value
expected)
  Address -> (Value -> Either TestError ()) -> IntegrationalScenario
expectStorageUpdate Address
addr Value -> Either TestError ()
predicate

-- | Check that eventually address has some particular storage value.
expectStorageConst :: Address -> Value -> IntegrationalScenario
expectStorageConst :: Address -> Value -> IntegrationalScenario
expectStorageConst addr :: Address
addr expected :: Value
expected = do
  InternalState
is <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
  let
    predicate :: Value -> Either TestError ()
predicate val :: Value
val
      | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
expected = Either TestError ()
forall (f :: * -> *). Applicative f => f ()
pass
      | Bool
otherwise = TestError -> Either TestError ()
forall a b. a -> Either a b
Left (TestError -> Either TestError ())
-> TestError -> Either TestError ()
forall a b. (a -> b) -> a -> b
$
        AddressName -> ExpectedStorage -> Text -> TestError
InvalidStorage (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) (Value -> ExpectedStorage
ExpectedStorage Value
expected) (Value -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Value
val)
  Address -> (Value -> Either TestError ()) -> IntegrationalScenario
expectStorage Address
addr Value -> Either TestError ()
predicate

-- | Similar to 'expectStorageConst', for typed stuff.
tExpectStorageConst
  :: forall st.
     (StorageScope st)
  => Address -> Typed.Value st -> IntegrationalScenario
tExpectStorageConst :: Address -> Value st -> IntegrationalScenario
tExpectStorageConst addr :: Address
addr expected :: Value st
expected =
  Address -> Value -> IntegrationalScenario
expectStorageConst Address
addr (Value st -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
Typed.untypeValue Value st
expected)

-- | Check that eventually address has some particular balance.
expectBalance :: Address -> Mutez -> IntegrationalScenario
expectBalance :: Address -> Mutez -> IntegrationalScenario
expectBalance addr :: Address
addr balance :: Mutez
balance = (InternalState -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
validate ((InternalState -> GState -> [GStateUpdate] -> Either TestError ())
 -> IntegrationalScenario)
-> (InternalState
    -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ \is :: InternalState
is gs :: GState
gs _ ->
  let realBalance :: Mutez
realBalance = Mutez -> (AddressState -> Mutez) -> Maybe AddressState -> Mutez
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HasCallStack => Word64 -> Mutez
Word64 -> Mutez
unsafeMkMutez 0) AddressState -> Mutez
asBalance (GState -> Map Address AddressState
gsAddresses GState
gs Map Address AddressState
-> Getting
     (Maybe AddressState)
     (Map Address AddressState)
     (Maybe AddressState)
-> Maybe AddressState
forall s a. s -> Getting a s a -> a
^. Index (Map Address AddressState)
-> Lens'
     (Map Address AddressState)
     (Maybe (IxValue (Map Address AddressState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Address AddressState)
Address
addr) in
  if Mutez
realBalance Mutez -> Mutez -> Bool
forall a. Eq a => a -> a -> Bool
== Mutez
balance then Either TestError ()
forall (f :: * -> *). Applicative f => f ()
pass
  else
    TestError -> Either TestError ()
forall a b. a -> Either a b
Left
    (TestError -> Either TestError ())
-> TestError -> Either TestError ()
forall a b. (a -> b) -> a -> b
$ AddressName -> ExpectedBalance -> Text -> TestError
InvalidBalance (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) (Mutez -> ExpectedBalance
ExpectedBalance Mutez
balance)
    (Text -> TestError) -> Text -> TestError
forall a b. (a -> b) -> a -> b
$ "its actual balance is: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Mutez -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Mutez
realBalance


-- | Attempt to run an action and return its result or, if interpretation fails, an error.
attempt :: IntegrationalScenarioM a -> IntegrationalScenarioM (Either ExecutorError a)
attempt :: IntegrationalScenarioM a
-> IntegrationalScenarioM (Either ExecutorError a)
attempt ma :: IntegrationalScenarioM a
ma = IntegrationalScenarioM (Either ExecutorError a)
-> (ScenarioError
    -> IntegrationalScenarioM (Either ExecutorError a))
-> IntegrationalScenarioM (Either ExecutorError a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (a -> Either ExecutorError a
forall a b. b -> Either a b
Right (a -> Either ExecutorError a)
-> IntegrationalScenarioM a
-> IntegrationalScenarioM (Either ExecutorError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntegrationalScenarioM a
ma) ((ScenarioError -> IntegrationalScenarioM (Either ExecutorError a))
 -> IntegrationalScenarioM (Either ExecutorError a))
-> (ScenarioError
    -> IntegrationalScenarioM (Either ExecutorError a))
-> IntegrationalScenarioM (Either ExecutorError a)
forall a b. (a -> b) -> a -> b
$ \case
  ScenarioError _ (InterpreterError err :: IntegrationalExecutorError
err) -> Either ExecutorError a
-> IntegrationalScenarioM (Either ExecutorError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ExecutorError a
 -> IntegrationalScenarioM (Either ExecutorError a))
-> (ExecutorError -> Either ExecutorError a)
-> ExecutorError
-> IntegrationalScenarioM (Either ExecutorError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExecutorError -> Either ExecutorError a
forall a b. a -> Either a b
Left (ExecutorError -> IntegrationalScenarioM (Either ExecutorError a))
-> ExecutorError -> IntegrationalScenarioM (Either ExecutorError a)
forall a b. (a -> b) -> a -> b
$ AddressName -> Address
addrNameToAddr (AddressName -> Address)
-> IntegrationalExecutorError -> ExecutorError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntegrationalExecutorError
err
  err :: ScenarioError
err -> ScenarioError -> IntegrationalScenarioM (Either ExecutorError a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ScenarioError
err

-- | Run an action that is expected to fail.
-- If the action fails, the test succeeds and the error is returned.
-- If the action succeeds, the test fails.
expectError :: IntegrationalScenarioM a -> IntegrationalScenarioM ExecutorError
expectError :: IntegrationalScenarioM a -> IntegrationalScenarioM ExecutorError
expectError scenario :: IntegrationalScenarioM a
scenario = IntegrationalScenarioM a
-> (ExecutorError -> IntegrationalScenarioM ExecutorError)
-> IntegrationalScenarioM ExecutorError
forall a b.
IntegrationalScenarioM a
-> (ExecutorError -> IntegrationalScenarioM b)
-> IntegrationalScenarioM b
catchExpectedError IntegrationalScenarioM a
scenario ExecutorError -> IntegrationalScenarioM ExecutorError
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Run an action that is expected to fail.
--
-- In @action `catchExpectedError` f@:
-- If the action fails, @f@ is applied to the error.
-- If the action succeeds, the test fails.
catchExpectedError
  :: IntegrationalScenarioM a
  -> (ExecutorError -> IntegrationalScenarioM b)
  -> IntegrationalScenarioM b
catchExpectedError :: IntegrationalScenarioM a
-> (ExecutorError -> IntegrationalScenarioM b)
-> IntegrationalScenarioM b
catchExpectedError scenario :: IntegrationalScenarioM a
scenario handle :: ExecutorError -> IntegrationalScenarioM b
handle =
  IntegrationalScenarioM a
-> IntegrationalScenarioM (Either ExecutorError a)
forall a.
IntegrationalScenarioM a
-> IntegrationalScenarioM (Either ExecutorError a)
attempt IntegrationalScenarioM a
scenario IntegrationalScenarioM (Either ExecutorError a)
-> (Either ExecutorError a -> IntegrationalScenarioM b)
-> IntegrationalScenarioM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left err :: ExecutorError
err -> ExecutorError -> IntegrationalScenarioM b
handle ExecutorError
err
    Right _ -> TestError -> IntegrationalScenarioM b
forall anything. TestError -> IntegrationalScenarioM anything
integrationalFail TestError
ExpectingInterpreterToFail

-- | Check that interpreter failed due to gas exhaustion.
expectGasExhaustion :: ExecutorError -> IntegrationalScenario
expectGasExhaustion :: ExecutorError -> IntegrationalScenario
expectGasExhaustion =
  \case
    EEInterpreterFailed _ (RuntimeFailure (MichelsonGasExhaustion, _)) -> IntegrationalScenario
forall (f :: * -> *). Applicative f => f ()
pass
    err :: ExecutorError
err -> ExecutorError -> Text -> IntegrationalScenario
forall a. ExecutorError -> Text -> IntegrationalScenarioM a
unexpectedInterpreterError ExecutorError
err "expected runtime failure due to gas exhaustion"

-- | Expect that interpretation of contract with given address ended
-- with [FAILED].
expectMichelsonFailed :: (MichelsonFailed -> Bool) -> Address -> ExecutorError -> IntegrationalScenario
expectMichelsonFailed :: (MichelsonFailed -> Bool)
-> Address -> ExecutorError -> IntegrationalScenario
expectMichelsonFailed predicate :: MichelsonFailed -> Bool
predicate expectedAddr :: Address
expectedAddr err :: ExecutorError
err =
  case ExecutorError
err of
    EEInterpreterFailed actualAddr :: Address
actualAddr (RuntimeFailure (mf :: MichelsonFailed
mf, _))
      | Address
expectedAddr Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
/= Address
actualAddr -> do
          InternalState
iState <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
          ExecutorError -> Text -> IntegrationalScenario
forall a. ExecutorError -> Text -> IntegrationalScenarioM a
unexpectedInterpreterError ExecutorError
err (Text -> IntegrationalScenario) -> Text -> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$
            "expected runtime failure for contract with address "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AddressName -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Address -> InternalState -> AddressName
addrToAddrName Address
expectedAddr InternalState
iState)
      | Bool -> Bool
not (MichelsonFailed -> Bool
predicate MichelsonFailed
mf) -> ExecutorError -> Text -> IntegrationalScenario
forall a. ExecutorError -> Text -> IntegrationalScenarioM a
unexpectedInterpreterError ExecutorError
err "predicate failed"
      | Bool
otherwise -> IntegrationalScenario
forall (f :: * -> *). Applicative f => f ()
pass
    _ -> ExecutorError -> Text -> IntegrationalScenario
forall a. ExecutorError -> Text -> IntegrationalScenarioM a
unexpectedInterpreterError ExecutorError
err "expected runtime failure"

----------------------------------------------------------------------------
-- Implementation of the testing engine
----------------------------------------------------------------------------

initIS :: InternalState
initIS :: InternalState
initIS = $WInternalState :: RemainingSteps
-> Timestamp
-> GState
-> [ExecutorResOrError']
-> Maybe ExecutorRes
-> Map Address Text
-> Maybe Address
-> InternalState
InternalState
  { _isNow :: Timestamp
_isNow = Timestamp
dummyNow
  , _isMaxSteps :: RemainingSteps
_isMaxSteps = RemainingSteps
dummyMaxSteps
  , _isGState :: GState
_isGState = GState
initGState
  , _isInterpreterLog :: [ExecutorResOrError']
_isInterpreterLog = [ExecutorResOrError']
forall a. Monoid a => a
mempty
  , _isExecutorResult :: Maybe ExecutorRes
_isExecutorResult = Maybe ExecutorRes
forall a. Maybe a
Nothing
  , _isContractsNames :: Map Address Text
_isContractsNames = Map Address Text
forall k a. Map k a
Map.empty
  , _isSender :: Maybe Address
_isSender = Maybe Address
forall a. Maybe a
Nothing
  }

integrationalTest ::
     (Maybe ScenarioError -> res)
  -> IntegrationalScenario
  -> res
integrationalTest :: (Maybe ScenarioError -> res) -> IntegrationalScenario -> res
integrationalTest howToFail :: Maybe ScenarioError -> res
howToFail scenario :: IntegrationalScenario
scenario =
  Maybe ScenarioError -> res
howToFail (Maybe ScenarioError -> res) -> Maybe ScenarioError -> res
forall a b. (a -> b) -> a -> b
$ Either ScenarioError ((), InternalState) -> Maybe ScenarioError
forall l r. Either l r -> Maybe l
leftToMaybe (Either ScenarioError ((), InternalState) -> Maybe ScenarioError)
-> Either ScenarioError ((), InternalState) -> Maybe ScenarioError
forall a b. (a -> b) -> a -> b
$ Except ScenarioError ((), InternalState)
-> Either ScenarioError ((), InternalState)
forall e a. Except e a -> Either e a
runExcept (IntegrationalScenario
-> InternalState -> Except ScenarioError ((), InternalState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT IntegrationalScenario
scenario InternalState
initIS)

mkError
  :: InternalState
  -> ExecutorError
  -> IntegrationalExecutorError
mkError :: InternalState -> ExecutorError -> IntegrationalExecutorError
mkError is :: InternalState
is = (Address -> AddressName)
-> ExecutorError -> IntegrationalExecutorError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Address -> AddressName)
 -> ExecutorError -> IntegrationalExecutorError)
-> (Address -> AddressName)
-> ExecutorError
-> IntegrationalExecutorError
forall a b. (a -> b) -> a -> b
$ (Address -> InternalState -> AddressName)
-> InternalState -> Address -> AddressName
forall a b c. (a -> b -> c) -> b -> a -> c
flip Address -> InternalState -> AddressName
addrToAddrName InternalState
is