{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE MonoLocalBinds     #-}
{-# LANGUAGE OverloadedStrings  #-}
module Wallet.Emulator.Error where

import Control.Monad.Freer (Eff, Member)
import Control.Monad.Freer.Error (Error, throwError)
import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text)
import GHC.Generics (Generic)
import Prettyprinter (Pretty (pretty), viaShow, (<+>))

import Ledger (PaymentPubKeyHash, ValidationError, Value)
import Ledger.Tx.CardanoAPI (ToCardanoError)
import Ledger.Tx.Constraints qualified as Constraints
import Plutus.Script.Utils.Ada (Ada)

-- | An error thrown by wallet interactions.
data WalletAPIError =
    InsufficientFunds Text
    -- ^ There were insufficient funds to perform the desired operation.
    | ChangeHasLessThanNAda Value Ada
    -- ^ The change when selecting coins contains less than the minimum amount
    -- of Ada.
    | NoPaymentPubKeyHashError
    -- ^ The wallet doesn't have any payment key hash, which should not be
    -- possible.
    | PaymentPrivateKeyNotFound PaymentPubKeyHash
    -- ^ The private key of this public key hash is not known to the wallet.
    | ValidationError ValidationError
    -- ^ There was an error during off-chain validation.
    | ToCardanoError ToCardanoError
    -- ^ There was an error while converting to Cardano.API format.
    | PaymentMkTxError Constraints.MkTxError
    -- ^ There was an error while creating a payment transaction
    | RemoteClientFunctionNotYetSupported Text
    -- ^ The called wallet effect is not yet supported in a remote wallet client scenario.
    | OtherError Text
    -- ^ Some other error occurred.
    deriving stock (Int -> WalletAPIError -> ShowS
[WalletAPIError] -> ShowS
WalletAPIError -> String
(Int -> WalletAPIError -> ShowS)
-> (WalletAPIError -> String)
-> ([WalletAPIError] -> ShowS)
-> Show WalletAPIError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WalletAPIError] -> ShowS
$cshowList :: [WalletAPIError] -> ShowS
show :: WalletAPIError -> String
$cshow :: WalletAPIError -> String
showsPrec :: Int -> WalletAPIError -> ShowS
$cshowsPrec :: Int -> WalletAPIError -> ShowS
Show, WalletAPIError -> WalletAPIError -> Bool
(WalletAPIError -> WalletAPIError -> Bool)
-> (WalletAPIError -> WalletAPIError -> Bool) -> Eq WalletAPIError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WalletAPIError -> WalletAPIError -> Bool
$c/= :: WalletAPIError -> WalletAPIError -> Bool
== :: WalletAPIError -> WalletAPIError -> Bool
$c== :: WalletAPIError -> WalletAPIError -> Bool
Eq, (forall x. WalletAPIError -> Rep WalletAPIError x)
-> (forall x. Rep WalletAPIError x -> WalletAPIError)
-> Generic WalletAPIError
forall x. Rep WalletAPIError x -> WalletAPIError
forall x. WalletAPIError -> Rep WalletAPIError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WalletAPIError x -> WalletAPIError
$cfrom :: forall x. WalletAPIError -> Rep WalletAPIError x
Generic)

instance Pretty WalletAPIError where
    pretty :: WalletAPIError -> Doc ann
pretty = \case
        InsufficientFunds Text
t ->
            Doc ann
"Insufficient funds:" 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
pretty Text
t
        ChangeHasLessThanNAda Value
v Ada
ada ->
            Doc ann
"Coin change has less than" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Ada -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Ada
ada Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Value -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Value
v
        WalletAPIError
NoPaymentPubKeyHashError ->
            Doc ann
"No payment public hash found"
        PaymentPrivateKeyNotFound PaymentPubKeyHash
pk ->
            Doc ann
"Payment private key not found:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PaymentPubKeyHash -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow PaymentPubKeyHash
pk
        ValidationError ValidationError
e ->
            Doc ann
"Validation error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ValidationError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ValidationError
e
        ToCardanoError ToCardanoError
t ->
            Doc ann
"Error during conversion to a Cardano.Api format:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ToCardanoError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ToCardanoError
t
        PaymentMkTxError MkTxError
e ->
            Doc ann
"Payment transaction error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> MkTxError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty MkTxError
e
        RemoteClientFunctionNotYetSupported Text
e ->
            Doc ann
"Remote client function not yet supported:" 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
pretty Text
e
        OtherError Text
t ->
            Doc ann
"Other error:" 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
pretty Text
t

instance FromJSON WalletAPIError
instance ToJSON WalletAPIError

throwInsufficientFundsError :: Member (Error WalletAPIError) effs => Text -> Eff effs a
throwInsufficientFundsError :: Text -> Eff effs a
throwInsufficientFundsError = WalletAPIError -> Eff effs a
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs a)
-> (Text -> WalletAPIError) -> Text -> Eff effs a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> WalletAPIError
InsufficientFunds

throwOtherError :: Member (Error WalletAPIError) effs => Text -> Eff effs a
throwOtherError :: Text -> Eff effs a
throwOtherError = WalletAPIError -> Eff effs a
forall e (effs :: [* -> *]) a.
Member (Error e) effs =>
e -> Eff effs a
throwError (WalletAPIError -> Eff effs a)
-> (Text -> WalletAPIError) -> Text -> Eff effs a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> WalletAPIError
OtherError