tests for redirect status

yesod-core/test.hs

@@ -1,4 +1,5 @@
 import Test.Hspec
 import qualified YesodCoreTest
 
+main :: IO ()
 main = hspecX $ descriptions $ YesodCoreTest.specs

yesod-core/test/YesodCoreTest.hs

@@ -9,6 +9,7 @@ import YesodCoreTest.NoOverloadedStrings
 import YesodCoreTest.InternalRequest
 import YesodCoreTest.ErrorHandling
 import YesodCoreTest.Cache
+import qualified YesodCoreTest.Redirect as Redirect
 
 import Test.Hspec
 
@@ -23,4 +24,5 @@ specs =
     , internalRequestTest
     , errorHandlingTest
     , cacheTest
+    , Redirect.specs
     ]

yesod-core/test/YesodCoreTest/Redirect.hs

@@ -0,0 +1,51 @@
+{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, MultiParamTypeClasses, OverloadedStrings #-}
+module YesodCoreTest.Redirect (specs) where
+
+import YesodCoreTest.YesodTest
+import Yesod.Handler (RedirectType(..))
+import qualified Network.HTTP.Types as H
+
+data Y = Y
+mkYesod "Y" [parseRoutes|
+/ RootR GET
+/r301 R301 GET
+/r303 R303 GET
+/r307 R307 GET
+|]
+instance Yesod Y where approot _ = "http://test"
+app :: Session () -> IO ()
+app = yesod Y
+
+getRootR :: Handler ()
+getRootR = return ()
+
+getR301, getR303, getR307 :: Handler ()
+getR301 = redirect RedirectPermanent RootR
+getR303 = redirect RedirectSeeOther RootR
+getR307 = redirect RedirectTemporary RootR
+
+
+specs :: [Spec]
+specs = describe "Redirect" [
+    it "301 redirect" $ app $ do
+      res <- request defaultRequest { pathInfo = ["r301"] }
+      assertStatus 301 res
+      assertBodyContains "" res
+
+  , it "303 redirect" $ app $ do
+      res <- request defaultRequest { pathInfo = ["r303"] }
+      assertStatus 303 res
+      assertBodyContains "" res
+
+  , it "307 redirect" $ app $ do
+      res <- request defaultRequest { pathInfo = ["r307"] }
+      assertStatus 307 res
+      assertBodyContains "" res
+
+  , it "302 redirect instead of 307 for http 1.0" $ app $ do
+      res <- request defaultRequest {
+        pathInfo = ["r307"], httpVersion = H.http10
+      }
+      assertStatus 302 res
+      assertBodyContains "" res
+  ]

yesod-core/test/YesodCoreTest/YesodTest.hs

@@ -0,0 +1,19 @@
+-- this is being re-worked into a general-purpose testing module for Yesod apps
+module YesodCoreTest.YesodTest
+(   yesod
+  , parseRoutes, mkYesod, yesodDispatch, renderRoute, Yesod(..)
+  , redirect
+  , module Network.Wai
+  , module Network.Wai.Test
+  , module Test.Hspec
+  , module Test.Hspec.HUnit
+) where
+
+import Yesod.Core hiding (Request)
+import Network.Wai.Test
+import Network.Wai
+import Test.Hspec
+import Test.Hspec.HUnit()
+
+yesod :: (YesodDispatch y y, Yesod y) => y -> Session a -> IO a
+yesod app f = toWaiApp app >>= runSession f