wai-middleware-static-caching (empty) → 0.6.0.1
raw patch · 4 files changed
+424/−0 lines, 4 filesdep +basedep +base16-bytestringdep +bytestringsetup-changed
Dependencies added: base, base16-bytestring, bytestring, containers, cryptohash, directory, expiring-cache-map, filepath, http-types, mtl, old-locale, text, time, unix, wai
Files
- LICENSE +31/−0
- Network/Wai/Middleware/Static/Caching.hs +344/−0
- Setup.hs +2/−0
- wai-middleware-static-caching.cabal +47/−0
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2012-Present, Andrew Farmer <anfarmer@ku.edu>+Copyright (c) 2015-Present, Alexander Thiemann <mail@athiemann.net>++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Andrew Farmer <anfarmer@ku.edu> nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Network/Wai/Middleware/Static/Caching.hs view
@@ -0,0 +1,344 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Serve static files, subject to a policy that can filter or+-- modify incoming URIs. The flow is (depending on cache strategy):+--+-- @+-- incoming request URI ==> policies ==> exists? ==> cached? ==> not modified+-- not cached? ==> respond+-- @+--+-- If any of the polices fail, or the file doesn't+-- exist, then the middleware gives up and calls the inner application.+-- If the file is found, the middleware chooses a content type based+-- on the file extension and returns the file contents as the response.+module Network.Wai.Middleware.Static.Caching+ ( -- * Middlewares+ static, staticPolicy, staticPolicy', unsafeStaticPolicy, unsafeStaticPolicy'+ , -- * Cache Control+ CachingStrategy(..), FileMeta(..)+ , -- * Policies+ Policy, (<|>), (>->), policy, predicate+ , addBase, addSlash, contains, hasPrefix, hasSuffix, noDots, isNotAbsolute, only+ , -- * Utilities+ tryPolicy+ ) where++import Caching.ExpiringCacheMap.HashECM (newECMIO, lookupECM, CacheSettings(..), consistentDuration)+import Control.Monad.Trans (liftIO)+import Data.List+import Data.Maybe (fromMaybe)+import Data.Monoid+import Data.Time+import Data.Time.Clock.POSIX+import Network.HTTP.Types (status200, status304)+import Network.HTTP.Types.Header (RequestHeaders)+import Network.Wai+import System.Directory (doesFileExist)+import System.Locale+import System.Posix.Files+import qualified Crypto.Hash.SHA1 as SHA1+import qualified Data.ByteString as B+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as B16+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Lazy as BSL+import qualified Data.Map as M+import qualified Data.Text as T+import qualified System.FilePath as FP++-- | Take an incoming URI and optionally modify or filter it.+-- The result will be treated as a filepath.+newtype Policy = Policy { tryPolicy :: String -> Maybe String -- ^ Run a policy+ }++-- | A cache strategy which should be used to+-- serve content matching a policy. Meta information is cached for a maxium of+-- 100 seconds before being recomputed.+data CachingStrategy+ -- | Do not send any caching headers+ = NoCaching+ -- | Send common caching headers for public (non dynamic) static files+ | PublicStaticCaching+ -- | Compute caching headers using the user specified function.+ -- See <http://www.mobify.com/blog/beginners-guide-to-http-cache-headers/> for a detailed guide+ | CustomCaching (FileMeta -> RequestHeaders)++-- | Note:+-- 'mempty' == @policy Just@ (the always accepting policy)+-- 'mappend' == @>->@ (policy sequencing)+instance Monoid Policy where+ mempty = policy Just+ mappend p1 p2 = policy (maybe Nothing (tryPolicy p2) . tryPolicy p1)++-- | Lift a function into a 'Policy'+policy :: (String -> Maybe String) -> Policy+policy = Policy++-- | Lift a predicate into a 'Policy'+predicate :: (String -> Bool) -> Policy+predicate p = policy (\s -> if p s then Just s else Nothing)++-- | Sequence two policies. They are run from left to right. (Note: this is `mappend`)+infixr 5 >->+(>->) :: Policy -> Policy -> Policy+(>->) = mappend++-- | Choose between two policies. If the first fails, run the second.+infixr 4 <|>+(<|>) :: Policy -> Policy -> Policy+p1 <|> p2 = policy (\s -> maybe (tryPolicy p2 s) Just (tryPolicy p1 s))++-- | Add a base path to the URI+--+-- > staticPolicy (addBase "/home/user/files")+--+-- GET \"foo\/bar\" looks for \"\/home\/user\/files\/foo\/bar\"+--+addBase :: String -> Policy+addBase b = policy (Just . (b FP.</>))++-- | Add an initial slash to to the URI, if not already present.+--+-- > staticPolicy addSlash+--+-- GET \"foo\/bar\" looks for \"\/foo\/bar\"+addSlash :: Policy+addSlash = policy slashOpt+ where slashOpt s@('/':_) = Just s+ slashOpt s = Just ('/':s)++-- | Accept only URIs with given suffix+hasSuffix :: String -> Policy+hasSuffix = predicate . isSuffixOf++-- | Accept only URIs with given prefix+hasPrefix :: String -> Policy+hasPrefix = predicate . isPrefixOf++-- | Accept only URIs containing given string+contains :: String -> Policy+contains = predicate . isInfixOf++-- | Reject URIs containing \"..\"+noDots :: Policy+noDots = predicate (not . isInfixOf "..")++-- | Reject URIs that are absolute paths+isNotAbsolute :: Policy+isNotAbsolute = predicate $ not . FP.isAbsolute++-- | Use URI as the key to an association list, rejecting those not found.+-- The policy result is the matching value.+--+-- > staticPolicy (only [("foo/bar", "/home/user/files/bar")])+--+-- GET \"foo\/bar\" looks for \"\/home\/user\/files\/bar\"+-- GET \"baz\/bar\" doesn't match anything+--+only :: [(String,String)] -> Policy+only al = policy (flip lookup al)++-- | Serve static files out of the application root (current directory).+-- If file is found, it is streamed to the client and no further middleware is run. Disables caching.+--+-- Note: for security reasons, this uses the 'noDots' and 'isNotAbsolute' policy by default.+static :: IO Middleware+static = staticPolicy mempty++-- | Serve static files subject to a 'Policy'. Disables caching.+--+-- Note: for security reasons, this uses the 'noDots' and 'isNotAbsolute' policy by default.+staticPolicy :: Policy -> IO Middleware+staticPolicy = staticPolicy' NoCaching++-- | Serve static files subject to a 'Policy' using a specified 'CachingStrategy'+--+-- Note: for security reasons, this uses the 'noDots' and 'isNotAbsolute' policy by default.+staticPolicy' :: CachingStrategy -> Policy -> IO Middleware+staticPolicy' cs p = unsafeStaticPolicy' cs $ noDots >-> isNotAbsolute >-> p++-- | Serve static files subject to a 'Policy'. Unlike 'static' and 'staticPolicy', this+-- has no policies enabled by default, and is hence insecure. Disables caching.+unsafeStaticPolicy :: Policy -> IO Middleware+unsafeStaticPolicy = unsafeStaticPolicy' NoCaching++-- | Serve static files subject to a 'Policy'. Unlike 'static' and 'staticPolicy', this+-- has no policies enabled by default, and is hence insecure. Also allows to set a 'CachingStrategy'.+unsafeStaticPolicy' :: CachingStrategy -> Policy -> IO Middleware+unsafeStaticPolicy' cacheStrategy p =+ do getFileMeta <- initializeFileMetaCache+ return $ middlewareHook getFileMeta cacheStrategy p++middlewareHook ::+ (FilePath -> IO FileMeta)+ -> CachingStrategy+ -> Policy+ -> (Request -> (Response -> IO b) -> IO b)+ -> Request+ -> (Response -> IO b)+ -> IO b+middlewareHook getFileMeta cs p app req callback =+ maybe (app req callback)+ (\fp ->+ do exists <- liftIO $ doesFileExist fp+ if exists+ then case cs of+ NoCaching -> sendFile fp+ _ ->+ do wasNotModified <- checkNotModified fp (readHeader "If-Modified-Since") (readHeader "If-None-Match")+ if wasNotModified+ then sendNotModified fp+ else sendFile fp+ else app req callback)+ (tryPolicy p $ T.unpack $ T.intercalate "/" $ pathInfo req)+ where+ readHeader header =+ lookup header $ requestHeaders req+ checkNotModified fp modSince etag =+ do fm <- getFileMeta fp+ return $ or [ Just (fm_lastModified fm) == modSince+ , Just (fm_etag fm) == etag+ ]+ computeHeaders fp =+ case cs of+ NoCaching -> return []+ PublicStaticCaching ->+ do fm <- getFileMeta fp+ return [ ("Cache-Control", "no-transform,public,max-age=300,s-maxage=900")+ , ("Last-Modified", fm_lastModified fm)+ , ("ETag", fm_etag fm)+ , ("Vary", "Accept-Encoding")+ ]+ CustomCaching f ->+ do fm <- getFileMeta fp+ return (f fm)+ sendNotModified fp =+ do cacheHeaders <- computeHeaders fp+ callback $ responseLBS status304 cacheHeaders BSL.empty+ sendFile fp =+ do let basicHeaders =+ [ ("Content-Type", getMimeType fp)+ ]+ cacheHeaders <- computeHeaders fp+ let headers =+ basicHeaders ++ cacheHeaders+ callback $ responseFile status200 headers fp Nothing++-- | Meta information about a file to calculate cache headers+data FileMeta+ = FileMeta+ { fm_lastModified :: !BS.ByteString+ , fm_etag :: !BS.ByteString+ , fm_fileName :: FilePath+ } deriving (Show, Eq)++initializeFileMetaCache :: IO (FilePath -> IO FileMeta)+initializeFileMetaCache =+ do let cacheAccess =+ consistentDuration 100 $ \state fp ->+ do fileMeta <- computeFileMeta fp+ return $! (state, fileMeta)+ cacheTick =+ do time <- getPOSIXTime+ return (round (time * 100))+ cacheFreq = 1+ cacheLRU =+ CacheWithLRUList 100 100 200+ filecache <- newECMIO cacheAccess cacheTick cacheFreq cacheLRU+ return (lookupECM filecache)++computeFileMeta :: FilePath -> IO FileMeta+computeFileMeta fp =+ do mtime <- getModTime fp+ ct <- BSL.readFile fp+ return $ FileMeta+ { fm_lastModified =+ BSC.pack $ formatTime defaultTimeLocale "%a, %d-%b-%Y %X %Z" mtime+ , fm_etag = B16.encode (SHA1.hashlazy ct)+ , fm_fileName = fp+ }++getModTime :: FilePath -> IO UTCTime+getModTime fullFilePath =+ do stat <- getFileStatus fullFilePath+ return $ (\t -> posixSecondsToUTCTime (realToFrac t :: POSIXTime)) $ modificationTime stat++type Ascii = B.ByteString++getMimeType :: FilePath -> Ascii+getMimeType = go . extensions+ where go [] = defaultMimeType+ go (ext:exts) = fromMaybe (go exts) $ M.lookup ext defaultMimeTypes++extensions :: FilePath -> [String]+extensions [] = []+extensions fp = case dropWhile (/= '.') fp of+ [] -> []+ s -> let ext = tail s+ in ext : extensions ext++defaultMimeType :: Ascii+defaultMimeType = "application/octet-stream"++-- This list taken from snap-core's Snap.Util.FileServe+defaultMimeTypes :: M.Map String Ascii+defaultMimeTypes = M.fromList [+ ( "asc" , "text/plain" ),+ ( "asf" , "video/x-ms-asf" ),+ ( "asx" , "video/x-ms-asf" ),+ ( "avi" , "video/x-msvideo" ),+ ( "bz2" , "application/x-bzip" ),+ ( "c" , "text/plain" ),+ ( "class" , "application/octet-stream" ),+ ( "conf" , "text/plain" ),+ ( "cpp" , "text/plain" ),+ ( "css" , "text/css" ),+ ( "cxx" , "text/plain" ),+ ( "dtd" , "text/xml" ),+ ( "dvi" , "application/x-dvi" ),+ ( "gif" , "image/gif" ),+ ( "gz" , "application/x-gzip" ),+ ( "hs" , "text/plain" ),+ ( "htm" , "text/html" ),+ ( "html" , "text/html" ),+ ( "jar" , "application/x-java-archive" ),+ ( "jpeg" , "image/jpeg" ),+ ( "jpg" , "image/jpeg" ),+ ( "js" , "text/javascript" ),+ ( "json" , "application/json" ),+ ( "log" , "text/plain" ),+ ( "m3u" , "audio/x-mpegurl" ),+ ( "mov" , "video/quicktime" ),+ ( "mp3" , "audio/mpeg" ),+ ( "mp4" , "video/mp4" ),+ ( "mpeg" , "video/mpeg" ),+ ( "mpg" , "video/mpeg" ),+ ( "ogg" , "application/ogg" ),+ ( "ogv" , "video/ogg" ),+ ( "pac" , "application/x-ns-proxy-autoconfig" ),+ ( "pdf" , "application/pdf" ),+ ( "png" , "image/png" ),+ ( "ps" , "application/postscript" ),+ ( "qt" , "video/quicktime" ),+ ( "sig" , "application/pgp-signature" ),+ ( "spl" , "application/futuresplash" ),+ ( "svg" , "image/svg+xml" ),+ ( "swf" , "application/x-shockwave-flash" ),+ ( "tar" , "application/x-tar" ),+ ( "tar.bz2" , "application/x-bzip-compressed-tar" ),+ ( "tar.gz" , "application/x-tgz" ),+ ( "tbz" , "application/x-bzip-compressed-tar" ),+ ( "text" , "text/plain" ),+ ( "tgz" , "application/x-tgz" ),+ ( "torrent" , "application/x-bittorrent" ),+ ( "ttf" , "application/x-font-truetype" ),+ ( "txt" , "text/plain" ),+ ( "wav" , "audio/x-wav" ),+ ( "wax" , "audio/x-ms-wax" ),+ ( "wma" , "audio/x-ms-wma" ),+ ( "wmv" , "video/x-ms-wmv" ),+ ( "xbm" , "image/x-xbitmap" ),+ ( "xml" , "text/xml" ),+ ( "xpm" , "image/x-xpixmap" ),+ ( "xwd" , "image/x-xwindowdump" ),+ ( "zip" , "application/zip" ) ]
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ wai-middleware-static-caching.cabal view
@@ -0,0 +1,47 @@+Name: wai-middleware-static-caching+Version: 0.6.0.1+Synopsis: WAI middleware that serves requests to static files.+Homepage: https://github.com/agrafix/wai-middleware-static+Bug-reports: https://github.com/agrafix/wai-middleware-static/issues+License: BSD3+License-file: LICENSE+Author: Andrew Farmer <afarmer@ittc.ku.edu>, Alexander Thiemann <mail@athiemann.net>+Maintainer: Alexander Thiemann <mail@athiemann.net>+Copyright: (c) 2012-2014 Andrew Farmer, (c) 2015 Alexander Thiemann+Category: Web+Stability: experimental+Build-type: Simple+Cabal-version: >= 1.10+Description:+ Fork of wai-middleware-static introducing caching:+ WAI middleware that intercepts requests to static files and serves them+ if they exist. Also implements caching strategies.+ .+ [WAI] <http://hackage.haskell.org/package/wai>+ [wai-middleware-static] <http://hackage.haskell.org/package/wai-middleware-static>++Library+ Exposed-modules: Network.Wai.Middleware.Static.Caching+ default-language: Haskell2010+ Build-depends:+ base >= 4.6.0.1 && < 5,+ base16-bytestring >= 0.1 && < 0.2,+ bytestring >= 0.10.0.2 && < 0.11,+ containers >= 0.5.0.0 && < 0.6,+ cryptohash >= 0.11 && < 0.12,+ directory >= 1.2.0.1 && < 1.3,+ expiring-cache-map >= 0.0.5 && < 0.1,+ filepath >= 1.3.0.1 && < 1.4,+ http-types >= 0.8.2 && < 0.9,+ mtl >= 2.1.2 && < 2.3,+ old-locale >= 1.0 && < 1.1,+ text >= 0.11.3.1 && < 1.3,+ time >= 1.4 && < 1.5,+ unix >= 2.7 && < 2.8,+ wai >= 3.0.0 && < 3.1++ GHC-options: -Wall -fno-warn-orphans++source-repository head+ type: git+ location: git://github.com/agrafix/wai-middleware-static.git