RefillableAddress.hs

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

module TestSuite.Cleveland.RefillableAddress
  ( test_AddressRefills
  , test_AddressDoesntRefill
  , test_RefillFailure
  ) where

import Lorentz qualified as L

import Test.Tasty (TestTree)

import Morley.Util.SizedList qualified as SL
import Morley.Util.SizedList.Types
import Test.Cleveland

import TestSuite.Util (shouldFailWithMessage)
import TestSuite.Util.Contracts

test_AddressRefills :: [TestTree]
test_AddressRefills =
  [ testScenario "A refillable address refills when transfer amount > balance" $ scenario do
      refillableAddr <- refillable $ newAddress "refillable"
      receiver <- newFreshAddress auto

      balanceSender <- getBalance refillableAddr

      withSender refillableAddr do
        transfer receiver (balanceSender + 1000) -- obviously more than sender has

      getBalance receiver @@== (balanceSender + 1000)
  , testScenario "Multiple refillable addresses refill when transfer amount > balance" $ scenario do
      addr1 ::< addr2 ::< Nil' <- refillables $ newAddresses $ enumAliases "refillable"
      receiver <- newFreshAddress auto
      balanceSender1 <- getBalance addr1
      balanceSender2 <- getBalance addr2

      withSender addr1 do
        transfer receiver (balanceSender1 + 1000) -- obviously more than sender has
      withSender addr2 do
        transfer receiver (balanceSender2 + 1000) -- obviously more than sender has

      getBalance receiver @@== (balanceSender1 + balanceSender2 + 2000)
  , testScenario "A refillable address refills when transfer amount == balance - 1 μtz" $ scenario do
      refillableAddr <- refillable $ newAddress "refillable"
      receiver <- newFreshAddress auto

      balanceSender <- getBalance refillableAddr

      withSender refillableAddr do
        transfer receiver (balanceSender - 1) -- also would fail without auto-refill, due to fees
        -- NOTE: the test crashes currently when transfer amount = balance; it seems like a
        -- bug in the local chain code. Theoretically, this test should work either way.

      getBalance receiver @@== (balanceSender - 1)
  , testScenario "A refillable address refills during contract origination" $ scenario do
      refillableAddr <- refillable $ newAddress "refillable"
      soBigContract <- importContract @() @() @() $ contractsDir </> "so_big.tz"
      -- storage burn should be at least >= 1 XTZ due to the contract size
      -- however, since 'refillableAddr' has at least 0.5 XTZ after 'refillable'
      -- we also transfer 0.5 XTZ to the contract; this ensures we're overbudget.
      void $ withSender refillableAddr $ originate "so_big" () soBigContract [tz|0.5|]
  ]

test_AddressDoesntRefill :: [TestTree]
test_AddressDoesntRefill =
  [ testScenarioOnEmulator "A non-refillable address doesn't refill" $
      scenarioEmulated (nonRefillableScenario emulatedError)
  , testScenarioOnNetwork "A non-refillable address doesn't refill" $
      scenario (nonRefillableScenario networkError)
  ]
  where
  emulatedError = "doesn't have enough funds"
  networkError = "too low"

nonRefillableScenario :: (MonadFail m, MonadCleveland caps m) => String -> m ()
nonRefillableScenario errorMsg = do
  nonRefillable ::< receiver ::< Nil' <- traverse newFreshAddress $ SL.replicateT auto

  -- needed to reveal `nonRefillable`
  transfer nonRefillable [tz|1u|]

  shouldFailWithMessage errorMsg $
    withSender nonRefillable $ transfer receiver [tz|100u|]

test_RefillFailure :: TestTree
test_RefillFailure = testScenario "Refill should succeed even if moneybag can't make the call"
  $ scenario do
    owner <- refillable $ newFreshAddress "owner"
    transfer owner [tz|400u|] -- a little more than revelation fee to avoid empty_implicit_contract
    contract <- originate "contract" (L.toAddress owner) $ L.defaultContract @() @L.Address $
          L.cdr
      L.# L.dup
      L.# L.sender
      L.# L.ifEq
        (L.nil L.# L.pair)
        (L.push @L.MText "Sender is not owner" L.# L.failWith)
    balance1 <- getBalance owner
    withSender owner $ transfer contract
    balance2 <- getBalance owner
    -- check that owner was in fact refilled
    checkCompares balance1 (<=) balance2