morley-upgradeable-0.3: Upgradeability infrastructure based on Morley.
Safe HaskellNone
LanguageHaskell2010

Lorentz.Contracts.Upgradeable.EntrypointWise

Synopsis

Documentation

type EntrypointImpl store = Lambda (ByteString, UStore store) ([Operation], UStore store) Source #

A helper type that defines an entrypoint that receives a packed argument, i.e. it's basically an unpack instruction followed by a TypedEntrypoint code

type EpwFallback store = Lambda ((MText, ByteString), UStore store) ([Operation], UStore store) Source #

A helper type that defines a function being called in case no implementation matches the requested entrypoint

data EpwContract ver Source #

This data type represents the new contract code and migrations necessary to upgrade the contract endpoints to the new version.

Constructors

EpwContract 

Fields

data EpwCaseClause store (entry :: EntrypointKind) where Source #

A data type representing a full case clause with the name and implementation of an entrypoint.

Constructors

EpwCaseClause :: TypedEntrypointImpl arg store -> EpwCaseClause store '(name, arg) 

mkEpwContract :: forall (ver :: VersionKind) (interface :: [EntrypointKind]) store. (interface ~ VerInterface ver, store ~ VerUStoreTemplate ver, CodeMigrations interface, HasUStore "code" MText (EntrypointImpl store) store, HasUField "fallback" (EpwFallback store) store, Typeable store) => Rec (EpwCaseClause store) interface -> EpwFallback store -> EpwContract ver Source #

Creates the EpwContract data structure from a Rec of case clauses

mkEpwContractT :: forall clauses ver (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 Source #

Like mkEpwContract, but accepts a tuple of clauses, not a Rec.

epwFallbackFail :: EpwFallback store Source #

Default implementation for EpwFallback reports an error just like its UParam counterpart

(/==>) :: Label name -> Lambda (arg, UStore store) ([Operation], UStore store) -> EpwCaseClause store '(name, arg) infixr 0 Source #

removeEndpoint :: forall store name s. GetUStoreKey store "code" ~ MText => Label name -> (UStore store ': s) :-> (UStore store ': s) Source #

Removes an endpoint from the #code submap

class EpwDocumented (entries :: [EntrypointKind]) where Source #

Helper for documenting entrypoints with EPW interface.

Methods

epwDocument :: Rec (EpwCaseClause store) entries -> Lambda () () Source #

Make up documentation for given entry points.

As result you get a fake contract from which you can later build desired documentation. Although, you may want to add contract name and description first.

Instances

Instances details
EpwDocumented ('[] :: [EntrypointKind]) Source # 
Instance details

Defined in Lorentz.Contracts.Upgradeable.EntrypointWise

Methods

epwDocument :: Rec (EpwCaseClause store) '[] -> Lambda () () Source #

(KnownSymbol name, EpwDocumented es) => EpwDocumented ('(name, a) ': es) Source # 
Instance details

Defined in Lorentz.Contracts.Upgradeable.EntrypointWise

Methods

epwDocument :: Rec (EpwCaseClause store) ('(name, a) ': es) -> Lambda () () Source #

epwContractDoc :: forall ver. (NiceVersion ver, KnownContractVersion ver, EpwDocumented (VerInterface ver), PermConstraint ver) => Rec (EpwCaseClause (VerUStoreTemplate ver)) (VerInterface ver) -> PermanentImpl ver -> Lambda () () Source #

By given list of entrypoints make up a fake contract which contains documentation for the body of given upgradeable contract.