fb299e7 · typeable/wai

git.iko.soy/typeable/wai

Add output formatter with details and headers

This adds a custom log output formatter which includes response headers. The motivation for this is that I'd like to be able to add arbitrary and request-specific data from my [Yesod] application to the log output, and it seems the best way to do this is to add that data to response headers.

commitfb299e77bcffe6af3732fd9907ba4802031a90fc authorJezen Thomas <jezen@jezenthomas.com> dateTue 9 Jul 2019, 11:21 (7 years ago) parent135c56f

3 files changed+91−8

compare with master

unifiedsplit

wai-extra/Network/Wai/Middleware/RequestLogger.hs+56−6 wai-extra/Network/Wai/Middleware/RequestLogger/JSON.hs+34−1 wai-extra/wai-extra.cabal+1−1

wai-extra/Network/Wai/Middleware/RequestLogger.hs+56−6

@@ -14,6 +14,7 @@ module Network.Wai.Middleware.RequestLogger

1414 , OutputFormat (..)

1515 , OutputFormatter

1616 , OutputFormatterWithDetails

17+ , OutputFormatterWithDetailsAndHeaders

1718 , Destination (..)

1819 , Callback

1920 , IPAddrSource (..)

@@ -49,14 +50,42 @@ import Network.Wai.Middleware.RequestLogger.Internal

4950import Network.Wai.Header (contentLength)

5051import Data.Text.Encoding (decodeUtf8')

5152

52−data OutputFormat = Apache IPAddrSource

53− | Detailed Bool -- ^ use colors?

54− | CustomOutputFormat OutputFormatter

55− | CustomOutputFormatWithDetails OutputFormatterWithDetails

53+data OutputFormat

54+ = Apache IPAddrSource

55+ | Detailed Bool -- ^ use colors?

56+ | CustomOutputFormat OutputFormatter

57+ | CustomOutputFormatWithDetails OutputFormatterWithDetails

58+ | CustomOutputFormatWithDetailsAndHeaders OutputFormatterWithDetailsAndHeaders

5659

5760type OutputFormatter = ZonedDate -> Request -> Status -> Maybe Integer -> LogStr

58−type OutputFormatterWithDetails =

59− ZonedDate -> Request -> Status -> Maybe Integer -> NominalDiffTime -> [S8.ByteString] -> B.Builder -> LogStr

61+

62+type OutputFormatterWithDetails

63+ = ZonedDate

64+ -> Request

65+ -> Status

66+ -> Maybe Integer

67+ -> NominalDiffTime

68+ -> [S8.ByteString]

69+ -> B.Builder

70+ -> LogStr

71+

72+-- | Same as @OutputFormatterWithDetails@ but with response headers included

73+--

74+-- This is useful if you wish to include arbitrary application data in your

75+-- logs, e.g., an authenticated user ID, which you would set in a response

76+-- header in your application and retrieve in the log formatter.

77+--

78+-- @since 3.0.27

79+type OutputFormatterWithDetailsAndHeaders

80+ = ZonedDate -- ^ When the log message was generated

81+ -> Request -- ^ The WAI request

82+ -> Status -- ^ HTTP status code

83+ -> Maybe Integer -- ^ Response size

84+ -> NominalDiffTime -- ^ Duration of the request

85+ -> [S8.ByteString] -- ^ The request body

86+ -> B.Builder -- ^ Raw response

87+ -> [Header] -- ^ The response headers

88+ -> LogStr

6089

6190data Destination = Handle Handle

6291 | Logger LoggerSet

@@ -108,6 +137,9 @@ mkRequestLogger RequestLoggerSettings{..} = do

108137 CustomOutputFormatWithDetails formatter -> do

109138 getdate <- getDateGetter flusher

110139 return $ customMiddlewareWithDetails callbackAndFlush getdate formatter

140+ CustomOutputFormatWithDetailsAndHeaders formatter -> do

141+ getdate <- getDateGetter flusher

142+ return $ customMiddlewareWithDetailsAndHeaders callbackAndFlush getdate formatter

111143

112144apacheMiddleware :: ApacheLoggerActions -> Middleware

113145apacheMiddleware ala app req sendResponse = app req $ \res -> do

@@ -138,6 +170,24 @@ customMiddlewareWithDetails cb getdate formatter app req sendResponse = do

138170 readIORef builderIO

139171 return rspRcv

140172

173+customMiddlewareWithDetailsAndHeaders :: Callback -> IO ZonedDate -> OutputFormatterWithDetailsAndHeaders -> Middleware

174+customMiddlewareWithDetailsAndHeaders cb getdate formatter app req sendResponse = do

175+ (req', reqBody) <- getRequestBody req

176+ t0 <- getCurrentTime

177+ app req' $ \res -> do

178+ t1 <- getCurrentTime

179+ date <- liftIO getdate

180+ let msize = contentLength (responseHeaders res)

181+ builderIO <- newIORef $ B.byteString ""

182+ res' <- recordChunks builderIO res

183+ rspRcv <- sendResponse res'

184+ _ <- do

185+ rawResponse <- readIORef builderIO

186+ let status = responseStatus res'

187+ duration = t1 `diffUTCTime` t0

188+ resHeaders = responseHeaders res'

189+ liftIO . cb $ formatter date req' status msize duration reqBody rawResponse resHeaders

190+ return rspRcv

141191-- | Production request logger middleware.

142192--

143193-- This uses the 'Apache' logging format, and takes IP addresses for clients from

wai-extra/Network/Wai/Middleware/RequestLogger/JSON.hs+34−1

@@ -1,7 +1,10 @@

11{-# LANGUAGE RecordWildCards #-}

22{-# LANGUAGE CPP #-}

4−module Network.Wai.Middleware.RequestLogger.JSON (formatAsJSON) where

4+module Network.Wai.Middleware.RequestLogger.JSON

5+ ( formatAsJSON

6+ , formatAsJSONWithHeaders

7+ ) where

69import qualified Data.ByteString.Builder as BB (toLazyByteString)

710import Data.ByteString.Lazy (toStrict)

@@ -40,6 +43,30 @@ formatAsJSON date req status responseSize duration reqBody response =

4043 , "time" .= decodeUtf8With lenientDecode date

4144 ]) <> "\n"

4245

46+-- | Same as @formatAsJSON@ but with response headers included

47+--

48+-- This is useful for passing arbitrary data from your application out to the

49+-- WAI layer for it to be logged, but you may need to be careful to

50+-- subsequently redact any headers which may contain sensitive data.

51+--

52+-- @since 3.0.27

53+formatAsJSONWithHeaders :: OutputFormatterWithDetailsAndHeaders

54+formatAsJSONWithHeaders date req status resSize duration reqBody res resHeaders =

55+ toLogStr (encode $

56+ object

57+ [ "request" .= requestToJSON duration req reqBody

58+ , "response" .= object

59+ [ "status" .= statusCode status

60+ , "size" .= resSize

61+ , "headers" .= responseHeadersToJSON resHeaders

62+ , "body" .=

63+ if statusCode status >= 400

64+ then Just . decodeUtf8With lenientDecode . toStrict . BB.toLazyByteString $ res

65+ else Nothing

66+ ]

67+ , "time" .= decodeUtf8With lenientDecode date

68+ ]) <> "\n"

69+

4370word32ToHostAddress :: Word32 -> Text

4471word32ToHostAddress = T.intercalate "." . map (T.pack . show) . fromIPv4 . fromHostAddress

4572

@@ -90,6 +117,12 @@ requestHeadersToJSON = toJSON . map hToJ where

90117 hToJ ("Cookie", _) = toJSON ("Cookie" :: Text, "-RDCT-" :: Text)

91118 hToJ hd = headerToJSON hd

92119

120+responseHeadersToJSON :: [Header] -> Value

121+responseHeadersToJSON = toJSON . map hToJ where

122+ -- Redact cookies

123+ hToJ ("Set-Cookie", _) = toJSON ("Set-Cookie" :: Text, "-RDCT-" :: Text)

124+ hToJ hd = headerToJSON hd

125+

93126headerToJSON :: Header -> Value

94127headerToJSON (headerName, header) = toJSON (decodeUtf8With lenientDecode . original $ headerName, decodeUtf8With lenientDecode header)

95128

wai-extra/wai-extra.cabal+1−1

@@ -1,5 +1,5 @@

11Name: wai-extra

2−Version: 3.0.26.1

2+Version: 3.0.27

33Synopsis: Provides some basic WAI handlers and middleware.

44description:

55 Provides basic WAI handler and middleware functionality: