-- 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
  { UStoreTemplateV1 -> UStoreField Natural
counterValue :: UStoreField Natural
  , UStoreTemplateV1 -> MText |~> EntrypointImpl UStoreTemplateV1
code :: MText |~> EntrypointImpl UStoreTemplateV1
  , UStoreTemplateV1 -> UStoreField $ EpwFallback UStoreTemplateV1
fallback :: UStoreField $ EpwFallback UStoreTemplateV1
  } deriving stock (UStoreTemplateV1 -> UStoreTemplateV1 -> Bool
(UStoreTemplateV1 -> UStoreTemplateV1 -> Bool)
-> (UStoreTemplateV1 -> UStoreTemplateV1 -> Bool)
-> Eq UStoreTemplateV1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UStoreTemplateV1 -> UStoreTemplateV1 -> Bool
$c/= :: UStoreTemplateV1 -> UStoreTemplateV1 -> Bool
== :: UStoreTemplateV1 -> UStoreTemplateV1 -> Bool
$c== :: UStoreTemplateV1 -> UStoreTemplateV1 -> Bool
Eq, (forall x. UStoreTemplateV1 -> Rep UStoreTemplateV1 x)
-> (forall x. Rep UStoreTemplateV1 x -> UStoreTemplateV1)
-> Generic UStoreTemplateV1
forall x. Rep UStoreTemplateV1 x -> UStoreTemplateV1
forall x. UStoreTemplateV1 -> Rep UStoreTemplateV1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UStoreTemplateV1 x -> UStoreTemplateV1
$cfrom :: forall x. UStoreTemplateV1 -> Rep UStoreTemplateV1 x
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 :: Proxy CounterV1 -> Version
contractVersion Proxy CounterV1
_ = Version
1

runAdd :: Lambda (Natural, UStoreV1) ([Operation], UStoreV1)
runAdd :: Lambda (Natural, UStoreV1) ([Operation], UStoreV1)
runAdd = do
  '[(Natural, UStoreV1)] :-> '[Natural, UStoreV1]
forall a b (s :: [*]). ((a, b) : s) :-> (a : b : s)
unpair
  ('[UStoreV1] :-> '[Natural, UStoreV1])
-> '[Natural, UStoreV1] :-> '[Natural, Natural, UStoreV1]
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip (('[UStoreV1] :-> '[Natural, UStoreV1])
 -> '[Natural, UStoreV1] :-> '[Natural, Natural, UStoreV1])
-> ('[UStoreV1] :-> '[Natural, UStoreV1])
-> '[Natural, UStoreV1] :-> '[Natural, Natural, UStoreV1]
forall a b. (a -> b) -> a -> b
$ Label "counterValue"
-> '[UStoreV1]
   :-> '[GetUStoreField UStoreTemplateV1 "counterValue", UStoreV1]
forall store (name :: Symbol) (s :: [*]).
FieldAccessC store name =>
Label name
-> (UStore store : s)
   :-> (GetUStoreField store name : UStore store : s)
ustoreGetField Label "counterValue"
forall a. IsLabel "counterValue" a => a
forall (x :: Symbol) a. IsLabel x a => a
#counterValue
  '[Natural, Natural, UStoreV1] :-> '[Natural, UStoreV1]
forall n m (s :: [*]).
ArithOpHs Add n m =>
(n : m : s) :-> (ArithResHs Add n m : s)
add
  Label "counterValue"
-> '[GetUStoreField UStoreTemplateV1 "counterValue", UStoreV1]
   :-> '[UStoreV1]
forall store (name :: Symbol) (s :: [*]).
FieldAccessC store name =>
Label name
-> (GetUStoreField store name : UStore store : s)
   :-> (UStore store : s)
ustoreSetField Label "counterValue"
forall a. IsLabel "counterValue" a => a
forall (x :: Symbol) a. IsLabel x a => a
#counterValue
  '[UStoreV1] :-> '[[Operation], UStoreV1]
forall p (s :: [*]). KnownValue p => s :-> (List p : s)
nil; '[[Operation], UStoreV1] :-> '[([Operation], UStoreV1)]
forall a b (s :: [*]). (a : b : s) :-> ((a, b) : s)
pair

runMul :: Lambda (Natural, UStoreV1) ([Operation], UStoreV1)
runMul :: Lambda (Natural, UStoreV1) ([Operation], UStoreV1)
runMul = do
  '[(Natural, UStoreV1)] :-> '[Natural, UStoreV1]
forall a b (s :: [*]). ((a, b) : s) :-> (a : b : s)
unpair
  ('[UStoreV1] :-> '[Natural, UStoreV1])
-> '[Natural, UStoreV1] :-> '[Natural, Natural, UStoreV1]
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip (('[UStoreV1] :-> '[Natural, UStoreV1])
 -> '[Natural, UStoreV1] :-> '[Natural, Natural, UStoreV1])
-> ('[UStoreV1] :-> '[Natural, UStoreV1])
-> '[Natural, UStoreV1] :-> '[Natural, Natural, UStoreV1]
forall a b. (a -> b) -> a -> b
$ Label "counterValue"
-> '[UStoreV1]
   :-> '[GetUStoreField UStoreTemplateV1 "counterValue", UStoreV1]
forall store (name :: Symbol) (s :: [*]).
FieldAccessC store name =>
Label name
-> (UStore store : s)
   :-> (GetUStoreField store name : UStore store : s)
ustoreGetField Label "counterValue"
forall a. IsLabel "counterValue" a => a
forall (x :: Symbol) a. IsLabel x a => a
#counterValue
  '[Natural, Natural, UStoreV1] :-> '[Natural, UStoreV1]
forall n m (s :: [*]).
ArithOpHs Mul n m =>
(n : m : s) :-> (ArithResHs Mul n m : s)
mul
  Label "counterValue"
-> '[GetUStoreField UStoreTemplateV1 "counterValue", UStoreV1]
   :-> '[UStoreV1]
forall store (name :: Symbol) (s :: [*]).
FieldAccessC store name =>
Label name
-> (GetUStoreField store name : UStore store : s)
   :-> (UStore store : s)
ustoreSetField Label "counterValue"
forall a. IsLabel "counterValue" a => a
forall (x :: Symbol) a. IsLabel x a => a
#counterValue
  '[UStoreV1] :-> '[[Operation], UStoreV1]
forall p (s :: [*]). KnownValue p => s :-> (List p : s)
nil; '[[Operation], UStoreV1] :-> '[([Operation], UStoreV1)]
forall a b (s :: [*]). (a : b : s) :-> ((a, b) : s)
pair

runGetCounterValue :: Lambda (Void_ () Natural, UStoreV1) ([Operation], UStoreV1)
runGetCounterValue :: Lambda (Void_ () Natural, UStoreV1) ([Operation], UStoreV1)
runGetCounterValue = do
  '[(Void_ () Natural, UStoreV1)] :-> '[Void_ () Natural, UStoreV1]
forall a b (s :: [*]). ((a, b) : s) :-> (a : b : s)
unpair
  ('[(), UStoreV1] :-> '[Natural])
-> '[Void_ () Natural, UStoreV1] :-> '[([Operation], UStoreV1)]
forall a b (s :: [*]) (s' :: [*]) (anything :: [*]).
(IsError (VoidResult b), NiceConstant b) =>
((a : s) :-> (b : s')) -> (Void_ a b : s) :-> anything
void_ (('[(), UStoreV1] :-> '[Natural])
 -> '[Void_ () Natural, UStoreV1] :-> '[([Operation], UStoreV1)])
-> ('[(), UStoreV1] :-> '[Natural])
-> '[Void_ () Natural, UStoreV1] :-> '[([Operation], UStoreV1)]
forall a b. (a -> b) -> a -> b
$ do
    forall (s :: [*]). (() : s) :-> s
forall a (s :: [*]). (a : s) :-> s
drop @()
    Label "counterValue"
-> '[UStoreV1]
   :-> '[GetUStoreField UStoreTemplateV1 "counterValue", UStoreV1]
forall store (name :: Symbol) (s :: [*]).
FieldAccessC store name =>
Label name
-> (UStore store : s)
   :-> (GetUStoreField store name : UStore store : s)
ustoreGetField Label "counterValue"
forall a. IsLabel "counterValue" a => a
forall (x :: Symbol) a. IsLabel x a => a
#counterValue
    ('[UStoreV1] :-> '[]) -> '[Natural, UStoreV1] :-> '[Natural]
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip '[UStoreV1] :-> '[]
forall a (s :: [*]). (a : s) :-> s
drop

epwContract :: EpwContract CounterV1
epwContract :: EpwContract CounterV1
epwContract = IsoRecTuple (Rec (EpwCaseClause UStoreTemplateV1) Interface)
-> EpwFallback UStoreTemplateV1 -> EpwContract CounterV1
forall clauses (ver :: VersionKind) (interface :: [EntrypointKind])
       store.
(interface ~ VerInterface ver, store ~ VerUStoreTemplate ver,
 clauses ~ Rec (EpwCaseClause store) interface,
 RecFromTuple clauses, CodeMigrations interface,
 HasUStore "code" MText (EntrypointImpl store) store,
 HasUField "fallback" (EpwFallback store) store, Typeable store) =>
IsoRecTuple clauses -> EpwFallback store -> EpwContract ver
mkEpwContractT
  ( Label "add"
forall a. IsLabel "add" a => a
forall (x :: Symbol) a. IsLabel x a => a
#add Label "add"
-> Lambda (Natural, UStoreV1) ([Operation], UStoreV1)
-> EpwCaseClause UStoreTemplateV1 '("add", Natural)
forall (name :: Symbol) arg store.
Label name
-> Lambda (arg, UStore store) ([Operation], UStore store)
-> EpwCaseClause store '(name, arg)
/==> Lambda (Natural, UStoreV1) ([Operation], UStoreV1)
runAdd
  , Label "mul"
forall a. IsLabel "mul" a => a
forall (x :: Symbol) a. IsLabel x a => a
#mul Label "mul"
-> Lambda (Natural, UStoreV1) ([Operation], UStoreV1)
-> EpwCaseClause UStoreTemplateV1 '("mul", Natural)
forall (name :: Symbol) arg store.
Label name
-> Lambda (arg, UStore store) ([Operation], UStore store)
-> EpwCaseClause store '(name, arg)
/==> Lambda (Natural, UStoreV1) ([Operation], UStoreV1)
runMul
  , Label "getCounterValue"
forall a. IsLabel "getCounterValue" a => a
forall (x :: Symbol) a. IsLabel x a => a
#getCounterValue Label "getCounterValue"
-> Lambda (Void_ () Natural, UStoreV1) ([Operation], UStoreV1)
-> EpwCaseClause
     UStoreTemplateV1 '("getCounterValue", Void_ () Natural)
forall (name :: Symbol) arg store.
Label name
-> Lambda (arg, UStore store) ([Operation], UStore store)
-> EpwCaseClause store '(name, arg)
/==> Lambda (Void_ () Natural, UStoreV1) ([Operation], UStoreV1)
runGetCounterValue
  ) EpwFallback UStoreTemplateV1
forall store. EpwFallback store
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 :: [MigrationScript () UStoreTemplateV1]
migrations =
  MigrationScript () UStoreTemplateV1
migrateStorage MigrationScript () UStoreTemplateV1
-> [MigrationScript () UStoreTemplateV1]
-> [MigrationScript () UStoreTemplateV1]
forall a. a -> [a] -> [a]
:
  (EpwContract CounterV1
-> forall oldStore.
   [MigrationScript oldStore (VerUStoreTemplate CounterV1)]
forall (ver :: VersionKind).
EpwContract ver
-> forall oldStore.
   [MigrationScript oldStore (VerUStoreTemplate ver)]
epwCodeMigrations EpwContract CounterV1
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 :: MigrationScript () UStoreTemplateV1
migrateStorage = ('[UStoreV1] :-> '[UStoreV1])
-> MigrationScript () UStoreTemplateV1
forall newStore oldStore.
('[UStore newStore] :-> '[UStore newStore])
-> MigrationScript oldStore newStore
manualWithNewUStore (('[UStoreV1] :-> '[UStoreV1])
 -> MigrationScript () UStoreTemplateV1)
-> ('[UStoreV1] :-> '[UStoreV1])
-> MigrationScript () UStoreTemplateV1
forall a b. (a -> b) -> a -> b
$ do
  Natural -> '[UStoreV1] :-> '[Natural, UStoreV1]
forall t (s :: [*]). NiceConstant t => t -> s :-> (t : s)
push @Natural Natural
0
  Label "counterValue"
-> '[GetUStoreField UStoreTemplateV1 "counterValue", UStoreV1]
   :-> '[UStoreV1]
forall store (name :: Symbol) (s :: [*]).
FieldAccessC store name =>
Label name
-> (GetUStoreField store name : UStore store : s)
   :-> (UStore store : s)
ustoreSetField Label "counterValue"
forall a. IsLabel "counterValue" a => a
forall (x :: Symbol) a. IsLabel x a => a
#counterValue

migrate :: MigrationScript () UStoreTemplateV1
migrate :: MigrationScript () UStoreTemplateV1
migrate = [MigrationScript () UStoreTemplateV1]
-> MigrationScript () UStoreTemplateV1
forall os ns. [MigrationScript os ns] -> MigrationScript os ns
manualConcatMigrationScripts [MigrationScript () UStoreTemplateV1]
migrations

counterContract :: UContractRouter CounterV1
counterContract :: UContractRouter CounterV1
counterContract = EpwContract CounterV1 -> UContractRouter CounterV1
forall (ver :: VersionKind). EpwContract ver -> UContractRouter ver
epwServe EpwContract CounterV1
epwContract

counterUpgradeParameters :: EpwUpgradeParameters [] CounterV0 CounterV1
counterUpgradeParameters :: EpwUpgradeParameters [] CounterV0 CounterV1
counterUpgradeParameters = EpwUpgradeParameters :: forall (t :: * -> *) (curVer :: VersionKind)
       (newVer :: VersionKind) code codePerm.
(Traversable t, KnownContractVersion curVer,
 KnownContractVersion newVer,
 RequireSamePermanents (VerPermanent curVer) (VerPermanent newVer),
 RecognizeUpgPiece (UContractRouterUpdate curVer newVer) code,
 RecognizeUpgPiece (PermanentImplUpdate curVer newVer) codePerm) =>
t (MigrationScript
     (VerUStoreTemplate curVer) (VerUStoreTemplate newVer))
-> code -> codePerm -> EpwUpgradeParameters t curVer newVer
EpwUpgradeParameters
  { upMigrationScripts :: [MigrationScript
   (VerUStoreTemplate CounterV0) (VerUStoreTemplate CounterV1)]
upMigrationScripts = [MigrationScript () UStoreTemplateV1]
[MigrationScript
   (VerUStoreTemplate CounterV0) (VerUStoreTemplate CounterV1)]
migrations
  , upNewCode :: UContractRouter CounterV1
upNewCode = UContractRouter CounterV1
counterContract
  , upNewPermCode :: PermanentImpl CounterV1
upNewPermCode = PermanentImpl CounterV1
forall (ver :: VersionKind).
(VerPermanent ver ~ Empty) =>
PermanentImpl ver
emptyPermanentImpl
  }