packages feed

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 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)