wai-log 0.3.0.0 → 0.4.0.0

raw patch · 5 files changed

+79/−58 lines, 5 filesnew-uploaderPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• src/Network/Wai/Log.hs +10/−9
• src/Network/Wai/Log/Internal.hs +11/−13
• src/Network/Wai/Log/Options.hs +48/−33
• wai-log.cabal +2/−3

@@ -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`

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

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

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

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