{-# OPTIONS_GHC -Wno-orphans #-}
module Lorentz.Contracts.UpgradeableCounterSdu.V1
( counterContract
, migration
, counterUpgradeParameters
, counterDoc
, runGetCounterValue
, runAdd
, permImpl
) where
import Lorentz
import Prelude (Identity)
import Data.Constraint (Dict(..))
import Lorentz.Contracts.Upgradeable.Common
import Lorentz.Contracts.Upgradeable.StorageDriven
import Lorentz.Contracts.UpgradeableCounterSdu
import Lorentz.UStore
{-# ANN module ("HLint: ignore Reduce duplication" :: Text) #-}
data UStoreTemplate = UStoreTemplate
{ UStoreTemplate -> UStoreField Natural
counterValue :: UStoreField Natural
, UStoreTemplate -> UStoreEntrypoint UStoreTemplate ()
epInc :: UStoreEntrypoint UStoreTemplate ()
, UStoreTemplate -> UStoreEntrypoint UStoreTemplate Natural
epAdd :: UStoreEntrypoint UStoreTemplate Natural
, UStoreTemplate
-> UStoreEntrypoint UStoreTemplate (Void_ () Natural)
epGetCounterValue :: UStoreEntrypoint UStoreTemplate (Void_ () Natural)
} deriving stock (UStoreTemplate -> UStoreTemplate -> Bool
(UStoreTemplate -> UStoreTemplate -> Bool)
-> (UStoreTemplate -> UStoreTemplate -> Bool) -> Eq UStoreTemplate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UStoreTemplate -> UStoreTemplate -> Bool
$c/= :: UStoreTemplate -> UStoreTemplate -> Bool
== :: UStoreTemplate -> UStoreTemplate -> Bool
$c== :: UStoreTemplate -> UStoreTemplate -> Bool
Eq, (forall x. UStoreTemplate -> Rep UStoreTemplate x)
-> (forall x. Rep UStoreTemplate x -> UStoreTemplate)
-> Generic UStoreTemplate
forall x. Rep UStoreTemplate x -> UStoreTemplate
forall x. UStoreTemplate -> Rep UStoreTemplate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UStoreTemplate x -> UStoreTemplate
$cfrom :: forall x. UStoreTemplate -> Rep UStoreTemplate x
Generic)
instance UStoreTemplateHasDoc UStoreTemplate where
ustoreTemplateDocName :: Text
ustoreTemplateDocName = Text
"V1"
ustoreTemplateDocDescription :: Markdown
ustoreTemplateDocDescription =
Markdown
"Template for version 1 of the contract."
type UStorage = UStore UStoreTemplate
type Interface = UStoreEpInterface UStoreTemplate
instance KnownContractVersion (CounterSduV 1) where
type VerInterface (CounterSduV 1) = Interface
type VerUStoreTemplate (CounterSduV 1) = UStoreTemplate
type VerPermanent (CounterSduV 1) = Permanent
_checkInterface :: Dict $ Interface ~
[ "epInc" ?: ()
, "epAdd" ?: Natural
, "epGetCounterValue" ?: Void_ () Natural
]
_checkInterface :: Dict
$ (Interface
~ '["epInc" ?: (), "epAdd" ?: Natural,
"epGetCounterValue" ?: Void_ () Natural])
_checkInterface = Dict
$ (Interface
~ '["epInc" ?: (), "epAdd" ?: Natural,
"epGetCounterValue" ?: Void_ () Natural])
forall (a :: Constraint). a => Dict a
Dict
runInc :: Entrypoint () UStorage
runInc :: Entrypoint () UStorage
runInc = do
forall (s :: [*]). (() : s) :-> s
forall a (s :: [*]). (a : s) :-> s
drop @()
Label "counterValue"
-> '[UStorage]
:-> '[GetUStoreField UStoreTemplate "counterValue", UStorage]
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, UStorage] :-> '[Natural, Natural, UStorage]
forall t (s :: [*]). NiceConstant t => t -> s :-> (t : s)
push @Natural Natural
1; '[Natural, Natural, UStorage] :-> '[Natural, UStorage]
forall n m (s :: [*]).
ArithOpHs Add n m =>
(n : m : s) :-> (ArithResHs Add n m : s)
add
Label "counterValue"
-> '[GetUStoreField UStoreTemplate "counterValue", UStorage]
:-> '[UStorage]
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
'[UStorage] :-> '[List Operation, UStorage]
forall p (s :: [*]). KnownValue p => s :-> (List p : s)
nil; '[List Operation, UStorage] :-> '[(List Operation, UStorage)]
forall a b (s :: [*]). (a : b : s) :-> ((a, b) : s)
pair
runAdd :: Entrypoint Natural UStorage
runAdd :: Entrypoint Natural UStorage
runAdd = do
('[UStorage] :-> '[Natural, UStorage])
-> '[Natural, UStorage] :-> '[Natural, Natural, UStorage]
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip (('[UStorage] :-> '[Natural, UStorage])
-> '[Natural, UStorage] :-> '[Natural, Natural, UStorage])
-> ('[UStorage] :-> '[Natural, UStorage])
-> '[Natural, UStorage] :-> '[Natural, Natural, UStorage]
forall a b. (a -> b) -> a -> b
$ Label "counterValue"
-> '[UStorage]
:-> '[GetUStoreField UStoreTemplate "counterValue", UStorage]
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, UStorage] :-> '[Natural, UStorage]
forall n m (s :: [*]).
ArithOpHs Add n m =>
(n : m : s) :-> (ArithResHs Add n m : s)
add
Label "counterValue"
-> '[GetUStoreField UStoreTemplate "counterValue", UStorage]
:-> '[UStorage]
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
'[UStorage] :-> '[List Operation, UStorage]
forall p (s :: [*]). KnownValue p => s :-> (List p : s)
nil; '[List Operation, UStorage] :-> '[(List Operation, UStorage)]
forall a b (s :: [*]). (a : b : s) :-> ((a, b) : s)
pair
runGetCounterValue :: Entrypoint (Void_ () Natural) UStorage
runGetCounterValue :: Entrypoint (Void_ () Natural) UStorage
runGetCounterValue = ('[(), UStorage] :-> '[Natural])
-> Entrypoint (Void_ () Natural) UStorage
forall a b (s :: [*]) (s' :: [*]) (anything :: [*]).
(IsError (VoidResult b), NiceConstant b) =>
((a : s) :-> (b : s')) -> (Void_ a b : s) :-> anything
void_ (('[(), UStorage] :-> '[Natural])
-> Entrypoint (Void_ () Natural) UStorage)
-> ('[(), UStorage] :-> '[Natural])
-> Entrypoint (Void_ () Natural) UStorage
forall a b. (a -> b) -> a -> b
$ do
forall (s :: [*]). (() : s) :-> s
forall a (s :: [*]). (a : s) :-> s
drop @()
Label "counterValue"
-> '[UStorage]
:-> '[GetUStoreField UStoreTemplate "counterValue", UStorage]
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
('[UStorage] :-> '[]) -> '[Natural, UStorage] :-> '[Natural]
forall a (s :: [*]) (s' :: [*]).
HasCallStack =>
(s :-> s') -> (a : s) :-> (a : s')
dip '[UStorage] :-> '[]
forall a (s :: [*]). (a : s) :-> s
drop
counterContract :: UContractRouter (CounterSduV 1)
counterContract :: UContractRouter (CounterSduV 1)
counterContract = SduFallback (VerUStoreTemplate (CounterSduV 1))
-> UContractRouter (CounterSduV 1)
forall (ver :: VersionKind).
Typeable (VerUStoreTemplate ver) =>
SduFallback (VerUStoreTemplate ver) -> UContractRouter ver
mkSduContract SduFallback (VerUStoreTemplate (CounterSduV 1))
forall store. SduFallback store
sduFallbackFail
permImpl :: PermanentImpl (CounterSduV 1)
permImpl :: PermanentImpl (CounterSduV 1)
permImpl = IsoRecTuple
(Rec
(CaseClauseL '[UStorage] '[(List Operation, UStorage)])
'[ 'CaseClauseParam "GetCounter" ('OneField (Void_ () Integer)),
'CaseClauseParam "GetNothing" ('OneField Empty)])
-> PermanentImpl (CounterSduV 1)
forall (ver :: VersionKind) dt (out :: [*]) (inp :: [*]) clauses.
(CaseTC dt out inp clauses,
DocumentEntrypoints PermanentEntrypointsKind dt,
dt ~ VerPermanent ver, inp ~ '[VerUStore ver],
out ~ ContractOut (VerUStore ver)) =>
IsoRecTuple clauses -> PermanentImpl ver
mkSmallPermanentImpl
( Label "cGetCounter"
forall a. IsLabel "cGetCounter" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cGetCounter Label "cGetCounter"
-> ('[Void_ () Integer, UStorage]
:-> '[(List Operation, UStorage)])
-> CaseClauseL
'[UStorage]
'[(List Operation, UStorage)]
('CaseClauseParam "GetCounter" ('OneField (Void_ () Integer)))
forall (name :: Symbol) body clause.
CaseArrow name body clause =>
Label name -> body -> clause
/-> ('[(), UStorage] :-> '[Integer])
-> '[Void_ () Integer, UStorage] :-> '[(List Operation, UStorage)]
forall a b (s :: [*]) (s' :: [*]) (anything :: [*]).
(IsError (VoidResult b), NiceConstant b) =>
((a : s) :-> (b : s')) -> (Void_ a b : s) :-> anything
void_ (('[(), UStorage] :-> '[Integer])
-> '[Void_ () Integer, UStorage] :-> '[(List Operation, UStorage)])
-> ('[(), UStorage] :-> '[Integer])
-> '[Void_ () Integer, UStorage] :-> '[(List Operation, UStorage)]
forall a b. (a -> b) -> a -> b
$ do
forall (s :: [*]). (() : s) :-> s
forall a (s :: [*]). (a : s) :-> s
drop @(); Label "counterValue"
-> '[UStorage] :-> '[GetUStoreField UStoreTemplate "counterValue"]
forall store (name :: Symbol) (s :: [*]).
FieldAccessC store name =>
Label name
-> (UStore store : s) :-> (GetUStoreField store name : s)
ustoreToField Label "counterValue"
forall a. IsLabel "counterValue" a => a
forall (x :: Symbol) a. IsLabel x a => a
#counterValue; '[Natural] :-> '[Integer]
forall i (s :: [*]).
ToIntegerArithOpHs i =>
(i : s) :-> (Integer : s)
int
, Label "cGetNothing"
forall a. IsLabel "cGetNothing" a => a
forall (x :: Symbol) a. IsLabel x a => a
#cGetNothing Label "cGetNothing"
-> ('[Empty, UStorage] :-> '[(List Operation, UStorage)])
-> CaseClauseL
'[UStorage]
'[(List Operation, UStorage)]
('CaseClauseParam "GetNothing" ('OneField Empty))
forall (name :: Symbol) body clause.
CaseArrow name body clause =>
Label name -> body -> clause
/-> '[Empty, UStorage] :-> '[(List Operation, UStorage)]
forall (s :: [*]) (s' :: [*]). (Empty : s) :-> s'
absurd_
)
mkStorage :: UStoreTemplate
mkStorage :: UStoreTemplate
mkStorage = UStoreTemplate :: UStoreField Natural
-> UStoreEntrypoint UStoreTemplate ()
-> UStoreEntrypoint UStoreTemplate Natural
-> UStoreEntrypoint UStoreTemplate (Void_ () Natural)
-> UStoreTemplate
UStoreTemplate
{ counterValue :: UStoreField Natural
counterValue = Natural -> UStoreField Natural
forall (m :: UStoreMarkerType) v. v -> UStoreFieldExt m v
UStoreField Natural
0
, epInc :: UStoreEntrypoint UStoreTemplate ()
epInc = Entrypoint () UStorage -> UStoreEntrypoint UStoreTemplate ()
forall arg store.
NiceUnpackedValue arg =>
Entrypoint arg (UStore store) -> UStoreEntrypoint store arg
mkUStoreEntrypoint Entrypoint () UStorage
runInc
, epAdd :: UStoreEntrypoint UStoreTemplate Natural
epAdd = Entrypoint Natural UStorage
-> UStoreEntrypoint UStoreTemplate Natural
forall arg store.
NiceUnpackedValue arg =>
Entrypoint arg (UStore store) -> UStoreEntrypoint store arg
mkUStoreEntrypoint Entrypoint Natural UStorage
runAdd
, epGetCounterValue :: UStoreEntrypoint UStoreTemplate (Void_ () Natural)
epGetCounterValue = Entrypoint (Void_ () Natural) UStorage
-> UStoreEntrypoint UStoreTemplate (Void_ () Natural)
forall arg store.
NiceUnpackedValue arg =>
Entrypoint arg (UStore store) -> UStoreEntrypoint store arg
mkUStoreEntrypoint Entrypoint (Void_ () Natural) UStorage
runGetCounterValue
}
migration :: UStoreMigration () UStoreTemplate
migration :: UStoreMigration () UStoreTemplate
migration = UStoreTemplate -> UStoreMigration () UStoreTemplate
forall template.
UStoreTraversable FillUStoreTW template =>
template -> UStoreMigration () template
fillUStore UStoreTemplate
mkStorage
counterUpgradeParameters :: EpwUpgradeParameters Identity (CounterSduV 0) (CounterSduV 1)
counterUpgradeParameters :: EpwUpgradeParameters Identity (CounterSduV 0) (CounterSduV 1)
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 :: Identity
(MigrationScript
(VerUStoreTemplate (CounterSduV 0))
(VerUStoreTemplate (CounterSduV 1)))
upMigrationScripts = UStoreMigration () UStoreTemplate
-> Identity (MigrationScript () UStoreTemplate)
forall os ns.
UStoreMigration os ns -> Identity (MigrationScript os ns)
migrationToScriptI UStoreMigration () UStoreTemplate
migration
, upNewCode :: UContractRouter (CounterSduV 1)
upNewCode = UContractRouter (CounterSduV 1)
counterContract
, upNewPermCode :: PermanentImpl (CounterSduV 1)
upNewPermCode = PermanentImpl (CounterSduV 1)
permImpl
}
counterDoc :: '[()] :-> '[()]
counterDoc :: '[()] :-> '[()]
counterDoc =
(SubDoc -> DName) -> ('[()] :-> '[()]) -> '[()] :-> '[()]
forall di (inp :: [*]) (out :: [*]).
DocItem di =>
(SubDoc -> di) -> (inp :-> out) -> inp :-> out
docGroup (Text -> SubDoc -> DName
DName Text
"Upgradeable counter (SDU)") (('[()] :-> '[()]) -> '[()] :-> '[()])
-> ('[()] :-> '[()]) -> '[()] :-> '[()]
forall a b. (a -> b) -> a -> b
$ do
'[()] :-> '[()]
forall (s :: [*]). s :-> s
contractGeneralDefault
DDescription -> '[()] :-> '[()]
forall di (s :: [*]). DocItem di => di -> s :-> s
doc (DDescription -> '[()] :-> '[()])
-> DDescription -> '[()] :-> '[()]
forall a b. (a -> b) -> a -> b
$ Markdown -> DDescription
DDescription
Markdown
"Sample of storage-driven upgradeable contract."
UStoreTemplate -> PermanentImpl (CounterSduV 1) -> '[()] :-> '[()]
forall utemplate (ver :: VersionKind).
(NiceVersion ver, KnownContractVersion ver,
UStoreTraversable SduDocumentTW utemplate, PermConstraint ver) =>
utemplate -> PermanentImpl ver -> '[()] :-> '[()]
sduContractDoc
(Proxy UpgradeableEntrypointsKind
-> UStoreTemplate -> UStoreTemplate
forall template epKind.
(UStoreTraversable SduAddEntrypointDocTW template,
DocItem (DEntrypoint epKind)) =>
Proxy epKind -> template -> template
sduAddEntrypointDoc (Proxy UpgradeableEntrypointsKind
forall k (t :: k). Proxy t
Proxy @UpgradeableEntrypointsKind) UStoreTemplate
mkStorage)
PermanentImpl (CounterSduV 1)
permImpl