Alias.hs

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

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

import Data.Aeson (FromJSON(..), ToJSON(..))
import Data.Constraint (Dict(..), (\\))
import Data.Constraint.Extras (has)
import Data.Constraint.Extras.TH (deriveArgDict)
import Data.GADT.Compare.TH (deriveGCompare, deriveGEq)
import Data.Singletons (SingI(..), demote)
import Data.Text qualified as T
import Fmt (Buildable(..), Doc, pretty)
import Options.Applicative qualified as Opt

import Data.Char qualified as Char
import Morley.Tezos.Address
import Morley.Tezos.Address.Kinds
import Morley.Util.CLI (HasCLReader(..))
import Morley.Util.Constrained
import Morley.Util.Interpolate (itu)
import Morley.Util.Sing
import Morley.Util.TH

-- | @octez-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)

deriveGADTNFData ''Alias
deriveGEq ''Alias
deriveGCompare ''Alias
deriveArgDict ''Alias

-- | 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'.
type SomeAlias = Constrained NullConstraint Alias

pattern SomeAlias :: Alias a -> SomeAlias
pattern SomeAlias x = Constrained x
{-# COMPLETE SomeAlias #-}

-- | 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 x = has @AliasKindSanityHelper x Dict

class (L1AddressKind kind, SingI kind) => AliasKindSanityHelper kind
instance (L1AddressKind kind, SingI kind) => AliasKindSanityHelper kind

{- | This type is meant to be used to parse CLI options where either an address
or an alias of an implicit account or a contract can be accepted.

This can be later converted to an address using @Morley.Client.resolveAddress@
or an alias using @Morley.Client.getAlias@.

This polymorphic type can be instantiated with 'AddressKindImplicit' or
'AddressKindContract' (see 'ImplicitAddressOrAlias' and
'ContractAddressOrAlias'), but not 'AddressKindSmartRollup'. There is no
@octez-client@ command to list smart rollup aliases, unlike @octez-client list
known addresses/contracts@, therefore:

1. It wouldn't be possible to implement @Morley.Client.resolveAddress@ for
   @AddressAlias _ :: AddressOrAlias 'AddressKindTxRollup@.
2. It wouldn't be possible to implement @Morley.Client.getAlias@ for
   @AddressResolved _ :: AddressOrAlias 'AddressKindTxRollup@.

This should be revisited if/when @octez-client@ adds support for smart rollup
aliases.
-}
data AddressOrAlias kind where
  AddressResolved :: L1AddressKind kind => KindedAddress kind -> AddressOrAlias kind
  -- ^ Address itself, can be used as is.
  AddressAlias :: Alias kind -> AddressOrAlias kind
  -- ^ Address alias, should be resolved by @octez-client@.

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

instance (SingI kind, L1AddressKind kind) => HasCLReader (AddressOrAlias kind) where
  getReader =
    getReader @SomeAddressOrAlias >>= \case
      SAOAKindSpecified aoa ->
        case castSing @_ @kind aoa \\ addressOrAliasKindSanity aoa of
          Just aoa' -> pure aoa'
          Nothing -> Opt.readerError
            let expectedKind = demote @kind in
            [itu|Unexpected address kind: expected #{expectedKind} address or alias, but got: '#{aoa}'|]
      SAOAKindUnspecified aliasText ->
        pure $ AddressAlias $ mkAlias aliasText
  getMetavar = (fmap Char.toUpper $ pretty $ demote @kind) <> " ADDRESS OR ALIAS"

instance Buildable (AddressOrAlias kind) where
  build = \case
    AddressResolved addr -> build addr
    AddressAlias alias -> aliasPrefix @kind <> ":" <> build alias \\ aliasKindSanity alias

{- This type is meant to be used to parse CLI options where either an address or an alias
of an implicit account can be accepted.

Example inputs:
  * "tz1hZ7o4bhFTo6AXpWZsXzbnddEK3dSCv1S8": an address belonging to an implicit account.
  * "implicit:some-alias" or "some-alias": an alias that is expected to be associated with an implicit account.
      * If it's associated with a contract, @Morley.Client.resolveAddress@ will fail.
      * If it's associated with __both__ a contract and an implicit account,
        @Morley.Client.resolveAddress@ will return the implicit account address.

Parsing will fail on these inputs:
  * "KT1STb2aG7NpoBBNRggvummqsxNQZmuAVFvG"
  * "contract:some-alias"

Refer to the 'HasCLReader' and @Morley.Client.Resolve@ instances for implementation details.
-}
type ImplicitAddressOrAlias = AddressOrAlias 'AddressKindImplicit

{- This type is meant to be used to parse CLI options where either an address or an alias
of a contract can be accepted.

Example inputs:
  * "KT1STb2aG7NpoBBNRggvummqsxNQZmuAVFvG": an address belonging to a contract.
  * "contract:some-alias" or "some-alias": an alias that is expected to be associated with a contract.
      * If it's associated with an implicit account, @Morley.Client.resolveAddress@ will fail.
      * If it's associated with __both__ a contract and an implicit account,
        @Morley.Client.resolveAddress@ will return the contract address.

Parsing will fail on these inputs:
  * "tz1hZ7o4bhFTo6AXpWZsXzbnddEK3dSCv1S8"
  * "implicit:some-alias"

Refer to the 'HasCLReader' and @Morley.Client.Resolve@ instances for implementation details.
-}
type ContractAddressOrAlias = AddressOrAlias 'AddressKindContract

-- | Given an 'AddressOrAlias', prove it's @kind@ is well-defined (i.e. it has a 'SingI'
-- instance and satisfies 'L1AddressKind' constraint)
addressOrAliasKindSanity :: forall kind. AddressOrAlias kind -> Dict (L1AddressKind kind, SingI kind)
addressOrAliasKindSanity = \case
  AddressResolved addr -> Dict \\ addressKindSanity addr
  AddressAlias alias -> aliasKindSanity alias

{- This type is meant to be used to parse CLI options where either an address or an alias
of either a contract or an implicit account can be accepted.

Example inputs:
  * "KT1STb2aG7NpoBBNRggvummqsxNQZmuAVFvG": an address belonging to a contract
  * "tz1hZ7o4bhFTo6AXpWZsXzbnddEK3dSCv1S8": an address belonging to an implicit account
  * "contract:some-alias": an alias that is expected to be associated with a contract.
      * If it's associated with an implicit account, @Morley.Client.resolveAddress@ will fail.
  * "implicit:some-alias": an alias that is expected to be associated with an implicit account.
      * If it's associated with a contract, @Morley.Client.resolveAddress@ will fail.
  * "some-alias": an alias that is expected to be associated with either a contract or an implicit account.
      * If it's associated with __both__ a contract and an implicit account,
        @Morley.Client.resolveAddress@ will fail.

Refer to the 'HasCLReader' and @Morley.Client.Resolve@ instances for implementation details.
-}
data SomeAddressOrAlias where
  SAOAKindSpecified :: AddressOrAlias kind -> SomeAddressOrAlias
  SAOAKindUnspecified :: Text -> SomeAddressOrAlias

deriving stock instance Show SomeAddressOrAlias

-- | The output of 'build' should be parseable by the 'HasCLReader' instance.
instance Buildable SomeAddressOrAlias where
  build = \case
    SAOAKindUnspecified alias -> build alias
    SAOAKindSpecified aoa -> build aoa

instance HasCLReader SomeAddressOrAlias where
  getMetavar = "CONTRACT OR IMPLICIT ADDRESS OR ALIAS"
  getReader =
    Opt.str >>= \str ->
      case parseAddress str of
        Right (Constrained addr) ->
          case addr of
            ImplicitAddress{} -> pure $ SAOAKindSpecified $ AddressResolved addr
            ContractAddress{} -> pure $ SAOAKindSpecified $ AddressResolved addr
            SmartRollupAddress{} -> Opt.readerError $ "Unexpected smart rollup address: " <> pretty addr
        Left _ ->
          pure $
            parseAliasWithPrefix @'AddressKindImplicit str <|> parseAliasWithPrefix @'AddressKindContract str
              & fromMaybe (SAOAKindUnspecified str)
      where
        -- Try parsing an alias with an explicit kind prefix.
        parseAliasWithPrefix
          :: forall kind. (L1AddressKind kind, SingI kind)
          => Text
          -> Maybe SomeAddressOrAlias
        parseAliasWithPrefix str =
          T.stripPrefix (pretty $ aliasPrefix @kind <> ":") str <&> \alias ->
            SAOAKindSpecified $ AddressAlias $ mkAlias @kind alias

-- | The prefix used to specify whether an alias belongs to a contract or an implicit account.
aliasPrefix :: forall addressKind. (L1AddressKind addressKind, SingI addressKind) => Doc
aliasPrefix =
  usingImplicitOrContractKind @addressKind $
    build $ demote @addressKind

contractPrefix, implicitPrefix :: Doc
contractPrefix = aliasPrefix @'AddressKindContract
implicitPrefix = aliasPrefix @'AddressKindImplicit