git.iko.soy/typeable/connexpay
on master help sign in
Add customer info to authorise request (#6)
commit98c324f9335980465d6b690d06b43656f16c00fb authorUladzimir Stsepchanka <st.uladzimir@protonmail.com> dateWed 16 Apr 2025, 19:43 (1 year ago) parent9498948
4 files changed+53−15
compare with master
unifiedsplit
connexpay/src/Tool.hs+12−4 connexpay/src/Web/Connexpay/Payments.hs+33−10 connexpay/src/Web/Connexpay/Types.hs+4−1 connexpay/src/Web/Connexpay/Utils.hs+4
connexpay/src/Tool.hs+12−4
@@ -59,6 +59,12 @@ cmdParser = CmdLine <$> strOption (short 'c' <> metavar "FILE" <> help "Configur
5959 <*> fmap pure (argument str mempty)
6060 <*> argument expdate mempty
6161 <*> fmap pure (argument str mempty)
62+ <*> pure
63+ ( Just Customer
64+ { address1 = "123 Test St"
65+ , address2 = Nothing
66+ , zip = Just "EC1A1BB"
67+ } )
6268 expdate = do s <- str
6369 guard (length s == 4)
6470 pure (read (take 2 s), read (drop 2 s))
@@ -82,10 +88,12 @@ main = do cmdLine <- execParser (info (cmdParser <**> helper) mempty)
8288 Right cpi -> print =<< runConnexpay cpi (doThing cmdLine.operation)
8389
8490doThing :: Command -> ConnexpayM ()
85−doThing (AuthSale cc amt) = liftIO . print =<< authorisePayment cc usd pnr vendor
86− where usd = Money amt
87− pnr = Just "PNRPNR"
88− vendor = Just "Typeable payment"
91+doThing (AuthSale creditCard amt) = liftIO . print =<< authorisePayment AuthRequest
92+ { creditCard
93+ , amount = Money amt
94+ , invoice = Just "PNRPNR"
95+ , vendor = Just "Typeable payment"
96+ }
8997doThing (VoidAuth guid) = liftIO . print =<< voidPayment (VoidAuthorized guid)
9098doThing (VoidSale guid amt) = liftIO . print =<< voidPayment (VoidCaptured guid (Money <$> amt))
9199doThing (CaptureSale guid) = liftIO . print =<< capturePayment guid
connexpay/src/Web/Connexpay/Payments.hs+33−10
@@ -1,7 +1,11 @@
11{-# LANGUAGE DataKinds #-}
22{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE TemplateHaskell #-}
34{-# LANGUAGE UndecidableInstances #-}
5+
46module Web.Connexpay.Payments ( CreditCard(..)
7+ , AuthRequest(..)
8+ , Customer(..)
59 , AuthResponse(..)
610 , authorisePayment
711 , VoidRequest(..)
@@ -18,6 +22,7 @@ import Control.Monad.Reader (asks)
1822import Control.Monad.Writer.Strict
1923import Data.Aeson
2024import Data.Aeson.KeyMap qualified as KeyMap
25+import Data.Aeson.TH
2126import Data.Aeson.Types (Pair, typeMismatch)
2227import Data.ByteString.Lazy qualified as ByteString
2328import Data.Int (Int32)
@@ -33,6 +38,17 @@ import Web.Connexpay.Data
3338import Web.Connexpay.Types
3439import Web.Connexpay.Utils
3540
41+
42+data Customer = Customer { address1 :: Text
43+ , address2 :: Maybe Text
44+ , zip :: Maybe Text
45+ }
46+
47+deriveToJSON defaultOptions
48+ { fieldLabelModifier = capitalize
49+ , omitNothingFields = True
50+ } ''Customer
51+
3652-- | Credit card info
3753-- No 'Show' instance should be made for this type
3854-- in order to avoid sensitive data leaks.
@@ -40,8 +56,8 @@ data CreditCard = CreditCard { number :: Text -- ^ Credit card numbe
4056 , cardholder :: Maybe Text -- ^ Cardholder name, optional.
4157 , expiration :: (Word, Word) -- ^ Expiration date (month,year).
4258 , cvv :: Maybe Text -- ^ CVC/CVV code.
59+ , customer :: Maybe Customer -- ^ Required to get AVS
4360 }
44−
4561type ShowError = TypeError.Text "CreditCard must not be shown in order to avoid leaking sensitive data"
4662
4763instance TypeError ShowError => Show CreditCard where
@@ -57,6 +73,8 @@ instance ToJSON CreditCard where
5773 tell ["Cvv2" .= cvv]
5874 let expDate = padDate (tshow (snd cc.expiration)) <> padDate (tshow (fst cc.expiration))
5975 tell ["ExpirationDate" .= expDate]
76+ whenJust cc.customer $ \customer ->
77+ tell [ "Customer" .= customer ]
6078
6179padDate :: Text -> Text
6280padDate t | Text.length t == 1 = "0" <> t
@@ -125,13 +143,18 @@ instance FromJSON AuthResponse where
125143 <*> o .:? "cvvVerificationCode"
126144 parseJSON v = typeMismatch "AuthReponse" v
127145
146+data AuthRequest = AuthRequest { creditCard :: CreditCard
147+ , amount :: Money USD
148+ , invoice :: Maybe Text
149+ , vendor :: Maybe Text
150+ -- ^ Merchant description that will appear in a
151+ -- customer's statement.
152+ }
153+
128154-- | Authorise a credit card payment.
129−authorisePayment :: CreditCard -- ^ Credit card details (see 'CreditCard')
130− -> Money USD -- ^ Amount to charge, USD
131− -> Maybe Text -- ^ Invoice description
132− -> Maybe Text -- ^ Merchant description that will appear in a customer's statement.
155+authorisePayment :: AuthRequest
133156 -> ConnexpayM AuthResponse
134−authorisePayment cc amt invoice vendor =
157+authorisePayment request =
135158 do resp <- sendRequestJson "authonlys" body
136159 let rbody = responseBody resp
137160 -- Special case for Connexpay local transaction
@@ -144,11 +167,11 @@ authorisePayment cc amt invoice vendor =
144167 throwError (PaymentFailure LocalTransaction Nothing)
145168 pure rbody
146169 where body = execWriter $
147− do tell [ "Card" .= cc ]
148− tell [ "Amount" .= getAmount amt ]
149− whenJust invoice $ \i ->
170+ do tell [ "Card" .= request.creditCard ]
171+ tell [ "Amount" .= getAmount request.amount ]
172+ whenJust request.invoice $ \i ->
150173 tell [ "OrderNumber" .= i ]
151− whenJust vendor $ \v ->
174+ whenJust request.vendor $ \v ->
152175 tell [ "StatementDescription" .= v ]
153176 -- We are supposed to pass RiskData, but it still
154177 -- can be an empty object. Consider population this
connexpay/src/Web/Connexpay/Types.hs+4−1
@@ -13,6 +13,7 @@ import Data.Aeson
1313import Data.ByteString (ByteString)
1414import Data.Text (Text)
1515import Data.Text qualified as Text
16+import Data.Text.Encoding qualified as Text
1617import Data.UUID (UUID)
1718import Network.HTTP.Client as Client
1819import Network.HTTP.Req
@@ -52,6 +53,8 @@ instance MonadHttp ConnexpayM where
5253 let cfg =
5354 defaultHttpConfig
5455 { httpConfigAltManager = Just mgr
56+ , httpConfigBodyPreviewLength = 8192
57+ -- ^ Default of 1024 is definitely not enough
5558 , httpConfigLogResponse = logResponse log_ }
5659 pure cfg
5760
@@ -74,5 +77,5 @@ logResponse log_ _req resp body = log_ msg
7477 where msg = Text.unlines [ "Connexpay response:"
7578 , "HTTP code: " <> tshow (statusCode (responseStatus resp))
7679 , "Headers: " <> tshow (Client.responseHeaders resp)
77− , "Body: " <> tshow body
80+ , "Body: " <> Text.decodeUtf8Lenient body
7881 ]
connexpay/src/Web/Connexpay/Utils.hs+4
@@ -1,5 +1,6 @@
11module Web.Connexpay.Utils where
22
3+import Data.Char
34import Data.Text (Text)
45import Data.Text qualified as Text
56import Network.HTTP.Client qualified as Client
@@ -23,3 +24,6 @@ tshow = Text.pack . show
2324responseCode :: HttpResponse response => response -> Int
2425responseCode = statusCode . Client.responseStatus . toVanillaResponse
2526
27+capitalize :: String -> String
28+capitalize [] = []
29+capitalize (x : xs) = toUpper x : xs