V1.hs

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

module Lorentz.Contracts.UpgradeableCounter.V1
  ( CounterV1
  , migrate
  , migrations
  , counterContract
  , counterUpgradeParameters
  , UStoreV1
  , UStoreTemplateV1
  ) where

import Lorentz
import Lorentz.Contracts.Upgradeable.Common
import Lorentz.Contracts.Upgradeable.EntrypointWise
import Lorentz.UStore
import Lorentz.UStore.Migration

import Lorentz.Contracts.UpgradeableCounter

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

data CounterV1 :: VersionKind

data UStoreTemplateV1 = UStoreTemplateV1
  { counterValue :: UStoreField Natural
  , code :: MText |~> EntrypointImpl UStoreTemplateV1
  , fallback :: UStoreField $ EpwFallback UStoreTemplateV1
  } deriving stock (Eq, Generic)

type UStoreV1 = UStore UStoreTemplateV1

type Interface =
  [ "add" ?: Natural
  , "mul" ?: Natural
  , "getCounterValue" ?: Void_ () Natural
  ]

instance KnownContractVersion CounterV1 where
  type VerInterface CounterV1 = Interface
  type VerUStoreTemplate CounterV1 = UStoreTemplateV1
  contractVersion _ = 1

runAdd :: Lambda (Natural, UStoreV1) ([Operation], UStoreV1)
runAdd = do
  unpair
  dip $ ustoreGetField #counterValue
  add
  ustoreSetField #counterValue
  nil; pair

runMul :: Lambda (Natural, UStoreV1) ([Operation], UStoreV1)
runMul = do
  unpair
  dip $ ustoreGetField #counterValue
  mul
  ustoreSetField #counterValue
  nil; pair

runGetCounterValue :: Lambda (Void_ () Natural, UStoreV1) ([Operation], UStoreV1)
runGetCounterValue = do
  unpair
  void_ $ do
    drop @()
    ustoreGetField #counterValue
    dip drop

epwContract :: EpwContract CounterV1
epwContract = mkEpwContractT
  ( #add /==> runAdd
  , #mul /==> runMul
  , #getCounterValue /==> runGetCounterValue
  ) epwFallbackFail

-- | Migrations represent entrypoint-wise upgrades. Each migration puts
--   an implementation of a method to UStore. The contract code itself
--   (`epwServe`) does not do anything special except for taking these
--   lambdas out of the big map.
migrations :: [MigrationScript () UStoreTemplateV1]
migrations =
  migrateStorage :
  (epwCodeMigrations epwContract)

-- | This function migrates the storage from an empty one to UStoreV1,
--   i.e. it populates the empty BigMap with entries and initial values
--   for each field. Currently it is not guaranteed that all fields will be set
--   according to the template. See /docs/upgradeableContracts.md for type-safe
--   migrations idea description. The result is expected to adhere
--   to V1.UStoreTemplateV1.
migrateStorage :: MigrationScript () UStoreTemplateV1
migrateStorage = manualWithNewUStore $ do
  push @Natural 0
  ustoreSetField #counterValue

migrate :: MigrationScript () UStoreTemplateV1
migrate = manualConcatMigrationScripts migrations

counterContract :: UContractRouter CounterV1
counterContract = epwServe epwContract

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