@@ -11,7 +11,7 @@ module Network.Wai.Middleware.RequestLogger
1111
1212import System.IO (stdout, hFlush)
1313import qualified Data.ByteString as BS
14−import Data.ByteString.Char8 (pack)
14+import Data.ByteString.Char8 (pack, unpack)
1515import Control.Monad.IO.Class (liftIO)
1616import Network.Wai (Request(..), Middleware, responseStatus)
1717import System.Log.FastLogger
@@ -74,7 +74,14 @@ toBS = id
7474logCallbackDev :: (BS.ByteString -> IO ()) -- ^ A function that logs the ByteString log message.
7575 -> Middleware
7676logCallbackDev cb app req = do
77− body <- requestBody req C.$$ CL.consume
77+ let mlen = lookup "content-length" (requestHeaders req) >>= readInt
78+ (req', body) <-
79+ case mlen of
80+ Just len | len <= 2048 -> do
81+ body <- requestBody req C.$$ CL.consume
82+ let req' = req { requestBody = CL.sourceList body }
83+ return (req', body)
84+ _ -> return (req, [])
7885 postParams <- if any (requestMethod req ==) ["GET", "HEAD"]
7986 then return []
8087 else do postParams <- liftIO $ allPostParams body
@@ -90,9 +97,10 @@ logCallbackDev cb app req = do
9097 , maybe "" id $ lookup "Accept" $ requestHeaders req
9198 , paramsToBS "GET " getParams
9299 , paramsToBS "POST " postParams
100+ , "\n"
93101 ]
94102 -- The body was consumed. Fill it back up so it is available again
95− rsp <- app req { requestBody = CL.sourceList body }
103+ rsp <- app req'
96104 liftIO $ cb $ BS.concat [
97105 "Status: "
98106 , code rsp
@@ -120,3 +128,8 @@ logCallbackDev cb app req = do
120128 collectPostParams :: ([Param], [File LBS.ByteString]) -> [Param]
121129 collectPostParams (postParams, files) = postParams ++
122130 (map (\(k,v) -> (k, BS.append "FILE: " (fileName v))) files)
131+
132+ readInt bs =
133+ case reads $ unpack bs of
134+ (i, _):_ -> Just (i :: Int)
135+ [] -> Nothing