@@ -24,14 +24,17 @@ import System.IO (Handle, stdout)
2424import qualified Data.ByteString as BS
2525import Data.ByteString.Char8 (pack, unpack)
2626import Control.Monad.IO.Class (liftIO)
27−import Network.Wai (Request(..), Middleware, responseStatus, Response)
27+import Network.Wai (Request(..), Middleware, responseStatus, Response, responseHeaders)
2828import System.Log.FastLogger
2929import Network.HTTP.Types as H
3030import Data.Maybe (fromMaybe)
3131import Control.Monad.Trans.Resource (withInternalState)
32+import Data.Monoid (mconcat)
33+import Blaze.ByteString.Builder (toByteString)
3234
3335import Network.Wai.Parse (sinkRequestBody, lbsBackEnd, fileName, Param, File, getRequestBodyType)
3436import qualified Data.ByteString.Lazy as LBS
37+import qualified Data.ByteString.Char8 as S8
3538
3639import qualified Data.Conduit as C
3740import qualified Data.Conduit.List as CL
@@ -41,20 +44,20 @@ import Data.IORef.Lifted
4144import System.IO.Unsafe
4245
4346import Data.Default (Default (def))
44−import Network.Wai.Logger.Format (apacheFormat, IPAddrSource (..))
47+import Network.Wai.Logger
4548import Network.Wai.Middleware.RequestLogger.Internal
4649
4750data OutputFormat = Apache IPAddrSource
4851 | Detailed Bool -- ^ use colors?
4952 | CustomOutputFormat OutputFormatter
5053
51−type OutputFormatter = ZonedDate -> Request -> Status -> Maybe Integer -> [LogStr]
54+type OutputFormatter = ZonedDate -> Request -> Status -> Maybe Integer -> LogStr
5255
5356data Destination = Handle Handle
54− | Logger Logger
57+ | Logger LoggerSet
5558 | Callback Callback
5659
57−type Callback = [LogStr] -> IO ()
60+type Callback = LogStr -> IO ()
5861
5962data RequestLoggerSettings = RequestLoggerSettings
6063 {
@@ -77,28 +80,31 @@ instance Default RequestLoggerSettings where
7780
7881mkRequestLogger :: RequestLoggerSettings -> IO Middleware
7982mkRequestLogger RequestLoggerSettings{..} = do
80− (callback, mgetdate) <-
83+ callback <-
8184 case destination of
82− Handle h -> fmap fromLogger $ mkLogger autoFlush h
83− Logger l -> return $ fromLogger l
84− Callback c -> return (c, Nothing)
85+ Handle h -> return $ BS.hPutStr h . toByteString . logStrBuilder
86+ Logger l -> return $ pushLogStr l
87+ Callback c -> return c
8588 case outputFormat of
8689 Apache ipsrc -> do
87− getdate <- dateHelper mgetdate
88− return $ apacheMiddleware callback ipsrc getdate
90+ getdate <- getDateGetter
91+ apache <- initLogger ipsrc (LogCallback callback (return ())) getdate
92+ return $ apacheMiddleware apache
8993 Detailed useColors -> detailedMiddleware callback useColors
9094 CustomOutputFormat formatter -> do
91− getdate <- dateHelper mgetdate
95+ getdate <- getDateGetter
9296 return $ customMiddleware callback getdate formatter
93− where
94− fromLogger l = (loggerPutStr l, Just $ loggerDate l)
95− dateHelper mgetdate = do
96− case mgetdate of
97− Just x -> return x
98− Nothing -> getDateGetter
9997
100−apacheMiddleware :: Callback -> IPAddrSource -> IO ZonedDate -> Middleware
101−apacheMiddleware cb ipsrc getdate = customMiddleware cb getdate $ apacheFormat ipsrc
98+apacheMiddleware :: ApacheLoggerActions -> Middleware
99+apacheMiddleware ala app req = do
100+ res <- app req
101+ let msize = lookup "content-length" (responseHeaders res) >>= readInt'
102+ readInt' bs =
103+ case S8.readInteger bs of
104+ Just (i, "") -> Just i
105+ _ -> Nothing
106+ apacheLogger ala req (responseStatus res) msize
107+ return res
102108
103109customMiddleware :: Callback -> IO ZonedDate -> OutputFormatter -> Middleware
104110customMiddleware cb getdate formatter app req = do
@@ -222,7 +228,7 @@ detailedMiddleware' cb getAddColor app req = do
222228 addColor <- getAddColor
223229
224230 -- log the request immediately.
225− liftIO $ cb $ map LB $ addColor (requestMethod req) ++
231+ liftIO $ cb $ mconcat $ map toLogStr $ addColor (requestMethod req) ++
226232 [ " "
227233 , rawPathInfo req
228234 , "\n"
@@ -238,7 +244,7 @@ detailedMiddleware' cb getAddColor app req = do
238244 -- log the status of the response
239245 -- this is color coordinated with the request logging
240246 -- also includes the request path to connect it to the request
241− liftIO $ cb $ map LB $ addColor "Status: " ++ [
247+ liftIO $ cb $ mconcat $ map toLogStr $ addColor "Status: " ++ [
242248 statusBS rsp
243249 , " "
244250 , msgBS rsp