wai-log 0.2.0.0 → 0.3.0.0

raw patch · 6 files changed

+156/−69 lines, 6 filesdep +bytestringdep +uuidPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, uuid

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−1
• README.md +2/−1
• src/Network/Wai/Log.hs +51/−27
• src/Network/Wai/Log/Internal.hs +34/−17
• src/Network/Wai/Log/Options.hs +53/−20
• wai-log.cabal +5/−3

@@ -1,4 +1,14 @@-# wai-log-0.2 (not released)+# wai-log-0.3 (2020-11-02)++* Rename `mkApplicationLogger` into `mkLogMiddleware`+* Generate ID for each request to correlate log messages+* Remove optional `logSendingResponse` and always log `Sending response`+* Log `method` and `url` in `defaultLogResponse` too+* Add `logBody` option to log `response_body` depending on the request and+  response parameters+* Use `snake_case` consistently in log output fields for `defaultOptions`++# wai-log-0.2 (2020-04-14)  * Entire interface has changed: now builds a `Middleware` in a `MonadLog`   context

@@ -1,4 +1,5 @@-# wai-log [![Hackage version](https://img.shields.io/hackage/v/wai-log.svg?label=Hackage)](https://hackage.haskell.org/package/wai-log) [![Build Status](https://secure.travis-ci.org/scrive/wai-log.svg?branch=master)](http://travis-ci.org/scrive/wai-log)+# wai-log [![Hackage version](https://img.shields.io/hackage/v/wai-log.svg?label=Hackage)](https://hackage.haskell.org/package/wai-log)+![Build & Test](https://github.com/scrive/wai-log/workflows/Build%20&%20Test/badge.svg)  A simple logging middleware for WAI applications that supports the `log-*` family of packages.

@@ -4,50 +4,74 @@ -- When logging to @stdout@ using 'defaultOptions', the output looks like this: -- -- @--- 2019-02-21 19:51:47 INFO my-server: Request received {---   \"url\": \"\/api\/myapi\",---   \"body-length\": \"KnownLength 0\",---   \"method\": \"GET\",---   \"user-agent\": \"curl\/7.54.0\",---   \"remote-host\": \"127.0.0.1:61249\"+-- 2020-10-27 12:30:23 INFO eid-server: Request received {+--   "url": "\/api\/v1\/transaction\/new",+--   "body_length": "KnownLength 136",+--   "method": \"POST\",+--   "user_agent": "curl/7.68.0",+--   "request_uuid": "f2c89425-9ec4-4cd2-ae56-4bab23681fce",+--   "remote_host": "127.0.0.1:34694" -- }--- 2019-02-21 19:51:47 INFO my-server: Sending response--- 2019-02-21 19:51:47 INFO my-server: Request complete {---   \"status\": {---     \"code\": 200,---     \"message\": \"OK\"+-- 2020-10-27 12:30:23 INFO eid-server: Sending response {+--   "request_uuid": "f2c89425-9ec4-4cd2-ae56-4bab23681fce"+-- }+-- 2020-10-27 12:30:23 INFO eid-server: Request complete {+--   "response_body": null,+--   "url": "\/api\/v1\/transaction\/new",+--   "method": \"POST\",+--   "status": {+--     "code": 400,+--     "message": "Bad Request" --   },---   \"time\": {---     \"process\": 2.224e-3,---     \"full\": 2.348e-3---   }+--   "time": {+--     "process": 2.97493e-3,+--     "full": 3.159565e-3+--   },+--   "request_uuid": "f2c89425-9ec4-4cd2-ae56-4bab23681fce" -- } -- @+ module Network.Wai.Log ( -- * Create a Middleware-  mkApplicationLogger-, mkApplicationLoggerWith+  mkLogMiddleware+, mkLogMiddlewareWith+-- ** Type+, LogMiddleware -- ** Options , Options(..)+, ResponseTime(..) , defaultOptions+, defaultLogRequest+, defaultLogResponse+-- ** Helpers+, logRequestUUID ) where  import Prelude hiding (log) +import Data.UUID (UUID) import Log (MonadLog, getLoggerIO)-import Network.Wai (Middleware)+import Network.Wai  import Network.Wai.Log.Internal import Network.Wai.Log.Options --- | Create a logging 'Middleware' using 'defaultOptions'+-- | The classic @wai@ 'Middleware' type is @Application -> Application@, but+-- that does not work when you want to pass logging context down to the+-- 'Application'. ----- Use 'mkApplicationLoggerWith' for custom 'Options'-mkApplicationLogger :: MonadLog m => m Middleware-mkApplicationLogger = mkApplicationLoggerWith defaultOptions+-- Instead we pass a 'UUID' to the 'Application', containting the+-- @request_uuid@, so it can be logged in the application's context.+type LogMiddleware = (UUID -> Application) -> Application --- | Create a logging 'Middleware' using the supplied 'Options'-mkApplicationLoggerWith :: MonadLog m => Options -> m Middleware-mkApplicationLoggerWith options = do-  logIO <- getLoggerIO-  return $ logRequestsWith logIO options+-- | Create a 'LogMiddleware' using 'defaultOptions'+--+-- Use 'mkLogMiddlewareWith' for custom 'Options'+mkLogMiddleware :: MonadLog m => m LogMiddleware+mkLogMiddleware = mkLogMiddlewareWith defaultOptions++-- | Create a 'LogMiddleware' using the supplied 'Options'+mkLogMiddlewareWith :: MonadLog m => Options -> m LogMiddleware+mkLogMiddlewareWith options = do+  loggerIO <- getLoggerIO+  return $ logRequestsWith loggerIO options

@@ -1,39 +1,56 @@ {-# LANGUAGE RecordWildCards #-} module Network.Wai.Log.Internal where -import Control.Monad (when)-import Data.Aeson.Types (Value, object, emptyObject)+import Data.Aeson.Types (Value(..), object)+import Data.ByteString.Builder (Builder) import Data.Text (Text) import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime)+import Data.UUID (UUID)+import Data.UUID.V4 (nextRandom) import Log (LogLevel)-import Network.Wai (Middleware)+import Network.Wai (Application, responseToStream) -import Network.Wai.Log.Options (Options(..), ResponseTime(..))+import Network.Wai.Log.Options (Options(..), ResponseTime(..), requestUUID)  -- | This type matches the one returned by 'getLoggerIO' type LoggerIO = UTCTime -> LogLevel -> Text -> Value -> IO () --- | Create a logging 'Middleware' given a 'LoggerIO' logging function and 'Options'-logRequestsWith :: LoggerIO -> Options -> Middleware-logRequestsWith loggerIO Options{..} app req respond = do-  logIO "Request received" . object . logRequest $ req+-- | Create a logging 'Middleware' that takes request UUID+-- given a 'LoggerIO' logging function and 'Options'+logRequestsWith :: LoggerIO -> Options -> (UUID -> Application) -> Application+logRequestsWith loggerIO Options{..} mkApp req respond = do+  uuid <- nextRandom+  logIO "Request received" $ logRequest uuid req   tStart <- getCurrentTime-  app req $ \resp -> do+  mkApp uuid req $ \resp -> do     tEnd <- getCurrentTime-    when logSendingResponse $-         logIO_ "Sending response"+    logIO "Sending response" . requestUUID $ uuid     r <- respond resp     tFull <- getCurrentTime     let processing = diffUTCTime tEnd  tStart         full       = diffUTCTime tFull tStart         times      = ResponseTime{..}-    logIO "Request complete" . object $ logResponse req resp times++    _ <- case logBody of+      Nothing ->+        logIO "Request complete" $ logResponse uuid req resp Null times+      Just bodyLogValueConstructorFunction ->+        let (status, responseHeaders, bodyToIO) = responseToStream resp+            mBodyLogValueConstructor =+              bodyLogValueConstructorFunction req status responseHeaders+        in case mBodyLogValueConstructor of+          Nothing ->+            logIO "Request complete" $ logResponse uuid req resp Null times+          Just bodyLogValueConstructor ->+            bodyToIO $ \streamingBodyToIO ->+              let logWithBuilder :: Builder -> IO ()+                  logWithBuilder b = logIO "Request complete" $+                    logResponse uuid req resp (bodyLogValueConstructor b) times++              in streamingBodyToIO logWithBuilder (return ())     return r    where--    logIO message value = do+    logIO message pairs = do       now <- getCurrentTime-      loggerIO now logLevel message value--    logIO_ m = logIO m emptyObject+      loggerIO now logLevel message (object pairs)

@@ -6,22 +6,36 @@ , defaultOptions , defaultLogRequest , defaultLogResponse+-- * Helpers+, logRequestUUID+, requestUUID ) where -import Data.Aeson.Types (Pair)+import Data.Aeson.Types (Pair, Value)+import Data.ByteString.Builder (Builder) import Data.String.Conversions (ConvertibleStrings, StrictText, cs) import Data.Text (Text) import Data.Time.Clock (NominalDiffTime)+import Data.UUID (UUID) import Log-import Network.HTTP.Types.Status+import Network.HTTP.Types.Header (ResponseHeaders)+import Network.HTTP.Types.Status (Status, statusCode, statusMessage) import Network.Wai  -- | Logging options+--+-- Logging response body involves extracting it from @Response@ via IO operations,+-- therefore the @logBody@ option takes @Request@, @Status@ and @ResponseHeaders@+-- as arguments to decide whether the IO operations of body extraction have+-- to be permormed.+-- The resulting @Maybe@ function is the constructor of a loggable @Value@+-- from the body bytestring builder. data Options = Options {-    logLevel            :: LogLevel-  , logRequest          :: Request -> [Pair]-  , logSendingResponse  :: Bool-  , logResponse         :: Request -> Response -> ResponseTime -> [Pair]+    logLevel    :: LogLevel+  , logRequest  :: UUID -> Request -> [Pair]+  , logResponse :: UUID -> Request -> Response -> Value -> ResponseTime -> [Pair]+  -- | An optional constructor of the response body log value.+  , logBody :: Maybe (Request -> Status -> ResponseHeaders -> Maybe (Builder -> Value))   }  -- | Timing data@@ -37,7 +51,6 @@ -- @ -- { logLevel = 'LogInfo' -- , logRequest = 'defaultLogRequest'--- , logSendingResponse = True -- , logResponse = 'defaultLogResponse' -- } -- @@@ -45,45 +58,65 @@ defaultOptions = Options   { logLevel = LogInfo   , logRequest = defaultLogRequest-  , logSendingResponse = True   , logResponse = defaultLogResponse+  , logBody = Nothing   }  -- | Logs the following request values: --+-- * request_uuid -- * method -- * url path -- * remote host -- * user agent -- * body-length-defaultLogRequest :: Request -> [Pair]-defaultLogRequest req =-  [ "method"      .= ts (requestMethod req)-  , "url"         .= ts (rawPathInfo req)-  , "remote-host" .= show (remoteHost req)-  , "user-agent"  .= fmap ts (requestHeaderUserAgent req)-  , "body-length" .= show (requestBodyLength req)+defaultLogRequest :: UUID -> Request -> [Pair]+defaultLogRequest uuid req =+  [ "request_uuid" .= uuid+  , "method"       .= ts (requestMethod req)+  , "url"          .= ts (rawPathInfo req)+  , "remote_host"  .= show (remoteHost req)+  , "user_agent"   .= fmap ts (requestHeaderUserAgent req)+  , "body_length"  .= show (requestBodyLength req)   ]  -- | Logs the following values: --+-- * request_uuid+-- * request method+-- * request url path+-- * response_body details provided as 'Value' -- * status code -- * status message -- * time full -- * time processing ----- Nothing from the 'Request' is logged--- -- Time is in seconds as that is how 'NominalDiffTime' is treated by default-defaultLogResponse :: Request -> Response -> ResponseTime -> [Pair]-defaultLogResponse _req resp time =-    [ "status" .= object [ "code"    .= statusCode (responseStatus resp)+defaultLogResponse :: UUID -> Request -> Response -> Value -> ResponseTime -> [Pair]+defaultLogResponse uuid req resp responseBody time =+    [ "request_uuid"  .= uuid+    , "method"        .= ts (requestMethod req)+    , "url"           .= ts (rawPathInfo req)+    , "response_body" .= responseBody+    , "status" .= object [ "code"    .= statusCode (responseStatus resp)                          , "message" .= ts (statusMessage (responseStatus resp))                          ]     , "time"   .= object [ "full"    .= full time                          , "process" .= processing time                          ]     ]++-- | Helper to consistently log the UUID in your application by adding+-- @request_uuid@ field to log's 'localData'+logRequestUUID :: MonadLog m => UUID -> m a -> m a+logRequestUUID = localData . requestUUID++-- | Logs the following values:+--+-- * request_uuid+requestUUID :: UUID -> [Pair]+requestUUID uuid =+  [ "request_uuid" .= uuid ]  ts :: ConvertibleStrings a StrictText => a -> Text ts = cs

@@ -1,6 +1,6 @@ cabal-version:       2.0 name:                wai-log-version:             0.2.0.0+version:             0.3.0.0  synopsis:            A logging middleware for WAI applications @@ -24,7 +24,7 @@ build-type:          Simple extra-source-files:  CHANGELOG.md, README.md tested-with:         GHC ==7.10.3, GHC ==8.0.2, GHC ==8.2.2, GHC ==8.4.4,-                     GHC ==8.6.4+                     GHC ==8.6.5, GHC ==8.8.4  Source-repository head   Type:     git@@ -38,12 +38,14 @@                      , FlexibleContexts   build-depends:       base >=4.8 && <5                      , aeson+                     , bytestring                      , http-types                      , log-base                      , string-conversions                      , text                      , time+                     , uuid                      , wai   exposed-modules:     Network.Wai.Log-                     , Network.Wai.Log.Options+  other-modules:       Network.Wai.Log.Options                      , Network.Wai.Log.Internal