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

-- | Various error types.
module Morley.Client.TezosClient.Types.Errors
  ( TezosClientError (..)
  , ResolveError(..)
  ) where

import Fmt (Buildable(..), pretty, (+|), (|+))

import Data.Constraint ((\\))
import Data.Singletons (demote)
import Data.Text qualified as T
import Lorentz.Value
import Morley.Client.RPC.Types
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Address.Kinds
import Morley.Tezos.Crypto
import Morley.Util.Constrained
import Morley.Util.Interpolate (itu)

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

deriving stock instance Show TezosClientError

instance Exception TezosClientError where
  displayException :: TezosClientError -> String
displayException = TezosClientError -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty

instance Buildable TezosClientError where
  build :: TezosClientError -> Doc
build = \case
    UnexpectedClientFailure Int
errCode Text
output Text
errOutput ->
      Doc
"`octez-client` unexpectedly failed with error code " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Int
errCode Int -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+
      Doc
". Stdout:\n" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Text
output Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"\nStderr:\n" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Text
errOutput Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
    AlreadyRevealed ImplicitAlias
alias ->
      Doc
"The address alias " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ImplicitAlias -> Doc
forall a. Buildable a => a -> Doc
build ImplicitAlias
alias Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" is already revealed"
    InvalidOperationHash OperationHash
hash ->
      Doc
"Can't wait for inclusion of operation " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> OperationHash -> Doc
forall a. Buildable a => a -> Doc
build OperationHash
hash Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
      Doc
" because this hash is invalid."
    CounterIsAlreadyUsed Text
counter Text
addr ->
      Doc
"Counter " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Text
counter Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
" already used for " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Text
addr Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"."
    TezosClientError
EConnreset -> Doc
"`octez-client` call failed with 'Unix.ECONNRESET' error."
    ConfigParseError String
err ->
      Doc
"A parse error occurred during config parsing: " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
forall a. Buildable a => a -> Doc
build String
err
    TezosClientCryptoParseError Text
txt CryptoParseError
err ->
      Doc
"`octez-client` produced a cryptographic primitive that we can't parse: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+|
      Text
txt Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
".\n The error is: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| CryptoParseError
err CryptoParseError -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"."
    TezosClientParseAddressError Text
txt ParseAddressError
err ->
      Doc
"`octez-client` produced an address that we can't parse: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+|
      Text
txt Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
".\n The error is: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| ParseAddressError
err ParseAddressError -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"."
    TezosClientParseFeeError Text
txt Text
err ->
      Doc
"`octez-client` produced invalid output for parsing baker fee: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+|
      Text
txt Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
".\n Parsing error is: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Text
err Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
    TezosClientUnexpectedOutputFormat Text
txt ->
      Doc
"`octez-client` printed a string that doesn't match the format we expect:\n" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
      Text -> Doc
forall a. Buildable a => a -> Doc
build Text
txt
    CantRevealContract ImplicitAlias
alias ->
      Doc
"Contracts (" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ImplicitAlias -> Doc
forall a. Buildable a => a -> Doc
build ImplicitAlias
alias Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
") cannot be revealed"
    ContractSender ContractAddress
addr Text
opName ->
      Doc
"Contract (" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ContractAddress -> Doc
forall a. Buildable a => a -> Doc
build ContractAddress
addr Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
") cannot be source of " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Text
opName Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
    EmptyImplicitContract ImplicitAlias
alias ->
      Doc
"Empty implicit contract (" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ImplicitAlias -> Doc
forall a. Buildable a => a -> Doc
build ImplicitAlias
alias Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
")"
    TezosClientUnexpectedSignatureOutput Text
txt ->
      Doc
"`octez-client sign bytes` call returned a signature in format we don't expect:\n" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
      Text -> Doc
forall a. Buildable a => a -> Doc
build Text
txt
    TezosClientParseEncryptionTypeError Text
txt Text
err ->
      Doc
"`octez-client` produced invalid output for parsing secret key encryption type: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+|
      Text
txt Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
".\n Parsing error is: " Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Text
err Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
""
    DuplicateAlias Text
alias -> Doc
"Attempted to save alias '" Doc -> Doc -> Doc
forall b. FromDoc b => Doc -> Doc -> b
+| Text
alias Text -> Doc -> Doc
forall a b. (Buildable a, FromDoc b) => a -> Doc -> b
|+ Doc
"', but it already exists"
    ResolveError ResolveError
err -> ResolveError -> Doc
forall a. Buildable a => a -> Doc
build ResolveError
err

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.
  REAmbiguousAlias :: Text -> [L1Address] -> ResolveError
  -- ^ Expected an alias to be associated with either an implicit address or a
  -- contract address, but it was associated with both.

deriving stock instance Show ResolveError

instance Buildable ResolveError where
  build :: ResolveError -> Doc
build = \case
    REWrongKind (Alias expectedKind
alias :: Alias expectedKind) (Constrained (KindedAddress a
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 :: AddressKind
demotedExpectedKind = forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: AddressKind).
(SingKind AddressKind, SingI a) =>
Demote AddressKind
demote @expectedKind ((L1AddressKind expectedKind, SingI expectedKind) => AddressKind)
-> Dict (L1AddressKind expectedKind, SingI expectedKind)
-> AddressKind
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ Alias expectedKind
-> Dict (L1AddressKind expectedKind, SingI expectedKind)
forall (kind :: AddressKind).
Alias kind -> Dict (L1AddressKind kind, SingI kind)
aliasKindSanity Alias expectedKind
alias :: AddressKind
        demotedActualKind :: AddressKind
demotedActualKind = forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: AddressKind).
(SingKind AddressKind, SingI a) =>
Demote AddressKind
demote @actualKind (SingI a => AddressKind) -> Dict (SingI a) -> AddressKind
forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ KindedAddress a -> Dict (SingI a)
forall (kind :: AddressKind).
KindedAddress kind -> Dict (SingI kind)
addressKindSanity KindedAddress a
addr :: AddressKind
    REAliasNotFound Text
aliasText ->
      [itu|Could not find the alias '#{aliasText}'.|]
    REAddressNotFound KindedAddress kind
addr ->
      [itu|Could not find an alias for the address '#{addr}'.|]
    REAmbiguousAlias Text
aliasText [L1Address]
addrs ->
      [itu|
        The alias '#{aliasText}' is assigned to:
          #{addrs'}
        Use '#{contractPrefix}:#{aliasText}' or '#{implicitPrefix}:#{aliasText}' to disambiguate.
        |]
      where
        addrs' :: Text
addrs' = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
[Text] -> [Element [Text]]
forall t. Container t => t -> [Element t]
toList ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [L1Address]
addrs [L1Address] -> (L1Address -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (forall (t :: AddressKind).
 ConstrainAddressKind
   '[ 'AddressKindImplicit, 'AddressKindContract] t =>
 KindedAddress t -> Text)
-> L1Address -> Text
forall {k} (c :: k -> Constraint) (f :: k -> *) r.
(forall (t :: k). c t => f t -> r) -> Constrained c f -> r
foldConstrained \case
          ContractAddress ContractHash
contractAddr -> [itu|* a contract address: #{contractAddr}|]
          ImplicitAddress KeyHash
implicitAddr -> [itu|* an implicit address: #{implicitAddr}|]