| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Michelson.Typed.EntryPoints
Description
Utilities for lightweight entrypoints support.
Synopsis
- newtype EpName = EpNameUnsafe {}
- pattern NoEpName :: EpName
- epNameFromParamAnn :: FieldAnn -> Maybe EpName
- epNameToParamAnn :: EpName -> FieldAnn
- epNameFromRefAnn :: FieldAnn -> Either EpNameFromRefAnnError EpName
- epNameToRefAnn :: EpName -> FieldAnn
- data EpNameFromRefAnnError = InEpNameBadAnnotation FieldAnn
- data EpAddress = EpAddress {}
- data ParseEpAddressError
- formatEpAddress :: EpAddress -> Text
- mformatEpAddress :: EpAddress -> MText
- parseEpAddress :: Text -> Either ParseEpAddressError EpAddress
- unsafeParseEpAddress :: HasCallStack => Text -> EpAddress
- newtype ParamNotes (t :: T) = ParamNotesUnsafe {
- unParamNotes :: Notes t
- data ArmCoord
- type ArmCoords = [ArmCoord]
- data ParamEpError
- mkParamNotes :: Notes t -> Either ParamEpError (ParamNotes t)
- data EpLiftSequence (arg :: T) (param :: T) where
- EplArgHere :: EpLiftSequence arg arg
- EplWrapLeft :: EpLiftSequence arg subparam -> EpLiftSequence arg (TOr subparam r)
- EplWrapRight :: EpLiftSequence arg subparam -> EpLiftSequence arg (TOr l subparam)
- data EntryPointCallT (param :: T) (arg :: T) = EntryPointCall {
- epcName :: EpName
- epcParamProxy :: Proxy param
- epcLiftSequence :: EpLiftSequence arg param
- data SomeEntryPointCallT (arg :: T) = ParameterScope param => SomeEpc (EntryPointCallT param arg)
- sepcName :: SomeEntryPointCallT arg -> EpName
- mkEntryPointCall :: ParameterScope param => EpName -> (Sing param, Notes param) -> (forall arg. ParameterScope arg => (Notes arg, EntryPointCallT param arg) -> r) -> Maybe r
- tyImplicitAccountParam :: (Sing TUnit, Notes TUnit)
Documentation
Entrypoint name.
Empty if this entrypoint is default one. Cannot be equal to "default", the reference implementation forbids that. Also, set of allowed characters should be the same as in annotations.
Constructors
| EpNameUnsafe | |
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
(e.g. annotation in CONTRACT instruction).
Fails if annotation is invalid.
epNameToRefAnn :: EpName -> FieldAnn Source #
Turn entrypoint name into annotation used as reference to entrypoint.
data EpNameFromRefAnnError Source #
Constructors
| InEpNameBadAnnotation FieldAnn |
Instances
| Eq EpNameFromRefAnnError Source # | |
Defined in Michelson.Typed.EntryPoints Methods (==) :: EpNameFromRefAnnError -> EpNameFromRefAnnError -> Bool # (/=) :: EpNameFromRefAnnError -> EpNameFromRefAnnError -> Bool # | |
| Show EpNameFromRefAnnError Source # | |
Defined in Michelson.Typed.EntryPoints Methods showsPrec :: Int -> EpNameFromRefAnnError -> ShowS # show :: EpNameFromRefAnnError -> String # showList :: [EpNameFromRefAnnError] -> ShowS # | |
| Buildable EpNameFromRefAnnError Source # | |
Defined in Michelson.Typed.EntryPoints Methods build :: EpNameFromRefAnnError -> Builder # | |
Address with optional entrypoint name attached to it. TODO: come up with better name?
Constructors
| EpAddress | |
Fields
| |
Instances
data ParseEpAddressError Source #
Constructors
| ParseEpAddressBadAddress ParseAddressError | |
| ParseEpAddressRefAnnError EpNameFromRefAnnError |
Instances
| Eq ParseEpAddressError Source # | |
Defined in Michelson.Typed.EntryPoints Methods (==) :: ParseEpAddressError -> ParseEpAddressError -> Bool # (/=) :: ParseEpAddressError -> ParseEpAddressError -> Bool # | |
| Show ParseEpAddressError Source # | |
Defined in Michelson.Typed.EntryPoints Methods showsPrec :: Int -> ParseEpAddressError -> ShowS # show :: ParseEpAddressError -> String # showList :: [ParseEpAddressError] -> ShowS # | |
| Buildable ParseEpAddressError Source # | |
Defined in Michelson.Typed.EntryPoints Methods build :: ParseEpAddressError -> Builder # | |
formatEpAddress :: EpAddress -> Text Source #
mformatEpAddress :: EpAddress -> MText Source #
parseEpAddress :: Text -> Either ParseEpAddressError EpAddress Source #
Parse an address which can be suffixed with entrypoint name (e.g. "tz1faswCTDciRzE4oJ9jn2Vm2dvjeyA9fUzU%entrypoint").
unsafeParseEpAddress :: HasCallStack => Text -> EpAddress Source #
newtype 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
| ParamNotesUnsafe | |
Fields
| |
Instances
| Eq (ParamNotes t) Source # | |
Defined in Michelson.Typed.EntryPoints | |
| Show (ParamNotes t) Source # | |
Defined in Michelson.Typed.EntryPoints Methods showsPrec :: Int -> ParamNotes t -> ShowS # show :: ParamNotes t -> String # showList :: [ParamNotes t] -> ShowS # | |
data ParamEpError Source #
Errors specific to parameter type declaration (entrypoints).
Constructors
| ParamEpDuplicatedNames (NonEmpty EpName) | |
| ParamEpUncallableArm ArmCoords |
Instances
| Eq ParamEpError Source # | |
Defined in Michelson.Typed.EntryPoints | |
| Show ParamEpError Source # | |
Defined in Michelson.Typed.EntryPoints Methods showsPrec :: Int -> ParamEpError -> ShowS # show :: ParamEpError -> String # showList :: [ParamEpError] -> ShowS # | |
| Buildable ParamEpError Source # | |
Defined in Michelson.Typed.EntryPoints Methods build :: ParamEpError -> Builder # | |
mkParamNotes :: Notes t -> 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 :: EpLiftSequence arg subparam -> EpLiftSequence arg (TOr subparam r) | |
| EplWrapRight :: EpLiftSequence arg subparam -> EpLiftSequence arg (TOr l subparam) |
Instances
| Eq (EpLiftSequence arg param) Source # | |
Defined in Michelson.Typed.EntryPoints Methods (==) :: EpLiftSequence arg param -> EpLiftSequence arg param -> Bool # (/=) :: EpLiftSequence arg param -> EpLiftSequence arg param -> Bool # | |
| Show (EpLiftSequence arg param) Source # | |
Defined in Michelson.Typed.EntryPoints Methods showsPrec :: Int -> EpLiftSequence arg param -> ShowS # show :: EpLiftSequence arg param -> String # showList :: [EpLiftSequence arg param] -> ShowS # | |
| Buildable (EpLiftSequence arg param) Source # | |
Defined in Michelson.Typed.EntryPoints Methods build :: EpLiftSequence arg param -> Builder # | |
data EntryPointCallT (param :: T) (arg :: T) Source #
Reference for calling a specific entrypoint of type arg.
Constructors
| EntryPointCall | |
Fields
| |
Instances
| Eq (EntryPointCallT param arg) Source # | |
Defined in Michelson.Typed.EntryPoints Methods (==) :: EntryPointCallT param arg -> EntryPointCallT param arg -> Bool # (/=) :: EntryPointCallT param arg -> EntryPointCallT param arg -> Bool # | |
| Show (EntryPointCallT param arg) Source # | |
Defined in Michelson.Typed.EntryPoints Methods showsPrec :: Int -> EntryPointCallT param arg -> ShowS # show :: EntryPointCallT param arg -> String # showList :: [EntryPointCallT param arg] -> ShowS # | |
| param ~ arg => Default (EntryPointCallT param arg) Source # | Calls the default entrypoint. |
Defined in Michelson.Typed.EntryPoints Methods def :: EntryPointCallT param arg # | |
| Buildable (EntryPointCallT param arg) Source # | |
Defined in Michelson.Typed.EntryPoints Methods build :: EntryPointCallT param arg -> Builder # | |
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
| ParameterScope param => SomeEpc (EntryPointCallT param arg) |
Instances
| Eq (SomeEntryPointCallT arg) Source # | |
Defined in Michelson.Typed.EntryPoints Methods (==) :: SomeEntryPointCallT arg -> SomeEntryPointCallT arg -> Bool # (/=) :: SomeEntryPointCallT arg -> SomeEntryPointCallT arg -> Bool # | |
| Show (SomeEntryPointCallT arg) Source # | |
Defined in Michelson.Typed.EntryPoints Methods showsPrec :: Int -> SomeEntryPointCallT arg -> ShowS # show :: SomeEntryPointCallT arg -> String # showList :: [SomeEntryPointCallT arg] -> ShowS # | |
| ParameterScope arg => Default (SomeEntryPointCallT arg) Source # | |
Defined in Michelson.Typed.EntryPoints Methods def :: SomeEntryPointCallT arg # | |
| Buildable (SomeEntryPointCallT arg) Source # | |
Defined in Michelson.Typed.EntryPoints Methods build :: SomeEntryPointCallT arg -> Builder # | |
sepcName :: SomeEntryPointCallT arg -> EpName Source #
mkEntryPointCall :: ParameterScope param => EpName -> (Sing param, Notes param) -> (forall arg. ParameterScope arg => (Notes arg, EntryPointCallT param arg) -> r) -> Maybe r Source #
Build EntryPointCallT.
Here we accept entrypoint name and type information for the parameter of target contract.
Returns Nothing if entrypoint is not found.