git.iko.soy/typeable/connexpay
on master help sign in
Log response code and headers.
commitee228b2ec335ad0765c30304a260a04fd3a77a3d authorNick <nick@typeable.io> dateFri 9 Aug 2024, 14:28 (2 years ago) parent9a555e8
3 files changed+25−5
connexpay/src/Web/Connexpay/Payments.hs+5−4 connexpay/src/Web/Connexpay/Types.hs+10−1 connexpay/src/Web/Connexpay/Utils.hs+10
connexpay/src/Web/Connexpay/Payments.hs+5−4
@@ -69,9 +69,11 @@ sendRequest' resp endpoint body =
6969 url s = s host /: "api" /: "v1" /: endpoint
7070 obj <- object <$> addGuid body
7171 let jbody = ReqBodyJson obj
72− if tls
72+ r <- if tls
7373 then reqCb POST (url https) jbody resp auth (logRequest obj)
7474 else reqCb POST (url http) jbody resp auth (logRequest obj)
75+ logResponse r
76+ pure r
7577 where
7678 addGuid b =
7779 do guid <- asks (.deviceGuid)
@@ -83,8 +85,8 @@ sendRequest' resp endpoint body =
8385 Object obj
8486 | Just c <- KeyMap.lookup "Card" obj -> Object (KeyMap.insert "Card" (replaceCard c) obj)
8587 other -> other
86− msg = Text.unlines [ ""
87− , Text.pack (show r)
88+ msg = Text.unlines [ "Connexpay request:"
89+ , tshow r
8890 , Text.decodeUtf8 (ByteString.toStrict $ encode v')
8991 ]
9092 _ <- liftIO (log_ msg)
@@ -96,7 +98,6 @@ sendRequest' resp endpoint body =
9698 $ c
9799 replaceCard v = v
98100
99−
100101sendRequestJson :: FromJSON a => Text -> [Pair] -> ConnexpayM (JsonResponse a)
101102sendRequestJson = sendRequest' jsonResponse
102103
connexpay/src/Web/Connexpay/Types.hs+10−1
@@ -13,7 +13,7 @@ import Data.Aeson
1313import Data.Text (Text)
1414import Data.Text qualified as Text
1515import Data.UUID (UUID)
16−import Network.HTTP.Client
16+import Network.HTTP.Client hiding (responseHeaders)
1717import Network.HTTP.Req
1818import Network.HTTP.Types
1919
@@ -60,3 +60,12 @@ runConnexpay_ cp m =
6060bearerToken :: ConnexpayM BearerToken
6161bearerToken = do v <- asks (.bearerToken)
6262 liftIO (readMVar v)
63+
64+logResponse :: HttpResponse r => r -> ConnexpayM ()
65+logResponse r =
66+ do log_ <- asks (.logAction)
67+ liftIO (log_ msg)
68+ where msg = Text.unlines [ "Connexpay response:"
69+ , "HTTP code: " <> tshow (responseCode r)
70+ , "Headers: " <> tshow (responseHeaders r)
71+ ]
connexpay/src/Web/Connexpay/Utils.hs+10
@@ -2,6 +2,9 @@ module Web.Connexpay.Utils where
22
33import Data.Text (Text)
44import Data.Text qualified as Text
5+import Network.HTTP.Client qualified as Client
6+import Network.HTTP.Req
7+import Network.HTTP.Types
58
69whenLeft :: Monad m => Either a b -> (a -> m ()) -> m ()
710whenLeft (Left l) f = f l
@@ -13,3 +16,10 @@ whenJust Nothing _ = pure ()
1316
1417tshow :: Show a => a -> Text
1518tshow = Text.pack . show
19+
20+responseHeaders :: HttpResponse response => response -> [Header]
21+responseHeaders = Client.responseHeaders . toVanillaResponse
22+
23+responseCode :: HttpResponse response => response -> Int
24+responseCode = statusCode . Client.responseStatus . toVanillaResponse
25+