98c324f · typeable/connexpay

git.iko.soy/typeable/connexpay

on master help sign in

Add customer info to authorise request (#6)

98c324fUladzimir Stsepchanka1 year ago

connexpay/src/Tool.hs+12−4

compare with master

unifiedsplit

@@ -59,6 +59,12 @@ cmdParser = CmdLine <$> strOption (short 'c' <> metavar "FILE" <> help "Configur

59 <*> fmap pure (argument str mempty)

60 <*> argument expdate mempty

61 <*> fmap pure (argument str mempty)

62+ <*> pure

63+ ( Just Customer

64+ { address1 = "123 Test St"

65+ , address2 = Nothing

66+ , zip = Just "EC1A1BB"

67+ } )

62 expdate = do s <- str

68 expdate = do s <- str

63 guard (length s == 4)

69 guard (length s == 4)

64 pure (read (take 2 s), read (drop 2 s))

70 pure (read (take 2 s), read (drop 2 s))

@@ -82,10 +88,12 @@ main = do cmdLine <- execParser (info (cmdParser <**> helper) mempty)

82 Right cpi -> print =<< runConnexpay cpi (doThing cmdLine.operation)

88 Right cpi -> print =<< runConnexpay cpi (doThing cmdLine.operation)

84doThing :: Command -> ConnexpayM ()

90doThing :: Command -> ConnexpayM ()

85−doThing (AuthSale cc amt) = liftIO . print =<< authorisePayment cc usd pnr vendor

91+doThing (AuthSale creditCard amt) = liftIO . print =<< authorisePayment AuthRequest

92+ { creditCard

86− where usd = Money amt

93+ , amount = Money amt

87− pnr = Just "PNRPNR"

94+ , invoice = Just "PNRPNR"

88− vendor = Just "Typeable payment"

95+ , vendor = Just "Typeable payment"

96+ }

89doThing (VoidAuth guid) = liftIO . print =<< voidPayment (VoidAuthorized guid)

97doThing (VoidAuth guid) = liftIO . print =<< voidPayment (VoidAuthorized guid)

90doThing (VoidSale guid amt) = liftIO . print =<< voidPayment (VoidCaptured guid (Money <$> amt))

98doThing (VoidSale guid amt) = liftIO . print =<< voidPayment (VoidCaptured guid (Money <$> amt))

91doThing (CaptureSale guid) = liftIO . print =<< capturePayment guid

99doThing (CaptureSale guid) = liftIO . print =<< capturePayment guid

connexpay/src/Web/Connexpay/Payments.hs+33−10

@@ -1,7 +1,11 @@

1{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE TemplateHaskell #-}

3{-# LANGUAGE UndecidableInstances #-}

4{-# LANGUAGE UndecidableInstances #-}

4module Web.Connexpay.Payments ( CreditCard(..)

6module Web.Connexpay.Payments ( CreditCard(..)

7+ , AuthRequest(..)

8+ , Customer(..)

5 , AuthResponse(..)

9 , AuthResponse(..)

6 , authorisePayment

10 , authorisePayment

7 , VoidRequest(..)

11 , VoidRequest(..)

@@ -18,6 +22,7 @@ import Control.Monad.Reader (asks)

18import Control.Monad.Writer.Strict

22import Control.Monad.Writer.Strict

19import Data.Aeson

23import Data.Aeson

20import Data.Aeson.KeyMap qualified as KeyMap

24import Data.Aeson.KeyMap qualified as KeyMap

25+import Data.Aeson.TH

21import Data.Aeson.Types (Pair, typeMismatch)

26import Data.Aeson.Types (Pair, typeMismatch)

22import Data.ByteString.Lazy qualified as ByteString

27import Data.ByteString.Lazy qualified as ByteString

23import Data.Int (Int32)

28import Data.Int (Int32)

@@ -33,6 +38,17 @@ import Web.Connexpay.Data

33import Web.Connexpay.Types

38import Web.Connexpay.Types

34import Web.Connexpay.Utils

39import Web.Connexpay.Utils

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+

36-- | Credit card info

52-- | Credit card info

37-- No 'Show' instance should be made for this type

53-- No 'Show' instance should be made for this type

38-- in order to avoid sensitive data leaks.

54-- in order to avoid sensitive data leaks.

@@ -40,8 +56,8 @@ data CreditCard = CreditCard { number :: Text -- ^ Credit card numbe

40 , cardholder :: Maybe Text -- ^ Cardholder name, optional.

56 , cardholder :: Maybe Text -- ^ Cardholder name, optional.

41 , expiration :: (Word, Word) -- ^ Expiration date (month,year).

57 , expiration :: (Word, Word) -- ^ Expiration date (month,year).

42 , cvv :: Maybe Text -- ^ CVC/CVV code.

58 , cvv :: Maybe Text -- ^ CVC/CVV code.

59+ , customer :: Maybe Customer -- ^ Required to get AVS

43 }

60 }

44−

45type ShowError = TypeError.Text "CreditCard must not be shown in order to avoid leaking sensitive data"

61type ShowError = TypeError.Text "CreditCard must not be shown in order to avoid leaking sensitive data"

47instance TypeError ShowError => Show CreditCard where

63instance TypeError ShowError => Show CreditCard where

@@ -57,6 +73,8 @@ instance ToJSON CreditCard where

57 tell ["Cvv2" .= cvv]

73 tell ["Cvv2" .= cvv]

58 let expDate = padDate (tshow (snd cc.expiration)) <> padDate (tshow (fst cc.expiration))

74 let expDate = padDate (tshow (snd cc.expiration)) <> padDate (tshow (fst cc.expiration))

59 tell ["ExpirationDate" .= expDate]

75 tell ["ExpirationDate" .= expDate]

76+ whenJust cc.customer $ \customer ->

77+ tell [ "Customer" .= customer ]

61padDate :: Text -> Text

79padDate :: Text -> Text

62padDate t | Text.length t == 1 = "0" <> t

80padDate t | Text.length t == 1 = "0" <> t

@@ -125,13 +143,18 @@ instance FromJSON AuthResponse where

125 <*> o .:? "cvvVerificationCode"

143 <*> o .:? "cvvVerificationCode"

126 parseJSON v = typeMismatch "AuthReponse" v

144 parseJSON v = typeMismatch "AuthReponse" v

127

145

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+

128-- | Authorise a credit card payment.

154-- | Authorise a credit card payment.

129−authorisePayment :: CreditCard -- ^ Credit card details (see 'CreditCard')

155+authorisePayment :: AuthRequest

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.

133 -> ConnexpayM AuthResponse

156 -> ConnexpayM AuthResponse

134−authorisePayment cc amt invoice vendor =

157+authorisePayment request =

135 do resp <- sendRequestJson "authonlys" body

158 do resp <- sendRequestJson "authonlys" body

136 let rbody = responseBody resp

159 let rbody = responseBody resp

137 -- Special case for Connexpay local transaction

160 -- Special case for Connexpay local transaction

@@ -144,11 +167,11 @@ authorisePayment cc amt invoice vendor =

144 throwError (PaymentFailure LocalTransaction Nothing)

167 throwError (PaymentFailure LocalTransaction Nothing)

145 pure rbody

168 pure rbody

146 where body = execWriter $

169 where body = execWriter $

147− do tell [ "Card" .= cc ]

170+ do tell [ "Card" .= request.creditCard ]

148− tell [ "Amount" .= getAmount amt ]

171+ tell [ "Amount" .= getAmount request.amount ]

149− whenJust invoice $ \i ->

172+ whenJust request.invoice $ \i ->

150 tell [ "OrderNumber" .= i ]

173 tell [ "OrderNumber" .= i ]

151− whenJust vendor $ \v ->

174+ whenJust request.vendor $ \v ->

152 tell [ "StatementDescription" .= v ]

175 tell [ "StatementDescription" .= v ]

153 -- We are supposed to pass RiskData, but it still

176 -- We are supposed to pass RiskData, but it still

154 -- can be an empty object. Consider population this

177 -- can be an empty object. Consider population this

connexpay/src/Web/Connexpay/Types.hs+4−1

@@ -13,6 +13,7 @@ import Data.Aeson

13import Data.ByteString (ByteString)

14import Data.Text (Text)

15import Data.Text qualified as Text

16+import Data.Text.Encoding qualified as Text

16import Data.UUID (UUID)

17import Data.UUID (UUID)

17import Network.HTTP.Client as Client

18import Network.HTTP.Client as Client

18import Network.HTTP.Req

19import Network.HTTP.Req

@@ -52,6 +53,8 @@ instance MonadHttp ConnexpayM where

52 let cfg =

53 let cfg =

53 defaultHttpConfig

54 defaultHttpConfig

54 { httpConfigAltManager = Just mgr

55 { httpConfigAltManager = Just mgr

56+ , httpConfigBodyPreviewLength = 8192

57+ -- ^ Default of 1024 is definitely not enough

55 , httpConfigLogResponse = logResponse log_ }

58 , httpConfigLogResponse = logResponse log_ }

56 pure cfg

59 pure cfg

@@ -74,5 +77,5 @@ logResponse log_ _req resp body = log_ msg

74 where msg = Text.unlines [ "Connexpay response:"

77 where msg = Text.unlines [ "Connexpay response:"

75 , "HTTP code: " <> tshow (statusCode (responseStatus resp))

78 , "HTTP code: " <> tshow (statusCode (responseStatus resp))

76 , "Headers: " <> tshow (Client.responseHeaders resp)

79 , "Headers: " <> tshow (Client.responseHeaders resp)

77− , "Body: " <> tshow body

80+ , "Body: " <> Text.decodeUtf8Lenient body

78 ]

81 ]

connexpay/src/Web/Connexpay/Utils.hs+4

@@ -1,5 +1,6 @@

1module Web.Connexpay.Utils where

3+import Data.Char

3import Data.Text (Text)

4import Data.Text (Text)

4import Data.Text qualified as Text

5import Data.Text qualified as Text

5import Network.HTTP.Client qualified as Client

6import Network.HTTP.Client qualified as Client

@@ -23,3 +24,6 @@ tshow = Text.pack . show

23responseCode :: HttpResponse response => response -> Int

24responseCode :: HttpResponse response => response -> Int

24responseCode = statusCode . Client.responseStatus . toVanillaResponse

25responseCode = statusCode . Client.responseStatus . toVanillaResponse

27+capitalize :: String -> String

28+capitalize [] = []

29+capitalize (x : xs) = toUpper x : xs