UpgradeableCounter.hs

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

module Test.Lorentz.Contracts.UpgradeableCounter
  ( spec_UpgradeableCounter
  ) where

import Lorentz (VoidResult(..), mkView, mkVoid, ( # ))
import qualified Lorentz as L

import Data.Coerce (coerce)
import Test.Hspec (Spec, describe, it)

import Lorentz.Constraints
import Lorentz.Contracts.Upgradeable.Common
import Lorentz.Contracts.UpgradeableCounter
import qualified Lorentz.Contracts.UpgradeableCounter.V1 as V1
import qualified Lorentz.Contracts.UpgradeableCounter.V2 as V2
import Lorentz.Test
import Lorentz.UParam
import Lorentz.UStore
import Lorentz.Value
import Util.Instances ()

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

admin, admin2, adversary :: Address
admin = genesisAddress1
admin2 = genesisAddress2
adversary = genesisAddress3

originateUpgradeableCounter
  :: IntegrationalScenarioM (UTAddress CounterV0)
originateUpgradeableCounter =
  lOriginate upgradeableCounterContract "UpgradeableCounter"
    (mkEmptyStorage admin) (toMutez 1000)

originateUpgradeableCounterV1
  :: IntegrationalScenarioM (UTAddress V1.CounterV1)
originateUpgradeableCounterV1 = do
  contract <- originateUpgradeableCounter
  withSender admin $ upgradeToV1 contract
  return (coerce contract)

-- We deliberately use forall here so that we can test incorrect upgrades
upgradeToV1
  :: forall sign.
     UTAddress sign
  -> IntegrationalScenarioM (UTAddress V1.CounterV1)
upgradeToV1 =
  integrationalTestUpgrade V1.counterUpgradeParameters UpgEntrypointWise
  . coerce

-- We deliberately use forall here so that we can test incorrect upgrades
upgradeToV2
  :: forall sign.
     UTAddress sign
  -> IntegrationalScenarioM (UTAddress V2.CounterV2)
upgradeToV2 =
  integrationalTestUpgrade V2.counterUpgradeParameters UpgEntrypointWise
  . coerce

uCall
  :: forall a name (ver :: VersionKind) (interface :: [EntrypointKind]).
  ( interface ~ VerInterface ver
  , NicePackedValue a
  , RequireUniqueEntrypoints interface
  , PermConstraint ver
  , LookupEntrypoint name interface ~ a
  )
  => UTAddress ver
  -> Label name
  -> a
  -> IntegrationalScenarioM ()
uCall contract method arg = do
  lCallDef contract $ Run ((mkUParam method arg) :: UParam interface)

getCounterValueV1
  :: UTAddress V1.CounterV1
  -> IntegrationalScenarioM ()
getCounterValueV1 contract = do
  uCall contract #getCounterValue $ mkVoid ()

getVersion
  :: (PermConstraint ver)
  => UTAddress ver
  -> TAddress Version
  -> IntegrationalScenarioM ()
getVersion contract consumer = do
  lCallDef contract $ GetVersion (mkView () consumer)

getCounterValueV2
  :: UTAddress V2.CounterV2
  -> IntegrationalScenarioM ()
getCounterValueV2 contract = do
  uCall contract #getCounterValue $ mkVoid ()

spec_UpgradeableCounter :: Spec
spec_UpgradeableCounter = do
  describe "v1" $ do
    it "Initially contains zero" $ do
      integrationalTestExpectation $ do
        contract <- originateUpgradeableCounterV1
        getCounterValueV1 contract `catchExpectedError`
          lExpectError (== VoidResult @Natural 0)

    it "Updates counter after each operation" $ do
      integrationalTestExpectation $ do
        contract <- originateUpgradeableCounterV1

        uCall contract #add (2 :: Natural)
        uCall contract #mul (3 :: Natural)
        getCounterValueV1 contract `catchExpectedError`
          lExpectError (== VoidResult @Natural 6)

  describe "v2" $ do
    it "Upgrades to v2" $ do
      integrationalTestExpectation $ do
        contract <- originateUpgradeableCounterV1
        consumer <- lOriginateEmpty contractConsumer "consumer"

        getVersion contract consumer
        contract2 <- withSender admin $ upgradeToV2 contract
        getVersion contract2 consumer

        lExpectViewConsumerStorage consumer [1, 2]

    it "Preserves the counter after the upgrade" $ do
      integrationalTestExpectation $ do
        contract <- originateUpgradeableCounterV1

        uCall contract #add (42 :: Natural)
        contract2 <- withSender admin $ upgradeToV2 contract
        getCounterValueV2 contract2 `catchExpectedError`
          lExpectError (== VoidResult @Integer 42)

    it "Exposes new methods" $ do
      integrationalTestExpectation $ do
        contract <- originateUpgradeableCounterV1

        contract2 <- withSender admin $ upgradeToV2 contract
        uCall contract2 #inc ()
        uCall contract2 #inc ()

        branchout
          [ "2 inc" ?-
              getCounterValueV2 contract2 `catchExpectedError`
                lExpectError (== VoidResult @Integer 2)

          , "2 inc, 1 dec" ?- do
              uCall contract2 #dec ()
              getCounterValueV2 contract2 `catchExpectedError`
                lExpectError (== VoidResult @Integer 1)
          ]

    it "Allows to decrement below zero" $ do
      integrationalTestExpectation $ do
        contract <- originateUpgradeableCounterV1

        contract2 <- withSender admin $ upgradeToV2 contract
        uCall contract2 #dec ()
        uCall contract2 #dec ()
        uCall contract2 #dec ()
        getCounterValueV2 contract2 `catchExpectedError`
          lExpectError (== VoidResult @Integer (-3))

  describe "Cross-version" do
    it "Can migrate to the same version" $ do
      integrationalTestExpectation $ do
        contract <- originateUpgradeableCounterV1
        void $ withSender admin $ integrationalTestUpgrade
          ( fvUpgrade . migrationToScriptI . mkUStoreMigration $
                L.push 100 # migrateModifyField #counterValue
          )
          UpgOneShot
          contract

  describe "Illegal migrations" $ do
    it "Cannot migrate if sender is not admin" $ do
      integrationalTestExpectation $ do
        contract <- originateUpgradeableCounter
        withSender adversary (upgradeToV1 contract) `catchExpectedError`
          lExpectCustomError_ #senderIsNotAdmin

  describe "Administrator change" $ do
    it "Admin can set a new administrator" $ do
      integrationalTestExpectation $ do
        contract <- originateUpgradeableCounter
        withSender admin . lCallDef contract $ SetAdministrator admin2
        void $ withSender admin2 $ upgradeToV1 contract

    it "Non-admin cannot set a new administrator" $ do
      integrationalTestExpectation $ do
        contract <- originateUpgradeableCounter
        withSender adversary (lCallDef contract $ SetAdministrator admin2) `catchExpectedError`
          lExpectCustomError_ #senderIsNotAdmin