From 510978d29894ccb5af463574fcfcaf1a7af7ddc4 Mon Sep 17 00:00:00 2001 From: Maxim Koltsov Date: Thu, 19 Nov 2020 14:46:32 +0300 Subject: [PATCH] version 0.1.3.1: optimize logging middleware (#18) --- CHANGELOG.md | 5 ++ src/Web/Template/Log.hs | 110 ++++++++++++++++++++-------------------- web-template.cabal | 2 +- 3 files changed, 61 insertions(+), 56 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e0d83dc..cadf1e5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased] +## [0.1.3.1] - 2020-11-19 +### Changed +- Rewrite logging middleware: do not force reading the whole request before passing it to the + application. + ## [0.1.3.0] - 2020-10-14 ### Added - `servant` support. diff --git a/src/Web/Template/Log.hs b/src/Web/Template/Log.hs index 4579e34..43de759 100644 --- a/src/Web/Template/Log.hs +++ b/src/Web/Template/Log.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} module Web.Template.Log @@ -5,70 +6,69 @@ module Web.Template.Log , bcdlog400 ) where -import Data.Aeson (pairs, (.=)) -import Data.Aeson.Encoding (encodingToLazyByteString) -import Data.ByteString.Builder (toLazyByteString) -import Data.Default (Default (..)) -import Data.Text as T (Text, pack, unpack, unwords) -import Data.Text.Encoding (decodeUtf8) -import qualified Data.Text.Lazy.Encoding as TLE (decodeUtf8) -import Data.Time (ZonedTime, defaultTimeLocale, formatTime, - nominalDiffTimeToSeconds, parseTimeM, - zonedTimeToUTC) -import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) -import Network.HTTP.Types.Status (Status (..)) -import Network.Wai (Middleware, rawPathInfo, requestMethod) -import Network.Wai.Logger (ZonedDate) -import Network.Wai.Middleware.RequestLogger (OutputFormat (..), - OutputFormatterWithDetails, mkRequestLogger, - outputFormat) -import System.BCD.Log (Level (..)) -import System.IO.Unsafe (unsafePerformIO) -import System.Log.FastLogger (toLogStr) +import Data.Aeson (fromEncoding, pairs, (.=)) +import Data.ByteString.Builder (hPutBuilder, toLazyByteString) +import Data.Text as T (Text, pack, unwords) +import Data.Text.Encoding (decodeUtf8) +import qualified Data.Text.Encoding.Error as TE +import qualified Data.Text.Lazy.Encoding as TLE (decodeUtf8With) +import Data.Time (ZonedTime, defaultTimeLocale, formatTime, + nominalDiffTimeToSeconds, utcToLocalZonedTime) +import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime, posixSecondsToUTCTime) +import Network.HTTP.Types.Status (Status (..)) +import Network.Wai (Middleware, rawPathInfo, requestMethod, responseStatus) +import Network.Wai.Internal (Response (..)) +import System.BCD.Log (Level (..)) +import System.IO (stdout) -{-# NOINLINE bcdlog #-} bcdlog :: Middleware -bcdlog = unsafePerformIO $ mkRequestLogger def - { outputFormat = CustomOutputFormatWithDetails $ formatter False - } +bcdlog = logMiddleware False -{-# NOINLINE bcdlog400 #-} bcdlog400 :: Middleware -bcdlog400 = unsafePerformIO $ mkRequestLogger def - { outputFormat = CustomOutputFormatWithDetails $ formatter True - } +bcdlog400 = logMiddleware True -formatter :: Bool -> OutputFormatterWithDetails -formatter log400 zonedDate request status _ _ _ respBody = do - let - zonedTime = parseZonedDate zonedDate - statusC = statusCode status - method = decodeUtf8 $ requestMethod request - url = decodeUtf8 $ rawPathInfo request - msg' = T.unwords [method, url, pack (show statusC)] +logMiddleware :: Bool -> Middleware +logMiddleware log400 app request respond = do + let + url = decodeUtf8 $ rawPathInfo request + method = decodeUtf8 $ requestMethod request + start <- getPOSIXTime + startZoned <- utcToLocalZonedTime $ posixSecondsToUTCTime start - -- Construct extended log record effectively by rendering directly to JSON, without - -- intermediate Value step. - res = pairs - ( "datetime" .= toIso zonedTime - <> "timestamp" .= toMs zonedTime - <> "level" .= INFO - <> "app" .= ("scotty" :: Text) - <> "msg" .= msg' - <> "status" .= statusC - <> "url" .= url + app request $ \response -> do + finishApp <- getPOSIXTime + !rcv <- respond response + finishNetwork <- getPOSIXTime + let + statusC = statusCode $ responseStatus response + msg' = T.unwords [method, url, pack (show statusC)] + responseBody = + case response of + -- Logger from wai-extra also reads streaming responses, + -- but those may be big. + ResponseBuilder _ _ b -> Just b + _ -> Nothing + logLine = pairs + ( "datetime" .= toIso startZoned + <> "timestamp" .= floor @_ @Int (toMs start) + <> "duration" .= toMs (finishApp - start) + <> "send_duration" .= toMs (finishNetwork - finishApp) + <> "level" .= INFO + <> "app" .= ("scotty" :: Text) + <> "msg" .= msg' + <> "status" .= statusC + <> "url" .= url <> if log400 && statusC >= 400 - then "response" .= (TLE.decodeUtf8 $ toLazyByteString respBody) + then maybe mempty (\b -> "response" .= TLE.decodeUtf8With TE.lenientDecode (toLazyByteString b)) responseBody else mempty ) - toLogStr (encodingToLazyByteString res) <> "\n" - where - toIso :: Maybe ZonedTime -> Text - toIso = pack . maybe "1970-01-01T00:00:00+0000" (formatTime defaultTimeLocale "%FT%T%z") + hPutBuilder stdout (fromEncoding logLine <> "\n") - toMs :: Maybe ZonedTime -> Int - toMs = maybe 0 (floor . (1000 *) . nominalDiffTimeToSeconds . utcTimeToPOSIXSeconds . zonedTimeToUTC) + return rcv + where + toIso :: ZonedTime -> Text + toIso = pack . formatTime defaultTimeLocale "%FT%T%z" - parseZonedDate :: ZonedDate -> Maybe ZonedTime - parseZonedDate = parseTimeM True defaultTimeLocale "%d/%b/%Y:%H:%M:%S %z" . unpack . decodeUtf8 + toMs :: POSIXTime -> Double + toMs = realToFrac . (1000 *) . nominalDiffTimeToSeconds diff --git a/web-template.cabal b/web-template.cabal index ca84fe0..8b2249c 100644 --- a/web-template.cabal +++ b/web-template.cabal @@ -1,5 +1,5 @@ name: web-template -version: 0.1.3.0 +version: 0.1.3.1 synopsis: Web template description: Web template includes: