haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix query string redirect bug

Browse Source
This commit is contained in:
Michael Snoyman 2011-04-03 22:07:40 +03:00
parent 2e7e24f2a2
commit 423f693bc3
2 changed files with 11 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
Test/CleanPath.hs
View File

@ -38,6 +38,7 @@ mkYesod "Y" [$parseRoutes|
/foo/#String FooStringR GET /foo/#String FooStringR GET
/bar BarR GET /bar BarR GET
/subsite SubsiteR Subsite getSubsite /subsite SubsiteR Subsite getSubsite
/plain PlainR GET
|] |]
instance Yesod Y where instance Yesod Y where
@ -54,6 +55,7 @@ instance Yesod Y where
getFooR = return $ RepPlain "foo" getFooR = return $ RepPlain "foo"
getFooStringR = return . RepPlain . toContent getFooStringR = return . RepPlain . toContent
getBarR = return $ RepPlain "bar" getBarR = return $ RepPlain "bar"
getPlainR = return $ RepPlain "plain"
cleanPathTest :: Test cleanPathTest :: Test
cleanPathTest = testGroup "Test.CleanPath" cleanPathTest = testGroup "Test.CleanPath"
@ -63,6 +65,7 @@ cleanPathTest = testGroup "Test.CleanPath"
, testCase "has trailing slash" hasTrailingSlash , testCase "has trailing slash" hasTrailingSlash
, testCase "/foo/something" fooSomething , testCase "/foo/something" fooSomething
, testCase "subsite dispatch" subsiteDispatch , testCase "subsite dispatch" subsiteDispatch
, testCase "redirect with query string" redQueryString
] ]
runner f = toWaiApp Y >>= runSession f runner f = toWaiApp Y >>= runSession f
@ -119,3 +122,11 @@ subsiteDispatch = runner $ do
assertStatus 200 res assertStatus 200 res
assertContentType "SUBSITE" res assertContentType "SUBSITE" res
assertBody "[\"1\",\"2\",\"3\",\"\"]" res assertBody "[\"1\",\"2\",\"3\",\"\"]" res
redQueryString = runner $ do
res <- request defaultRequest
{ pathInfo = decodePathSegments "/plain/"
, rawQueryString = "?foo=bar"
}
assertStatus 301 res
assertHeader "Location" "http://test/plain?foo=bar" res

1
Yesod/Internal/Dispatch.hs
View File

@ -92,7 +92,6 @@ sendRedirect y segments' env =
if S.null (W.rawQueryString env) if S.null (W.rawQueryString env)
then dest then dest
else (dest `mappend` else (dest `mappend`
Blaze.ByteString.Builder.Char8.fromChar '?' `mappend`
Blaze.ByteString.Builder.fromByteString (W.rawQueryString env)) Blaze.ByteString.Builder.fromByteString (W.rawQueryString env))
mkYesodDispatch' :: [((String, Pieces), Maybe String)] mkYesodDispatch' :: [((String, Pieces), Maybe String)]