diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -125,3 +125,9 @@ ``` you won't see anything in the server logs. + +## Customization + +Customizing the log filtering middleware can be done with the `FilterOptions` type. It supports two options currently: +* Detailed logging: Includes the request duration in milliseconds and the response body size. `True` by default. +* Log when the request body is empty: Boolean value indicating whether or not to create log messages when there is no request body. `True` by default. diff --git a/examples/basic/Main.hs b/examples/basic/Main.hs --- a/examples/basic/Main.hs +++ b/examples/basic/Main.hs @@ -37,7 +37,7 @@ post "/" $ text "SUCCESS" filteringMiddleware = - mkFilterLogger True (keepShortBodies >=> containing 'c') + mkDefaultFilterLogger (keepShortBodies >=> containing 'c') where keepShortBodies bs | BS.length bs < 10 = Just bs | otherwise = Nothing diff --git a/examples/password/Main.hs b/examples/password/Main.hs --- a/examples/password/Main.hs +++ b/examples/password/Main.hs @@ -50,5 +50,5 @@ post "/" $ text "SUCCESS" filterPasswords = - mkFilterLogger True hidePasswords + mkDefaultFilterLogger hidePasswords where hidePasswords r@LoginRequest{..} = Just r {password = "*****"} diff --git a/filter-logger.cabal b/filter-logger.cabal --- a/filter-logger.cabal +++ b/filter-logger.cabal @@ -1,5 +1,5 @@ name: filter-logger -version: 0.3.0.0 +version: 0.4.0.0 synopsis: Filterable request logging wai middleware. Change how data is logged and when. description: Composable filters to transform objects and control when they are written to server logs. homepage: https://github.com/caneroj1/filter-logger#readme @@ -25,8 +25,10 @@ , fast-logger , http-types , semigroups + , time , wai , wai-extra + , wai-logger default-language: Haskell2010 executable filter-logger-basic-exe diff --git a/src/Network/Wai/Middleware/FilterLogger.hs b/src/Network/Wai/Middleware/FilterLogger.hs --- a/src/Network/Wai/Middleware/FilterLogger.hs +++ b/src/Network/Wai/Middleware/FilterLogger.hs @@ -13,9 +13,12 @@ module X ) where -import Network.Wai.Middleware.FilterLogger.Internal as X (LogFilter, LogFilterable (..), +import Network.Wai.Middleware.FilterLogger.Internal as X (FilterOptions (..), + LogFilter, + LogFilterable (..), LogShowable (..), Loggable, logFilterJSON, logShowJSON, + mkDefaultFilterLogger, mkFilterLogger) diff --git a/src/Network/Wai/Middleware/FilterLogger/Internal.hs b/src/Network/Wai/Middleware/FilterLogger/Internal.hs --- a/src/Network/Wai/Middleware/FilterLogger/Internal.hs +++ b/src/Network/Wai/Middleware/FilterLogger/Internal.hs @@ -11,6 +11,7 @@ {-# OPTIONS_HADDOCK prune #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module Network.Wai.Middleware.FilterLogger.Internal where @@ -19,20 +20,38 @@ import Data.Aeson.Encode.Pretty import Data.ByteString (ByteString) import qualified Data.ByteString as BS hiding (ByteString) +import Data.ByteString.Builder (Builder) import qualified Data.ByteString.Lazy as BL (ByteString, fromStrict, toStrict) import Data.Char import Data.Default import Data.Semigroup +import Data.Time.Clock (NominalDiffTime) import Data.Word import Network.HTTP.Types.Status import Network.Wai +import Network.Wai.Logger import Network.Wai.Middleware.RequestLogger import System.IO.Unsafe import System.Log.FastLogger import Text.Printf (printf) +-- | Options for controlling log filtering. +data FilterOptions = FilterOptions { + -- | Boolean value indicating whether to log output should be detailed or not. + -- Details include the response size and request duration in ms. + -- Default is True. + detailed :: Bool + + -- | Boolean value indicating whether to log messages when there is no request body. + -- Default is True. + , logOnEmptyBody :: Bool + } + +instance Default FilterOptions where + def = FilterOptions True True + -- | Typeclass for types that can be converted into a strict 'ByteString' -- and be shown in a log. class LogShowable a where @@ -81,17 +100,27 @@ logFilter :: (Loggable a) => ByteString -> LogFilter a -> Maybe a logFilter bs lf = prep bs >>= lf --- | Given a valid 'LogFilter', construct a 'Middleware' value that --- will log messages where the request body of the incoming request passes --- the filter. Accepts an optional 'Bool' parameter for detailed logging or not. -mkFilterLogger :: (Loggable a) => Bool -> LogFilter a -> Middleware -mkFilterLogger detailed lf = unsafePerformIO $ - mkRequestLogger def { outputFormat = CustomOutputFormatWithDetails $ customOutputFormatter detailed lf } +-- | Make a filtering request logger with the default 'FilterOptions'. +mkDefaultFilterLogger :: (Loggable a) => LogFilter a -> Middleware +mkDefaultFilterLogger = mkFilterLogger def + +-- | Given a valid 'LogFilter' and custom 'FilterOptions', construct a filtering request logger. +mkFilterLogger :: (Loggable a) => FilterOptions -> LogFilter a -> Middleware +mkFilterLogger opts lf = unsafePerformIO $ + mkRequestLogger def { outputFormat = CustomOutputFormatWithDetails $ customOutputFormatter opts lf } {-# NOINLINE mkFilterLogger #-} -customOutputFormatter :: (Loggable a) => Bool -> LogFilter a -> OutputFormatterWithDetails -customOutputFormatter detail lf date req status responseSize time reqBody builder = - maybe mempty (logString detail) $ logFilter (BS.concat reqBody) lf +customOutputFormatter :: (Loggable a) => FilterOptions -> LogFilter a -> OutputFormatterWithDetails +customOutputFormatter FilterOptions{..} lf date req status responseSize time reqBody builder = + maybe mempty (buildLog detailed date req status responseSize time builder) bodyToLog + where bodyToLog + | null reqBody && logOnEmptyBody = Just BS.empty + | otherwise = logShow <$> logFilter (BS.concat reqBody) lf + +type MyOutputFormatter = ZonedDate -> Request -> Status -> Maybe Integer -> NominalDiffTime -> Builder -> ByteString -> LogStr + +buildLog :: Bool -> MyOutputFormatter +buildLog detail date req status responseSize time builder body = logString detail where toBS = BS.pack . map (fromIntegral . ord) @@ -100,7 +129,9 @@ inMS = printf "%.2f" . dfromRational $ toRational time * 1000 - header = date <> "\n" <> + header = rawPathInfo req <> + rawQueryString req <> "\n" <> + date <> "\n" <> toBS (show . fromIntegral $ statusCode status) <> " - " <> statusMessage status <> "\n" buildRespSize (Just s) = "Response Size: " <> toBS (show s) <> "\n" @@ -111,8 +142,11 @@ buildDetails True = buildRespSize responseSize <> buildDuration buildDetails False = "" - logString detailed msg = toLogStr ( + formattedBody + | BS.null body = body + | otherwise = body <> "\n" + + logString detailed = toLogStr ( header <> buildDetails detail <> - logShow msg <> - "\n") + formattedBody)