wai-extra 0.4.3 → 0.4.4

raw patch · 4 files changed

+110/−29 lines, 4 filesdep +data-defaultdep +zlib-enumPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: data-default, zlib-enum

API changes (from Hackage documentation)

Files

• Network/Wai/Middleware/Gzip.hs +88/−19
• Network/Wai/Middleware/Rewrite.hs +13/−7
• runtests.hs +3/−1
• wai-extra.cabal +6/−2

@@ -14,15 +14,44 @@ -- Automatic gzip compression of responses. -- ----------------------------------------------------------module Network.Wai.Middleware.Gzip (gzip) where+module Network.Wai.Middleware.Gzip+    ( gzip+    , gzip'+    , GzipSettings+    , gzipFiles+    , GzipFiles (..)+    , def+    , defaultCheckMime+    ) where  import Network.Wai import Network.Wai.Zlib import Data.Maybe (fromMaybe)-import Data.Enumerator (($$), joinI)+import Data.Enumerator (($$), joinI, (=$), run)+import Data.Enumerator.Binary (enumFile, iterHandle) import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString as S+import Data.Default+import Network.HTTP.Types (Status, Header)+import Control.Monad.IO.Class (liftIO)+import qualified Codec.Zlib.Enum as CZE+import qualified System.IO as SIO+import System.Directory (doesFileExist, createDirectoryIfMissing) +data GzipSettings = GzipSettings+    { gzipFiles :: GzipFiles+    , gzipCheckMime :: S.ByteString -> Bool+    }++data GzipFiles = GzipIgnore | GzipCompress | GzipCacheFolder FilePath+    deriving (Show, Eq, Read)++instance Default GzipSettings where+    def = GzipSettings GzipIgnore defaultCheckMime++defaultCheckMime :: S.ByteString -> Bool+defaultCheckMime = S8.isPrefixOf "text/"+ -- | Use gzip to compress the body of the response. -- -- Analyzes the \"Accept-Encoding\" header from the client to determine@@ -31,37 +60,77 @@ -- Possible future enhancements: -- -- * Only compress if the response is above a certain size.------ * I've read that IE can\'t support compression for Javascript files. gzip :: Bool -- ^ should we gzip files?      -> Middleware-gzip files app env = do+gzip files = gzip' def+    { gzipFiles = if files then GzipCompress else GzipIgnore+    }++gzip' :: GzipSettings -> Middleware+gzip' set app env = do     res <- app env-    return $-        case res of-            ResponseFile{} | not files -> res-            _ -> if "gzip" `elem` enc && not isMSIE6-                    then ResponseEnumerator $ compressE $ responseEnumerator res-                    else res+    case res of+        ResponseFile{} | gzipFiles set == GzipIgnore -> return res+        _ -> if "gzip" `elem` enc && not isMSIE6+                then+                    case (res, gzipFiles set) of+                        (ResponseFile s hs file Nothing, GzipCacheFolder cache) ->+                            case lookup "content-type" hs of+                                Just m+                                    | gzipCheckMime set m -> liftIO $ compressFile s hs file cache+                                _ -> return res+                        _ -> return $ ResponseEnumerator $ compressE set $ responseEnumerator res+                else return res   where     enc = fromMaybe [] $ (splitCommas . S8.unpack)                     `fmap` lookup "Accept-Encoding" (requestHeaders env)     ua = fromMaybe "" $ lookup "user-agent" $ requestHeaders env     isMSIE6 = "MSIE 6" `S.isInfixOf` ua -compressE :: (forall a. ResponseEnumerator a)+compressFile :: Status -> [Header] -> FilePath -> FilePath -> IO Response+compressFile s hs file cache = do+    e <- doesFileExist tmpfile+    if e+        then onSucc+        else do+            createDirectoryIfMissing True cache+            x <- SIO.withFile tmpfile SIO.WriteMode $ \h ->+                   run+                 $ enumFile file+                $$ CZE.gzip+                =$ iterHandle h+            either (const onErr) (const onSucc) x+  where+    onSucc = return $ ResponseFile s (fixHeaders hs) tmpfile Nothing+    onErr = return $ ResponseFile s hs file Nothing+    tmpfile = cache ++ '/' : map safe file+    safe c+        | 'A' <= c && c <= 'Z' = c+        | 'a' <= c && c <= 'z' = c+        | '0' <= c && c <= '9' = c+    safe '-' = '-'+    safe '_' = '_'+    safe _ = '_'++compressE :: GzipSettings           -> (forall a. ResponseEnumerator a)-compressE re f =+          -> (forall a. ResponseEnumerator a)+compressE set re f =     re f'     --e s hs'   where     f' s hs =-        joinI $ compress $$ f s hs'-      where-        -- Remove Content-Length header, since we will certainly have a-        -- different length after gzip compression.-        hs' = ("Content-Encoding", "gzip") : filter notLength hs-        notLength (x, _) = x /= "content-length"+        case lookup "content-type" hs of+            Just m | gzipCheckMime set m -> joinI $ compress $$ f s (fixHeaders hs)+            _ -> f s hs++-- Remove Content-Length header, since we will certainly have a+-- different length after gzip compression.+fixHeaders :: [Header] -> [Header]+fixHeaders =+    (("Content-Encoding", "gzip") :) . filter notLength+  where+    notLength (x, _) = x /= "content-length"  splitCommas :: String -> [String] splitCommas [] = []

@@ -7,21 +7,27 @@ import System.Directory (doesFileExist) import Control.Monad.IO.Class (liftIO) import Data.Text (Text, unpack, pack)+import qualified Data.Text.Encoding as TE+import qualified Data.Text as T+import Network.HTTP.Types as H + -- | rewrite based on your own conversion rules -- Example usage: rewrite (autoHtmlRewrite "static")-rewrite :: ([Text] -> IO [Text]) -> Middleware+rewrite :: ([Text] -> H.RequestHeaders -> IO [Text]) -> Middleware rewrite convert app req = do-  newPathInfo <- liftIO $ convert $ pathInfo req-  app req { pathInfo = newPathInfo }+  newPathInfo <- liftIO $ convert (pathInfo req) (requestHeaders req)+  let rawPInfo = TE.encodeUtf8 $ T.intercalate "/" newPathInfo+  app req { pathInfo = newPathInfo, rawPathInfo =  rawPInfo }  -- | example rewriter---   implements 2 rules for static html re-writes+-- We don't recommend normally checking the file system on every request - this is just an example.+-- Implements 2 rules for static html re-writes --   1) for a directory foo/, check for foo/index.html --   2) for a non-directory bar, check for bar.html---   if the file exists, do the rewrite-autoHtmlRewrite :: String -> [Text] -> IO [Text]-autoHtmlRewrite staticDir pieces' = do+-- Do the rewrite only if the html file exists.+autoHtmlRewrite :: String -> [Text] -> H.RequestHeaders -> IO [Text]+autoHtmlRewrite staticDir pieces' _ = do     fe <- doesFileExist $ staticDir ++ "/" ++ reWritePath     return $ if fe then map pack reWritePieces else pieces'   where

@@ -255,7 +255,9 @@     assertBody "{\"foo\":\"bar\"}" sres3  gzipApp :: Application-gzipApp = gzip True $ const $ return $ responseLBS status200 [] "test"+gzipApp = gzip True $ const $ return $ responseLBS status200+    [("Content-Type", "text/plain")]+    "test"  caseGzip :: Assertion caseGzip = flip runSession gzipApp $ do

@@ -1,5 +1,5 @@ Name:                wai-extra-Version:             0.4.3+Version:             0.4.4 Synopsis:            Provides some basic WAI handlers and middleware. Description:         The goal here is to provide common features without many dependencies. License:             BSD3@@ -33,7 +33,9 @@                      blaze-builder >= 0.2.1.3 && < 0.4,                      http-types >= 0.6 && < 0.7,                      text >= 0.5 && < 1.0,-                     case-insensitive >= 0.2 && < 0.4+                     case-insensitive >= 0.2 && < 0.4,+                     zlib-enum >= 0.2.1 && < 0.3,+                     data-default >= 0.3 && < 0.4   Exposed-modules:   Network.Wai.Handler.CGI                      Network.Wai.Middleware.AcceptOverride                      Network.Wai.Middleware.Autohead@@ -71,6 +73,8 @@                    , zlib-bindings                    , blaze-builder-enumerator                    , blaze-builder+                   , zlib-enum+                   , data-default  source-repository head   type:     git