V2.hs

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

module Lorentz.Contracts.UpgradeableCounter.V2
  ( Interface
  , UStoreV2
  , CounterV2
  , migrate
  , migrations
  , counterContract
  , counterUpgradeParameters
  ) where

import Lorentz

import Lorentz.Contracts.Upgradeable.Common
import Lorentz.Contracts.Upgradeable.EntrypointWise
import Lorentz.Contracts.UpgradeableCounter.V1 (CounterV1, UStoreTemplateV1)
import Lorentz.UStore
import Lorentz.UStore.Migration

data CounterV2 :: VersionKind

data UStoreTemplateV2 = UStoreTemplateV2
  { newCounterValue :: UStoreField Integer
  , code :: MText |~> EntrypointImpl UStoreTemplateV2
  , fallback :: UStoreField $ EpwFallback UStoreTemplateV2
  } deriving stock (Eq, Generic)

type UStoreV2 = UStore UStoreTemplateV2

type Interface =
  [ "inc" ?: ()
  , "dec" ?: ()
  , "getCounterValue" ?: Void_ () Integer
  ]

instance KnownContractVersion CounterV2 where
  type VerInterface CounterV2 = Interface
  type VerUStoreTemplate CounterV2 = UStoreTemplateV2
  contractVersion _ = 2

epwContract :: EpwContract CounterV2
epwContract = mkEpwContractT
  ( #inc /==> runInc
  , #dec /==> runDec
  , #getCounterValue /==> runView
  ) epwFallbackFail

addInt :: Integer -> Lambda ((), UStoreV2) ([Operation], UStoreV2)
addInt x = do
  unpair
  drop
  ustoreGetField #newCounterValue
  push x
  add
  ustoreSetField #newCounterValue
  nil; pair

runInc :: Lambda ((), UStoreV2) ([Operation], UStoreV2)
runInc = addInt 1

runDec :: Lambda ((), UStoreV2) ([Operation], UStoreV2)
runDec = addInt (-1)

runView :: Lambda (Void_ () Integer, UStoreV2) ([Operation], UStoreV2)
runView = do
  unpair
  void_ $ do
    drop @()
    ustoreGetField #newCounterValue
    dip drop


migrations :: [MigrationScript UStoreTemplateV1 UStoreTemplateV2]
migrations =
    migrationToScript migrateStorage
  : removeOldEndpoints
  : epwCodeMigrations epwContract

removeOldEndpoints :: MigrationScript UStoreTemplateV1 UStoreTemplateV2
removeOldEndpoints = manualWithOldUStore $ do
  removeEndpoint #add
  removeEndpoint #mul

migrateStorage :: UStoreMigration UStoreTemplateV1 UStoreTemplateV2
migrateStorage = mkUStoreMigration $ do
  migrateExtractField #counterValue
  int
  migrateAddField #newCounterValue

  migrateCoerceUnsafe #code
  migrateCoerceUnsafe #fallback

  migrationFinish

migrate :: MigrationScript UStoreTemplateV1 UStoreTemplateV2
migrate = manualConcatMigrationScripts migrations

counterContract :: UContractRouter CounterV2
counterContract = epwServe epwContract

counterUpgradeParameters :: EpwUpgradeParameters [] CounterV1 CounterV2
counterUpgradeParameters = EpwUpgradeParameters
  { upMigrationScripts = migrations
  , upNewCode = counterContract
  , upNewPermCode = emptyPermanentImpl
  }