git.iko.soy/typeable/wai
on master help sign in
Merge branch 'master' of github.com:yesodweb/wai
commiteaa23746d925927b9bba42d08e514cf77da63e5a authorMichael Snoyman <michael@snoyman.com> dateSun 1 Sep 2013, 18:48 (13 years ago) parenteebd7656eeea88
5 files changed+30−6
compare with master
unifiedsplit
wai-app-static/WaiAppStatic/Storage/Embedded.hs+3−2 wai-app-static/WaiAppStatic/Storage/Filesystem.hs+1−1 wai-app-static/wai-app-static.cabal+2−1 wai-extra/Network/Wai/Middleware/Gzip.hs+7−2 wai-extra/test/WaiExtraTest.hs+17
wai-app-static/WaiAppStatic/Storage/Embedded.hs+3−2
@@ -15,7 +15,8 @@ import Data.Function (on)
1515import qualified Data.Text as T
1616import Data.Ord
1717import qualified Data.ByteString as S
18−import qualified Crypto.Hash.MD5 as MD5
18+import qualified Crypto.Classes as CR
19+import Crypto.Hash.CryptoAPI (hash', MD5)
1920import qualified Data.ByteString.Base64 as B64
2021import WaiAppStatic.Storage.Filesystem (defaultFileServerSettings)
2122
@@ -89,4 +90,4 @@ bsToFile name bs = File
8990 }
9091
9192runHash :: ByteString -> ByteString
92−runHash = B64.encode . MD5.hash
93+runHash = B64.encode . CR.encode . (hash' :: S.ByteString -> MD5)
wai-app-static/WaiAppStatic/Storage/Filesystem.hs+1−1
@@ -27,7 +27,7 @@ import System.PosixCompat.Files (fileSize, getFileStatus, modificationTime, isRe
2727import Data.Maybe (catMaybes)
2828import qualified Crypto.Conduit
2929import Data.Serialize (encode)
30−import Crypto.Hash.MD5 (MD5)
30+import Crypto.Hash.CryptoAPI (MD5)
3131import qualified Data.ByteString.Base64 as B64
3232
3333-- | Construct a new path from a root and some @Pieces@.
wai-app-static/wai-app-static.cabal+2−1
@@ -37,7 +37,8 @@ library
3737 , text >= 0.7
3838 , blaze-builder >= 0.2.1.4
3939 , base64-bytestring >= 0.1
40− , cryptohash >= 0.7
40+ , crypto-api >= 0.12.2
41+ , cryptohash-cryptoapi >= 0.1.0
4142 , system-filepath >= 0.4
4243 , system-fileio >= 0.3
4344 , http-date
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"