wai-middleware-etag 0.1.0.0 → 0.1.1.1
raw patch · 2 files changed
+100/−77 lines, 2 filesdep ~filepathdep ~wai
Dependency ranges changed: filepath, wai
Files
- src/Network/Wai/Middleware/ETag.hs +84/−66
- wai-middleware-etag.cabal +16/−11
src/Network/Wai/Middleware/ETag.hs view
@@ -11,19 +11,26 @@ -- -- WAI ETag middleware for static files. -module Network.Wai.Middleware.ETag where+module Network.Wai.Middleware.ETag+ ( etag+ , etagWithoutCache+ , defaultETagContext+ , ETagContext(..)+ , MaxAge(..)+ , ChecksumCache+ ) where -import Control.Concurrent.MVar (MVar, newMVar, takeMVar)+import Control.Concurrent.MVar (MVar, newMVar, readMVar, modifyMVar_) import Control.Exception (SomeException, try) import Control.Monad (liftM)-import Crypto.Hash.MD5 as MD5+import qualified Crypto.Hash.MD5 as MD5 (hash) import qualified Data.ByteString as BS (ByteString, readFile)-import qualified Data.ByteString.Base64 as B64-import qualified Data.ByteString.Char8 as BS8-import qualified Data.HashMap.Strict as M+import qualified Data.ByteString.Base64 as B64 (encode)+import qualified Data.ByteString.Char8 as BS8 (append, pack)+import qualified Data.HashMap.Strict as M (HashMap, empty, insert, lookup) import Network.HTTP.Date (HTTPDate, epochTimeToHTTPDate, formatHTTPDate, parseHTTPDate)-import Network.HTTP.Types (Header, ResponseHeaders, status304)+import Network.HTTP.Types (Header, status304) import Network.Wai (Middleware, requestHeaders, responseLBS) import Network.Wai.Internal (Request (..), Response (..))@@ -31,42 +38,41 @@ import System.PosixCompat.Files (fileSize, getFileStatus, modificationTime) --- | Attaches the middleware. Enable caching if the first argument is 'True'.-etag :: Bool -> MaxAge -> Middleware-etag useCache age app req = do- c <- liftM (ETagContext useCache) (newMVar M.empty)- etag' c age app req- -- | Attaches the middleware with a provided context.-etag' :: ETagContext -> MaxAge -> Middleware-etag' cache age app req =- app req >>= \response -> case response of+etag :: ETagContext -> MaxAge -> Middleware+etag ctx age app req sendResponse =+ app req $ \response -> case response of rf@(ResponseFile _ _ path _) -> do- r <- hashFileCached cache path+ r <- hashFileCached ctx path case (r, lookup "if-none-match" $ requestHeaders req) of (Hash h, Just rh) | h == rh ->- return $ addCacheControl age $ responseLBS status304 [] ""+ sendResponse $ addCacheControl age $ responseLBS status304 [] "" (Hash h, _) ->- respond age rf [("ETag", h)]+ respond age rf [("ETag", h)] >>= sendResponse (FileNotFound, _) ->- return rf+ sendResponse rf (FileTooBig, _) -> do modTime <- getModificationTimeIfExists path case (fmap epochTimeToHTTPDate modTime, modifiedSince req) of (Just mdate, Just lastSent) | mdate == lastSent ->- return $ addCacheControl age $ responseLBS status304 [] ""+ sendResponse $ addCacheControl age $ responseLBS status304 [] "" (Just mdate, _) ->- respond age rf [("last-modified", formatHTTPDate mdate)]+ respond age rf [("last-modified", formatHTTPDate mdate)] >>= sendResponse (Nothing, _) ->- respond age rf []+ respond age rf [] >>= sendResponse x ->- return x+ sendResponse x +-- | Attaches the middleware without caching the calculated ETags.+etagWithoutCache :: MaxAge -> Middleware+etagWithoutCache age app req sendResponse =+ defaultETagContext False >>= \ctx -> etag ctx age app req sendResponse+ -- | Finalize the response by attaching a cache-control header based on age. respond :: Monad m => MaxAge -> Response -> [Header] -> m Response respond age res hs =@@ -81,59 +87,61 @@ addCacheControl age res = case res of (ResponseFile st hs path part) ->- ResponseFile st (cacheControl age hs) path part+ ResponseFile st (modifyHeaders age hs) path part (ResponseBuilder st hs b) ->- ResponseBuilder st (cacheControl age hs) b- (ResponseSource st hs s) ->- ResponseSource st (cacheControl age hs) s---- | Determine if-modified-since tag from the http request if present.-modifiedSince :: Request -> Maybe HTTPDate-modifiedSince req =- lookup "if-modified-since" (requestHeaders req) >>= parseHTTPDate---- | Determine the hash of a provided file located at 'path'.--- If caching is enabled, use the cached checksum, otherwise--- always re-calculate.-hashFileCached :: ETagContext -> FilePath -> IO HashResult-hashFileCached ctx path =- if etagCtxUseCache ctx- then- liftM (M.lookup path) (takeMVar $ etagCtxCache ctx) >>= \r-> case r of- Just cachedHash ->- return $ Hash cachedHash- Nothing ->- hashFile path- else- hashFile path---- | Add cache-control to the provided response-headears.-cacheControl :: MaxAge -> ResponseHeaders -> ResponseHeaders-cacheControl maxage =- headerCacheControl . headerExpires+ ResponseBuilder st (modifyHeaders age hs) b+ (ResponseStream st hs body) ->+ ResponseStream st (modifyHeaders age hs) body+ (ResponseRaw bs f) ->+ ResponseRaw bs f where- headerCacheControl = case maxage of+ modifyHeaders maxage =+ headerCacheControl maxage . headerExpires maxage++ headerCacheControl maxage = case maxage of NoMaxAge -> id MaxAgeSeconds i -> (:) ("Cache-Control", BS8.append "public, max-age=" $ BS8.pack $ show i) MaxAgeForever ->- cacheControl (MaxAgeSeconds (60 * 60 * 24 * 365))+ headerCacheControl (MaxAgeSeconds (60 * 60 * 24 * 365 * 100)) - headerExpires = case maxage of+ headerExpires maxage = case maxage of NoMaxAge -> id- MaxAgeSeconds _ ->- id -- FIXME+ MaxAgeSeconds i ->+ (:) ("Expires", formatHTTPDate $ epochTimeToHTTPDate $ fromIntegral i) MaxAgeForever ->- (:) ("Expires", "Thu, 31 Dec 2037 23:55:55 GMT")+ headerExpires (MaxAgeSeconds (60 * 60 * 24 * 365 * 100)) +-- | Determine if-modified-since tag from the http request if present.+modifiedSince :: Request -> Maybe HTTPDate+modifiedSince req =+ lookup "if-modified-since" (requestHeaders req) >>= parseHTTPDate++-- | Determine the hash of a provided file located at 'path'.+-- If caching is enabled, use the cached checksum, otherwise+-- always re-calculate.+hashFileCached :: ETagContext -> FilePath -> IO HashResult+hashFileCached (ETagContext False size _) path = hashFile path size+hashFileCached (ETagContext True size cache) path =+ liftM (M.lookup path) (readMVar cache) >>= \r -> case r of+ Just cachedHash ->+ return $ Hash cachedHash+ Nothing ->+ hashFile path size >>= \hr -> case hr of+ Hash h -> do+ modifyMVar_ cache (return . M.insert path h)+ return hr+ _ ->+ return hr+ -- | Hash the file with MD5 located at 'fp'.-hashFile :: FilePath -> IO HashResult-hashFile fp = do- size <- liftM fileSize (getFileStatus fp)+hashFile :: FilePath -> Integer -> IO HashResult+hashFile fp size = do+ fs <- liftM fileSize (getFileStatus fp) - if size < 1024 * 1024+ if fs <= fromIntegral size then do res <- try $ liftM (B64.encode . MD5.hash) (BS.readFile fp) @@ -153,6 +161,11 @@ Left (_ :: SomeException) -> Nothing Right x -> Just x +-- | Create an empty 'ETagContext'.+defaultETagContext :: Bool -> IO ETagContext+defaultETagContext useCache =+ liftM (ETagContext useCache (1024 * 1024 * 16)) (newMVar M.empty)+ -- | Maximum age that will be attached to all file-resources -- processed by the middleware. data MaxAge@@ -168,10 +181,15 @@ | FileNotFound deriving (Show, Eq, Ord, Read) +type ChecksumCache = MVar (M.HashMap FilePath BS.ByteString)+ -- | The configuration context of the middleware. data ETagContext = ETagContext { etagCtxUseCache :: !Bool- -- ^ Set to false to disable the cache- , etagCtxCache :: !(MVar (M.HashMap FilePath BS.ByteString))- -- ^ The underlying store mapping filepaths to calculated checksums+ -- ^ Set to false to disable the cache.+ , etagCtxMaxSize :: !Integer+ -- ^ File size in bytes. If files are bigger than 'etagCtxMaxSize',+ -- no etag will be calculated.+ , etagCtxCache :: !ChecksumCache+ -- ^ The underlying store mapping filepaths to calculated checksums. } deriving (Eq)
wai-middleware-etag.cabal view
@@ -1,5 +1,5 @@ name: wai-middleware-etag-version: 0.1.0.0+version: 0.1.1.1 synopsis: WAI ETag middleware for static files homepage: https://github.com/ameingast/wai-middleware-etag Bug-reports: https://github.com/ameingast/wai-middleware-etag/issues@@ -11,23 +11,28 @@ stability: experimental build-type: Simple cabal-version: >= 1.8-description: WAI middleware that attaches ETags to responses for static files- if they exist. +description: WAI middleware that attaches ETags to responses for static files.+ .- Caveats: + Caveats: . If caching is turned on, the middleware caches calculated checksums- aggressively in a synchronized hashmap; checksums are calculated only - once, so changes on the file-system are not reflected until the server - is restarted. + aggressively in a synchronized hashmap; checksums are calculated only+ once, so changes on the file-system are not reflected until the server+ is restarted. . This middleware only calculates ETag checksums for file smaller than 1MB, otherwise it attaches a last-modified tag to the response. .+ The package is heavily influenced by wai-app-static.+ . [WAI] <http://hackage.haskell.org/package/wai>+ .+ [wai-app-static] <http://hackage.haskell.org/package/wai-app-static> + extra-source-files: src/Network/Wai/Middleware/ETag.hs- + source-repository head type: git location: git://github.com/ameingast/wai-middleware-etag.git@@ -37,14 +42,14 @@ hs-source-dirs: src ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns extensions: OverloadedStrings- build-depends: + build-depends: base >= 4.6 && < 5, base64-bytestring >= 1.0 && < 1.1, bytestring >= 0.10 && < 0.11, cryptohash >= 0.11 && < 0.12,- filepath >= 1.3 && < 1.4,+ filepath >= 1.3 && < 1.5, http-date >= 0.0.4 && < 0.1, http-types >= 0.8 && < 0.9, unix-compat >= 0.4 && < 0.5, unordered-containers >= 0.2 && < 0.3,- wai >= 2.0.0 && < 2.1+ wai >= 3.0 && < 3.1