More complete defaultCheckMime

wai-extra/Network/Wai/Middleware/Gzip.hs

@@ -39,6 +39,7 @@ import qualified Data.Conduit.List as CL
 import Data.Conduit.Blaze (builderToByteStringFlush)
 import Blaze.ByteString.Builder (fromByteString)
 import Control.Exception (try, SomeException)
+import qualified Data.Set as Set
 
 data GzipSettings = GzipSettings
     { gzipFiles :: GzipFiles
@@ -52,7 +53,15 @@ instance Default GzipSettings where
     def = GzipSettings GzipIgnore defaultCheckMime
 
 defaultCheckMime :: S.ByteString -> Bool
-defaultCheckMime bs = S8.isPrefixOf "text/" bs || S8.isPrefixOf "application/json" bs
+defaultCheckMime bs =
+    S8.isPrefixOf "text/" bs || bs' `Set.member` toCompress
+  where
+    bs' = fst $ S.breakByte 59 bs -- semicolon
+    toCompress = Set.fromList
+        [ "application/json"
+        , "application/javascript"
+        , "application/ecmascript"
+        ]
 
 -- | Use gzip to compress the body of the response.
 --

wai-extra/test/WaiExtraTest.hs

@@ -63,6 +63,7 @@ specs = do
     it "jsonp" caseJsonp
     it "gzip" caseGzip
     it "gzip not for MSIE" caseGzipMSIE
+    it "defaultCheckMime" caseDefaultCheckMime
     it "vhost" caseVhost
     it "autohead" caseAutohead
     it "method override" caseMethodOverride
@@ -331,6 +332,16 @@ caseGzip = flip runSession gzipApp $ do
     assertNoHeader "Content-Encoding" sres2
     assertBody "test" sres2
 
+caseDefaultCheckMime :: Assertion
+caseDefaultCheckMime = do
+    let go x y = (x, defaultCheckMime x) `shouldBe` (x, y)
+    go "application/json" True
+    go "application/javascript" True
+    go "application/something" False
+    go "text/something" True
+    go "foo/bar" False
+    go "application/json; charset=utf-8" True
+
 caseGzipMSIE :: Assertion
 caseGzipMSIE = flip runSession gzipApp $ do
     sres1 <- request defaultRequest

wai-extra/wai-extra.cabal

@@ -43,6 +43,7 @@ Library
                    , resourcet                 >= 0.3      && < 0.5
                    , void                      >= 0.5      && < 0.6
                    , stringsearch              >= 0.3      && < 0.4
+                   , containers
 
   Exposed-modules:   Network.Wai.Handler.CGI
                      Network.Wai.Middleware.AcceptOverride