DFS.hs

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

module TestSuite.Cleveland.DFS
  ( test_CheckDFSExecutionOrder
  ) where

import Test.Tasty (TestTree)

import Lorentz.Address
import Lorentz.Entrypoints
import Morley.Michelson.Typed qualified as T
import Morley.Tezos.Core (Mutez)
import Test.Cleveland
import TestSuite.Util.Contracts (inContractsDir)

data TransferAllParameter
  = ReceiveXtz
  | GetBalance
  | Transfer Mutez
  deriving stock (Generic)
  deriving anyclass (T.IsoValue)

data TransferAllCallerParameter
  = Moneybag
  | CallTransfer Mutez
  | CallCPS (TAddress TransferAllParameter ())
  deriving stock (Generic)
  deriving anyclass (T.IsoValue)

instance ParameterHasEntrypoints TransferAllParameter where
  type ParameterEntrypointsDerivation TransferAllParameter = EpdPlain

instance ParameterHasEntrypoints TransferAllCallerParameter where
  type ParameterEntrypointsDerivation TransferAllCallerParameter = EpdPlain

test_CheckDFSExecutionOrder :: [TestTree]
test_CheckDFSExecutionOrder =
  -- The following scenario fails with insufficient balance error in
  -- case when operations are performed in the BFS order.
  -- Here is the operation queue:
  -- 1) callCPS
  -- 2) getBalance(1), getBalance(2)
  -- 3) getBalance(2), callTransfer(1)
  -- 4) callTransfer(1), callTransfer(2)
  -- 5) callTransfer(2), transfer(1)
  -- 6) transfer(1), transfer(2)
  -- 7) transfer(2), moneybag(1)
  -- 8) moneybag(1), moneybag(2)
  -- 9) moneybag(2) -- this operation will then fail due to insufficient transfer_all contract
  --    balance
  [ testScenario "Operations are performed in DFS order" $ scenario do
      transferAllAddr <-
        importContract (inContractsDir "transfer_all.tz")
        >>= originateSimple @TransferAllParameter "transfer_all" () . noViews
      transferAllCallerAddr <-
        importContract (inContractsDir "transfer_all_caller.tz")
        >>= originateSimple @TransferAllCallerParameter "transfer_all_caller" () . noViews
      transfer $ TransferData
        { tdTo = transferAllAddr
        , tdAmount = 100
        , tdEntrypoint = ep "receiveXtz"
        , tdParameter = ()
        } -- transferAllAddr 100
      call transferAllCallerAddr (Call @"CallCPS") (toTAddress transferAllAddr)
  ]