version 0.1.2.3: defaultHandleLog400 (#17)

Author: maksbotan

CHANGELOG.md

@@ -6,6 +6,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ## [Unreleased]
 
+## [0.1.2.3] - 2020-08-17
+### Added
+- `defaultHandleLog400` middleware to log response bodies of 4xx and 5xx responses.
+
 ## [0.1.2.2] - 2020-05-19
 ### Changed
 - Ignore `"Warp: Client closed connection prematurely"` exception.

src/Web/Template/Log.hs

@@ -2,39 +2,44 @@
 
 module Web.Template.Log
   ( bcdlog
+  , 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                            as T (Text, pack, unpack, unwords)
 import           Data.Text.Encoding                   (decodeUtf8)
-import           Data.Time                            (ZonedTime,
-                                                       defaultTimeLocale,
-                                                       formatTime,
-                                                       nominalDiffTimeToSeconds,
-                                                       parseTimeM,
+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                          (Middleware, rawPathInfo, requestMethod)
 import           Network.Wai.Logger                   (ZonedDate)
 import           Network.Wai.Middleware.RequestLogger (OutputFormat (..),
-                                                       OutputFormatter,
-                                                       mkRequestLogger,
+                                                       OutputFormatterWithDetails, mkRequestLogger,
                                                        outputFormat)
 import           System.BCD.Log                       (Level (..))
 import           System.IO.Unsafe                     (unsafePerformIO)
 import           System.Log.FastLogger                (toLogStr)
 
 {-# NOINLINE bcdlog #-}
 bcdlog :: Middleware
-bcdlog = unsafePerformIO $ mkRequestLogger def {outputFormat = CustomOutputFormat formatter}
+bcdlog = unsafePerformIO $ mkRequestLogger def
+  { outputFormat = CustomOutputFormatWithDetails $ formatter False
+  }
 
-formatter :: OutputFormatter
-formatter zonedDate request status _ = do
+{-# NOINLINE bcdlog400 #-}
+bcdlog400 :: Middleware
+bcdlog400 = unsafePerformIO $ mkRequestLogger def
+  { outputFormat = CustomOutputFormatWithDetails $ formatter True
+  }
+
+formatter :: Bool -> OutputFormatterWithDetails
+formatter log400 zonedDate request status _ _ _ respBody = do
     let
       zonedTime = parseZonedDate zonedDate
       statusC   = statusCode status
@@ -52,6 +57,9 @@ formatter zonedDate request status _ = do
         <> "msg"       .= msg'
         <> "status"    .= statusC
         <> "url"       .= url
+        <> if log400 && statusC >= 400
+              then "response" .= (TLE.decodeUtf8 $ toLazyByteString respBody)
+              else mempty
         )
 
     toLogStr (encodingToLazyByteString res) <> "\n"

src/Web/Template/Server.hs

@@ -9,6 +9,7 @@ module Web.Template.Server
     , runWebServer
     , runWebServerWith
     , defaultHandleLog
+    , defaultHandleLog400
     , defaultHeaderCORS
     , toApplication
     ) where
@@ -34,7 +35,7 @@ import           Web.Scotty.Trans          (Options (..), ScottyT, defaultHandle
                                             middleware, next, param, scottyAppT, scottyOptsT,
                                             status)
 import           Web.Template.Except       (Except, JsonWebError (..), handleEx)
-import           Web.Template.Log          (bcdlog)
+import           Web.Template.Log          (bcdlog, bcdlog400)
 import           Web.Template.Types
 
 -- | Restart `f` on `error` after `1s`.
@@ -87,6 +88,11 @@ evalCustomWebServer CustomWebServer {..} = (fst <$>) . (\rws -> evalRWST rws rea
 defaultHandleLog :: Middleware
 defaultHandleLog = bcdlog
 
+-- | Log everything as 'defaultHandleLog' and also log response bodies for
+-- 4xx and 5xx responses.
+defaultHandleLog400 :: Middleware
+defaultHandleLog400 = bcdlog400
+
 defaultHeaderCORS :: Middleware
 defaultHeaderCORS = modifyResponse (mapResponseHeaders addHeaderCORS)
   where

web-template.cabal

@@ -1,5 +1,5 @@
 name:                web-template
-version:             0.1.2.2
+version:             0.1.2.3
 synopsis:            Web template
 description:
             Web template includes: