@@ -14,14 +14,43 @@
14-- Automatic gzip compression of responses.
14-- Automatic gzip compression of responses.
16---------------------------------------------------------
16---------------------------------------------------------
17−module Network.Wai.Middleware.Gzip (gzip) where
17+module Network.Wai.Middleware.Gzip
19import Network.Wai
27import Network.Wai
20import Network.Wai.Zlib
28import Network.Wai.Zlib
21import Data.Maybe (fromMaybe)
29import Data.Maybe (fromMaybe)
22−import Data.Enumerator (($$), joinI)
30+import Data.Enumerator (($$), joinI, (=$), run)
31+import Data.Enumerator.Binary (enumFile, iterHandle)
23import qualified Data.ByteString.Char8 as S8
32import qualified Data.ByteString.Char8 as S8
24import qualified Data.ByteString as S
33import qualified Data.ByteString as S
35+import Network.HTTP.Types (Status, Header)
36+import Control.Monad.IO.Class (liftIO)
37+import qualified Codec.Zlib.Enum as CZE
38+import qualified System.IO as SIO
39+import System.Directory (doesFileExist, createDirectoryIfMissing)
41+data GzipSettings = GzipSettings
42+ { gzipFiles :: GzipFiles
43+ , gzipCheckMime :: S.ByteString -> Bool
46+data GzipFiles = GzipIgnore | GzipCompress | GzipCacheFolder FilePath
47+ deriving (Show, Eq, Read)
49+instance Default GzipSettings where
50+ def = GzipSettings GzipIgnore defaultCheckMime
52+defaultCheckMime :: S.ByteString -> Bool
53+defaultCheckMime = S8.isPrefixOf "text/"
26-- | Use gzip to compress the body of the response.
55-- | Use gzip to compress the body of the response.
@@ -31,37 +60,77 @@ import qualified Data.ByteString as S
31-- Possible future enhancements:
60-- Possible future enhancements:
33-- * Only compress if the response is above a certain size.
62-- * Only compress if the response is above a certain size.
35−-- * I've read that IE can\'t support compression for Javascript files.
36gzip :: Bool -- ^ should we gzip files?
63gzip :: Bool -- ^ should we gzip files?
37 -> Middleware
64 -> Middleware
38−gzip files app env = do
65+gzip files = gzip' def
66+ { gzipFiles = if files then GzipCompress else GzipIgnore
69+gzip' :: GzipSettings -> Middleware
70+gzip' set app env = do
39 res <- app env
71 res <- app env
41− case res of
72+ case res of
42− ResponseFile{} | not files -> res
73+ ResponseFile{} | gzipFiles set == GzipIgnore -> return res
43− _ -> if "gzip" `elem` enc && not isMSIE6
74+ _ -> if "gzip" `elem` enc && not isMSIE6
76+ case (res, gzipFiles set) of
77+ (ResponseFile s hs file Nothing, GzipCacheFolder cache) ->
78+ case lookup "content-type" hs of
80+ | gzipCheckMime set m -> liftIO $ compressFile s hs file cache
44− then ResponseEnumerator $ compressE $ responseEnumerator res
82+ _ -> return $ ResponseEnumerator $ compressE set $ responseEnumerator res
45− else res
83+ else return res
47 enc = fromMaybe [] $ (splitCommas . S8.unpack)
85 enc = fromMaybe [] $ (splitCommas . S8.unpack)
48 `fmap` lookup "Accept-Encoding" (requestHeaders env)
86 `fmap` lookup "Accept-Encoding" (requestHeaders env)
49 ua = fromMaybe "" $ lookup "user-agent" $ requestHeaders env
87 ua = fromMaybe "" $ lookup "user-agent" $ requestHeaders env
50 isMSIE6 = "MSIE 6" `S.isInfixOf` ua
88 isMSIE6 = "MSIE 6" `S.isInfixOf` ua
90+compressFile :: Status -> [Header] -> FilePath -> FilePath -> IO Response
91+compressFile s hs file cache = do
92+ e <- doesFileExist tmpfile
96+ createDirectoryIfMissing True cache
97+ x <- SIO.withFile tmpfile SIO.WriteMode $ \h ->
102+ either (const onErr) (const onSucc) x
104+ onSucc = return $ ResponseFile s (fixHeaders hs) tmpfile Nothing
105+ onErr = return $ ResponseFile s hs file Nothing
106+ tmpfile = cache ++ '/' : map safe file
108+ | 'A' <= c && c <= 'Z' = c
109+ | 'a' <= c && c <= 'z' = c
110+ | '0' <= c && c <= '9' = c
115+compressE :: GzipSettings
52−compressE :: (forall a. ResponseEnumerator a)
116+ -> (forall a. ResponseEnumerator a)
53 -> (forall a. ResponseEnumerator a)
117 -> (forall a. ResponseEnumerator a)
54−compressE re f =
118+compressE set re f =
56 --e s hs'
120 --e s hs'
58 f' s hs =
122 f' s hs =
123+ case lookup "content-type" hs of
59− joinI $ compress $$ f s hs'
124+ Just m | gzipCheckMime set m -> joinI $ compress $$ f s (fixHeaders hs)
60− where
125+ _ -> f s hs
61− -- Remove Content-Length header, since we will certainly have a
127+-- Remove Content-Length header, since we will certainly have a
62− -- different length after gzip compression.
128+-- different length after gzip compression.
129+fixHeaders :: [Header] -> [Header]
63− hs' = ("Content-Encoding", "gzip") : filter notLength hs
131+ (("Content-Encoding", "gzip") :) . filter notLength
64− notLength (x, _) = x /= "content-length"
133+ notLength (x, _) = x /= "content-length"
66splitCommas :: String -> [String]
135splitCommas :: String -> [String]
67splitCommas [] = []
136splitCommas [] = []