d80afce · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

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

d80afceJohn Lenz13 years ago

wai-extra/Network/Wai/Middleware/Gzip.hs+7−2

compare with master

unifiedsplit

@@ -25,7 +25,7 @@ module Network.Wai.Middleware.Gzip

25 ) where

27import Network.Wai

28−import Data.Maybe (fromMaybe)

28+import Data.Maybe (fromMaybe, isJust)

29import qualified Data.ByteString.Char8 as S8

30import qualified Data.ByteString as S

31import Data.Default

@@ -76,7 +76,7 @@ gzip set app env = do

76 res <- app env

77 case res of

78 ResponseFile{} | gzipFiles set == GzipIgnore -> return res

79− _ -> if "gzip" `elem` enc && not isMSIE6

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

80 then

81 case (res, gzipFiles set) of

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

@@ -91,6 +91,11 @@ gzip set app env = do

91 `fmap` lookup "Accept-Encoding" (requestHeaders env)

92 ua = fromMaybe "" $ lookup "user-agent" $ requestHeaders env

93 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

95compressFile :: Status -> [Header] -> FilePath -> FilePath -> IO Response

100compressFile :: Status -> [Header] -> FilePath -> FilePath -> IO Response

96compressFile s hs file cache = do

101compressFile s hs file cache = do

wai-extra/test/WaiExtraTest.hs+17

@@ -63,6 +63,7 @@ specs = do

63 it "jsonp" caseJsonp

64 it "gzip" caseGzip

65 it "gzip not for MSIE" caseGzipMSIE

66+ it "gzip bypass when precompressed" caseGzipBypassPre

66 it "defaultCheckMime" caseDefaultCheckMime

67 it "defaultCheckMime" caseDefaultCheckMime

67 it "vhost" caseVhost

68 it "vhost" caseVhost

68 it "autohead" caseAutohead

69 it "autohead" caseAutohead

@@ -318,6 +319,14 @@ gzipApp = gzip def $ const $ return $ responseLBS status200

318 [("Content-Type", "text/plain")]

319 [("Content-Type", "text/plain")]

319 "test"

320 "test"

320

321

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+

321caseGzip :: Assertion

330caseGzip :: Assertion

322caseGzip = flip runSession gzipApp $ do

331caseGzip = flip runSession gzipApp $ do

323 sres1 <- request defaultRequest

332 sres1 <- request defaultRequest

@@ -353,6 +362,14 @@ caseGzipMSIE = flip runSession gzipApp $ do

353 assertNoHeader "Content-Encoding" sres1

362 assertNoHeader "Content-Encoding" sres1

354 liftIO $ simpleBody sres1 @?= "test"

363 liftIO $ simpleBody sres1 @?= "test"

355

364

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+

356vhostApp1, vhostApp2, vhostApp :: Application

373vhostApp1, vhostApp2, vhostApp :: Application

357vhostApp1 = const $ return $ responseLBS status200 [] "app1"

374vhostApp1 = const $ return $ responseLBS status200 [] "app1"

358vhostApp2 = const $ return $ responseLBS status200 [] "app2"

375vhostApp2 = const $ return $ responseLBS status200 [] "app2"