Alias.hs

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

module Morley.Tezos.Address.Alias
  ( AddressOrAlias(..)
  , Alias(..)
  , SomeAlias(..)
  , SomeAddressOrAlias(..)
  , ImplicitAlias
  , ContractAlias
  , ImplicitAddressOrAlias
  , ContractAddressOrAlias
  , unAlias
  , mkAlias
  , aliasKindSanity
  )
  where

import Data.Aeson (FromJSON(..), ToJSON(..))
import Data.Constraint (Dict(..), (\\))
import Data.Singletons (SingI(..), demote)
import Data.Type.Equality ((:~:)(..))
import Fmt (Buildable(..), nameF, pretty, (+|), (|+))
import Options.Applicative qualified as Opt

import Morley.Tezos.Address
import Morley.Tezos.Address.Kinds
import Morley.Util.CLI (HasCLReader(..))
import Morley.Util.Sing

-- | @tezos-client@ can associate addresses with textual aliases.
-- This type denotes such an alias.
data Alias (kind :: AddressKind) where
  ImplicitAlias :: Text -> Alias 'AddressKindImplicit
  ContractAlias :: Text -> Alias 'AddressKindContract

-- | A type only allowing v'ImplicitAlias' values.
type ImplicitAlias = Alias 'AddressKindImplicit

-- | A type only allowing v'ContractAlias' values.
type ContractAlias = Alias 'AddressKindContract

deriving stock instance Show (Alias kind)
deriving stock instance Eq (Alias kind)
deriving stock instance Ord (Alias kind)

-- | Get raw alias text from 'Alias'
unAlias :: Alias kind -> Text
unAlias = \case
  ImplicitAlias x -> x
  ContractAlias x -> x

-- | Construct an 'Alias' from alias 'Text'.
mkAlias :: forall kind. (SingI kind, L1AddressKind kind) => Text -> Alias kind
mkAlias = usingImplicitOrContractKind @kind $ case sing @kind of
  SAddressKindImplicit -> ImplicitAlias
  SAddressKindContract -> ContractAlias

instance Buildable (Alias kind) where
  build = build . unAlias

instance ToJSON (Alias kind) where
  toJSON = toJSON . unAlias

instance (SingI kind, L1AddressKind kind) => FromJSON (Alias kind) where
  parseJSON = fmap mkAlias . parseJSON

-- | Existential wrapper over 'Alias'.
data SomeAlias = forall kind. SomeAlias (Alias kind)

deriving stock instance Show SomeAlias

instance Buildable SomeAlias where
  build (SomeAlias x) = build x

-- | Given an 'Alias', prove it's @kind@ is well-defined (i.e. it has a 'SingI'
-- instance and satisfies 'L1AddressKind' constraint)
aliasKindSanity :: Alias kind -> Dict (L1AddressKind kind, SingI kind)
aliasKindSanity = \case
  ImplicitAlias{} -> Dict
  ContractAlias{} -> Dict

-- | Representation of an address that @tezos-client@ uses. It can be
-- an address itself or a textual alias.
data AddressOrAlias kind
  = AddressResolved (KindedAddress kind)
  -- ^ Address itself, can be used as is.
  | AddressAlias (Alias kind)
  -- ^ Address alias, should be resolved by @tezos-client@.
  deriving stock (Show, Eq, Ord)

instance (SingI kind, L1AddressKind kind) => HasCLReader (AddressOrAlias kind) where
  getReader =
    Opt.str >>= \addrOrAlias ->
      case parseAddress addrOrAlias of
        Right (MkAddress (addr :: KindedAddress kind')) ->
          case eqI @kind @kind' \\ addressKindSanity addr of
            Just Refl -> pure $ AddressResolved addr
            Nothing -> Opt.readerError $ pretty $ nameF "Unexpected address kind" $
              "expected " +| demote @kind |+ " address, but got " +| addr |+ ""
        Left _ -> pure $ AddressAlias (mkAlias addrOrAlias)
  getMetavar = "ADDRESS OR ALIAS"

instance Buildable (AddressOrAlias kind) where
  build = \case
    AddressResolved addr -> build addr
    AddressAlias alias -> build alias

-- | Convenience type synonym.
type ImplicitAddressOrAlias = AddressOrAlias 'AddressKindImplicit

-- | Convenience type synonym.
type ContractAddressOrAlias = AddressOrAlias 'AddressKindContract

-- | Existential over 'AddressOrAlias'.
data SomeAddressOrAlias = forall kind. SomeAddressOrAlias (AddressOrAlias kind)

instance Buildable SomeAddressOrAlias where
  build (SomeAddressOrAlias x) = build x

deriving stock instance Show SomeAddressOrAlias