Resolve.hs

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

-- | Utilities for resolving addresses and aliases.
module Morley.Client.TezosClient.Resolve
  ( ResolveError(..)
  , Resolve(..)
  , resolveAddress
  , resolveAddressMaybe
  , getAlias
  , getAliasMaybe
  , getTezosClientConfig
  , resolveAddressWithAlias
  , resolveAddressWithAliasMaybe
  ) where

import Data.Constraint ((\\))
import Fmt (pretty)

import Morley.Client.Logging
import Morley.Client.TezosClient.Class qualified as Class
import Morley.Client.TezosClient.Config
import Morley.Client.TezosClient.Types.Errors
import Morley.Client.Types
import Morley.Client.Types.AliasesAndAddresses
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Address.Kinds
import Morley.Util.Constrained

class Resolve addressOrAlias where
  type ResolvedAddress addressOrAlias :: Type
  type ResolvedAlias addressOrAlias :: Type
  type ResolvedAddressAndAlias addressOrAlias :: Type

  -- | Looks up the address associated with the given @addressOrAlias@.
  --
  -- When the alias is associated with __both__ an implicit and a contract address:
  --
  -- * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',
  --   unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.
  -- * The 'AddressOrAlias' instance will return the address with the requested kind.
  resolveAddressEither
    :: forall m env
     . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)
    => addressOrAlias
    -> m (Either ResolveError (ResolvedAddress addressOrAlias))

  {- | Looks up the alias associated with the given @addressOrAlias@.

  When the alias is associated with __both__ an implicit and a contract address:

  * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',
    unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.
  * The 'AddressOrAlias' instance will return the alias of the address with the requested kind.

  The primary (and probably only) reason this function exists is that
  @octez-client sign@ command only works with aliases. It was
  reported upstream: <https://gitlab.com/tezos/tezos/-/issues/836>.
  -}
  getAliasEither
    :: forall m env
     . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)
    => addressOrAlias
    -> m (Either ResolveError (ResolvedAlias addressOrAlias))

  -- | Resolve both address and alias at the same time
  resolveAddressWithAliasEither
    :: forall m env
     . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)
    => addressOrAlias
    -> m (Either ResolveError (ResolvedAddressAndAlias addressOrAlias))

instance Resolve (AddressOrAlias kind) where
  type ResolvedAddress (AddressOrAlias kind) = KindedAddress kind
  type ResolvedAlias (AddressOrAlias kind) = Alias kind
  type ResolvedAddressAndAlias (AddressOrAlias kind) = AddressWithAlias kind

  resolveAddressEither
    :: (Class.HasTezosClient m)
    => AddressOrAlias kind -> m (Either ResolveError (KindedAddress kind))
  resolveAddressEither = \case
    AddressResolved addr -> pure $ Right addr
    aoa@(AddressAlias alias) -> do
      aas <- Class.getAliasesAndAddresses
      pure $ lookupAddr alias aas
        & maybeToRight (handleMissing aas)
      where
        handleMissing :: AliasesAndAddresses -> ResolveError
        handleMissing aas
          = maybe (REAliasNotFound (pretty aoa)) (REWrongKind alias)
          $ case alias of
              -- notice kind is flipped
              ImplicitAlias aliasTxt -> Constrained <$> lookupAddr (ContractAlias aliasTxt) aas
              ContractAlias aliasTxt -> Constrained <$> lookupAddr (ImplicitAlias aliasTxt) aas

  getAliasEither
    :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)
    => AddressOrAlias kind -> m (Either ResolveError (Alias kind))
  getAliasEither = \case
    aoa@(AddressAlias alias) ->
      -- Check if the alias exists
      ($> alias) <$> resolveAddressEither aoa
    AddressResolved addr ->
      maybeToRight (REAddressNotFound addr) . lookupAlias addr <$> Class.getAliasesAndAddresses

  resolveAddressWithAliasEither addr =
    (liftA2 . liftA2) AddressWithAlias (resolveAddressEither addr) (getAliasEither addr)

instance Resolve SomeAddressOrAlias where
  type ResolvedAddress SomeAddressOrAlias = L1Address
  type ResolvedAlias SomeAddressOrAlias = SomeAlias
  type ResolvedAddressAndAlias SomeAddressOrAlias = Constrained L1AddressKind AddressWithAlias

  resolveAddressEither
    :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)
    => SomeAddressOrAlias -> m (Either ResolveError L1Address)
  resolveAddressEither = \case
    SAOAKindUnspecified aliasText -> do
      aas <- Class.getAliasesAndAddresses
      let contractAddress = lookupAddr (mkAlias @'AddressKindContract aliasText) aas
          implicitAddress = lookupAddr (mkAlias @'AddressKindImplicit aliasText) aas
      case (contractAddress, implicitAddress) of
        (Nothing, Nothing) -> pure $ Left $ REAliasNotFound aliasText
        (Just addr, Nothing) -> pure $ Right $ Constrained addr
        (Nothing, Just addr) -> pure $ Right $ Constrained addr
        (Just ca, Just ia) -> throwM $ AmbiguousAlias aliasText ca ia
    SAOAKindSpecified aoa ->
      fmap Constrained <$> resolveAddressEither aoa \\ addressOrAliasKindSanity aoa

  getAliasEither
    :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)
    => SomeAddressOrAlias -> m (Either ResolveError SomeAlias)
  getAliasEither = \case
    SAOAKindSpecified aoa -> do
      fmap SomeAlias
        <$> getAliasEither aoa \\ addressOrAliasKindSanity aoa
    aoa@SAOAKindUnspecified{} -> runExceptT do
      -- Find out whether this alias is associated with an implicit address or a contract,
      -- and return an @Alias kind@ of the correct kind.
      ExceptT (resolveAddressWithAliasEither aoa) <&> foldConstrained (SomeAlias . awaAlias)

  resolveAddressWithAliasEither addr = runExceptT case addr of
    SAOAKindSpecified aoa -> do
      kaddr <- ExceptT $ resolveAddressEither aoa
      kalias <- ExceptT $ getAliasEither aoa
      pure $ Constrained (AddressWithAlias kaddr kalias) \\ addressOrAliasKindSanity aoa
    aoa@(SAOAKindUnspecified aliasText) -> do
      ExceptT (resolveAddressEither aoa) <&> foldConstrained
        \kaddr -> Constrained $ AddressWithAlias kaddr $ mkAlias aliasText \\ addressKindSanity kaddr

-- | Looks up the address and alias with the given @addressOrAlias@.
resolveAddressWithAlias
  :: forall addressOrAlias m env
   . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias)
  => addressOrAlias
  -> m (ResolvedAddressAndAlias addressOrAlias)
resolveAddressWithAlias = resolveAddressWithAliasEither >=> either (throwM . ResolveError) pure

-- | Looks up the address and alias with the given @addressOrAlias@.
resolveAddressWithAliasMaybe
  :: forall addressOrAlias m env
   . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias)
  => addressOrAlias
  -> m (Maybe (ResolvedAddressAndAlias addressOrAlias))
resolveAddressWithAliasMaybe = fmap rightToMaybe . resolveAddressWithAliasEither

-- | Looks up the address associated with the given @addressOrAlias@.
--
-- Will throw a 'TezosClientError' if @addressOrAlias@ is an alias and:
--
-- * the alias does not exist.
-- * the alias exists but its address is of the wrong kind.
--
-- When the alias is associated with __both__ an implicit and a contract address:
--
-- * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',
--   unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.
-- * The 'AddressOrAlias' instance will return the address with the requested kind.
resolveAddress
  :: forall addressOrAlias m env
   . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias)
  => addressOrAlias
  -> m (ResolvedAddress addressOrAlias)
resolveAddress = resolveAddressEither >=> either (throwM . ResolveError) pure

-- | Looks up the address associated with the given @addressOrAlias@.
--
-- Will return 'Nothing' if @addressOrAlias@ is an alias and:
--
-- * the alias does not exist.
-- * the alias exists but its address is of the wrong kind.
--
-- When the alias is associated with __both__ an implicit and a contract address:
--
-- * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',
--   unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.
-- * The 'AddressOrAlias' instance will return the address with the requested kind.
resolveAddressMaybe
  :: forall addressOrAlias m env
   . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m, Resolve addressOrAlias)
  => addressOrAlias
  -> m (Maybe (ResolvedAddress addressOrAlias))
resolveAddressMaybe aoa = rightToMaybe <$> resolveAddressEither aoa

{- | Looks up the alias associated with the given @addressOrAlias@.

Will throw a 'TezosClientError' if @addressOrAlias@:

  * is an address that is not associated with any alias.
  * is an alias that does not exist.
  * is an alias that exists but its address is of the wrong kind.

When the alias is associated with __both__ an implicit and a contract address:

  * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',
    unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.
  * The 'AddressOrAlias' instance will return the alias.
-}
getAlias
  :: forall addressOrAlias m env
   . (Class.HasTezosClient m, WithClientLog env m, MonadThrow m, Resolve addressOrAlias)
  => addressOrAlias
  -> m (ResolvedAlias addressOrAlias)
getAlias = getAliasEither >=> either (throwM . ResolveError) pure

{- | Looks up the alias associated with the given @addressOrAlias@.

Will return 'Nothing' if @addressOrAlias@:

  * is an address that is not associated with any alias.
  * is an alias that does not exist.
  * is an alias that exists but its address is of the wrong kind.

When the alias is associated with __both__ an implicit and a contract address:

  * The 'SomeAddressOrAlias' instance will throw a 'TezosClientError',
    unless the alias is prefixed with @implicit:@ or @contract:@ to disambiguate.
  * The 'AddressOrAlias' instance will return the alias.
-}
getAliasMaybe
  :: forall addressOrAlias m env
   . (Class.HasTezosClient m, WithClientLog env m, MonadThrow m, Resolve addressOrAlias)
  => addressOrAlias
  -> m (Maybe (ResolvedAlias addressOrAlias))
getAliasMaybe aoa = rightToMaybe <$> getAliasEither aoa