Apply.hs

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

{-# OPTIONS_GHC -Wno-orphans #-}

-- | Tests for the 'APPLY' instruction.
module Test.Interpreter.Apply
  ( test_Basic
  , test_Partially_applied_lambda_packed
  ) where

import Test.Tasty (TestTree)

import Morley.Michelson.Typed
import Morley.Michelson.Untyped qualified as U
import Test.Cleveland
import Test.Cleveland.Util (fromHex)

import Test.Util.Contracts

test_Basic :: TestTree
test_Basic = testScenarioOnEmulator "" $ scenario do
  applyContract <- importUntypedContract $ inContractsDir "apply.tz"
  handle <- originateUntypedSimple "apply" (U.ValueInt 0) applyContract
  let
    lam :: Instr '[ ToT (Integer, Integer) ] '[ ToT Integer ]
    lam = DUP `Seq` CAR `Seq` DIP CDR `Seq` SUB
  transfer TransferData
    { tdTo = handle
    , tdAmount = 0
    , tdEntrypoint = DefEpName
    , tdParameter = VLam $ RfNormal lam }
  getStorage @Integer handle @@== 2


test_Partially_applied_lambda_packed :: TestTree
test_Partially_applied_lambda_packed = testScenarioOnEmulator "" $ scenario do
  partApplyContract <-
    importUntypedContract $ inContractsDir "partially-applied-lambda-packed.tz"
  handle <- originateUntypedSimple "apply" (U.ValueBytes $ U.InternalByteString "") partApplyContract
  let expected = unsafe $ fromHex "05020000000f0743035b0005034202000000020316"
  transfer TransferData
    { tdTo = handle
    , tdAmount = 0
    , tdEntrypoint = DefEpName
    , tdParameter = () }
  getStorage @ByteString handle @@== expected