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 :: [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)
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
}