@@ -14,14 +14,43 @@
1414-- Automatic gzip compression of responses.
1515--
1616---------------------------------------------------------
17−module Network.Wai.Middleware.Gzip (gzip) where
17+module Network.Wai.Middleware.Gzip
18+ ( gzip
19+ , gzip'
20+ , GzipSettings
21+ , gzipFiles
22+ , GzipFiles (..)
23+ , def
24+ , defaultCheckMime
25+ ) where
1826
1927import Network.Wai
2028import Network.Wai.Zlib
2129import Data.Maybe (fromMaybe)
22−import Data.Enumerator (($$), joinI)
30+import Data.Enumerator (($$), joinI, (=$), run)
31+import Data.Enumerator.Binary (enumFile, iterHandle)
2332import qualified Data.ByteString.Char8 as S8
2433import qualified Data.ByteString as S
34+import Data.Default
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)
40+
41+data GzipSettings = GzipSettings
42+ { gzipFiles :: GzipFiles
43+ , gzipCheckMime :: S.ByteString -> Bool
44+ }
45+
46+data GzipFiles = GzipIgnore | GzipCompress | GzipCacheFolder FilePath
47+ deriving (Show, Eq, Read)
48+
49+instance Default GzipSettings where
50+ def = GzipSettings GzipIgnore defaultCheckMime
51+
52+defaultCheckMime :: S.ByteString -> Bool
53+defaultCheckMime = S8.isPrefixOf "text/"
2554
2655-- | Use gzip to compress the body of the response.
2756--
@@ -31,37 +60,77 @@ import qualified Data.ByteString as S
3160-- Possible future enhancements:
3261--
3362-- * Only compress if the response is above a certain size.
34−--
35−-- * I've read that IE can\'t support compression for Javascript files.
3663gzip :: Bool -- ^ should we gzip files?
3764 -> Middleware
38−gzip files app env = do
65+gzip files = gzip' def
66+ { gzipFiles = if files then GzipCompress else GzipIgnore
67+ }
68+
69+gzip' :: GzipSettings -> Middleware
70+gzip' set app env = do
3971 res <- app env
40− return $
41− case res of
42− ResponseFile{} | not files -> res
43− _ -> if "gzip" `elem` enc && not isMSIE6
44− then ResponseEnumerator $ compressE $ responseEnumerator res
45− else res
72+ case res of
73+ ResponseFile{} | gzipFiles set == GzipIgnore -> return res
74+ _ -> if "gzip" `elem` enc && not isMSIE6
75+ then
76+ case (res, gzipFiles set) of
77+ (ResponseFile s hs file Nothing, GzipCacheFolder cache) ->
78+ case lookup "content-type" hs of
79+ Just m
80+ | gzipCheckMime set m -> liftIO $ compressFile s hs file cache
81+ _ -> return res
82+ _ -> return $ ResponseEnumerator $ compressE set $ responseEnumerator res
83+ else return res
4684 where
4785 enc = fromMaybe [] $ (splitCommas . S8.unpack)
4886 `fmap` lookup "Accept-Encoding" (requestHeaders env)
4987 ua = fromMaybe "" $ lookup "user-agent" $ requestHeaders env
5088 isMSIE6 = "MSIE 6" `S.isInfixOf` ua
5189
52−compressE :: (forall a. ResponseEnumerator a)
90+compressFile :: Status -> [Header] -> FilePath -> FilePath -> IO Response
91+compressFile s hs file cache = do
92+ e <- doesFileExist tmpfile
93+ if e
94+ then onSucc
95+ else do
96+ createDirectoryIfMissing True cache
97+ x <- SIO.withFile tmpfile SIO.WriteMode $ \h ->
98+ run
99+ $ enumFile file
100+ $$ CZE.gzip
101+ =$ iterHandle h
102+ either (const onErr) (const onSucc) x
103+ where
104+ onSucc = return $ ResponseFile s (fixHeaders hs) tmpfile Nothing
105+ onErr = return $ ResponseFile s hs file Nothing
106+ tmpfile = cache ++ '/' : map safe file
107+ safe c
108+ | 'A' <= c && c <= 'Z' = c
109+ | 'a' <= c && c <= 'z' = c
110+ | '0' <= c && c <= '9' = c
111+ safe '-' = '-'
112+ safe '_' = '_'
113+ safe _ = '_'
114+
115+compressE :: GzipSettings
116+ -> (forall a. ResponseEnumerator a)
53117 -> (forall a. ResponseEnumerator a)
54−compressE re f =
118+compressE set re f =
55119 re f'
56120 --e s hs'
57121 where
58122 f' s hs =
59− joinI $ compress $$ f s hs'
60− where
61− -- Remove Content-Length header, since we will certainly have a
62− -- different length after gzip compression.
63− hs' = ("Content-Encoding", "gzip") : filter notLength hs
64− notLength (x, _) = x /= "content-length"
123+ case lookup "content-type" hs of
124+ Just m | gzipCheckMime set m -> joinI $ compress $$ f s (fixHeaders hs)
125+ _ -> f s hs
126+
127+-- Remove Content-Length header, since we will certainly have a
128+-- different length after gzip compression.
129+fixHeaders :: [Header] -> [Header]
130+fixHeaders =
131+ (("Content-Encoding", "gzip") :) . filter notLength
132+ where
133+ notLength (x, _) = x /= "content-length"
65134
66135splitCommas :: String -> [String]
67136splitCommas [] = []