From df6834a335b124d5aa014b35bd3b5ec00dadd9e2 Mon Sep 17 00:00:00 2001 From: Mark Wotton Date: Mon, 21 Mar 2016 12:13:23 -0400 Subject: [PATCH 01/10] add followRedirect --- yesod-test/Yesod/Test.hs | 20 ++++++++++++++++++++ yesod-test/test/main.hs | 29 +++++++++++++++++++++++++++-- yesod-test/yesod-test.cabal | 3 ++- 3 files changed, 49 insertions(+), 3 deletions(-) diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index 33d60364..32b6b0b1 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -50,6 +50,7 @@ module Yesod.Test , get , post , postBody + , followRedirect , request , addRequestHeader , setMethod @@ -693,6 +694,25 @@ get url = request $ do setMethod "GET" setUrl url +-- | Follow a redirect, if the last response was a redirect. +-- ==== __Examples__ +-- > get HomeR +-- +-- > followRedirect +followRedirect :: Yesod site + => YesodExample site () +followRedirect = do + mr <- getResponse + case mr of + Nothing -> failure "no response, so no redirect to follow" + Just r -> do + if not ((H.statusCode $ simpleStatus r) `elem` [301,303]) + then failure "followRedirect called, but previous request was not a redirect" + else do + case lookup "Location" (simpleHeaders r) of + Nothing -> failure "No location header set" + Just h -> get (TE.decodeUtf8 h) + -- | Sets the HTTP method used by the request. -- -- ==== __Examples__ diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs index 5461e8bd..f7808bc0 100644 --- a/yesod-test/test/main.hs +++ b/yesod-test/test/main.hs @@ -20,11 +20,13 @@ import Data.Monoid ((<>)) import Control.Applicative import Network.Wai (pathInfo, requestHeaders) import Data.Maybe (fromMaybe) +import Data.Either (isLeft) +import Control.Monad.Catch (try) import Data.ByteString.Lazy.Char8 () import qualified Data.Map as Map import qualified Text.HTML.DOM as HD -import Network.HTTP.Types.Status (unsupportedMediaType415) +import Network.HTTP.Types.Status (status301, status303, unsupportedMediaType415) parseQuery_ = either error id . parseQuery findBySelector_ x = either error id . findBySelector x @@ -213,8 +215,28 @@ main = hspec $ do setMethod "POST" setUrl ("/" :: Text) statusIs 403 + describe "test redirects" $ yesodSpec app $ do + yit "follows 303 redirects when requested" $ do + get ("/redirect303" :: Text) + statusIs 303 + followRedirect + statusIs 200 + bodyContains "we have been successfully redirected" + + yit "follows 301 redirects when requested" $ do + get ("/redirect301" :: Text) + statusIs 301 + followRedirect + statusIs 200 + bodyContains "we have been successfully redirected" + yit "throws an exception when no redirect was returned" $ do + get ("/" :: Text) + statusIs 200 + r <- followRedirect + statusIs 200 + -- assertBool "expected exception" $ isLeft r instance RenderMessage LiteApp FormMessage where renderMessage _ _ = defaultFormMessage @@ -235,6 +257,9 @@ app = liteApp $ do case mfoo of Nothing -> error "No foo" Just foo -> return foo + onStatic "redirect301" $ dispatchTo $ redirectWith status301 ("/redirectTarget" :: Text) >> return () + onStatic "redirect303" $ dispatchTo $ redirectWith status303 ("/redirectTarget" :: Text) >> return () + onStatic "redirectTarget" $ dispatchTo $ return ("we have been successfully redirected" :: Text) onStatic "form" $ dispatchTo $ do ((mfoo, widget), _) <- runFormPost $ renderDivs @@ -290,4 +315,4 @@ postHomeR = defaultLayout [whamlet|

Welcome to my test application. - |] \ No newline at end of file + |] diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal index 907624e5..f0c607f6 100644 --- a/yesod-test/yesod-test.cabal +++ b/yesod-test/yesod-test.cabal @@ -4,7 +4,7 @@ license: MIT license-file: LICENSE author: Nubis maintainer: Michael Snoyman, Greg Weber, Nubis -synopsis: integration testing for WAI/Yesod Applications +synopsis: integration testing for WAI/Yesod Applications category: Web, Yesod, Testing stability: Experimental cabal-version: >= 1.8 @@ -60,6 +60,7 @@ test-suite test , yesod-form , text , wai + , exceptions , http-types source-repository head From 62961ef9313747547220502d7bdeb385ea49729a Mon Sep 17 00:00:00 2001 From: Mark Wotton Date: Mon, 21 Mar 2016 12:34:38 -0400 Subject: [PATCH 02/10] fix exception test --- yesod-test/test/main.hs | 8 +++++--- yesod-test/yesod-test.cabal | 2 +- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs index f7808bc0..c9271df7 100644 --- a/yesod-test/test/main.hs +++ b/yesod-test/test/main.hs @@ -21,7 +21,7 @@ import Control.Applicative import Network.Wai (pathInfo, requestHeaders) import Data.Maybe (fromMaybe) import Data.Either (isLeft) -import Control.Monad.Catch (try) +import Control.Exception.Lifted(try, SomeException) import Data.ByteString.Lazy.Char8 () import qualified Data.Map as Map @@ -234,9 +234,11 @@ main = hspec $ do yit "throws an exception when no redirect was returned" $ do get ("/" :: Text) statusIs 200 - r <- followRedirect + -- This appears to be an HUnitFailure, which is not + -- exported, so I'm catching SomeException instead. + (r :: Either SomeException ()) <- try followRedirect statusIs 200 - -- assertBool "expected exception" $ isLeft r + liftIO $ assertBool "expected exception" $ isLeft r instance RenderMessage LiteApp FormMessage where renderMessage _ _ = defaultFormMessage diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal index f0c607f6..9f2ee0da 100644 --- a/yesod-test/yesod-test.cabal +++ b/yesod-test/yesod-test.cabal @@ -60,7 +60,7 @@ test-suite test , yesod-form , text , wai - , exceptions + , lifted-base , http-types source-repository head From 29c335af563799f4ae3df66ee9b131463452700a Mon Sep 17 00:00:00 2001 From: Mark Wotton Date: Mon, 21 Mar 2016 13:39:49 -0400 Subject: [PATCH 03/10] use Either rather than throwing an exception --- yesod-test/Yesod/Test.hs | 10 +++++----- yesod-test/test/main.hs | 7 ++----- 2 files changed, 7 insertions(+), 10 deletions(-) diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index 32b6b0b1..4e7afe0e 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -700,18 +700,18 @@ get url = request $ do -- -- > followRedirect followRedirect :: Yesod site - => YesodExample site () + => YesodExample site (Either T.Text ()) followRedirect = do mr <- getResponse case mr of - Nothing -> failure "no response, so no redirect to follow" + Nothing -> return $ Left "no response, so no redirect to follow" Just r -> do if not ((H.statusCode $ simpleStatus r) `elem` [301,303]) - then failure "followRedirect called, but previous request was not a redirect" + then return $ Left "followRedirect called, but previous request was not a redirect" else do case lookup "Location" (simpleHeaders r) of - Nothing -> failure "No location header set" - Just h -> get (TE.decodeUtf8 h) + Nothing -> return $ Left "No location header set" + Just h -> get (TE.decodeUtf8 h) >> return (Right ()) -- | Sets the HTTP method used by the request. -- diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs index c9271df7..3cee06be 100644 --- a/yesod-test/test/main.hs +++ b/yesod-test/test/main.hs @@ -231,13 +231,10 @@ main = hspec $ do bodyContains "we have been successfully redirected" - yit "throws an exception when no redirect was returned" $ do + yit "returns a Left when no redirect was returned" $ do get ("/" :: Text) statusIs 200 - -- This appears to be an HUnitFailure, which is not - -- exported, so I'm catching SomeException instead. - (r :: Either SomeException ()) <- try followRedirect - statusIs 200 + r <- followRedirect liftIO $ assertBool "expected exception" $ isLeft r instance RenderMessage LiteApp FormMessage where From f381c69449fdf6ab8086f0aa49b813bcc7a60e0d Mon Sep 17 00:00:00 2001 From: Mark Wotton Date: Mon, 21 Mar 2016 13:43:36 -0400 Subject: [PATCH 04/10] expand range of acceptable redirection codes --- yesod-test/Yesod/Test.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index 4e7afe0e..dea2a6a3 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -706,7 +706,7 @@ followRedirect = do case mr of Nothing -> return $ Left "no response, so no redirect to follow" Just r -> do - if not ((H.statusCode $ simpleStatus r) `elem` [301,303]) + if not ((H.statusCode $ simpleStatus r) `elem` [301, 302, 303, 307, 308]) then return $ Left "followRedirect called, but previous request was not a redirect" else do case lookup "Location" (simpleHeaders r) of From 92f24a73dc0302b160ee612744d36ef935fd93d2 Mon Sep 17 00:00:00 2001 From: Mark Wotton Date: Mon, 21 Mar 2016 13:44:26 -0400 Subject: [PATCH 05/10] better error messages for followRedirect --- yesod-test/Yesod/Test.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index dea2a6a3..f886b399 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -704,13 +704,13 @@ followRedirect :: Yesod site followRedirect = do mr <- getResponse case mr of - Nothing -> return $ Left "no response, so no redirect to follow" + Nothing -> return $ Left "followRedirect called, but there was no previous response, so no redirect to follow" Just r -> do if not ((H.statusCode $ simpleStatus r) `elem` [301, 302, 303, 307, 308]) then return $ Left "followRedirect called, but previous request was not a redirect" else do case lookup "Location" (simpleHeaders r) of - Nothing -> return $ Left "No location header set" + Nothing -> return $ Left "followRedirect called, but no location header set" Just h -> get (TE.decodeUtf8 h) >> return (Right ()) -- | Sets the HTTP method used by the request. From ef00ddd80bd12de6082823542603a291b48c1248 Mon Sep 17 00:00:00 2001 From: Mark Wotton Date: Mon, 21 Mar 2016 17:16:28 -0400 Subject: [PATCH 06/10] test result value, return URL in Right branch, document meaning in haddocks --- yesod-test/Yesod/Test.hs | 8 ++++++-- yesod-test/test/main.hs | 10 ++++++---- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index f886b399..cac92a6a 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -695,12 +695,15 @@ get url = request $ do setUrl url -- | Follow a redirect, if the last response was a redirect. +-- | Return Left with an error message if not a redirect +-- | Return Right with the redirected URL if it was. +-- -- ==== __Examples__ -- > get HomeR -- -- > followRedirect followRedirect :: Yesod site - => YesodExample site (Either T.Text ()) + => YesodExample site (Either T.Text T.Text) followRedirect = do mr <- getResponse case mr of @@ -711,7 +714,8 @@ followRedirect = do else do case lookup "Location" (simpleHeaders r) of Nothing -> return $ Left "followRedirect called, but no location header set" - Just h -> get (TE.decodeUtf8 h) >> return (Right ()) + Just h -> let url = TE.decodeUtf8 h in + get url >> return (Right url) -- | Sets the HTTP method used by the request. -- diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs index 3cee06be..0ef4354c 100644 --- a/yesod-test/test/main.hs +++ b/yesod-test/test/main.hs @@ -20,7 +20,7 @@ import Data.Monoid ((<>)) import Control.Applicative import Network.Wai (pathInfo, requestHeaders) import Data.Maybe (fromMaybe) -import Data.Either (isLeft) +import Data.Either (isLeft, isRight) import Control.Exception.Lifted(try, SomeException) import Data.ByteString.Lazy.Char8 () @@ -219,14 +219,16 @@ main = hspec $ do yit "follows 303 redirects when requested" $ do get ("/redirect303" :: Text) statusIs 303 - followRedirect + r <- followRedirect + liftIO $ assertBool "expected a Right from a 303 redirect" $ isRight r statusIs 200 bodyContains "we have been successfully redirected" yit "follows 301 redirects when requested" $ do get ("/redirect301" :: Text) statusIs 301 - followRedirect + r <- followRedirect + liftIO $ assertBool "expected a Right from a 301 redirect" $ isRight r statusIs 200 bodyContains "we have been successfully redirected" @@ -235,7 +237,7 @@ main = hspec $ do get ("/" :: Text) statusIs 200 r <- followRedirect - liftIO $ assertBool "expected exception" $ isLeft r + liftIO $ assertBool "expected a Left when not a redirect" $ isLeft r instance RenderMessage LiteApp FormMessage where renderMessage _ _ = defaultFormMessage From f2341355c1846c1a7ce27cb7963427acf01869aa Mon Sep 17 00:00:00 2001 From: Mark Wotton Date: Mon, 21 Mar 2016 17:20:02 -0400 Subject: [PATCH 07/10] documentation fixes --- yesod-test/Yesod/Test.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index cac92a6a..928320cf 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -695,12 +695,13 @@ get url = request $ do setUrl url -- | Follow a redirect, if the last response was a redirect. +-- | (We consider 301, 302, 303, 307 and 308 as redirects.) -- | Return Left with an error message if not a redirect -- | Return Right with the redirected URL if it was. -- -- ==== __Examples__ --- > get HomeR -- +-- > get HomeR -- > followRedirect followRedirect :: Yesod site => YesodExample site (Either T.Text T.Text) From b21e64637f814b92680f230051d4c7b4ead3b7f4 Mon Sep 17 00:00:00 2001 From: Mark Wotton Date: Mon, 21 Mar 2016 17:21:14 -0400 Subject: [PATCH 08/10] documentation fixes #2 --- yesod-test/Yesod/Test.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index 928320cf..9a689349 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -695,7 +695,9 @@ get url = request $ do setUrl url -- | Follow a redirect, if the last response was a redirect. --- | (We consider 301, 302, 303, 307 and 308 as redirects.) +-- | (We consider a request a redirect if the status is +-- | 301, 302, 303, 307 or 308, and the Location header is set.) +-- | -- | Return Left with an error message if not a redirect -- | Return Right with the redirected URL if it was. -- From 23278d651e4fc2119d4ef55b4469e39a51b66ae4 Mon Sep 17 00:00:00 2001 From: Mark Wotton Date: Mon, 21 Mar 2016 17:41:25 -0400 Subject: [PATCH 09/10] documentation fixes & formatting #3 --- yesod-test/Yesod/Test.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index 9a689349..7da770ab 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -695,16 +695,15 @@ get url = request $ do setUrl url -- | Follow a redirect, if the last response was a redirect. --- | (We consider a request a redirect if the status is --- | 301, 302, 303, 307 or 308, and the Location header is set.) --- | --- | Return Left with an error message if not a redirect --- | Return Right with the redirected URL if it was. +-- (We consider a request a redirect if the status is +-- 301, 302, 303, 307 or 308, and the Location header is set.) -- -- ==== __Examples__ -- -- > get HomeR -- > followRedirect +followRedirect :: Yesod site + => YesodExample site (Either T.Text T.Text) -- ^ 'Left' with an error message if not a redirect, 'Right' with the redirected URL if it was followRedirect :: Yesod site => YesodExample site (Either T.Text T.Text) followRedirect = do @@ -713,7 +712,7 @@ followRedirect = do Nothing -> return $ Left "followRedirect called, but there was no previous response, so no redirect to follow" Just r -> do if not ((H.statusCode $ simpleStatus r) `elem` [301, 302, 303, 307, 308]) - then return $ Left "followRedirect called, but previous request was not a redirect" + then return $ Left "followRedirect called, but previous request was not a redirect" else do case lookup "Location" (simpleHeaders r) of Nothing -> return $ Left "followRedirect called, but no location header set" From 94109d9406e69739393383379cd8cbb0e33cb384 Mon Sep 17 00:00:00 2001 From: Mark Wotton Date: Mon, 21 Mar 2016 17:46:28 -0400 Subject: [PATCH 10/10] duplicated typesig --- yesod-test/Yesod/Test.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index 7da770ab..36bbb582 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -704,8 +704,6 @@ get url = request $ do -- > followRedirect followRedirect :: Yesod site => YesodExample site (Either T.Text T.Text) -- ^ 'Left' with an error message if not a redirect, 'Right' with the redirected URL if it was -followRedirect :: Yesod site - => YesodExample site (Either T.Text T.Text) followRedirect = do mr <- getResponse case mr of