-- | 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
  , IntegrationalValidator
  , SuccessValidator
  , IntegrationalScenarioM
  , IntegrationalScenario
  , ValidationError (..)
  , integrationalTestExpectation
  , integrationalTestProperty
  , originate
  , tOriginate
  , transfer
  , tTransfer
  , validate
  , integrationalFail
  , setMaxSteps
  , modifyNow
  , setNow
  , rewindTime
  , withSender
  , setChainId
  , branchout
  , (?-)
  , offshoot

  -- * Validators
  , composeValidators
  , composeValidatorsList
  , expectAnySuccess
  , expectNoUpdates
  , expectNoStorageUpdates
  , expectStorageUpdate
  , expectStorageUpdateConst
  , expectBalance
  , expectStorage
  , expectStorageConst
  , tExpectStorageConst
  , expectGasExhaustion
  , expectMichelsonFailed
  ) where

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

import Michelson.Interpret (InterpretError(..), MichelsonFailed(..), RemainingSteps)
import Michelson.Runtime
  (ExecutorError, ExecutorError'(..), ExecutorOp(..), ExecutorRes(..), executorPure)
import Michelson.Runtime.GState
import Michelson.Runtime.TxData
import Michelson.Test.Dummy
import Michelson.Test.Util (failedProp, succeededProp)
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, mkContractAddress)
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 = 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 ExecutorResOrError
_isExecutorResult :: Maybe ExecutorResOrError
  -- ^ 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
----------------------------------------------------------------------------

-- | Validator for integrational testing.
-- If an error is expected, it should be 'Left' with validator for errors.
-- Otherwise it should check final global state and its updates.
type IntegrationalValidator = Either (ExecutorError -> Bool) SuccessValidator

-- | Validator for integrational testing that expects successful execution.
type SuccessValidator = InternalState -> GState -> [GStateUpdate] -> Either ValidationError ()

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

-- | A dummy data type that ensures that `validate` is called in the
-- end of each scenario. It is intentionally not exported.
data Validated = Validated

type IntegrationalScenario = IntegrationalScenarioM Validated

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

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 ValidationError
  = UnexpectedExecutorError IntegrationalExecutorError
  | UnexpectedTypeCheckError TCError
  | ExpectingInterpreterToFail
  | IncorrectUpdates ValidationError [GStateUpdate]
  | IncorrectStorageUpdate AddressName Text
  | InvalidStorage AddressName ExpectedStorage Text
  | StoragePredicateMismatch AddressName Text
  | InvalidBalance AddressName ExpectedBalance Text
  | UnexpectedUpdates (NonEmpty GStateUpdate)
  | CustomValidationError Text
  deriving stock (Int -> ValidationError -> ShowS
[ValidationError] -> ShowS
ValidationError -> String
(Int -> ValidationError -> ShowS)
-> (ValidationError -> String)
-> ([ValidationError] -> ShowS)
-> Show ValidationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidationError] -> ShowS
$cshowList :: [ValidationError] -> ShowS
show :: ValidationError -> String
$cshow :: ValidationError -> String
showsPrec :: Int -> ValidationError -> ShowS
$cshowsPrec :: Int -> ValidationError -> ShowS
Show)

instance Buildable ValidationError where
  build :: ValidationError -> Builder
build (UnexpectedExecutorError iErr :: IntegrationalExecutorError
iErr) =
    "Unexpected interpreter error. Reason: " 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 :: ValidationError
vErr updates :: [GStateUpdate]
updates) =
    "Updates are incorrect: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ValidationError
vErr ValidationError -> 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 (CustomValidationError msg :: Text
msg) = Text -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Text
msg

instance Exception ValidationError where
  displayException :: ValidationError -> String
displayException = ValidationError -> 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 -> ValidationError
_seError :: ValidationError
  }

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

instance Buildable ScenarioError where
  build :: ScenarioError -> Builder
build (ScenarioError br :: ScenarioBranchName
br err :: ValidationError
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
<> ValidationError -> Builder
forall p. Buildable p => p -> Builder
build ValidationError
err

-- | Integrational test that executes given operations and validates
-- them using given validator. 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 'Property' capability.
-- It can be used with QuickCheck's @forAll@ to make a
-- property-based test with arbitrary data.
integrationalTestProperty :: IntegrationalScenario -> 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))

-- | Helper function which provides the results of the given operations.
interpret :: [ExecutorOp] -> IntegrationalScenarioM ExecutorResOrError
interpret :: [ExecutorOp] -> IntegrationalScenarioM ExecutorResOrError
interpret ops :: [ExecutorOp]
ops = 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
interpretedResult = Timestamp
-> RemainingSteps -> GState -> [ExecutorOp] -> ExecutorResOrError
executorPure Timestamp
now RemainingSteps
maxSteps GState
gState [ExecutorOp]
ops
  ExecutorResOrError
-> (ExecutorRes -> StateT InternalState (Except ScenarioError) ())
-> StateT InternalState (Except ScenarioError) ()
forall (f :: * -> *) l r.
Applicative f =>
Either l r -> (r -> f ()) -> f ()
whenRight ExecutorResOrError
interpretedResult ((ExecutorRes -> StateT InternalState (Except ScenarioError) ())
 -> StateT InternalState (Except ScenarioError) ())
-> (ExecutorRes -> StateT InternalState (Except ScenarioError) ())
-> StateT InternalState (Except ScenarioError) ()
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 -> StateT InternalState (Except ScenarioError) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ExecutorRes -> GState
_erGState ExecutorRes
result
  return ExecutorResOrError
interpretedResult

-- | Interprets provided list of operations only if previous interpretation
-- succeeded which allows for engine return the earliest error possible.
registerInterpretationIfNeeded :: [ExecutorOp] -> IntegrationalScenarioM ()
registerInterpretationIfNeeded :: [ExecutorOp] -> StateT InternalState (Except ScenarioError) ()
registerInterpretationIfNeeded ops :: [ExecutorOp]
ops = do
  Maybe ExecutorResOrError
previousResult <- Getting
  (Maybe ExecutorResOrError) InternalState (Maybe ExecutorResOrError)
-> StateT
     InternalState (Except ScenarioError) (Maybe ExecutorResOrError)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Maybe ExecutorResOrError) InternalState (Maybe ExecutorResOrError)
Lens' InternalState (Maybe ExecutorResOrError)
isExecutorResult
  case Maybe ExecutorResOrError
previousResult of
    Just (Left _) -> StateT InternalState (Except ScenarioError) ()
forall (f :: * -> *). Applicative f => f ()
pass
    _ -> [ExecutorOp] -> IntegrationalScenarioM ExecutorResOrError
interpret [ExecutorOp]
ops IntegrationalScenarioM ExecutorResOrError
-> (ExecutorResOrError
    -> StateT InternalState (Except ScenarioError) ())
-> StateT InternalState (Except ScenarioError) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExecutorResOrError
-> StateT InternalState (Except ScenarioError) ()
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
  [ExecutorOp] -> StateT InternalState (Except ScenarioError) ()
registerInterpretationIfNeeded [OriginationOperation -> ExecutorOp
OriginateOp OriginationOperation
origination]
  let address :: Address
address = OriginationOperation -> Address
mkContractAddress OriginationOperation
origination
  (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)
-> StateT InternalState (Except ScenarioError) ()
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
    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.FullContract cp st
  -> Text
  -> Typed.Value st
  -> Mutez
  -> IntegrationalScenarioM Address
tOriginate :: FullContract cp st
-> Text -> Value st -> Mutez -> IntegrationalScenarioM Address
tOriginate contract :: FullContract cp st
contract name :: Text
name value :: Value st
value balance :: Mutez
balance =
  Contract
-> Text -> Value -> Mutez -> IntegrationalScenarioM Address
originate (FullContract cp st -> Contract
forall (param :: T) (store :: T).
(SingI param, SingI store) =>
FullContract param store -> Contract
Typed.convertFullContract FullContract 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 -> StateT InternalState (Except ScenarioError) ()
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] -> StateT InternalState (Except ScenarioError) ()
registerInterpretationIfNeeded [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
-> StateT InternalState (Except ScenarioError) ()
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 =
            ((Typeable arg, SingI 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 -> StateT InternalState (Except ScenarioError) ()
transfer TxData
txData Address
to

-- | Validate the execution result.
validate :: IntegrationalValidator -> IntegrationalScenario
validate :: IntegrationalValidator -> IntegrationalScenario
validate validator :: IntegrationalValidator
validator = Validated
Validated Validated
-> StateT InternalState (Except ScenarioError) ()
-> IntegrationalScenario
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ do
  InternalState
iState <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
  Maybe ExecutorResOrError
interpreterResult <- Getting
  (Maybe ExecutorResOrError) InternalState (Maybe ExecutorResOrError)
-> StateT
     InternalState (Except ScenarioError) (Maybe ExecutorResOrError)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting
  (Maybe ExecutorResOrError) InternalState (Maybe ExecutorResOrError)
Lens' InternalState (Maybe ExecutorResOrError)
isExecutorResult
  case Maybe ExecutorResOrError
interpreterResult of
    Just result :: ExecutorResOrError
result -> do
      ExecutorResOrError
-> (ExecutorError
    -> StateT InternalState (Except ScenarioError) ())
-> StateT InternalState (Except ScenarioError) ()
forall (f :: * -> *) l r.
Applicative f =>
Either l r -> (l -> f ()) -> f ()
whenLeft ExecutorResOrError
result ((ExecutorError -> StateT InternalState (Except ScenarioError) ())
 -> StateT InternalState (Except ScenarioError) ())
-> (ExecutorError
    -> StateT InternalState (Except ScenarioError) ())
-> StateT InternalState (Except ScenarioError) ()
forall a b. (a -> b) -> a -> b
$ \_ -> (Maybe ExecutorResOrError -> Identity (Maybe ExecutorResOrError))
-> InternalState -> Identity InternalState
Lens' InternalState (Maybe ExecutorResOrError)
isExecutorResult ((Maybe ExecutorResOrError -> Identity (Maybe ExecutorResOrError))
 -> InternalState -> Identity InternalState)
-> Maybe ExecutorResOrError
-> StateT InternalState (Except ScenarioError) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe ExecutorResOrError
forall a. Maybe a
Nothing
      IntegrationalValidator
-> ExecutorResOrError
-> InternalState
-> StateT InternalState (Except ScenarioError) ()
validateResult IntegrationalValidator
validator ExecutorResOrError
result InternalState
iState
    _ ->
      Text -> StateT InternalState (Except ScenarioError) ()
forall anything. Text -> IntegrationalScenarioM anything
failWith "Validating empty scenario"
    where
      failWith :: Text -> IntegrationalScenarioM anything
failWith = ValidationError -> IntegrationalScenarioM anything
forall anything. ValidationError -> IntegrationalScenarioM anything
integrationalFail (ValidationError -> IntegrationalScenarioM anything)
-> (Text -> ValidationError)
-> Text
-> IntegrationalScenarioM anything
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ValidationError
CustomValidationError

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

-- | Make all further interpreter calls (which are triggered by the
-- 'validate' function) use modified timestamp as the current one.
modifyNow :: (Timestamp -> Timestamp) -> IntegrationalScenarioM ()
modifyNow :: (Timestamp -> Timestamp)
-> StateT InternalState (Except ScenarioError) ()
modifyNow = ASetter InternalState InternalState Timestamp Timestamp
-> (Timestamp -> Timestamp)
-> StateT InternalState (Except ScenarioError) ()
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 (which are triggered by the
-- 'validate' function) use given timestamp as the current one.
setNow :: Timestamp -> IntegrationalScenarioM ()
setNow :: Timestamp -> StateT InternalState (Except ScenarioError) ()
setNow time :: Timestamp
time = (Timestamp -> Timestamp)
-> StateT InternalState (Except ScenarioError) ()
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 -> StateT InternalState (Except ScenarioError) ()
rewindTime interval :: Integer
interval = (Timestamp -> Timestamp)
-> StateT InternalState (Except ScenarioError) ()
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 (which are triggered by the
-- 'validate' function) use given gas limit.
setMaxSteps :: RemainingSteps -> IntegrationalScenarioM ()
setMaxSteps :: RemainingSteps -> StateT InternalState (Except ScenarioError) ()
setMaxSteps = ASetter InternalState InternalState RemainingSteps RemainingSteps
-> RemainingSteps -> StateT InternalState (Except ScenarioError) ()
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 -> StateT InternalState (Except ScenarioError) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Address
addr
  IntegrationalScenarioM a
scenario IntegrationalScenarioM a
-> StateT InternalState (Except ScenarioError) ()
-> 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 -> StateT InternalState (Except ScenarioError) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Address
prevSender)

-- | Make all further interpreter calls (which are triggered by the
-- 'validate' function) use given chain id.
setChainId :: ChainId -> IntegrationalScenarioM ()
setChainId :: ChainId -> StateT InternalState (Except ScenarioError) ()
setChainId = ASetter InternalState InternalState ChainId ChainId
-> ChainId -> StateT InternalState (Except ScenarioError) ()
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
-> StateT InternalState (Except ScenarioError) ()
putResult res :: ExecutorResOrError
res = do
  ([ExecutorResOrError] -> Identity [ExecutorResOrError])
-> InternalState -> Identity InternalState
Lens' InternalState [ExecutorResOrError]
isInterpreterLog (([ExecutorResOrError] -> Identity [ExecutorResOrError])
 -> InternalState -> Identity InternalState)
-> [ExecutorResOrError]
-> StateT InternalState (Except ScenarioError) ()
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]
res
  (Maybe ExecutorResOrError -> Identity (Maybe ExecutorResOrError))
-> InternalState -> Identity InternalState
Lens' InternalState (Maybe ExecutorResOrError)
isExecutorResult ((Maybe ExecutorResOrError -> Identity (Maybe ExecutorResOrError))
 -> InternalState -> Identity InternalState)
-> Maybe ExecutorResOrError
-> StateT InternalState (Except ScenarioError) ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ExecutorResOrError -> Maybe ExecutorResOrError
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExecutorResOrError
res

-- | 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 = do
  InternalState
st <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
  [Validated]
res <- ExceptT ScenarioError Identity [Validated]
-> StateT InternalState (Except ScenarioError) [Validated]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT ScenarioError Identity [Validated]
 -> StateT InternalState (Except ScenarioError) [Validated])
-> (((Text, IntegrationalScenario)
     -> ExceptT ScenarioError Identity Validated)
    -> ExceptT ScenarioError Identity [Validated])
-> ((Text, IntegrationalScenario)
    -> ExceptT ScenarioError Identity Validated)
-> StateT InternalState (Except ScenarioError) [Validated]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, IntegrationalScenario)]
-> ((Text, IntegrationalScenario)
    -> ExceptT ScenarioError Identity Validated)
-> ExceptT ScenarioError Identity [Validated]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Text, IntegrationalScenario)]
scenarios (((Text, IntegrationalScenario)
  -> ExceptT ScenarioError Identity Validated)
 -> StateT InternalState (Except ScenarioError) [Validated])
-> ((Text, IntegrationalScenario)
    -> ExceptT ScenarioError Identity Validated)
-> StateT InternalState (Except ScenarioError) [Validated]
forall a b. (a -> b) -> a -> b
$ \(name :: Text
name, scenario :: IntegrationalScenario
scenario) ->
    (ScenarioError -> ScenarioError)
-> ExceptT ScenarioError Identity Validated
-> ExceptT ScenarioError Identity Validated
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) (ExceptT ScenarioError Identity Validated
 -> ExceptT ScenarioError Identity Validated)
-> ExceptT ScenarioError Identity Validated
-> ExceptT ScenarioError Identity Validated
forall a b. (a -> b) -> a -> b
$
    IntegrationalScenario
-> InternalState -> ExceptT ScenarioError Identity Validated
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT IntegrationalScenario
scenario InternalState
st
  case [Validated] -> Maybe (NonEmpty Validated)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Validated]
res of
    Nothing -> Text -> IntegrationalScenario
forall a. HasCallStack => Text -> a
error "branch: empty list of scenarios provided"
    Just (validated :: Validated
validated :| _) -> Validated -> IntegrationalScenario
forall (f :: * -> *) a. Applicative f => a -> f a
pure Validated
validated

-- | 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 -> IntegrationalScenarioM ()
offshoot :: Text
-> IntegrationalScenario
-> StateT InternalState (Except ScenarioError) ()
offshoot name :: Text
name scenario :: IntegrationalScenario
scenario = do
  InternalState
st <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
  Validated
Validated <- ExceptT ScenarioError Identity Validated -> IntegrationalScenario
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT ScenarioError Identity Validated -> IntegrationalScenario)
-> ExceptT ScenarioError Identity Validated
-> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$
    (ScenarioError -> ScenarioError)
-> ExceptT ScenarioError Identity Validated
-> ExceptT ScenarioError Identity Validated
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) (ExceptT ScenarioError Identity Validated
 -> ExceptT ScenarioError Identity Validated)
-> ExceptT ScenarioError Identity Validated
-> ExceptT ScenarioError Identity Validated
forall a b. (a -> b) -> a -> b
$
    IntegrationalScenario
-> InternalState -> ExceptT ScenarioError Identity Validated
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT IntegrationalScenario
scenario InternalState
st
  StateT InternalState (Except ScenarioError) ()
forall (f :: * -> *). Applicative f => f ()
pass

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

-- | 'SuccessValidator' that always passes.
expectAnySuccess :: SuccessValidator
expectAnySuccess :: SuccessValidator
expectAnySuccess _ _ _ = Either ValidationError ()
forall (f :: * -> *). Applicative f => f ()
pass

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

-- | Check that there were no storage updates.
expectNoStorageUpdates :: SuccessValidator
expectNoStorageUpdates :: SuccessValidator
expectNoStorageUpdates _ _ updates :: [GStateUpdate]
updates =
  Either ValidationError ()
-> (NonEmpty GStateUpdate -> Either ValidationError ())
-> Maybe (NonEmpty GStateUpdate)
-> Either ValidationError ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either ValidationError ()
forall (f :: * -> *). Applicative f => f ()
pass (ValidationError -> Either ValidationError ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ValidationError -> Either ValidationError ())
-> (NonEmpty GStateUpdate -> ValidationError)
-> NonEmpty GStateUpdate
-> Either ValidationError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty GStateUpdate -> ValidationError
UnexpectedUpdates) (Maybe (NonEmpty GStateUpdate) -> Either ValidationError ())
-> ([GStateUpdate] -> Maybe (NonEmpty GStateUpdate))
-> [GStateUpdate]
-> Either ValidationError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GStateUpdate] -> Maybe (NonEmpty GStateUpdate)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([GStateUpdate] -> Either ValidationError ())
-> [GStateUpdate] -> Either ValidationError ()
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 ValidationError ())
  -> SuccessValidator
expectStorage :: Address -> (Value -> Either ValidationError ()) -> SuccessValidator
expectStorage addr :: Address
addr predicate :: Value -> Either ValidationError ()
predicate is :: InternalState
is gs :: GState
gs _ =
  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 ValidationError ()
predicate (Value -> Either ValidationError ())
-> Value -> Either ValidationError ()
forall a b. (a -> b) -> a -> b
$ ContractState -> Value
csStorage ContractState
cs
    Just (ASSimple {}) ->
      ValidationError -> Either ValidationError ()
forall a b. a -> Either a b
Left (ValidationError -> Either ValidationError ())
-> ValidationError -> Either ValidationError ()
forall a b. (a -> b) -> a -> b
$ Text -> ValidationError
intro (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$ "it's a simple address"
    Nothing -> ValidationError -> Either ValidationError ()
forall a b. a -> Either a b
Left (ValidationError -> Either ValidationError ())
-> ValidationError -> Either ValidationError ()
forall a b. (a -> b) -> a -> b
$ Text -> ValidationError
intro (Text -> ValidationError) -> Text -> ValidationError
forall a b. (a -> b) -> a -> b
$ "it's unknown"
  where
    intro :: Text -> ValidationError
intro = AddressName -> Text -> ValidationError
StoragePredicateMismatch (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is)

-- | 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 ValidationError ())
  -> SuccessValidator
expectStorageUpdate :: Address -> (Value -> Either ValidationError ()) -> SuccessValidator
expectStorageUpdate addr :: Address
addr predicate :: Value -> Either ValidationError ()
predicate 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 -> ValidationError -> Either ValidationError ()
forall a b. a -> Either a b
Left (ValidationError -> Either ValidationError ())
-> ValidationError -> Either ValidationError ()
forall a b. (a -> b) -> a -> b
$
      AddressName -> Text -> ValidationError
IncorrectStorageUpdate (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) "storage wasn't updated"
    Just (GSSetStorageValue _ val :: Value
val _) ->
      (ValidationError -> ValidationError)
-> Either ValidationError () -> Either ValidationError ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (AddressName -> Text -> ValidationError
IncorrectStorageUpdate (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) (Text -> ValidationError)
-> (ValidationError -> Text) -> ValidationError -> ValidationError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidationError -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) (Either ValidationError () -> Either ValidationError ())
-> Either ValidationError () -> Either ValidationError ()
forall a b. (a -> b) -> a -> b
$
      Value -> Either ValidationError ()
predicate Value
val
    -- 'checkAddr' ensures that only 'GSSetStorageValue' can be found
    Just _ -> Text -> Either ValidationError ()
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
  -> SuccessValidator
expectStorageUpdateConst :: Address -> Value -> SuccessValidator
expectStorageUpdateConst addr :: Address
addr expected :: Value
expected is :: InternalState
is =
  Address -> (Value -> Either ValidationError ()) -> SuccessValidator
expectStorageUpdate Address
addr Value -> Either ValidationError ()
predicate InternalState
is
  where
    predicate :: Value -> Either ValidationError ()
predicate val :: Value
val
      | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
expected = Either ValidationError ()
forall (f :: * -> *). Applicative f => f ()
pass
      | Bool
otherwise = ValidationError -> Either ValidationError ()
forall a b. a -> Either a b
Left (ValidationError -> Either ValidationError ())
-> ValidationError -> Either ValidationError ()
forall a b. (a -> b) -> a -> b
$
        AddressName -> Text -> ValidationError
IncorrectStorageUpdate (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) (Value -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Value
expected)

-- | Check that eventually address has some particular storage value.
expectStorageConst :: Address -> Value -> SuccessValidator
expectStorageConst :: Address -> Value -> SuccessValidator
expectStorageConst addr :: Address
addr expected :: Value
expected is :: InternalState
is = Address -> (Value -> Either ValidationError ()) -> SuccessValidator
expectStorage Address
addr Value -> Either ValidationError ()
predicate InternalState
is
  where
    predicate :: Value -> Either ValidationError ()
predicate val :: Value
val
      | Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
expected = Either ValidationError ()
forall (f :: * -> *). Applicative f => f ()
pass
      | Bool
otherwise = ValidationError -> Either ValidationError ()
forall a b. a -> Either a b
Left (ValidationError -> Either ValidationError ())
-> ValidationError -> Either ValidationError ()
forall a b. (a -> b) -> a -> b
$
        AddressName -> ExpectedStorage -> Text -> ValidationError
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)

-- | Similar to 'expectStorageConst', for typed stuff.
tExpectStorageConst
  :: forall st.
     (StorageScope st)
  => Address -> Typed.Value st -> SuccessValidator
tExpectStorageConst :: Address -> Value st -> SuccessValidator
tExpectStorageConst addr :: Address
addr expected :: Value st
expected =
  Address -> Value -> SuccessValidator
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 -> SuccessValidator
expectBalance :: Address -> Mutez -> SuccessValidator
expectBalance addr :: Address
addr balance :: Mutez
balance 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 ValidationError ()
forall (f :: * -> *). Applicative f => f ()
pass
  else
    ValidationError -> Either ValidationError ()
forall a b. a -> Either a b
Left
    (ValidationError -> Either ValidationError ())
-> ValidationError -> Either ValidationError ()
forall a b. (a -> b) -> a -> b
$ AddressName -> ExpectedBalance -> Text -> ValidationError
InvalidBalance (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) (Mutez -> ExpectedBalance
ExpectedBalance Mutez
balance)
    (Text -> ValidationError) -> Text -> ValidationError
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

-- | Compose two success validators.
--
-- For example:
--
-- expectBalance bal addr `composeValidators`
-- expectStorageUpdateConst addr2 ValueUnit
composeValidators ::
     SuccessValidator
  -> SuccessValidator
  -> SuccessValidator
composeValidators :: SuccessValidator -> SuccessValidator -> SuccessValidator
composeValidators val1 :: SuccessValidator
val1 val2 :: SuccessValidator
val2 gState :: InternalState
gState updates :: GState
updates =
  SuccessValidator
val1 InternalState
gState GState
updates ([GStateUpdate] -> Either ValidationError ())
-> ([GStateUpdate] -> Either ValidationError ())
-> [GStateUpdate]
-> Either ValidationError ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SuccessValidator
val2 InternalState
gState GState
updates

-- | Compose a list of success validators.
composeValidatorsList :: [SuccessValidator] -> SuccessValidator
composeValidatorsList :: [SuccessValidator] -> SuccessValidator
composeValidatorsList = (SuccessValidator
 -> Element [SuccessValidator] -> SuccessValidator)
-> SuccessValidator -> [SuccessValidator] -> SuccessValidator
forall t b. Container t => (b -> Element t -> b) -> b -> t -> b
foldl' SuccessValidator -> Element [SuccessValidator] -> SuccessValidator
SuccessValidator -> SuccessValidator -> SuccessValidator
composeValidators SuccessValidator
expectAnySuccess

-- | Check that interpreter failed due to gas exhaustion.
expectGasExhaustion :: ExecutorError -> Bool
expectGasExhaustion :: ExecutorError -> Bool
expectGasExhaustion =
  \case
    EEInterpreterFailed _ (RuntimeFailure (MichelsonGasExhaustion, _)) -> Bool
True
    _ -> Bool
False

-- | Expect that interpretation of contract with given address ended
-- with [FAILED].
expectMichelsonFailed :: (MichelsonFailed -> Bool) -> Address -> ExecutorError -> Bool
expectMichelsonFailed :: (MichelsonFailed -> Bool) -> Address -> ExecutorError -> Bool
expectMichelsonFailed predicate :: MichelsonFailed -> Bool
predicate addr :: Address
addr =
  \case
    EEInterpreterFailed failedAddr :: Address
failedAddr (RuntimeFailure (mf :: MichelsonFailed
mf, _)) ->
      Address
addr Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address
failedAddr Bool -> Bool -> Bool
&& MichelsonFailed -> Bool
predicate MichelsonFailed
mf
    _ -> Bool
False

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

initIS :: InternalState
initIS :: InternalState
initIS = $WInternalState :: RemainingSteps
-> Timestamp
-> GState
-> [ExecutorResOrError]
-> Maybe ExecutorResOrError
-> 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 ExecutorResOrError
_isExecutorResult = Maybe ExecutorResOrError
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 (Validated, InternalState)
-> Maybe ScenarioError
forall l r. Either l r -> Maybe l
leftToMaybe (Either ScenarioError (Validated, InternalState)
 -> Maybe ScenarioError)
-> Either ScenarioError (Validated, InternalState)
-> Maybe ScenarioError
forall a b. (a -> b) -> a -> b
$ Except ScenarioError (Validated, InternalState)
-> Either ScenarioError (Validated, InternalState)
forall e a. Except e a -> Either e a
runExcept (IntegrationalScenario
-> InternalState -> Except ScenarioError (Validated, InternalState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT IntegrationalScenario
scenario InternalState
initIS)

validateResult ::
     IntegrationalValidator
  -> ExecutorResOrError
  -> InternalState
  -> IntegrationalScenarioM ()
validateResult :: IntegrationalValidator
-> ExecutorResOrError
-> InternalState
-> StateT InternalState (Except ScenarioError) ()
validateResult validator :: IntegrationalValidator
validator result :: ExecutorResOrError
result iState :: InternalState
iState =
  case (IntegrationalValidator
validator, ExecutorResOrError
result) of
    (Left validateError :: ExecutorError -> Bool
validateError, Left err :: ExecutorError
err)
      | ExecutorError -> Bool
validateError ExecutorError
err -> StateT InternalState (Except ScenarioError) ()
forall (f :: * -> *). Applicative f => f ()
pass
    (_, Left err :: ExecutorError
err) ->
      ValidationError -> StateT InternalState (Except ScenarioError) ()
forall anything. ValidationError -> IntegrationalScenarioM anything
doFail (ValidationError -> StateT InternalState (Except ScenarioError) ())
-> ValidationError
-> StateT InternalState (Except ScenarioError) ()
forall a b. (a -> b) -> a -> b
$ IntegrationalExecutorError -> ValidationError
UnexpectedExecutorError (ExecutorError -> InternalState -> IntegrationalExecutorError
mkError ExecutorError
err InternalState
iState)
    (Left _, Right _) ->
      ValidationError -> StateT InternalState (Except ScenarioError) ()
forall anything. ValidationError -> IntegrationalScenarioM anything
doFail (ValidationError -> StateT InternalState (Except ScenarioError) ())
-> ValidationError
-> StateT InternalState (Except ScenarioError) ()
forall a b. (a -> b) -> a -> b
$ ValidationError
ExpectingInterpreterToFail
    (Right validateUpdates :: SuccessValidator
validateUpdates, Right ir :: ExecutorRes
ir)
      | Left bad :: ValidationError
bad <- SuccessValidator
validateUpdates InternalState
iState (ExecutorRes -> GState
_erGState ExecutorRes
ir) (ExecutorRes -> [GStateUpdate]
_erUpdates ExecutorRes
ir) ->
        ValidationError -> StateT InternalState (Except ScenarioError) ()
forall anything. ValidationError -> IntegrationalScenarioM anything
doFail (ValidationError -> StateT InternalState (Except ScenarioError) ())
-> ValidationError
-> StateT InternalState (Except ScenarioError) ()
forall a b. (a -> b) -> a -> b
$ ValidationError -> [GStateUpdate] -> ValidationError
IncorrectUpdates ValidationError
bad (ExecutorRes -> [GStateUpdate]
_erUpdates ExecutorRes
ir)
      | Bool
otherwise -> StateT InternalState (Except ScenarioError) ()
forall (f :: * -> *). Applicative f => f ()
pass
  where
    doFail :: ValidationError -> IntegrationalScenarioM anything
doFail = ValidationError -> IntegrationalScenarioM anything
forall anything. ValidationError -> IntegrationalScenarioM anything
integrationalFail
    mkError
      :: ExecutorError -> InternalState -> IntegrationalExecutorError
    mkError :: ExecutorError -> InternalState -> IntegrationalExecutorError
mkError iErr :: ExecutorError
iErr is :: InternalState
is = case ExecutorError
iErr of
      EEUnknownContract addr :: Address
addr -> AddressName -> IntegrationalExecutorError
forall a. a -> ExecutorError' a
EEUnknownContract (AddressName -> IntegrationalExecutorError)
-> AddressName -> IntegrationalExecutorError
forall a b. (a -> b) -> a -> b
$ Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is
      EEInterpreterFailed addr :: Address
addr err :: InterpretError
err ->
        AddressName -> InterpretError -> IntegrationalExecutorError
forall a. a -> InterpretError -> ExecutorError' a
EEInterpreterFailed (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) InterpretError
err
      EEAlreadyOriginated addr :: Address
addr cs :: ContractState
cs ->
        AddressName -> ContractState -> IntegrationalExecutorError
forall a. a -> ContractState -> ExecutorError' a
EEAlreadyOriginated (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) ContractState
cs
      EEUnknownSender addr :: Address
addr -> AddressName -> IntegrationalExecutorError
forall a. a -> ExecutorError' a
EEUnknownSender (AddressName -> IntegrationalExecutorError)
-> AddressName -> IntegrationalExecutorError
forall a b. (a -> b) -> a -> b
$ Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is
      EEUnknownManager addr :: Address
addr -> AddressName -> IntegrationalExecutorError
forall a. a -> ExecutorError' a
EEUnknownManager (AddressName -> IntegrationalExecutorError)
-> AddressName -> IntegrationalExecutorError
forall a b. (a -> b) -> a -> b
$ Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is
      EENotEnoughFunds addr :: Address
addr amount :: Mutez
amount ->
        AddressName -> Mutez -> IntegrationalExecutorError
forall a. a -> Mutez -> ExecutorError' a
EENotEnoughFunds (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) Mutez
amount
      EEZeroTransaction addr :: Address
addr ->
        AddressName -> IntegrationalExecutorError
forall a. a -> ExecutorError' a
EEZeroTransaction (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is)
      EEFailedToApplyUpdates err :: GStateUpdateError
err -> GStateUpdateError -> IntegrationalExecutorError
forall a. GStateUpdateError -> ExecutorError' a
EEFailedToApplyUpdates GStateUpdateError
err
      EEIllTypedContract err :: TCError
err -> TCError -> IntegrationalExecutorError
forall a. TCError -> ExecutorError' a
EEIllTypedContract TCError
err
      EEIllTypedStorage err :: TCError
err -> TCError -> IntegrationalExecutorError
forall a. TCError -> ExecutorError' a
EEIllTypedStorage TCError
err
      EEIllTypedParameter err :: TCError
err -> TCError -> IntegrationalExecutorError
forall a. TCError -> ExecutorError' a
EEIllTypedParameter TCError
err
      EEUnknownEntrypoint err :: EpName
err -> EpName -> IntegrationalExecutorError
forall a. EpName -> ExecutorError' a
EEUnknownEntrypoint EpName
err