packages feed

cleveland-0.2.0: test/TestSuite/Cleveland/NewAddressCheck.hs

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

module TestSuite.Cleveland.NewAddressCheck
  ( test_AddressesReuse
  , test_NewAddressCheck
  ) where

import Test.Tasty (TestTree)

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

test_AddressesReuse :: TestTree
test_AddressesReuse =
  -- If we start hitting this check, then we have to revise the fact that
  -- 'newAddress' does not always put money on the generated address.
  -- If probability of generating the same address twice is low, then
  -- we better always blindly transfer some money to new addresses.
  testScenario "Address generation is deterministic" $ scenario do
    addr1 ::< addr2 ::< Nil' <- newAddresses $ SL.replicateT "test"

    addr1 @== addr2

test_NewAddressCheck :: [TestTree]
test_NewAddressCheck =
  [ testScenario "Newly created address gets money if it had low balance" $ scenario do
      let hints = enumAliases "test"
      test ::< test2 ::< Nil' <- newAddresses hints

      balance <- getBalance test
      let
        -- Prepare to spend most of the money (about 4/5 of the current balance)
        (toRemain, _) = balance `divModMutezInt` (5 :: Int) ?: error "Bad div"
        toSpend = balance - toRemain

      transferMoney test2 toSpend
        & withSender test

      balance2 <- getBalance test
      assert (balance2 <= toRemain) $
        "Sanity check failed. Something went wrong, is test broken?"

      -- creating the same address to check how balance replenishes
      _ <- newAddress $ SL.head hints

      balance3 <- getBalance test
      checkCompares balance3 (>) toRemain

  , testScenario "Newly created address does not get money if it has enough" $ scenario do
      test <- newAddress "test"

      initialBalance <- getBalance test

      -- creating the same address to check that no extra money are put on it
      _ <- newAddress "test"

      getBalance test @@== initialBalance
  ]