BatchTransferCheck.hs

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

{-# LANGUAGE ApplicativeDo #-}

module TestSuite.Cleveland.BatchTransferCheck
  ( test_SimpleTransfer
  , test_BatchTransferLeapingCosts
  ) where

import Test.Tasty (TestTree)

import Lorentz ((#), (:->))
import Lorentz qualified as L
import Morley.Util.SizedList qualified as SL
import Morley.Util.SizedList.Types
import Test.Cleveland

test_SimpleTransfer :: TestTree
test_SimpleTransfer =
  testScenario "Check the batch transaction correctness" $ scenario do
    addrs@(test1 ::< test2 ::< Nil') <- traverse newFreshAddress $ SL.replicateT auto

    comment "balance is updated after batch transfer"
    inBatch $ do
      for_ [100 :: Mutez, 200] $ transfer test1
      transfer test2 [tz|300u|]
      return ()

    traverse getBalance addrs @@== 300 :< 300 :< Nil

-- | Add given element on stack once on first invocation, and 10k times on
-- subsequent invocations.
leapingContract :: forall a. (L.NiceParameterFull a, L.NiceStorageFull [a], L.Dupable a) => L.Contract a [a] ()
leapingContract = L.defaultContract $
  L.unpair #
  L.duupX @2 # L.size # L.int # L.ifEq0 (L.push 1) (L.push 5000) #
  lIterate (L.dup @a # L.dip L.cons) #
  L.drop @a #
  L.nil # L.pair
  where
    lIterate :: s :-> s -> Natural : s :-> s
    lIterate f =
      decrease #
      L.loop (L.dip f # decrease) #
      L.drop @Natural

    decrease :: Natural : s :-> Bool : Natural : s
    decrease =
      L.push @Natural 1 # L.rsub # L.isNat #
      L.ifSome (L.push True) (L.push 999 # L.push False)

-- | Even in case when transactions in batch have very different costs,
-- and costs of subsequent transactions is affected by previous transactions,
-- everything works as expected.
test_BatchTransferLeapingCosts :: TestTree
test_BatchTransferLeapingCosts =
  testScenario "Check fees evaluation correctness for leaping transfer costs" $ scenario do
    contract <- originate "contract" [] (leapingContract @L.MText)

    comment "Perform batch transfer, second transaction should have much \
            \higher cost with respect to the first one"
    inBatch $
      for_ ["a", "b"] $ transfer contract . calling def

    comment "Sanity check on storage"
    getStorage contract @@==
      replicate 5000 "b" ++ one "a"