Lambda.hs

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

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

import Prelude

import Fmt (pretty)
import Hedgehog (Gen)
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified 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 (KeyHash)
import Morley.Tezos.Address
import Test.Cleveland
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) (Gen.constant [])
      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 -> Integer
sumLambdaCheck param _st = sum param

lambdasSideEffectsCheck
  :: MonadCleveland caps m
  => Maybe KeyHash
  -> [Address]
  -> ContractHandle (Maybe KeyHash) [Address] ()
  -> m a
  -> m ()
lambdasSideEffectsCheck param _st contract action = do
  void action
  originatedContracts <- getStorage contract
  forM_ @_ @_ @() (zip [(0 :: Integer) ..] $ reverse originatedContracts) \(n, ct) -> do
    case ct of
      Constrained addr@ContractAddress{} -> do
        getDelegate addr @@== param
        getStorage @Integer addr @@== n
      _ -> failure $ "Expected ContractAddress, but got " <> pretty ct

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 -> Integer
lambdaInLambdaCheck (SmallMatrix param) st = sum (st : map sum param)