lorentz-0.14.1: EDSL for the Michelson Language
Safe HaskellSafe-Inferred
LanguageHaskell2010

Lorentz.Errors

Synopsis

Haskell to Value conversion

class ErrorHasDoc e => IsError e where Source #

Haskell type representing error.

Minimal complete definition

errorToVal, errorFromVal

Methods

errorToVal :: e -> (forall t. ErrorScope t => Value t -> r) -> r Source #

Converts a Haskell error into Value representation.

errorFromVal :: SingI t => Value t -> Either Text e Source #

Converts a Value into Haskell error.

failUsing :: IsError e => e -> s :-> t Source #

Fail with the given Haskell value.

Instances

Instances details
IsError UnspecifiedError Source # 
Instance details

Defined in Lorentz.Errors

Methods

errorToVal :: UnspecifiedError -> (forall (t :: T). ErrorScope t => Value t -> r) -> r Source #

errorFromVal :: forall (t :: T). SingI t => Value t -> Either Text UnspecifiedError Source #

failUsing :: forall (s :: [Type]) (t :: [Type]). IsError UnspecifiedError => UnspecifiedError -> s :-> t Source #

IsError MText Source #

Use this for internal errors only.

"Normal" error scenarios should use the mechanism of custom errors, see below.

Instance details

Defined in Lorentz.Errors

Methods

errorToVal :: MText -> (forall (t :: T). ErrorScope t => Value t -> r) -> r Source #

errorFromVal :: forall (t :: T). SingI t => Value t -> Either Text MText Source #

failUsing :: forall (s :: [Type]) (t :: [Type]). IsError MText => MText -> s :-> t Source #

(TypeError ('Text "Use representative error messages") :: Constraint) => IsError () Source # 
Instance details

Defined in Lorentz.Errors

Methods

errorToVal :: () -> (forall (t :: T). ErrorScope t => Value t -> r) -> r Source #

errorFromVal :: forall (t :: T). SingI t => Value t -> Either Text () Source #

failUsing :: forall (s :: [Type]) (t :: [Type]). IsError () => () -> s :-> t Source #

(CustomErrorHasDoc tag, KnownError (CustomErrorRep tag), IsoValue (CustomErrorRep tag), IsCustomErrorArgRep (CustomErrorRep tag)) => IsError (CustomError tag) Source # 
Instance details

Defined in Lorentz.Errors

Methods

errorToVal :: CustomError tag -> (forall (t :: T). ErrorScope t => Value t -> r) -> r Source #

errorFromVal :: forall (t :: T). SingI t => Value t -> Either Text (CustomError tag) Source #

failUsing :: forall (s :: [Type]) (t :: [Type]). IsError (CustomError tag) => CustomError tag -> s :-> t Source #

KnownSymbol reason => IsError (Impossible reason) Source # 
Instance details

Defined in Lorentz.Errors

Methods

errorToVal :: Impossible reason -> (forall (t :: T). ErrorScope t => Value t -> r) -> r Source #

errorFromVal :: forall (t :: T). SingI t => Value t -> Either Text (Impossible reason) Source #

failUsing :: forall (s :: [Type]) (t :: [Type]). IsError (Impossible reason) => Impossible reason -> s :-> t Source #

(NiceConstant r, ErrorHasDoc (VoidResult r)) => IsError (VoidResult r) Source # 
Instance details

Defined in Lorentz.Macro

Methods

errorToVal :: VoidResult r -> (forall (t :: T). ErrorScope t => Value t -> r0) -> r0 Source #

errorFromVal :: forall (t :: T). SingI t => Value t -> Either Text (VoidResult r) Source #

failUsing :: forall (s :: [Type]) (t :: [Type]). IsError (VoidResult r) => VoidResult r -> s :-> t Source #

(Typeable arg, IsError (CustomError tag), arg ~ ErrorArg tag, FailUnlessEqual arg () ('Text "This error requires argument of type " :<>: 'ShowType (ErrorArg tag))) => IsError (arg -> CustomError tag) Source #

If CustomError constructor is not provided its argument, we assume that this is unit-arg error and interpret the passed value as complete.

Instance details

Defined in Lorentz.Errors

Methods

errorToVal :: (arg -> CustomError tag) -> (forall (t :: T). ErrorScope t => Value t -> r) -> r Source #

errorFromVal :: forall (t :: T). SingI t => Value t -> Either Text (arg -> CustomError tag) Source #

failUsing :: forall (s :: [Type]) (t :: [Type]). IsError (arg -> CustomError tag) => (arg -> CustomError tag) -> s :-> t Source #

type ErrorScope t = ConstantScope t Source #

Since 008 it's prohibited to fail with non-packable values and with the 'Contract t' type values, which is equivalent to our ConstantScope constraint. See https://gitlab.com/tezos/tezos/-/issues/1093#note_496066354 for more information.

class (SingI t, WellTyped t, HasNoOp t, HasNoBigMap t, HasNoContract t, HasNoTicket t, HasNoSaplingState t) => ConstantScope (t :: T) #

Instances

Instances details
(SingI t, WellTyped t, HasNoOp t, HasNoBigMap t, HasNoContract t, HasNoTicket t, HasNoSaplingState t) => ConstantScope t 
Instance details

Defined in Morley.Michelson.Typed.Scope

(WithDeMorganScope HasNoOp t a b, WithDeMorganScope HasNoBigMap t a b, WithDeMorganScope HasNoContract t a b, WithDeMorganScope HasNoTicket t a b, WithDeMorganScope HasNoSaplingState t a b, WellTyped a, WellTyped b) => WithDeMorganScope ConstantScope t a b 
Instance details

Defined in Morley.Michelson.Typed.Scope

Methods

withDeMorganScope :: ConstantScope (t a b) => ((ConstantScope a, ConstantScope b) => ret) -> ret

SingI t => CheckScope (ConstantScope t) 
Instance details

Defined in Morley.Michelson.Typed.Scope

Methods

checkScope :: Either BadTypeForScope (Dict (ConstantScope t))

isoErrorToVal :: (KnownError e, IsoValue e) => e -> (forall t. ErrorScope t => Value t -> r) -> r Source #

Implementation of errorToVal via IsoValue.

isoErrorFromVal :: (SingI t, KnownIsoT e, IsoValue e) => Value t -> Either Text e Source #

Implementation of errorFromVal via IsoValue.

simpleFailUsing :: forall e s t. IsError e => e -> s :-> t Source #

Basic implementation for failUsing.

class Typeable e => ErrorHasDoc (e :: Type) where Source #

Associated Types

type ErrorRequirements e :: Constraint Source #

Constraints which we require in a particular instance. You are not oblidged to often instantiate this correctly, it is only useful for some utilities.

type ErrorRequirements _ = ()

Methods

errorDocName :: Text Source #

Name of error as it appears in the corresponding section title.

errorDocMdCause :: Markdown Source #

What should happen for this error to be raised.

errorDocMdCauseInEntrypoint :: Markdown Source #

Brief version of errorDocMdCause.

This will appear along with the error when mentioned in entrypoint description. By default, the first sentence of the full description is used.

errorDocHaskellRep :: Markdown Source #

How this error is represented in Haskell.

errorDocClass :: ErrorClass Source #

Error class.

errorDocDependencies :: [SomeDocDefinitionItem] Source #

Which definitions documentation for this error mentions.

errorDocRequirements :: Dict (ErrorRequirements e) Source #

Captured constraints which we require in a particular instance. This is a way to encode a bidirectional instance in the nowaday Haskell, for class MyConstraint => ErrorHasDoc MyType instance it lets deducing MyConstraint by ErrorHasDoc MyType.

You are not oblidged to always instantiate, it is only useful for some utilities which otherwise would not compile.

Instances

Instances details
ErrorHasDoc UnspecifiedError Source # 
Instance details

Defined in Lorentz.Errors

ErrorHasDoc MText Source # 
Instance details

Defined in Lorentz.Errors

Associated Types

type ErrorRequirements MText Source #

(TypeError ('Text "Use representative error messages") :: Constraint) => ErrorHasDoc () Source # 
Instance details

Defined in Lorentz.Errors

Associated Types

type ErrorRequirements () Source #

(CustomErrorHasDoc tag, IsCustomErrorArgRep (CustomErrorRep tag)) => ErrorHasDoc (CustomError tag) Source # 
Instance details

Defined in Lorentz.Errors

Associated Types

type ErrorRequirements (CustomError tag) Source #

KnownSymbol reason => ErrorHasDoc (Impossible reason) Source # 
Instance details

Defined in Lorentz.Errors

Associated Types

type ErrorRequirements (Impossible reason) Source #

TypeHasDoc r => ErrorHasDoc (VoidResult r) Source # 
Instance details

Defined in Lorentz.Macro

Associated Types

type ErrorRequirements (VoidResult r) Source #

(ErrorHasDoc err, KnownNat numTag, ErrorHasNumericDoc err) => ErrorHasDoc (NumericErrorWrapper numTag err) Source # 
Instance details

Defined in Lorentz.Errors.Numeric.Doc

Associated Types

type ErrorRequirements (NumericErrorWrapper numTag err) Source #

(Typeable arg, ErrorHasDoc (CustomError tag)) => ErrorHasDoc (arg -> CustomError tag) Source # 
Instance details

Defined in Lorentz.Errors

Associated Types

type ErrorRequirements (arg -> CustomError tag) Source #

typeDocMdDescriptionReferToError :: forall e. IsError e => Markdown Source #

Implementation of typeDocMdDescription (of TypeHasDoc typeclass) for Haskell types which sole purpose is to be error.

isInternalErrorClass :: ErrorClass -> Bool Source #

Whether given error class is about internal errors.

Internal errors are not enlisted on per-entrypoint basis, only once for the entire contract.

data UnspecifiedError Source #

Use this type as replacement for () when you really want to leave error cause unspecified.

Constructors

UnspecifiedError 

Instances

Instances details
Generic UnspecifiedError Source # 
Instance details

Defined in Lorentz.Errors

Associated Types

type Rep UnspecifiedError :: Type -> Type #

ErrorHasDoc UnspecifiedError Source # 
Instance details

Defined in Lorentz.Errors

IsError UnspecifiedError Source # 
Instance details

Defined in Lorentz.Errors

Methods

errorToVal :: UnspecifiedError -> (forall (t :: T). ErrorScope t => Value t -> r) -> r Source #

errorFromVal :: forall (t :: T). SingI t => Value t -> Either Text UnspecifiedError Source #

failUsing :: forall (s :: [Type]) (t :: [Type]). IsError UnspecifiedError => UnspecifiedError -> s :-> t Source #

IsoValue UnspecifiedError Source # 
Instance details

Defined in Lorentz.Errors

Associated Types

type ToT UnspecifiedError :: T #

type Rep UnspecifiedError Source # 
Instance details

Defined in Lorentz.Errors

type Rep UnspecifiedError = D1 ('MetaData "UnspecifiedError" "Lorentz.Errors" "lorentz-0.14.1-inplace" 'False) (C1 ('MetaCons "UnspecifiedError" 'PrefixI 'False) (U1 :: Type -> Type))
type ErrorRequirements UnspecifiedError Source # 
Instance details

Defined in Lorentz.Errors

type ToT UnspecifiedError Source # 
Instance details

Defined in Lorentz.Errors

data Impossible (reason :: Symbol) Source #

Use this error when sure that failing at the current position is possible in no curcumstances (including invalid user input or misconfigured storage).

To use this as error, you have to briefly specify the reason why the error scenario is impossible (experimental feature).

Constructors

HasCallStack => Impossible 

Instances

Instances details
KnownSymbol reason => ErrorHasDoc (Impossible reason) Source # 
Instance details

Defined in Lorentz.Errors

Associated Types

type ErrorRequirements (Impossible reason) Source #

KnownSymbol reason => IsError (Impossible reason) Source # 
Instance details

Defined in Lorentz.Errors

Methods

errorToVal :: Impossible reason -> (forall (t :: T). ErrorScope t => Value t -> r) -> r Source #

errorFromVal :: forall (t :: T). SingI t => Value t -> Either Text (Impossible reason) Source #

failUsing :: forall (s :: [Type]) (t :: [Type]). IsError (Impossible reason) => Impossible reason -> s :-> t Source #

type ErrorRequirements (Impossible reason) Source # 
Instance details

Defined in Lorentz.Errors

type ErrorRequirements (Impossible reason) = ()

data SomeError Source #

Type wrapper for an IsError.

Constructors

forall e.(IsError e, Eq e) => SomeError e 

Instances

Instances details
Buildable SomeError Source # 
Instance details

Defined in Lorentz.Errors

Methods

build :: SomeError -> Builder #

Eq SomeError Source # 
Instance details

Defined in Lorentz.Errors

General instructions

failUnexpected :: MText -> s :-> t Source #

Fail, providing a reference to the place in the code where this function is called.

Like error in Haskell code, this instruction is for internal errors only.

Custom errors

data NoErrorArg Source #

To be used as ErrorArg instance when failing with just a string instead of pair string x

data UnitErrorArg Source #

To be used as ErrorArg instances. This is equivalent to using () but using UnitErrorArg is preferred since () behavior could be changed in the future.

type family ErrorArg (tag :: Symbol) :: Type Source #

Declares a custom error, defining error name - error argument relation.

If your error is supposed to carry no argument, then provide ().

Note that this relation is defined globally rather than on per-contract basis, so define errors accordingly. If your error has argument specific to your contract, call it such that error name reflects its belonging to this contract.

This is the basic [error format].

Instances

Instances details
type ErrorArg "nOT_SINGLE_TICKET_TOKEN" Source # 
Instance details

Defined in Lorentz.Tickets

type ErrorArg "nOT_SINGLE_TICKET_TOKEN" = NoErrorArg
type ErrorArg "nOT_TICKET_TARGET" Source # 
Instance details

Defined in Lorentz.Tickets

type ErrorArg "nOT_TICKET_TARGET" = NoErrorArg
type ErrorArg "no_view" Source # 
Instance details

Defined in Lorentz.Macro

type ErrorArg "no_view" = MText
type ErrorArg "uparamArgumentUnpackFailed" Source # 
Instance details

Defined in Lorentz.UParam

type ErrorArg "uparamArgumentUnpackFailed" = UnitErrorArg
type ErrorArg "uparamNoSuchEntrypoint" Source # 
Instance details

Defined in Lorentz.UParam

type ErrorArg "uparamNoSuchEntrypoint" = MText
type ErrorArg "wRONG_TICKETER" Source # 
Instance details

Defined in Lorentz.Tickets

type ErrorArg "wRONG_TICKETER" = NoErrorArg
type ErrorArg "zero_denominator" Source # 
Instance details

Defined in Lorentz.CustomArith.RationalArith

type ErrorArg "zero_denominator" = ("numerator" :! Integer, "denominator" :! Natural)

data CustomError (tag :: Symbol) Source #

Material custom error.

Use this in pattern matches against error (e.g. in tests).

Constructors

CustomError 

Fields

Instances

Instances details
Show (CustomErrorRep tag) => Show (CustomError tag) Source # 
Instance details

Defined in Lorentz.Errors

Methods

showsPrec :: Int -> CustomError tag -> ShowS #

show :: CustomError tag -> String #

showList :: [CustomError tag] -> ShowS #

Buildable (CustomError tag) Source # 
Instance details

Defined in Lorentz.Errors

Methods

build :: CustomError tag -> Builder #

Buildable (CustomError "uparamArgumentUnpackFailed") Source # 
Instance details

Defined in Lorentz.UParam

Methods

build :: CustomError "uparamArgumentUnpackFailed" -> Builder #

Buildable (CustomError "uparamNoSuchEntrypoint") Source # 
Instance details

Defined in Lorentz.UParam

Methods

build :: CustomError "uparamNoSuchEntrypoint" -> Builder #

Eq (CustomErrorRep tag) => Eq (CustomError tag) Source # 
Instance details

Defined in Lorentz.Errors

Methods

(==) :: CustomError tag -> CustomError tag -> Bool #

(/=) :: CustomError tag -> CustomError tag -> Bool #

(CustomErrorHasDoc tag, IsCustomErrorArgRep (CustomErrorRep tag)) => ErrorHasDoc (CustomError tag) Source # 
Instance details

Defined in Lorentz.Errors

Associated Types

type ErrorRequirements (CustomError tag) Source #

(CustomErrorHasDoc tag, KnownError (CustomErrorRep tag), IsoValue (CustomErrorRep tag), IsCustomErrorArgRep (CustomErrorRep tag)) => IsError (CustomError tag) Source # 
Instance details

Defined in Lorentz.Errors

Methods

errorToVal :: CustomError tag -> (forall (t :: T). ErrorScope t => Value t -> r) -> r Source #

errorFromVal :: forall (t :: T). SingI t => Value t -> Either Text (CustomError tag) Source #

failUsing :: forall (s :: [Type]) (t :: [Type]). IsError (CustomError tag) => CustomError tag -> s :-> t Source #

(WellTypedToT (CustomErrorRep tag), TypeError ('Text "CustomError has no IsoValue instance") :: Constraint) => IsoValue (CustomError tag) Source #

This instance cannot be implemented, use IsError instance instead.

Instance details

Defined in Lorentz.Errors

Associated Types

type ToT (CustomError tag) :: T #

Methods

toVal :: CustomError tag -> Value (ToT (CustomError tag)) #

fromVal :: Value (ToT (CustomError tag)) -> CustomError tag #

(Typeable arg, ErrorHasDoc (CustomError tag)) => ErrorHasDoc (arg -> CustomError tag) Source # 
Instance details

Defined in Lorentz.Errors

Associated Types

type ErrorRequirements (arg -> CustomError tag) Source #

(Typeable arg, IsError (CustomError tag), arg ~ ErrorArg tag, FailUnlessEqual arg () ('Text "This error requires argument of type " :<>: 'ShowType (ErrorArg tag))) => IsError (arg -> CustomError tag) Source #

If CustomError constructor is not provided its argument, we assume that this is unit-arg error and interpret the passed value as complete.

Instance details

Defined in Lorentz.Errors

Methods

errorToVal :: (arg -> CustomError tag) -> (forall (t :: T). ErrorScope t => Value t -> r) -> r Source #

errorFromVal :: forall (t :: T). SingI t => Value t -> Either Text (arg -> CustomError tag) Source #

failUsing :: forall (s :: [Type]) (t :: [Type]). IsError (arg -> CustomError tag) => (arg -> CustomError tag) -> s :-> t Source #

type ErrorRequirements (CustomError tag) Source # 
Instance details

Defined in Lorentz.Errors

type ToT (CustomError tag) Source # 
Instance details

Defined in Lorentz.Errors

type ToT (CustomError tag) = ToT (CustomErrorRep tag)
type ErrorRequirements (arg -> CustomError tag) Source # 
Instance details

Defined in Lorentz.Errors

type ErrorRequirements (arg -> CustomError tag) = ()

type CustomErrorRep tag = CustomErrorArgRep (ErrorArg tag) Source #

How CustomError is actually represented in Michelson.

class IsCustomErrorArgRep a where Source #

Typeclass implements various method that work with CustomErrorArgRep.

type MustHaveErrorArg errorTag expectedArgRep = FailUnlessEqual (CustomErrorRep errorTag) expectedArgRep ((('Text "Error argument type is " :<>: 'ShowType expectedArgRep) :<>: 'Text " but given error requires argument of type ") :<>: 'ShowType (CustomErrorRep errorTag)) Source #

failCustom :: forall tag err s any. (MustHaveErrorArg tag (MText, err), CustomErrorHasDoc tag, KnownError err) => Label tag -> (err ': s) :-> any Source #

Fail with given custom error.

failCustom_ :: forall tag s any. (MustHaveErrorArg tag (MText, ()), CustomErrorHasDoc tag) => Label tag -> s :-> any Source #

Specialization of failCustom for unit-arg errors.

failCustomNoArg :: forall tag s any. (MustHaveErrorArg tag MText, CustomErrorHasDoc tag) => Label tag -> s :-> any Source #

Fail with given custom error.

Documentation

data ErrorClass Source #

Error class on how the error should be handled by the client.

Constructors

ErrClassActionException

Normal expected error. Examples: "insufficient balance", "wallet does not exist".

ErrClassBadArgument

Invalid argument passed to entrypoint. Examples: your entrypoint accepts an enum represented as nat, and unknown value is provided. This includes more complex cases which involve multiple entrypoints. E.g. API provides iterator interface, middleware should care about using it hiding complex details and exposing a simpler API to user; then an attempt to request non-existing element would also correspond to an error from this class.

ErrClassContractInternal

Unexpected error. Most likely it means that there is a bug in the contract or the contract has been deployed incorrectly.

ErrClassUnknown

It's possible to leave error class unspecified.

Instances

Instances details
Buildable ErrorClass Source # 
Instance details

Defined in Lorentz.Errors

Methods

build :: ErrorClass -> Builder #

Lift ErrorClass Source # 
Instance details

Defined in Lorentz.Errors

Methods

lift :: Quote m => ErrorClass -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => ErrorClass -> Code m ErrorClass #

class (KnownSymbol tag, TypeHasDoc (CustomErrorRep tag), IsError (CustomError tag)) => CustomErrorHasDoc tag where Source #

Minimal complete definition

customErrDocMdCause, customErrClass

Methods

customErrDocMdCause :: Markdown Source #

What should happen for this error to be raised.

customErrDocMdCauseInEntrypoint :: Markdown Source #

Brief version of customErrDocMdCause. This will appear along with the error when mentioned in entrypoint description.

By default, the first sentence of the full description is used.

customErrClass :: ErrorClass Source #

Error class.

By default this returns "unknown error" class; though you should provide explicit implementation in order to avoid a warning.

customErrArgumentSemantics :: Maybe Markdown Source #

Clarification of error argument meaning.

Provide when it's not obvious, e.g. argument is not named with :!.

NOTE: This should not be an entire sentence, rather just the semantic backbone.

Bad: * Error argument stands for the previous value of approval.

Good: * the previous value of approval * pair, first argument of which is one thing, and the second is another

Instances

Instances details
CustomErrorHasDoc "nOT_SINGLE_TICKET_TOKEN" Source # 
Instance details

Defined in Lorentz.Tickets

CustomErrorHasDoc "nOT_TICKET_TARGET" Source # 
Instance details

Defined in Lorentz.Tickets

CustomErrorHasDoc "no_view" Source # 
Instance details

Defined in Lorentz.Macro

CustomErrorHasDoc "uparamArgumentUnpackFailed" Source # 
Instance details

Defined in Lorentz.UParam

CustomErrorHasDoc "uparamNoSuchEntrypoint" Source # 
Instance details

Defined in Lorentz.UParam

CustomErrorHasDoc "wRONG_TICKETER" Source # 
Instance details

Defined in Lorentz.Tickets

CustomErrorHasDoc "zero_denominator" Source # 
Instance details

Defined in Lorentz.CustomArith.RationalArith

data DError where Source #

Mentions that contract uses given error.

Constructors

DError :: ErrorHasDoc e => Proxy e -> DError 

data DThrows where Source #

Documentation for custom errors.

Mentions that entrypoint throws given error.

Constructors

DThrows :: ErrorHasDoc e => Proxy e -> DThrows 

Internals

errorTagToText :: forall tag. KnownSymbol tag => Text Source #

errorTagToMText :: Label tag -> MText Source #

Demote error tag to term level.