{-# OPTIONS_HADDOCK not-home #-}
module Test.Cleveland.Lorentz.Internal.Entrypoints
( module Test.Cleveland.Lorentz.Internal.Entrypoints
) where
import Lorentz hiding (contract)
import Data.Map qualified as Map
import Test.Tasty (TestName, TestTree, testGroup)
import Test.Tasty.HUnit (testCase)
import Morley.Michelson.Typed (HandleImplicitDefaultEp(..), convertContract, flattenEntrypoints)
import Morley.Michelson.Untyped qualified as U
import Morley.Util.Named
import Test.Cleveland.Michelson.Internal.Entrypoints qualified as M
type ContractEPTypeTest expectedEps
= forall contractEps st vd.
(NiceParameterFull expectedEps, NiceParameterFull contractEps)
=> Contract contractEps st vd -> TestTree
type ContractEPTest contractEps st vd
= Contract contractEps st vd
-> Map EpName U.Ty
-> TestTree
testCompareContractEntrypointsT
:: forall expectedEps.
(M.EPMismatch -> M.EPMismatch)
-> TestName -> ContractEPTypeTest expectedEps
testCompareContractEntrypointsT :: forall expectedEps.
(EPMismatch -> EPMismatch)
-> TestName -> ContractEPTypeTest expectedEps
testCompareContractEntrypointsT EPMismatch -> EPMismatch
compareMode TestName
name Contract contractEps st vd
contract =
let entrypoints :: Map EpName Ty
entrypoints = HandleImplicitDefaultEp
-> ParamNotes (ToT expectedEps) -> Map EpName Ty
forall (t :: T).
HandleImplicitDefaultEp -> ParamNotes t -> Map EpName Ty
flattenEntrypoints HandleImplicitDefaultEp
WithoutImplicitDefaultEp (ParamNotes (ToT expectedEps) -> Map EpName Ty)
-> ParamNotes (ToT expectedEps) -> Map EpName Ty
forall a b. (a -> b) -> a -> b
$
forall cp. ParameterDeclaresEntrypoints cp => ParamNotes (ToT cp)
parameterEntrypointsToNotes @expectedEps
in (EPMismatch -> EPMismatch)
-> TestName -> ContractEPTest contractEps st vd
forall contractEps st vd.
NiceParameterFull contractEps =>
(EPMismatch -> EPMismatch)
-> TestName -> ContractEPTest contractEps st vd
testCompareContractEntrypoints EPMismatch -> EPMismatch
compareMode TestName
name Contract contractEps st vd
contract Map EpName Ty
entrypoints
testCompareContractEntrypoints
:: forall contractEps st vd.
NiceParameterFull contractEps
=> (M.EPMismatch -> M.EPMismatch)
-> TestName -> ContractEPTest contractEps st vd
testCompareContractEntrypoints :: forall contractEps st vd.
NiceParameterFull contractEps =>
(EPMismatch -> EPMismatch)
-> TestName -> ContractEPTest contractEps st vd
testCompareContractEntrypoints EPMismatch -> EPMismatch
compareMode TestName
name contract :: Contract contractEps st vd
contract@Contract{} Map EpName Ty
spec =
let entrypointsInType :: Map EpName Ty
entrypointsInType = HandleImplicitDefaultEp
-> ParamNotes (ToT contractEps) -> Map EpName Ty
forall (t :: T).
HandleImplicitDefaultEp -> ParamNotes t -> Map EpName Ty
flattenEntrypoints HandleImplicitDefaultEp
wantsDefaultEp (ParamNotes (ToT contractEps) -> Map EpName Ty)
-> ParamNotes (ToT contractEps) -> Map EpName Ty
forall a b. (a -> b) -> a -> b
$
forall cp. ParameterDeclaresEntrypoints cp => ParamNotes (ToT cp)
parameterEntrypointsToNotes @contractEps
wantsDefaultEp :: HandleImplicitDefaultEp
wantsDefaultEp
| EpName -> Map EpName Ty -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member EpName
DefEpName Map EpName Ty
spec = HandleImplicitDefaultEp
WithImplicitDefaultEp
| Bool
otherwise = HandleImplicitDefaultEp
WithoutImplicitDefaultEp
contract' :: Contract
contract' = Contract (ToT contractEps) (ToT st) -> Contract
forall (param :: T) (store :: T). Contract param store -> Contract
convertContract (Contract (ToT contractEps) (ToT st) -> Contract)
-> (Contract contractEps st vd
-> Contract (ToT contractEps) (ToT st))
-> Contract contractEps st vd
-> Contract
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract contractEps st vd -> Contract (ToT contractEps) (ToT st)
forall cp st vd. Contract cp st vd -> Contract (ToT cp) (ToT st)
toMichelsonContract (Contract contractEps st vd -> Contract)
-> Contract contractEps st vd -> Contract
forall a b. (a -> b) -> a -> b
$ Contract contractEps st vd
contract
in TestName -> [TestTree] -> TestTree
testGroup TestName
name
[ TestName -> Assertion -> TestTree
testCase TestName
"Contract type matches entrypoint spec" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
Either TcTypeError EPMismatch -> Assertion
M.assertEPComparisonSuccessful (Either TcTypeError EPMismatch -> Assertion)
-> (EPMismatch -> Either TcTypeError EPMismatch)
-> EPMismatch
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EPMismatch -> Either TcTypeError EPMismatch
forall a b. b -> Either a b
Right (EPMismatch -> Either TcTypeError EPMismatch)
-> (EPMismatch -> EPMismatch)
-> EPMismatch
-> Either TcTypeError EPMismatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EPMismatch -> EPMismatch
compareMode (EPMismatch -> Assertion) -> EPMismatch -> Assertion
forall a b. (a -> b) -> a -> b
$
("expected" :! Map EpName Ty)
-> ("actual" :! Map EpName Ty) -> EPMismatch
M.compareEntrypoints (IsLabel "expected" (Name "expected")
Name "expected"
#expected Name "expected" -> Map EpName Ty -> "expected" :! Map EpName Ty
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Map EpName Ty
spec) (IsLabel "actual" (Name "actual")
Name "actual"
#actual Name "actual" -> Map EpName Ty -> "actual" :! Map EpName Ty
forall (name :: Symbol) a. Name name -> a -> NamedF Identity a name
:! Map EpName Ty
entrypointsInType)
, (EPMismatch -> EPMismatch)
-> TestName -> Contract -> Map EpName Ty -> TestTree
M.testContractEntrypoints EPMismatch -> EPMismatch
compareMode
TestName
"Untyped contract matches entrypoint spec" Contract
contract' Map EpName Ty
spec
]