diff --git a/Network/Wai/Middleware/Static.hs b/Network/Wai/Middleware/Static.hs --- a/Network/Wai/Middleware/Static.hs +++ b/Network/Wai/Middleware/Static.hs @@ -12,6 +12,9 @@ ( -- * Middlewares static, staticPolicy, unsafeStaticPolicy , static', staticPolicy', unsafeStaticPolicy' + , staticWithOptions, staticPolicyWithOptions, unsafeStaticPolicyWithOptions + , -- * Options + Options, cacheContainer, mimeTypes, defaultOptions , -- * Cache Control CachingStrategy(..), FileMeta(..), initCaching, CacheContainer , -- * Policies @@ -29,7 +32,9 @@ #if !(MIN_VERSION_base(4,8,0)) import Data.Monoid (Monoid(..)) #endif +#if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup (Semigroup(..)) +#endif import Data.Time import Data.Time.Clock.POSIX import Network.HTTP.Types (status200, status304) @@ -54,6 +59,24 @@ newtype Policy = Policy { tryPolicy :: String -> Maybe String -- ^ 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. @@ -143,7 +166,7 @@ -- 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). @@ -157,38 +180,65 @@ -- 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 = staticPolicy' CacheContainerEmpty +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. Disables caching. +-- has no policies enabled by default and is hence insecure. Disables caching. unsafeStaticPolicy :: Policy -> Middleware -unsafeStaticPolicy = unsafeStaticPolicy' CacheContainerEmpty +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'. -unsafeStaticPolicy' :: - CacheContainer - -> Policy - -> Middleware -unsafeStaticPolicy' cacheContainer p app req callback = +{-# 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 (app req callback) (\fp -> do exists <- liftIO $ doesFileExist fp if exists - then case cacheContainer of + then case cacheContainer options of CacheContainerEmpty -> sendFile fp [] CacheContainer _ NoCaching -> @@ -222,7 +272,7 @@ callback $ responseLBS status304 cacheHeaders BSL.empty sendFile fp extraHeaders = do let basicHeaders = - [ ("Content-Type", getMimeType fp) + [ ("Content-Type", mimeTypes options fp) ] headers = basicHeaders ++ extraHeaders diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,7 @@ +## 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. diff --git a/wai-middleware-static.cabal b/wai-middleware-static.cabal --- a/wai-middleware-static.cabal +++ b/wai-middleware-static.cabal @@ -1,5 +1,5 @@ Name: wai-middleware-static -Version: 0.8.2 +Version: 0.8.3 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 @@ -22,7 +22,9 @@ , GHC == 7.10.3 , GHC == 8.0.2 , GHC == 8.2.2 - , GHC == 8.4.1 + , GHC == 8.4.4 + , GHC == 8.6.5 + , GHC == 8.8.1 Extra-source-files: changelog.md, README.md Library @@ -31,7 +33,7 @@ Build-depends: base >= 4.6.0.1 && < 5, bytestring >= 0.10.0.2 && < 0.11, - containers >= 0.5.0.0 && < 0.6, + containers >= 0.5.0.0 && < 0.7, cryptonite >= 0.10 && < 1.0, memory >= 0.10 && < 1.0, directory >= 1.2.0.1 && < 1.4, @@ -43,7 +45,7 @@ old-locale >= 1.0 && < 1.1, semigroups >= 0.18 && < 1, text >= 0.11.3.1 && < 1.3, - time >= 1.4 && < 1.9, + time >= 1.4 && < 1.10, wai >= 3.0.0 && < 3.3 GHC-options: -Wall -fno-warn-orphans