Lambda.hs

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

module Test.Lambda
  ( test_Lambdas
  , sumLambdaCalledOnce
  , sumLambdaCalledTwice
  , lambdasSideEffects
  , lambdaInLambda1
  , lambdaInLambda2
  , pathSumLambdaCalledOnce
  , pathSumLambdaCalledTwice
  , pathLambdasSideEffects
  , pathLambdaInLambda1
  , pathLambdaInLambda2
  ) where

import Prelude

import Hedgehog (Gen)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Hspec.Expectations (errorCall, shouldThrow)
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (testCase)

import Hedgehog.Gen.Tezos.Crypto (genKeyHash)
import Lorentz hiding (map)
import Michelson.Interpret (MichelsonFailed(..))
import Michelson.Runtime.GState
import qualified Michelson.Typed as T
import Test.Code.Lambda
import Test.Util

test_Lambdas :: [TestTree]
test_Lambdas =
  [ testIndigoContract "Pure lambda called once"
      genIntegerList genInteger
      (validateContractSt sumLambdaCheck)
      sumLambdaCalledOnce pathSumLambdaCalledOnce
  , testIndigoContract "Pure lambda called twice"
      genIntegerList genInteger
      (validateContractSt sumLambdaCheck)
      sumLambdaCalledTwice pathSumLambdaCalledTwice
  , testIndigoContract "Lambda with side effects"
      (Gen.maybe genKeyHash) genInteger
      (validateContract lambdasSideEffectsCheck)
      lambdasSideEffects pathLambdasSideEffects
  , testIndigoContract "Inner lambdas"
      genSmallMatrix genInteger
      (validateContractSt lambdaInLambdaCheck)
      lambdaInLambda1 pathLambdaInLambda1
  , testIndigoContract "Inner lambdas2"
      genSmallMatrix genInteger
      (validateContractSt lambdaInLambdaCheck)
      lambdaInLambda2 pathLambdaInLambda2
  , testCase "Outer scope error" $
      (pure $! lambdaOuterVarClosure)
      `shouldThrow`
      (errorCall "You are looking for manually created or leaked variable. #ref3 of type Integer")
  ]
  where
    genInteger = Gen.integral (Range.linearFrom 0 -1000 1000)
    genIntegerList = Gen.list (Range.linear 0 100) genInteger

pathSumLambdaCalledOnce :: FilePath
pathSumLambdaCalledOnce = "test/contracts/golden/lambda/pure_lambda_called_once.tz"

pathSumLambdaCalledTwice :: FilePath
pathSumLambdaCalledTwice = "test/contracts/golden/lambda/pure_lambda_called_twice.tz"

pathLambdasSideEffects :: FilePath
pathLambdasSideEffects = "test/contracts/golden/lambda/lambda_side_effects.tz"

pathLambdaInLambda1 :: FilePath
pathLambdaInLambda1 = "test/contracts/golden/lambda/impure_inner_lambdas.tz"

pathLambdaInLambda2 :: FilePath
pathLambdaInLambda2 = "test/contracts/golden/lambda/impure_inner_lambdas2.tz"

sumLambdaCheck :: [Integer] -> Integer -> Either MichelsonFailed Integer
sumLambdaCheck param _st = Right $ sum param

lambdasSideEffectsCheck :: Maybe KeyHash -> Integer -> Either MichelsonFailed ([Operation], Integer)
lambdasSideEffectsCheck param st = Right ([crConOp 1, crConOp 0], st + 2)
  where
    crConOp c = T.OpCreateContract $
      T.CreateContract genesisAddress param (toMutez 0) (T.VInt c)
      (T.cCode $ compileLorentzContract dummyContract)

genSmallMatrix :: Gen SmallMatrix
genSmallMatrix =
  fmap SmallMatrix
  $ Gen.list (Range.linear 0 15)
  $ Gen.list (Range.linear 0 15)
  $ Gen.integral (Range.linearFrom 0 -1000 1000)

lambdaInLambdaCheck :: SmallMatrix -> Integer -> Either MichelsonFailed Integer
lambdaInLambdaCheck (SmallMatrix param) st = Right $ sum (st : map sum param)