wai-middleware-static 0.6.0.1 → 0.7.0.0

raw patch · 3 files changed

+165/−23 lines, 3 filesdep +base16-bytestringdep +cryptohashdep +expiring-cache-mapdep ~filepathnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: base16-bytestring, cryptohash, expiring-cache-map, old-locale, time, unix

Dependency ranges changed: filepath

API changes (from Hackage documentation)

Files

• Network/Wai/Middleware/Static.hs +150/−20
• changelog.md +5/−0
• wai-middleware-static.cabal +10/−3

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP, OverloadedStrings #-} -- | Serve static files, subject to a policy that can filter or --   modify incoming URIs. The flow is: --@@ -11,6 +11,9 @@ module Network.Wai.Middleware.Static     ( -- * Middlewares       static, staticPolicy, unsafeStaticPolicy+    , static', staticPolicy', unsafeStaticPolicy'+    , -- * Cache Control+      CachingStrategy(..), FileMeta(..), initCaching, CacheContainer     , -- * Policies       Policy, (<|>), (>->), policy, predicate     , addBase, addSlash, contains, hasPrefix, hasSuffix, noDots, isNotAbsolute, only@@ -18,25 +21,50 @@       tryPolicy     ) where +import Caching.ExpiringCacheMap.HashECM (newECMIO, lookupECM, CacheSettings(..), consistentDuration) import Control.Monad.Trans (liftIO)-import qualified Data.ByteString as B import Data.List-import qualified Data.Map as M import Data.Maybe (fromMaybe)+#if !(MIN_VERSION_base(4,8,0)) import Data.Monoid-import qualified Data.Text as T--import Network.HTTP.Types (status200)+#endif+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)+#if !(MIN_VERSION_time(1,5,0))+import System.Locale+#endif+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 -import Network.Wai- -- | 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)@@ -113,32 +141,132 @@ 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.+-- 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 :: Middleware static = staticPolicy mempty --- | Serve static files subject to a 'Policy'+-- | 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. Allows a 'CachingStrategy'. -- -- Note: for security reasons, this uses the 'noDots' and 'isNotAbsolute' policy by default.+static' :: CacheContainer -> Middleware+static' cc = staticPolicy' cc 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 -> Middleware-staticPolicy p = unsafeStaticPolicy $ noDots >-> isNotAbsolute >-> p+staticPolicy = staticPolicy' CacheContainerEmpty +-- | 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' :: CacheContainer -> Policy -> Middleware+staticPolicy' cc p = unsafeStaticPolicy' cc $ 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.+-- has no policies enabled by default, and is hence insecure. Disables caching. unsafeStaticPolicy :: Policy -> Middleware-unsafeStaticPolicy p app req callback =+unsafeStaticPolicy = unsafeStaticPolicy' CacheContainerEmpty++-- | 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' ::+    CacheContainer+    -> Policy+    -> Middleware+unsafeStaticPolicy' cacheContainer p app req callback =     maybe (app req callback)-          (\fp -> do exists <- liftIO $ doesFileExist fp-                     if exists-                        then callback $ responseFile status200-                                                     [("Content-Type", getMimeType fp)]-                                                     fp-                                                     Nothing-                        else app req callback)+          (\fp ->+               do exists <- liftIO $ doesFileExist fp+                  if exists+                  then case cacheContainer of+                         CacheContainerEmpty ->+                             sendFile fp []+                         CacheContainer _ NoCaching ->+                             sendFile fp []+                         CacheContainer getFileMeta strategy ->+                             do fileMeta <- getFileMeta fp+                                if checkNotModified fileMeta (readHeader "If-Modified-Since") (readHeader "If-None-Match")+                                then sendNotModified fileMeta strategy+                                else sendFile fp (computeHeaders fileMeta strategy)+                  else app req callback)           (tryPolicy p $ T.unpack $ T.intercalate "/" $ pathInfo req)+    where+      readHeader header =+          lookup header $ requestHeaders req+      checkNotModified fm modSince etag =+          or [ Just (fm_lastModified fm) == modSince+             , Just (fm_etag fm) == etag+             ]+      computeHeaders fm cs =+          case cs of+            NoCaching -> []+            PublicStaticCaching ->+                [ ("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 -> f fm+      sendNotModified fm cs =+          do let cacheHeaders = computeHeaders fm cs+             callback $ responseLBS status304 cacheHeaders BSL.empty+      sendFile fp extraHeaders =+          do let basicHeaders =+                     [ ("Content-Type", getMimeType fp)+                     ]+                 headers =+                     basicHeaders ++ extraHeaders+             callback $ responseFile status200 headers fp Nothing +-- | Container caching file meta information. Create using 'initCaching'+data CacheContainer+    = CacheContainerEmpty+    | CacheContainer (FilePath -> IO FileMeta) CachingStrategy++-- | 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)++-- | Initialize caching. This should only be done once per application launch.+initCaching :: CachingStrategy -> IO CacheContainer+initCaching cs =+    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 (CacheContainer (lookupECM filecache) cs)++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@@ -186,9 +314,11 @@   ( "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"                         ),

@@ -1,3 +1,8 @@+## 0.7.0.0+* Implement caching [agrafix]+* Include mp4 and ogv mime_types [DrBoolean]+* Dependency updates for ghc 7.10 [DougBurke]+ ## 0.6.0.1  * Update links to new wai-middleware-static github/issue tracker.

@@ -1,5 +1,5 @@ Name:                wai-middleware-static-Version:             0.6.0.1+Version:             0.7.0.0 Synopsis:            WAI middleware that serves requests to static files. Homepage:            https://github.com/scotty-web/wai-middleware-static Bug-reports:         https://github.com/scotty-web/wai-middleware-static/issues@@ -23,14 +23,21 @@ Library   Exposed-modules:     Network.Wai.Middleware.Static   default-language:    Haskell2010-  Build-depends:       base             >= 4.6.0.1  && < 5,+  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,-                       filepath         >= 1.3.0.1  && < 1.4,+                       expiring-cache-map >= 0.0.5  && < 0.1,+                       filepath         >= 1.3.0.1  && < 1.5,                        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.6,+                       unix             >= 2.7      && < 2.8,                        wai              >= 3.0.0    && < 3.1    GHC-options: -Wall -fno-warn-orphans