diff --git a/yesod-test/ChangeLog.md b/yesod-test/ChangeLog.md index ba1aa905..681845b5 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 [#1642](https://github.com/yesodweb/yesod/pull/1642) + ## 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 b7a176ed..80b814f8 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,36 @@ yesodSpecApp site getApp yspecs = yit :: String -> YesodExample site () -> YesodSpec site yit label example = tell [YesodSpecItem label example] +-- | Modifies the site ('yedSite') of the test, and creates a new WAI app ('yedApp') for it. +-- +-- 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. +-- +-- ==== __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 + (newSite, middleware) <- liftIO $ 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..f0f5b8e4 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,12 +50,16 @@ 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 |] main :: IO () @@ -378,7 +383,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 +425,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 +449,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 -> pure (site { routedAppInteger = 1 }, id)) + get ("/get-integer" :: Text) + bodyContains "1" + describe "Basic Authentication" $ yesodSpec app $ do yit "rejects no header" $ do get ("checkBasicAuth" :: Text) @@ -598,3 +611,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
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