on master help sign in
Merge pull request #169 from wuzzeb/master

gzip: Don't compress the body if the body is already compressed

commit1047188cf1aeb9bb1d749fce1184f27ea49d8099 authorMichael Snoyman <michael@snoyman.com> dateSat 31 Aug 2013, 10:35 (13 years ago) parent4805e74d80afce
2 files changed+24−2
wai-extra/Network/Wai/Middleware/Gzip.hs+7−2 wai-extra/test/WaiExtraTest.hs+17
wai-extra/Network/Wai/Middleware/Gzip.hs+7−2
@@ -25,7 +25,7 @@ module Network.Wai.Middleware.Gzip
2525 ) where
2626
2727import Network.Wai
28−import Data.Maybe (fromMaybe)
28+import Data.Maybe (fromMaybe, isJust)
2929import qualified Data.ByteString.Char8 as S8
3030import qualified Data.ByteString as S
3131import Data.Default
@@ -76,7 +76,7 @@ gzip set app env = do
7676 res <- app env
7777 case res of
7878 ResponseFile{} | gzipFiles set == GzipIgnore -> return res
79− _ -> if "gzip" `elem` enc && not isMSIE6
79+ _ -> if "gzip" `elem` enc && not isMSIE6 && not (isEncoded res)
8080 then
8181 case (res, gzipFiles set) of
8282 (ResponseFile s hs file Nothing, GzipCacheFolder cache) ->
@@ -91,6 +91,11 @@ gzip set app env = do
9191 `fmap` lookup "Accept-Encoding" (requestHeaders env)
9292 ua = fromMaybe "" $ lookup "user-agent" $ requestHeaders env
9393 isMSIE6 = "MSIE 6" `S.isInfixOf` ua
94+ responseHeaders res = case res of
95+ ResponseFile _ h _ _ -> h
96+ ResponseBuilder _ h _ -> h
97+ ResponseSource _ h _ -> h
98+ isEncoded res = isJust $ lookup "Content-Encoding" $ responseHeaders res
9499
95100compressFile :: Status -> [Header] -> FilePath -> FilePath -> IO Response
96101compressFile s hs file cache = do
wai-extra/test/WaiExtraTest.hs+17
@@ -63,6 +63,7 @@ specs = do
6363 it "jsonp" caseJsonp
6464 it "gzip" caseGzip
6565 it "gzip not for MSIE" caseGzipMSIE
66+ it "gzip bypass when precompressed" caseGzipBypassPre
6667 it "defaultCheckMime" caseDefaultCheckMime
6768 it "vhost" caseVhost
6869 it "autohead" caseAutohead
@@ -318,6 +319,14 @@ gzipApp = gzip def $ const $ return $ responseLBS status200
318319 [("Content-Type", "text/plain")]
319320 "test"
320321
322+-- Lie a little and don't compress the body. This way we test
323+-- that the compression is skipped based on the presence of
324+-- the Content-Encoding header.
325+gzipPrecompressedApp :: Application
326+gzipPrecompressedApp = gzip def $ const $ return $ responseLBS status200
327+ [("Content-Type", "text/plain"), ("Content-Encoding", "gzip")]
328+ "test"
329+
321330caseGzip :: Assertion
322331caseGzip = flip runSession gzipApp $ do
323332 sres1 <- request defaultRequest
@@ -353,6 +362,14 @@ caseGzipMSIE = flip runSession gzipApp $ do
353362 assertNoHeader "Content-Encoding" sres1
354363 liftIO $ simpleBody sres1 @?= "test"
355364
365+caseGzipBypassPre :: Assertion
366+caseGzipBypassPre = flip runSession gzipPrecompressedApp $ do
367+ sres1 <- request defaultRequest
368+ { requestHeaders = [("Accept-Encoding", "gzip")]
369+ }
370+ assertHeader "Content-Encoding" "gzip" sres1
371+ assertBody "test" sres1 -- the body is not actually compressed
372+
356373vhostApp1, vhostApp2, vhostApp :: Application
357374vhostApp1 = const $ return $ responseLBS status200 [] "app1"
358375vhostApp2 = const $ return $ responseLBS status200 [] "app2"