Merge pull request #1642 from yesodweb/testModifySite

Add testModifySite

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)

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__

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
         <p>
             Read item #{i}.
     |]
+
+getIntegerR :: Handler Text
+getIntegerR = do
+    app <- getYesod
+    pure $ T.pack $ show (routedAppInteger app)

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 <nubis@woobiz.com.ar>