From 50c8a0e2204ba49e0a35526ae7c015788ef3468e Mon Sep 17 00:00:00 2001 From: Nick Date: Tue, 30 Apr 2024 16:12:32 +0000 Subject: [PATCH] Improve error handling a bit more. --- connexpay/src/Web/Connexpay.hs | 7 +++-- connexpay/src/Web/Connexpay/Data.hs | 46 +++++++++++++++++++++++++++- connexpay/src/Web/Connexpay/Init.hs | 1 + connexpay/src/Web/Connexpay/Types.hs | 34 +------------------- 4 files changed, 52 insertions(+), 36 deletions(-) diff --git a/connexpay/src/Web/Connexpay.hs b/connexpay/src/Web/Connexpay.hs index 58ebfe4..fbb339b 100644 --- a/connexpay/src/Web/Connexpay.hs +++ b/connexpay/src/Web/Connexpay.hs @@ -1,11 +1,14 @@ module Web.Connexpay ( module Payments , initConnexpay - , Connexpay + , Connexpay(..) , ConnexpayM , PaymentError(..) + , PaymentFailure(..) + , describeFailure , runConnexpay ) where +import Web.Connexpay.Data import Web.Connexpay.Init import Web.Connexpay.Payments as Payments -import Web.Connexpay.Types as Export +import Web.Connexpay.Types diff --git a/connexpay/src/Web/Connexpay/Data.hs b/connexpay/src/Web/Connexpay/Data.hs index 4b084c8..c4acf9d 100644 --- a/connexpay/src/Web/Connexpay/Data.hs +++ b/connexpay/src/Web/Connexpay/Data.hs @@ -1,11 +1,17 @@ {-# LANGUAGE OverloadedStrings #-} -module Web.Connexpay.Data ( TransactionStatus (..) +module Web.Connexpay.Data ( TransactionStatus(..) + , PaymentFailure(..) + , describeFailure + , guessFailure + , ErrorMessage(..) + , PaymentError(..) ) where import Data.Aeson import Data.Aeson.Types import Data.Maybe (fromMaybe) import Data.Text (Text) +import Network.HTTP.Client -- | Transaction status in Connexpay -- The list is taken from https://docs.connexpay.com/reference/search-sales @@ -30,3 +36,41 @@ statuses = [ ( "Transaction - Approved", TransactionApproved ) instance FromJSON TransactionStatus where parseJSON (String s) = pure (fromMaybe (TransactionOther s) (lookup s statuses)) parseJSON v = typeMismatch "TransactionStatus" v + +-- | Payment failure types. +-- This type describes failures that related to either credit card being invalid, +-- client account having insufficient funds, and other non-technical conditions. +-- FIXME: this list is not exhaustive. Add more values whenever we encounter them. +data PaymentFailure = CVVFailed -- ^ CVV verification failure + | CardInvalid -- ^ Credit card details are invalid + | InvalidAmount -- ^ Money amount is invalid + | LocalTransaction -- ^ Special case for transactions that were registered but did't go through somehow. + deriving (Eq, Show) + +describeFailure :: PaymentFailure -> Text +describeFailure CVVFailed = "CVV authorisation failure" +describeFailure CardInvalid = "Invalid credit card details" +describeFailure InvalidAmount = "Invalid amount of money requested" +describeFailure LocalTransaction = "Transaction registered but not processed. Consult with payment processor." + +-- | Guess failure type from HTTP code and supplied error string. +guessFailure :: Int -> Text -> Maybe PaymentFailure +guessFailure 422 "Error code D2020. CVV2 verification failed." = Just CVVFailed +guessFailure 422 "Error code D2005. Invalid Card." = Just CardInvalid +guessFailure 422 "Amount field don't allow a value greater than $999,999.99" = Just InvalidAmount +guessFailure _ _ = Nothing + +-- | Error response from Connexpay +data ErrorMessage = ErrorMessage { message :: Text + , errorId :: Text } + +instance FromJSON ErrorMessage where + parseJSON (Object o) = ErrorMessage <$> o .: "message" + <*> o .: "errorId" + parseJSON v = typeMismatch "ErrorMessage" v + +data PaymentError = ParseError String + | InvalidUrl String String + | HttpFailure HttpExceptionContent + | PaymentFailure PaymentFailure + deriving (Show) diff --git a/connexpay/src/Web/Connexpay/Init.hs b/connexpay/src/Web/Connexpay/Init.hs index d63ff4d..99f54e1 100644 --- a/connexpay/src/Web/Connexpay/Init.hs +++ b/connexpay/src/Web/Connexpay/Init.hs @@ -2,6 +2,7 @@ module Web.Connexpay.Init where import Web.Connexpay.Auth +import Web.Connexpay.Data import Web.Connexpay.Types import Web.Connexpay.Utils diff --git a/connexpay/src/Web/Connexpay/Types.hs b/connexpay/src/Web/Connexpay/Types.hs index 4513c3f..278aeab 100644 --- a/connexpay/src/Web/Connexpay/Types.hs +++ b/connexpay/src/Web/Connexpay/Types.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Web.Connexpay.Types where +import Web.Connexpay.Data import Web.Connexpay.Utils import Control.Concurrent.Async @@ -9,7 +10,6 @@ import Control.Monad.Except (MonadError, ExceptT, runExceptT, throwError) import Control.Monad.IO.Class import Control.Monad.Reader import Data.Aeson -import Data.Aeson.Types (typeMismatch) import Data.Text (Text) import Data.Text qualified as Text import Data.UUID (UUID) @@ -32,38 +32,6 @@ data Connexpay = Connexpay { logAction :: Text -> IO () , password :: Text } --- | Payment failure types. --- This type describes failures that related to either credit card being invalid, --- client account having insufficient funds, and other non-technical conditions. --- FIXME: this list is not exhaustive. Add more values whenever we encounter them. -data PaymentFailure = CVVFailed -- ^ CVV verification failure - | CardInvalid -- ^ Credit card details are invalid - | InvalidAmount -- ^ Money amount is invalid - | LocalTransaction -- ^ Special case for transactions that were registered but did't go through somehow. - deriving (Eq, Show) - --- | Guess failure type from HTTP code and supplied error string. -guessFailure :: Int -> Text -> Maybe PaymentFailure -guessFailure 422 "Error code D2020. CVV2 verification failed." = Just CVVFailed -guessFailure 422 "Error code D2005. Invalid Card." = Just CardInvalid -guessFailure 422 "Amount field don't allow a value greater than $999,999.99" = Just InvalidAmount -guessFailure _ _ = Nothing - --- | Error response from Connexpay -data ErrorMessage = ErrorMessage { message :: Text - , errorId :: Text } - -instance FromJSON ErrorMessage where - parseJSON (Object o) = ErrorMessage <$> o .: "message" - <*> o .: "errorId" - parseJSON v = typeMismatch "ErrorMessage" v - -data PaymentError = ParseError String - | InvalidUrl String String - | HttpFailure HttpExceptionContent - | PaymentFailure PaymentFailure - deriving (Show) - newtype ConnexpayM a = ConnexpayM (ReaderT Connexpay (ExceptT PaymentError IO) a) deriving (Functor, Applicative, Monad, MonadIO, MonadReader Connexpay, MonadError PaymentError)