Adding failing test case: headers after redirect

This commit is contained in:
Michael Snoyman 2011-12-06 12:53:21 +02:00
parent e372e126b4
commit 09d26f8099

View File

@ -7,11 +7,13 @@ import Test.Hspec
import Test.Hspec.HUnit () import Test.Hspec.HUnit ()
import Yesod.Core hiding (Request) import Yesod.Core hiding (Request)
import Network.Wai
import Network.Wai.Test import Network.Wai.Test
data Y = Y data Y = Y
mkYesod "Y" [parseRoutes| mkYesod "Y" [parseRoutes|
/ RootR GET / RootR GET
/redirect RedirR GET
|] |]
instance Yesod Y where instance Yesod Y where
@ -22,9 +24,15 @@ instance Yesod Y where
getRootR :: Handler () getRootR :: Handler ()
getRootR = error "FOOBAR" >> return () getRootR = error "FOOBAR" >> return ()
getRedirR :: Handler ()
getRedirR = do
setHeader "foo" "bar"
redirect RedirectPermanent RootR
exceptionsTest :: [Spec] exceptionsTest :: [Spec]
exceptionsTest = describe "Test.Exceptions" exceptionsTest = describe "Test.Exceptions"
[ it "500" case500 [ it "500" case500
, it "redirect keeps headers" caseRedirect
] ]
runner :: Session () -> IO () runner :: Session () -> IO ()
@ -35,3 +43,9 @@ case500 = runner $ do
res <- request defaultRequest res <- request defaultRequest
assertStatus 500 res assertStatus 500 res
assertBody "FOOBAR" res assertBody "FOOBAR" res
caseRedirect :: IO ()
caseRedirect = runner $ do
res <- request defaultRequest { pathInfo = ["redirect"] }
assertStatus 301 res
assertHeader "foo" "bar" res