{-# LANGUAGE LambdaCase #-}

module Cardano.CLI.Type.Error.DebugCmdError
  ( DebugCmdError (..)
  )
where

import Cardano.Api
import Cardano.Api.Byron qualified as Byron
import Cardano.Api.Ledger qualified as L

import Cardano.CLI.Type.Error.TxCmdError
import Cardano.Configuration qualified as Cfg

import Data.Aeson.Key qualified as Aeson
import Data.Aeson.Types qualified as Aeson
import Data.Text.Lazy.Builder qualified as Text
import Formatting.Buildable (build)

data DebugCmdError
  = DebugCmdFailed
  | -- | @DebugNodeConfigGenesisDataCmdError filepath error@ represents an error when
    -- reading the node configuration at @filepath@
    DebugNodeConfigGenesisDataCmdError !FilePath !Byron.GenesisDataError
  | -- | @DebugNodeConfigReadCmdError filepath error@ represents an error when
    -- reading the node configuration at @filepath@, or the genesis files it names
    DebugNodeConfigReadCmdError
      !FilePath
      -- ^ The file path of the node configuration file
      !NodeConfigError
      -- ^ The error from reading the node configuration or a genesis file it names
  | DebugTxCmdError !TxCmdError
  deriving Int -> DebugCmdError -> ShowS
[DebugCmdError] -> ShowS
DebugCmdError -> String
(Int -> DebugCmdError -> ShowS)
-> (DebugCmdError -> String)
-> ([DebugCmdError] -> ShowS)
-> Show DebugCmdError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DebugCmdError -> ShowS
showsPrec :: Int -> DebugCmdError -> ShowS
$cshow :: DebugCmdError -> String
show :: DebugCmdError -> String
$cshowList :: [DebugCmdError] -> ShowS
showList :: [DebugCmdError] -> ShowS
Show

instance Error DebugCmdError where
  prettyError :: forall ann. DebugCmdError -> Doc ann
prettyError = \case
    DebugCmdError
DebugCmdFailed -> Doc ann
"Debug command failed"
    DebugNodeConfigGenesisDataCmdError String
fp GenesisDataError
err ->
      Doc ann
"Error reading node configuration at: "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
fp
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
": "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (Builder -> Text
Text.toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ GenesisDataError -> Builder
forall p. Buildable p => p -> Builder
build GenesisDataError
err)
    DebugNodeConfigReadCmdError String
fp NodeConfigError
err -> case NodeConfigError
err of
      -- cardano-config says which genesis file is at fault, and which key names it
      NodeConfigParsingError
        Cfg.ConfigurationParsingError
          { errFile :: ConfigurationParsingError -> StrictMaybe String
Cfg.errFile = L.SJust String
genesisFp
          , errPath :: ConfigurationParsingError -> JSONPath
Cfg.errPath = [Aeson.Key Key
key]
          , errMessage :: ConfigurationParsingError -> String
Cfg.errMessage = String
message
          }
          | String
genesisFp String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
fp ->
              Doc ann
"Error reading the genesis file "
                Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
genesisFp
                Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" ("
                Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Key -> Text
Aeson.toText Key
key)
                Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" in "
                Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
fp
                Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"): "
                Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
message
      NodeConfigError
_ ->
        Doc ann
"Error reading node configuration at: "
          Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
fp
          Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
": "
          Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> NodeConfigError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. NodeConfigError -> Doc ann
prettyError NodeConfigError
err
    DebugTxCmdError TxCmdError
err -> TxCmdError -> Doc ann
forall ann. TxCmdError -> Doc ann
renderTxCmdError TxCmdError
err