-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Basic types for the test framework.
module Test.Cleveland.Lorentz.Types
  ( ContractHandle (..)
  , L1TAddress (..)

  , ToContractAddress (..)
  , ToImplicitAddress (..)
  , ToL1Address (..)
  , ToL1TAddress (..)
  , ToStorageType (..)

  , NiceParameter
  , NiceParameterFull
  , NiceStorage
  , NicePackedValue
  , NiceUnpackedValue

  , ToAddress
  , toAddress

  -- * Notes
  -- $noteTAddress
  ) where

import Data.Constraint (Dict(..))
import Fmt (Buildable(..), (+|), (|+))

import Lorentz.Address
import Lorentz.Constraints
import Morley.Client.Types
  (AddressWithAlias(..), ContractAddressWithAlias, ImplicitAddressWithAlias)
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias

-- | Handle to a contract.
--
-- This is what you get when originating a contract and that allows further
-- operations with the contract within the test framework.
--
-- Note that this is part of the testing framework and exists solely in Haskell
-- world, so it has no 'T.IsoValue' and related instances and cannot be used in
-- Lorentz code.
data ContractHandle (cp :: Type) (st :: Type) (vd :: Type) =
  (NiceParameter cp, NiceStorage st, NiceViewsDescriptor vd) =>
  ContractHandle
  { forall cp st vd. ContractHandle cp st vd -> ContractAlias
chContractName :: ContractAlias
  , forall cp st vd. ContractHandle cp st vd -> ContractAddress
chAddress :: ContractAddress
  }

deriving stock instance Show (ContractHandle cp st vd)

instance Buildable (ContractHandle cp st vd) where
  build :: ContractHandle cp st vd -> Builder
build (ContractHandle ContractAlias
name ContractAddress
addr) =
    Builder
"<handler to '" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ContractAlias
name ContractAlias -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"' / " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ContractAddress
addr ContractAddress -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
">"

instance ToAddress (ContractHandle cp st vd) where
  toAddress :: ContractHandle cp st vd -> Address
toAddress = ContractAddress -> Address
forall (kind :: AddressKind). KindedAddress kind -> Address
MkAddress (ContractAddress -> Address)
-> (ContractHandle cp st vd -> ContractAddress)
-> ContractHandle cp st vd
-> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractHandle cp st vd -> ContractAddress
forall cp st vd. ContractHandle cp st vd -> ContractAddress
chAddress

-- TODO [#577]: simplify this instance once fundep in ToTAddress is added
instance (cp' ~ cp, vd ~ vd') => ToTAddress cp' vd' (ContractHandle cp st vd) where
  toTAddress :: ContractHandle cp st vd -> TAddress cp' vd'
toTAddress = Address -> TAddress cp' vd'
forall cp vd a. ToTAddress cp vd a => a -> TAddress cp vd
toTAddress (Address -> TAddress cp' vd')
-> (ContractHandle cp st vd -> Address)
-> ContractHandle cp st vd
-> TAddress cp' vd'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractHandle cp st vd -> Address
forall a. ToAddress a => a -> Address
toAddress

instance ToContractRef arg (TAddress cp vd) => ToContractRef arg (ContractHandle cp st vd) where
  toContractRef :: HasCallStack => ContractHandle cp st vd -> ContractRef arg
toContractRef = TAddress cp vd -> ContractRef arg
forall cp contract.
(ToContractRef cp contract, HasCallStack) =>
contract -> ContractRef cp
toContractRef (TAddress cp vd -> ContractRef arg)
-> (ContractHandle cp st vd -> TAddress cp vd)
-> ContractHandle cp st vd
-> ContractRef arg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cp vd a. ToTAddress cp vd a => a -> TAddress cp vd
toTAddress @cp

class ToContractAddress addr where
  toContractAddress :: addr -> ContractAddress

instance ToContractAddress ContractAddress where
  toContractAddress :: ContractAddress -> ContractAddress
toContractAddress = ContractAddress -> ContractAddress
forall a. a -> a
id

instance ToContractAddress ContractAddressWithAlias where
  toContractAddress :: ContractAddressWithAlias -> ContractAddress
toContractAddress = ContractAddressWithAlias -> ContractAddress
forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
awaAddress

instance ToContractAddress (ContractHandle cp st vd) where
  toContractAddress :: ContractHandle cp st vd -> ContractAddress
toContractAddress = ContractHandle cp st vd -> ContractAddress
forall cp st vd. ContractHandle cp st vd -> ContractAddress
chAddress

class ToImplicitAddress addr where
  toImplicitAddress :: addr -> ImplicitAddress

instance ToImplicitAddress ImplicitAddress where
  toImplicitAddress :: ImplicitAddress -> ImplicitAddress
toImplicitAddress = ImplicitAddress -> ImplicitAddress
forall a. a -> a
id

instance ToImplicitAddress ImplicitAddressWithAlias where
  toImplicitAddress :: ImplicitAddressWithAlias -> ImplicitAddress
toImplicitAddress = ImplicitAddressWithAlias -> ImplicitAddress
forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
awaAddress

class ToL1Address addr where
  toL1Address :: addr -> L1Address

instance ToL1Address (L1TAddress cp vd) where
  toL1Address :: L1TAddress cp vd -> L1Address
toL1Address = L1TAddress cp vd -> L1Address
forall k k (cp :: k) (vd :: k). L1TAddress cp vd -> L1Address
unL1TAddress

instance ToL1Address L1Address where
  toL1Address :: L1Address -> L1Address
toL1Address = L1Address -> L1Address
forall a. a -> a
id

instance L1AddressKind kind => ToL1Address (KindedAddress kind) where
  toL1Address :: KindedAddress kind -> L1Address
toL1Address = KindedAddress kind -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained

instance L1AddressKind kind => ToL1Address (AddressWithAlias kind) where
  toL1Address :: AddressWithAlias kind -> L1Address
toL1Address = KindedAddress kind -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained (KindedAddress kind -> L1Address)
-> (AddressWithAlias kind -> KindedAddress kind)
-> AddressWithAlias kind
-> L1Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressWithAlias kind -> KindedAddress kind
forall (kind :: AddressKind).
AddressWithAlias kind -> KindedAddress kind
awaAddress

instance ToL1Address (ContractHandle cp st vd) where
  toL1Address :: ContractHandle cp st vd -> L1Address
toL1Address = ContractAddress -> L1Address
forall {k} (c :: k -> Constraint) (f :: k -> *) (a :: k).
c a =>
f a -> Constrained c f
Constrained (ContractAddress -> L1Address)
-> (ContractHandle cp st vd -> ContractAddress)
-> ContractHandle cp st vd
-> L1Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractHandle cp st vd -> ContractAddress
forall cp st vd. ContractHandle cp st vd -> ContractAddress
chAddress

-- | Counterpart of 'TAddress' that contains 'L1Address' instead of 'Address'.
newtype L1TAddress cp vd = L1TAddress { forall k k (cp :: k) (vd :: k). L1TAddress cp vd -> L1Address
unL1TAddress :: L1Address }

instance (cp ~ cp', vd ~ vd') => ToTAddress cp' vd' (L1TAddress cp vd) where
  toTAddress :: L1TAddress cp vd -> TAddress cp' vd'
toTAddress = Address -> TAddress cp' vd'
forall cp vd a. ToTAddress cp vd a => a -> TAddress cp vd
toTAddress (Address -> TAddress cp' vd')
-> (L1TAddress cp vd -> Address)
-> L1TAddress cp vd
-> TAddress cp' vd'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. L1Address -> Address
forall a. ToAddress a => a -> Address
toAddress (L1Address -> Address)
-> (L1TAddress cp vd -> L1Address) -> L1TAddress cp vd -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. L1TAddress cp vd -> L1Address
forall k k (cp :: k) (vd :: k). L1TAddress cp vd -> L1Address
unL1TAddress

-- | Counterpart of 'ToTAddress' that converts to 'L1TAddress' rather than
-- 'TAddress'.
class (ToTAddress cp vd addr, ToL1Address addr)
  => ToL1TAddress cp vd addr where
  toL1TAddress :: addr -> L1TAddress cp vd
instance (ToTAddress cp vd addr, ToL1Address addr)
  => ToL1TAddress cp vd addr where
  toL1TAddress :: addr -> L1TAddress cp vd
toL1TAddress = L1Address -> L1TAddress cp vd
forall {k} {k} (cp :: k) (vd :: k). L1Address -> L1TAddress cp vd
L1TAddress (L1Address -> L1TAddress cp vd)
-> (addr -> L1Address) -> addr -> L1TAddress cp vd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. addr -> L1Address
forall addr. ToL1Address addr => addr -> L1Address
toL1Address

-- NB: We declare ToL1TAddress as a typeclass for two reasons:
-- one, it defines a constraint synonym, and two, if we were to define
-- toL1Address as a simple function, GHC would complain about
-- ToTAddress being redundant -- it's not though, it constrains the types.

-- | Declares that @addr@ points to an entity with a storage.
--
-- @addr@ may fix storage type or may not - in the latter case the caller
-- has to specify the storage type explicitly via type annotation.
class ToContractAddress addr => ToStorageType st addr where
  -- | Pick proof of that storage type is valid.
  pickNiceStorage :: addr -> Dict (NiceStorage st)

instance NiceStorage st => ToStorageType st ContractAddress where
  pickNiceStorage :: ContractAddress -> Dict (NiceStorage st)
pickNiceStorage ContractAddress
_ = Dict (NiceStorage st)
forall (a :: Constraint). a => Dict a
Dict

instance (st ~ st') => ToStorageType st' (ContractHandle cp st vd) where
  pickNiceStorage :: ContractHandle cp st vd -> Dict (NiceStorage st')
pickNiceStorage ContractHandle{} = Dict (NiceStorage st')
forall (a :: Constraint). a => Dict a
Dict

{- $noteTAddress

  == A note on 'TAddress' instance for 'ToStorageType'

  'TAddress' isn't intended to be a part of the Cleveland API.
  In the absolute majority of cases, if one is interested in both parameter
  and storage, then they should use 'ContractHandle', as the storage type
  needs to be known either way. If one isn't interested in storage, they
  presumably wouldn't call functions to get storage. Hence, this instance
  wouldn't be particularly useful. Legacy code using 'TAddress' instead of
  'ContractHandle' should be preferably updated, if possible. If nothing
  else, 'toAddress' can be used as a stopgap measure.
-}