From e39eaeef92220522934c7c50ab318d36ff251a6d Mon Sep 17 00:00:00 2001 From: Maximilian Tagher Date: Sun, 17 Nov 2019 12:42:20 -0800 Subject: [PATCH 1/4] WIP - Add testModifySite --- yesod-test/Yesod/Test.hs | 15 +++++++++++++++ yesod-test/test/main.hs | 33 ++++++++++++++++++++++++++++++--- 2 files changed, 45 insertions(+), 3 deletions(-) diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index b7a176ed..fcae9ffb 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -45,6 +45,9 @@ module Yesod.Test , ydescribe , yit + -- * Modify test site + , testModifySite + -- * Modify test state , testSetCookie , testDeleteCookie @@ -341,6 +344,18 @@ yesodSpecApp site getApp yspecs = yit :: String -> YesodExample site () -> YesodSpec site yit label example = tell [YesodSpecItem label example] +-- | Modifies the site ('yedSite') of the test +-- +-- TODO documentation here +-- +-- TODO @since +testModifySite :: YesodDispatch site => (site -> site) -> Middleware -> YesodExample site () +testModifySite newSiteFn middleware = do + currentSite <- getTestYesod + let newSite = newSiteFn currentSite + app <- liftIO $ toWaiAppPlain newSite + modifySIO $ \yed -> yed { yedSite = newSite, yedApp = middleware app } + -- | Sets a cookie -- -- ==== __Examples__ diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs index 2d76c8ef..06a6603c 100644 --- a/yesod-test/test/main.hs +++ b/yesod-test/test/main.hs @@ -42,6 +42,7 @@ import Network.HTTP.Types.Status (status301, status303, status403, status422, un import UnliftIO.Exception (tryAny, SomeException, try) import qualified Web.Cookie as Cookie import Data.Maybe (isNothing) +import qualified Data.Text as T parseQuery_ :: Text -> [[SelectorGroup]] parseQuery_ = either error id . parseQuery @@ -49,14 +50,24 @@ parseQuery_ = either error id . parseQuery findBySelector_ :: HtmlLBS -> Query -> [String] findBySelector_ x = either error id . findBySelector x -data RoutedApp = RoutedApp +data RoutedApp = RoutedApp { routedAppInteger :: Integer } + +defaultRoutedApp :: RoutedApp +defaultRoutedApp = RoutedApp 0 mkYesod "RoutedApp" [parseRoutes| / HomeR GET POST /resources ResourcesR POST /resources/#Text ResourceR GET +/get-integer IntegerR GET |] +-- data ParamaterizedApp = ParamaterizedApp { parameterizedAppInteger :: Integer } + +-- mkYesod "ParamaterizedApp" [parseRoutes| +-- /get-integer ParameterizedGetInteger GET +-- |] + main :: IO () main = hspec $ do describe "CSS selector parsing" $ do @@ -378,7 +389,7 @@ main = hspec $ do testModifyCookies (\_ -> Map.empty) get ("cookie/check-no-cookie" :: Text) statusIs 200 - describe "CSRF with cookies/headers" $ yesodSpec RoutedApp $ do + describe "CSRF with cookies/headers" $ yesodSpec defaultRoutedApp $ do yit "Should receive a CSRF cookie and add its value to the headers" $ do get ("/" :: Text) statusIs 200 @@ -420,7 +431,7 @@ main = hspec $ do r <- followRedirect liftIO $ assertBool "expected a Left when not a redirect" $ isLeft r - describe "route parsing in tests" $ yesodSpec RoutedApp $ do + describe "route parsing in tests" $ yesodSpec defaultRoutedApp $ do yit "parses location header into a route" $ do -- get CSRF token get HomeR @@ -444,6 +455,14 @@ main = hspec $ do loc <- getLocation liftIO $ assertBool "expected a Left when not a redirect" $ isLeft loc + describe "modifying site value" $ yesodSpec defaultRoutedApp $ do + yit "can change site value" $ do + get ("/get-integer" :: Text) + bodyContains "0" + testModifySite (\site -> site { routedAppInteger = 1 }) id + get ("/get-integer" :: Text) + bodyContains "1" + describe "Basic Authentication" $ yesodSpec app $ do yit "rejects no header" $ do get ("checkBasicAuth" :: Text) @@ -571,6 +590,9 @@ cookieApp = liteApp $ do instance Yesod RoutedApp where yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware +-- instance Yesod ParameterizedApp where +-- yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware + getHomeR :: Handler Html getHomeR = defaultLayout [whamlet| @@ -598,3 +620,8 @@ getResourceR i = defaultLayout

Read item #{i}. |] + +getIntegerR :: Handler Text +getIntegerR = do + app <- getYesod + pure $ T.pack $ show (routedAppInteger app) \ No newline at end of file From a2d200c182cafec8956fa41b77d9e02ca91af3ec Mon Sep 17 00:00:00 2001 From: Maximilian Tagher Date: Sun, 17 Nov 2019 12:43:24 -0800 Subject: [PATCH 2/4] .. --- yesod-test/test/main.hs | 9 --------- 1 file changed, 9 deletions(-) diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs index 06a6603c..57a93c17 100644 --- a/yesod-test/test/main.hs +++ b/yesod-test/test/main.hs @@ -62,12 +62,6 @@ mkYesod "RoutedApp" [parseRoutes| /get-integer IntegerR GET |] --- data ParamaterizedApp = ParamaterizedApp { parameterizedAppInteger :: Integer } - --- mkYesod "ParamaterizedApp" [parseRoutes| --- /get-integer ParameterizedGetInteger GET --- |] - main :: IO () main = hspec $ do describe "CSS selector parsing" $ do @@ -590,9 +584,6 @@ cookieApp = liteApp $ do instance Yesod RoutedApp where yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware --- instance Yesod ParameterizedApp where --- yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware - getHomeR :: Handler Html getHomeR = defaultLayout [whamlet| From cbef19fae94ce912ff01d1c11cc334595e1f4772 Mon Sep 17 00:00:00 2001 From: Maximilian Tagher Date: Tue, 19 Nov 2019 23:11:13 -0800 Subject: [PATCH 3/4] [yesod-test] Add testModifySite --- yesod-test/ChangeLog.md | 4 ++++ yesod-test/Yesod/Test.hs | 30 ++++++++++++++++++++++++------ yesod-test/test/main.hs | 2 +- yesod-test/yesod-test.cabal | 2 +- 4 files changed, 30 insertions(+), 8 deletions(-) diff --git a/yesod-test/ChangeLog.md b/yesod-test/ChangeLog.md index ba1aa905..fe40bf15 100644 --- a/yesod-test/ChangeLog.md +++ b/yesod-test/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for yesod-test +## 1.6.8 + +Add `testModifySite` function [#](https://github.com/yesodweb/yesod/pull/) + ## 1.6.7 Add `addBasicAuthHeader` function [#1632](https://github.com/yesodweb/yesod/pull/1632) diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index fcae9ffb..80b814f8 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -344,15 +344,33 @@ yesodSpecApp site getApp yspecs = yit :: String -> YesodExample site () -> YesodSpec site yit label example = tell [YesodSpecItem label example] --- | Modifies the site ('yedSite') of the test +-- | Modifies the site ('yedSite') of the test, and creates a new WAI app ('yedApp') for it. -- --- TODO documentation here +-- yesod-test allows sending requests to your application to test that it handles them correctly. +-- In rare cases, you may wish to modify that application in the middle of a test. +-- This may be useful if you wish to, for example, test your application under a certain configuration, +-- then change that configuration to see if your app responds differently. -- --- TODO @since -testModifySite :: YesodDispatch site => (site -> site) -> Middleware -> YesodExample site () -testModifySite newSiteFn middleware = do +-- ==== __Examples__ +-- +-- > post SendEmailR +-- > -- Assert email not created in database +-- > testModifySite (\site -> pure (site { siteSettingsStoreEmail = True }, id)) +-- > post SendEmailR +-- > -- Assert email created in database +-- +-- > testModifySite (\site -> do +-- > middleware <- makeLogware site +-- > pure (site { appRedisConnection = Nothing }, middleware) +-- > ) +-- +-- @since 1.6.8 +testModifySite :: YesodDispatch site + => (site -> IO (site, Middleware)) -- ^ A function from the existing site, to a new site and middleware for a WAI app. + -> YesodExample site () +testModifySite newSiteFn = do currentSite <- getTestYesod - let newSite = newSiteFn currentSite + (newSite, middleware) <- liftIO $ newSiteFn currentSite app <- liftIO $ toWaiAppPlain newSite modifySIO $ \yed -> yed { yedSite = newSite, yedApp = middleware app } diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs index 57a93c17..f0f5b8e4 100644 --- a/yesod-test/test/main.hs +++ b/yesod-test/test/main.hs @@ -453,7 +453,7 @@ main = hspec $ do yit "can change site value" $ do get ("/get-integer" :: Text) bodyContains "0" - testModifySite (\site -> site { routedAppInteger = 1 }) id + testModifySite (\site -> pure (site { routedAppInteger = 1 }, id)) get ("/get-integer" :: Text) bodyContains "1" diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal index 24ac3208..ac770758 100644 --- a/yesod-test/yesod-test.cabal +++ b/yesod-test/yesod-test.cabal @@ -1,5 +1,5 @@ name: yesod-test -version: 1.6.7 +version: 1.6.8 license: MIT license-file: LICENSE author: Nubis From b0c07ea3cd50980b418d810ae6aeeb5005cb63b3 Mon Sep 17 00:00:00 2001 From: Maximilian Tagher Date: Tue, 19 Nov 2019 23:13:11 -0800 Subject: [PATCH 4/4] .. --- yesod-test/ChangeLog.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yesod-test/ChangeLog.md b/yesod-test/ChangeLog.md index fe40bf15..681845b5 100644 --- a/yesod-test/ChangeLog.md +++ b/yesod-test/ChangeLog.md @@ -2,7 +2,7 @@ ## 1.6.8 -Add `testModifySite` function [#](https://github.com/yesodweb/yesod/pull/) +Add `testModifySite` function [#1642](https://github.com/yesodweb/yesod/pull/1642) ## 1.6.7