{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.CLI.Types.Errors.QueryCmdError
  ( QueryCmdError (..)
  , renderQueryCmdError
  , mkEraMismatchError
  )
where

import           Cardano.Api hiding (QueryInShelleyBasedEra (..))
import           Cardano.Api.Consensus as Consensus (EraMismatch (..), PastHorizonException)
import           Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..))

import           Cardano.Binary (DecoderError)
import           Cardano.CLI.Helpers (HelpersError (..), renderHelpersError)
import           Cardano.CLI.Types.Errors.GenesisCmdError
import           Cardano.CLI.Types.Errors.NodeEraMismatchError (NodeEraMismatchError (..))

import qualified Data.ByteString.Lazy.Char8 as LBS
import           Data.Text.Lazy.Builder (toLazyText)
import           Formatting.Buildable (build)

{- HLINT ignore "Move brackets to avoid $" -}
{- HLINT ignore "Redundant flip" -}

data QueryCmdError
  = QueryCmdConvenienceError !QueryConvenienceError
  | QueryCmdWriteFileError !(FileError ())
  | QueryCmdHelpersError !HelpersError
  | QueryCmdAcquireFailure !AcquiringFailure
  | QueryCmdByronEra
  | QueryCmdEraMismatch !EraMismatch
  | QueryCmdPastHorizon !Consensus.PastHorizonException
  | QueryCmdSystemStartUnavailable
  | QueryCmdGenesisReadError !GenesisCmdError
  | QueryCmdLeaderShipError !LeadershipError
  | QueryCmdTextEnvelopeReadError !(FileError TextEnvelopeError)
  | QueryCmdTextReadError !(FileError InputDecodeError)
  | QueryCmdOpCertCounterReadError !(FileError TextEnvelopeError)
  | QueryCmdProtocolStateDecodeFailure !(LBS.ByteString, DecoderError)
  | QueryCmdPoolStateDecodeError DecoderError
  | QueryCmdStakeSnapshotDecodeError DecoderError
  | QueryCmdUnsupportedNtcVersion !UnsupportedNtcVersionError
  | QueryCmdProtocolParameterConversionError !ProtocolParametersConversionError
  | QueryCmdDRepKeyError !(FileError InputDecodeError)
  | QueryCmdSPOKeyError !(FileError InputDecodeError)
  | QueryCmdCommitteeColdKeyError !(FileError InputDecodeError)
  | QueryCmdCommitteeHotKeyError !(FileError InputDecodeError)
  deriving Int -> QueryCmdError -> ShowS
[QueryCmdError] -> ShowS
QueryCmdError -> String
(Int -> QueryCmdError -> ShowS)
-> (QueryCmdError -> String)
-> ([QueryCmdError] -> ShowS)
-> Show QueryCmdError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryCmdError -> ShowS
showsPrec :: Int -> QueryCmdError -> ShowS
$cshow :: QueryCmdError -> String
show :: QueryCmdError -> String
$cshowList :: [QueryCmdError] -> ShowS
showList :: [QueryCmdError] -> ShowS
Show

mkEraMismatchError :: NodeEraMismatchError -> QueryCmdError
mkEraMismatchError :: NodeEraMismatchError -> QueryCmdError
mkEraMismatchError NodeEraMismatchError{CardanoEra nodeEra
nodeEra :: CardanoEra nodeEra
nodeEra :: ()
nodeEra, CardanoEra era
era :: CardanoEra era
era :: ()
era} =
  EraMismatch -> QueryCmdError
QueryCmdEraMismatch (EraMismatch -> QueryCmdError) -> EraMismatch -> QueryCmdError
forall a b. (a -> b) -> a -> b
$
    EraMismatch
      { ledgerEraName :: Text
ledgerEraName = Doc AnsiStyle -> Text
docToText (Doc AnsiStyle -> Text) -> Doc AnsiStyle -> Text
forall a b. (a -> b) -> a -> b
$ CardanoEra nodeEra -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
forall ann. CardanoEra nodeEra -> Doc ann
pretty CardanoEra nodeEra
nodeEra
      , otherEraName :: Text
otherEraName = Doc AnsiStyle -> Text
docToText (Doc AnsiStyle -> Text) -> Doc AnsiStyle -> Text
forall a b. (a -> b) -> a -> b
$ CardanoEra era -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
forall ann. CardanoEra era -> Doc ann
pretty CardanoEra era
era
      }

renderQueryCmdError :: QueryCmdError -> Doc ann
renderQueryCmdError :: forall ann. QueryCmdError -> Doc ann
renderQueryCmdError = \case
  QueryCmdWriteFileError FileError ()
fileErr ->
    FileError () -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError () -> Doc ann
prettyError FileError ()
fileErr
  QueryCmdHelpersError HelpersError
helpersErr ->
    HelpersError -> Doc ann
forall ann. HelpersError -> Doc ann
renderHelpersError HelpersError
helpersErr
  QueryCmdAcquireFailure AcquiringFailure
acquireFail ->
    AcquiringFailure -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow AcquiringFailure
acquireFail
  QueryCmdError
QueryCmdByronEra ->
    Doc ann
"This query cannot be used for the Byron era"
  QueryCmdEraMismatch (EraMismatch Text
ledgerEra Text
queryEra) ->
    Doc ann
"\nAn error mismatch occurred."
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\nSpecified query era: "
      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 Text
queryEra
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\nCurrent ledger era: "
      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 Text
ledgerEra
  QueryCmdPastHorizon PastHorizonException
e ->
    Doc ann
"Past horizon: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> PastHorizonException -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow PastHorizonException
e
  QueryCmdError
QueryCmdSystemStartUnavailable ->
    Doc ann
"System start unavailable"
  QueryCmdGenesisReadError GenesisCmdError
err' ->
    GenesisCmdError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. GenesisCmdError -> Doc ann
prettyError GenesisCmdError
err'
  QueryCmdLeaderShipError LeadershipError
e ->
    LeadershipError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. LeadershipError -> Doc ann
prettyError LeadershipError
e
  QueryCmdTextEnvelopeReadError FileError TextEnvelopeError
e ->
    FileError TextEnvelopeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError TextEnvelopeError -> Doc ann
prettyError FileError TextEnvelopeError
e
  QueryCmdTextReadError FileError InputDecodeError
e ->
    FileError InputDecodeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError InputDecodeError -> Doc ann
prettyError FileError InputDecodeError
e
  QueryCmdOpCertCounterReadError FileError TextEnvelopeError
e ->
    FileError TextEnvelopeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError TextEnvelopeError -> Doc ann
prettyError FileError TextEnvelopeError
e
  QueryCmdProtocolStateDecodeFailure (ByteString
_, DecoderError
decErr) ->
    Doc ann
"Failed to decode the protocol state: " 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
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ DecoderError -> Builder
forall p. Buildable p => p -> Builder
build DecoderError
decErr)
  QueryCmdPoolStateDecodeError DecoderError
decoderError ->
    Doc ann
"Failed to decode PoolState.  Error: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> DecoderError -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow DecoderError
decoderError
  QueryCmdStakeSnapshotDecodeError DecoderError
decoderError ->
    Doc ann
"Failed to decode StakeSnapshot.  Error: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> DecoderError -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow DecoderError
decoderError
  QueryCmdUnsupportedNtcVersion (UnsupportedNtcVersionError MinNodeToClientVersion
minNtcVersion MinNodeToClientVersion
ntcVersion) ->
    Doc ann
"Unsupported feature for the node-to-client protocol version.\n"
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"This query requires at least "
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> MinNodeToClientVersion -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow MinNodeToClientVersion
minNtcVersion
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" but the node negotiated "
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> MinNodeToClientVersion -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow MinNodeToClientVersion
ntcVersion
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
".\n"
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Later node versions support later protocol versions (but development protocol versions are not enabled in the node by default)."
  QueryCmdProtocolParameterConversionError ProtocolParametersConversionError
ppce ->
    Doc ann
"Failed to convert protocol parameter: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ProtocolParametersConversionError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. ProtocolParametersConversionError -> Doc ann
prettyError ProtocolParametersConversionError
ppce
  QueryCmdConvenienceError QueryConvenienceError
qce ->
    Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> Text -> Doc ann
forall a b. (a -> b) -> a -> b
$ QueryConvenienceError -> Text
renderQueryConvenienceError QueryConvenienceError
qce
  QueryCmdDRepKeyError FileError InputDecodeError
e ->
    Doc ann
"Error reading delegation representative key: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FileError InputDecodeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError InputDecodeError -> Doc ann
prettyError FileError InputDecodeError
e
  QueryCmdSPOKeyError FileError InputDecodeError
e ->
    Doc ann
"Error reading Stake Pool Operator key: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FileError InputDecodeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError InputDecodeError -> Doc ann
prettyError FileError InputDecodeError
e
  QueryCmdCommitteeColdKeyError FileError InputDecodeError
e ->
    Doc ann
"Error reading committee cold key: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FileError InputDecodeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError InputDecodeError -> Doc ann
prettyError FileError InputDecodeError
e
  QueryCmdCommitteeHotKeyError FileError InputDecodeError
e ->
    Doc ann
"Error reading committee hot key: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FileError InputDecodeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError InputDecodeError -> Doc ann
prettyError FileError InputDecodeError
e