packages feed

wai-middleware-static 0.1.2 → 0.2.0

raw patch · 2 files changed

+84/−44 lines, 2 filesdep +filepathdep −bytestringdep −system-filepathPVP ok

version bump matches the API change (PVP)

Dependencies added: filepath

Dependencies removed: bytestring, system-filepath

API changes (from Hackage documentation)

- Network.Wai.Middleware.Static: staticList :: [(Text, Text)] -> Middleware
- Network.Wai.Middleware.Static: staticRoot :: Text -> Middleware
+ Network.Wai.Middleware.Static: (>->) :: Policy -> Policy -> Policy
+ Network.Wai.Middleware.Static: addBase :: String -> Policy
+ Network.Wai.Middleware.Static: addSlash :: Policy
+ Network.Wai.Middleware.Static: noDots :: Policy
+ Network.Wai.Middleware.Static: only :: [(String, String)] -> Policy
+ Network.Wai.Middleware.Static: staticPolicy :: Policy -> Middleware
+ Network.Wai.Middleware.Static: type Policy = String -> Maybe String

Files

Network/Wai/Middleware/Static.hs view
@@ -1,66 +1,109 @@ {-# LANGUAGE OverloadedStrings #-}-module Network.Wai.Middleware.Static (static, staticRoot, staticList) where+-- | Serve static files, subject to a policy that can filter or+--   modify incoming URIs. The flow is:+--+--   incoming request URI ==> policies ==> exists? ==> respond+--+--   If any of the polices fail (return Nothing), 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+    ( -- * Middlewares+      static, staticPolicy+    , -- * Policies+      Policy, (>->)+    , addBase, addSlash, noDots, only+    ) where -import Control.Monad (mplus) import Control.Monad.Trans (liftIO) import Data.List (isInfixOf) import qualified Data.Map as M import Data.Maybe (fromMaybe)-import Data.Monoid (mconcat)-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy.Char8 as BL+import Data.Monoid import qualified Data.Text as T-import qualified Data.Text.Encoding as E -import qualified Filesystem.Path.CurrentOS as F-import Network.HTTP.Types (status200, status404)+import Network.HTTP.Types (status200, Ascii) import System.Directory (doesFileExist)+import System.FilePath  import Network.Wai +-- | Take an incoming URI and optionally modify or filter it.+--   The result will be treated as a filepath.+type Policy = String -> Maybe String++-- | Combine two policies. They are run from left to right.+(>->) :: Policy -> Policy -> Policy+p1 >-> p2 = maybe Nothing p2 . p1++-- | Filter URIs containing \"..\"+noDots :: Policy+noDots s = if ".." `isInfixOf` s then Nothing else Just 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 = Just . (b </>)++-- | Add an initial slash to to the URI, if not already present.+--+-- > staticPolicy addSlash+--+-- GET \"foo\/bar\" looks for \"\/foo\/bar\"+addSlash :: Policy+addSlash s@('/':_) = Just s+addSlash s         = Just ('/':s)++-- | Filter any URIs not in a specific list, mapping to a filepath.+--+-- > 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 = flip lookup+ -- | 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. static :: Middleware-static = staticRoot ""---- | Like 'static', but only looks for static files in the given directory.--- Supplied path may be relative or absolute and is prepended to the requested path.------ > static = staticRoot ""-staticRoot :: T.Text -> Middleware-staticRoot base app req =-    if ".." `isInfixOf` (F.encodeString fp) -- for security reasons-      then app req-      else do exists <- liftIO $ doesFileExist fStr-              if exists-                then return $ ResponseFile status200 [("Content-Type", getMimeType fp)] fStr Nothing-                else app req-  where fp = F.collapse $ F.fromText $ T.intercalate "/" $ pathInfo req-        fStr = F.encodeString $ F.fromText base F.</> fp+static = staticPolicy mempty --- | Serve only the files given in an association list.--- Key is the URI, Value is the filesystem path.-staticList :: [(T.Text, T.Text)] -> Middleware-staticList fs app req =+-- | Serve static files subject to a 'Policy'+staticPolicy :: Policy -> Middleware+staticPolicy p app req =     maybe (app req)-          (\fp -> do let fStr = T.unpack fp-                     exists <- liftIO $ doesFileExist fStr+          (\fp -> do exists <- liftIO $ doesFileExist fp                      if exists-                        then return $ ResponseFile status200 [("Content-Type", getMimeType (F.fromText fp))] fStr Nothing-                        else return $ responseLBS status404 [("Content-Type", "text/plain")] $ mconcat ["404: ", BL.pack fStr, " not found."])-          ((lookup p fs) `mplus` (lookup (T.cons '/' p) fs)) -- try without and with leading slash-    where p = (T.intercalate "/" $ pathInfo req)+                        then return $ ResponseFile status200+                                                   [("Content-Type", getMimeType fp)]+                                                   fp+                                                   Nothing+                        else app req)+          (p $ T.unpack $ T.intercalate "/" $ pathInfo req) -getMimeType :: F.FilePath -> B.ByteString-getMimeType = go . map E.encodeUtf8 . F.extensions+getMimeType :: FilePath -> Ascii+getMimeType = go . extensions     where go [] = defaultMimeType-          go exts = fromMaybe (go $ tail exts) $ M.lookup (B.intercalate "." exts) defaultMimeTypes+          go (ext:exts) = fromMaybe (go exts) $ M.lookup ext defaultMimeTypes -defaultMimeType :: B.ByteString+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 B.ByteString B.ByteString+defaultMimeTypes :: M.Map String Ascii defaultMimeTypes = M.fromList [   ( "asc"     , "text/plain"                        ),   ( "asf"     , "video/x-ms-asf"                    ),
wai-middleware-static.cabal view
@@ -1,5 +1,5 @@ Name:                wai-middleware-static-Version:             0.1.2+Version:             0.2.0 Synopsis:            WAI middleware that intercepts requests to static files. Homepage:            https://github.com/xich/scotty Bug-reports:         https://github.com/xich/scotty/issues@@ -18,18 +18,15 @@   .   [WAI] <http://hackage.haskell.org/package/wai> --- Extra-source-files:- Library   Exposed-modules:     Network.Wai.Middleware.Static   default-language:    Haskell2010   Build-depends:       base             >= 4.3.1 && < 5,-                       bytestring       >= 0.9.1,                        containers       >= 0.4,                        directory        >= 1.1,                        http-types       >= 0.6.8 && < 0.7,                        mtl              >= 2.0.1,-                       system-filepath  >= 0.4.4,+                       filepath         >= 1.3.0.0,                        text             >= 0.11.1,                        wai              >= 1.0.0