diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/src/Network/Wai/Log.hs b/src/Network/Wai/Log.hs --- a/src/Network/Wai/Log.hs +++ b/src/Network/Wai/Log.hs @@ -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 diff --git a/src/Network/Wai/Log/Internal.hs b/src/Network/Wai/Log/Internal.hs --- a/src/Network/Wai/Log/Internal.hs +++ b/src/Network/Wai/Log/Internal.hs @@ -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) diff --git a/src/Network/Wai/Log/Options.hs b/src/Network/Wai/Log/Options.hs --- a/src/Network/Wai/Log/Options.hs +++ b/src/Network/Wai/Log/Options.hs @@ -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 diff --git a/wai-log.cabal b/wai-log.cabal --- a/wai-log.cabal +++ b/wai-log.cabal @@ -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