CallSelf.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Tests for the contract that calls self several times.

{-# OPTIONS_GHC -Wno-deprecations #-}

module Test.Interpreter.CallSelf
  ( test_self_caller
  ) where

import Hedgehog (forAll, property, withTests)
import Hedgehog.Gen qualified as Gen
import Test.HUnit (Assertion, (@?=))
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (testCase)
import Test.Tasty.Hedgehog (testProperty)
import Unsafe qualified (fromIntegral)

import Morley.Michelson.Interpret (ContractEnv(..), InterpreterState(..), RemainingSteps(..))
import Morley.Michelson.Typed as T
import Morley.Michelson.Untyped qualified as U
import Test.Cleveland
import Test.Cleveland.Michelson (ContractPropValidator, contractProp)
import Test.Cleveland.Michelson.Dummy
import Test.Cleveland.Michelson.Import (embedContract)

import Test.Util.Contracts

gasForOneExecution :: Num a => a
gasForOneExecution = 19

gasForLastExecution :: Num a => a
gasForLastExecution = 20

type Parameter = 'TInt
type Storage = 'TNat

test_self_caller :: [TestTree]
test_self_caller =
  [ testCase ("With parameter 1 single execution consumes " <>
      show @_ @Int gasForLastExecution <> " gas") $
    contractProp selfCaller (unitValidator gasForLastExecution) unitContractEnv
    (1 :: Integer) (0 :: Natural)

  , testCase ("With parameter 2 single execution consumes " <>
      show @_ @Int gasForOneExecution <> " gas") $
    contractProp selfCaller (unitValidator gasForOneExecution) unitContractEnv
    (2 :: Integer) (0 :: Natural)

  , testProperty propertyDescription $
    withTests 10 $ property $ do
      callCount <- forAll $ Gen.enum minCalls maxCalls
      testScenarioProps $ clevelandTransferScenario (T.convertContract selfCaller) callCount
  ]
  where
    -- Environment for unit test
    unitContractEnv = dummyContractEnv
    -- Validator for unit test
    unitValidator ::
      RemainingSteps -> ContractPropValidator Storage Assertion
    unitValidator gasDiff (_, (isRemainingSteps -> remSteps, _)) =
      remSteps @?= ceMaxSteps unitContractEnv - gasDiff

    propertyDescription =
      "calls itself n times, sets storage to n OR fails due to gas limit"

    minCalls = 1
    maxCalls = 10

    selfCaller = $$(embedContract @Parameter @Storage (inContractsDir "call_self_several_times.tz"))

    clevelandTransferScenario :: Monad m => U.Contract -> Integer -> Scenario m
    clevelandTransferScenario uSelfContract parameter = scenario do
      address <- originateUntypedSimple "self-caller" (U.ValueInt 0) uSelfContract
      transfer TransferData
        { tdTo = address
        , tdAmount = 1
        , tdEntrypoint = DefEpName
        , tdParameter = parameter
        }
      let expectedStorage :: Natural = Unsafe.fromIntegral @Integer @Natural parameter
      getStorage @Natural address @@== expectedStorage