packages feed

cleveland-0.1.1: morley-test/Test/Interpreter/CallSelfAddress.hs

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

module Test.Interpreter.CallSelfAddress
  ( test_Call_self_address
  ) where

import Test.Tasty (TestTree)

import Morley.Michelson.Typed
import Morley.Tezos.Core (zeroMutez)
import Test.Cleveland
import Test.Cleveland.Michelson.Import (embedContract)
import Test.Util.Contracts (inContractsDir)

type ReceiverParameter = 'TLambda 'TUnit 'TAddress
type ReceiverStorage = 'TUnit

type SenderParameter = 'TContract ('TLambda 'TUnit 'TAddress)
type SenderStorage = 'TUnit

test_Call_self_address :: [TestTree]
test_Call_self_address =
    -- This tests that the SELF_ADDRESS inside a lambda returns the address
    -- of the contract executing the lambda (not the contract defining it).
    -- To do so, two contracts called the sender and the receiver are used.
    -- The sender (this contract) sends the lambda { DROP; SELF_ADDRESS }
    -- to the receiver (see self_address_receiver.tz) who checks that the
    -- returned value is the same as its SELF_ADDRESS.
    [ testScenario "self_address_sender should call self_address_receiver with no error" $ scenario do
        receiverUntyped <- originateUntyped $ UntypedOriginateData
            { uodName = "Receiver Contract"
            , uodBalance = zeroMutez
            , uodStorage = untypeValue $ toVal ()
            , uodContract = convertContract receiverContract
            }
        senderUntyped <- originateUntyped $ UntypedOriginateData
            { uodName = "Receiver Contract"
            , uodBalance = zeroMutez
            , uodStorage = untypeValue $ toVal ()
            , uodContract = convertContract senderContract
            }

        let params :: Value SenderParameter
              = VContract receiverUntyped (SomeEpc unsafeEpcCallRoot)

        transfer TransferData
          { tdTo = senderUntyped
          , tdAmount = zeroMutez
          , tdEntrypoint = DefEpName
          , tdParameter = params
          }
    ]
  where
    receiverContract =
      $$(embedContract @ReceiverParameter @ReceiverStorage (inContractsDir "self_address_receiver.tz"))
    senderContract =
      $$(embedContract @SenderParameter @SenderStorage (inContractsDir "self_address_sender.tz"))