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

module Cardano.CLI.Types.Errors.TxCmdError
  ( TxCmdError (..)
  , AnyTxBodyErrorAutoBalance (..)
  , AnyTxCmdTxExecUnitsErr (..)
  , renderTxCmdError
  )
where

import           Cardano.Api
import           Cardano.Api.Shelley

import           Cardano.CLI.Read
import           Cardano.CLI.Types.Common
import           Cardano.CLI.Types.Errors.BootstrapWitnessError
import           Cardano.CLI.Types.Errors.NodeEraMismatchError
import qualified Cardano.CLI.Types.Errors.NodeEraMismatchError as NEM
import           Cardano.CLI.Types.Errors.ProtocolParamsError
import           Cardano.CLI.Types.Errors.TxValidationError
import           Cardano.CLI.Types.Output
import           Cardano.CLI.Types.TxFeature
import qualified Cardano.Prelude as List
import           Ouroboros.Consensus.Cardano.Block (EraMismatch (..))

import           Data.Text (Text)

{- HLINT ignore "Use let" -}

data AnyTxCmdTxExecUnitsErr where
  AnyTxCmdTxExecUnitsErr :: TransactionValidityError era -> AnyTxCmdTxExecUnitsErr

data AnyTxBodyErrorAutoBalance where
  AnyTxBodyErrorAutoBalance :: TxBodyErrorAutoBalance era -> AnyTxBodyErrorAutoBalance

data TxCmdError
  = TxCmdMetadataError MetadataError
  | TxCmdVoteError VoteError
  | TxCmdConstitutionError ConstitutionError
  | TxCmdProposalError ProposalError
  | TxCmdScriptWitnessError ScriptWitnessError
  | TxCmdProtocolParamsError ProtocolParamsError
  | TxCmdScriptFileError (FileError ScriptDecodeError)
  | TxCmdKeyFileError (FileError InputDecodeError)
  | TxCmdReadTextViewFileError !(FileError TextEnvelopeError)
  | TxCmdReadWitnessSigningDataError !ReadWitnessSigningDataError
  | TxCmdWriteFileError !(FileError ())
  | TxCmdBootstrapWitnessError !BootstrapWitnessError
  | TxCmdTxSubmitError !Text
  | TxCmdTxSubmitErrorEraMismatch !EraMismatch
  | TxCmdTxFeatureMismatch !AnyCardanoEra !TxFeature
  | TxCmdTxBodyError !TxBodyError
  | TxCmdWitnessEraMismatch !AnyCardanoEra !AnyCardanoEra !WitnessFile
  | TxCmdPolicyIdsMissing ![PolicyId] ![PolicyId]
  | -- The first list is the missing policy Ids, the second list is the
    -- policy Ids that were provided in the transaction.
    TxCmdPolicyIdsExcess ![PolicyId]
  | TxCmdByronEra
  | TxCmdBalanceTxBody !AnyTxBodyErrorAutoBalance
  | TxCmdTxInsDoNotExist !TxInsExistError
  | TxCmdPParamsErr !ProtocolParametersError
  | TxCmdTextEnvError !(FileError TextEnvelopeError)
  | TxCmdTextEnvCddlError !(FileError TextEnvelopeCddlError)
  | TxCmdTxExecUnitsErr !AnyTxCmdTxExecUnitsErr
  | TxCmdPlutusScriptCostErr !PlutusScriptCostError
  | TxCmdPParamExecutionUnitsNotAvailable
  | TxCmdPlutusScriptsRequireCardanoMode
  | TxCmdProtocolParametersNotPresentInTxBody
  | TxCmdTxNodeEraMismatchError !NodeEraMismatchError
  | TxCmdQueryConvenienceError !QueryConvenienceError
  | TxCmdQueryNotScriptLocked !ScriptLockedTxInsError
  | TxCmdScriptDataError !ScriptDataError
  | TxCmdCddlWitnessError CddlWitnessError
  | TxCmdRequiredSignerError RequiredSignerError
  | -- Validation errors
    forall era. TxCmdNotSupportedInEraValidationError (TxNotSupportedInEraValidationError era)
  | TxCmdAuxScriptsValidationError TxAuxScriptsValidationError
  | TxCmdProtocolParamsConverstionError ProtocolParametersConversionError
  | forall era. TxCmdTxGovDuplicateVotes (TxGovDuplicateVotes era)
  | forall era. TxCmdFeeEstimationError (TxFeeEstimationError era)

renderTxCmdError :: TxCmdError -> Doc ann
renderTxCmdError :: forall ann. TxCmdError -> Doc ann
renderTxCmdError = \case
  TxCmdProtocolParamsConverstionError ProtocolParametersConversionError
err' ->
    Doc ann
"Error while converting protocol parameters: " 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
err'
  TxCmdVoteError VoteError
voteErr ->
    VoteError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. VoteError -> Doc ann
prettyError VoteError
voteErr
  TxCmdConstitutionError ConstitutionError
constErr ->
    ConstitutionError -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow ConstitutionError
constErr
  TxCmdProposalError ProposalError
propErr ->
    ProposalError -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow ProposalError
propErr
  TxCmdReadTextViewFileError 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
  TxCmdScriptFileError FileError ScriptDecodeError
fileErr ->
    FileError ScriptDecodeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError ScriptDecodeError -> Doc ann
prettyError FileError ScriptDecodeError
fileErr
  TxCmdKeyFileError FileError InputDecodeError
fileErr ->
    FileError InputDecodeError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError InputDecodeError -> Doc ann
prettyError FileError InputDecodeError
fileErr
  TxCmdReadWitnessSigningDataError ReadWitnessSigningDataError
witSignDataErr ->
    ReadWitnessSigningDataError -> Doc ann
forall ann. ReadWitnessSigningDataError -> Doc ann
renderReadWitnessSigningDataError ReadWitnessSigningDataError
witSignDataErr
  TxCmdWriteFileError FileError ()
fileErr ->
    FileError () -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. FileError () -> Doc ann
prettyError FileError ()
fileErr
  TxCmdTxSubmitError Text
res ->
    Doc ann
"Error while submitting tx: " 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
res
  TxCmdTxSubmitErrorEraMismatch EraMismatch{Text
ledgerEraName :: Text
ledgerEraName :: EraMismatch -> Text
ledgerEraName, Text
otherEraName :: Text
otherEraName :: EraMismatch -> Text
otherEraName} ->
    Doc ann
"The era of the node and the tx do not match. "
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"The node is running in the "
      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
ledgerEraName
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" era, but the transaction is for the "
      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
otherEraName
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" era."
  TxCmdBootstrapWitnessError BootstrapWitnessError
sbwErr ->
    BootstrapWitnessError -> Doc ann
forall ann. BootstrapWitnessError -> Doc ann
renderBootstrapWitnessError BootstrapWitnessError
sbwErr
  TxCmdTxFeatureMismatch AnyCardanoEra
era TxFeature
TxFeatureImplicitFees ->
    Doc ann
"An explicit transaction fee must be specified for "
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> AnyCardanoEra -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AnyCardanoEra -> Doc ann
pretty AnyCardanoEra
era
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" era transactions."
  TxCmdTxFeatureMismatch (AnyCardanoEra CardanoEra era
ShelleyEra) TxFeature
TxFeatureValidityNoUpperBound ->
    Doc ann
"A TTL must be specified for Shelley era transactions."
  TxCmdTxFeatureMismatch AnyCardanoEra
era TxFeature
feature ->
    Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (TxFeature -> Text
renderFeature TxFeature
feature)
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" cannot be used for "
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> AnyCardanoEra -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AnyCardanoEra -> Doc ann
pretty AnyCardanoEra
era
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" era transactions."
  TxCmdTxBodyError TxBodyError
err' ->
    Doc ann
"Transaction validaton error: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> TxBodyError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TxBodyError -> Doc ann
prettyError TxBodyError
err'
  TxCmdWitnessEraMismatch AnyCardanoEra
era AnyCardanoEra
era' (WitnessFile FilePath
file) ->
    Doc ann
"The era of a witness does not match the era of the transaction. "
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"The transaction is for the "
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> AnyCardanoEra -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AnyCardanoEra -> Doc ann
pretty AnyCardanoEra
era
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" era, but the "
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"witness in "
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow FilePath
file
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" is for the "
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> AnyCardanoEra -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AnyCardanoEra -> Doc ann
pretty AnyCardanoEra
era'
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" era."
  TxCmdPolicyIdsMissing [PolicyId]
missingPolicyIds [PolicyId]
knownPolicyIds ->
    [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
"The \"--mint\" flag specifies an asset with a policy Id, but no "
      , Doc ann
"corresponding monetary policy script has been provided as a witness "
      , Doc ann
"(via the \"--mint-script-file\" flag). The policy Id in question is: "
      , [PolicyId] -> Doc ann
forall ann. [PolicyId] -> Doc ann
prettyPolicyIdList [PolicyId]
missingPolicyIds
      ]
        [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. Semigroup a => a -> a -> a
<> [Doc ann
". Known policy Ids are: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [PolicyId] -> Doc ann
forall ann. [PolicyId] -> Doc ann
prettyPolicyIdList [PolicyId]
knownPolicyIds | Bool -> Bool
not ([PolicyId] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PolicyId]
knownPolicyIds)]
  TxCmdPolicyIdsExcess [PolicyId]
policyids ->
    [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
      [ Doc ann
"A script provided to witness minting does not correspond to the policy "
      , Doc ann
"id of any asset specified in the \"--mint\" field. The script hash is: "
      , [PolicyId] -> Doc ann
forall ann. [PolicyId] -> Doc ann
prettyPolicyIdList [PolicyId]
policyids
      ]
  TxCmdError
TxCmdByronEra ->
    Doc ann
"This query cannot be used for the Byron era"
  TxCmdBalanceTxBody (AnyTxBodyErrorAutoBalance TxBodyErrorAutoBalance era
err') ->
    TxBodyErrorAutoBalance era -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TxBodyErrorAutoBalance era -> Doc ann
prettyError TxBodyErrorAutoBalance era
err'
  TxCmdTxInsDoNotExist TxInsExistError
e ->
    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
$ TxInsExistError -> Text
renderTxInsExistError TxInsExistError
e
  TxCmdPParamsErr ProtocolParametersError
err' ->
    ProtocolParametersError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. ProtocolParametersError -> Doc ann
prettyError ProtocolParametersError
err'
  TxCmdTextEnvError FileError TextEnvelopeError
err' ->
    [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
      [ Doc ann
"Failed to decode the ledger's CDDL serialisation format. "
      , Doc ann
"File error: " 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
err'
      ]
  TxCmdTextEnvCddlError FileError TextEnvelopeCddlError
cddlErr ->
    [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
      [ Doc ann
"Failed to decode the ledger's CDDL serialisation format. "
      , Doc ann
"TextEnvelopeCddl error: " 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
cddlErr
      ]
  TxCmdTxExecUnitsErr (AnyTxCmdTxExecUnitsErr TransactionValidityError era
err') ->
    TransactionValidityError era -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TransactionValidityError era -> Doc ann
prettyError TransactionValidityError era
err'
  TxCmdPlutusScriptCostErr PlutusScriptCostError
err' ->
    PlutusScriptCostError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. PlutusScriptCostError -> Doc ann
prettyError PlutusScriptCostError
err'
  TxCmdError
TxCmdPParamExecutionUnitsNotAvailable ->
    [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
      [ Doc ann
"Execution units not available in the protocol parameters. This is "
      , Doc ann
"likely due to not being in the Alonzo era"
      ]
  TxCmdTxNodeEraMismatchError (NodeEraMismatchError{era :: ()
NEM.era = CardanoEra era
valueEra, nodeEra :: ()
nodeEra = CardanoEra nodeEra
nodeEra}) ->
    CardanoEra nodeEra
-> (CardanoEraConstraints nodeEra => Doc ann) -> Doc ann
forall era a.
CardanoEra era -> (CardanoEraConstraints era => a) -> a
cardanoEraConstraints CardanoEra nodeEra
nodeEra ((CardanoEraConstraints nodeEra => Doc ann) -> Doc ann)
-> (CardanoEraConstraints nodeEra => Doc ann) -> Doc ann
forall a b. (a -> b) -> a -> b
$
      CardanoEra era -> (CardanoEraConstraints era => Doc ann) -> Doc ann
forall era a.
CardanoEra era -> (CardanoEraConstraints era => a) -> a
cardanoEraConstraints CardanoEra era
valueEra ((CardanoEraConstraints era => Doc ann) -> Doc ann)
-> (CardanoEraConstraints era => Doc ann) -> Doc ann
forall a b. (a -> b) -> a -> b
$
        [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
          [ Doc ann
"Transactions can only be produced in the same era as the node. Requested era: "
          , CardanoEra era -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CardanoEra era -> Doc ann
pretty CardanoEra era
valueEra Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
", node era: "
          , CardanoEra nodeEra -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CardanoEra nodeEra -> Doc ann
pretty CardanoEra nodeEra
nodeEra Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"."
          ]
  TxCmdQueryConvenienceError QueryConvenienceError
e ->
    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
e
  TxCmdQueryNotScriptLocked ScriptLockedTxInsError
e ->
    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
$ ScriptLockedTxInsError -> Text
renderNotScriptLockedTxInsError ScriptLockedTxInsError
e
  TxCmdError
TxCmdPlutusScriptsRequireCardanoMode ->
    Doc ann
"Plutus scripts are only available in CardanoMode"
  TxCmdError
TxCmdProtocolParametersNotPresentInTxBody ->
    Doc ann
"Protocol parameters were not found in transaction body"
  TxCmdMetadataError MetadataError
e ->
    MetadataError -> Doc ann
forall ann. MetadataError -> Doc ann
renderMetadataError MetadataError
e
  TxCmdScriptWitnessError ScriptWitnessError
e ->
    ScriptWitnessError -> Doc ann
forall ann. ScriptWitnessError -> Doc ann
renderScriptWitnessError ScriptWitnessError
e
  TxCmdScriptDataError ScriptDataError
e ->
    ScriptDataError -> Doc ann
forall ann. ScriptDataError -> Doc ann
renderScriptDataError ScriptDataError
e
  TxCmdProtocolParamsError ProtocolParamsError
e ->
    ProtocolParamsError -> Doc ann
forall ann. ProtocolParamsError -> Doc ann
renderProtocolParamsError ProtocolParamsError
e
  TxCmdCddlWitnessError CddlWitnessError
e ->
    CddlWitnessError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. CddlWitnessError -> Doc ann
prettyError CddlWitnessError
e
  TxCmdRequiredSignerError RequiredSignerError
e ->
    RequiredSignerError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. RequiredSignerError -> Doc ann
prettyError RequiredSignerError
e
  -- Validation errors
  TxCmdNotSupportedInEraValidationError TxNotSupportedInEraValidationError era
e ->
    TxNotSupportedInEraValidationError era -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TxNotSupportedInEraValidationError era -> Doc ann
prettyError TxNotSupportedInEraValidationError era
e
  TxCmdAuxScriptsValidationError TxAuxScriptsValidationError
e ->
    TxAuxScriptsValidationError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TxAuxScriptsValidationError -> Doc ann
prettyError TxAuxScriptsValidationError
e
  TxCmdTxGovDuplicateVotes TxGovDuplicateVotes era
e ->
    TxGovDuplicateVotes era -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TxGovDuplicateVotes era -> Doc ann
prettyError TxGovDuplicateVotes era
e
  TxCmdFeeEstimationError TxFeeEstimationError era
e ->
    TxFeeEstimationError era -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. TxFeeEstimationError era -> Doc ann
prettyError TxFeeEstimationError era
e

prettyPolicyIdList :: [PolicyId] -> Doc ann
prettyPolicyIdList :: forall ann. [PolicyId] -> Doc ann
prettyPolicyIdList =
  [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat ([Doc ann] -> Doc ann)
-> ([PolicyId] -> [Doc ann]) -> [PolicyId] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
List.intersperse Doc ann
", " ([Doc ann] -> [Doc ann])
-> ([PolicyId] -> [Doc ann]) -> [PolicyId] -> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PolicyId -> Doc ann) -> [PolicyId] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> (PolicyId -> Text) -> PolicyId -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolicyId -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText)