{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Lorentz.Address
( TAddress (..)
, FutureContract (..)
, asAddressOf
, asAddressOf_
, callingAddress
, callingDefAddress
, ToAddress (..)
, ToTAddress (..)
, ToTAddress_
, toTAddress_
, ToContractRef (..)
, FromContractRef (..)
, convertContractRef
, ImplicitContractParameter
, Address
, EpAddress (..)
, ContractRef (..)
, M.coerceContractRef
) where
import Data.Type.Bool (Not, type (&&))
import Fmt (Buildable)
import Lorentz.Annotation
import Lorentz.Base
import Lorentz.Constraints
import Lorentz.Entrypoints.Core qualified as Ep
import Morley.AsRPC (HasRPCRepr(..))
import Morley.Michelson.Typed (ContractRef(..), IsoValue(..))
import Morley.Michelson.Typed qualified as M
import Morley.Michelson.Typed.Entrypoints (EpAddress(..))
import Morley.Tezos.Address
import Morley.Util.Constrained
import Morley.Util.Type
import Morley.Util.TypeLits
newtype TAddress (p :: Type) (vd :: Type) = TAddress { forall p vd. TAddress p vd -> Address
unTAddress :: Address }
deriving stock ((forall x. TAddress p vd -> Rep (TAddress p vd) x)
-> (forall x. Rep (TAddress p vd) x -> TAddress p vd)
-> Generic (TAddress p vd)
forall x. Rep (TAddress p vd) x -> TAddress p vd
forall x. TAddress p vd -> Rep (TAddress p vd) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p vd x. Rep (TAddress p vd) x -> TAddress p vd
forall p vd x. TAddress p vd -> Rep (TAddress p vd) x
$cto :: forall p vd x. Rep (TAddress p vd) x -> TAddress p vd
$cfrom :: forall p vd x. TAddress p vd -> Rep (TAddress p vd) x
Generic, Int -> TAddress p vd -> ShowS
[TAddress p vd] -> ShowS
TAddress p vd -> String
(Int -> TAddress p vd -> ShowS)
-> (TAddress p vd -> String)
-> ([TAddress p vd] -> ShowS)
-> Show (TAddress p vd)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p vd. Int -> TAddress p vd -> ShowS
forall p vd. [TAddress p vd] -> ShowS
forall p vd. TAddress p vd -> String
showList :: [TAddress p vd] -> ShowS
$cshowList :: forall p vd. [TAddress p vd] -> ShowS
show :: TAddress p vd -> String
$cshow :: forall p vd. TAddress p vd -> String
showsPrec :: Int -> TAddress p vd -> ShowS
$cshowsPrec :: forall p vd. Int -> TAddress p vd -> ShowS
Show)
deriving newtype (TAddress p vd -> TAddress p vd -> Bool
(TAddress p vd -> TAddress p vd -> Bool)
-> (TAddress p vd -> TAddress p vd -> Bool) -> Eq (TAddress p vd)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall p vd. TAddress p vd -> TAddress p vd -> Bool
/= :: TAddress p vd -> TAddress p vd -> Bool
$c/= :: forall p vd. TAddress p vd -> TAddress p vd -> Bool
== :: TAddress p vd -> TAddress p vd -> Bool
$c== :: forall p vd. TAddress p vd -> TAddress p vd -> Bool
Eq, Eq (TAddress p vd)
Eq (TAddress p vd)
-> (TAddress p vd -> TAddress p vd -> Ordering)
-> (TAddress p vd -> TAddress p vd -> Bool)
-> (TAddress p vd -> TAddress p vd -> Bool)
-> (TAddress p vd -> TAddress p vd -> Bool)
-> (TAddress p vd -> TAddress p vd -> Bool)
-> (TAddress p vd -> TAddress p vd -> TAddress p vd)
-> (TAddress p vd -> TAddress p vd -> TAddress p vd)
-> Ord (TAddress p vd)
TAddress p vd -> TAddress p vd -> Bool
TAddress p vd -> TAddress p vd -> Ordering
TAddress p vd -> TAddress p vd -> TAddress p vd
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall p vd. Eq (TAddress p vd)
forall p vd. TAddress p vd -> TAddress p vd -> Bool
forall p vd. TAddress p vd -> TAddress p vd -> Ordering
forall p vd. TAddress p vd -> TAddress p vd -> TAddress p vd
min :: TAddress p vd -> TAddress p vd -> TAddress p vd
$cmin :: forall p vd. TAddress p vd -> TAddress p vd -> TAddress p vd
max :: TAddress p vd -> TAddress p vd -> TAddress p vd
$cmax :: forall p vd. TAddress p vd -> TAddress p vd -> TAddress p vd
>= :: TAddress p vd -> TAddress p vd -> Bool
$c>= :: forall p vd. TAddress p vd -> TAddress p vd -> Bool
> :: TAddress p vd -> TAddress p vd -> Bool
$c> :: forall p vd. TAddress p vd -> TAddress p vd -> Bool
<= :: TAddress p vd -> TAddress p vd -> Bool
$c<= :: forall p vd. TAddress p vd -> TAddress p vd -> Bool
< :: TAddress p vd -> TAddress p vd -> Bool
$c< :: forall p vd. TAddress p vd -> TAddress p vd -> Bool
compare :: TAddress p vd -> TAddress p vd -> Ordering
$ccompare :: forall p vd. TAddress p vd -> TAddress p vd -> Ordering
Ord, TAddress p vd -> Builder
(TAddress p vd -> Builder) -> Buildable (TAddress p vd)
forall p. (p -> Builder) -> Buildable p
forall p vd. TAddress p vd -> Builder
build :: TAddress p vd -> Builder
$cbuild :: forall p vd. TAddress p vd -> Builder
Buildable)
deriving anyclass (WellTypedToT (TAddress p vd)
WellTypedToT (TAddress p vd)
-> (TAddress p vd -> Value (ToT (TAddress p vd)))
-> (Value (ToT (TAddress p vd)) -> TAddress p vd)
-> IsoValue (TAddress p vd)
Value (ToT (TAddress p vd)) -> TAddress p vd
TAddress p vd -> Value (ToT (TAddress p vd))
forall a.
WellTypedToT a
-> (a -> Value (ToT a)) -> (Value (ToT a) -> a) -> IsoValue a
forall {p} {vd}. WellTypedToT (TAddress p vd)
forall p vd. Value (ToT (TAddress p vd)) -> TAddress p vd
forall p vd. TAddress p vd -> Value (ToT (TAddress p vd))
fromVal :: Value (ToT (TAddress p vd)) -> TAddress p vd
$cfromVal :: forall p vd. Value (ToT (TAddress p vd)) -> TAddress p vd
toVal :: TAddress p vd -> Value (ToT (TAddress p vd))
$ctoVal :: forall p vd. TAddress p vd -> Value (ToT (TAddress p vd))
IsoValue, Maybe AnnOptions
FollowEntrypointFlag -> Notes (ToT (TAddress p vd))
(FollowEntrypointFlag -> Notes (ToT (TAddress p vd)))
-> Maybe AnnOptions -> HasAnnotation (TAddress p vd)
forall a.
(FollowEntrypointFlag -> Notes (ToT a))
-> Maybe AnnOptions -> HasAnnotation a
forall p vd. Maybe AnnOptions
forall p vd. FollowEntrypointFlag -> Notes (ToT (TAddress p vd))
annOptions :: Maybe AnnOptions
$cannOptions :: forall p vd. Maybe AnnOptions
getAnnotation :: FollowEntrypointFlag -> Notes (ToT (TAddress p vd))
$cgetAnnotation :: forall p vd. FollowEntrypointFlag -> Notes (ToT (TAddress p vd))
HasAnnotation)
instance HasRPCRepr (TAddress cp vd) where
type AsRPC (TAddress cp vd) = TAddress cp vd
asAddressOf :: contract cp st vd -> Address -> TAddress cp vd
asAddressOf :: forall {k} (contract :: * -> k -> * -> *) cp (st :: k) vd.
contract cp st vd -> Address -> TAddress cp vd
asAddressOf contract cp st vd
_ = Address -> TAddress cp vd
forall p vd. Address -> TAddress p vd
TAddress
asAddressOf_ :: contract cp st vd -> Address : s :-> TAddress cp vd : s
asAddressOf_ :: forall {k} (contract :: * -> k -> * -> *) cp (st :: k) vd
(s :: [*]).
contract cp st vd -> (Address : s) :-> (TAddress cp vd : s)
asAddressOf_ contract cp st vd
_ = Instr (ToTs (Address : s)) (ToTs (TAddress cp vd : s))
-> (Address : s) :-> (TAddress cp vd : s)
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I Instr (ToTs (Address : s)) (ToTs (TAddress cp vd : s))
forall (inp :: [T]). Instr inp inp
M.Nop
callingAddress
:: forall cp vd addr mname.
(ToTAddress cp vd addr, NiceParameterFull cp)
=> addr
-> Ep.EntrypointRef mname
-> ContractRef (Ep.GetEntrypointArgCustom cp mname)
callingAddress :: forall cp vd addr (mname :: Maybe Symbol).
(ToTAddress cp vd addr, NiceParameterFull cp) =>
addr
-> EntrypointRef mname
-> ContractRef (GetEntrypointArgCustom cp mname)
callingAddress (forall cp vd a. ToTAddress cp vd a => a -> TAddress cp vd
toTAddress @cp @vd -> TAddress Address
addr) EntrypointRef mname
epRef =
case forall cp (mname :: Maybe Symbol).
ParameterDeclaresEntrypoints cp =>
EntrypointRef mname
-> EntrypointCall cp (GetEntrypointArgCustom cp mname)
Ep.parameterEntrypointCallCustom @cp EntrypointRef mname
epRef of
epc :: EntrypointCall cp (GetEntrypointArgCustom cp mname)
epc@M.EntrypointCall{} -> Address
-> SomeEntrypointCall (GetEntrypointArgCustom cp mname)
-> ContractRef (GetEntrypointArgCustom cp mname)
forall arg. Address -> SomeEntrypointCall arg -> ContractRef arg
ContractRef Address
addr (EntrypointCall cp (GetEntrypointArgCustom cp mname)
-> SomeEntrypointCall (GetEntrypointArgCustom cp mname)
forall (arg :: T) (param :: T).
ParameterScope param =>
EntrypointCallT param arg -> SomeEntrypointCallT arg
M.SomeEpc EntrypointCall cp (GetEntrypointArgCustom cp mname)
epc)
callingDefAddress
:: forall cp vd addr.
(ToTAddress cp vd addr, NiceParameterFull cp)
=> addr
-> ContractRef (Ep.GetDefaultEntrypointArg cp)
callingDefAddress :: forall cp vd addr.
(ToTAddress cp vd addr, NiceParameterFull cp) =>
addr -> ContractRef (GetDefaultEntrypointArg cp)
callingDefAddress addr
addr = forall cp vd addr (mname :: Maybe Symbol).
(ToTAddress cp vd addr, NiceParameterFull cp) =>
addr
-> EntrypointRef mname
-> ContractRef (GetEntrypointArgCustom cp mname)
callingAddress @cp @vd addr
addr EntrypointRef 'Nothing
Ep.CallDefault
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
toTAddress_ :: forall cp addr vd (s :: [*]).
ToTAddress_ cp vd addr =>
(addr : s) :-> (TAddress cp vd : s)
toTAddress_ = Instr (ToTs (addr : s)) (ToTs (TAddress cp vd : s))
-> (addr : s) :-> (TAddress cp vd : s)
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I Instr (ToTs (addr : s)) (ToTs (TAddress cp vd : s))
forall (inp :: [T]). Instr inp inp
M.Nop
newtype FutureContract arg = FutureContract { forall arg. FutureContract arg -> ContractRef arg
unFutureContract :: ContractRef arg }
instance IsoValue (FutureContract arg) where
type ToT (FutureContract arg) = ToT EpAddress
toVal :: FutureContract arg -> Value (ToT (FutureContract arg))
toVal (FutureContract ContractRef arg
contract) = EpAddress -> Value (ToT EpAddress)
forall a. IsoValue a => a -> Value (ToT a)
toVal (EpAddress -> Value (ToT EpAddress))
-> EpAddress -> Value (ToT EpAddress)
forall a b. (a -> b) -> a -> b
$ ContractRef arg -> EpAddress
forall cp. ContractRef cp -> EpAddress
M.contractRefToAddr ContractRef arg
contract
fromVal :: Value (ToT (FutureContract arg)) -> FutureContract arg
fromVal = Text -> Value 'TAddress -> FutureContract arg
forall a. HasCallStack => Text -> a
error Text
"Fetching 'FutureContract' back from Michelson is impossible"
instance HasAnnotation (FutureContract a) where
getAnnotation :: FollowEntrypointFlag -> Notes (ToT (FutureContract a))
getAnnotation FollowEntrypointFlag
_ = Notes (ToT (FutureContract a))
forall (t :: T). SingI t => Notes t
M.starNotes
instance HasRPCRepr (FutureContract p) where
type AsRPC (FutureContract p) = FutureContract p
class ToAddress a where
toAddress :: a -> Address
instance ToAddress Address where
toAddress :: Address -> Address
toAddress = Address -> Address
forall a. a -> a
id
instance ToAddress L1Address where
toAddress :: L1Address -> Address
toAddress = (forall (t :: AddressKind).
ConstrainAddressKind
'[ 'AddressKindImplicit, 'AddressKindContract] t =>
KindedAddress t -> Address)
-> L1Address -> Address
forall {k} (c :: k -> Constraint) (f :: k -> *) r.
(forall (t :: k). c t => f t -> r) -> Constrained c f -> r
foldConstrained forall (kind :: AddressKind). KindedAddress kind -> Address
forall (t :: AddressKind).
ConstrainAddressKind
'[ 'AddressKindImplicit, 'AddressKindContract] t =>
KindedAddress t -> Address
MkAddress
instance ToAddress (KindedAddress kind) where
toAddress :: KindedAddress kind -> Address
toAddress = KindedAddress kind -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress
instance ToAddress EpAddress where
toAddress :: EpAddress -> Address
toAddress = EpAddress -> Address
eaAddress
instance ToAddress (TAddress cp vd) where
toAddress :: TAddress cp vd -> Address
toAddress = TAddress cp vd -> Address
forall p vd. TAddress p vd -> Address
unTAddress
instance ToAddress (FutureContract cp) where
toAddress :: FutureContract cp -> Address
toAddress = ContractRef cp -> Address
forall a. ToAddress a => a -> Address
toAddress (ContractRef cp -> Address)
-> (FutureContract cp -> ContractRef cp)
-> FutureContract cp
-> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FutureContract cp -> ContractRef cp
forall arg. FutureContract arg -> ContractRef arg
unFutureContract
instance ToAddress (ContractRef cp) where
toAddress :: ContractRef cp -> Address
toAddress = ContractRef cp -> Address
forall cp. ContractRef cp -> Address
crAddress
class ToTAddress (cp :: Type) (vd :: Type) (a :: Type) where
toTAddress :: a -> TAddress cp vd
instance ToTAddress cp vd Address where
toTAddress :: Address -> TAddress cp vd
toTAddress = Address -> TAddress cp vd
forall p vd. Address -> TAddress p vd
TAddress
instance ToTAddress cp vd ContractAddress where
toTAddress :: ContractAddress -> TAddress cp vd
toTAddress = Address -> TAddress cp vd
forall p vd. Address -> TAddress p vd
TAddress (Address -> TAddress cp vd)
-> (ContractAddress -> Address)
-> ContractAddress
-> TAddress cp vd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress
type CheckImplicitContractParameter :: Type -> M.T -> Constraint
type family CheckImplicitContractParameter cp totcp where
CheckImplicitContractParameter _ 'M.TUnit = ()
CheckImplicitContractParameter _ ('M.TTicket _) = ()
CheckImplicitContractParameter cp totcp = TypeError
( 'Text "Implicit address parameter may be either 'unit' or 'ticket', but it was"
':$$: 'ShowType cp ':<>: 'Text " (" ':<>: 'ShowType totcp ':<>: 'Text ")"
)
class ToT cp ~ totcp => ImplicitContractParameter cp totcp
instance ToT cp ~ 'M.TTicket t => ImplicitContractParameter cp ('M.TTicket t)
instance {-# incoherent #-} (CheckImplicitContractParameter cp totcp, cp ~ (), totcp ~ 'M.TUnit)
=> ImplicitContractParameter cp totcp
instance (ImplicitContractParameter cp (ToT cp), vd ~ ()) => ToTAddress cp vd ImplicitAddress where
toTAddress :: ImplicitAddress -> TAddress cp vd
toTAddress = Address -> TAddress cp vd
forall p vd. Address -> TAddress p vd
TAddress (Address -> TAddress cp vd)
-> (ImplicitAddress -> Address)
-> ImplicitAddress
-> TAddress cp vd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImplicitAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress
instance (vd ~ ()) => ToTAddress cp vd SmartRollupAddress where
toTAddress :: SmartRollupAddress -> TAddress cp vd
toTAddress = Address -> TAddress cp vd
forall p vd. Address -> TAddress p vd
TAddress (Address -> TAddress cp vd)
-> (SmartRollupAddress -> Address)
-> SmartRollupAddress
-> TAddress cp vd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SmartRollupAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress
instance ToTAddress cp vd L1Address where
toTAddress :: L1Address -> TAddress cp vd
toTAddress = (forall (t :: AddressKind).
ConstrainAddressKind
'[ 'AddressKindImplicit, 'AddressKindContract] t =>
KindedAddress t -> TAddress cp vd)
-> L1Address -> TAddress cp vd
forall {k} (c :: k -> Constraint) (f :: k -> *) r.
(forall (t :: k). c t => f t -> r) -> Constrained c f -> r
foldConstrained ((forall (t :: AddressKind).
ConstrainAddressKind
'[ 'AddressKindImplicit, 'AddressKindContract] t =>
KindedAddress t -> TAddress cp vd)
-> L1Address -> TAddress cp vd)
-> (forall (t :: AddressKind).
ConstrainAddressKind
'[ 'AddressKindImplicit, 'AddressKindContract] t =>
KindedAddress t -> TAddress cp vd)
-> L1Address
-> TAddress cp vd
forall a b. (a -> b) -> a -> b
$ Address -> TAddress cp vd
forall p vd. Address -> TAddress p vd
TAddress (Address -> TAddress cp vd)
-> (KindedAddress t -> Address)
-> KindedAddress t
-> TAddress cp vd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KindedAddress t -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress
instance (cp ~ cp', vd ~ vd') => ToTAddress cp vd (TAddress cp' vd') where
toTAddress :: TAddress cp' vd' -> TAddress cp vd
toTAddress = TAddress cp' vd' -> TAddress cp vd
forall a. a -> a
id
class ToContractRef (cp :: Type) (contract :: Type) where
toContractRef :: HasCallStack => contract -> ContractRef cp
instance (cp ~ cp') => ToContractRef cp (ContractRef cp') where
toContractRef :: HasCallStack => ContractRef cp' -> ContractRef cp
toContractRef = ContractRef cp' -> ContractRef cp
forall a. a -> a
id
instance (NiceParameter cp, cp ~ cp') => ToContractRef cp (FutureContract cp') where
toContractRef :: HasCallStack => FutureContract cp' -> ContractRef cp
toContractRef = FutureContract cp' -> ContractRef cp
forall arg. FutureContract arg -> ContractRef arg
unFutureContract
instance ( FailWhen cond msg
, cond ~
( Ep.CanHaveEntrypoints cp &&
Not (Ep.ParameterEntrypointsDerivation cp == Ep.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, Ep.GetDefaultEntrypointArg cp ~ cp
) =>
ToContractRef arg (TAddress cp vd) where
toContractRef :: HasCallStack => TAddress cp vd -> ContractRef arg
toContractRef TAddress cp vd
taddr = forall cp vd addr (mname :: Maybe Symbol).
(ToTAddress cp vd addr, NiceParameterFull cp) =>
addr
-> EntrypointRef mname
-> ContractRef (GetEntrypointArgCustom cp mname)
callingAddress @cp @vd TAddress cp vd
taddr EntrypointRef 'Nothing
Ep.CallDefault
class FromContractRef (cp :: Type) (contract :: Type) where
fromContractRef :: ContractRef cp -> contract
instance (cp ~ cp') => FromContractRef cp (ContractRef cp') where
fromContractRef :: ContractRef cp -> ContractRef cp'
fromContractRef = ContractRef cp -> ContractRef cp'
forall a. a -> a
id
instance (cp ~ cp') => FromContractRef cp (FutureContract cp') where
fromContractRef :: ContractRef cp -> FutureContract cp'
fromContractRef = ContractRef cp' -> FutureContract cp'
forall arg. ContractRef arg -> FutureContract arg
FutureContract (ContractRef cp' -> FutureContract cp')
-> (ContractRef cp -> ContractRef cp')
-> ContractRef cp
-> FutureContract cp'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractRef cp -> ContractRef cp'
forall cp contract.
FromContractRef cp contract =>
ContractRef cp -> contract
fromContractRef
instance FromContractRef cp EpAddress where
fromContractRef :: ContractRef cp -> EpAddress
fromContractRef = ContractRef cp -> EpAddress
forall cp. ContractRef cp -> EpAddress
M.contractRefToAddr
instance FromContractRef cp Address where
fromContractRef :: ContractRef cp -> Address
fromContractRef = ContractRef cp -> Address
forall cp. ContractRef cp -> Address
crAddress
convertContractRef
:: forall cp contract2 contract1.
(ToContractRef cp contract1, FromContractRef cp contract2)
=> contract1 -> contract2
convertContractRef :: forall cp contract2 contract1.
(ToContractRef cp contract1, FromContractRef cp contract2) =>
contract1 -> contract2
convertContractRef = forall cp contract.
FromContractRef cp contract =>
ContractRef cp -> contract
fromContractRef @cp (ContractRef cp -> contract2)
-> (contract1 -> ContractRef cp) -> contract1 -> contract2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. contract1 -> ContractRef cp
forall cp contract.
(ToContractRef cp contract, HasCallStack) =>
contract -> ContractRef cp
toContractRef