Permalink
Browse files

Fix some escaping issues

  • Loading branch information...
1 parent 3501871 commit 5677b24581e0c7264dccf03fc5aaa785fe36532c @singpolyma committed Oct 15, 2012
Showing with 7 additions and 4 deletions.
  1. +2 −2 example/routes
  2. +2 −1 route-generator.cabal
  3. +3 −1 routeGenerator.hs
View
@@ -1,4 +1,4 @@
GET / => home
GET /test/: => test
-GET /test2/: => test2
-GET /test3/:/* => test3
+GET /test#2/: => test2
+GET /test©3/:/* => test3
View
@@ -55,7 +55,8 @@ executable routeGenerator
base == 4.*,
text >= 0.7,
attoparsec >= 0.10.0.0,
- yesod-routes
+ yesod-routes,
+ network
source-repository head
type: git
View
@@ -9,6 +9,7 @@ import Data.List (intercalate)
import Data.Char (isUpper, isSpace)
import Data.Maybe (catMaybes, isJust)
import Yesod.Routes.Dispatch (Piece(Static, Dynamic))
+import Network.URI (escapeURIString, isReserved, isUnescapedInURI)
import Data.Text (Text)
import qualified Data.Text as T
@@ -61,6 +62,7 @@ multiArg _ = 0
emitPathHelpers :: [Route] -> Int -> IO ()
emitPathHelpers rs nArgs = mapM_ emitPathHelper rs
where
+ doEscapeURI = escapeURIString (\c -> not (isReserved c || not (isUnescapedInURI c))) . T.unpack
escapeURI = "(escapeURIString (\\c -> not (isReserved c || not (isUnescapedInURI c))) . unpack)"
emitPathHelper r = do
let args = argList "arg" (length (filter isDynamic (pieces r)) + multiArg r)
@@ -70,7 +72,7 @@ emitPathHelpers rs nArgs = mapM_ emitPathHelper rs
putStr " = URI \"\" Nothing ('/' : intercalate \"/\" (["
putStr $ intercalate ", " $ snd $ foldr (\p (n,xs) -> case p of
Dynamic -> (n-1, (escapeURI ++ " $ toPathPiece arg" ++ show n):xs)
- Static s -> (n, show s : xs)
+ Static s -> (n, show (doEscapeURI s) : xs)
) (length args - multiArg r, []) (pieces r)
putStr "]"
when (multi r) (putStr $ " ++ map " ++ escapeURI ++ " (toPathMultiPiece arg" ++ show (length args) ++ ")")

0 comments on commit 5677b24

Please sign in to comment.