Impl.hs

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

-- | Interface to the @octez-client@ executable expressed in Haskell types.

module Morley.Client.TezosClient.Impl
  ( TezosClientError (..)

  -- * @octez-client@ api
  , signBytes
  , rememberContract
  , importKey
  , genKey
  , genFreshKey
  , revealKey
  , ResolveError(..)
  , Resolve(..)
  , resolveAddress
  , resolveAddressMaybe
  , getAlias
  , getAliasMaybe
  , getPublicKey
  , getSecretKey
  , getTezosClientConfig
  , calcTransferFee
  , calcOriginationFee
  , calcRevealFee
  , getKeyPassword
  , registerDelegate
  , getAliasesAndAddresses

  -- * Internals
  , findAddress
  , FindAddressResult(..)
  , CallMode(..)
  , callTezosClient
  , callTezosClientStrict
  ) where

import Unsafe qualified ((!!))

import Colourista (formatWith, red)
import Control.Exception (IOException, throwIO)
import Data.Aeson (eitherDecodeStrict, encode)
import Data.ByteArray (ScrubbedBytes)
import Data.ByteString.Lazy.Char8 qualified as C (unpack)
import Data.Text qualified as T
import Fmt (Buildable(..), pretty, (+|), (|+))
import System.Exit (ExitCode(..))
import System.Process (readProcessWithExitCode)
import Text.Printf (printf)
import UnliftIO.IO (hGetEcho, hSetEcho)

import Data.Constraint ((\\))
import Data.Singletons (demote)
import Lorentz.Value
import Morley.Client.Logging
import Morley.Client.RPC.Types
import Morley.Client.TezosClient.Class (AliasBehavior(..))
import Morley.Client.TezosClient.Class qualified as Class (HasTezosClient(..))
import Morley.Client.TezosClient.Parser
import Morley.Client.TezosClient.Types
import Morley.Client.Util (readScrubbedBytes, scrubbedBytesToString)
import Morley.Micheline
import Morley.Michelson.Typed.Scope
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Address.Kinds
import Morley.Tezos.Crypto
import Morley.Util.Interpolate (itu)
import Morley.Util.Peano
import Morley.Util.Sing (castSing)
import Morley.Util.SizedList.Types

----------------------------------------------------------------------------
-- Errors
----------------------------------------------------------------------------

-- | A data type for all /predicatable/ errors that can happen during
-- @octez-client@ usage.
data TezosClientError =
    UnexpectedClientFailure
    -- ^ @octez-client@ call unexpectedly failed (returned non-zero exit code).
    -- The error contains the error code, stdout and stderr contents.
      Int -- ^ Exit code
      Text -- ^ stdout
      Text -- ^ stderr

  -- These errors represent specific known scenarios.
  | AlreadyRevealed
    -- ^ Public key of the given address is already revealed.
      ImplicitAlias -- ^ Address alias that has already revealed its key
  | InvalidOperationHash
    -- ^ Can't wait for inclusion of operation with given hash because
    -- the hash is invalid.
      OperationHash
  | CounterIsAlreadyUsed
    -- ^ Error that indicates when given counter is already used for
    -- given contract.
    Text -- ^ Raw counter
    Text -- ^ Raw address
  | EConnreset
    -- ^ Network error with which @octez-client@ fails from time to time.

  -- Note: the errors below most likely indicate that something is wrong in our code.
  -- Maybe we made a wrong assumption about @octez-client@ or just didn't consider some case.
  -- Another possible reason that a broken @octez-client@ is used.
  | ConfigParseError String
  -- ^ A parse error occurred during config parsing.
  | TezosClientCryptoParseError Text CryptoParseError
  -- ^ @octez-client@ produced a cryptographic primitive that we can't parse.
  | TezosClientParseAddressError Text ParseAddressError
  -- ^ @octez-client@ produced an address that we can't parse.
  | TezosClientParseFeeError Text Text
  -- ^ @octez-client@ produced invalid output for parsing baker fee
  | TezosClientUnexpectedOutputFormat Text
  -- ^ @octez-client@ printed a string that doesn't match the format we expect.
  | CantRevealContract
    -- ^ Given alias is a contract and cannot be revealed.
    ImplicitAlias -- ^ Address alias of implicit account
  | ContractSender ContractAddress Text
    -- ^ Given contract is a source of a transfer or origination operation.
  | EmptyImplicitContract
    -- ^ Given alias is an empty implicit contract.
    ImplicitAlias -- ^ Address alias of implicit contract
  | TezosClientUnexpectedSignatureOutput Text
  -- ^ @octez-client sign bytes@ produced unexpected output format
  | TezosClientParseEncryptionTypeError Text Text
  -- ^ @octez-client@ produced invalid output for parsing secret key encryption type.
  | DuplicateAlias Text
  -- ^ Tried to save alias, but such alias already exists.
  | AmbiguousAlias Text ContractAddress ImplicitAddress
  -- ^ Expected an alias to be associated with either an implicit address or a
  -- contract address, but it was associated with both.
  | AliasTxRollup Text (KindedAddress 'AddressKindTxRollup)
  -- ^ Expected an alias to be associated with either
  -- an implicit address or a contract address,
  -- but it was associated with a transaction rollup address.
  | ResolveError ResolveError

deriving stock instance Show TezosClientError

instance Exception TezosClientError where
  displayException = pretty

instance Buildable TezosClientError where
  build = \case
    UnexpectedClientFailure errCode output errOutput ->
      "`octez-client` unexpectedly failed with error code " +| errCode |+
      ". Stdout:\n" +| output |+ "\nStderr:\n" +| errOutput |+ ""
    AlreadyRevealed alias ->
      "The address alias " <> build alias <> " is already revealed"
    InvalidOperationHash hash ->
      "Can't wait for inclusion of operation " <> build hash <>
      " because this hash is invalid."
    CounterIsAlreadyUsed counter addr ->
      "Counter " +| counter |+ " already used for " +| addr |+ "."
    EConnreset -> "`octez-client` call failed with 'Unix.ECONNRESET' error."
    ConfigParseError err ->
      "A parse error occurred during config parsing: " <> build err
    TezosClientCryptoParseError txt err ->
      "`octez-client` produced a cryptographic primitive that we can't parse: " +|
      txt |+ ".\n The error is: " +| err |+ "."
    TezosClientParseAddressError txt err ->
      "`octez-client` produced an address that we can't parse: " +|
      txt |+ ".\n The error is: " +| err |+ "."
    TezosClientParseFeeError txt err ->
      "`octez-client` produced invalid output for parsing baker fee: " +|
      txt |+ ".\n Parsing error is: " +| err |+ ""
    TezosClientUnexpectedOutputFormat txt ->
      "`octez-client` printed a string that doesn't match the format we expect:\n" <>
      build txt
    CantRevealContract alias ->
      "Contracts (" <> build alias <> ") cannot be revealed"
    ContractSender addr opName ->
      "Contract (" <> build addr <> ") cannot be source of " +| opName |+ ""
    EmptyImplicitContract alias ->
      "Empty implicit contract (" <> build alias <> ")"
    TezosClientUnexpectedSignatureOutput txt ->
      "`octez-client sign bytes` call returned a signature in format we don't expect:\n" <>
      build txt
    TezosClientParseEncryptionTypeError txt err ->
      "`octez-client` produced invalid output for parsing secret key encryption type: " +|
      txt |+ ".\n Parsing error is: " +| err |+ ""
    DuplicateAlias alias -> "Attempted to save alias '" +| alias |+ "', but it already exists"
    AmbiguousAlias aliasText contractAddr implicitAddr ->
      [itu|
        The alias '#{aliasText}' is assigned to both:
          * a contract address: #{contractAddr}
          * and an implicit address: #{implicitAddr}
        Use '#{contractPrefix}:#{aliasText}' or '#{implicitPrefix}:#{aliasText}' to disambiguate.
        |]
    AliasTxRollup aliasText txRollupAddr ->
      [itu|
        Expected the alias '#{aliasText}' to be assigned to either a contract or an implicit account,
        but it's assigned to a transaction rollup address: #{txRollupAddr}.
        |]
    ResolveError err -> build err

----------------------------------------------------------------------------
-- API
----------------------------------------------------------------------------

-- Note: if we try to sign with an unknown alias, @octez-client@ will
-- report a fatal error (assert failure) to stdout. It's bad. It's
-- reported in two issues: https://gitlab.com/tezos/tezos/-/issues/653
-- and https://gitlab.com/tezos/tezos/-/issues/813.
-- I (@gromak) currently think it's better to wait for it to be resolved upstream.
-- Currently we will throw 'TezosClientUnexpectedOutputFormat' error.
-- | Sign an arbtrary bytestring using @octez-client@.
-- Secret key of the address corresponding to give 'AddressOrAlias' must be known.
signBytes
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, Class.HasTezosClient m)
  => ImplicitAddressOrAlias
  -> Maybe ScrubbedBytes
  -> ByteString
  -> m Signature
signBytes signer mbPassword opHash = do
  signerAlias <- getAlias signer
  logDebug $ "Signing for " <> pretty signer
  output <- callTezosClientStrict
    ["sign", "bytes", toCmdArg opHash, "for", toCmdArg signerAlias] MockupMode mbPassword
  liftIO case T.stripPrefix "Signature: " output of
    Nothing ->
      -- There is additional noise in the stdout in case key is password protected
      case T.stripPrefix "Enter password for encrypted key: Signature: " output of
        Nothing -> throwM $ TezosClientUnexpectedSignatureOutput output
        Just signatureTxt -> txtToSignature signatureTxt
    Just signatureTxt -> txtToSignature signatureTxt
  where
    txtToSignature :: MonadCatch m => Text -> m Signature
    txtToSignature signatureTxt = either (throwM . TezosClientCryptoParseError signatureTxt) pure $
      parseSignature . T.strip $ signatureTxt

-- | Generate a new secret key and save it with given alias.
-- If an address with given alias already exists, it will be returned
-- and no state will be changed.
genKey
  :: ( MonadThrow m, MonadCatch m, WithClientLog env m, HasTezosClientEnv env, MonadIO m
     , Class.HasTezosClient m)
  => ImplicitAlias
  -> m ImplicitAddress
genKey name = do
  let
    isAlreadyExistsError :: Text -> Bool
    -- We can do a bit better here using more complex parsing if necessary.
    isAlreadyExistsError = T.isInfixOf "already exists."

    errHandler _ errOut = pure (isAlreadyExistsError errOut)

  _ <-
    callTezosClient errHandler
    ["gen", "keys", toCmdArg name] MockupMode Nothing
  resolveAddress (AddressAlias name)

-- | Generate a new secret key and save it with given alias.
-- If an address with given alias already exists, it will be removed
-- and replaced with a fresh one.
genFreshKey
  :: ( MonadThrow m, MonadCatch m, WithClientLog env m, HasTezosClientEnv env, MonadIO m
     , Class.HasTezosClient m)
  => ImplicitAlias
  -> m ImplicitAddress
genFreshKey name = do
  let
    isNoAliasError :: Text -> Bool
    -- We can do a bit better here using more complex parsing if necessary.
    isNoAliasError = T.isInfixOf "no public key hash alias named"

    errHandler _ errOutput = pure (isNoAliasError errOutput)

  _ <-
    callTezosClient errHandler
    ["forget", "address", toCmdArg name, "--force"] MockupMode Nothing
  callTezosClientStrict ["gen", "keys", toCmdArg name] MockupMode Nothing
  resolveAddress (AddressAlias name)

-- | Reveal public key corresponding to the given alias.
-- Fails if it's already revealed.
revealKey
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => ImplicitAlias
  -> Maybe ScrubbedBytes
  -> m ()
revealKey alias mbPassword = do
  logDebug $ "Revealing key for " +| alias |+ ""
  let
    alreadyRevealed = T.isInfixOf "previously revealed"
    revealedImplicitAccount = T.isInfixOf "only implicit accounts can be revealed"
    emptyImplicitContract = T.isInfixOf "Empty implicit contract"
    errHandler _ errOut =
      False <$ do
        when (alreadyRevealed errOut) (throwM (AlreadyRevealed alias))
        when (revealedImplicitAccount errOut) (throwM (CantRevealContract alias))
        when (emptyImplicitContract errOut) (throwM (EmptyImplicitContract alias))

  _ <-
    callTezosClient errHandler
    ["reveal", "key", "for", toCmdArg alias] ClientMode mbPassword

  logDebug $ "Successfully revealed key for " +| alias |+ ""

-- | Register alias as delegate
registerDelegate
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => ImplicitAlias
  -> Maybe ScrubbedBytes
  -> m ()
registerDelegate alias mbPassword = do
  logDebug $ "Registering " +| alias |+ " as delegate"
  let
    emptyImplicitContract = T.isInfixOf "Empty implicit contract"
    errHandler _ errOut =
      False <$ do
        when (emptyImplicitContract errOut) (throwM (EmptyImplicitContract alias))

  _ <-
    callTezosClient errHandler
    ["register", "key", toCmdArg alias, "as", "delegate"] ClientMode mbPassword

  logDebug $ "Successfully registered " +| alias |+ " as delegate"

-- | Call @octez-client@ to list known addresses or contracts
callListKnown
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => String -> m Text
callListKnown objects =
  callTezosClientStrict ["list", "known", objects] MockupMode Nothing

-- | Return 'PublicKey' corresponding to given 'AddressOrAlias'.
getPublicKey
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, Class.HasTezosClient m)
  => ImplicitAddressOrAlias
  -> m PublicKey
getPublicKey addrOrAlias = do
  alias <- getAlias addrOrAlias
  logDebug $ "Getting " +| alias |+ " public key"
  output <- callTezosClientStrict ["show", "address", toCmdArg alias] MockupMode Nothing
  liftIO case lines output of
    _ : [rawPK] -> do
      pkText <- maybe
        (throwM $ TezosClientUnexpectedOutputFormat rawPK) pure
        (T.stripPrefix "Public Key: " rawPK)
      either (throwM . TezosClientCryptoParseError pkText) pure $
        parsePublicKey pkText
    _ -> throwM $ TezosClientUnexpectedOutputFormat output

-- | Return 'SecretKey' corresponding to given 'AddressOrAlias'.
getSecretKey
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, Class.HasTezosClient m)
  => ImplicitAddressOrAlias
  -> m SecretKey
getSecretKey addrOrAlias = do
  alias <- getAlias addrOrAlias
  logDebug $ "Getting " +| alias |+ " secret key"
  output <- callTezosClientStrict ["show", "address", toCmdArg alias, "--show-secret"] MockupMode Nothing
  liftIO case lines output of
    _ : _ : [rawSK] -> do
      skText <- maybe
        (throwM $ TezosClientUnexpectedOutputFormat rawSK) pure
        (T.stripPrefix "Secret Key: " rawSK)
      either (throwM . TezosClientCryptoParseError skText) pure $
        parseSecretKey skText
    _ -> throwM $ TezosClientUnexpectedOutputFormat output

-- | Save a contract with given address and alias.
-- If @replaceExisting@ is @False@ and a contract with given alias
-- already exists, this function does nothing.
rememberContract
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => AliasBehavior
  -> ContractAddress
  -> ContractAlias
  -> m ()
rememberContract aliasBehavior address alias = case aliasBehavior of
  DontSaveAlias ->
    logInfo $ "Not saving " +| address |+ " as " +| alias |+ " as requested"
  OverwriteDuplicateAlias ->
    void $ callTezosClient (\_ _ -> pure False) (args <> ["--force"]) MockupMode Nothing
  _ -> do
    let errHandler _ errOut
          | isAlreadyExistsError errOut = case aliasBehavior of
              KeepDuplicateAlias -> pure True
              ForbidDuplicateAlias -> throwM $ DuplicateAlias $ unAlias alias
          | otherwise = pure False
    void $ callTezosClient errHandler args MockupMode Nothing
  where
    args = ["remember", "contract", toCmdArg alias, pretty address]
    isAlreadyExistsError = T.isInfixOf "already exists"

importKey
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => Bool
  -> ImplicitAlias
  -> SecretKey
  -> m ImplicitAlias
importKey replaceExisting name key = do
  let
    isAlreadyExistsError = T.isInfixOf "already exists"
    errHandler _ errOut = pure (isAlreadyExistsError errOut)
    args = ["import", "secret", "key", toCmdArg name, toCmdArg key]
  _ <-
    callTezosClient errHandler
    (if replaceExisting then args <> ["--force"] else args)
    MockupMode Nothing
  pure name

-- | Read @octez-client@ configuration.
getTezosClientConfig :: FilePath -> Maybe FilePath -> IO TezosClientConfig
getTezosClientConfig client mbDataDir = do
  t <- readProcessWithExitCode' client
    (maybe [] (\dir -> ["-d", dir]) mbDataDir ++  ["config", "show"]) ""
  case t of
    (ExitSuccess, toText -> output, _) -> case eitherDecodeStrict . encodeUtf8 . toText $ output of
        Right config -> pure config
        Left err -> throwM $ ConfigParseError err
    (ExitFailure errCode, toText -> output, toText -> errOutput) ->
      throwM $ UnexpectedClientFailure errCode output errOutput

-- | Calc baker fee for transfer using @octez-client@.
calcTransferFee
  :: ( WithClientLog env m, HasTezosClientEnv env
     , MonadIO m, MonadCatch m
     )
  => AddressOrAlias kind
  -> Maybe ScrubbedBytes
  -> TezosInt64
  -> [CalcTransferFeeData]
  -> m [TezosMutez]
calcTransferFee from mbPassword burnCap transferFeeDatas = do
  output <- callTezosClientStrict
    [ "multiple", "transfers", "from", pretty from, "using"
    , C.unpack $ encode transferFeeDatas, "--burn-cap", showBurnCap burnCap, "--dry-run"
    ] ClientMode mbPassword
  withSomePeano (fromIntegralOverflowing $ length transferFeeDatas) $
    \(_ :: Proxy n) -> toList <$> feeOutputParser @n output

-- | Calc baker fee for origination using @octez-client@.
calcOriginationFee
  :: ( UntypedValScope st, WithClientLog env m, HasTezosClientEnv env
     , MonadIO m, MonadCatch m
     )
  => CalcOriginationFeeData cp st -> m TezosMutez
calcOriginationFee CalcOriginationFeeData{..} = do
  output <- callTezosClientStrict
    [ "originate", "contract", "-", "transferring"
    , showTez cofdBalance
    , "from", pretty cofdFrom, "running"
    , toCmdArg cofdContract, "--init"
    , toCmdArg cofdStorage, "--burn-cap"
    , showBurnCap cofdBurnCap, "--dry-run"
    ] ClientMode cofdMbFromPassword
  fees <- feeOutputParser @1 output
  case fees of
    singleFee :< Nil -> return singleFee

-- | Calc baker fee for revealing using @octez-client@.
--
-- Note that @octez-client@ does not support passing an address here,
-- at least at the moment of writing.
calcRevealFee
  :: ( WithClientLog env m, HasTezosClientEnv env
     , MonadIO m, MonadCatch m
     )
  => ImplicitAlias -> Maybe ScrubbedBytes -> TezosInt64 -> m TezosMutez
calcRevealFee alias mbPassword burnCap = do
  output <- callTezosClientStrict
    [ "reveal", "key", "for", toCmdArg alias
    , "--burn-cap", showBurnCap burnCap
    , "--dry-run"
    ] ClientMode mbPassword
  fees <- feeOutputParser @1 output
  case fees of
    singleFee :< Nil -> return singleFee

feeOutputParser :: forall n m. (SingIPeano n, MonadIO m, MonadThrow m) => Text -> m (SizedList n TezosMutez)
feeOutputParser output =
  case parseBakerFeeFromOutput @n output of
    Right fee -> return fee
    Left err -> throwM $ TezosClientParseFeeError output $ pretty err

showBurnCap :: TezosInt64 -> String
showBurnCap x = printf "%.6f" $ (fromIntegralToRealFrac @TezosInt64 @Float x) / 1000

showTez :: TezosMutez -> String
showTez = toCmdArg . unTezosMutez

-- | Get password for secret key associated with given address
-- in case this key is password-protected
getKeyPassword
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadMask m, Class.HasTezosClient m)
  => ImplicitAddress -> m (Maybe ScrubbedBytes)
getKeyPassword key = (getAlias $ AddressResolved key) >>= getKeyPassword'
  where
    getKeyPassword'
      :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m, MonadMask m)
      => ImplicitAlias -> m (Maybe ScrubbedBytes)
    getKeyPassword' alias = do
      output <- callTezosClientStrict [ "show", "address", pretty alias, "-S"] MockupMode Nothing
      encryptionType <-
        case parseSecretKeyEncryption output of
          Right t -> return t
          Left err -> throwM $ TezosClientParseEncryptionTypeError output $ pretty err
      case encryptionType of
        EncryptedKey -> do
          putTextLn $ "Please enter password for '" <> pretty alias <> "':"
          Just <$> withoutEcho readScrubbedBytes
        _ -> pure Nothing

    -- Hide entered password
    withoutEcho :: (MonadIO m, MonadMask m) => m a -> m a
    withoutEcho action = do
      old <- hGetEcho stdin
      bracket_ (hSetEcho stdin False) (hSetEcho stdin old) action

----------------------------------------------------------------------------
-- Helpers
-- All interesting @octez-client@ functionality is supposed to be
-- exported as functions with types closely resembling inputs of
-- respective @octez-client@ functions. If something is not
-- available, consider adding it here. But if it is not feasible,
-- you can use these two functions directly to constructor a custom
-- @octez-client@ call.
----------------------------------------------------------------------------

-- | Datatype that represents modes for calling node from @octez-client@.
data CallMode
  = MockupMode
  -- ^ Mode in which @octez-client@ doesn't perform any actual RPC calls to the node
  -- and use mock instead.
  | ClientMode
  -- ^ Normal mode in which @octez-client@ performs all necessary RPC calls to the node.

-- | Call @octez-client@ with given arguments. Arguments defined by
-- config are added automatically. The second argument specifies what
-- should be done in failure case. It takes stdout and stderr
-- output. Possible handling:
--
-- 1. Parse a specific error and throw it.
-- 2. Parse an expected error that shouldn't cause a failure.
-- Return @True@ in this case.
-- 3. Detect an unexpected error, return @False@.
-- In this case 'UnexpectedClientFailure' will be throw.
callTezosClient
  :: forall env m. (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => (Text -> Text -> IO Bool) -> [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClient errHandler args mode mbInput = retryEConnreset mode $ do
  TezosClientEnv {..} <- view tezosClientEnvL
  let
    extraArgs :: [String]
    extraArgs = mconcat
      [ ["-E", toCmdArg tceEndpointUrl]
      , maybe [] (\dir -> ["-d", dir]) tceMbTezosClientDataDir
      , ["--mode", case mode of
            MockupMode -> "mockup"
            ClientMode -> "client"
        ]
      ]

    allArgs = extraArgs ++ args
  logDebug $ "Running: " <> unwords (toText <$> tceTezosClientPath:allArgs)
  let
    ifNotEmpty prefix output
      | null output = ""
      | otherwise = prefix <> ":\n" <> output
    logOutput :: Text -> Text -> m ()
    logOutput output errOutput = logDebug $
      ifNotEmpty "stdout" output <>
      ifNotEmpty "stderr" errOutput

  liftIO (readProcessWithExitCode' tceTezosClientPath allArgs
          (maybe "" scrubbedBytesToString mbInput)) >>= \case
    (ExitSuccess, toText -> output, toText -> errOutput) ->
      output <$ logOutput output errOutput
    (ExitFailure errCode, toText -> output, toText -> errOutput) -> do
      checkCounterError errOutput
      checkEConnreset errOutput
      liftIO $ unlessM (errHandler output errOutput) $
        throwM $ UnexpectedClientFailure errCode output errOutput

      output <$ logOutput output errOutput
  where
    checkCounterError
      :: Text -> m ()
    checkCounterError errOutput |
      "Counter" `T.isPrefixOf` errOutput && "already used for contract" `T.isInfixOf` errOutput = do
        let splittedErrOutput = words errOutput
        liftIO $ throwM $
          CounterIsAlreadyUsed (splittedErrOutput Unsafe.!! 1) (splittedErrOutput Unsafe.!! 5)
    checkCounterError _ = pass
    checkEConnreset :: Text -> m ()
    checkEConnreset errOutput
      | "Unix.ECONNRESET" `T.isInfixOf` errOutput = throwM EConnreset
    checkEConnreset _ = pass

    -- Helper function that retries @octez-client@ call action in case of @ECONNRESET@.
    -- Note that this error cannot appear in case of 'MockupMode' call.
    retryEConnreset :: CallMode -> m a -> m a
    retryEConnreset MockupMode action = action
    retryEConnreset ClientMode action = retryEConnresetImpl 0 action

    retryEConnresetImpl :: Integer -> m a -> m a
    retryEConnresetImpl attempt action = action `catch` \err -> do
      case err of
        EConnreset ->
          if attempt >= maxRetryAmount then throwM err
          else retryEConnresetImpl (attempt + 1) action
        anotherErr -> throwM anotherErr

    maxRetryAmount = 5

-- | Call @octez-client@ and expect success.
callTezosClientStrict
  :: (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => [String] -> CallMode -> Maybe ScrubbedBytes -> m Text
callTezosClientStrict args mode mbInput = callTezosClient errHandler args mode mbInput
  where
    errHandler _ _ = pure False

-- | Variant of @readProcessWithExitCode@ that prints a better error in case of
-- an exception in the inner @readProcessWithExitCode@ call.
readProcessWithExitCode'
  :: FilePath
  -> [String]
  -> String
  -> IO (ExitCode, String, String)
readProcessWithExitCode' fp args inp =
  catch
    (readProcessWithExitCode fp args inp) handler
  where
    handler :: IOException -> IO (ExitCode, String, String)
    handler e = do
      hPutStrLn @Text stderr $ formatWith [red] errorMsg
      throwIO e

    errorMsg =
      "ERROR!! There was an error in executing `" <> toText fp <> "` program. Is the \
      \ executable available in PATH ?"

data ResolveError where
  REAliasNotFound :: Text -> ResolveError
  -- ^ Could not find an address with given alias.
  REWrongKind :: Alias expectedKind -> Address -> ResolveError
  -- ^ Expected an alias to be associated with an implicit address, but it was
  -- associated with a contract address, or vice-versa.
  REAddressNotFound :: KindedAddress kind -> ResolveError
  -- ^ Could not find an alias with given address.

deriving stock instance Show ResolveError

instance Buildable ResolveError where
  build = \case
    REWrongKind (alias :: Alias expectedKind) (Constrained (addr :: KindedAddress actualKind)) ->
      [itu|
        Expected the alias '#{alias}' to be assigned to an address of kind '#{demotedExpectedKind}',
        but it's assigned to an address of kind '#{demotedActualKind}': #{addr}.
        |]
      where
        demotedExpectedKind = demote @expectedKind \\ aliasKindSanity alias :: AddressKind
        demotedActualKind = demote @actualKind \\ addressKindSanity addr :: AddressKind
    REAliasNotFound aliasText ->
      [itu|Could not find the alias '#{aliasText}'.|]
    REAddressNotFound addr ->
      [itu|Could not find an alias for the address '#{addr}'.|]

class Resolve addressOrAlias where
  type ResolvedAddress addressOrAlias :: Type
  type ResolvedAlias 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))

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

  resolveAddressEither
    :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)
    => AddressOrAlias kind -> m (Either ResolveError (KindedAddress kind))
  resolveAddressEither = \case
    AddressResolved addr -> pure $ Right addr
    aoa@(AddressAlias alias) -> do
      findAddress (unAlias alias) >>= \case
        FARNone -> pure $ Left $ REAliasNotFound (pretty aoa)
        FARUnambiguous (Constrained addr) ->
          pure $ maybeToRight (REWrongKind alias (Constrained addr)) $
            castSing addr \\ addressKindSanity addr \\ aliasKindSanity alias
        FARAmbiguous contractAddr implicitAddr ->
          withDict (aliasKindSanity alias) $
            usingImplicitOrContractKind @kind
              case sing @kind of
                SAddressKindContract -> pure $ Right contractAddr
                SAddressKindImplicit -> pure $ Right implicitAddr

  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 -> do
      aliasesAndAddresses <- Class.getAliasesAndAddresses
      case fst <$> find (\(_, addr') -> addr' == pretty addr) aliasesAndAddresses of
        Nothing -> pure $ Left $ REAddressNotFound addr
        Just aliasText -> do
          -- This alias _might_ belong to both an implicit account and a contract,
          -- in which case it might be prefixed with "key".
          -- If so, we have to strip the prefix.
          let aliasTextWithoutPrefix = fromMaybe aliasText $ T.stripPrefix "key:" aliasText
          pure $ Right $ mkAlias @kind aliasTextWithoutPrefix \\ addressKindSanity addr

instance Resolve SomeAddressOrAlias where
  type ResolvedAddress SomeAddressOrAlias = L1Address
  type ResolvedAlias SomeAddressOrAlias = SomeAlias

  resolveAddressEither
    :: (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)
    => SomeAddressOrAlias -> m (Either ResolveError L1Address)
  resolveAddressEither = \case
    SAOAKindUnspecified aliasText -> do
      findAddress aliasText >>= \case
        FARNone -> pure $ Left $ REAliasNotFound aliasText
        FARUnambiguous addr -> pure $ Right addr
        FARAmbiguous contractAddr implicitAddr -> throwM $ AmbiguousAlias aliasText contractAddr implicitAddr
    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 aliasText) -> do
      -- Find out whether this alias is associated with an implicit address or a contract,
      -- and return an @Alias kind@ of the correct kind.
      resolveAddressEither aoa <&> fmap
        \(Constrained (addr :: KindedAddress kind)) ->
          SomeAlias $ mkAlias @kind aliasText \\ addressKindSanity addr

-- | 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

{- | Finds the implicit/contract addresses assigned to the given alias.

Note that an alias can be ambiguous: it can refer to __both__ a contract and an
implicit account. When an alias "abc" is ambiguous, @octez-client list known
contracts@ will return two entries with the following format:

> abc: KT1...
> key:abc: tz1...

So, in order to check whether the alias is ambiguous, we check whether both
"abc" and "key:abc" are present in the output.

If only "abc" is present, then we know it's not ambiguous (and it refers to
__either__ a contract or an implicit account).
-}
findAddress
  :: forall m env
   . (Class.HasTezosClient m, MonadThrow m, WithClientLog env m)
  => Text
  -> m FindAddressResult
findAddress aliasText = do
  logDebug $ "Resolving " +| aliasText |+ ""
  aliasesAndAddresses <- Class.getAliasesAndAddresses

  let find' alias = snd <$> find (\(alias', _) -> alias' == alias) aliasesAndAddresses

  case (find' aliasText, find' ("key:" <> aliasText)) of
    (Nothing, _) -> pure FARNone
    (Just firstMatch, Nothing) -> FARUnambiguous <$> parseL1Address firstMatch
    (Just contractAddrText, Just implicitAddrText) -> do
      contractAddr <-
        either (throwM . TezosClientParseAddressError contractAddrText) pure $
          parseKindedAddress @'AddressKindContract contractAddrText
      implicitAddr <-
        either (throwM . TezosClientParseAddressError implicitAddrText) pure $
          parseKindedAddress @'AddressKindImplicit implicitAddrText
      pure $ FARAmbiguous contractAddr implicitAddr
  where
    parseL1Address :: Text -> m L1Address
    parseL1Address addrText =
      either (throwM . TezosClientParseAddressError addrText) pure .
      parseConstrainedAddress $ addrText

-- | Whether an alias is associated with an implicit address, a contract address, or both.
data FindAddressResult
  = FARUnambiguous L1Address
  | FARAmbiguous ContractAddress ImplicitAddress
  | FARNone

{- | Calls @octez-client list known contracts@ and returns
a list of @(alias, address)@ pairs.

Note that an alias can be ambiguous: it can refer to __both__ a contract and an implicit account.
When an alias "abc" is ambiguous, the list will contain two entries:

> ("abc", "KT1...")
> ("key:abc", "tz1...")
-}
getAliasesAndAddresses
  :: forall m env
   . (WithClientLog env m, HasTezosClientEnv env, MonadIO m, MonadCatch m)
  => m [(Text, Text)]
getAliasesAndAddresses =
  parseOutput <$> callListKnown "contracts"
  where
    parseOutput :: Text -> [(Text, Text)]
    parseOutput = fmap parseLine . lines

    -- Note: each line has the format "<alias>: <address>"
    parseLine :: Text -> (Text, Text)
    parseLine = first (T.dropEnd 2) . T.breakOnEnd ": "