@@ -10,10 +10,11 @@ import Control.Monad.Except (MonadError, ExceptT, runExceptT, throwError)
1010import Control.Monad.IO.Class
1111import Control.Monad.Reader
1212import Data.Aeson
13+import Data.ByteString (ByteString)
1314import Data.Text (Text)
1415import Data.Text qualified as Text
1516import Data.UUID (UUID)
16−import Network.HTTP.Client hiding (responseHeaders)
17+import Network.HTTP.Client as Client
1718import Network.HTTP.Req
1819import Network.HTTP.Types
1920
@@ -45,8 +46,14 @@ instance MonadHttp ConnexpayM where
4546 , Just f <- guessFailure (statusCode $ responseStatus resp) err.message = throwError (PaymentFailure f)
4647 handleHttpException (VanillaHttpException (HttpExceptionRequest _ c)) = throwError (ConnectionError $ HttpFailure c)
4748
48− getHttpConfig = do mgr <- asks (.manager)
49− pure (defaultHttpConfig { httpConfigAltManager = Just mgr })
49+ getHttpConfig =
50+ do mgr <- asks (.manager)
51+ log_ <- asks (.logAction)
52+ let cfg =
53+ defaultHttpConfig
54+ { httpConfigAltManager = Just mgr
55+ , httpConfigLogResponse = logResponse log_ }
56+ pure cfg
5057
5158
5259runConnexpay :: Connexpay -> ConnexpayM a -> IO (Either ConnexpayError a)
@@ -62,11 +69,10 @@ bearerToken :: ConnexpayM (Maybe BearerToken)
6269bearerToken = do v <- asks (.bearerToken)
6370 liftIO (readMVar v)
6471
65−logResponse :: HttpResponse r => r -> ConnexpayM ()
66−logResponse r =
67− do log_ <- asks (.logAction)
68− liftIO (log_ msg)
72+logResponse :: (Text -> IO ()) -> Request -> Response a -> ByteString -> IO ()
73+logResponse log_ _req resp body = log_ msg
6974 where msg = Text.unlines [ "Connexpay response:"
70− , "HTTP code: " <> tshow (responseCode r)
71− , "Headers: " <> tshow (responseHeaders r)
75+ , "HTTP code: " <> tshow (statusCode (responseStatus resp))
76+ , "Headers: " <> tshow (Client.responseHeaders resp)
77+ , "Body: " <> tshow body
7278 ]