module Michelson.Test.Integrational
(
TxData (..)
, genesisAddress
, genesisAddress1
, genesisAddress2
, genesisAddress3
, genesisAddress4
, genesisAddress5
, genesisAddress6
, IntegrationalValidator
, SuccessValidator
, IntegrationalScenarioM
, IntegrationalScenario
, ValidationError (..)
, integrationalTestExpectation
, integrationalTestProperty
, originate
, tOriginate
, transfer
, tTransfer
, validate
, integrationalFail
, setMaxSteps
, modifyNow
, setNow
, rewindTime
, withSender
, setChainId
, branchout
, (?-)
, offshoot
, 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)
type ExecutorResOrError = Either ExecutorError ExecutorRes
data InternalState = InternalState
{ InternalState -> RemainingSteps
_isMaxSteps :: RemainingSteps
, InternalState -> Timestamp
_isNow :: Timestamp
, InternalState -> GState
_isGState :: GState
, InternalState -> [ExecutorResOrError]
_isInterpreterLog :: [ExecutorResOrError]
, InternalState -> Maybe ExecutorResOrError
_isExecutorResult :: Maybe ExecutorResOrError
, InternalState -> Map Address Text
_isContractsNames :: Map Address Text
, InternalState -> Maybe Address
_isSender :: Maybe Address
}
makeLenses ''InternalState
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
type IntegrationalValidator = Either (ExecutorError -> Bool) SuccessValidator
type SuccessValidator = InternalState -> GState -> [GStateUpdate] -> Either ValidationError ()
type IntegrationalScenarioM = StateT InternalState (Except ScenarioError)
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
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
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))
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))
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
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 :: 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}
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 :: 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]
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 :: 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
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
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
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)
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)
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
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)
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)
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
emptyScenarioBranch :: ScenarioBranchName
emptyScenarioBranch :: ScenarioBranchName
emptyScenarioBranch = [Text] -> ScenarioBranchName
ScenarioBranchName []
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
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
(?-) :: Text -> a -> (Text, a)
?- :: Text -> a -> (Text, a)
(?-) = (,)
infixr 0 ?-
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
expectAnySuccess :: SuccessValidator
expectAnySuccess :: SuccessValidator
expectAnySuccess _ _ _ = Either ValidationError ()
forall (f :: * -> *). Applicative f => f ()
pass
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
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
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)
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
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
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)
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)
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)
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
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
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
expectGasExhaustion :: ExecutorError -> Bool
expectGasExhaustion :: ExecutorError -> Bool
expectGasExhaustion =
\case
EEInterpreterFailed _ (RuntimeFailure (MichelsonGasExhaustion, _)) -> Bool
True
_ -> Bool
False
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
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