-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

{- |

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".

-}
module Lorentz.Address
  ( TAddress (..)
  , FutureContract (..)

    -- ** Conversions
  , callingTAddress
  , callingDefTAddress
  , ToAddress (..)
  , ToTAddress (..)
  , ToTAddress_
  , toTAddress_
  , ToContractRef (..)
  , FromContractRef (..)
  , convertContractRef

    -- * Re-exports
  , Address
  , EpAddress (..)
  , ContractRef (..)
  , M.coerceContractRef
  ) where

import Data.Kind as Kind
import Data.Type.Bool (type (&&), Not)

import Lorentz.Annotation
import Lorentz.Base
import Lorentz.Constraints
import qualified Lorentz.Entrypoints.Core as Ep
import Michelson.Typed (ContractRef(..), IsoValue(..))
import qualified Michelson.Typed as M
import Michelson.Typed.Entrypoints (EpAddress(..))
import Tezos.Address (Address)
import Util.Type
import Util.TypeLits

-- | Address which remembers the parameter type 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.
newtype TAddress p = TAddress { TAddress p -> Address
unTAddress :: Address }
  deriving stock (forall x. TAddress p -> Rep (TAddress p) x)
-> (forall x. Rep (TAddress p) x -> TAddress p)
-> Generic (TAddress p)
forall x. Rep (TAddress p) x -> TAddress p
forall x. TAddress p -> Rep (TAddress p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (p :: k) x. Rep (TAddress p) x -> TAddress p
forall k (p :: k) x. TAddress p -> Rep (TAddress p) x
$cto :: forall k (p :: k) x. Rep (TAddress p) x -> TAddress p
$cfrom :: forall k (p :: k) x. TAddress p -> Rep (TAddress p) x
Generic
  deriving anyclass (WellTypedToT (TAddress p)
WellTypedToT (TAddress p) =>
(TAddress p -> Value (ToT (TAddress p)))
-> (Value (ToT (TAddress p)) -> TAddress p)
-> IsoValue (TAddress p)
Value (ToT (TAddress p)) -> TAddress p
TAddress p -> Value (ToT (TAddress p))
forall a.
WellTypedToT a =>
(a -> Value (ToT a)) -> (Value (ToT a) -> a) -> IsoValue a
forall k (p :: k). WellTypedToT (TAddress p)
forall k (p :: k). Value (ToT (TAddress p)) -> TAddress p
forall k (p :: k). TAddress p -> Value (ToT (TAddress p))
fromVal :: Value (ToT (TAddress p)) -> TAddress p
$cfromVal :: forall k (p :: k). Value (ToT (TAddress p)) -> TAddress p
toVal :: TAddress p -> Value (ToT (TAddress p))
$ctoVal :: forall k (p :: k). TAddress p -> Value (ToT (TAddress p))
$cp1IsoValue :: forall k (p :: k). WellTypedToT (TAddress p)
IsoValue, FollowEntrypointFlag -> Notes (ToT (TAddress p))
(FollowEntrypointFlag -> Notes (ToT (TAddress p)))
-> HasAnnotation (TAddress p)
forall a.
(FollowEntrypointFlag -> Notes (ToT a)) -> HasAnnotation a
forall k (p :: k). FollowEntrypointFlag -> Notes (ToT (TAddress p))
getAnnotation :: FollowEntrypointFlag -> Notes (ToT (TAddress p))
$cgetAnnotation :: forall k (p :: k). FollowEntrypointFlag -> Notes (ToT (TAddress p))
HasAnnotation)

-- | Turn 'TAddress' 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).
callingTAddress
  :: forall cp mname.
     (NiceParameterFull cp)
  => TAddress cp
  -> Ep.EntrypointRef mname
  -> ContractRef (Ep.GetEntrypointArgCustom cp mname)
callingTAddress :: TAddress cp
-> EntrypointRef mname
-> ContractRef (GetEntrypointArgCustom cp mname)
callingTAddress (TAddress addr :: Address
addr) epRef :: EntrypointRef mname
epRef =
  ((KnownValue cp,
  (KnownT (ToT cp), FailOnOperationFound (ContainsOp (ToT cp)),
   FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT cp))))
 :- (KnownT (ToT cp), HasNoOp (ToT cp),
     HasNoNestedBigMaps (ToT cp)))
-> ((KnownT (ToT cp), HasNoOp (ToT cp),
     HasNoNestedBigMaps (ToT cp)) =>
    ContractRef (GetEntrypointArgCustom cp mname))
-> ContractRef (GetEntrypointArgCustom cp mname)
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict ((KnownValue cp,
 (KnownT (ToT cp), FailOnOperationFound (ContainsOp (ToT cp)),
  FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT cp))))
:- (KnownT (ToT cp), HasNoOp (ToT cp), HasNoNestedBigMaps (ToT cp))
forall a. NiceParameter a :- ParameterScope (ToT a)
niceParameterEvi @cp) (((KnownT (ToT cp), HasNoOp (ToT cp),
   HasNoNestedBigMaps (ToT cp)) =>
  ContractRef (GetEntrypointArgCustom cp mname))
 -> ContractRef (GetEntrypointArgCustom cp mname))
-> ((KnownT (ToT cp), HasNoOp (ToT cp),
     HasNoNestedBigMaps (ToT cp)) =>
    ContractRef (GetEntrypointArgCustom cp mname))
-> ContractRef (GetEntrypointArgCustom cp mname)
forall a b. (a -> b) -> a -> b
$
  case EntrypointRef mname
-> EntrypointCall cp (GetEntrypointArgCustom cp mname)
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)

-- | Specification of 'callTAddress' to call the default entrypoint.
callingDefTAddress
  :: forall cp.
     (NiceParameterFull cp)
  => TAddress cp
  -> ContractRef (Ep.GetDefaultEntrypointArg cp)
callingDefTAddress :: TAddress cp -> ContractRef (GetDefaultEntrypointArg cp)
callingDefTAddress taddr :: TAddress cp
taddr = TAddress cp
-> EntrypointRef 'Nothing
-> ContractRef (GetEntrypointArgCustom cp 'Nothing)
forall cp (mname :: Maybe Symbol).
NiceParameterFull cp =>
TAddress cp
-> EntrypointRef mname
-> ContractRef (GetEntrypointArgCustom cp mname)
callingTAddress TAddress cp
taddr EntrypointRef 'Nothing
Ep.CallDefault

-- | Something coercible to 'TAddress cp'.
type ToTAddress_ cp addr = (ToTAddress cp addr, ToT addr ~ ToT Address)

-- | Cast something appropriate to 'TAddress'.
toTAddress_
  :: forall cp addr s.
     (ToTAddress_ cp addr)
  => addr : s :-> TAddress cp : s
toTAddress_ :: (addr : s) :-> (TAddress cp : s)
toTAddress_ = Instr (ToTs (addr : s)) (ToTs (TAddress cp : s))
-> (addr : s) :-> (TAddress cp : s)
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I Instr (ToTs (addr : s)) (ToTs (TAddress cp : s))
forall (inp :: [T]). Instr inp inp
M.Nop

-- | 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.
newtype FutureContract arg = FutureContract { 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 contract :: ContractRef arg
contract) = EpAddress -> Value (ToT (FutureContract arg))
forall a. IsoValue a => a -> Value (ToT a)
toVal (EpAddress -> Value (ToT (FutureContract arg)))
-> EpAddress -> Value (ToT (FutureContract arg))
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 "Fetching 'FutureContract' back from Michelson is impossible"

instance HasAnnotation (FutureContract a) where
  getAnnotation :: FollowEntrypointFlag -> Notes (ToT (FutureContract a))
getAnnotation _ = Notes (ToT (FutureContract a))
forall (t :: T). SingI t => Notes t
M.starNotes

-- | 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.
class ToAddress a where
  toAddress :: a -> Address

instance ToAddress Address where
  toAddress :: Address -> Address
toAddress = Address -> Address
forall a. a -> a
id

instance ToAddress EpAddress where
  toAddress :: EpAddress -> Address
toAddress = EpAddress -> Address
eaAddress

instance ToAddress (TAddress cp) where
  toAddress :: TAddress cp -> Address
toAddress = TAddress cp -> Address
forall k (cp :: k). TAddress cp -> 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

-- | Convert something referring to a contract (not specific entrypoint)
-- to 'TAddress' in /Haskell/ world.
class ToTAddress (cp :: Kind.Type) (a :: Kind.Type) where
  toTAddress :: a -> TAddress cp

instance ToTAddress cp Address where
  toTAddress :: Address -> TAddress cp
toTAddress = Address -> TAddress cp
forall k (p :: k). Address -> TAddress p
TAddress

instance (cp ~ cp') => ToTAddress cp (TAddress cp') where
  toTAddress :: TAddress cp' -> TAddress cp
toTAddress = TAddress cp' -> TAddress cp
forall a. a -> a
id

-- | Convert something to 'ContractRef' in /Haskell/ world.
class ToContractRef (cp :: Kind.Type) (contract :: Kind.Type) where
  toContractRef :: HasCallStack => contract -> ContractRef cp

instance (cp ~ cp') => ToContractRef cp (ContractRef cp') where
  toContractRef :: 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 :: 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
           -- These constraints should naturally derive from ones above,
           -- but proving that is not worth the effort
         , NiceParameterFull cp, Ep.GetDefaultEntrypointArg cp ~ cp
         ) =>
         ToContractRef arg (TAddress cp) where
  toContractRef :: TAddress cp -> ContractRef arg
toContractRef = TAddress cp -> ContractRef arg
forall cp.
NiceParameterFull cp =>
TAddress cp -> ContractRef (GetDefaultEntrypointArg cp)
callingDefTAddress

-- | Convert something from 'ContractAddr' in /Haskell/ world.
class FromContractRef (cp :: Kind.Type) (contract :: Kind.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 :: contract1 -> contract2
convertContractRef = forall contract.
FromContractRef cp contract =>
ContractRef cp -> contract
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