@@ -17,6 +17,7 @@ import Control.Monad.Writer.Strict
1717import Data.Aeson
1818import Data.Aeson.KeyMap qualified as KeyMap
1919import Data.Aeson.Types (Pair, typeMismatch)
20+import Data.ByteString.Lazy qualified as ByteString
2021import Data.Int (Int32)
2122import Data.Money
2223import Data.Proxy
@@ -66,12 +67,35 @@ sendRequest' resp endpoint body =
6667 tls <- asks (.useTLS)
6768 let auth = header "Authorization" ("Bearer " <> Text.encodeUtf8 tok)
6869 url s = s host /: "api" /: "v1" /: endpoint
69− jbody <- ReqBodyJson . object <$> addGuid body
70+ obj <- object <$> addGuid body
71+ let jbody = ReqBodyJson obj
7072 if tls
71− then req POST (url https) jbody resp auth
72− else req POST (url http) jbody resp auth
73− where addGuid b = do guid <- asks (.deviceGuid)
74− return (b <> [ "DeviceGuid" .= show guid ])
73+ then reqCb POST (url https) jbody resp auth (logRequest obj)
74+ else reqCb POST (url http) jbody resp auth (logRequest obj)
75+ where
76+ addGuid b =
77+ do guid <- asks (.deviceGuid)
78+ return (b <> [ "DeviceGuid" .= show guid ])
79+ logRequest v r =
80+ do log_ <- asks (.logAction)
81+ -- Remove card info from logs
82+ let v' = case v of
83+ Object obj
84+ | Just c <- KeyMap.lookup "Card" obj -> Object (KeyMap.insert "Card" (replaceCard c) obj)
85+ other -> other
86+ msg = Text.unlines [ ""
87+ , Text.pack (show r)
88+ , Text.decodeUtf8 (ByteString.toStrict $ encode v')
89+ ]
90+ _ <- liftIO (log_ msg)
91+ return r
92+ replaceCard (Object c) =
93+ Object
94+ $ KeyMap.insert "CardNumber" (String "<REDACTED>")
95+ $ KeyMap.insert "Cvv2" (String "<REDACTED>")
96+ $ c
97+ replaceCard v = v
98+
7599
76100sendRequestJson :: FromJSON a => Text -> [Pair] -> ConnexpayM (JsonResponse a)
77101sendRequestJson = sendRequest' jsonResponse