diff --git a/yesod-core/test.hs b/yesod-core/test.hs index 7a8397c2..b04ec7db 100644 --- a/yesod-core/test.hs +++ b/yesod-core/test.hs @@ -1,4 +1,5 @@ import Test.Hspec import qualified YesodCoreTest +main :: IO () main = hspecX $ descriptions $ YesodCoreTest.specs diff --git a/yesod-core/test/YesodCoreTest.hs b/yesod-core/test/YesodCoreTest.hs index 6602ce4a..9a1d23c7 100644 --- a/yesod-core/test/YesodCoreTest.hs +++ b/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 ] diff --git a/yesod-core/test/YesodCoreTest/Redirect.hs b/yesod-core/test/YesodCoreTest/Redirect.hs new file mode 100644 index 00000000..8a31d19b --- /dev/null +++ b/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 + ] diff --git a/yesod-core/test/YesodCoreTest/YesodTest.hs b/yesod-core/test/YesodCoreTest/YesodTest.hs new file mode 100644 index 00000000..30790f95 --- /dev/null +++ b/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