-- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA -- TODO [#712]: Remove this next major release {-# OPTIONS_GHC -Wno-deprecations #-} module Test.Lorentz.Interpreter ( test_Entry_points_lookup , test_Entry_points_calling ) where import System.FilePath (()) import Test.Tasty (TestTree, testGroup) import Lorentz (EpdPlain, ParameterHasEntrypoints(..), toAddress) import Morley.Michelson.Text import Morley.Michelson.Typed (IsoValue(..)) import Morley.Michelson.Typed qualified as T import Morley.Michelson.Untyped qualified as U import Morley.Tezos.Address import Test.Cleveland import Test.Cleveland.Lorentz.Import (importContractExt) import Test.Cleveland.Michelson (testTreesWithTypedContract) data Contract1Parameter = Contract11 Integer | Contract12 MText deriving stock Generic deriving anyclass (IsoValue) data Self1Parameter = Self11 Integer | Self12 () deriving stock Generic deriving anyclass (IsoValue) instance ParameterHasEntrypoints Contract1Parameter where type ParameterEntrypointsDerivation Contract1Parameter = EpdPlain instance ParameterHasEntrypoints Self1Parameter where type ParameterEntrypointsDerivation Self1Parameter = EpdPlain test_Entry_points_lookup :: IO [TestTree] test_Entry_points_lookup = testTreesWithTypedContract (dir "call1.mtz") $ \call1 -> testTreesWithTypedContract (dir "call2.mtz") $ \call2 -> testTreesWithTypedContract (dir "call3.mtz") $ \call3 -> testTreesWithTypedContract (dir "call4.mtz") $ \call4 -> testTreesWithTypedContract (dir "call5.mtz") $ \call5 -> testTreesWithTypedContract (dir "call6.mtz") $ \call6 -> testTreesWithTypedContract (dir "call7.mtz") $ \call7 -> pure [ testGroup "Calling contract without default entrypoint" [ testScenarioOnEmulator "Calling default entrypoint refers to the root" $ myScenario call1 simpleContract id , testScenarioOnEmulator "Calling some entrypoint refers this entrypoint" $ myScenario call7 simpleContract id ] , testGroup "Calling contract with default entrypoint" [ testScenarioOnEmulator "Calling default entrypoint works" $ myScenario call2 defaultEPContract id ] , testGroup "Common failures" [ testScenarioOnEmulator "Fails on type mismatch" $ myScenario call1 defaultEPContract $ expectFailedWith () , testScenarioOnEmulator "Fails on entrypoint not found" $ myScenario call3 simpleContract $ expectFailedWith () ] , testGroup "Referring entrypoints groups" [ testScenarioOnEmulator "Can refer entrypoint group" $ myScenario call4 complexContract id , testScenarioOnEmulator "Works with annotations" $ myScenario call5 complexContract id , testScenarioOnEmulator "Does not work on annotations mismatch in 'contract' type argument" $ myScenario call6 complexContract $ expectFailedWith () ] ] where myScenario = scenario ... myScenario' myScenario' :: MonadCleveland caps m => T.Contract 'T.TAddress 'T.TUnit -> U.Contract -> (m () -> m ()) -> m () myScenario' caller callee validator = do hcallee <- originateUntypedSimple "callee" U.ValueUnit callee hcaller <- originateTypedSimple @Address @_ @() "caller" () caller validator $ transfer $ TransferData { tdTo = hcaller , tdEntrypoint = U.DefEpName , tdParameter = hcallee , tdAmount = 100 } dummyCode = U.PrimEx <$> [ U.CDR U.noAnn U.noAnn , U.NIL U.noAnn U.noAnn (U.Ty U.TOperation U.noAnn) , U.PAIR U.noAnn U.noAnn U.noAnn U.noAnn ] dummyContract ty = U.Contract (par ty) storageTy dummyCode U.PSC [] simpleContract = dummyContract contractSimpleTy defaultEPContract = dummyContract contractWithDefTy complexContract = dummyContract contractComplexTy dir = entrypointsDir par ty = U.ParameterType ty U.noAnn storageTy = U.Ty U.TUnit U.noAnn contractSimpleTy = U.Ty (U.TOr "a" "b" (U.Ty U.TInt U.noAnn) (U.Ty U.TNat U.noAnn)) U.noAnn contractComplexTy = U.Ty (U.TOr "s" "t" (U.Ty U.TString U.noAnn) contractSimpleTy) U.noAnn contractWithDefTy = U.Ty (U.TOr "a" "default" (U.Ty U.TNat U.noAnn) (U.Ty U.TString U.noAnn)) U.noAnn test_Entry_points_calling :: IO [TestTree] test_Entry_points_calling = pure [ testScenario "Calling some entrypoint in CONTRACT" $ scenario do call1 <- importContract @Address @_ @() $ dir "call1.mtz" callerRef <- originateSimple "caller" () call1 contract1 <- runIO $ importContractExt @Contract1Parameter @_ @() $ dir "contract1.mtz" targetRef <- originateSimple "target" 0 contract1 transfer TransferData { tdTo = callerRef , tdAmount = 1 , tdEntrypoint = T.DefEpName , tdParameter = toAddress targetRef } getStorage @Integer targetRef @@== 5 , testScenario "Calling some entrypoint in SELF" $ scenario do self1 <- runIO $ importContractExt @Self1Parameter @_ @() $ dir "self1.mtz" contractRef <- originateSimple "self" 0 self1 transfer TransferData { tdTo = contractRef , tdAmount = 1 , tdEntrypoint = T.DefEpName , tdParameter = Right @Integer () } getStorage @Integer contractRef @@== 5 ] where dir = entrypointsDir entrypointsDir :: FilePath entrypointsDir = ".." ".." "contracts" "entrypoints"