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 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 @TransferAllParameter (inContractsDir "transfer_all.tz")
        >>= originate "transfer_all" () . noViews
      transferAllCallerAddr <-
        importContract @TransferAllCallerParameter (inContractsDir "transfer_all_caller.tz")
        >>= originate "transfer_all_caller" () . noViews
      transfer transferAllAddr [tz|100u|] $ calling #receiveXtz ()
      transfer transferAllCallerAddr $ calling #callCPS $ toTAddress transferAllAddr
  ]