git.iko.soy/typeable/connexpay
on master help sign in
Slightly better error handling.
commit234bf5b10f9dbfac565addcdc4caf7472aef93fa authorNick <nick@typeable.io> dateFri 26 Apr 2024, 13:16 (2 years ago) parent1eac87f
4 files changed+52−8
compare with master
unifiedsplit
connexpay/connexpay.cabal+2 connexpay/src/Web/Connexpay/Data.hs+1−1 connexpay/src/Web/Connexpay/Payments.hs+14−3 connexpay/src/Web/Connexpay/Types.hs+35−4
connexpay/connexpay.cabal+2
@@ -36,6 +36,7 @@ library
3636 , bytestring
3737 , http-api-data
3838 , http-client
39+ , http-types
3940 , mtl
4041 , req
4142 , text
@@ -57,6 +58,7 @@ executable connexpay-tool
5758 , http-api-data
5859 , http-client
5960 , http-client-tls
61+ , http-types
6062 , mtl
6163 , optparse-applicative
6264 , req
connexpay/src/Web/Connexpay/Data.hs+1−1
@@ -16,7 +16,7 @@ data TransactionStatus = TransactionApproved -- ^ Obvious
1616 | TransactionCreatedProcError -- ^ Processor errored out
1717 | TransactionApprovedWarning -- ^ Wut 0__o FIXME: figure out what this is
1818 | TransactionOther Text -- ^ In case they return something unexpected
19− deriving (Show)
19+ deriving (Eq, Ord, Show)
2020
2121statuses :: [(Text, TransactionStatus)]
2222statuses = [ ( "Transaction - Approved", TransactionApproved )
connexpay/src/Web/Connexpay/Payments.hs+14−3
@@ -9,7 +9,8 @@ module Web.Connexpay.Payments ( CreditCard(..)
99 , cancelPayment
1010 ) where
1111
12−import Control.Monad (void)
12+import Control.Monad (when,void)
13+import Control.Monad.Except (throwError)
1314import Control.Monad.Reader (asks)
1415import Control.Monad.Writer.Strict
1516import Data.Aeson
@@ -95,8 +96,18 @@ authorisePayment :: CreditCard -- ^ Credit card details (see 'CreditCard')
9596 -> Money USD -- ^ Amount to charge, USD
9697 -> Maybe Text -- ^ Merchant description that will appear in a customer's statement.
9798 -> ConnexpayM AuthResponse
98−authorisePayment cc amt vendor = do resp <- sendRequestJson "authonlys" body
99− pure (responseBody resp)
99+authorisePayment cc amt vendor =
100+ do resp <- sendRequestJson "authonlys" body
101+ let rbody = responseBody resp
102+ -- Special case for Connexpay local transaction
103+ -- This status means that the transaction was registered,
104+ -- but Connexpay stopped its processing and it won't be
105+ -- moved any further.
106+ -- Also, when I asked Ken from Connexpay about this,
107+ -- he told me he had never seen this status before.
108+ when (rbody.status == TransactionCreatedLocal) $
109+ throwError (PaymentFailure LocalTransaction)
110+ pure rbody
100111 where body = execWriter $
101112 do tell [ "Card" .= cc ]
102113 tell [ "Amount" .= getAmount amt ]
connexpay/src/Web/Connexpay/Types.hs+35−4
@@ -8,11 +8,14 @@ import Control.Concurrent.MVar (MVar, readMVar)
88import Control.Monad.Except (MonadError, ExceptT, runExceptT, throwError)
99import Control.Monad.IO.Class
1010import Control.Monad.Reader
11+import Data.Aeson
12+import Data.Aeson.Types (typeMismatch)
1113import Data.Text (Text)
1214import Data.Text qualified as Text
1315import Data.UUID (UUID)
14−import Network.HTTP.Client (Manager, HttpException(..), HttpExceptionContent)
16+import Network.HTTP.Client
1517import Network.HTTP.Req
18+import Network.HTTP.Types
1619
1720type BearerToken = Text
1821type DeviceGuid = UUID
@@ -29,19 +32,47 @@ data Connexpay = Connexpay { logAction :: Text -> IO ()
2932 , password :: Text
3033 }
3134
32−data PaymentError = AuthFailure
33− | ParseError String
35+-- | Payment failure types.
36+-- This type describes failures that related to either credit card being invalid,
37+-- client account having insufficient funds, and other non-technical conditions.
38+-- FIXME: this list is not exhaustive. Add more values whenever we encounter them.
39+data PaymentFailure = CVVFailed -- ^ CVV verification failure
40+ | CardInvalid -- ^ Credit card details are invalid
41+ | InvalidAmount -- ^ Money amount is invalid
42+ | LocalTransaction -- ^ Special case for transactions that were registered but did't go through somehow.
43+ deriving (Eq, Show)
44+
45+-- | Guess failure type from HTTP code and supplied error string.
46+guessFailure :: Int -> Text -> Maybe PaymentFailure
47+guessFailure 422 "Error code D2020. CVV2 verification failed." = Just CVVFailed
48+guessFailure 422 "Error code D2005. Invalid Card." = Just CardInvalid
49+guessFailure 422 "Amount field don't allow a value greater than $999,999.99" = Just InvalidAmount
50+guessFailure _ _ = Nothing
51+
52+-- | Error response from Connexpay
53+data ErrorMessage = ErrorMessage { message :: Text
54+ , errorId :: Text }
55+
56+instance FromJSON ErrorMessage where
57+ parseJSON (Object o) = ErrorMessage <$> o .: "message"
58+ <*> o .: "errorId"
59+ parseJSON v = typeMismatch "ErrorMessage" v
60+
61+data PaymentError = ParseError String
3462 | InvalidUrl String String
3563 | HttpFailure HttpExceptionContent
64+ | PaymentFailure PaymentFailure
3665 deriving (Show)
3766
38−
3967newtype ConnexpayM a = ConnexpayM (ReaderT Connexpay (ExceptT PaymentError IO) a)
4068 deriving (Functor, Applicative, Monad, MonadIO, MonadReader Connexpay, MonadError PaymentError)
4169
4270instance MonadHttp ConnexpayM where
4371 handleHttpException (JsonHttpException e) = throwError (ParseError e)
4472 handleHttpException (VanillaHttpException (InvalidUrlException url why)) = throwError (InvalidUrl url why)
73+ handleHttpException (VanillaHttpException (HttpExceptionRequest _ (StatusCodeException resp bs)))
74+ | Just err <- decodeStrict @ErrorMessage bs
75+ , Just f <- guessFailure (statusCode $ responseStatus resp) err.message = throwError (PaymentFailure f)
4576 handleHttpException (VanillaHttpException (HttpExceptionRequest _ c)) = throwError (HttpFailure c)
4677
4778 getHttpConfig = do mgr <- asks (.manager)