filter-logger 0.3.0.0 → 0.4.0.0
raw patch · 6 files changed
+62/−17 lines, 6 filesdep +timedep +wai-loggerPVP ok
version bump matches the API change (PVP)
Dependencies added: time, wai-logger
API changes (from Hackage documentation)
+ Network.Wai.Middleware.FilterLogger.Internal: FilterOptions :: Bool -> Bool -> FilterOptions
+ Network.Wai.Middleware.FilterLogger.Internal: [detailed] :: FilterOptions -> Bool
+ Network.Wai.Middleware.FilterLogger.Internal: [logOnEmptyBody] :: FilterOptions -> Bool
+ Network.Wai.Middleware.FilterLogger.Internal: data FilterOptions
+ Network.Wai.Middleware.FilterLogger.Internal: instance Data.Default.Class.Default Network.Wai.Middleware.FilterLogger.Internal.FilterOptions
+ Network.Wai.Middleware.FilterLogger.Internal: mkDefaultFilterLogger :: (Loggable a) => LogFilter a -> Middleware
- Network.Wai.Middleware.FilterLogger.Internal: mkFilterLogger :: (Loggable a) => Bool -> LogFilter a -> Middleware
+ Network.Wai.Middleware.FilterLogger.Internal: mkFilterLogger :: (Loggable a) => FilterOptions -> LogFilter a -> Middleware
Files
- README.md +6/−0
- examples/basic/Main.hs +1/−1
- examples/password/Main.hs +1/−1
- filter-logger.cabal +3/−1
- src/Network/Wai/Middleware/FilterLogger.hs +4/−1
- src/Network/Wai/Middleware/FilterLogger/Internal.hs +47/−13
README.md view
@@ -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.
examples/basic/Main.hs view
@@ -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
examples/password/Main.hs view
@@ -50,5 +50,5 @@ post "/" $ text "SUCCESS" filterPasswords =- mkFilterLogger True hidePasswords+ mkDefaultFilterLogger hidePasswords where hidePasswords r@LoginRequest{..} = Just r {password = "*****"}
filter-logger.cabal view
@@ -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
src/Network/Wai/Middleware/FilterLogger.hs view
@@ -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)
src/Network/Wai/Middleware/FilterLogger/Internal.hs view
@@ -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)