CallSelf.hs

-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

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

module Test.Interpreter.CallSelf
  ( test_self_caller
  ) where

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

import Michelson.Interpret (ContractEnv(..), InterpreterState(..), RemainingSteps(..))
import Michelson.Runtime.GState
import Michelson.Test (ContractPropValidator, contractProp, testTreesWithContract)
import Michelson.Test.Dummy
import Michelson.Test.Integrational
import Michelson.Typed
import qualified Michelson.Untyped as U
import Tezos.Core (unsafeMkMutez)

import Test.Util.Contracts

test_self_caller :: IO [TestTree]
test_self_caller =
  testTreesWithContract (inContractsDir "call_self_several_times.tz") $ \selfCaller ->
  pure (testImpl selfCaller)

data Fixture = Fixture
  { fMaxSteps :: RemainingSteps
  , fParameter :: Word64
  } deriving stock (Show)

gasForOneExecution :: Num a => a
gasForOneExecution = 19

gasForLastExecution :: Num a => a
gasForLastExecution = 20

fExpectSuccess :: Fixture -> Bool
fExpectSuccess Fixture {..} =
  -- note: fParameter must be ≥ 1
  fMaxSteps >= fromIntegral ((fParameter - 1) * gasForOneExecution + gasForLastExecution)

genFixture :: Gen Fixture
genFixture =
  Fixture <$> (RemainingSteps <$> Gen.enum minGas maxGas) <*> Gen.enum minCalls maxCalls
  where
    minCalls = 1
    maxCalls = 10
    minGas = 0
    maxGas = gasForOneExecution * maxCalls

type Parameter = 'TInt
type Storage = 'TNat

testImpl ::
     (U.Contract, Contract Parameter Storage)
  -> [TestTree]
testImpl (uSelfCaller, selfCaller) =
  [ 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
      fixture <- forAll genFixture
      integrationalTestProp (integrationalScenario uSelfCaller fixture)
  ]
  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"

integrationalScenario :: U.Contract -> Fixture -> IntegrationalScenario
integrationalScenario uSelfCaller fixture = do
  setMaxSteps (fMaxSteps fixture)
  address <- originate uSelfCaller "self-caller" (U.ValueInt 0) (unsafeMkMutez 1)
  let
    txData :: TxData
    txData = TxData
      { tdSenderAddress = genesisAddress
      , tdParameter = U.ValueInt (fromIntegral $ fParameter fixture)
      , tdEntrypoint = DefEpName
      , tdAmount = minBound
      }
  if fExpectSuccess fixture
    then do
      transfer txData address
      let expectedStorage = U.ValueInt (fromIntegral $ fParameter fixture)
      expectStorageUpdateConst address expectedStorage
    else
      transfer txData address `catchExpectedError` expectGasExhaustion