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

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

  , ToStorageType (..)

  , NiceParameter
  , NiceParameterFull
  , NiceStorage
  , NicePackedValue
  , NiceUnpackedValue

  , ToAddress
  , toAddress

  -- * Notes
  -- $noteTAddress
  ) where

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

import Lorentz.Address
import Lorentz.Constraints
import Morley.Michelson.Typed qualified as T

-- | 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
  { ContractHandle cp st vd -> Text
chContractName :: Text
  , ContractHandle cp st vd -> Address
chAddress :: Address
  }

deriving stock instance Show (ContractHandle cp st vd)

instance Buildable (ContractHandle cp st vd) where
  build :: ContractHandle cp st vd -> Builder
build (ContractHandle Text
name Address
addr) =
    Builder
"<handler to '" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
name Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"' / " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Address
addr Address -> 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 = ContractHandle cp st vd -> Address
forall cp st vd. ContractHandle cp st vd -> Address
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 :: 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 vd a. ToTAddress cp vd a => a -> TAddress cp vd
forall cp vd a. ToTAddress cp vd a => a -> TAddress cp vd
toTAddress @cp

-- | Extract the evidence in typed Michelson that the parameter type is valid
-- for such scope.
chNiceParameterEvi :: forall param st vd. ContractHandle param st vd -> Dict (T.ParameterScope $ T.ToT st)
chNiceParameterEvi :: ContractHandle param st vd -> Dict (ParameterScope $ ToT st)
chNiceParameterEvi ContractHandle{} = (((SingI (ToT st), WellTyped (ToT st),
   FailOnOperationFound (ContainsOp (ToT st)),
   FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st))),
  KnownValue st)
 :- (ParameterScope $ ToT st))
-> Dict
     ((SingI (ToT st), WellTyped (ToT st),
       FailOnOperationFound (ContainsOp (ToT st)),
       FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st))),
      KnownValue st)
-> Dict (ParameterScope $ ToT st)
forall (a :: Constraint) (b :: Constraint).
(a :- b) -> Dict a -> Dict b
mapDict (((SingI (ToT st), WellTyped (ToT st),
  FailOnOperationFound (ContainsOp (ToT st)),
  FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st))),
 KnownValue st)
:- (ParameterScope $ ToT st)
forall a. NiceParameter a :- ParameterScope (ToT a)
niceParameterEvi @st) Dict
  ((SingI (ToT st), WellTyped (ToT st),
    FailOnOperationFound (ContainsOp (ToT st)),
    FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st))),
   KnownValue st)
forall (a :: Constraint). a => Dict a
Dict

-- | Extract the evidence in typed Michelson that the storage type is valid
-- for such scope.
chNiceStorageEvi :: forall param st vd. ContractHandle param st vd -> Dict (T.StorageScope $ T.ToT st)
chNiceStorageEvi :: ContractHandle param st vd -> Dict (StorageScope $ ToT st)
chNiceStorageEvi ContractHandle{} = (((SingI (ToT st), WellTyped (ToT st),
   FailOnOperationFound (ContainsOp (ToT st)),
   FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
   FailOnContractFound (ContainsContract (ToT st))),
  KnownValue st)
 :- (StorageScope $ ToT st))
-> Dict
     ((SingI (ToT st), WellTyped (ToT st),
       FailOnOperationFound (ContainsOp (ToT st)),
       FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
       FailOnContractFound (ContainsContract (ToT st))),
      KnownValue st)
-> Dict (StorageScope $ ToT st)
forall (a :: Constraint) (b :: Constraint).
(a :- b) -> Dict a -> Dict b
mapDict (((SingI (ToT st), WellTyped (ToT st),
  FailOnOperationFound (ContainsOp (ToT st)),
  FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
  FailOnContractFound (ContainsContract (ToT st))),
 KnownValue st)
:- (StorageScope $ ToT st)
forall a. NiceStorage a :- StorageScope (ToT a)
niceStorageEvi @st) Dict
  ((SingI (ToT st), WellTyped (ToT st),
    FailOnOperationFound (ContainsOp (ToT st)),
    FailOnNestedBigMapsFound (ContainsNestedBigMaps (ToT st)),
    FailOnContractFound (ContainsContract (ToT st))),
   KnownValue st)
forall (a :: Constraint). a => Dict a
Dict

-- | 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 ToAddress addr => ToStorageType st addr where
  -- | Pick proof of that storage type is valid.
  pickNiceStorage :: addr -> Dict (NiceStorage st)

instance NiceStorage st => ToStorageType st Address where
  pickNiceStorage :: Address -> Dict (NiceStorage st)
pickNiceStorage Address
_ = 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.
-}