{-# OPTIONS_GHC -Wno-deprecations #-}
module Test.Cleveland.Michelson.Unit
{-# DEPRECATED "Use the new Test.Cleveland interface instead. Entrypoint utilities\
\ are moved to Test.Cleveland.Michelson.Entrypoints" #-}
( ContractReturn
, ContractPropValidator
, EPMismatch
, contractProp
, contractPropVal
, validateSuccess
, validateStorageIs
, validateMichelsonFailsWith
) where
import Data.Constraint ((\\))
import Fmt ((+|), (|+))
import Test.HUnit (Assertion, assertFailure, (@?=))
import Test.Hspec.Expectations (Expectation, shouldBe, shouldSatisfy)
import Lorentz.Constraints.Scopes (NiceConstant, niceConstantEvi)
import Morley.Michelson.Interpret
(ContractEnv, ContractReturn, MichelsonFailed(..), MichelsonFailureWithStack(..), interpret)
import Morley.Michelson.Typed (Contract, IsoValue(..), ToT)
import Morley.Michelson.Typed qualified as T
import Test.Cleveland.Michelson.Dummy (dummyBigMapCounter, dummyGlobalCounter)
import Test.Cleveland.Michelson.Internal.Entrypoints
type ContractPropValidator st prop = ContractReturn st -> prop
contractProp
:: ( IsoValue param, IsoValue storage
, ToT param ~ cp, ToT storage ~ st
, T.ParameterScope cp
)
=> Contract cp st
-> ContractPropValidator st prop
-> ContractEnv
-> param
-> storage
-> prop
contractProp :: Contract cp st
-> ContractPropValidator st prop
-> ContractEnv
-> param
-> storage
-> prop
contractProp Contract cp st
instr ContractPropValidator st prop
check ContractEnv
env param
param storage
initSt =
Contract cp st
-> ContractPropValidator st prop
-> ContractEnv
-> Value cp
-> Value st
-> prop
forall (cp :: T) (st :: T) prop.
ParameterScope cp =>
Contract cp st
-> ContractPropValidator st prop
-> ContractEnv
-> Value cp
-> Value st
-> prop
contractPropVal Contract cp st
instr ContractPropValidator st prop
check ContractEnv
env (param -> Value (ToT param)
forall a. IsoValue a => a -> Value (ToT a)
toVal param
param) (storage -> Value (ToT storage)
forall a. IsoValue a => a -> Value (ToT a)
toVal storage
initSt)
contractPropVal
:: (T.ParameterScope cp)
=> Contract cp st
-> ContractPropValidator st prop
-> ContractEnv
-> T.Value cp
-> T.Value st
-> prop
contractPropVal :: Contract cp st
-> ContractPropValidator st prop
-> ContractEnv
-> Value cp
-> Value st
-> prop
contractPropVal Contract cp st
instr ContractPropValidator st prop
check ContractEnv
env Value cp
param Value st
initSt =
ContractPropValidator st prop
check ContractPropValidator st prop -> ContractPropValidator st prop
forall a b. (a -> b) -> a -> b
$ Contract cp st
-> EntrypointCallT cp cp
-> Value cp
-> Value st
-> GlobalCounter
-> BigMapCounter
-> ContractEnv
-> ContractReturn st
forall (cp :: T) (st :: T) (arg :: T).
Contract cp st
-> EntrypointCallT cp arg
-> Value arg
-> Value st
-> GlobalCounter
-> BigMapCounter
-> ContractEnv
-> ContractReturn st
interpret Contract cp st
instr EntrypointCallT cp cp
forall (param :: T).
ParameterScope param =>
EntrypointCallT param param
T.unsafeEpcCallRoot Value cp
param Value st
initSt GlobalCounter
dummyGlobalCounter BigMapCounter
dummyBigMapCounter ContractEnv
env
validateSuccess :: HasCallStack => ContractPropValidator st Expectation
validateSuccess :: ContractPropValidator st Expectation
validateSuccess (Either MichelsonFailureWithStack ([Operation], Value st)
res, (InterpreterState, MorleyLogs)
_) = Either MichelsonFailureWithStack ([Operation], Value st)
res Either MichelsonFailureWithStack ([Operation], Value st)
-> (Either MichelsonFailureWithStack ([Operation], Value st)
-> Bool)
-> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` Either MichelsonFailureWithStack ([Operation], Value st) -> Bool
forall a b. Either a b -> Bool
isRight
validateStorageIs
:: IsoValue st
=> st -> ContractPropValidator (ToT st) Assertion
validateStorageIs :: st -> ContractPropValidator (ToT st) Expectation
validateStorageIs st
expected (Either MichelsonFailureWithStack ([Operation], Value (ToT st))
res, (InterpreterState, MorleyLogs)
_) =
case Either MichelsonFailureWithStack ([Operation], Value (ToT st))
res of
Left MichelsonFailureWithStack
err ->
String -> Expectation
forall a. HasCallStack => String -> IO a
assertFailure (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$ Builder
"Unexpected interpretation failure: " Builder -> Builder -> String
forall b. FromBuilder b => Builder -> Builder -> b
+| MichelsonFailureWithStack
err MichelsonFailureWithStack -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
Right ([Operation]
_ops, Value (ToT st)
got) ->
Value (ToT st)
got Value (ToT st) -> Value (ToT st) -> Expectation
forall a. (HasCallStack, Eq a, Show a) => a -> a -> Expectation
@?= st -> Value (ToT st)
forall a. IsoValue a => a -> Value (ToT a)
toVal st
expected
validateMichelsonFailsWith
:: forall v st. NiceConstant v
=> v -> ContractPropValidator st Expectation
validateMichelsonFailsWith :: v -> ContractPropValidator st Expectation
validateMichelsonFailsWith v
v (Either MichelsonFailureWithStack ([Operation], Value st)
res, (InterpreterState, MorleyLogs)
_) = case Either MichelsonFailureWithStack ([Operation], Value st)
res of
Right ([Operation], Value st)
_ -> String -> Expectation
forall a. HasCallStack => String -> IO a
assertFailure (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$
Builder
"contract was expected to fail with " Builder -> Builder -> String
forall b. FromBuilder b => Builder -> Builder -> b
+| MichelsonFailed
expected MichelsonFailed -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" but didn't."
Left MichelsonFailureWithStack{InstrCallStack
MichelsonFailed
mfwsInstrCallStack :: MichelsonFailureWithStack -> InstrCallStack
mfwsFailed :: MichelsonFailureWithStack -> MichelsonFailed
mfwsInstrCallStack :: InstrCallStack
mfwsFailed :: MichelsonFailed
..} -> MichelsonFailed
mfwsFailed MichelsonFailed -> MichelsonFailed -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` MichelsonFailed
expected
where
expected :: MichelsonFailed
expected = Value (ToT v) -> MichelsonFailed
forall (t :: T).
(SingI t, ConstantScope t) =>
Value t -> MichelsonFailed
MichelsonFailedWith (v -> Value (ToT v)
forall a. IsoValue a => a -> Value (ToT a)
toVal v
v) (ConstantScope (ToT v) => MichelsonFailed)
-> (((SingI (ToT v), WellTyped (ToT v),
FailOnOperationFound (ContainsOp (ToT v)),
FailOnBigMapFound (ContainsBigMap (ToT v)),
FailOnContractFound (ContainsContract (ToT v)),
FailOnTicketFound (ContainsTicket (ToT v)),
FailOnSaplingStateFound (ContainsSaplingState (ToT v))),
KnownValue v)
:- ConstantScope (ToT v))
-> MichelsonFailed
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ ((SingI (ToT v), WellTyped (ToT v),
FailOnOperationFound (ContainsOp (ToT v)),
FailOnBigMapFound (ContainsBigMap (ToT v)),
FailOnContractFound (ContainsContract (ToT v)),
FailOnTicketFound (ContainsTicket (ToT v)),
FailOnSaplingStateFound (ContainsSaplingState (ToT v))),
KnownValue v)
:- ConstantScope (ToT v)
forall a. NiceConstant a :- ConstantScope (ToT a)
niceConstantEvi @v