Permalink
Browse files

Add Policy choice operator.

  • Loading branch information...
1 parent fe0fa27 commit 8e3097b7655c5df004f3f66bc653f5a807653816 Andrew Farmer committed Jun 8, 2012
Showing with 21 additions and 12 deletions.
  1. +19 −10 Network/Wai/Middleware/Static.hs
  2. +1 −1 examples/json.hs
  3. +1 −1 wai-middleware-static/wai-middleware-static.cabal
@@ -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")])
View
@@ -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
@@ -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

0 comments on commit 8e3097b

Please sign in to comment.