Add Policy choice operator.

Network/Wai/Middleware/Static.hs

@@ -12,34 +12,35 @@ module Network.Wai.Middleware.Static
     ( -- * Middlewares
       static, staticPolicy
     , -- * Policies
-      Policy, (>->)
-    , addBase, addSlash, noDots, only
+      Policy, (>->), (<|>)
+    , addBase, addSlash, hasExtension, noDots, only
     ) where
 
 import Control.Monad.Trans (liftIO)
-import Data.List (isInfixOf)
+import Data.List (isInfixOf, isSuffixOf)
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
-import Data.Monoid
 import qualified Data.Text as T
 
 import Network.HTTP.Types (status200, Ascii)
 import System.Directory (doesFileExist)
-import System.FilePath
+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.
 type Policy = String -> Maybe String
 
--- | Combine two policies. They are run from left to right.
+-- | Sequence two policies. They are run from left to right.
+infixr 5 >->
 (>->) :: Policy -> Policy -> Policy
 p1 >-> p2 = maybe Nothing p2 . p1
 
--- | Filter URIs containing \"..\"
-noDots :: Policy
-noDots s = if ".." `isInfixOf` s then Nothing else Just s
+-- | Choose between two policies. If the first returns Nothing, run the second.
+infixr 4 <|>
+(<|>) :: Policy -> Policy -> Policy
+p1 <|> p2 = \s -> maybe (p2 s) Just (p1 s)
 
 -- | Add a base path to the URI
 --
@@ -48,7 +49,7 @@ noDots s = if ".." `isInfixOf` s then Nothing else Just s
 -- GET \"foo\/bar\" looks for \"\/home\/user\/files\/foo\/bar\"
 --
 addBase :: String -> Policy
-addBase b = Just . (b </>)
+addBase b = Just . (b FP.</>)
 
 -- | Add an initial slash to to the URI, if not already present.
 --
@@ -59,6 +60,14 @@ addSlash :: Policy
 addSlash s@('/':_) = Just s
 addSlash s         = Just ('/':s)
 
+-- | Filter URIs based on extension
+hasExtension :: String -> Policy
+hasExtension suf s = if suf `isSuffixOf` s then Just s else Nothing
+
+-- | Filter URIs containing \"..\"
+noDots :: Policy
+noDots s = if ".." `isInfixOf` s then Nothing else Just s
+
 -- | Filter any URIs not in a specific list, mapping to a filepath.
 --
 -- > staticPolicy (only [("foo/bar", "/home/user/files/bar")])

examples/json.hs

@@ -24,7 +24,7 @@ $(deriveJSON Prelude.id ''Foo)
 main :: IO ()
 main = scotty 3000 $ do
     middleware logStdoutDev
-    middleware $ staticPolicy (addBase "static")
+    middleware $ staticPolicy (noDots >-> addBase "static")
 
     get "/" $ do
         html $ wrapper $ do

wai-middleware-static/wai-middleware-static.cabal

@@ -1,5 +1,5 @@
 Name:                wai-middleware-static
-Version:             0.2.0
+Version:             0.2.2
 Synopsis:            WAI middleware that intercepts requests to static files.
 Homepage:            https://github.com/xich/scotty
 Bug-reports:         https://github.com/xich/scotty/issues