Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
This module introduces several types for safe work with address
and
contract
types. All available types for that are represented in the following
table:
Type | Type safe? | What it refers to | Michelson reflection |
---|---|---|---|
Address | No | Whole contract | address |
EpAddress | No | Entrypoint | address |
TAddress | Yes | Whole contract | address |
FutureContract | Yes | Entrypoint | address |
ContractRef | Yes | Entrypoint | contract |
This module also provides functions for converting between these types in Haskell and Michelson worlds. In the latter you can additionally use coercions and dedicated instructions from Lorentz.Instr.
Synopsis
- newtype TAddress (p :: Type) (vd :: Type) = TAddress {}
- newtype FutureContract arg = FutureContract {
- unFutureContract :: ContractRef arg
- asAddressOf :: contract cp st vd -> Address -> TAddress cp vd
- asAddressOf_ :: contract cp st vd -> (Address ': s) :-> (TAddress cp vd ': s)
- callingAddress :: forall cp vd addr mname. (ToTAddress cp vd addr, NiceParameterFull cp) => addr -> EntrypointRef mname -> ContractRef (GetEntrypointArgCustom cp mname)
- callingDefAddress :: forall cp vd addr. (ToTAddress cp vd addr, NiceParameterFull cp) => addr -> ContractRef (GetDefaultEntrypointArg cp)
- class ToAddress a where
- class ToTAddress (cp :: Type) (vd :: Type) (a :: Type) where
- toTAddress :: a -> TAddress cp vd
- type ToTAddress_ cp vd addr = (ToTAddress cp vd addr, ToT addr ~ ToT Address)
- toTAddress_ :: forall cp addr vd s. ToTAddress_ cp vd addr => (addr ': s) :-> (TAddress cp vd ': s)
- class ToContractRef (cp :: Type) (contract :: Type) where
- toContractRef :: HasCallStack => contract -> ContractRef cp
- class FromContractRef (cp :: Type) (contract :: Type) where
- fromContractRef :: ContractRef cp -> contract
- convertContractRef :: forall cp contract2 contract1. (ToContractRef cp contract1, FromContractRef cp contract2) => contract1 -> contract2
- data Address
- data EpAddress = EpAddress {}
- data ContractRef arg = ContractRef {
- crAddress :: Address
- crEntrypoint :: SomeEntrypointCall arg
- coerceContractRef :: ToT a ~ ToT b => ContractRef a -> ContractRef b
Documentation
newtype TAddress (p :: Type) (vd :: Type) Source #
Address which remembers the parameter and views types of the contract it refers to.
It differs from Michelson's contract
type because it cannot contain
entrypoint, and it always refers to entire contract parameter even if this
contract has explicit default entrypoint.
Instances
newtype FutureContract arg Source #
Address associated with value of contract arg
type.
Places where ContractRef
can appear are now severely limited,
this type gives you type-safety of ContractRef
but still can be used
everywhere.
This type is not a full-featured one rather a helper; in particular, once
pushing it on stack, you cannot return it back to Haskell world.
Note that it refers to an entrypoint of the contract, not just the contract
as a whole. In this sense this type differs from TAddress
.
Unlike with ContractRef
, having this type you still cannot be sure that
the referred contract exists and need to perform a lookup before calling it.
Instances
Conversions
asAddressOf :: contract cp st vd -> Address -> TAddress cp vd Source #
For a contract and an address of its instance, construct a typed address.
callingAddress :: forall cp vd addr mname. (ToTAddress cp vd addr, NiceParameterFull cp) => addr -> EntrypointRef mname -> ContractRef (GetEntrypointArgCustom cp mname) Source #
Turn any typed address to ContractRef
in Haskell world.
This is an analogy of address
to contract
convertion in Michelson world,
thus you have to supply an entrypoint (or call the default one explicitly).
callingDefAddress :: forall cp vd addr. (ToTAddress cp vd addr, NiceParameterFull cp) => addr -> ContractRef (GetDefaultEntrypointArg cp) Source #
Specialization of callingAddress
to call the default entrypoint.
class ToAddress a where Source #
Convert something to Address
in Haskell world.
Use this when you want to access state of the contract and are not interested in calling it.
Instances
ToAddress EpAddress Source # | |
ToAddress Address Source # | |
ToAddress (FutureContract cp) Source # | |
Defined in Lorentz.Address toAddress :: FutureContract cp -> Address Source # | |
ToAddress (ContractRef cp) Source # | |
Defined in Lorentz.Address toAddress :: ContractRef cp -> Address Source # | |
ToAddress (TAddress cp vd) Source # | |
class ToTAddress (cp :: Type) (vd :: Type) (a :: Type) where Source #
Convert something referring to a contract (not specific entrypoint)
to TAddress
in Haskell world.
toTAddress :: a -> TAddress cp vd Source #
Instances
ToTAddress cp vd Address Source # | |
Defined in Lorentz.Address toTAddress :: Address -> TAddress cp vd Source # | |
(cp ~ cp', vd ~ vd') => ToTAddress cp vd (TAddress cp' vd') Source # | |
Defined in Lorentz.Address toTAddress :: TAddress cp' vd' -> TAddress cp vd Source # |
type ToTAddress_ cp vd addr = (ToTAddress cp vd addr, ToT addr ~ ToT Address) Source #
Something coercible to 'TAddress cp'.
toTAddress_ :: forall cp addr vd s. ToTAddress_ cp vd addr => (addr ': s) :-> (TAddress cp vd ': s) Source #
Cast something appropriate to TAddress
.
class ToContractRef (cp :: Type) (contract :: Type) where Source #
Convert something to ContractRef
in Haskell world.
toContractRef :: HasCallStack => contract -> ContractRef cp Source #
Instances
(NiceParameter cp, cp ~ cp') => ToContractRef cp (FutureContract cp') Source # | |
Defined in Lorentz.Address toContractRef :: FutureContract cp' -> ContractRef cp Source # | |
cp ~ cp' => ToContractRef cp (ContractRef cp') Source # | |
Defined in Lorentz.Address toContractRef :: ContractRef cp' -> ContractRef cp Source # | |
(FailWhen cond msg, cond ~ (CanHaveEntrypoints cp && Not (ParameterEntrypointsDerivation cp == EpdNone)), msg ~ (((('Text "Cannot apply `ToContractRef` to `TAddress`" :$$: 'Text "Consider using call(Def)TAddress first`") :$$: 'Text "(or if you know your parameter type is primitive,") :$$: 'Text " make sure typechecker also knows about that)") :$$: (('Text "For parameter `" :<>: 'ShowType cp) :<>: 'Text "`")), cp ~ arg, NiceParameter arg, NiceParameterFull cp, GetDefaultEntrypointArg cp ~ cp) => ToContractRef arg (TAddress cp vd) Source # | |
Defined in Lorentz.Address toContractRef :: TAddress cp vd -> ContractRef arg Source # |
class FromContractRef (cp :: Type) (contract :: Type) where Source #
Convert something from ContractRef
in Haskell world.
fromContractRef :: ContractRef cp -> contract Source #
Instances
FromContractRef cp EpAddress Source # | |
Defined in Lorentz.Address fromContractRef :: ContractRef cp -> EpAddress Source # | |
FromContractRef cp Address Source # | |
Defined in Lorentz.Address fromContractRef :: ContractRef cp -> Address Source # | |
cp ~ cp' => FromContractRef cp (FutureContract cp') Source # | |
Defined in Lorentz.Address fromContractRef :: ContractRef cp -> FutureContract cp' Source # | |
cp ~ cp' => FromContractRef cp (ContractRef cp') Source # | |
Defined in Lorentz.Address fromContractRef :: ContractRef cp -> ContractRef cp' Source # |
convertContractRef :: forall cp contract2 contract1. (ToContractRef cp contract1, FromContractRef cp contract2) => contract1 -> contract2 Source #
Re-exports
Instances
Instances
data ContractRef arg #
Instances
coerceContractRef :: ToT a ~ ToT b => ContractRef a -> ContractRef b #