wai-middleware-static 0.6.0.1 → 0.9.4
raw patch · 6 files changed
Files
- Network/Wai/Middleware/Static.hs +222/−107
- README.md +3/−0
- changelog.md +54/−0
- test/Network/Wai/Middleware/StaticSpec.hs +41/−0
- test/Spec.hs +1/−0
- wai-middleware-static.cabal +49/−14
Network/Wai/Middleware/Static.hs view
@@ -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,38 +11,90 @@ module Network.Wai.Middleware.Static ( -- * Middlewares static, staticPolicy, unsafeStaticPolicy+ , static', staticPolicy', unsafeStaticPolicy'+ , staticWithOptions, staticPolicyWithOptions, unsafeStaticPolicyWithOptions+ , -- * Options+ Options, cacheContainer, mimeTypes, defaultOptions+ , -- * Cache Control+ CachingStrategy(..), FileMeta(..), initCaching, CacheContainer , -- * Policies Policy, (<|>), (>->), policy, predicate , addBase, addSlash, contains, hasPrefix, hasSuffix, noDots, isNotAbsolute, only , -- * Utilities tryPolicy+ , -- * MIME types+ getMimeType ) where -import Control.Monad.Trans (liftIO)-import qualified Data.ByteString as B-import Data.List-import qualified Data.Map as M-import Data.Maybe (fromMaybe)-import Data.Monoid+import Caching.ExpiringCacheMap.HashECM (newECMIO, lookupECM, CacheSettings(..), consistentDuration)+import Control.Monad+import qualified Crypto.Hash.SHA1 as SHA1+import qualified Data.ByteString.Base16 as Base16+import qualified Data.List as L+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup (Semigroup(..))+#endif+import Data.Time+import Data.Time.Clock.POSIX+import Network.HTTP.Types+import Network.Mime (MimeType, defaultMimeLookup)+import Network.Wai+import System.Directory (doesFileExist, getModificationTime)+-- import Crypto.Hash.Algorithms+-- import Crypto.Hash+-- import Data.ByteArray.Encoding+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Lazy as BSL import qualified Data.Text as T--import Network.HTTP.Types (status200)-import System.Directory (doesFileExist) 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+newtype Policy = Policy { tryPolicy :: String -> Maybe FilePath -- ^ Run a policy } +-- | Options for 'staticWithOptions' 'Middleware'.+--+-- Options can be set using record syntax on 'defaultOptions' with the fields below.+data Options = Options { cacheContainer :: CacheContainer -- ^ Cache container to use+ , mimeTypes :: FilePath -> MimeType -- ^ Compute MimeType from file name+ }++-- | Default options.+--+-- @+-- 'Options'+-- { 'cacheContainer' = 'CacheContainerEmpty' -- no caching+-- , 'mimeTypes' = 'getMimeType' -- use 'defaultMimeLookup' from 'Network.Mime'+-- }+-- @+defaultOptions :: Options+defaultOptions = Options { cacheContainer = CacheContainerEmpty, mimeTypes = getMimeType }++-- | 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:+-- '(<>)' == @>->@ (policy sequencing)+instance Semigroup Policy where+ p1 <> p2 = policy (maybe Nothing (tryPolicy p2) . tryPolicy p1)++-- | 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)+ mempty = policy Just+ mappend = (<>) -- | Lift a function into a 'Policy' policy :: (String -> Maybe String) -> Policy@@ -55,7 +107,7 @@ -- | 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 <|>@@ -83,19 +135,19 @@ -- | Accept only URIs with given suffix hasSuffix :: String -> Policy-hasSuffix = predicate . isSuffixOf+hasSuffix = predicate . L.isSuffixOf -- | Accept only URIs with given prefix hasPrefix :: String -> Policy-hasPrefix = predicate . isPrefixOf+hasPrefix = predicate . L.isPrefixOf -- | Accept only URIs containing given string contains :: String -> Policy-contains = predicate . isInfixOf+contains = predicate . L.isInfixOf -- | Reject URIs containing \"..\" noDots :: Policy-noDots = predicate (not . isInfixOf "..")+noDots = predicate (not . L.isInfixOf "..") -- | Reject URIs that are absolute paths isNotAbsolute :: Policy@@ -109,110 +161,173 @@ -- GET \"foo\/bar\" looks for \"\/home\/user\/files\/bar\" -- GET \"baz\/bar\" doesn't match anything ---only :: [(String,String)] -> Policy+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.+-- 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.+{-# DEPRECATED static'+ [ "Use 'staticWithOptions' instead. "+ , "This function will be removed in the next major release."+ ] #-}+static' :: CacheContainer -> Middleware+static' cc = staticPolicy' cc mempty++-- | 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. Takes 'Options'.+--+-- Note: for security reasons, this uses the 'noDots' and 'isNotAbsolute' policy by default.+staticWithOptions :: Options -> Middleware+staticWithOptions options = staticPolicyWithOptions options 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' (cacheContainer defaultOptions) +-- | Serve static files subject to a 'Policy' using a specified 'CachingStrategy'+--+-- Note: for security reasons, this uses the 'noDots' and 'isNotAbsolute' policy by default.+{-# DEPRECATED staticPolicy'+ [ "Use 'staticPolicyWithOptions' instead. "+ , "This function will be removed in the next major release."+ ] #-}+staticPolicy' :: CacheContainer -> Policy -> Middleware+staticPolicy' cc p = unsafeStaticPolicy' cc $ noDots >-> isNotAbsolute >-> p++-- | Serve static files subject to a 'Policy' using specified 'Options'+--+-- Note: for security reasons, this uses the 'noDots' and 'isNotAbsolute' policy by default.+staticPolicyWithOptions :: Options -> Policy -> Middleware+staticPolicyWithOptions options p = unsafeStaticPolicyWithOptions options $ 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 =- 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)+unsafeStaticPolicy = unsafeStaticPolicy' (cacheContainer defaultOptions)++-- | 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'.+{-# DEPRECATED unsafeStaticPolicy'+ [ "Use 'unsafeStaticPolicyWithOptions' instead. "+ , "This function will be removed in the next major release."+ ] #-}+unsafeStaticPolicy' :: CacheContainer -> Policy -> Middleware+unsafeStaticPolicy' cc = unsafeStaticPolicyWithOptions (defaultOptions { cacheContainer = cc })++-- | Serve static files subject to a 'Policy'. Unlike 'staticWithOptions' and 'staticPolicyWithOptions',+-- this has no policies enabled by default and is hence insecure. Takes 'Options'.+unsafeStaticPolicyWithOptions :: Options -> Policy -> Middleware+unsafeStaticPolicyWithOptions options p app req callback =+ maybe serveUpstream tryStaticFile mCandidateFile+ where+ serveUpstream :: IO ResponseReceived+ serveUpstream = app req callback++ tryStaticFile :: FilePath -> IO ResponseReceived+ tryStaticFile fp = do+ exists <- doesFileExist fp+ if exists+ then case cacheContainer options 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 serveUpstream++ mCandidateFile :: Maybe FilePath+ mCandidateFile =+ guard isHeadOrGet >> (tryPolicy p $ T.unpack $ T.intercalate "/" $ pathInfo req)+ where+ method :: Method+ method = requestMethod req -type Ascii = B.ByteString+ isHeadOrGet :: Bool+ isHeadOrGet = method == methodHead || method == methodGet -getMimeType :: FilePath -> Ascii-getMimeType = go . extensions- where go [] = defaultMimeType- go (ext:exts) = fromMaybe (go exts) $ M.lookup ext defaultMimeTypes+ 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", mimeTypes options fp)+ ]+ headers =+ basicHeaders ++ extraHeaders+ callback $ responseFile status200 headers fp Nothing -extensions :: FilePath -> [String]-extensions [] = []-extensions fp = case dropWhile (/= '.') fp of- [] -> []- s -> let ext = tail s- in ext : extensions ext+-- | Container caching file meta information. Create using 'initCaching'+data CacheContainer+ = CacheContainerEmpty+ | CacheContainer (FilePath -> IO FileMeta) CachingStrategy -defaultMimeType :: Ascii-defaultMimeType = "application/octet-stream"+-- | 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) --- 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" ),- ( "mpeg" , "video/mpeg" ),- ( "mpg" , "video/mpeg" ),- ( "ogg" , "application/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" ) ]+-- | 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 <- getModificationTime fp+ ct <- BSL.readFile fp+ return $ FileMeta+ { fm_lastModified =+ BSC.pack $ formatTime defaultTimeLocale "%a, %d-%b-%Y %X %Z" mtime+ , fm_etag = Base16.encode (SHA1.hashlazy ct)+ , fm_fileName = fp+ }++-- | Guess MIME type from file extension+getMimeType :: FilePath -> MimeType+getMimeType = defaultMimeLookup . T.pack
+ README.md view
@@ -0,0 +1,3 @@+# wai-middleware-static [](https://github.com/scotty-web/wai-middleware-static/actions?query=workflow%3AHaskell-CI)++WAI middleware that intercepts requests to static files and serves them if they exist.
changelog.md view
@@ -1,3 +1,57 @@+## 0.9.4 [2026.01.10]+* Allow building with `time-1.15.*` (GHC 9.14).+* Remove unused `containers`, `old-locale`, and `semigroups` dependencies.++## 0.9.3 [2024.12.28]+* Drop support for pre-8.0 versions of GHC.++## 0.9.2 [2022.03.08]+* Allow building with GHC 9.2.+* Replace the `cryptonite` and `memory` dependencies with equivalent+ functionality from `cryptohash-sha1` and `base16-bytestring`.++## 0.9.1 [2021.10.31]+* Always import `Data.List` qualified.++## 0.9.0 [2020.10.01]+* Only serve static files on `HEAD` or `GET` requests.++## 0.8.3 [2019.10.20]+* Add `Options`, `staticWithOptions`, `staticPolicyWithOptions`, and `unsafeStaticPolicyWithOptions`.+* Parameterize Middleware with options allowing custom file name to MIME type mapping.++## 0.8.2 [2018.04.07]+* Remove unused test suite.++## 0.8.1+* Add `Semigroup Policy` instance+* Replace dependencies on `base16-bytestring` and `cryptohash` with the more+ modern `memory` and `cryptonite` packages, respectively [myfreeweb]++## 0.8.0+* The `mime-types` library is now used to lookup MIME types from extensions.+ As a result, some extensions now map to different MIME types. They are:++ Extension | `wai-middleware-static` | `mime-types` |+ --------- | ----------------------------- | ------------ |+ `class` | `application/octet-stream` | `application/java-vm`+ `dtd` | `text/xml` | `application/xml-dtd`+ `jar` | `application/x-java-archive` | `application/java-archive`+ `js` | `text/javascript` | `application/javascript`+ `ogg` | `application/ogg` | `audio/ogg`+ `ttf` | `application/x-font-truetype` | `application/x-font-ttf`++* Exposed `getMimeType` function [Shimuuar]++## 0.7.0.1+* Fixed Windows build (by replacing `unix` dependency with equivalent `directory`+ function)++## 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.
+ test/Network/Wai/Middleware/StaticSpec.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Wai.Middleware.StaticSpec (spec) where++import Test.Hspec hiding (shouldReturn)+import Test.Hspec.Expectations.Lifted+import Test.Hspec.Wai+import Test.Mockery.Directory++import Web.Scotty (scottyApp)+import Network.Wai.Test (SResponse(..))+import Network.HTTP.Types.Status++import Network.Wai.Middleware.Static++spec :: Spec+spec = around_ inTempDirectory $ do+ describe "static" $ with (static `fmap` scottyApp (return ())) $ do+ before_ (writeFile "foo.html" "some content") $ do+ context "on HEAD" $ do+ it "serves static file" $ do+ request "HEAD" "/foo.html" [] "" `shouldReturn` SResponse {+ simpleStatus = status200+ , simpleHeaders = [("Content-Type", "text/html")]+ , simpleBody = "some content"+ }++ context "on GET" $ do+ it "serves static file" $ do+ get "/foo.html" `shouldReturn` SResponse {+ simpleStatus = status200+ , simpleHeaders = [("Content-Type", "text/html")]+ , simpleBody = "some content"+ }++ context "otherwise" $ do+ it "serves upstream" $ do+ post "/foo.html" "" `shouldReturn` SResponse {+ simpleStatus = status404+ , simpleHeaders = [("Content-Type", "text/html")]+ , simpleBody = "<h1>404: File Not Found!</h1>"+ }
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -fforce-recomp -F -pgmF hspec-discover #-}
wai-middleware-static.cabal view
@@ -1,5 +1,5 @@ Name: wai-middleware-static-Version: 0.6.0.1+Version: 0.9.4 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@@ -17,24 +17,59 @@ if they exist. . [WAI] <http://hackage.haskell.org/package/wai>--Extra-source-files: changelog.md+tested-with: GHC == 8.0.2+ , GHC == 8.2.2+ , GHC == 8.4.4+ , GHC == 8.6.5+ , GHC == 8.8.4+ , GHC == 8.10.7+ , GHC == 9.0.2+ , GHC == 9.2.8+ , GHC == 9.4.8+ , GHC == 9.6.7+ , GHC == 9.8.4+ , GHC == 9.10.3+ , GHC == 9.12.2+ , GHC == 9.14.1+Extra-source-files: changelog.md, README.md Library Exposed-modules: Network.Wai.Middleware.Static default-language: Haskell2010- Build-depends: base >= 4.6.0.1 && < 5,- bytestring >= 0.10.0.2 && < 0.11,- containers >= 0.5.0.0 && < 0.6,- directory >= 1.2.0.1 && < 1.3,- filepath >= 1.3.0.1 && < 1.4,- http-types >= 0.8.2 && < 0.9,- mtl >= 2.1.2 && < 2.3,- text >= 0.11.3.1 && < 1.3,- wai >= 3.0.0 && < 3.1+ Build-depends:+ base >= 4.9 && < 5,+ base16-bytestring >= 0.1 && < 1.1,+ bytestring >= 0.10.0.2 && < 0.13,+ cryptohash-sha1 >= 0.11 && < 0.12,+ directory >= 1.2.0.1 && < 1.4,+ expiring-cache-map >= 0.0.5 && < 0.1,+ filepath >= 1.3.0.1 && < 1.6,+ http-types >= 0.8.2 && < 0.13,+ mime-types >= 0.1.0.3 && < 0.2,+ text >= 0.11.3.1 && < 2.2,+ time >= 1.6.0.1 && < 1.16,+ wai >= 3.0.0 && < 3.3 - GHC-options: -Wall -fno-warn-orphans+ GHC-options: -Wall -Wno-orphans +test-suite spec+ main-is: Spec.hs+ other-modules: Network.Wai.Middleware.StaticSpec+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: test+ build-depends: base,+ hspec == 2.*,+ hspec-expectations-lifted,+ hspec-wai >= 0.6.3,+ mockery,+ scotty,+ wai-extra,+ http-types,+ wai-middleware-static+ build-tool-depends: hspec-discover:hspec-discover == 2.*+ GHC-options: -Wall+ source-repository head type: git- location: git://github.com/scotty-web/wai-middleware-static.git+ location: https://github.com/scotty-web/wai-middleware-static.git