TransferCheck.hs

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

module TestSuite.Cleveland.TransferCheck
  ( test_TransferFromContract
  , test_nonUnitParamToImplicitAccount_fails
  ) where

import Test.Tasty (TestTree, testGroup)

import Lorentz ((#))
import Lorentz qualified as L
import Lorentz.Value
import Morley.Util.Named ((!))
import Test.Cleveland
import TestSuite.Util (idContract, shouldFailWithMessage)

test_TransferFromContract :: TestTree
test_TransferFromContract = testGroup "Transfers from contract"
  [ testScenario "Fails transfering 0tz to plain account" $ scenario
      $ testZeroTransactionFails
  , testScenario "Success transfering 0tz to a contract" $ scenario
      $ testZeroTransactionSuccess
  , testScenario "Allow transferring 0ꜩ from TRANSFER_TOKENS (#440)" $ scenario testEmptyTransfer
  ]
  where
    testEmptyTransfer :: MonadCleveland caps m => m ()
    testEmptyTransfer = do
      addr1 <- originate "test1" () zeroTransferContract
      addr2 <- originate "test2" () idContract
      transfer addr1 $ calling def (toTAddress addr2)

zeroTransferContract :: L.Contract (L.TAddress () ()) () ()
zeroTransferContract = L.defaultContract $
  L.car #
  L.pairE
    ( L.transferTokensE
        ! #contract do
           L.contract # L.assertSome [L.mt|Invalid contract address|]
        ! #amount do L.push zeroMutez
        ! #arg L.unit
      L.|:| L.nil
    , L.unit
    )

test_nonUnitParamToImplicitAccount_fails :: TestTree
test_nonUnitParamToImplicitAccount_fails =
  testScenario "`transfer` fails when param for an implicit account is not Unit" $ scenario do
    addr <- newFreshAddress "alias"
    transfer addr [tz|2u|] (unsafeCalling def (2 :: Natural))
      & shouldFailWithMessage "Bad contract parameter for: "

testZeroTransactionFails :: MonadCleveland caps m => m ()
testZeroTransactionFails = do
  wallet <- newAddress "wallet"
  expectTransferFailure emptyTransaction (transfer wallet)

testZeroTransactionSuccess :: MonadCleveland caps m => m ()
testZeroTransactionSuccess = do
  address <- originate "test0tzContract" True $ idContract @MText

  transfer address $ calling def "aaa"