module Michelson.Test.Unit
( ContractReturn
, ContractPropValidator
, contractProp
, contractPropVal
, contractHasEntryPoints
, matchContractEntryPoints
, hasEp
, validateStorageIs
) where
import Data.List.NonEmpty (fromList)
import qualified Data.Map as Map
import Fmt ((+|), (|+))
import Test.HUnit (Assertion, assertFailure, (@?=))
import Michelson.Interpret (ContractEnv, ContractReturn, interpret)
import Michelson.Printer (printUntypedContract)
import Michelson.Runtime (parseExpandContract)
import Michelson.Typed (Contract, IsoValue(..), ToT, epNameToParamAnn)
import qualified Michelson.Typed as T
import Michelson.Untyped (EpName, para)
import Michelson.Untyped hiding (Contract)
import qualified Michelson.Untyped as U
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 instr check env param initSt =
contractPropVal instr check env (toVal param) (toVal initSt)
contractPropVal
:: (T.ParameterScope cp)
=> Contract cp st
-> ContractPropValidator st prop
-> ContractEnv
-> T.Value cp
-> T.Value st
-> prop
contractPropVal instr check env param initSt =
check $ interpret instr T.epcCallRootUnsafe param initSt env
hasEp :: T -> (EpName, U.Type) -> Bool
hasEp (TOr lFieldAnn rFieldAnn lType@(Type lT _) rType@(Type rT _))
ep@(epNameToParamAnn -> epAnn, epType) = or
[ (epAnn == lFieldAnn && epType == lType)
, (epAnn == rFieldAnn && epType == rType)
, hasEp lT ep
, hasEp rT ep ]
hasEp _ _ = False
contractHasEntryPoints :: U.Contract -> Map EpName U.Type -> Bool
contractHasEntryPoints contract eps = isRight $ matchContractEntryPoints contract eps
matchContractEntryPoints
:: HasCallStack
=> U.Contract
-> Map EpName U.Type
-> Either (NonEmpty (EpName, U.Type)) ()
matchContractEntryPoints contract eps =
phi $ fromRight (error "Impossible") parsedContract
where
parsedContract = parseExpandContract Nothing
(toText $ printUntypedContract True contract)
phi (para -> Type t _) = conv $ filter (\ep -> not (hasEp t ep)) (Map.toList eps)
conv l | null l = Right ()
| otherwise = Left $ fromList l
validateStorageIs
:: IsoValue st
=> st -> ContractPropValidator (ToT st) Assertion
validateStorageIs expected (res, _) =
case res of
Left err ->
assertFailure $ "Unexpected interpretation failure: " +| err |+ ""
Right (_ops, got) ->
got @?= toVal expected