wai-extra 3.0.11.1 → 3.0.12
raw patch · 6 files changed
+50/−18 lines, 6 files
Files
- ChangeLog.md +5/−0
- Network/Wai/Header.hs +18/−0
- Network/Wai/Middleware/Gzip.hs +12/−1
- Network/Wai/Middleware/RequestLogger.hs +12/−13
- test/WaiExtraSpec.hs +1/−3
- wai-extra.cabal +2/−1
ChangeLog.md view
@@ -1,3 +1,8 @@+## 3.0.12++* Add Network.Wai.Header.contentLength to read the Content-Length header of a response+* The gzip middleware no longer zips responses smaller than 860 bytes+ ## 3.0.11 * Add constructor for more detailed custom output formats for RequestLogger
+ Network/Wai/Header.hs view
@@ -0,0 +1,18 @@+-- | Some helpers for dealing with WAI 'Header's.++module Network.Wai.Header+ ( contentLength+ ) where++import qualified Data.ByteString.Char8 as S8+import Network.HTTP.Types as H++-- | More useful for a response. A Wai Request already has a requestBodyLength+contentLength :: [(HeaderName, S8.ByteString)] -> Maybe Integer+contentLength hdrs = lookup H.hContentLength hdrs >>= readInt++readInt :: S8.ByteString -> Maybe Integer+readInt bs =+ case S8.readInteger bs of+ Just (i, "") -> Just i+ _ -> Nothing
Network/Wai/Middleware/Gzip.hs view
@@ -33,6 +33,7 @@ import Blaze.ByteString.Builder (fromByteString) import Control.Exception (try, SomeException) import qualified Data.Set as Set+import Network.Wai.Header import Network.Wai.Internal import qualified Data.Streaming.Blaze as B import qualified Data.Streaming.Zlib as Z@@ -79,7 +80,7 @@ case res of ResponseRaw{} -> sendResponse res ResponseFile{} | gzipFiles set == GzipIgnore -> sendResponse res- _ -> if "gzip" `elem` enc && not isMSIE6 && not (isEncoded res)+ _ -> if "gzip" `elem` enc && not isMSIE6 && not (isEncoded res) && (bigEnough res) then case (res, gzipFiles set) of (ResponseFile s hs file Nothing, GzipCacheFolder cache) ->@@ -95,6 +96,16 @@ ua = fromMaybe "" $ lookup hUserAgent $ requestHeaders env isMSIE6 = "MSIE 6" `S.isInfixOf` ua isEncoded res = isJust $ lookup hContentEncoding $ responseHeaders res++ bigEnough rsp = case contentLength (responseHeaders rsp) of+ Nothing -> True -- This could be a streaming case+ Just len -> len >= minimumLength++ -- For a small enough response, gzipping will actually increase the size+ -- Potentially for anything less than 860 bytes gzipping could be a net loss+ -- The actual number is application specific though and may need to be adjusted+ -- http://webmasters.stackexchange.com/questions/31750/what-is-recommended-minimum-object-size-for-gzip-performance-benefits+ minimumLength = 860 compressFile :: Status -> [Header] -> FilePath -> FilePath -> (Response -> IO a) -> IO a compressFile s hs file cache sendResponse = do
Network/Wai/Middleware/RequestLogger.hs view
@@ -24,7 +24,11 @@ import qualified Data.ByteString as BS import Data.ByteString.Char8 (pack, unpack) import Control.Monad.IO.Class (liftIO)-import Network.Wai (Request(..), Middleware, responseStatus, Response, responseHeaders)+import Network.Wai+ ( Request(..), requestBodyLength, RequestBodyLength(..)+ , Middleware+ , Response, responseStatus, responseHeaders+ ) import System.Log.FastLogger import Network.HTTP.Types as H import Data.Maybe (fromMaybe)@@ -41,6 +45,7 @@ import Data.Default.Class (Default (def)) import Network.Wai.Logger import Network.Wai.Middleware.RequestLogger.Internal+import Network.Wai.Header (contentLength) import Data.Text.Encoding (decodeUtf8') data OutputFormat = Apache IPAddrSource@@ -106,11 +111,7 @@ apacheMiddleware :: ApacheLoggerActions -> Middleware apacheMiddleware ala app req sendResponse = app req $ \res -> do- let msize = lookup H.hContentLength (responseHeaders res) >>= readInt'- readInt' bs =- case S8.readInteger bs of- Just (i, "") -> Just i- _ -> Nothing+ let msize = contentLength (responseHeaders res) apacheLogger ala req (responseStatus res) msize sendResponse res @@ -246,11 +247,12 @@ -> (BS.ByteString -> BS.ByteString -> [BS.ByteString]) -> Middleware detailedMiddleware' cb ansiColor ansiMethod ansiStatusCode app req sendResponse = do- let mlen = lookup H.hContentLength (requestHeaders req) >>= readInt (req', body) <-- case mlen of+ -- second tuple item should not be necessary, but a test runner might mess it up+ case (requestBodyLength req, contentLength (requestHeaders req)) of -- log the request body if it is small- Just len | len <= 2048 -> getRequestBody req+ (KnownLength len, _) | len <= 2048 -> getRequestBody req+ (_, Just len) | len <= 2048 -> getRequestBody req _ -> return (req, []) let reqbodylog _ = if null body then [""] else ansiColor White " Request Body: " <> body <> ["\n"]@@ -308,10 +310,7 @@ collectPostParams (postParams, files) = postParams ++ map (\(k,v) -> (k, "FILE: " <> fileName v)) files - readInt bs =- case reads $ unpack bs of- (i, _):_ -> Just (i :: Int)- [] -> Nothing+ statusBS :: Response -> BS.ByteString statusBS = pack . show . statusCode . responseStatus
test/WaiExtraSpec.hs view
@@ -341,10 +341,8 @@ } where params = [("foo", "bar"), ("baz", "bin")]- -- FIXME change back once we include post parameter output in logging- -- postOutput = T.pack $ "POST \nAccept: \n Params: " ++ (show params) -- the time cannot be known, so match around it- postOutput = ("POST /\n Accept: \n Status: 200 OK 0", "s\n")+ postOutput = (T.pack $ "POST /\n Params: " ++ (show params), "s\n") getOutput params' = ("GET /location\n Params: " <> T.pack (show params') <> "\n Accept: \n Status: 200 OK 0", "s\n") debugApp (beginning, ending) req send = do
wai-extra.cabal view
@@ -1,5 +1,5 @@ Name: wai-extra-Version: 3.0.11.1+Version: 3.0.12 Synopsis: Provides some basic WAI handlers and middleware. description: Provides basic WAI handler and middleware functionality:@@ -123,6 +123,7 @@ Exposed-modules: Network.Wai.Handler.CGI Network.Wai.Handler.SCGI+ Network.Wai.Header Network.Wai.Middleware.AcceptOverride Network.Wai.Middleware.AddHeaders Network.Wai.Middleware.Approot