{-# LANGUAGE OverloadedStrings #-}
module Cardano.Api.TxSubmit.ErrorRender
  ( renderApplyMempoolPayloadErr
  ) where

-- This file contains error renders. They should have been defined at a lower level, with the error
-- type definitions, but for some reason have not been.
-- They will be defined here for now and then moved where they are supposed to be once they
-- are working.

import           Cardano.Chain.Byron.API (ApplyMempoolPayloadErr (..))
import           Cardano.Chain.UTxO.UTxO (UTxOError (..))
import           Cardano.Chain.UTxO.Validation (TxValidationError (..), UTxOValidationError (..))

import           Cardano.Prelude hiding ((%))

import qualified Data.Text as Text

import           Formatting (build, sformat, stext, (%))

renderApplyMempoolPayloadErr :: ApplyMempoolPayloadErr -> Text
renderApplyMempoolPayloadErr :: ApplyMempoolPayloadErr -> Text
renderApplyMempoolPayloadErr ApplyMempoolPayloadErr
err =
    case ApplyMempoolPayloadErr
err of
      MempoolTxErr UTxOValidationError
ve -> UTxOValidationError -> Text
renderValidationError UTxOValidationError
ve
      MempoolDlgErr {} -> Text
"Delegation error"
      MempoolUpdateProposalErr {} -> Text
"Update proposal error"
      MempoolUpdateVoteErr {} -> Text
"Update vote error"


renderValidationError :: UTxOValidationError -> Text
renderValidationError :: UTxOValidationError -> Text
renderValidationError UTxOValidationError
ve =
  case UTxOValidationError
ve of
    UTxOValidationTxValidationError TxValidationError
tve -> TxValidationError -> Text
renderTxValidationError TxValidationError
tve
    UTxOValidationUTxOError UTxOError
ue -> UTxOError -> Text
renderUTxOError UTxOError
ue


renderTxValidationError :: TxValidationError -> Text
renderTxValidationError :: TxValidationError -> Text
renderTxValidationError TxValidationError
tve =
  Text
"Tx Validation: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    case TxValidationError
tve of
      TxValidationLovelaceError Text
txt LovelaceError
e ->
        Format Text (Text -> LovelaceError -> Text)
-> Text -> LovelaceError -> Text
forall a. Format Text a -> a
sformat (Format
  (Text -> LovelaceError -> Text) (Text -> LovelaceError -> Text)
"Lovelace error "Format
  (Text -> LovelaceError -> Text) (Text -> LovelaceError -> Text)
-> Format Text (Text -> LovelaceError -> Text)
-> Format Text (Text -> LovelaceError -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (LovelaceError -> Text) (Text -> LovelaceError -> Text)
forall r. Format r (Text -> r)
stext Format (LovelaceError -> Text) (Text -> LovelaceError -> Text)
-> Format Text (LovelaceError -> Text)
-> Format Text (Text -> LovelaceError -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
%Format (LovelaceError -> Text) (LovelaceError -> Text)
": "Format (LovelaceError -> Text) (LovelaceError -> Text)
-> Format Text (LovelaceError -> Text)
-> Format Text (LovelaceError -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text (LovelaceError -> Text)
forall a r. Buildable a => Format r (a -> r)
build) Text
txt LovelaceError
e
      TxValidationFeeTooSmall Tx
tx Lovelace
expected Lovelace
actual ->
        Format Text (Tx -> Lovelace -> Lovelace -> Text)
-> Tx -> Lovelace -> Lovelace -> Text
forall a. Format Text a -> a
sformat (Format
  (Tx -> Lovelace -> Lovelace -> Text)
  (Tx -> Lovelace -> Lovelace -> Text)
"Tx "Format
  (Tx -> Lovelace -> Lovelace -> Text)
  (Tx -> Lovelace -> Lovelace -> Text)
-> Format Text (Tx -> Lovelace -> Lovelace -> Text)
-> Format Text (Tx -> Lovelace -> Lovelace -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format
  (Lovelace -> Lovelace -> Text) (Tx -> Lovelace -> Lovelace -> Text)
forall a r. Buildable a => Format r (a -> r)
build Format
  (Lovelace -> Lovelace -> Text) (Tx -> Lovelace -> Lovelace -> Text)
-> Format Text (Lovelace -> Lovelace -> Text)
-> Format Text (Tx -> Lovelace -> Lovelace -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
%Format
  (Lovelace -> Lovelace -> Text) (Lovelace -> Lovelace -> Text)
" fee "Format
  (Lovelace -> Lovelace -> Text) (Lovelace -> Lovelace -> Text)
-> Format Text (Lovelace -> Lovelace -> Text)
-> Format Text (Lovelace -> Lovelace -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (Lovelace -> Text) (Lovelace -> Lovelace -> Text)
forall a r. Buildable a => Format r (a -> r)
build Format (Lovelace -> Text) (Lovelace -> Lovelace -> Text)
-> Format Text (Lovelace -> Text)
-> Format Text (Lovelace -> Lovelace -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
%Format (Lovelace -> Text) (Lovelace -> Text)
"too low, expected "Format (Lovelace -> Text) (Lovelace -> Text)
-> Format Text (Lovelace -> Text) -> Format Text (Lovelace -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text (Lovelace -> Text)
forall a r. Buildable a => Format r (a -> r)
build) Tx
tx Lovelace
actual Lovelace
expected
      TxValidationWitnessWrongSignature TxInWitness
wit ProtocolMagicId
pmid TxSigData
sig ->
        Format Text (TxInWitness -> Text -> Text -> Text)
-> TxInWitness -> Text -> Text -> Text
forall a. Format Text a -> a
sformat (Format
  (TxInWitness -> Text -> Text -> Text)
  (TxInWitness -> Text -> Text -> Text)
"Bad witness "Format
  (TxInWitness -> Text -> Text -> Text)
  (TxInWitness -> Text -> Text -> Text)
-> Format Text (TxInWitness -> Text -> Text -> Text)
-> Format Text (TxInWitness -> Text -> Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (Text -> Text -> Text) (TxInWitness -> Text -> Text -> Text)
forall a r. Buildable a => Format r (a -> r)
build Format (Text -> Text -> Text) (TxInWitness -> Text -> Text -> Text)
-> Format Text (Text -> Text -> Text)
-> Format Text (TxInWitness -> Text -> Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
%Format (Text -> Text -> Text) (Text -> Text -> Text)
" for signature "Format (Text -> Text -> Text) (Text -> Text -> Text)
-> Format Text (Text -> Text -> Text)
-> Format Text (Text -> Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (Text -> Text) (Text -> Text -> Text)
forall r. Format r (Text -> r)
stext Format (Text -> Text) (Text -> Text -> Text)
-> Format Text (Text -> Text) -> Format Text (Text -> Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
%Format (Text -> Text) (Text -> Text)
" protocol magic id "Format (Text -> Text) (Text -> Text)
-> Format Text (Text -> Text) -> Format Text (Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text (Text -> Text)
forall r. Format r (Text -> r)
stext) TxInWitness
wit (TxSigData -> Text
forall a. Show a => a -> Text
textShow TxSigData
sig) (ProtocolMagicId -> Text
forall a. Show a => a -> Text
textShow ProtocolMagicId
pmid)
      TxValidationWitnessWrongKey TxInWitness
wit Address
addr ->
        Format Text (TxInWitness -> Address -> Text)
-> TxInWitness -> Address -> Text
forall a. Format Text a -> a
sformat (Format
  (TxInWitness -> Address -> Text) (TxInWitness -> Address -> Text)
"Bad witness "Format
  (TxInWitness -> Address -> Text) (TxInWitness -> Address -> Text)
-> Format Text (TxInWitness -> Address -> Text)
-> Format Text (TxInWitness -> Address -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (Address -> Text) (TxInWitness -> Address -> Text)
forall a r. Buildable a => Format r (a -> r)
build Format (Address -> Text) (TxInWitness -> Address -> Text)
-> Format Text (Address -> Text)
-> Format Text (TxInWitness -> Address -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
%Format (Address -> Text) (Address -> Text)
" for address "Format (Address -> Text) (Address -> Text)
-> Format Text (Address -> Text) -> Format Text (Address -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text (Address -> Text)
forall a r. Buildable a => Format r (a -> r)
build) TxInWitness
wit Address
addr
      TxValidationMissingInput TxIn
tx ->
        Format Text (TxIn -> Text) -> TxIn -> Text
forall a. Format Text a -> a
sformat (Format (TxIn -> Text) (TxIn -> Text)
"Validation cannot find input tx "Format (TxIn -> Text) (TxIn -> Text)
-> Format Text (TxIn -> Text) -> Format Text (TxIn -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text (TxIn -> Text)
forall a r. Buildable a => Format r (a -> r)
build) TxIn
tx
      -- Fields are <expected> <actual>
      TxValidationNetworkMagicMismatch NetworkMagic
expected NetworkMagic
actual ->
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [ Text
"Bad network magic  ", NetworkMagic -> Text
forall a. Show a => a -> Text
textShow NetworkMagic
actual, Text
", expected ", NetworkMagic -> Text
forall a. Show a => a -> Text
textShow NetworkMagic
expected ]
      TxValidationTxTooLarge Natural
expected Natural
actual ->
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [ Text
"Tx is ", Natural -> Text
forall a. Show a => a -> Text
textShow Natural
actual, Text
" bytes, but expected < ", Natural -> Text
forall a. Show a => a -> Text
textShow Natural
expected, Text
" bytes" ]
      TxValidationError
TxValidationUnknownAddressAttributes ->
        Text
"Unknown address attributes"
      TxValidationError
TxValidationUnknownAttributes ->
        Text
"Unknown attributes"

renderUTxOError :: UTxOError -> Text
renderUTxOError :: UTxOError -> Text
renderUTxOError UTxOError
ue =
  Text
"UTxOError: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    case UTxOError
ue of
      UTxOMissingInput TxIn
tx -> Format Text (TxIn -> Text) -> TxIn -> Text
forall a. Format Text a -> a
sformat (Format (TxIn -> Text) (TxIn -> Text)
"Lookup of tx "Format (TxIn -> Text) (TxIn -> Text)
-> Format Text (TxIn -> Text) -> Format Text (TxIn -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text (TxIn -> Text)
forall a r. Buildable a => Format r (a -> r)
build Format Text (TxIn -> Text)
-> Format Text Text -> Format Text (TxIn -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
%Format Text Text
" failed") TxIn
tx
      UTxOError
UTxOOverlappingUnion -> Text
"Union or two overlapping UTxO sets"

textShow :: Show a => a -> Text
textShow :: a -> Text
textShow = String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> String
forall a b. (Show a, ConvertText String b) => a -> b
show