git.iko.soy/typeable/connexpay
on master help sign in
Revert "Log responses"
b051396Nick
connexpay/src/Web/Connexpay/Payments.hs+16−26
compare with master
unifiedsplit
@@ -12,8 +12,7 @@ module Web.Connexpay.Payments ( CreditCard(..)
12 , returnPayment
12 , returnPayment
13 ) where
13 ) where
14
14
15−import Control.Exception (throwIO)
15+import Control.Monad (when,void)
16−import Control.Monad (when)
17import Control.Monad.Except (throwError)
16import Control.Monad.Except (throwError)
18import Control.Monad.Reader (asks)
17import Control.Monad.Reader (asks)
19import Control.Monad.Writer.Strict
18import Control.Monad.Writer.Strict
@@ -63,10 +62,8 @@ padDate :: Text -> Text
63padDate t | Text.length t == 1 = "0" <> t
62padDate t | Text.length t == 1 = "0" <> t
64 | otherwise = t
63 | otherwise = t
65
64
66−sendRequest' :: HttpResponse resp
65+sendRequest' :: HttpResponse resp => Proxy resp -> Text -> [Pair] -> ConnexpayM resp
67− => Proxy resp -> Text -> (forall scheme. Option scheme) -> [Pair]
68− -> ConnexpayM resp
69−sendRequest' resp endpoint opts body =
66+sendRequest' resp endpoint body =
70 do mtok <- bearerToken
67 do mtok <- bearerToken
71 tok <- case mtok of
68 tok <- case mtok of
72 Just t -> pure t
69 Just t -> pure t
@@ -74,13 +71,13 @@ sendRequest' resp endpoint opts body =
74 host <- asks (.url)
71 host <- asks (.url)
75 tls <- asks (.useTLS)
72 tls <- asks (.useTLS)
76 let auth = header "Authorization" ("Bearer " <> Text.encodeUtf8 tok)
73 let auth = header "Authorization" ("Bearer " <> Text.encodeUtf8 tok)
77− headers = auth <> opts
78 url s = s host /: "api" /: "v1" /: endpoint
74 url s = s host /: "api" /: "v1" /: endpoint
79 obj <- object <$> addGuid body
75 obj <- object <$> addGuid body
80 let jbody = ReqBodyJson obj
76 let jbody = ReqBodyJson obj
81 r <- if tls
77 r <- if tls
82− then reqCb POST (url https) jbody resp headers (logRequest obj)
78+ then reqCb POST (url https) jbody resp auth (logRequest obj)
83− else reqCb POST (url http) jbody resp headers (logRequest obj)
79+ else reqCb POST (url http) jbody resp auth (logRequest obj)
80+ logResponse r
84 pure r
81 pure r
85 where
82 where
86 addGuid b =
83 addGuid b =
@@ -106,21 +103,11 @@ sendRequest' resp endpoint opts body =
106 $ c
103 $ c
107 replaceCard v = v
104 replaceCard v = v
108
105
109−sendRequestJson :: FromJSON a => Text -> [Pair] -> ConnexpayM a
106+sendRequestJson :: FromJSON a => Text -> [Pair] -> ConnexpayM (JsonResponse a)
110−sendRequestJson endpoint body = do
107+sendRequestJson = sendRequest' jsonResponse
111− r <- sendRequest' lbsResponse endpoint accept body
112− let b = responseBody r
113− logResponseBody r b
114− case eitherDecode b of
115− Right x -> return x
116− Left e -> liftIO (throwIO (JsonHttpException e))
117− where
118− accept = header "Accept" "application/json"
119
108
120sendRequest_ :: Text -> [Pair] -> ConnexpayM ()
109sendRequest_ :: Text -> [Pair] -> ConnexpayM ()
121−sendRequest_ ep body = do
122− r <- sendRequest' ignoreResponse ep mempty body
110+sendRequest_ ep = void . sendRequest' ignoreResponse ep
123− logResponse r
124
111
125data AuthResponse = AuthResponse { paymentGuid :: AuthOnlyGuid
112data AuthResponse = AuthResponse { paymentGuid :: AuthOnlyGuid
126 , status :: TransactionStatus
113 , status :: TransactionStatus
@@ -146,7 +133,8 @@ authorisePayment :: CreditCard -- ^ Credit card details (see 'CreditCard')
146 -> Maybe Text -- ^ Merchant description that will appear in a customer's statement.
133 -> Maybe Text -- ^ Merchant description that will appear in a customer's statement.
147 -> ConnexpayM AuthResponse
134 -> ConnexpayM AuthResponse
148authorisePayment cc amt invoice vendor =
135authorisePayment cc amt invoice vendor =
149− do rbody <- sendRequestJson "authonlys" body
136+ do resp <- sendRequestJson "authonlys" body
137+ let rbody = responseBody resp
150 -- Special case for Connexpay local transaction
138 -- Special case for Connexpay local transaction
151 -- This status means that the transaction was registered,
139 -- This status means that the transaction was registered,
152 -- but Connexpay stopped its processing and it won't be
140 -- but Connexpay stopped its processing and it won't be
@@ -168,8 +156,7 @@ authorisePayment cc amt invoice vendor =
168 -- should the need arise.
156 -- should the need arise.
169 tell [ "RiskData" .= KeyMap.empty @() ]
157 tell [ "RiskData" .= KeyMap.empty @() ]
170
158
171−data VoidRequest = VoidAuthorized AuthOnlyGuid
159+data VoidRequest = VoidAuthorized AuthOnlyGuid | VoidCaptured SaleGuid (Maybe (Money USD))
172− | VoidCaptured SaleGuid (Maybe (Money USD))
173
160
174-- | Void payment
161-- | Void payment
175voidPayment :: VoidRequest
162voidPayment :: VoidRequest
@@ -206,7 +193,10 @@ instance FromJSON CaptureResponse where
206-- | Capture payment, previously authorised through 'authorisePayment'.
193-- | Capture payment, previously authorised through 'authorisePayment'.
207capturePayment :: SaleGuid -- ^ Sales GUID, obtained from 'authorisePayment'.
194capturePayment :: SaleGuid -- ^ Sales GUID, obtained from 'authorisePayment'.
208 -> ConnexpayM CaptureResponse
195 -> ConnexpayM CaptureResponse
196+capturePayment pid =
209−capturePayment pid = sendRequestJson "Captures" body
197+ do resp <- sendRequestJson "Captures" body
198+ let rbody = responseBody resp
199+ pure rbody
210 where body = [ "AuthOnlyGuid" .= show pid
200 where body = [ "AuthOnlyGuid" .= show pid
211 , "ConnexPayTransaction" .= CPTransaction 1 ]
201 , "ConnexPayTransaction" .= CPTransaction 1 ]
212
202
connexpay/src/Web/Connexpay/Types.hs+1−12
@@ -10,11 +10,10 @@ import Control.Monad.Except (MonadError, ExceptT, runExceptT, throwError)
10import Control.Monad.IO.Class
10import Control.Monad.IO.Class
11import Control.Monad.Reader
11import Control.Monad.Reader
12import Data.Aeson
12import Data.Aeson
13−import Data.ByteString.Lazy (ByteString)
14import Data.Text (Text)
13import Data.Text (Text)
15import Data.Text qualified as Text
14import Data.Text qualified as Text
16import Data.UUID (UUID)
15import Data.UUID (UUID)
17−import Network.HTTP.Client hiding (responseBody, responseHeaders)
16+import Network.HTTP.Client hiding (responseHeaders)
18import Network.HTTP.Req
17import Network.HTTP.Req
19import Network.HTTP.Types
18import Network.HTTP.Types
20
19
@@ -71,13 +70,3 @@ logResponse r =
71 , "HTTP code: " <> tshow (responseCode r)
70 , "HTTP code: " <> tshow (responseCode r)
72 , "Headers: " <> tshow (responseHeaders r)
71 , "Headers: " <> tshow (responseHeaders r)
73 ]
72 ]
74−
75−logResponseBody :: HttpResponse resp => resp -> ByteString -> ConnexpayM ()
76−logResponseBody r body =
77− do log_ <- asks (.logAction)
78− liftIO (log_ msg)
79− where msg = Text.unlines [ "Connexpay response:"
80− , "HTTP code: " <> tshow (responseCode r)
81− , "Headers: " <> tshow (responseHeaders r)
82− , "Body: " <> tshow body
83− ]