diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +# wai-log-0.4 (2022-11-22) +* Parametrise the `LogMiddleware` type with an opaque type parameter for the request id +* Parametrise the `Options` record type with the opaque type parameter representing the request id +* Add new field to the `Options id` record type `logGetRequestId :: Request -> IO id` which represents a function for getting/generating a request id given a `Request` +* Update helper functions `logRequestId` and `requestId` to reflect changes to the request id type +* Add new helper function `mkOpaqueDefaultOptions` for building an `Options id` record for an opaque id +* Flatten the field structure of the log response emitted by `defaultLogResponse` + # wai-log-0.3 (2020-11-02) * Rename `mkApplicationLogger` into `mkLogMiddleware` 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 @@ -9,11 +9,11 @@ -- "body_length": "KnownLength 136", -- "method": \"POST\", -- "user_agent": "curl/7.68.0", --- "request_uuid": "f2c89425-9ec4-4cd2-ae56-4bab23681fce", +-- "request_id": "f2c89425-9ec4-4cd2-ae56-4bab23681fce", -- "remote_host": "127.0.0.1:34694" -- } -- 2020-10-27 12:30:23 INFO eid-server: Sending response { --- "request_uuid": "f2c89425-9ec4-4cd2-ae56-4bab23681fce" +-- "request_id": "f2c89425-9ec4-4cd2-ae56-4bab23681fce" -- } -- 2020-10-27 12:30:23 INFO eid-server: Request complete { -- "response_body": null, @@ -27,7 +27,7 @@ -- "process": 2.97493e-3, -- "full": 3.159565e-3 -- }, --- "request_uuid": "f2c89425-9ec4-4cd2-ae56-4bab23681fce" +-- "request_id": "f2c89425-9ec4-4cd2-ae56-4bab23681fce" -- } -- @ @@ -44,11 +44,12 @@ , defaultLogRequest , defaultLogResponse -- ** Helpers -, logRequestUUID +, logRequestId ) where import Prelude hiding (log) +import Data.Aeson (ToJSON) import Data.UUID (UUID) import Log (MonadLog, getLoggerIO) import Network.Wai @@ -60,18 +61,18 @@ -- that does not work when you want to pass logging context down to the -- 'Application'. -- --- 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 +-- Instead we pass an id to the 'Application', containing the +-- @request_id@, so it can be logged in the application's context. +type LogMiddleware id = (id -> Application) -> Application -- | Create a 'LogMiddleware' using 'defaultOptions' -- -- Use 'mkLogMiddlewareWith' for custom 'Options' -mkLogMiddleware :: MonadLog m => m LogMiddleware +mkLogMiddleware :: MonadLog m => m (LogMiddleware UUID) mkLogMiddleware = mkLogMiddlewareWith defaultOptions -- | Create a 'LogMiddleware' using the supplied 'Options' -mkLogMiddlewareWith :: MonadLog m => Options -> m LogMiddleware +mkLogMiddlewareWith :: (MonadLog m, ToJSON id) => Options id -> m (LogMiddleware id) 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,30 +1,28 @@ {-# LANGUAGE RecordWildCards #-} module Network.Wai.Log.Internal where -import Data.Aeson.Types (Value(..), object) +import Data.Aeson.Types (ToJSON, 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 (Application, responseToStream) -import Network.Wai.Log.Options (Options(..), ResponseTime(..), requestUUID) +import Network.Wai.Log.Options (Options(..), ResponseTime(..), requestId) -- | This type matches the one returned by 'getLoggerIO' type LoggerIO = UTCTime -> LogLevel -> Text -> Value -> IO () --- | Create a logging 'Middleware' that takes request UUID +-- | Create a logging 'Middleware' that takes request id -- given a 'LoggerIO' logging function and 'Options' -logRequestsWith :: LoggerIO -> Options -> (UUID -> Application) -> Application +logRequestsWith :: ToJSON id => LoggerIO -> Options id -> (id -> Application) -> Application logRequestsWith loggerIO Options{..} mkApp req respond = do - uuid <- nextRandom - logIO "Request received" $ logRequest uuid req + reqId <- logGetRequestId req + logIO "Request received" $ logRequest reqId req tStart <- getCurrentTime - mkApp uuid req $ \resp -> do + mkApp reqId req $ \resp -> do tEnd <- getCurrentTime - logIO "Sending response" . requestUUID $ uuid + logIO "Sending response" . requestId $ reqId r <- respond resp tFull <- getCurrentTime let processing = diffUTCTime tEnd tStart @@ -33,19 +31,19 @@ _ <- case logBody of Nothing -> - logIO "Request complete" $ logResponse uuid req resp Null times + logIO "Request complete" $ logResponse reqId 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 + logIO "Request complete" $ logResponse reqId req resp Null times Just bodyLogValueConstructor -> bodyToIO $ \streamingBodyToIO -> let logWithBuilder :: Builder -> IO () logWithBuilder b = logIO "Request complete" $ - logResponse uuid req resp (bodyLogValueConstructor b) times + logResponse reqId req resp (bodyLogValueConstructor b) times in streamingBodyToIO logWithBuilder (return ()) return r 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 @@ -7,16 +7,18 @@ , defaultLogRequest , defaultLogResponse -- * Helpers -, logRequestUUID -, requestUUID +, mkOpaqueDefaultOptions +, logRequestId +, requestId ) where -import Data.Aeson.Types (Pair, Value) +import Data.Aeson.Types (ToJSON, 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 Data.UUID.V4 (nextRandom) import Log import Network.HTTP.Types.Header (ResponseHeaders) import Network.HTTP.Types.Status (Status, statusCode, statusMessage) @@ -27,15 +29,17 @@ -- 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. +-- to be performed. -- The resulting @Maybe@ function is the constructor of a loggable @Value@ -- from the body bytestring builder. -data Options = Options { +data Options id = Options { logLevel :: LogLevel - , logRequest :: UUID -> Request -> [Pair] - , logResponse :: UUID -> Request -> Response -> Value -> ResponseTime -> [Pair] + , logRequest :: id -> Request -> [Pair] + , logResponse :: id -> Request -> Response -> Value -> ResponseTime -> [Pair] -- | An optional constructor of the response body log value. , logBody :: Maybe (Request -> Status -> ResponseHeaders -> Maybe (Builder -> Value)) + -- | A function for getting the request id + , logGetRequestId :: Request -> IO id } -- | Timing data @@ -52,16 +56,29 @@ -- { logLevel = 'LogInfo' -- , logRequest = 'defaultLogRequest' -- , logResponse = 'defaultLogResponse' +-- , logGetRequestId = 'const nextRandom' -- } -- @ -defaultOptions :: Options +defaultOptions :: Options UUID defaultOptions = Options { logLevel = LogInfo , logRequest = defaultLogRequest , logResponse = defaultLogResponse , logBody = Nothing + , logGetRequestId = const nextRandom } +-- | Build a default 'Options' record for an opaque id given a function +-- for retrieving an id. +mkOpaqueDefaultOptions :: ToJSON id => (Request -> IO id) -> Options id +mkOpaqueDefaultOptions getReqId = Options + { logLevel = LogInfo + , logRequest = defaultLogRequest + , logResponse = defaultLogResponse + , logBody = Nothing + , logGetRequestId = getReqId + } + -- | Logs the following request values: -- -- * request_uuid @@ -70,9 +87,9 @@ -- * remote host -- * user agent -- * body-length -defaultLogRequest :: UUID -> Request -> [Pair] -defaultLogRequest uuid req = - [ "request_uuid" .= uuid +defaultLogRequest :: ToJSON id => id -> Request -> [Pair] +defaultLogRequest reqId req = + [ "request_id" .= reqId , "method" .= ts (requestMethod req) , "url" .= ts (rawPathInfo req) , "remote_host" .= show (remoteHost req) @@ -82,7 +99,7 @@ -- | Logs the following values: -- --- * request_uuid +-- * request_id -- * request method -- * request url path -- * response_body details provided as 'Value' @@ -92,31 +109,29 @@ -- * time processing -- -- Time is in seconds as that is how 'NominalDiffTime' is treated by default -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 - ] - ] +defaultLogResponse :: ToJSON id => id -> Request -> Response -> Value -> ResponseTime -> [Pair] +defaultLogResponse reqId req resp responseBody time = + [ "request_id" .= reqId + , "method" .= ts (requestMethod req) + , "url" .= ts (rawPathInfo req) + , "response_body" .= responseBody + , "response_code" .= statusCode (responseStatus resp) + , "response_message" .= ts (statusMessage $ responseStatus resp) + , "full_time" .= full time + , "elapsed_time" .= 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 +-- | Helper to consistently log the request id in your application by adding +-- @request_id@ field to log's 'localData' +logRequestId :: (MonadLog m, ToJSON id) => id -> m a -> m a +logRequestId = localData . requestId -- | Logs the following values: -- --- * request_uuid -requestUUID :: UUID -> [Pair] -requestUUID uuid = - [ "request_uuid" .= uuid ] +-- * request_id +requestId :: ToJSON id => id -> [Pair] +requestId reqId = + [ "request_id" .= reqId ] 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.3.0.0 +version: 0.4.0.0 synopsis: A logging middleware for WAI applications @@ -23,8 +23,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.5, GHC ==8.8.4 +tested-with: GHC ==8.10.7, GHC ==9.2.4 Source-repository head Type: git