91f3a86 · typeable/connexpay

git.iko.soy/typeable/connexpay

on master help sign in

Log responses via a callback inside req.

91f3a86Nick2 years ago

connexpay/src/Web/Connexpay/Payments.hs−1

compare with master

unifiedsplit

@@ -77,7 +77,6 @@ sendRequest' resp endpoint body =

77 r <- if tls

78 then reqCb POST (url https) jbody resp auth (logRequest obj)

79 else reqCb POST (url http) jbody resp auth (logRequest obj)

80− logResponse r

81 pure r

80 pure r

82 where

81 where

83 addGuid b =

82 addGuid b =

connexpay/src/Web/Connexpay/Types.hs+15−9

@@ -10,10 +10,11 @@ import Control.Monad.Except (MonadError, ExceptT, runExceptT, throwError)

10import Control.Monad.IO.Class

11import Control.Monad.Reader

12import Data.Aeson

13+import Data.ByteString (ByteString)

13import Data.Text (Text)

14import Data.Text (Text)

14import Data.Text qualified as Text

15import Data.Text qualified as Text

15import Data.UUID (UUID)

16import Data.UUID (UUID)

16−import Network.HTTP.Client hiding (responseHeaders)

17+import Network.HTTP.Client as Client

17import Network.HTTP.Req

18import Network.HTTP.Req

18import Network.HTTP.Types

19import Network.HTTP.Types

@@ -45,8 +46,14 @@ instance MonadHttp ConnexpayM where

45 , Just f <- guessFailure (statusCode $ responseStatus resp) err.message = throwError (PaymentFailure f)

46 , Just f <- guessFailure (statusCode $ responseStatus resp) err.message = throwError (PaymentFailure f)

46 handleHttpException (VanillaHttpException (HttpExceptionRequest _ c)) = throwError (ConnectionError $ HttpFailure c)

47 handleHttpException (VanillaHttpException (HttpExceptionRequest _ c)) = throwError (ConnectionError $ HttpFailure c)

49+ getHttpConfig =

48− getHttpConfig = do mgr <- asks (.manager)

50+ do mgr <- asks (.manager)

51+ log_ <- asks (.logAction)

52+ let cfg =

53+ defaultHttpConfig

49− pure (defaultHttpConfig { httpConfigAltManager = Just mgr })

54+ { httpConfigAltManager = Just mgr

55+ , httpConfigLogResponse = logResponse log_ }

56+ pure cfg

52runConnexpay :: Connexpay -> ConnexpayM a -> IO (Either ConnexpayError a)

59runConnexpay :: Connexpay -> ConnexpayM a -> IO (Either ConnexpayError a)

@@ -62,11 +69,10 @@ bearerToken :: ConnexpayM (Maybe BearerToken)

62bearerToken = do v <- asks (.bearerToken)

69bearerToken = do v <- asks (.bearerToken)

63 liftIO (readMVar v)

70 liftIO (readMVar v)

65−logResponse :: HttpResponse r => r -> ConnexpayM ()

72+logResponse :: (Text -> IO ()) -> Request -> Response a -> ByteString -> IO ()

66−logResponse r =

73+logResponse log_ _req resp body = log_ msg

67− do log_ <- asks (.logAction)

68− liftIO (log_ msg)

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

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

70− , "HTTP code: " <> tshow (responseCode r)

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

71− , "Headers: " <> tshow (responseHeaders r)

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

77+ , "Body: " <> tshow body

72 ]

78 ]

connexpay/src/Web/Connexpay/Utils.hs+2−2

@@ -17,8 +17,8 @@ whenJust Nothing _ = pure ()

17tshow :: Show a => a -> Text

18tshow = Text.pack . show

20−responseHeaders :: HttpResponse response => response -> [Header]

20+--responseHeaders :: HttpResponse response => response -> [Header]

21−responseHeaders = Client.responseHeaders . toVanillaResponse

21+--responseHeaders = Client.responseHeaders . toVanillaResponse

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

24responseCode = statusCode . Client.responseStatus . toVanillaResponse

stack.yaml+2−1

@@ -7,7 +7,8 @@ packages:

7extra-deps:

8 - git: https://github.com/typeable/bucks.git

9 commit: 9e378b675fe7fb88d5ddb3af068d82eb441f343c

10−

10+ - git: https://github.com/typeable/req.git

11+ commit: 8829ac5197f7a4b3f04b7fdfc3ea66cfe70ab0a5

11nix:

12nix:

12 packages: [zlib]

13 packages: [zlib]

13local-bin-path: bin

14local-bin-path: bin