UserUpgradeable.hs

-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Tests for user-defined upgrades

module Test.Lorentz.Contracts.UserUpgradeable
  ( test_UserUpgradeable
  ) where

import qualified Data.Map as Map
import Test.Tasty (TestTree)
import Test.Tasty.HUnit (testCase)

import Lorentz (mkView)
import Lorentz.Contracts.UserUpgradeable.Migrations (MigrationTarget)
import qualified Lorentz.Contracts.UserUpgradeable.V1 as V1
import qualified Lorentz.Contracts.UserUpgradeable.V2 as V2
import Lorentz.Test
import Lorentz.Value

{-# ANN module ("HLint: ignore Reduce duplication" :: Text) #-}

wallet1, admin :: Address
wallet1 = genesisAddress1
admin = genesisAddress2

originateV1 :: IntegrationalScenarioM (TAddress V1.Parameter)
originateV1 =
  lOriginate V1.userUpgradeableContract "UserUpgradeable V1"
    (V1.mkStorage balances admin) (toMutez 1000)
  where
    balances = BigMap $ Map.fromList
      [ (wallet1, 100)
      ]

originateV2
  :: TAddress V1.Parameter -> IntegrationalScenarioM (TAddress V2.Parameter)
originateV2 prevVersion =
  lOriginate V2.userUpgradeableContract "UserUpgradeable V2"
    (V2.mkStorage prevVersion) (toMutez 1000)

-- | A helper function that originates v1 and v2, and initiates an upgrade
-- from v1 to v2.
initMigration
  :: IntegrationalScenarioM (TAddress V1.Parameter, TAddress V2.Parameter)
initMigration = do
  v1 <- originateV1
  v2 <- originateV2 v1
  withSender admin $
    lCallDef v1 $ V1.InitiateMigration (migrateFromEntrypoint v2)
  return (v1, v2)

migrateMyTokens
  :: TAddress V1.Parameter -> Address -> Natural
  -> IntegrationalScenarioM ()
migrateMyTokens v1 wallet amount = do
  withSender wallet $
    lCallDef v1 $ V1.MigrateMyTokens amount

migrateFromEntrypoint :: TAddress V2.Parameter -> MigrationTarget
migrateFromEntrypoint c =
  fromContractRef . callingTAddress c $ Call @"MigrateFrom"

test_UserUpgradeable :: [TestTree]
test_UserUpgradeable =
  [ testCase "Arbitrary user can not initiate an upgrade" $
      integrationalTestExpectation $ do
        v1 <- originateV1
        v2 <- originateV2 v1
        lCallDef v1 (V1.InitiateMigration (migrateFromEntrypoint v2)) `catchExpectedError`
          lExpectCustomError_ #senderIsNotAdmin

  , testCase "Cannot initiate an upgrade twice" $
      integrationalTestExpectation $ do
        (v1, v2) <- initMigration
        withSender admin
          (lCallDef v1 $ V1.InitiateMigration (migrateFromEntrypoint v2))
          `catchExpectedError` lExpectCustomError_ #alreadyMigrating

  , testCase "Cannot call migrate if the migration is not initiated" $
      integrationalTestExpectation $ do
        v1 <- originateV1
        migrateMyTokens v1 wallet1 100 `catchExpectedError`
          lExpectCustomError_ #nowhereToMigrate

  , testCase "Migrations burn old tokens" $
      integrationalTestExpectation $ do
        (v1, _) <- initMigration
        consumer <- lOriginateEmpty @Natural contractConsumer "consumer"

        migrateMyTokens v1 wallet1 90
        migrateMyTokens v1 wallet1 9

        lCallDef v1 $ V1.GetBalance (mkView wallet1 consumer)
        lExpectViewConsumerStorage consumer [1]

  , testCase "Can migrate the whole balance" $
      integrationalTestExpectation $ do
        (v1, _) <- initMigration
        consumer <- lOriginateEmpty @Natural contractConsumer "consumer"

        migrateMyTokens v1 wallet1 100

        lCallDef v1 $ V1.GetBalance (mkView wallet1 consumer)
        lExpectViewConsumerStorage consumer [0]

  , testCase "Cannot migrate more than you have" $
      integrationalTestExpectation $ do
        (v1, _) <- initMigration

        migrateMyTokens v1 wallet1 101 `catchExpectedError`
          lExpectCustomError_ #userUpgradable'notEnoughTokens

  , testCase "Migrations mint new tokens" $
      integrationalTestExpectation $ do
        (v1, v2) <- initMigration
        consumer <- lOriginateEmpty @Natural contractConsumer "consumer"

        migrateMyTokens v1 wallet1 90
        migrateMyTokens v1 wallet1 9

        lCallDef v2 $ V2.GetBalance (mkView wallet1 consumer)
        lExpectViewConsumerStorage consumer [99]

  , testCase "Cannot call MigrateFrom directly" $
      integrationalTestExpectation $ do
        (_, v2) <- initMigration

        withSender wallet1
          (lCallDef v2 $ V2.MigrateFrom (wallet1, 100))
          `catchExpectedError` lExpectCustomError_ #userUpgradable'unauthorizedMigrateFrom
  ]