{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}

module Cardano.CLI.Types.Errors.GovernanceCmdError where

import           Cardano.Api
import           Cardano.Api.Shelley

import           Cardano.Binary (DecoderError)
import           Cardano.CLI.Read
import           Cardano.CLI.Types.Errors.HashCmdError (FetchURLError, HashCheckError)
import           Cardano.CLI.Types.Errors.StakeAddressCmdError

import           Control.Exception (displayException)
import qualified Data.List as List
import           Data.Text (Text)
import qualified Data.Text.Lazy.Builder as TL
import qualified Formatting.Buildable as B

data GovernanceCmdError
  = -- Voting related
    StakeCredGovCmdError StakeAddressCmdError
  | VotingCredentialDecodeGovCmdEror DecoderError
  | WriteFileError (FileError ())
  | ReadFileError (FileError InputDecodeError)
  | -- Governance action related
    GovernanceCmdConstitutionError ConstitutionError
  | GovernanceCmdProposalError ProposalError
  | GovernanceCmdTextEnvReadError !(FileError TextEnvelopeError)
  | GovernanceCmdTextEnvCddlReadError !(FileError TextEnvelopeCddlError)
  | GovernanceCmdCddlError !CddlError
  | GovernanceCmdKeyReadError !(FileError InputDecodeError)
  | GovernanceCmdCostModelReadError !(FileError ())
  | GovernanceCmdTextEnvWriteError !(FileError ())
  | GovernanceCmdEmptyUpdateProposalError
  | GovernanceCmdMIRCertificateKeyRewardMistmach
      !FilePath
      !Int
      -- ^ Number of stake verification keys
      !Int
      -- ^ Number of reward amounts
  | GovernanceCmdCostModelsJsonDecodeErr !FilePath !Text
  | GovernanceCmdEmptyCostModel !FilePath
  | -- | Expected key types
    GovernanceCmdUnexpectedKeyType
      ![TextEnvelopeType]
  | -- | Maximum answer index
    GovernanceCmdPollOutOfBoundAnswer
      !Int
  | GovernanceCmdPollInvalidChoice
  | GovernanceCmdDecoderError !DecoderError
  | GovernanceCmdVerifyPollError !GovernancePollError
  | GovernanceCmdWriteFileError !(FileError ())
  | -- Legacy - remove me after cardano-cli transitions to new era based structure
    GovernanceCmdMIRCertNotSupportedInConway
  | GovernanceCmdGenesisDelegationNotSupportedInConway
  | GovernanceDRepHashCheckError HashCheckError
  | GovernanceCmdHashMismatchError
      !(Hash DRepMetadata)
      -- ^ Expected hash
      !(Hash DRepMetadata)
      -- ^ Actual hash
  | GovernanceCmdFetchURLError !FetchURLError
  deriving Int -> GovernanceCmdError -> ShowS
[GovernanceCmdError] -> ShowS
GovernanceCmdError -> String
(Int -> GovernanceCmdError -> ShowS)
-> (GovernanceCmdError -> String)
-> ([GovernanceCmdError] -> ShowS)
-> Show GovernanceCmdError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GovernanceCmdError -> ShowS
showsPrec :: Int -> GovernanceCmdError -> ShowS
$cshow :: GovernanceCmdError -> String
show :: GovernanceCmdError -> String
$cshowList :: [GovernanceCmdError] -> ShowS
showList :: [GovernanceCmdError] -> ShowS
Show

instance Error GovernanceCmdError where
  prettyError :: forall ann. GovernanceCmdError -> Doc ann
prettyError = \case
    StakeCredGovCmdError StakeAddressCmdError
stakeAddressCmdError ->
      Doc ann
"Stake credential error: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> StakeAddressCmdError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. StakeAddressCmdError -> Doc ann
prettyError StakeAddressCmdError
stakeAddressCmdError
    VotingCredentialDecodeGovCmdEror DecoderError
decoderError ->
      Doc ann
"Could not decode voting credential: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> DecoderError -> Doc ann
forall {ann}. DecoderError -> Doc ann
renderDecoderError DecoderError
decoderError
    WriteFileError FileError ()
fileError ->
      FileError () -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError () -> Doc ann
prettyError FileError ()
fileError
    ReadFileError FileError InputDecodeError
fileError ->
      FileError InputDecodeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError InputDecodeError -> Doc ann
prettyError FileError InputDecodeError
fileError
    GovernanceCmdConstitutionError ConstitutionError
e ->
      Doc ann
"Constitution error " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ConstitutionError -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow ConstitutionError
e -- TODO Conway render this properly
    GovernanceCmdProposalError ProposalError
e ->
      Doc ann
"Proposal error " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ProposalError -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow ProposalError
e -- TODO Conway render this properly
    GovernanceCmdTextEnvReadError FileError TextEnvelopeError
fileError ->
      Doc ann
"Cannot read text envelope: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FileError TextEnvelopeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError TextEnvelopeError -> Doc ann
prettyError FileError TextEnvelopeError
fileError
    GovernanceCmdTextEnvCddlReadError FileError TextEnvelopeCddlError
fileError ->
      Doc ann
"Cannot read text cddl envelope: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FileError TextEnvelopeCddlError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError TextEnvelopeCddlError -> Doc ann
prettyError FileError TextEnvelopeCddlError
fileError
    GovernanceCmdCddlError CddlError
cddlError ->
      Doc ann
"Reading transaction CDDL file error: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> CddlError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. CddlError -> Doc ann
prettyError CddlError
cddlError
    GovernanceCmdKeyReadError FileError InputDecodeError
fileError ->
      Doc ann
"Cannot read 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
fileError
    GovernanceCmdCostModelReadError FileError ()
fileError ->
      Doc ann
"Cannot read cost model: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FileError () -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError () -> Doc ann
prettyError FileError ()
fileError
    GovernanceCmdTextEnvWriteError FileError ()
fileError ->
      FileError () -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError () -> Doc ann
prettyError FileError ()
fileError
    GovernanceCmdError
GovernanceCmdEmptyUpdateProposalError ->
      Doc ann
"Empty update proposals are not allowed."
    GovernanceCmdMIRCertificateKeyRewardMistmach String
fp Int
nStakeVerKeys Int
nRewards ->
      Doc ann
"Error creating the MIR certificate 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
" The number of staking keys: "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow Int
nStakeVerKeys
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" and the number of reward amounts: "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow Int
nRewards
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" are not equivalent."
    GovernanceCmdCostModelsJsonDecodeErr String
fp Text
msg ->
      Doc ann
"Error decoding cost model: " 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
msg Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" 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
    GovernanceCmdEmptyCostModel String
fp ->
      Doc ann
"The decoded cost model was empty 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
    GovernanceCmdUnexpectedKeyType [TextEnvelopeType]
expectedTypes ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"Unexpected poll key type; expected one of: "
        , [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
List.intersperse Doc ann
", " (TextEnvelopeType -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow (TextEnvelopeType -> Doc ann) -> [TextEnvelopeType] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TextEnvelopeType]
expectedTypes)
        ]
    GovernanceCmdPollOutOfBoundAnswer Int
maxIdx ->
      Doc ann
"Poll answer out of bounds. Choices are between 0 and " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow Int
maxIdx
    GovernanceCmdError
GovernanceCmdPollInvalidChoice ->
      Doc ann
"Invalid choice. Please choose from the available answers."
    GovernanceCmdDecoderError DecoderError
decoderError ->
      Doc ann
"Unable to decode metadata: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> DecoderError -> Doc ann
forall {ann}. DecoderError -> Doc ann
renderDecoderError DecoderError
decoderError
    GovernanceCmdVerifyPollError GovernancePollError
pollError ->
      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
$ GovernancePollError -> Text
renderGovernancePollError GovernancePollError
pollError
    GovernanceCmdWriteFileError FileError ()
fileError ->
      Doc ann
"Cannot write file: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FileError () -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError () -> Doc ann
prettyError FileError ()
fileError
    GovernanceCmdError
GovernanceCmdMIRCertNotSupportedInConway ->
      Doc ann
"MIR certificates are not supported in Conway era onwards."
    GovernanceCmdError
GovernanceCmdGenesisDelegationNotSupportedInConway ->
      Doc ann
"Genesis delegation is not supported in Conway era onwards."
    GovernanceDRepHashCheckError HashCheckError
hashCheckError ->
      Doc ann
"Error while checking DRep metadata hash: " 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 (HashCheckError -> String
forall e. Exception e => e -> String
displayException HashCheckError
hashCheckError)
    GovernanceCmdHashMismatchError (DRepMetadataHash Hash StandardCrypto ByteString
expectedHash) (DRepMetadataHash Hash StandardCrypto ByteString
actualHash) ->
      Doc ann
"Hashes do not match!"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\nExpected:"
          Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Hash Blake2b_256 ByteString -> String
forall a. Show a => a -> String
show Hash Blake2b_256 ByteString
Hash StandardCrypto ByteString
expectedHash)
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"\n  Actual:"
          Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Hash Blake2b_256 ByteString -> String
forall a. Show a => a -> String
show Hash Blake2b_256 ByteString
Hash StandardCrypto ByteString
actualHash)
    GovernanceCmdFetchURLError FetchURLError
fetchErr ->
      String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (FetchURLError -> String
forall e. Exception e => e -> String
displayException FetchURLError
fetchErr)
   where
    renderDecoderError :: DecoderError -> Doc ann
renderDecoderError = Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (Text -> Doc ann)
-> (DecoderError -> Text) -> DecoderError -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TL.toLazyText (Builder -> Text)
-> (DecoderError -> Builder) -> DecoderError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoderError -> Builder
forall p. Buildable p => p -> Builder
B.build