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

module Cardano.CLI.Types.Errors.GenesisCmdError
  ( GenesisCmdError (..)
  )
where

import           Cardano.Api

import           Cardano.CLI.Byron.Genesis as Byron
import           Cardano.CLI.EraBased.Run.Governance.Committee (GovernanceCommitteeError)
import           Cardano.CLI.Types.Common
import           Cardano.CLI.Types.Errors.AddressCmdError
import           Cardano.CLI.Types.Errors.NodeCmdError
import           Cardano.CLI.Types.Errors.StakeAddressCmdError
import           Cardano.CLI.Types.Errors.StakePoolCmdError

import           Control.Exception (IOException)
import           Data.Text (Text)

data GenesisCmdError
  = GenesisCmdAddressCmdError !AddressCmdError
  | GenesisCmdByronError !ByronGenesisError
  | GenesisCmdCostModelsError !FilePath
  | -- | First @Integer@ is the delegate supply, second @Integer@ is the total supply
    GenesisCmdDelegatedSupplyExceedsTotalSupply !Integer !Integer
  | GenesisCmdFileError !(FileError ())
  | GenesisCmdFileDecodeError !FilePath !Text
  | GenesisCmdFilesDupIndex [FilePath]
  | GenesisCmdFilesNoIndex [FilePath]
  | GenesisCmdGenesisFileDecodeError !FilePath !Text
  | GenesisCmdGenesisFileError !(FileError ())
  | GenesisCmdGovernanceCommitteeError !GovernanceCommitteeError
  | GenesisCmdMismatchedGenesisKeyFiles [Int] [Int] [Int]
  | GenesisCmdNodeCmdError !NodeCmdError
  | GenesisCmdStakeAddressCmdError !StakeAddressCmdError
  | GenesisCmdStakePoolCmdError !StakePoolCmdError
  | GenesisCmdStakePoolRelayFileError !FilePath !IOException
  | GenesisCmdStakePoolRelayJsonDecodeError !FilePath !String
  | GenesisCmdTextEnvReadFileError !(FileError TextEnvelopeError)
  | GenesisCmdTooFewPoolsForBulkCreds !Word !Word !Word
  | -- | First @Int@ is the number of SPOs, second @Int@ is number of relays
    GenesisCmdTooManyRelaysError !FilePath !Int !Int
  | GenesisCmdUnexpectedAddressVerificationKey
      !(VerificationKeyFile In)
      !Text
      !SomeAddressVerificationKey
  deriving Int -> GenesisCmdError -> ShowS
[GenesisCmdError] -> ShowS
GenesisCmdError -> String
(Int -> GenesisCmdError -> ShowS)
-> (GenesisCmdError -> String)
-> ([GenesisCmdError] -> ShowS)
-> Show GenesisCmdError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenesisCmdError -> ShowS
showsPrec :: Int -> GenesisCmdError -> ShowS
$cshow :: GenesisCmdError -> String
show :: GenesisCmdError -> String
$cshowList :: [GenesisCmdError] -> ShowS
showList :: [GenesisCmdError] -> ShowS
Show

instance Error GenesisCmdError where
  prettyError :: forall ann. GenesisCmdError -> Doc ann
prettyError = \case
    GenesisCmdGenesisFileError FileError ()
fe ->
      FileError () -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError () -> Doc ann
prettyError FileError ()
fe
    GenesisCmdFileError FileError ()
fe ->
      FileError () -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError () -> Doc ann
prettyError FileError ()
fe
    GenesisCmdMismatchedGenesisKeyFiles [Int]
gfiles [Int]
dfiles [Int]
vfiles ->
      Doc ann
"Mismatch between the files found:\n"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Genesis key file indexes:      "
        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]
gfiles
        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
"Delegate key file indexes:     "
        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]
dfiles
        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
"Delegate VRF key file indexes: "
        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]
vfiles
    GenesisCmdFilesNoIndex [String]
files ->
      Doc ann
"The genesis keys files are expected to have a numeric index but these do not:\n"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((String -> Doc ann) -> [String] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [String]
files)
    GenesisCmdFilesDupIndex [String]
files ->
      Doc ann
"The genesis keys files are expected to have a unique numeric index but these do not:\n"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((String -> Doc ann) -> [String] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [String]
files)
    GenesisCmdFileDecodeError String
path Text
errorTxt ->
      Doc ann
"Cannot decode file:" 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 String
path Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"\nError:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
errorTxt
    GenesisCmdTextEnvReadFileError FileError TextEnvelopeError
fileErr ->
      FileError TextEnvelopeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError TextEnvelopeError -> Doc ann
prettyError FileError TextEnvelopeError
fileErr
    GenesisCmdUnexpectedAddressVerificationKey (File String
file) Text
expect SomeAddressVerificationKey
got ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"Unexpected address verification key type in file "
        , String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
file
        , Doc ann
", expected: "
        , Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
expect
        , Doc ann
", got: "
        , Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (SomeAddressVerificationKey -> Text
renderSomeAddressVerificationKey SomeAddressVerificationKey
got)
        ]
    GenesisCmdTooFewPoolsForBulkCreds Word
pools Word
files Word
perPool ->
      [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [ Doc ann
"Number of pools requested for generation ("
        , Word -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow Word
pools
        , Doc ann
") is insufficient to fill "
        , Word -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow Word
files
        , Doc ann
" bulk files, with "
        , Word -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow Word
perPool
        , Doc ann
" pools per file."
        ]
    GenesisCmdAddressCmdError AddressCmdError
e ->
      AddressCmdError -> Doc ann
forall ann. AddressCmdError -> Doc ann
renderAddressCmdError AddressCmdError
e
    GenesisCmdNodeCmdError NodeCmdError
e ->
      NodeCmdError -> Doc ann
forall ann. NodeCmdError -> Doc ann
renderNodeCmdError NodeCmdError
e
    GenesisCmdStakePoolCmdError StakePoolCmdError
e ->
      StakePoolCmdError -> Doc ann
forall ann. StakePoolCmdError -> Doc ann
renderStakePoolCmdError StakePoolCmdError
e
    GenesisCmdStakeAddressCmdError StakeAddressCmdError
e ->
      StakeAddressCmdError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. StakeAddressCmdError -> Doc ann
prettyError StakeAddressCmdError
e
    GenesisCmdCostModelsError String
fp ->
      Doc ann
"Cost model is invalid: " 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
    GenesisCmdGenesisFileDecodeError String
fp Text
e ->
      Doc ann
"Error while decoding Shelley genesis 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
" Error: "
        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 Text
e
    GenesisCmdByronError ByronGenesisError
e -> ByronGenesisError -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow ByronGenesisError
e
    GenesisCmdTooManyRelaysError String
fp Int
nbSPOs Int
nbRelays ->
      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
" specifies "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
nbRelays
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" relays, but only "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
nbSPOs
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" SPOs have been specified."
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" Please specify a number of relays that is lesser or equal to the number of SPOs."
    GenesisCmdStakePoolRelayFileError String
fp IOException
e ->
      Doc ann
"Error occurred while reading the stake pool relay specification 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
fp
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" Error: "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> IOException -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow IOException
e
    GenesisCmdStakePoolRelayJsonDecodeError String
fp String
e ->
      Doc ann
"Error occurred while decoding the stake pool relay specification 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
fp
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" Error: "
        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
e
    GenesisCmdDelegatedSupplyExceedsTotalSupply Integer
delegated Integer
total ->
      Doc ann
"Provided delegated supply is "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
delegated
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
", which is greater than the specified total supply: "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
total
        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
<> Doc ann
"This is incorrect: the delegated supply should be less or equal to the total supply."
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" Note that the total supply can either come from --total-supply or from the default template. Please fix what you use."
    GenesisCmdGovernanceCommitteeError GovernanceCommitteeError
govCommitteeError ->
      Doc ann
"Error during committee creation: "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> GovernanceCommitteeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. GovernanceCommitteeError -> Doc ann
prettyError GovernanceCommitteeError
govCommitteeError