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
        transferMoney receiver (balanceSender + 1000) -- obviously more than sender has

      getBalance receiver @@== (balanceSender + 1000)
  , 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
        transferMoney 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 $ OriginateData
        { odName = "so_big"
        , odBalance = 0.5e6
        , odContract = soBigContract
        , odStorage = ()
        }
  ]

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`
  transferMoney nonRefillable 1

  shouldFailWithMessage errorMsg $
    withSender nonRefillable $ transferMoney receiver 100

test_RefillFailure :: TestTree
test_RefillFailure = testScenario "Refill should succeed even if moneybag can't make the call"
  $ scenario do
    owner <- refillable $ newFreshAddress "owner"
    transferMoney owner 400 -- a little more than revelation fee to avoid empty_implicit_contract
    contract <- originateSimple @() @L.Address @() "contract" owner $ L.defaultContract $
          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 $ call contract CallDefault ()
    balance2 <- getBalance owner
    -- check that owner was in fact refilled
    checkCompares balance1 (<=) balance2