wai-log 0.1.0.0 → 0.2.0.0

raw patch · 5 files changed

+164/−45 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• src/Network/Wai/Log.hs +22/−43
• src/Network/Wai/Log/Internal.hs +39/−0
• src/Network/Wai/Log/Options.hs +89/−0
• wai-log.cabal +6/−2

@@ -1,2 +1,10 @@+# wai-log-0.2 (not released)++* Entire interface has changed: now builds a `Middleware` in a `MonadLog`+  context+* Adds `Options` to control what is logged+* Currently logging behaviour is unchanged when using `defaultOptions`+ # wai-log-0.1 (2019-03-07)+ * Initial release (split from internal Scrive package).

@@ -1,8 +1,7 @@ -- | A simple logging middleware for WAI applications that supports the 'log-*' -- family of packages: <https://hackage.haskell.org/package/log-base> ----- Currently there are no logging options but contributions are welcome.--- When logging to @stdout@, the output looks like this:+-- When logging to @stdout@ using 'defaultOptions', the output looks like this: -- -- @ -- 2019-02-21 19:51:47 INFO my-server: Request received {@@ -25,50 +24,30 @@ -- } -- @ module Network.Wai.Log (-  logRequestsWith+-- * Create a Middleware+  mkApplicationLogger+, mkApplicationLoggerWith+-- ** Options+, Options(..)+, defaultOptions ) where -import Data.Aeson ()-import Data.String.Conversions (ConvertibleStrings, StrictText, cs)-import Data.Text (Text)-import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime)-import Log-import Network.HTTP.Types.Status-import Network.Wai---- | Given a logger, create a 'Middleware' that logs incoming requests, the--- response code, and how long it took to process and respond to the request.-logRequestsWith :: (LogT IO () -> IO ()) -> Middleware-logRequestsWith runLogger app req respond = do--  runLogger . logInfo "Request received" $ object-    [ "method"      .= ts (requestMethod req)-    , "url"         .= ts (rawPathInfo req)-    , "remote-host" .= show (remoteHost req)-    , "user-agent"  .= fmap ts (requestHeaderUserAgent req)-    , "body-length" .= show (requestBodyLength req)-    ]-  tStart <- getCurrentTime--  app req $ \resp -> do-    tEnd <- getCurrentTime-    runLogger $ logInfo_ "Sending response"-    r <- respond resp-    tFull <- getCurrentTime+import Prelude hiding (log) -    runLogger . logInfo "Request complete" $ object-      [ "status" .= object [ "code"    .= statusCode (responseStatus resp)-                           , "message" .= ts (statusMessage (responseStatus resp))-                           ]-      , "time"   .= object [ "full"    .= diffSeconds tFull tStart-                           , "process" .= diffSeconds tEnd tStart-                           ]-      ]+import Log (MonadLog, getLoggerIO)+import Network.Wai (Middleware) -    return r+import Network.Wai.Log.Internal+import Network.Wai.Log.Options -diffSeconds :: UTCTime -> UTCTime -> Double-diffSeconds a b = realToFrac $ diffUTCTime a b+-- | Create a logging 'Middleware' using 'defaultOptions'+--+-- Use 'mkApplicationLoggerWith' for custom 'Options'+mkApplicationLogger :: MonadLog m => m Middleware+mkApplicationLogger = mkApplicationLoggerWith defaultOptions -ts :: ConvertibleStrings a StrictText => a -> Text-ts = cs+-- | Create a logging 'Middleware' using the supplied 'Options'+mkApplicationLoggerWith :: MonadLog m => Options -> m Middleware+mkApplicationLoggerWith options = do+  logIO <- getLoggerIO+  return $ logRequestsWith logIO options

@@ -0,0 +1,39 @@+{-# LANGUAGE RecordWildCards #-}+module Network.Wai.Log.Internal where++import Control.Monad (when)+import Data.Aeson.Types (Value, object, emptyObject)+import Data.Text (Text)+import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime)+import Log (LogLevel)+import Network.Wai (Middleware)++import Network.Wai.Log.Options (Options(..), ResponseTime(..))++-- | 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+  tStart <- getCurrentTime+  app req $ \resp -> do+    tEnd <- getCurrentTime+    when logSendingResponse $+         logIO_ "Sending response"+    r <- respond resp+    tFull <- getCurrentTime+    let processing = diffUTCTime tEnd  tStart+        full       = diffUTCTime tFull tStart+        times      = ResponseTime{..}+    logIO "Request complete" . object $ logResponse req resp times+    return r++  where++    logIO message value = do+      now <- getCurrentTime+      loggerIO now logLevel message value++    logIO_ m = logIO m emptyObject

@@ -0,0 +1,89 @@+module Network.Wai.Log.Options (+-- * Options & Timing+  Options(..)+, ResponseTime(..)+-- * Defaults+, defaultOptions+, defaultLogRequest+, defaultLogResponse+) where++import Data.Aeson.Types (Pair)+import Data.String.Conversions (ConvertibleStrings, StrictText, cs)+import Data.Text (Text)+import Data.Time.Clock (NominalDiffTime)+import Log+import Network.HTTP.Types.Status+import Network.Wai++-- | Logging options+data Options = Options {+    logLevel            :: LogLevel+  , logRequest          :: Request -> [Pair]+  , logSendingResponse  :: Bool+  , logResponse         :: Request -> Response -> ResponseTime -> [Pair]+  }++-- | Timing data+data ResponseTime = ResponseTime {+  -- | Time between request received and application finished processing request+    processing :: NominalDiffTime+  -- | Time between request received and response sent+  , full       :: NominalDiffTime+  }++-- | Default 'Options'+--+-- @+-- { logLevel = 'LogInfo'+-- , logRequest = 'defaultLogRequest'+-- , logSendingResponse = True+-- , logResponse = 'defaultLogResponse'+-- }+-- @+defaultOptions :: Options+defaultOptions = Options+  { logLevel = LogInfo+  , logRequest = defaultLogRequest+  , logSendingResponse = True+  , logResponse = defaultLogResponse+  }++-- | Logs the following request values:+--+-- * 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)+  ]++-- | Logs the following values:+--+-- * 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)+                         , "message" .= ts (statusMessage (responseStatus resp))+                         ]+    , "time"   .= object [ "full"    .= full time+                         , "process" .= processing time+                         ]+    ]++ts :: ConvertibleStrings a StrictText => a -> Text+ts = cs

@@ -1,5 +1,6 @@+cabal-version:       2.0 name:                wai-log-version:             0.1.0.0+version:             0.2.0.0  synopsis:            A logging middleware for WAI applications @@ -21,8 +22,9 @@ license-file:        LICENSE  build-type:          Simple-cabal-version:       2.0 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  Source-repository head   Type:     git@@ -43,3 +45,5 @@                      , time                      , wai   exposed-modules:     Network.Wai.Log+                     , Network.Wai.Log.Options+                     , Network.Wai.Log.Internal