git.iko.soy/typeable/wai
on master help sign in
Do not compress for MSIE 6
b5b2167Michael Snoyman
Network/Wai/Middleware/Gzip.hs+4−1
compare with master
unifiedsplit
@@ -21,6 +21,7 @@ import Network.Wai.Zlib
21import Data.Maybe (fromMaybe)
21import Data.Maybe (fromMaybe)
22import Data.Enumerator (($$), joinI)
22import Data.Enumerator (($$), joinI)
23import qualified Data.ByteString.Char8 as S8
23import qualified Data.ByteString.Char8 as S8
24+import qualified Data.ByteString as S
24
25
25-- | Use gzip to compress the body of the response.
26-- | Use gzip to compress the body of the response.
26--
27--
@@ -39,12 +40,14 @@ gzip files app env = do
39 return $
40 return $
40 case res of
41 case res of
41 ResponseFile{} | not files -> res
42 ResponseFile{} | not files -> res
42− _ -> if "gzip" `elem` enc
43+ _ -> if "gzip" `elem` enc && not isMSIE6
43 then ResponseEnumerator $ compressE $ responseEnumerator res
44 then ResponseEnumerator $ compressE $ responseEnumerator res
44 else res
45 else res
45 where
46 where
46 enc = fromMaybe [] $ (splitCommas . S8.unpack)
47 enc = fromMaybe [] $ (splitCommas . S8.unpack)
47 `fmap` lookup "Accept-Encoding" (requestHeaders env)
48 `fmap` lookup "Accept-Encoding" (requestHeaders env)
49+ ua = fromMaybe "" $ lookup "user-agent" $ requestHeaders env
50+ isMSIE6 = "MSIE 6" `S.isInfixOf` ua
48
51
49compressE :: (forall a. ResponseEnumerator a)
52compressE :: (forall a. ResponseEnumerator a)
50 -> (forall a. ResponseEnumerator a)
53 -> (forall a. ResponseEnumerator a)
runtests.hs+12
@@ -42,6 +42,7 @@ testSuite = testGroup "Network.Wai.Parse"
42 , testCase "takeLine" caseTakeLine
42 , testCase "takeLine" caseTakeLine
43 , testCase "jsonp" caseJsonp
43 , testCase "jsonp" caseJsonp
44 , testCase "gzip" caseGzip
44 , testCase "gzip" caseGzip
45+ , testCase "gzip not for MSIE" caseGzipMSIE
45 , testCase "vhost" caseVhost
46 , testCase "vhost" caseVhost
46 , testCase "autohead" caseAutohead
47 , testCase "autohead" caseAutohead
47 , testCase "method override" caseMethodOverride
48 , testCase "method override" caseMethodOverride
@@ -259,6 +260,17 @@ caseGzip = flip runSession gzipApp $ do
259 assertNoHeader "Content-Encoding" sres2
260 assertNoHeader "Content-Encoding" sres2
260 assertBody "test" sres2
261 assertBody "test" sres2
261
262
263+caseGzipMSIE :: Assertion
264+caseGzipMSIE = flip runSession gzipApp $ do
265+ sres1 <- request Request
266+ { requestHeaders =
267+ [ ("Accept-Encoding", "gzip")
268+ , ("User-Agent", "Mozilla/4.0 (Windows; MSIE 6.0; Windows NT 6.0)")
269+ ]
270+ }
271+ assertNoHeader "Content-Encoding" sres1
272+ liftIO $ simpleBody sres1 @?= "test"
273+
262vhostApp1 = const $ return $ responseLBS status200 [] "app1"
274vhostApp1 = const $ return $ responseLBS status200 [] "app1"
263vhostApp2 = const $ return $ responseLBS status200 [] "app2"
275vhostApp2 = const $ return $ responseLBS status200 [] "app2"
264vhostApp = vhost
276vhostApp = vhost