53b8a1d · typeable/wai

git.iko.soy/typeable/wai

Merge pull request #453 from yesodweb/gzip-large-response-only

Gzip large response only

commit53b8a1d0dc85455ca811ccbdf85ea8b72b3f155f authorGreg Weber <greg@gregweber.info> dateFri 16 Oct 2015, 14:03 (11 years ago) parent9f8f983 c010a28

6 files changed+50−18

compare with master

unifiedsplit

wai-extra/ChangeLog.md+5 wai-extra/Network/Wai/Header.hs+18 wai-extra/Network/Wai/Middleware/Gzip.hs+12−1 wai-extra/Network/Wai/Middleware/RequestLogger.hs+12−13 wai-extra/test/WaiExtraSpec.hs+1−3 wai-extra/wai-extra.cabal+2−1

wai-extra/ChangeLog.md+5

@@ -1,3 +1,8 @@

1+## 3.0.12

3+* Add Network.Wai.Header.contentLength to read the Content-Length header of a response

4+* The gzip middleware no longer zips responses smaller than 860 bytes

16## 3.0.11

38* Add constructor for more detailed custom output formats for RequestLogger

wai-extra/Network/Wai/Header.hsnew file+18

@@ -0,0 +1,18 @@

1+-- | Some helpers for dealing with WAI 'Header's.

3+module Network.Wai.Header

4+ ( contentLength

5+ ) where

7+import qualified Data.ByteString.Char8 as S8

8+import Network.HTTP.Types as H

10+-- | More useful for a response. A Wai Request already has a requestBodyLength

11+contentLength :: [(HeaderName, S8.ByteString)] -> Maybe Integer

12+contentLength hdrs = lookup H.hContentLength hdrs >>= readInt

13+

14+readInt :: S8.ByteString -> Maybe Integer

15+readInt bs =

16+ case S8.readInteger bs of

17+ Just (i, "") -> Just i

18+ _ -> Nothing

wai-extra/Network/Wai/Middleware/Gzip.hs+12−1

@@ -33,6 +33,7 @@ import System.Directory (doesFileExist, createDirectoryIfMissing)

3333import Blaze.ByteString.Builder (fromByteString)

3434import Control.Exception (try, SomeException)

3535import qualified Data.Set as Set

36+import Network.Wai.Header

3637import Network.Wai.Internal

3738import qualified Data.Streaming.Blaze as B

3839import qualified Data.Streaming.Zlib as Z

@@ -79,7 +80,7 @@ gzip set app env sendResponse = app env $ \res ->

7980 case res of

8081 ResponseRaw{} -> sendResponse res

8182 ResponseFile{} | gzipFiles set == GzipIgnore -> sendResponse res

82− _ -> if "gzip" `elem` enc && not isMSIE6 && not (isEncoded res)

83+ _ -> if "gzip" `elem` enc && not isMSIE6 && not (isEncoded res) && (bigEnough res)

8384 then

8485 case (res, gzipFiles set) of

8586 (ResponseFile s hs file Nothing, GzipCacheFolder cache) ->

@@ -96,6 +97,16 @@ gzip set app env sendResponse = app env $ \res ->

9697 isMSIE6 = "MSIE 6" `S.isInfixOf` ua

9798 isEncoded res = isJust $ lookup hContentEncoding $ responseHeaders res

9899

100+ bigEnough rsp = case contentLength (responseHeaders rsp) of

101+ Nothing -> True -- This could be a streaming case

102+ Just len -> len >= minimumLength

103+

104+ -- For a small enough response, gzipping will actually increase the size

105+ -- Potentially for anything less than 860 bytes gzipping could be a net loss

106+ -- The actual number is application specific though and may need to be adjusted

107+ -- http://webmasters.stackexchange.com/questions/31750/what-is-recommended-minimum-object-size-for-gzip-performance-benefits

108+ minimumLength = 860

109+

99110compressFile :: Status -> [Header] -> FilePath -> FilePath -> (Response -> IO a) -> IO a

100111compressFile s hs file cache sendResponse = do

101112 e <- doesFileExist tmpfile

wai-extra/Network/Wai/Middleware/RequestLogger.hs+12−13

@@ -24,7 +24,11 @@ import qualified Blaze.ByteString.Builder as B

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, responseHeaders)

27+import Network.Wai

28+ ( Request(..), requestBodyLength, RequestBodyLength(..)

29+ , Middleware

30+ , Response, responseStatus, responseHeaders

31+ )

2832import System.Log.FastLogger

2933import Network.HTTP.Types as H

3034import Data.Maybe (fromMaybe)

@@ -41,6 +45,7 @@ import Network.Wai.Internal (Response (..))

4145import Data.Default.Class (Default (def))

4246import Network.Wai.Logger

4347import Network.Wai.Middleware.RequestLogger.Internal

48+import Network.Wai.Header (contentLength)

4449import Data.Text.Encoding (decodeUtf8')

4550

4651data OutputFormat = Apache IPAddrSource

@@ -106,11 +111,7 @@ mkRequestLogger RequestLoggerSettings{..} = do

106111

107112apacheMiddleware :: ApacheLoggerActions -> Middleware

108113apacheMiddleware ala app req sendResponse = app req $ \res -> do

109− let msize = lookup H.hContentLength (responseHeaders res) >>= readInt'

110− readInt' bs =

111− case S8.readInteger bs of

112− Just (i, "") -> Just i

113− _ -> Nothing

114+ let msize = contentLength (responseHeaders res)

114115 apacheLogger ala req (responseStatus res) msize

115116 sendResponse res

116117

@@ -246,11 +247,12 @@ detailedMiddleware' :: Callback

246247 -> (BS.ByteString -> BS.ByteString -> [BS.ByteString])

247248 -> Middleware

248249detailedMiddleware' cb ansiColor ansiMethod ansiStatusCode app req sendResponse = do

249− let mlen = lookup H.hContentLength (requestHeaders req) >>= readInt

250250 (req', body) <-

251− case mlen of

251+ -- second tuple item should not be necessary, but a test runner might mess it up

252+ case (requestBodyLength req, contentLength (requestHeaders req)) of

252253 -- log the request body if it is small

253− Just len | len <= 2048 -> getRequestBody req

254+ (KnownLength len, _) | len <= 2048 -> getRequestBody req

255+ (_, Just len) | len <= 2048 -> getRequestBody req

254256 _ -> return (req, [])

255257

256258 let reqbodylog _ = if null body then [""] else ansiColor White " Request Body: " <> body <> ["\n"]

@@ -308,10 +310,7 @@ detailedMiddleware' cb ansiColor ansiMethod ansiStatusCode app req sendResponse

308310 collectPostParams (postParams, files) = postParams ++

309311 map (\(k,v) -> (k, "FILE: " <> fileName v)) files

310312

311− readInt bs =

312− case reads $ unpack bs of

313− (i, _):_ -> Just (i :: Int)

314− [] -> Nothing

313+

315314

316315statusBS :: Response -> BS.ByteString

317316statusBS = pack . show . statusCode . responseStatus

wai-extra/test/WaiExtraSpec.hs+1−3

@@ -341,10 +341,8 @@ caseDebugRequestBody = do

341341 }

342342 where

343343 params = [("foo", "bar"), ("baz", "bin")]

344− -- FIXME change back once we include post parameter output in logging

345− -- postOutput = T.pack $ "POST \nAccept: \n Params: " ++ (show params)

346344 -- the time cannot be known, so match around it

347− postOutput = ("POST /\n Accept: \n Status: 200 OK 0", "s\n")

345+ postOutput = (T.pack $ "POST /\n Params: " ++ (show params), "s\n")

348346 getOutput params' = ("GET /location\n Params: " <> T.pack (show params') <> "\n Accept: \n Status: 200 OK 0", "s\n")

349347

350348 debugApp (beginning, ending) req send = do

wai-extra/wai-extra.cabal+2−1

@@ -1,5 +1,5 @@

11Name: wai-extra

2−Version: 3.0.11.1

2+Version: 3.0.12

33Synopsis: Provides some basic WAI handlers and middleware.

44description:

55 Provides basic WAI handler and middleware functionality:

@@ -123,6 +123,7 @@ Library

123123

124124 Exposed-modules: Network.Wai.Handler.CGI

125125 Network.Wai.Handler.SCGI

126+ Network.Wai.Header

126127 Network.Wai.Middleware.AcceptOverride

127128 Network.Wai.Middleware.AddHeaders

128129 Network.Wai.Middleware.Approot