UpgradeableCounterSdu.hs

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

module Test.Lorentz.Contracts.UpgradeableCounterSdu
  ( spec_UpgradeableCounterSdu
  , test_Documentation
  ) where

import Lorentz (VoidResult(..), mkView, mkVoid)

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

import Lorentz.Constraints
import Lorentz.Contracts.Upgradeable.Common
import Lorentz.Contracts.Upgradeable.Test
import Lorentz.Contracts.UpgradeableCounterSdu
import qualified Lorentz.Contracts.UpgradeableCounterSdu.V1 as V1
import qualified Lorentz.Contracts.UpgradeableCounterSdu.V2 as V2
import Lorentz.Test
import Lorentz.Test.Doc
import Lorentz.UParam
import Lorentz.Value
import Util.Instances ()
import Util.Named

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

admin :: Address
admin = genesisAddress1

originateUpgradeableCounter
  :: IntegrationalScenarioM (UTAddress (CounterSduV 0))
originateUpgradeableCounter =
  lOriginate upgradeableCounterContractSdu "UpgradeableCounter"
    (mkEmptyStorage admin) (toMutez 1000)

originateUpgradeableCounterV1
  :: IntegrationalScenarioM (UTAddress (CounterSduV 1))
originateUpgradeableCounterV1 = do
  contract <- originateUpgradeableCounter
  withSender admin $ upgradeToV1 UpgEntrypointWise contract

upgradeToV1
  :: SimpleUpgradeWay
  -> UTAddress (CounterSduV 0)
  -> IntegrationalScenarioM (UTAddress (CounterSduV 1))
upgradeToV1 = integrationalTestUpgrade V1.counterUpgradeParameters

upgradeToV2
  :: SimpleUpgradeWay
  -> UTAddress (CounterSduV 1)
  -> IntegrationalScenarioM (UTAddress (CounterSduV 2))
upgradeToV2 = integrationalTestUpgrade V2.counterUpgradeParameters

upgradeV0ToV2
  :: SimpleUpgradeWay
  -> UTAddress (CounterSduV 0)
  -> IntegrationalScenarioM (UTAddress (CounterSduV 2))
upgradeV0ToV2 = integrationalTestUpgrade V2.counterUpgradeParametersFromV0

uCall
  :: forall a name (ver :: VersionKind) (interface :: [EntrypointKind]).
  ( interface ~ VerInterface ver
  , NicePackedValue a
  , PermConstraint ver
  , RequireUniqueEntrypoints interface
  , 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 (CounterSduV 1)
  -> IntegrationalScenarioM ()
getCounterValueV1 contract = do
  uCall contract #epGetCounterValue $ mkVoid ()

getCounterValueV2
  :: UTAddress (CounterSduV 2)
  -> IntegrationalScenarioM ()
getCounterValueV2 contract = do
  uCall contract #epGetCounterValue $ mkVoid ()

spec_UpgradeableCounterSdu :: Spec
spec_UpgradeableCounterSdu =
  forM_ [UpgOneShot, UpgEntrypointWise] $ \upgWay ->
  describe (show upgWay) $ do
    -- Most of the logic is covered in tests for similar 'UpgradeableCounter'
    -- contract (with entrypoint-wise migration way), not including such tests
    -- here, only ones on the main functionality
    describe "v1" $ do
      it "Updates counter after each operation" $ do
        integrationalTestExpectation $ do
          contract <- originateUpgradeableCounterV1

          uCall contract #epAdd (2 :: Natural)
          uCall contract #epInc ()
          getCounterValueV1 contract `catchExpectedError`
            lExpectError (== VoidResult @Natural 3)

      it "Can call permanent entrypoint" $ do
        integrationalTestExpectation $ do
          contract <- originateUpgradeableCounterV1

          uCall contract #epAdd (5 :: Natural)
          lCallEP contract (Call @"GetCounter") (mkVoid ()) `catchExpectedError`
            lExpectError (== VoidResult @Integer 5)

    describe "v2" $ do
      it "Upgrade and further operations work fine" $ do
        integrationalTestExpectation $ do
          contract <- originateUpgradeableCounterV1

          uCall contract #epAdd (2 :: Natural)

          offshoot "Before migration" $ do
            getCounterValueV1 contract `catchExpectedError`
              lExpectError (== VoidResult @Natural 2)

          contract2 <- withSender admin $ upgradeToV2 upgWay contract

          offshoot "Right after migration" $ do
            getCounterValueV2 contract2 `catchExpectedError`
              lExpectError (== VoidResult @Integer 2)

          offshoot "Cannot call removed entrypoint" $ do
            uCall contract #epAdd (5 :: Natural) `catchExpectedError`
              lExpectCustomError #uparamNoSuchEntrypoint [mt|epAdd|]

          uCall contract2 #epDec ()

          offshoot "After dec" $ do
            getCounterValueV2 contract2 `catchExpectedError`
              lExpectError (== VoidResult @Integer 1)

      it "Upgrade from scratch works fine" $
        integrationalTestExpectation $ do
          contractV0 <- originateUpgradeableCounter
          contract <- withSender admin $ upgradeV0ToV2 upgWay contractV0

          branchout
            [ "Can call operations" ?- do
                uCall contract #epInc ()
                uCall contract #epDec ()

            , "Version field has expected value" ?- do
                consumer <- lOriginateEmpty contractConsumer "consumer"
                lCallEP contract (Call @"GetVersion") (mkView () consumer)
                lExpectViewConsumerStorage consumer [2]
            ]

      it "Can decrease version" $ do
        integrationalTestExpectation $ do
          contractV2 <- originateUpgradeableCounterV1 >>=
                        withSender admin . upgradeToV2 upgWay

          contractV1 <-
            withSender admin $
              integrationalTestUpgrade V2.counterRollbackParameters upgWay contractV2

          consumer <- lOriginateEmpty contractConsumer "consumer"

          lCallDef contractV1 $ GetVersion (mkView () consumer)

          lExpectViewConsumerStorage consumer [1]

      it "Fails if wrong old version is provided" $ do
        integrationalTestExpectation $ do
          contract <- originateUpgradeableCounterV1
          withSender admin (upgradeV0ToV2 upgWay (coerce contract)) `catchExpectedError`
            lExpectCustomError #upgVersionMismatch
            (#expectedCurrent .! 0, #actualCurrent .! 1)

      it "Can call permanent entrypoint" $ do
        integrationalTestExpectation $ do
          contract <- originateUpgradeableCounterV1
          uCall contract #epAdd (5 :: Natural)

          contract2 <- withSender admin $ upgradeToV2 upgWay contract
          uCall contract2 #epInc ()
          lCallDef contract2 (RunPerm (GetCounter $ mkVoid ())) `catchExpectedError`
            lExpectError (== VoidResult @Integer 6)

test_Documentation :: [TestTree]
test_Documentation =
  runDocTests testSuites V1.counterDoc
  where
    testSuites =
      testUpgradeableContractDoc `excludeDocTests`
      [ testEachEntrypointIsDescribed
      ]