morley-1.20.0: Developer tools for the Michelson Language
Safe HaskellSafe-Inferred
LanguageHaskell2010

Morley.Michelson.Typed.Entrypoints

Contents

Description

Utilities for lightweight entrypoints support.

Synopsis

Documentation

data EpAddress Source #

Address with optional entrypoint name attached to it.

Constructors

EpAddress' 

Fields

Bundled Patterns

pattern EpAddress :: KindedAddress kind -> EpName -> EpAddress 

Instances

Instances details
Generic EpAddress Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Associated Types

type Rep EpAddress :: Type -> Type #

Show EpAddress Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

NFData EpAddress Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

rnf :: EpAddress -> () #

Eq EpAddress Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Ord EpAddress Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

HasRPCRepr EpAddress Source # 
Instance details

Defined in Morley.AsRPC

Associated Types

type AsRPC EpAddress Source #

TypeHasDoc EpAddress Source # 
Instance details

Defined in Morley.Michelson.Typed.Haskell.Doc

IsoValue EpAddress Source # 
Instance details

Defined in Morley.Michelson.Typed.Haskell.Value

Associated Types

type ToT EpAddress :: T Source #

Buildable EpAddress Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

build :: EpAddress -> Doc

buildList :: [EpAddress] -> Doc

type Rep EpAddress Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

type Rep EpAddress = D1 ('MetaData "EpAddress" "Morley.Michelson.Typed.Entrypoints" "morley-1.20.0-inplace" 'False) (C1 ('MetaCons "EpAddress'" 'PrefixI 'True) (S1 ('MetaSel ('Just "eaAddress") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Address) :*: S1 ('MetaSel ('Just "eaEntrypoint") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 EpName)))
type AsRPC EpAddress Source # 
Instance details

Defined in Morley.AsRPC

type TypeDocFieldDescriptions EpAddress Source # 
Instance details

Defined in Morley.Michelson.Typed.Haskell.Doc

type ToT EpAddress Source # 
Instance details

Defined in Morley.Michelson.Typed.Haskell.Value

data ParseEpAddressError Source #

Instances

Instances details
Generic ParseEpAddressError Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Associated Types

type Rep ParseEpAddressError :: Type -> Type #

Show ParseEpAddressError Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

NFData ParseEpAddressError Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

rnf :: ParseEpAddressError -> () #

Eq ParseEpAddressError Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Buildable ParseEpAddressError Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

type Rep ParseEpAddressError Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

parseEpAddress :: Text -> Either ParseEpAddressError EpAddress Source #

Parse an address which can be suffixed with entrypoint name (e.g. "tz1faswCTDciRzE4oJ9jn2Vm2dvjeyA9fUzU%entrypoint").

parseEpAddressRaw :: ByteString -> Either ParseEpAddressError EpAddress Source #

Parses byte representation of entrypoint address.

For every address

KT1QbdJ7M7uAQZwLpvzerUyk7LYkJWDL7eDh%foo%bar

we get the following byte representation

01afab866e7f1e74f9bba388d66b246276ce50bf4700666f6f25626172
______________________________________//__/____
              address                     %   ep1  % ep2

data ParamNotes (t :: T) Source #

Annotations for contract parameter declaration.

Following the Michelson specification, this type has the following invariants: 1. No entrypoint name is duplicated. 2. If default entrypoint is explicitly assigned, no "arm" remains uncallable.

Constructors

UnsafeParamNotes 

Fields

Instances

Instances details
Generic (ParamNotes t) Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Associated Types

type Rep (ParamNotes t) :: Type -> Type #

Methods

from :: ParamNotes t -> Rep (ParamNotes t) x #

to :: Rep (ParamNotes t) x -> ParamNotes t #

Show (ParamNotes t) Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

NFData (ParamNotes t) Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

rnf :: ParamNotes t -> () #

Eq (ParamNotes t) Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

(==) :: ParamNotes t -> ParamNotes t -> Bool #

(/=) :: ParamNotes t -> ParamNotes t -> Bool #

type Rep (ParamNotes t) Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

type Rep (ParamNotes t) = D1 ('MetaData "ParamNotes" "Morley.Michelson.Typed.Entrypoints" "morley-1.20.0-inplace" 'False) (C1 ('MetaCons "UnsafeParamNotes" 'PrefixI 'True) (S1 ('MetaSel ('Just "pnNotes") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Notes t)) :*: S1 ('MetaSel ('Just "pnRootAnn") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 RootAnn)))

pattern ParamNotes :: Notes t -> RootAnn -> ParamNotes t Source #

starParamNotes :: SingI t => ParamNotes t Source #

Parameter without annotations.

data ArmCoord Source #

Constructors

AcLeft 
AcRight 

Instances

Instances details
Generic ArmCoord Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Associated Types

type Rep ArmCoord :: Type -> Type #

Methods

from :: ArmCoord -> Rep ArmCoord x #

to :: Rep ArmCoord x -> ArmCoord #

Show ArmCoord Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

NFData ArmCoord Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

rnf :: ArmCoord -> () #

Eq ArmCoord Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Buildable ArmCoord Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

build :: ArmCoord -> Doc

buildList :: [ArmCoord] -> Doc

type Rep ArmCoord Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

type Rep ArmCoord = D1 ('MetaData "ArmCoord" "Morley.Michelson.Typed.Entrypoints" "morley-1.20.0-inplace" 'False) (C1 ('MetaCons "AcLeft" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "AcRight" 'PrefixI 'False) (U1 :: Type -> Type))

type ArmCoords = [ArmCoord] Source #

Coordinates of "arm" in Or tree, used solely in error messages.

data ParamEpError Source #

Errors specific to parameter type declaration (entrypoints).

Instances

Instances details
Generic ParamEpError Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Associated Types

type Rep ParamEpError :: Type -> Type #

Show ParamEpError Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

NFData ParamEpError Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

rnf :: ParamEpError -> () #

Eq ParamEpError Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Buildable ParamEpError Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

build :: ParamEpError -> Doc

buildList :: [ParamEpError] -> Doc

type Rep ParamEpError Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

type Rep ParamEpError = D1 ('MetaData "ParamEpError" "Morley.Michelson.Typed.Entrypoints" "morley-1.20.0-inplace" 'False) (C1 ('MetaCons "ParamEpDuplicatedNames" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (NonEmpty EpName))) :+: C1 ('MetaCons "ParamEpUncallableArm" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 ArmCoords)))

mkParamNotes :: Notes t -> RootAnn -> Either ParamEpError (ParamNotes t) Source #

Construct ParamNotes performing all necessary checks.

data EpLiftSequence (arg :: T) (param :: T) where Source #

Describes how to construct full contract parameter from given entrypoint argument.

This could be just wrapper over Value arg -> Value param, but we cannot use Value type in this module easily.

Constructors

EplArgHere :: EpLiftSequence arg arg 
EplWrapLeft :: (SingI subparam, SingI r) => EpLiftSequence arg subparam -> EpLiftSequence arg ('TOr subparam r) 
EplWrapRight :: (SingI l, SingI subparam) => EpLiftSequence arg subparam -> EpLiftSequence arg ('TOr l subparam) 

Instances

Instances details
Show (EpLiftSequence arg param) Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

showsPrec :: Int -> EpLiftSequence arg param -> ShowS #

show :: EpLiftSequence arg param -> String #

showList :: [EpLiftSequence arg param] -> ShowS #

NFData (EpLiftSequence arg param) Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

rnf :: EpLiftSequence arg param -> () #

Eq (EpLiftSequence arg param) Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

(==) :: EpLiftSequence arg param -> EpLiftSequence arg param -> Bool #

(/=) :: EpLiftSequence arg param -> EpLiftSequence arg param -> Bool #

Buildable (EpLiftSequence arg param) Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

build :: EpLiftSequence arg param -> Doc

buildList :: [EpLiftSequence arg param] -> Doc

data EntrypointCallT (param :: T) (arg :: T) Source #

Reference for calling a specific entrypoint of type arg.

Constructors

ParameterScope arg => EntrypointCall 

Fields

Instances

Instances details
Show (EntrypointCallT param arg) Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

showsPrec :: Int -> EntrypointCallT param arg -> ShowS #

show :: EntrypointCallT param arg -> String #

showList :: [EntrypointCallT param arg] -> ShowS #

NFData (EntrypointCallT param arg) Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

rnf :: EntrypointCallT param arg -> () #

Eq (EntrypointCallT param arg) Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

(==) :: EntrypointCallT param arg -> EntrypointCallT param arg -> Bool #

(/=) :: EntrypointCallT param arg -> EntrypointCallT param arg -> Bool #

Buildable (EntrypointCallT param arg) Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

build :: EntrypointCallT param arg -> Doc

buildList :: [EntrypointCallT param arg] -> Doc

epcPrimitive :: forall p. (ParameterScope p, ForbidOr p) => EntrypointCallT p p Source #

Call parameter which has no entrypoints, always safe.

unsafeEpcCallRoot :: ParameterScope param => EntrypointCallT param param Source #

Construct EntrypointCallT which calls no entrypoint and assumes that there is no explicit "default" one.

Validity of such operation is not ensured.

data SomeEntrypointCallT (arg :: T) Source #

EntrypointCallT with hidden parameter type.

This requires argument to satisfy ParameterScope constraint. Strictly speaking, entrypoint argument may one day start having different set of constraints comparing to ones applied to parameter, but this seems unlikely.

Constructors

forall param.ParameterScope param => SomeEpc (EntrypointCallT param arg) 

Instances

Instances details
Show (SomeEntrypointCallT arg) Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

NFData (SomeEntrypointCallT arg) Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

rnf :: SomeEntrypointCallT arg -> () #

Eq (SomeEntrypointCallT arg) Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Buildable (SomeEntrypointCallT arg) Source # 
Instance details

Defined in Morley.Michelson.Typed.Entrypoints

Methods

build :: SomeEntrypointCallT arg -> Doc

buildList :: [SomeEntrypointCallT arg] -> Doc

unsafeSepcCallRoot :: ParameterScope param => SomeEntrypointCallT param Source #

Construct SomeEntrypointCallT which calls no entrypoint and assumes that there is no explicit "default" one.

Validity of such operation is not ensured.

sepcPrimitive :: forall t. (ParameterScope t, ForbidOr t) => SomeEntrypointCallT t Source #

Call parameter which has no entrypoints, always safe.

type family ForbidOr (t :: T) :: Constraint where ... Source #

Equations

ForbidOr ('TOr l r) = TypeError ('Text "Cannot apply to sum type parameter " ':<>: 'ShowType ('TOr l r)) 
ForbidOr _ = () 

data MkEntrypointCallRes param where Source #

Constructors

MkEntrypointCallRes :: ParameterScope arg => Notes arg -> EntrypointCallT param arg -> MkEntrypointCallRes param 

mkEntrypointCall :: ParameterScope param => EpName -> ParamNotes param -> Maybe (MkEntrypointCallRes param) Source #

Build EntrypointCallT.

Here we accept entrypoint name and type information for the parameter of target contract.

Returns Nothing if entrypoint is not found.

Prefer using mkDefEntrypointCall for the default entrypoint.

mkDefEntrypointCall :: ParameterScope param => ParamNotes param -> MkEntrypointCallRes param Source #

Build EntrypointCallT calling the default entrypoint. Unlike mkEntrypointCall, always succeeds.

tyImplicitAccountParam :: ParamNotes 'TUnit Source #

parameter type of implicit account.

Re-exports

newtype EpName Source #

Entrypoint name.

There are two properties we care about:

  1. Special treatment of the default entrypoint name. default is prohibited in the CONTRACT instruction and in values of address and contract types. However, it is not prohibited in the SELF instruction. Hence, the value inside EpName can be "default", so that we can distinguish SELF and SELF %default. It is important to distinguish them because their binary representation that is inserted into blockchain is different. For example, typechecking SELF %default consumes more gas than SELF. In this module, we provide several smart constructors with different handling of default, please use the appropriate one for your use case.
  2. The set of permitted characters. Intuitively, an entrypoint name should be valid only if it is a valid annotation (because entrypoints are defined using field annotations). However, it is not enforced in Tezos. It is not clear whether this behavior is intended. There is an upstream issue which received bug label, so probably it is considered a bug. Currently we treat it as a bug and deviate from upstream implementation by probiting entrypoint names that are not valid annotations. If Tezos developers fix it soon, we will be happy. If they don't, we should (maybe temporarily) remove this limitation from our code. There is an issue in our repo as well.

Constructors

UnsafeEpName 

Fields

Instances

Instances details
FromJSON EpName Source # 
Instance details

Defined in Morley.Michelson.Untyped.Entrypoints

ToJSON EpName Source # 
Instance details

Defined in Morley.Michelson.Untyped.Entrypoints

Generic EpName Source # 
Instance details

Defined in Morley.Michelson.Untyped.Entrypoints

Associated Types

type Rep EpName :: Type -> Type #

Methods

from :: EpName -> Rep EpName x #

to :: Rep EpName x -> EpName #

Show EpName Source # 
Instance details

Defined in Morley.Michelson.Untyped.Entrypoints

NFData EpName Source # 
Instance details

Defined in Morley.Michelson.Untyped.Entrypoints

Methods

rnf :: EpName -> () #

Eq EpName Source # 
Instance details

Defined in Morley.Michelson.Untyped.Entrypoints

Methods

(==) :: EpName -> EpName -> Bool #

(/=) :: EpName -> EpName -> Bool #

Ord EpName Source # 
Instance details

Defined in Morley.Michelson.Untyped.Entrypoints

HasCLReader EpName Source # 
Instance details

Defined in Morley.Michelson.Untyped.Entrypoints

Buildable EpName Source # 
Instance details

Defined in Morley.Michelson.Untyped.Entrypoints

Methods

build :: EpName -> Doc

buildList :: [EpName] -> Doc

type Rep EpName Source # 
Instance details

Defined in Morley.Michelson.Untyped.Entrypoints

type Rep EpName = D1 ('MetaData "EpName" "Morley.Michelson.Untyped.Entrypoints" "morley-1.20.0-inplace" 'True) (C1 ('MetaCons "UnsafeEpName" 'PrefixI 'True) (S1 ('MetaSel ('Just "unEpName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))

pattern DefEpName :: EpName Source #

This is a bidirectional pattern that can be used for two purposes:

  1. Construct an EpName referring to the default entrypoint.
  2. Use it in pattern-matching or in equality comparison to check whether EpName refers to the default entrypoint. This is trickier because there are two possible EpName values referring to the default entrypoints. DefEpName will match only the most common one (no entrypoint). However, there is a special case: SELF instruction can have explicit %default reference. For this reason, it is recommended to use isDefEpName instead. Pattern-matching on DefEpName is still permitted for backwards compatibility and for the cases when you are sure that EpName does not come from the SELF instruction.

epNameFromParamAnn :: FieldAnn -> Maybe EpName Source #

Make up EpName from annotation in parameter type declaration.

Returns Nothing if no entrypoint is assigned here.

epNameToParamAnn :: EpName -> FieldAnn Source #

Turn entrypoint name into annotation for contract parameter declaration.

epNameFromRefAnn :: FieldAnn -> Either EpNameFromRefAnnError EpName Source #

Make up EpName from annotation which is reference to an entrypoint. Note that it's more common for Michelson to prohibit explicit default entrypoint reference.

Specifically, %default annotation is probitited in values of address and contract types. It's also prohibited in the CONTRACT instruction. However, there is an exception: SELF %default is a perfectly valid instruction. Hence, when you construct an EpName from an annotation that's part of SELF, you should use epNameFromSelfAnn instead.

epNameToRefAnn :: EpName -> FieldAnn Source #

Turn entrypoint name into annotation used as reference to entrypoint.

data EpNameFromRefAnnError Source #

Instances

Instances details
Generic EpNameFromRefAnnError Source # 
Instance details

Defined in Morley.Michelson.Untyped.Entrypoints

Associated Types

type Rep EpNameFromRefAnnError :: Type -> Type #

Show EpNameFromRefAnnError Source # 
Instance details

Defined in Morley.Michelson.Untyped.Entrypoints

NFData EpNameFromRefAnnError Source # 
Instance details

Defined in Morley.Michelson.Untyped.Entrypoints

Methods

rnf :: EpNameFromRefAnnError -> () #

Eq EpNameFromRefAnnError Source # 
Instance details

Defined in Morley.Michelson.Untyped.Entrypoints

Buildable EpNameFromRefAnnError Source # 
Instance details

Defined in Morley.Michelson.Untyped.Entrypoints

type Rep EpNameFromRefAnnError Source # 
Instance details

Defined in Morley.Michelson.Untyped.Entrypoints

type Rep EpNameFromRefAnnError = D1 ('MetaData "EpNameFromRefAnnError" "Morley.Michelson.Untyped.Entrypoints" "morley-1.20.0-inplace" 'False) (C1 ('MetaCons "InEpNameBadAnnotation" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 FieldAnn)))