{-# OPTIONS_GHC -Wno-deprecations #-}
module Michelson.Test.Integrational
(
TxData (..)
, genesisAddress
, genesisAddress1
, genesisAddress2
, genesisAddress3
, genesisAddress4
, genesisAddress5
, genesisAddress6
, IntegrationalScenarioM
, IntegrationalScenario
, TestError (..)
, integrationalTestExpectation
, integrationalTestProp
, originate
, tOriginate
, transfer
, tTransfer
, integrationalFail
, unexpectedInterpreterError
, setMaxSteps
, modifyNow
, setNow
, rewindTime
, withSender
, setChainId
, branchout
, (?-)
, offshoot
, expectNoUpdates
, expectNoStorageUpdates
, expectStorageUpdate
, expectStorageUpdateConst
, expectBalance
, expectStorage
, expectStorageConst
, tExpectStorageConst
, attempt
, expectError
, catchExpectedError
, expectGasExhaustion
, expectMichelsonFailed
, isGState
, integrationalTestProperty
) where
import Control.Lens (assign, at, makeLenses, makeLensesFor, modifying, (%=), (.=), (<>=), (?=))
import Control.Monad.Except (Except, catchError, runExcept, throwError, withExcept)
import qualified Data.List as List
import Data.Map as Map (empty, insert, lookup)
import Fmt (Buildable(..), blockListF, listF, pretty, (+|), (|+))
import Hedgehog (MonadTest)
import Named ((:!), arg)
import Test.Hspec (Expectation, expectationFailure)
import qualified Test.QuickCheck as QC
import Michelson.Interpret (InterpretError(..), MichelsonFailed(..), RemainingSteps)
import Michelson.Runtime
(ExecutorError, ExecutorError'(..), ExecutorM, ExecutorOp(..), ExecutorRes(..),
executeGlobalOperations, executeOrigination, runExecutorM, withGlobalOperation)
import Michelson.Runtime.GState
import Michelson.Runtime.TxData
import Michelson.Test.Dummy
import Michelson.Test.Util (failedProp, failedTest, succeededProp, succeededTest)
import Michelson.TypeCheck (TCError)
import qualified Michelson.Typed as Typed
import Michelson.Typed.Scope (ParameterScope, StorageScope, properParameterEvi, withDict)
import Michelson.Untyped (Contract, EpName, OriginationOperation(..), Value)
import Tezos.Address (Address)
import Tezos.Core (ChainId, Mutez, Timestamp, timestampPlusSeconds, unsafeMkMutez)
type ExecutorResOrError a = Either ExecutorError (ExecutorRes, a)
type ExecutorResOrError' = Either ExecutorError ExecutorRes
data InternalState = InternalState
{ InternalState -> RemainingSteps
_isMaxSteps :: RemainingSteps
, InternalState -> Timestamp
_isNow :: Timestamp
, InternalState -> GState
_isGState :: GState
, InternalState -> [ExecutorResOrError']
_isInterpreterLog :: [ExecutorResOrError']
, InternalState -> Maybe ExecutorRes
_isExecutorResult :: Maybe ExecutorRes
, 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 IntegrationalScenarioM = StateT InternalState (Except ScenarioError)
type IntegrationalScenario = IntegrationalScenarioM ()
newtype ExpectedStorage = ExpectedStorage Value deriving stock (Int -> ExpectedStorage -> ShowS
[ExpectedStorage] -> ShowS
ExpectedStorage -> String
(Int -> ExpectedStorage -> ShowS)
-> (ExpectedStorage -> String)
-> ([ExpectedStorage] -> ShowS)
-> Show ExpectedStorage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpectedStorage] -> ShowS
$cshowList :: [ExpectedStorage] -> ShowS
show :: ExpectedStorage -> String
$cshow :: ExpectedStorage -> String
showsPrec :: Int -> ExpectedStorage -> ShowS
$cshowsPrec :: Int -> ExpectedStorage -> ShowS
Show)
newtype ExpectedBalance = ExpectedBalance Mutez deriving stock (Int -> ExpectedBalance -> ShowS
[ExpectedBalance] -> ShowS
ExpectedBalance -> String
(Int -> ExpectedBalance -> ShowS)
-> (ExpectedBalance -> String)
-> ([ExpectedBalance] -> ShowS)
-> Show ExpectedBalance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExpectedBalance] -> ShowS
$cshowList :: [ExpectedBalance] -> ShowS
show :: ExpectedBalance -> String
$cshow :: ExpectedBalance -> String
showsPrec :: Int -> ExpectedBalance -> ShowS
$cshowsPrec :: Int -> ExpectedBalance -> ShowS
Show)
data AddressName = AddressName (Maybe Text) Address deriving stock (Int -> AddressName -> ShowS
[AddressName] -> ShowS
AddressName -> String
(Int -> AddressName -> ShowS)
-> (AddressName -> String)
-> ([AddressName] -> ShowS)
-> Show AddressName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressName] -> ShowS
$cshowList :: [AddressName] -> ShowS
show :: AddressName -> String
$cshow :: AddressName -> String
showsPrec :: Int -> AddressName -> ShowS
$cshowsPrec :: Int -> AddressName -> ShowS
Show)
addrToAddrName :: Address -> InternalState -> AddressName
addrToAddrName :: Address -> InternalState -> AddressName
addrToAddrName addr :: Address
addr iState :: InternalState
iState =
Maybe Text -> Address -> AddressName
AddressName (Address -> Map Address Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
lookup Address
addr (InternalState
iState InternalState
-> Getting (Map Address Text) InternalState (Map Address Text)
-> Map Address Text
forall s a. s -> Getting a s a -> a
^. Getting (Map Address Text) InternalState (Map Address Text)
Lens' InternalState (Map Address Text)
isContractsNames)) Address
addr
addrNameToAddr :: AddressName -> Address
addrNameToAddr :: AddressName -> Address
addrNameToAddr (AddressName _ addr :: Address
addr) = Address
addr
instance Buildable AddressName where
build :: AddressName -> Builder
build (AddressName mbName :: Maybe Text
mbName addr :: Address
addr) =
Address -> Builder
forall p. Buildable p => p -> Builder
build Address
addr Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Builder -> (Text -> Builder) -> Maybe Text -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (\cName :: Text
cName -> " (" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+|Text
cName Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ")") Maybe Text
mbName
type IntegrationalExecutorError = ExecutorError' AddressName
data TestError
= InterpreterError IntegrationalExecutorError
| UnexpectedInterpreterError Text IntegrationalExecutorError
| UnexpectedTypeCheckError TCError
| ExpectingInterpreterToFail
| IncorrectUpdates TestError [GStateUpdate]
| IncorrectStorageUpdate AddressName Text
| InvalidStorage AddressName ExpectedStorage Text
| StoragePredicateMismatch AddressName Text
| InvalidBalance AddressName ExpectedBalance Text
| UnexpectedUpdates (NonEmpty GStateUpdate)
| ValidatingEmptyScenario
| CustomTestError Text
deriving stock (Int -> TestError -> ShowS
[TestError] -> ShowS
TestError -> String
(Int -> TestError -> ShowS)
-> (TestError -> String)
-> ([TestError] -> ShowS)
-> Show TestError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestError] -> ShowS
$cshowList :: [TestError] -> ShowS
show :: TestError -> String
$cshow :: TestError -> String
showsPrec :: Int -> TestError -> ShowS
$cshowsPrec :: Int -> TestError -> ShowS
Show)
instance Buildable TestError where
build :: TestError -> Builder
build (InterpreterError iErr :: IntegrationalExecutorError
iErr) =
"Interpreter failed: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| IntegrationalExecutorError
iErr IntegrationalExecutorError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
build (UnexpectedInterpreterError reason :: Text
reason iErr :: IntegrationalExecutorError
iErr) =
"Unexpected interpreter error. Reason: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
reason Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ". Got: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| IntegrationalExecutorError
iErr IntegrationalExecutorError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
build (UnexpectedTypeCheckError tcErr :: TCError
tcErr) =
"Unexpected type check error. Reason: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| TCError
tcErr TCError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
build ExpectingInterpreterToFail =
"Interpreter unexpectedly didn't fail"
build (IncorrectUpdates vErr :: TestError
vErr updates :: [GStateUpdate]
updates) =
"Updates are incorrect: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| TestError
vErr TestError -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ " . Updates are:"
Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| [GStateUpdate] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
blockListF [GStateUpdate]
updates Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
build (IncorrectStorageUpdate addr :: AddressName
addr msg :: Text
msg) =
"Storage of " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| AddressName
addr AddressName -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ " is updated incorrectly: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
msg Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
build (InvalidStorage addr :: AddressName
addr (ExpectedStorage expected :: Value
expected) msg :: Text
msg) =
"Expected " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| AddressName
addr AddressName -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ " to have storage " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Value
expected Value -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ", but " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
msg Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
build (StoragePredicateMismatch addr :: AddressName
addr msg :: Text
msg) =
"Expected " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| AddressName
addr AddressName -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ " to have storage that matches the predicate, but" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
msg Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
build (InvalidBalance addr :: AddressName
addr (ExpectedBalance expected :: Mutez
expected) msg :: Text
msg) =
"Expected " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| AddressName
addr AddressName -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ " to have balance " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Mutez
expected Mutez -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ", but " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
msg Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
build (UnexpectedUpdates updates :: NonEmpty GStateUpdate
updates) =
"Did not expect certain updates, but there are some: " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| NonEmpty GStateUpdate -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
listF NonEmpty GStateUpdate
updates Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ ""
build ValidatingEmptyScenario =
"Validating empty scenario"
build (CustomTestError msg :: Text
msg) = Text -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Text
msg
instance Exception TestError where
displayException :: TestError -> String
displayException = TestError -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty
data ScenarioError = ScenarioError
{ ScenarioError -> ScenarioBranchName
_seBranch :: ScenarioBranchName
, ScenarioError -> TestError
_seError :: TestError
}
makeLensesFor [("_seBranch", "seBranch")] ''ScenarioError
instance Buildable ScenarioError where
build :: ScenarioError -> Builder
build (ScenarioError br :: ScenarioBranchName
br err :: TestError
err) =
let builtBranch :: Builder
builtBranch
| ScenarioBranchName -> Bool
nullScenarioBranch ScenarioBranchName
br = ""
| Bool
otherwise = "In '" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ScenarioBranchName
br ScenarioBranchName -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ "' branch:\n"
in Builder
builtBranch Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TestError -> Builder
forall p. Buildable p => p -> Builder
build TestError
err
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 -> QC.Property
integrationalTestProperty :: IntegrationalScenario -> Property
integrationalTestProperty =
(Maybe ScenarioError -> Property)
-> IntegrationalScenario -> Property
forall res.
(Maybe ScenarioError -> res) -> IntegrationalScenario -> res
integrationalTest (Property
-> (ScenarioError -> Property) -> Maybe ScenarioError -> Property
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Property
succeededProp (Text -> Property
failedProp (Text -> Property)
-> (ScenarioError -> Text) -> ScenarioError -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioError -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty))
{-# DEPRECATED integrationalTestProperty "Use 'integrationalTestProp' instead." #-}
integrationalTestProp :: MonadTest m => IntegrationalScenario -> m ()
integrationalTestProp :: IntegrationalScenario -> m ()
integrationalTestProp scenario :: IntegrationalScenario
scenario =
(Maybe ScenarioError -> m ()) -> IntegrationalScenario -> m ()
forall res.
(Maybe ScenarioError -> res) -> IntegrationalScenario -> res
integrationalTest (m () -> (ScenarioError -> m ()) -> Maybe ScenarioError -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m ()
forall (m :: * -> *). MonadTest m => m ()
succeededTest (Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadTest m) => Text -> m ()
failedTest (Text -> m ()) -> (ScenarioError -> Text) -> ScenarioError -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioError -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty)) IntegrationalScenario
scenario
interpret :: ExecutorM a -> IntegrationalScenarioM (ExecutorResOrError a)
interpret :: ExecutorM a -> IntegrationalScenarioM (ExecutorResOrError a)
interpret action :: ExecutorM a
action = do
Timestamp
now <- Getting Timestamp InternalState Timestamp
-> StateT InternalState (Except ScenarioError) Timestamp
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Timestamp InternalState Timestamp
Lens' InternalState Timestamp
isNow
RemainingSteps
maxSteps <- Getting RemainingSteps InternalState RemainingSteps
-> StateT InternalState (Except ScenarioError) RemainingSteps
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting RemainingSteps InternalState RemainingSteps
Lens' InternalState RemainingSteps
isMaxSteps
GState
gState <- Getting GState InternalState GState
-> StateT InternalState (Except ScenarioError) GState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting GState InternalState GState
Lens' InternalState GState
isGState
let interpretedResult :: ExecutorResOrError a
interpretedResult = Timestamp
-> RemainingSteps -> GState -> ExecutorM a -> ExecutorResOrError a
forall a.
Timestamp
-> RemainingSteps
-> GState
-> ExecutorM a
-> Either ExecutorError (ExecutorRes, a)
runExecutorM Timestamp
now RemainingSteps
maxSteps GState
gState ExecutorM a
action
ExecutorResOrError a
-> ((ExecutorRes, a) -> IntegrationalScenario)
-> IntegrationalScenario
forall (f :: * -> *) l r.
Applicative f =>
Either l r -> (r -> f ()) -> f ()
whenRight ExecutorResOrError a
interpretedResult (((ExecutorRes, a) -> IntegrationalScenario)
-> IntegrationalScenario)
-> ((ExecutorRes, a) -> IntegrationalScenario)
-> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ \(result :: ExecutorRes
result, _) -> (GState -> Identity GState)
-> InternalState -> Identity InternalState
Lens' InternalState GState
isGState ((GState -> Identity GState)
-> InternalState -> Identity InternalState)
-> GState -> IntegrationalScenario
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ExecutorRes -> GState
_erGState ExecutorRes
result
return ExecutorResOrError a
interpretedResult
registerInterpretation :: [ExecutorOp] -> IntegrationalScenarioM ()
registerInterpretation :: [ExecutorOp] -> IntegrationalScenario
registerInterpretation ops :: [ExecutorOp]
ops =
ExecutorM () -> IntegrationalScenarioM (ExecutorResOrError ())
forall a.
ExecutorM a -> IntegrationalScenarioM (ExecutorResOrError a)
interpret ([ExecutorOp] -> ExecutorM ()
executeGlobalOperations [ExecutorOp]
ops) IntegrationalScenarioM (ExecutorResOrError ())
-> (ExecutorResOrError () -> ExecutorResOrError')
-> StateT InternalState (Except ScenarioError) ExecutorResOrError'
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((ExecutorRes, ()) -> ExecutorRes)
-> ExecutorResOrError () -> ExecutorResOrError'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ExecutorRes, ()) -> ExecutorRes
forall a b. (a, b) -> a
fst StateT InternalState (Except ScenarioError) ExecutorResOrError'
-> (ExecutorResOrError' -> IntegrationalScenario)
-> IntegrationalScenario
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExecutorResOrError' -> IntegrationalScenario
putResult
originate :: Contract -> Text -> Value -> Mutez -> IntegrationalScenarioM Address
originate :: Contract
-> Text -> Value -> Mutez -> IntegrationalScenarioM Address
originate contract :: Contract
contract contractName :: Text
contractName value :: Value
value balance :: Mutez
balance = do
InternalState
is <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
ExecutorResOrError Address
result <- ExecutorM Address
-> IntegrationalScenarioM (ExecutorResOrError Address)
forall a.
ExecutorM a -> IntegrationalScenarioM (ExecutorResOrError a)
interpret (ExecutorM Address
-> IntegrationalScenarioM (ExecutorResOrError Address))
-> ExecutorM Address
-> IntegrationalScenarioM (ExecutorResOrError Address)
forall a b. (a -> b) -> a -> b
$ ExecutorOp -> ExecutorM Address -> ExecutorM Address
forall a. ExecutorOp -> ExecutorM a -> ExecutorM a
withGlobalOperation (OriginationOperation -> ExecutorOp
OriginateOp OriginationOperation
origination)
(ExecutorM Address -> ExecutorM Address)
-> ExecutorM Address -> ExecutorM Address
forall a b. (a -> b) -> a -> b
$ OriginationOperation -> ExecutorM Address
executeOrigination OriginationOperation
origination
ExecutorResOrError' -> IntegrationalScenario
putResult (ExecutorResOrError' -> IntegrationalScenario)
-> ExecutorResOrError' -> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ ((ExecutorRes, Address) -> ExecutorRes)
-> ExecutorResOrError Address -> ExecutorResOrError'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ExecutorRes, Address) -> ExecutorRes
forall a b. (a, b) -> a
fst ExecutorResOrError Address
result
Address
address <- (ExecutorError -> IntegrationalScenarioM Address)
-> ((ExecutorRes, Address) -> IntegrationalScenarioM Address)
-> ExecutorResOrError Address
-> IntegrationalScenarioM Address
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (InternalState -> ExecutorError -> IntegrationalScenarioM Address
forall a.
InternalState -> ExecutorError -> IntegrationalScenarioM a
interpreterError InternalState
is) (Address -> IntegrationalScenarioM Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> IntegrationalScenarioM Address)
-> ((ExecutorRes, Address) -> Address)
-> (ExecutorRes, Address)
-> IntegrationalScenarioM Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExecutorRes, Address) -> Address
forall a b. (a, b) -> b
snd) (ExecutorResOrError Address -> IntegrationalScenarioM Address)
-> ExecutorResOrError Address -> IntegrationalScenarioM Address
forall a b. (a -> b) -> a -> b
$ ExecutorResOrError Address
result
(Map Address Text -> Identity (Map Address Text))
-> InternalState -> Identity InternalState
Lens' InternalState (Map Address Text)
isContractsNames ((Map Address Text -> Identity (Map Address Text))
-> InternalState -> Identity InternalState)
-> (Map Address Text -> Map Address Text) -> IntegrationalScenario
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Address -> Text -> Map Address Text -> Map Address Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Address
address Text
contractName
return Address
address
where
interpreterError :: InternalState -> ExecutorError -> IntegrationalScenarioM a
interpreterError :: InternalState -> ExecutorError -> IntegrationalScenarioM a
interpreterError is :: InternalState
is = TestError -> IntegrationalScenarioM a
forall anything. TestError -> IntegrationalScenarioM anything
integrationalFail (TestError -> IntegrationalScenarioM a)
-> (ExecutorError -> TestError)
-> ExecutorError
-> IntegrationalScenarioM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntegrationalExecutorError -> TestError
InterpreterError (IntegrationalExecutorError -> TestError)
-> (ExecutorError -> IntegrationalExecutorError)
-> ExecutorError
-> TestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalState -> ExecutorError -> IntegrationalExecutorError
mkError InternalState
is
origination :: OriginationOperation
origination = (Value -> Contract -> OriginationOperation
dummyOrigination Value
value Contract
contract) {ooBalance :: Mutez
ooBalance = Mutez
balance}
tOriginate ::
(ParameterScope cp, StorageScope st)
=> Typed.Contract cp st
-> Text
-> Typed.Value st
-> Mutez
-> IntegrationalScenarioM Address
tOriginate :: Contract cp st
-> Text -> Value st -> Mutez -> IntegrationalScenarioM Address
tOriginate contract :: Contract cp st
contract name :: Text
name value :: Value st
value balance :: Mutez
balance =
Contract
-> Text -> Value -> Mutez -> IntegrationalScenarioM Address
originate (Contract cp st -> Contract
forall (param :: T) (store :: T).
(SingI param, SingI store) =>
Contract param store -> Contract
Typed.convertContract Contract cp st
contract) Text
name
(Value st -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
Typed.untypeValue Value st
value) Mutez
balance
transfer :: TxData -> Address -> IntegrationalScenarioM ()
transfer :: TxData -> Address -> IntegrationalScenario
transfer txData :: TxData
txData destination :: Address
destination = do
Maybe Address
mSender <- Getting (Maybe Address) InternalState (Maybe Address)
-> StateT InternalState (Except ScenarioError) (Maybe Address)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe Address) InternalState (Maybe Address)
Lens' InternalState (Maybe Address)
isSender
let unwrappedData :: TxData
unwrappedData = (TxData -> TxData)
-> (Address -> TxData -> TxData)
-> Maybe Address
-> TxData
-> TxData
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TxData -> TxData
forall a. a -> a
id (ASetter TxData TxData Address Address
-> Address -> TxData -> TxData
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter TxData TxData Address Address
Lens' TxData Address
tdSenderAddressL) Maybe Address
mSender TxData
txData
[ExecutorOp] -> IntegrationalScenario
registerInterpretation [Address -> TxData -> ExecutorOp
TransferOp Address
destination TxData
unwrappedData]
tTransfer
:: forall arg.
(ParameterScope arg)
=> "from" :! Address
-> "to" :! Address
-> Mutez
-> EpName
-> Typed.Value arg
-> IntegrationalScenarioM ()
tTransfer :: ("from" :! Address)
-> ("to" :! Address)
-> Mutez
-> EpName
-> Value arg
-> IntegrationalScenario
tTransfer (Name "from" -> ("from" :! Address) -> Address
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "from" (Name "from")
Name "from"
#from -> Address
from) (Name "to" -> ("to" :! Address) -> Address
forall (name :: Symbol) a. Name name -> (name :! a) -> a
arg IsLabel "to" (Name "to")
Name "to"
#to -> Address
to) money :: Mutez
money epName :: EpName
epName param :: Value arg
param =
let txData :: TxData
txData = $WTxData :: Address -> Value -> EpName -> Mutez -> TxData
TxData
{ tdSenderAddress :: Address
tdSenderAddress = Address
from
, tdParameter :: Value
tdParameter =
((KnownT arg, () :: Constraint, () :: Constraint)
:- ParameterScope arg)
-> (ParameterScope arg => Value) -> Value
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (ProperParameterBetterErrors arg :- ParameterScope arg
forall (t :: T). ProperParameterBetterErrors t :- ParameterScope t
properParameterEvi @arg) ((ParameterScope arg => Value) -> Value)
-> (ParameterScope arg => Value) -> Value
forall a b. (a -> b) -> a -> b
$
Value arg -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
Typed.untypeValue Value arg
param
, tdEntrypoint :: EpName
tdEntrypoint = EpName
epName
, tdAmount :: Mutez
tdAmount = Mutez
money
}
in TxData -> Address -> IntegrationalScenario
transfer TxData
txData Address
to
validate
:: (InternalState -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
validate :: (InternalState -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
validate validator :: InternalState -> GState -> [GStateUpdate] -> Either TestError ()
validator = do
InternalState
iState <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
Maybe ExecutorRes
interpreterResult <- Getting (Maybe ExecutorRes) InternalState (Maybe ExecutorRes)
-> StateT InternalState (Except ScenarioError) (Maybe ExecutorRes)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe ExecutorRes) InternalState (Maybe ExecutorRes)
Lens' InternalState (Maybe ExecutorRes)
isExecutorResult
case Maybe ExecutorRes
interpreterResult of
Nothing -> TestError -> IntegrationalScenario
forall anything. TestError -> IntegrationalScenarioM anything
integrationalFail TestError
ValidatingEmptyScenario
Just result :: ExecutorRes
result -> do
case InternalState -> GState -> [GStateUpdate] -> Either TestError ()
validator InternalState
iState (ExecutorRes -> GState
_erGState ExecutorRes
result) (ExecutorRes -> [GStateUpdate]
_erUpdates ExecutorRes
result) of
Left bad :: TestError
bad -> TestError -> IntegrationalScenario
forall anything. TestError -> IntegrationalScenarioM anything
integrationalFail (TestError -> IntegrationalScenario)
-> TestError -> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ TestError -> [GStateUpdate] -> TestError
IncorrectUpdates TestError
bad (ExecutorRes -> [GStateUpdate]
_erUpdates ExecutorRes
result)
Right () -> IntegrationalScenario
forall (f :: * -> *). Applicative f => f ()
pass
integrationalFail :: TestError -> IntegrationalScenarioM anything
integrationalFail :: TestError -> IntegrationalScenarioM anything
integrationalFail = ScenarioError -> IntegrationalScenarioM anything
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ScenarioError -> IntegrationalScenarioM anything)
-> (TestError -> ScenarioError)
-> TestError
-> IntegrationalScenarioM anything
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioBranchName -> TestError -> ScenarioError
ScenarioError ScenarioBranchName
emptyScenarioBranch
unexpectedInterpreterError :: ExecutorError -> Text -> IntegrationalScenarioM a
unexpectedInterpreterError :: ExecutorError -> Text -> IntegrationalScenarioM a
unexpectedInterpreterError err :: ExecutorError
err reason :: Text
reason = do
InternalState
iState <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
TestError -> IntegrationalScenarioM a
forall anything. TestError -> IntegrationalScenarioM anything
integrationalFail (TestError -> IntegrationalScenarioM a)
-> TestError -> IntegrationalScenarioM a
forall a b. (a -> b) -> a -> b
$ Text -> IntegrationalExecutorError -> TestError
UnexpectedInterpreterError Text
reason (InternalState -> ExecutorError -> IntegrationalExecutorError
mkError InternalState
iState ExecutorError
err)
modifyNow :: (Timestamp -> Timestamp) -> IntegrationalScenarioM ()
modifyNow :: (Timestamp -> Timestamp) -> IntegrationalScenario
modifyNow = ASetter InternalState InternalState Timestamp Timestamp
-> (Timestamp -> Timestamp) -> IntegrationalScenario
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying ASetter InternalState InternalState Timestamp Timestamp
Lens' InternalState Timestamp
isNow
setNow :: Timestamp -> IntegrationalScenarioM ()
setNow :: Timestamp -> IntegrationalScenario
setNow time :: Timestamp
time = (Timestamp -> Timestamp) -> IntegrationalScenario
modifyNow (Timestamp -> Timestamp -> Timestamp
forall a b. a -> b -> a
const Timestamp
time)
rewindTime :: Integer -> IntegrationalScenarioM ()
rewindTime :: Integer -> IntegrationalScenario
rewindTime interval :: Integer
interval = (Timestamp -> Timestamp) -> IntegrationalScenario
modifyNow ((Timestamp -> Integer -> Timestamp)
-> Integer -> Timestamp -> Timestamp
forall a b c. (a -> b -> c) -> b -> a -> c
flip Timestamp -> Integer -> Timestamp
timestampPlusSeconds Integer
interval)
setMaxSteps :: RemainingSteps -> IntegrationalScenarioM ()
setMaxSteps :: RemainingSteps -> IntegrationalScenario
setMaxSteps = ASetter InternalState InternalState RemainingSteps RemainingSteps
-> RemainingSteps -> IntegrationalScenario
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter InternalState InternalState RemainingSteps RemainingSteps
Lens' InternalState RemainingSteps
isMaxSteps
withSender :: Address -> IntegrationalScenarioM a -> IntegrationalScenarioM a
withSender :: Address -> IntegrationalScenarioM a -> IntegrationalScenarioM a
withSender addr :: Address
addr scenario :: IntegrationalScenarioM a
scenario = do
Maybe Address
prevSender <- Getting (Maybe Address) InternalState (Maybe Address)
-> StateT InternalState (Except ScenarioError) (Maybe Address)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe Address) InternalState (Maybe Address)
Lens' InternalState (Maybe Address)
isSender
(Maybe Address -> Identity (Maybe Address))
-> InternalState -> Identity InternalState
Lens' InternalState (Maybe Address)
isSender ((Maybe Address -> Identity (Maybe Address))
-> InternalState -> Identity InternalState)
-> Address -> IntegrationalScenario
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= Address
addr
IntegrationalScenarioM a
scenario IntegrationalScenarioM a
-> IntegrationalScenario -> IntegrationalScenarioM a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ((Maybe Address -> Identity (Maybe Address))
-> InternalState -> Identity InternalState
Lens' InternalState (Maybe Address)
isSender ((Maybe Address -> Identity (Maybe Address))
-> InternalState -> Identity InternalState)
-> Maybe Address -> IntegrationalScenario
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Address
prevSender)
setChainId :: ChainId -> IntegrationalScenarioM ()
setChainId :: ChainId -> IntegrationalScenario
setChainId = ASetter InternalState InternalState ChainId ChainId
-> ChainId -> IntegrationalScenario
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ((GState -> Identity GState)
-> InternalState -> Identity InternalState
Lens' InternalState GState
isGState ((GState -> Identity GState)
-> InternalState -> Identity InternalState)
-> ((ChainId -> Identity ChainId) -> GState -> Identity GState)
-> ASetter InternalState InternalState ChainId ChainId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainId -> Identity ChainId) -> GState -> Identity GState
Lens' GState ChainId
gsChainIdL)
putResult :: ExecutorResOrError' -> IntegrationalScenarioM ()
putResult :: ExecutorResOrError' -> IntegrationalScenario
putResult resOrErr :: ExecutorResOrError'
resOrErr = do
([ExecutorResOrError'] -> Identity [ExecutorResOrError'])
-> InternalState -> Identity InternalState
Lens' InternalState [ExecutorResOrError']
isInterpreterLog (([ExecutorResOrError'] -> Identity [ExecutorResOrError'])
-> InternalState -> Identity InternalState)
-> [ExecutorResOrError'] -> IntegrationalScenario
forall s (m :: * -> *) a.
(MonadState s m, Monoid a) =>
ASetter' s a -> a -> m ()
<>= OneItem [ExecutorResOrError'] -> [ExecutorResOrError']
forall x. One x => OneItem x -> x
one ExecutorResOrError'
OneItem [ExecutorResOrError']
resOrErr
case ExecutorResOrError'
resOrErr of
Right res :: ExecutorRes
res -> (Maybe ExecutorRes -> Identity (Maybe ExecutorRes))
-> InternalState -> Identity InternalState
Lens' InternalState (Maybe ExecutorRes)
isExecutorResult ((Maybe ExecutorRes -> Identity (Maybe ExecutorRes))
-> InternalState -> Identity InternalState)
-> Maybe ExecutorRes -> IntegrationalScenario
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ExecutorRes -> Maybe ExecutorRes
forall a. a -> Maybe a
Just ExecutorRes
res
Left err :: ExecutorError
err -> do
InternalState
iState <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
TestError -> IntegrationalScenario
forall anything. TestError -> IntegrationalScenarioM anything
integrationalFail (TestError -> IntegrationalScenario)
-> TestError -> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ IntegrationalExecutorError -> TestError
InterpreterError (IntegrationalExecutorError -> TestError)
-> IntegrationalExecutorError -> TestError
forall a b. (a -> b) -> a -> b
$ InternalState -> ExecutorError -> IntegrationalExecutorError
mkError InternalState
iState ExecutorError
err
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
| [(Text, IntegrationalScenario)] -> Bool
forall t. Container t => t -> Bool
null [(Text, IntegrationalScenario)]
scenarios = Text -> IntegrationalScenario
forall a. HasCallStack => Text -> a
error "branch: empty list of scenarios provided"
| Bool
otherwise = do
InternalState
st <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
Except ScenarioError () -> IntegrationalScenario
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Except ScenarioError () -> IntegrationalScenario)
-> (((Text, IntegrationalScenario) -> Except ScenarioError ())
-> Except ScenarioError ())
-> ((Text, IntegrationalScenario) -> Except ScenarioError ())
-> IntegrationalScenario
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, IntegrationalScenario)]
-> (Element [(Text, IntegrationalScenario)]
-> Except ScenarioError ())
-> Except ScenarioError ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
t -> (Element t -> m b) -> m ()
forM_ [(Text, IntegrationalScenario)]
scenarios (((Text, IntegrationalScenario) -> Except ScenarioError ())
-> IntegrationalScenario)
-> ((Text, IntegrationalScenario) -> Except ScenarioError ())
-> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ \(name :: Text
name, scenario :: IntegrationalScenario
scenario) ->
(ScenarioError -> ScenarioError)
-> Except ScenarioError () -> Except ScenarioError ()
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept ((ScenarioBranchName -> Identity ScenarioBranchName)
-> ScenarioError -> Identity ScenarioError
Lens' ScenarioError ScenarioBranchName
seBranch ((ScenarioBranchName -> Identity ScenarioBranchName)
-> ScenarioError -> Identity ScenarioError)
-> (ScenarioBranchName -> ScenarioBranchName)
-> ScenarioError
-> ScenarioError
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> ScenarioBranchName -> ScenarioBranchName
appendScenarioBranch Text
name) (Except ScenarioError () -> Except ScenarioError ())
-> Except ScenarioError () -> Except ScenarioError ()
forall a b. (a -> b) -> a -> b
$
IntegrationalScenario -> InternalState -> Except ScenarioError ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT IntegrationalScenario
scenario InternalState
st
(?-) :: Text -> a -> (Text, a)
?- :: Text -> a -> (Text, a)
(?-) = (,)
infixr 0 ?-
offshoot :: Text -> IntegrationalScenario -> IntegrationalScenario
offshoot :: Text -> IntegrationalScenario -> IntegrationalScenario
offshoot name :: Text
name scenario :: IntegrationalScenario
scenario = do
InternalState
st <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
Except ScenarioError () -> IntegrationalScenario
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Except ScenarioError () -> IntegrationalScenario)
-> Except ScenarioError () -> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$
(ScenarioError -> ScenarioError)
-> Except ScenarioError () -> Except ScenarioError ()
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept ((ScenarioBranchName -> Identity ScenarioBranchName)
-> ScenarioError -> Identity ScenarioError
Lens' ScenarioError ScenarioBranchName
seBranch ((ScenarioBranchName -> Identity ScenarioBranchName)
-> ScenarioError -> Identity ScenarioError)
-> (ScenarioBranchName -> ScenarioBranchName)
-> ScenarioError
-> ScenarioError
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> ScenarioBranchName -> ScenarioBranchName
appendScenarioBranch Text
name) (Except ScenarioError () -> Except ScenarioError ())
-> Except ScenarioError () -> Except ScenarioError ()
forall a b. (a -> b) -> a -> b
$
IntegrationalScenario -> InternalState -> Except ScenarioError ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT IntegrationalScenario
scenario InternalState
st
expectNoUpdates :: IntegrationalScenario
expectNoUpdates :: IntegrationalScenario
expectNoUpdates = (InternalState -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
validate ((InternalState -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario)
-> (InternalState
-> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ \_ _ updates :: [GStateUpdate]
updates ->
Either TestError ()
-> (NonEmpty GStateUpdate -> Either TestError ())
-> Maybe (NonEmpty GStateUpdate)
-> Either TestError ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either TestError ()
forall (f :: * -> *). Applicative f => f ()
pass (TestError -> Either TestError ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TestError -> Either TestError ())
-> (NonEmpty GStateUpdate -> TestError)
-> NonEmpty GStateUpdate
-> Either TestError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty GStateUpdate -> TestError
UnexpectedUpdates) (Maybe (NonEmpty GStateUpdate) -> Either TestError ())
-> ([GStateUpdate] -> Maybe (NonEmpty GStateUpdate))
-> [GStateUpdate]
-> Either TestError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GStateUpdate] -> Maybe (NonEmpty GStateUpdate)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([GStateUpdate] -> Either TestError ())
-> [GStateUpdate] -> Either TestError ()
forall a b. (a -> b) -> a -> b
$ [GStateUpdate]
updates
expectNoStorageUpdates :: IntegrationalScenario
expectNoStorageUpdates :: IntegrationalScenario
expectNoStorageUpdates = (InternalState -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
validate ((InternalState -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario)
-> (InternalState
-> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ \_ _ updates :: [GStateUpdate]
updates ->
Either TestError ()
-> (NonEmpty GStateUpdate -> Either TestError ())
-> Maybe (NonEmpty GStateUpdate)
-> Either TestError ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either TestError ()
forall (f :: * -> *). Applicative f => f ()
pass (TestError -> Either TestError ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TestError -> Either TestError ())
-> (NonEmpty GStateUpdate -> TestError)
-> NonEmpty GStateUpdate
-> Either TestError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty GStateUpdate -> TestError
UnexpectedUpdates) (Maybe (NonEmpty GStateUpdate) -> Either TestError ())
-> ([GStateUpdate] -> Maybe (NonEmpty GStateUpdate))
-> [GStateUpdate]
-> Either TestError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GStateUpdate] -> Maybe (NonEmpty GStateUpdate)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([GStateUpdate] -> Either TestError ())
-> [GStateUpdate] -> Either TestError ()
forall a b. (a -> b) -> a -> b
$
(GStateUpdate -> Bool) -> [GStateUpdate] -> [GStateUpdate]
forall a. (a -> Bool) -> [a] -> [a]
filter GStateUpdate -> Bool
isStorageUpdate [GStateUpdate]
updates
where
isStorageUpdate :: GStateUpdate -> Bool
isStorageUpdate = \case
GSSetStorageValue {} -> Bool
True
_ -> Bool
False
expectStorage
:: Address
-> (Value -> Either TestError ())
-> IntegrationalScenario
expectStorage :: Address -> (Value -> Either TestError ()) -> IntegrationalScenario
expectStorage addr :: Address
addr predicate :: Value -> Either TestError ()
predicate = (InternalState -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
validate ((InternalState -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario)
-> (InternalState
-> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ \is :: InternalState
is gs :: GState
gs _ ->
let intro :: Text -> TestError
intro = AddressName -> Text -> TestError
StoragePredicateMismatch (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) in
case GState -> Map Address AddressState
gsAddresses GState
gs Map Address AddressState
-> Getting
(Maybe AddressState)
(Map Address AddressState)
(Maybe AddressState)
-> Maybe AddressState
forall s a. s -> Getting a s a -> a
^. Index (Map Address AddressState)
-> Lens'
(Map Address AddressState)
(Maybe (IxValue (Map Address AddressState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Address AddressState)
Address
addr of
Just (ASContract cs :: ContractState
cs) ->
Value -> Either TestError ()
predicate (Value -> Either TestError ()) -> Value -> Either TestError ()
forall a b. (a -> b) -> a -> b
$ ContractState -> Value
csStorage ContractState
cs
Just (ASSimple {}) ->
TestError -> Either TestError ()
forall a b. a -> Either a b
Left (TestError -> Either TestError ())
-> TestError -> Either TestError ()
forall a b. (a -> b) -> a -> b
$ Text -> TestError
intro (Text -> TestError) -> Text -> TestError
forall a b. (a -> b) -> a -> b
$ "it's a simple address"
Nothing -> TestError -> Either TestError ()
forall a b. a -> Either a b
Left (TestError -> Either TestError ())
-> TestError -> Either TestError ()
forall a b. (a -> b) -> a -> b
$ Text -> TestError
intro (Text -> TestError) -> Text -> TestError
forall a b. (a -> b) -> a -> b
$ "it's unknown"
expectStorageUpdate
:: Address
-> (Value -> Either TestError ())
-> IntegrationalScenario
expectStorageUpdate :: Address -> (Value -> Either TestError ()) -> IntegrationalScenario
expectStorageUpdate addr :: Address
addr predicate :: Value -> Either TestError ()
predicate = (InternalState -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
validate ((InternalState -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario)
-> (InternalState
-> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ \is :: InternalState
is _ updates :: [GStateUpdate]
updates ->
case (GStateUpdate -> Bool) -> [GStateUpdate] -> Maybe GStateUpdate
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find GStateUpdate -> Bool
checkAddr ([GStateUpdate] -> [GStateUpdate]
forall a. [a] -> [a]
reverse [GStateUpdate]
updates) of
Nothing -> TestError -> Either TestError ()
forall a b. a -> Either a b
Left (TestError -> Either TestError ())
-> TestError -> Either TestError ()
forall a b. (a -> b) -> a -> b
$
AddressName -> Text -> TestError
IncorrectStorageUpdate (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) "storage wasn't updated"
Just (GSSetStorageValue _ val :: Value
val _) ->
(TestError -> TestError)
-> Either TestError () -> Either TestError ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (AddressName -> Text -> TestError
IncorrectStorageUpdate (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) (Text -> TestError)
-> (TestError -> Text) -> TestError -> TestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestError -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) (Either TestError () -> Either TestError ())
-> Either TestError () -> Either TestError ()
forall a b. (a -> b) -> a -> b
$
Value -> Either TestError ()
predicate Value
val
Just _ -> Text -> Either TestError ()
forall a. HasCallStack => Text -> a
error "expectStorageUpdate: internal error"
where
checkAddr :: GStateUpdate -> Bool
checkAddr (GSSetStorageValue addr' :: Address
addr' _ _) = Address
addr' Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Address
addr
checkAddr _ = Bool
False
expectStorageUpdateConst
:: Address
-> Value
-> IntegrationalScenario
expectStorageUpdateConst :: Address -> Value -> IntegrationalScenario
expectStorageUpdateConst addr :: Address
addr expected :: Value
expected = do
InternalState
is <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
let
predicate :: Value -> Either TestError ()
predicate val :: Value
val
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
expected = Either TestError ()
forall (f :: * -> *). Applicative f => f ()
pass
| Bool
otherwise = TestError -> Either TestError ()
forall a b. a -> Either a b
Left (TestError -> Either TestError ())
-> TestError -> Either TestError ()
forall a b. (a -> b) -> a -> b
$
AddressName -> Text -> TestError
IncorrectStorageUpdate (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) (Value -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Value
expected)
Address -> (Value -> Either TestError ()) -> IntegrationalScenario
expectStorageUpdate Address
addr Value -> Either TestError ()
predicate
expectStorageConst :: Address -> Value -> IntegrationalScenario
expectStorageConst :: Address -> Value -> IntegrationalScenario
expectStorageConst addr :: Address
addr expected :: Value
expected = do
InternalState
is <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
let
predicate :: Value -> Either TestError ()
predicate val :: Value
val
| Value
val Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
expected = Either TestError ()
forall (f :: * -> *). Applicative f => f ()
pass
| Bool
otherwise = TestError -> Either TestError ()
forall a b. a -> Either a b
Left (TestError -> Either TestError ())
-> TestError -> Either TestError ()
forall a b. (a -> b) -> a -> b
$
AddressName -> ExpectedStorage -> Text -> TestError
InvalidStorage (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) (Value -> ExpectedStorage
ExpectedStorage Value
expected) (Value -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Value
val)
Address -> (Value -> Either TestError ()) -> IntegrationalScenario
expectStorage Address
addr Value -> Either TestError ()
predicate
tExpectStorageConst
:: forall st.
(StorageScope st)
=> Address -> Typed.Value st -> IntegrationalScenario
tExpectStorageConst :: Address -> Value st -> IntegrationalScenario
tExpectStorageConst addr :: Address
addr expected :: Value st
expected =
Address -> Value -> IntegrationalScenario
expectStorageConst Address
addr (Value st -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
Typed.untypeValue Value st
expected)
expectBalance :: Address -> Mutez -> IntegrationalScenario
expectBalance :: Address -> Mutez -> IntegrationalScenario
expectBalance addr :: Address
addr balance :: Mutez
balance = (InternalState -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
validate ((InternalState -> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario)
-> (InternalState
-> GState -> [GStateUpdate] -> Either TestError ())
-> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$ \is :: InternalState
is gs :: GState
gs _ ->
let realBalance :: Mutez
realBalance = Mutez -> (AddressState -> Mutez) -> Maybe AddressState -> Mutez
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HasCallStack => Word64 -> Mutez
Word64 -> Mutez
unsafeMkMutez 0) AddressState -> Mutez
asBalance (GState -> Map Address AddressState
gsAddresses GState
gs Map Address AddressState
-> Getting
(Maybe AddressState)
(Map Address AddressState)
(Maybe AddressState)
-> Maybe AddressState
forall s a. s -> Getting a s a -> a
^. Index (Map Address AddressState)
-> Lens'
(Map Address AddressState)
(Maybe (IxValue (Map Address AddressState)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Address AddressState)
Address
addr) in
if Mutez
realBalance Mutez -> Mutez -> Bool
forall a. Eq a => a -> a -> Bool
== Mutez
balance then Either TestError ()
forall (f :: * -> *). Applicative f => f ()
pass
else
TestError -> Either TestError ()
forall a b. a -> Either a b
Left
(TestError -> Either TestError ())
-> TestError -> Either TestError ()
forall a b. (a -> b) -> a -> b
$ AddressName -> ExpectedBalance -> Text -> TestError
InvalidBalance (Address -> InternalState -> AddressName
addrToAddrName Address
addr InternalState
is) (Mutez -> ExpectedBalance
ExpectedBalance Mutez
balance)
(Text -> TestError) -> Text -> TestError
forall a b. (a -> b) -> a -> b
$ "its actual balance is: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Mutez -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty Mutez
realBalance
attempt :: IntegrationalScenarioM a -> IntegrationalScenarioM (Either ExecutorError a)
attempt :: IntegrationalScenarioM a
-> IntegrationalScenarioM (Either ExecutorError a)
attempt ma :: IntegrationalScenarioM a
ma = IntegrationalScenarioM (Either ExecutorError a)
-> (ScenarioError
-> IntegrationalScenarioM (Either ExecutorError a))
-> IntegrationalScenarioM (Either ExecutorError a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (a -> Either ExecutorError a
forall a b. b -> Either a b
Right (a -> Either ExecutorError a)
-> IntegrationalScenarioM a
-> IntegrationalScenarioM (Either ExecutorError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntegrationalScenarioM a
ma) ((ScenarioError -> IntegrationalScenarioM (Either ExecutorError a))
-> IntegrationalScenarioM (Either ExecutorError a))
-> (ScenarioError
-> IntegrationalScenarioM (Either ExecutorError a))
-> IntegrationalScenarioM (Either ExecutorError a)
forall a b. (a -> b) -> a -> b
$ \case
ScenarioError _ (InterpreterError err :: IntegrationalExecutorError
err) -> Either ExecutorError a
-> IntegrationalScenarioM (Either ExecutorError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ExecutorError a
-> IntegrationalScenarioM (Either ExecutorError a))
-> (ExecutorError -> Either ExecutorError a)
-> ExecutorError
-> IntegrationalScenarioM (Either ExecutorError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExecutorError -> Either ExecutorError a
forall a b. a -> Either a b
Left (ExecutorError -> IntegrationalScenarioM (Either ExecutorError a))
-> ExecutorError -> IntegrationalScenarioM (Either ExecutorError a)
forall a b. (a -> b) -> a -> b
$ AddressName -> Address
addrNameToAddr (AddressName -> Address)
-> IntegrationalExecutorError -> ExecutorError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntegrationalExecutorError
err
err :: ScenarioError
err -> ScenarioError -> IntegrationalScenarioM (Either ExecutorError a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ScenarioError
err
expectError :: IntegrationalScenarioM a -> IntegrationalScenarioM ExecutorError
expectError :: IntegrationalScenarioM a -> IntegrationalScenarioM ExecutorError
expectError scenario :: IntegrationalScenarioM a
scenario = IntegrationalScenarioM a
-> (ExecutorError -> IntegrationalScenarioM ExecutorError)
-> IntegrationalScenarioM ExecutorError
forall a b.
IntegrationalScenarioM a
-> (ExecutorError -> IntegrationalScenarioM b)
-> IntegrationalScenarioM b
catchExpectedError IntegrationalScenarioM a
scenario ExecutorError -> IntegrationalScenarioM ExecutorError
forall (f :: * -> *) a. Applicative f => a -> f a
pure
catchExpectedError
:: IntegrationalScenarioM a
-> (ExecutorError -> IntegrationalScenarioM b)
-> IntegrationalScenarioM b
catchExpectedError :: IntegrationalScenarioM a
-> (ExecutorError -> IntegrationalScenarioM b)
-> IntegrationalScenarioM b
catchExpectedError scenario :: IntegrationalScenarioM a
scenario handle :: ExecutorError -> IntegrationalScenarioM b
handle =
IntegrationalScenarioM a
-> IntegrationalScenarioM (Either ExecutorError a)
forall a.
IntegrationalScenarioM a
-> IntegrationalScenarioM (Either ExecutorError a)
attempt IntegrationalScenarioM a
scenario IntegrationalScenarioM (Either ExecutorError a)
-> (Either ExecutorError a -> IntegrationalScenarioM b)
-> IntegrationalScenarioM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left err :: ExecutorError
err -> ExecutorError -> IntegrationalScenarioM b
handle ExecutorError
err
Right _ -> TestError -> IntegrationalScenarioM b
forall anything. TestError -> IntegrationalScenarioM anything
integrationalFail TestError
ExpectingInterpreterToFail
expectGasExhaustion :: ExecutorError -> IntegrationalScenario
expectGasExhaustion :: ExecutorError -> IntegrationalScenario
expectGasExhaustion =
\case
EEInterpreterFailed _ (RuntimeFailure (MichelsonGasExhaustion, _)) -> IntegrationalScenario
forall (f :: * -> *). Applicative f => f ()
pass
err :: ExecutorError
err -> ExecutorError -> Text -> IntegrationalScenario
forall a. ExecutorError -> Text -> IntegrationalScenarioM a
unexpectedInterpreterError ExecutorError
err "expected runtime failure due to gas exhaustion"
expectMichelsonFailed :: (MichelsonFailed -> Bool) -> Address -> ExecutorError -> IntegrationalScenario
expectMichelsonFailed :: (MichelsonFailed -> Bool)
-> Address -> ExecutorError -> IntegrationalScenario
expectMichelsonFailed predicate :: MichelsonFailed -> Bool
predicate expectedAddr :: Address
expectedAddr err :: ExecutorError
err =
case ExecutorError
err of
EEInterpreterFailed actualAddr :: Address
actualAddr (RuntimeFailure (mf :: MichelsonFailed
mf, _))
| Address
expectedAddr Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
/= Address
actualAddr -> do
InternalState
iState <- StateT InternalState (Except ScenarioError) InternalState
forall s (m :: * -> *). MonadState s m => m s
get
ExecutorError -> Text -> IntegrationalScenario
forall a. ExecutorError -> Text -> IntegrationalScenarioM a
unexpectedInterpreterError ExecutorError
err (Text -> IntegrationalScenario) -> Text -> IntegrationalScenario
forall a b. (a -> b) -> a -> b
$
"expected runtime failure for contract with address "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> AddressName -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Address -> InternalState -> AddressName
addrToAddrName Address
expectedAddr InternalState
iState)
| Bool -> Bool
not (MichelsonFailed -> Bool
predicate MichelsonFailed
mf) -> ExecutorError -> Text -> IntegrationalScenario
forall a. ExecutorError -> Text -> IntegrationalScenarioM a
unexpectedInterpreterError ExecutorError
err "predicate failed"
| Bool
otherwise -> IntegrationalScenario
forall (f :: * -> *). Applicative f => f ()
pass
_ -> ExecutorError -> Text -> IntegrationalScenario
forall a. ExecutorError -> Text -> IntegrationalScenarioM a
unexpectedInterpreterError ExecutorError
err "expected runtime failure"
initIS :: InternalState
initIS :: InternalState
initIS = $WInternalState :: RemainingSteps
-> Timestamp
-> GState
-> [ExecutorResOrError']
-> Maybe ExecutorRes
-> Map Address Text
-> Maybe Address
-> InternalState
InternalState
{ _isNow :: Timestamp
_isNow = Timestamp
dummyNow
, _isMaxSteps :: RemainingSteps
_isMaxSteps = RemainingSteps
dummyMaxSteps
, _isGState :: GState
_isGState = GState
initGState
, _isInterpreterLog :: [ExecutorResOrError']
_isInterpreterLog = [ExecutorResOrError']
forall a. Monoid a => a
mempty
, _isExecutorResult :: Maybe ExecutorRes
_isExecutorResult = Maybe ExecutorRes
forall a. Maybe a
Nothing
, _isContractsNames :: Map Address Text
_isContractsNames = Map Address Text
forall k a. Map k a
Map.empty
, _isSender :: Maybe Address
_isSender = Maybe Address
forall a. Maybe a
Nothing
}
integrationalTest ::
(Maybe ScenarioError -> res)
-> IntegrationalScenario
-> res
integrationalTest :: (Maybe ScenarioError -> res) -> IntegrationalScenario -> res
integrationalTest howToFail :: Maybe ScenarioError -> res
howToFail scenario :: IntegrationalScenario
scenario =
Maybe ScenarioError -> res
howToFail (Maybe ScenarioError -> res) -> Maybe ScenarioError -> res
forall a b. (a -> b) -> a -> b
$ Either ScenarioError ((), InternalState) -> Maybe ScenarioError
forall l r. Either l r -> Maybe l
leftToMaybe (Either ScenarioError ((), InternalState) -> Maybe ScenarioError)
-> Either ScenarioError ((), InternalState) -> Maybe ScenarioError
forall a b. (a -> b) -> a -> b
$ Except ScenarioError ((), InternalState)
-> Either ScenarioError ((), InternalState)
forall e a. Except e a -> Either e a
runExcept (IntegrationalScenario
-> InternalState -> Except ScenarioError ((), InternalState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT IntegrationalScenario
scenario InternalState
initIS)
mkError
:: InternalState
-> ExecutorError
-> IntegrationalExecutorError
mkError :: InternalState -> ExecutorError -> IntegrationalExecutorError
mkError is :: InternalState
is = (Address -> AddressName)
-> ExecutorError -> IntegrationalExecutorError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Address -> AddressName)
-> ExecutorError -> IntegrationalExecutorError)
-> (Address -> AddressName)
-> ExecutorError
-> IntegrationalExecutorError
forall a b. (a -> b) -> a -> b
$ (Address -> InternalState -> AddressName)
-> InternalState -> Address -> AddressName
forall a b c. (a -> b -> c) -> b -> a -> c
flip Address -> InternalState -> AddressName
addrToAddrName InternalState
is