-- | Re-exports typed Value, CValue, some core types, some helpers and
-- defines aliases for constructors of typed values.
--

{-
TODO [TM-280]: Move this mess somewhere (in the last MR)

This module also 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 this types in Haskell
world.
In Michelson world, you can use coercions and dedicated instructions from
"Lorentz.Instr".
-}
module Lorentz.Value
  ( Value
  , IsoValue (..)
  , IsoCValue (..)
  , CValue (..)

    -- * Primitive types
  , Integer
  , Natural
  , MText
  , Bool (..)
  , ByteString
  , Address
  , EpAddress (..)
  , Mutez
  , Timestamp
  , ChainId
  , KeyHash
  , PublicKey
  , Signature
  , Set
  , Map
  , M.BigMap (..)
  , M.Operation
  , Maybe (..)
  , List
  , ContractRef (..)
  , TAddress (..)
  , FutureContract (..)

  , M.EpName
  , pattern M.DefEpName
  , EntryPointCall
  , SomeEntryPointCall

    -- * Constructors
  , toMutez
  , mt
  , timestampFromSeconds
  , timestampFromUTCTime
  , timestampQuote

    -- * Conversions
  , M.coerceContractRef
  , callingTAddress
  , callingDefTAddress
  , ToAddress (..)
  , ToTAddress (..)
  , ToContractRef (..)
  , FromContractRef (..)
  , convertContractRef

    -- * Misc
  , Default (..)
  , Label (..)
  ) where

import Data.Default (Default(..))
import Data.Type.Bool (type (&&), Not)
import Data.Kind as Kind
import Data.Vinyl.Derived (Label(..))

import Lorentz.Constraints
import Michelson.Text
import Michelson.Typed
  (ContractRef(..), EntryPointCall, IsoCValue(..), IsoValue(..), SomeEntryPointCall, Value)
import qualified Michelson.Typed as M
import Michelson.Typed.CValue (CValue(..))
import qualified Lorentz.EntryPoints.Core as Ep
import Michelson.Typed.EntryPoints (EpAddress(..))
import Tezos.Address (Address)
import Tezos.Core
  (ChainId, Mutez, Timestamp, timestampFromSeconds, timestampFromUTCTime, timestampQuote, toMutez)
import Tezos.Crypto (KeyHash, PublicKey, Signature)
import Util.TypeLits
import Util.Type

type List = []

-- TODO (this MR): Add appropriate 'CanCastTo' instances

-- | 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 { unTAddress :: Address }
  deriving stock Generic
  deriving anyclass IsoValue

-- | 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 addr) epRef =
  withDict (niceParameterEvi @cp) $
  case Ep.parameterEntryPointCallCustom @cp epRef of
    epc@M.EntryPointCall{} -> ContractRef addr (M.SomeEpc epc)

-- | Specification of 'callTAddress' to call the default entrypoint.
callingDefTAddress
  :: forall cp.
     (NiceParameterFull cp)
  => TAddress cp
  -> ContractRef (Ep.GetDefaultEntryPointArg cp)
callingDefTAddress taddr = callingTAddress taddr Ep.CallDefault

-- | 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 { unFutureContract :: ContractRef arg }

instance IsoValue (FutureContract arg) where
  type ToT (FutureContract arg) = ToT EpAddress
  toVal (FutureContract contract) = toVal $ M.contractRefToAddr contract
  fromVal = error "Fetching 'FutureContract' back from Michelson is impossible"

-- | 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 = id

instance ToAddress EpAddress where
  toAddress = eaAddress

instance ToAddress (TAddress cp) where
  toAddress = unTAddress

instance ToAddress (FutureContract cp) where
  toAddress = toAddress . unFutureContract

instance ToAddress (ContractRef cp) where
  toAddress = 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 = TAddress

instance (cp ~ cp') => ToTAddress cp (TAddress cp') where
  toTAddress = 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 = id

instance (NiceParameter cp, cp ~ cp') => ToContractRef cp (FutureContract cp') where
  toContractRef = 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 prooving that does not worth the effort
         , NiceParameterFull cp, Ep.GetDefaultEntryPointArg cp ~ cp
         ) =>
         ToContractRef arg (TAddress cp) where
  toContractRef = 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 = id

instance (cp ~ cp') => FromContractRef cp (FutureContract cp') where
  fromContractRef = FutureContract . fromContractRef

instance FromContractRef cp EpAddress where
  fromContractRef = M.contractRefToAddr

instance FromContractRef cp Address where
  fromContractRef = crAddress

convertContractRef
  :: forall cp contract2 contract1.
     (ToContractRef cp contract1, FromContractRef cp contract2)
  => contract1 -> contract2
convertContractRef = fromContractRef @cp . toContractRef