1
{-# LANGUAGE OverloadedStrings #-}
2
module Network.Wai.Middleware.CleanPath
10
import qualified Data.ByteString.Char8 as B
11
import qualified Data.ByteString.Lazy as L
12
import Network.URI (unEscapeString)
13
import qualified Data.ByteString.UTF8 as BSU
15
cleanPathFunc :: (B.ByteString -> Either B.ByteString [String])
17
-> ([String] -> Request -> IO Response)
20
cleanPathFunc splitter prefix app env =
21
case splitter $ pathInfo env of
22
Right pieces -> app pieces env
25
[("Location", B.concat [prefix, p, suffix])]
28
-- include the query string if present
30
case B.uncons $ queryString env of
32
Just ('?', _) -> queryString env
33
_ -> B.cons '?' $ queryString env
35
-- | Performs redirects as per 'splitPath'.
36
cleanPathRel :: B.ByteString -> ([String] -> Request -> IO Response)
37
-> Request -> IO Response
38
cleanPathRel = cleanPathFunc splitPath
40
cleanPath :: ([String] -> Request -> IO Response) -> Request -> IO Response
41
cleanPath = cleanPathRel B.empty
43
-- | Given a certain requested path, return either a corrected path
44
-- to redirect to or the tokenized path.
46
-- This code corrects for the following issues:
48
-- * It is missing a trailing slash, and there is no period after the
51
-- * There are any doubled slashes.
52
splitPath :: B.ByteString -> Either B.ByteString [String]
54
let corrected = B.pack $ rts $ ats $ rds $ B.unpack s
56
then Right $ map (BSU.toString . B.pack . unEscapeString . B.unpack)
57
$ filter (not . B.null)
61
-- | Remove double slashes
62
rds :: String -> String
66
| a == '/' && b == '/' = rds (b:c)
67
| otherwise = a : rds (b:c)
69
-- | Add a trailing slash if it is missing. Empty string is left alone.
70
ats :: String -> String
73
if last s == '/' || dbs (reverse s)
77
-- | Remove a trailing slash if the last piece has a period.
78
rts :: String -> String
81
if last s == '/' && dbs (tail $ reverse s)
85
-- | Is there a period before a slash here?
added
removed
Network/Wai/Middleware/CleanPath.hs
