Merge pull request #1570 from yesodweb/cookieHelpers

[yesod-test] Add utility functions to modify cookies

yesod-test/ChangeLog.md

@@ -1,3 +1,7 @@
+## 1.6.6
+
+* Add utility functions to modify cookies [$1570](https://github.com/yesodweb/yesod/pull/1570)
+
 ## 1.6.5.1
 
 * Make test suite build with GHC 8.6 [#1561](https://github.com/yesodweb/yesod/pull/1561)

yesod-test/Yesod/Test.hs

@@ -45,6 +45,12 @@ module Yesod.Test
     , ydescribe
     , yit
 
+    -- * Modify test state
+    , testSetCookie
+    , testDeleteCookie
+    , testModifyCookies
+    , testClearCookies
+
     -- * Making requests
     -- | You can construct requests with the 'RequestBuilder' monad, which lets you
     -- set the URL and add parameters, headers, and files. Helper functions are provided to
@@ -326,6 +332,46 @@ yesodSpecApp site getApp yspecs =
 yit :: String -> YesodExample site () -> YesodSpec site
 yit label example = tell [YesodSpecItem label example]
 
+-- | Sets a cookie
+--
+-- ==== __Examples__
+--
+-- > import qualified Data.Cookie as Cookie
+-- > :set -XOverloadedStrings
+-- > testSetCookie Cookie.defaultSetCookie { Cookie.setCookieName = "name" }
+--
+-- @since 1.6.6
+testSetCookie :: Cookie.SetCookie -> YesodExample site ()
+testSetCookie cookie = do
+  let key = Cookie.setCookieName cookie
+  modifySIO $ \yed -> yed { yedCookies = M.insert key cookie (yedCookies yed) }
+
+-- | Deletes the cookie of the given name
+--
+-- ==== __Examples__
+--
+-- > :set -XOverloadedStrings
+-- > testDeleteCookie "name"
+--
+-- @since 1.6.6
+testDeleteCookie :: ByteString -> YesodExample site ()
+testDeleteCookie k = do
+  modifySIO $ \yed -> yed { yedCookies = M.delete k (yedCookies yed) }
+
+-- | Modify the current cookies with the given mapping function
+--
+-- @since 1.6.6
+testModifyCookies :: (Cookies -> Cookies) -> YesodExample site ()
+testModifyCookies f = do
+  modifySIO $ \yed -> yed { yedCookies = f (yedCookies yed) }
+
+-- | Clears the current cookies
+--
+-- @since 1.6.6
+testClearCookies :: YesodExample site ()
+testClearCookies = do
+  modifySIO $ \yed -> yed { yedCookies = M.empty }
+
 -- Performs a given action using the last response. Use this to create
 -- response-level assertions
 withResponse' :: (state -> Maybe SResponse)

yesod-test/test/main.hs

@@ -38,8 +38,10 @@ import Data.Either (isLeft, isRight)
 import Data.ByteString.Lazy.Char8 ()
 import qualified Data.Map as Map
 import qualified Text.HTML.DOM as HD
-import Network.HTTP.Types.Status (status301, status303, unsupportedMediaType415)
+import Network.HTTP.Types.Status (status301, status303, status422, unsupportedMediaType415)
 import UnliftIO.Exception (tryAny, SomeException, try)
+import qualified Web.Cookie as Cookie
+import Data.Maybe (isNothing)
 
 parseQuery_ :: Text -> [[SelectorGroup]]
 parseQuery_ = either error id . parseQuery
@@ -314,6 +316,33 @@ main = hspec $ do
             statusIs 200
             printBody
             bodyContains "Foo"
+        yit "should 422 on the cookie named key" $ do
+            get ("cookie/check-no-cookie" :: Text)
+            statusIs 200
+            testSetCookie Cookie.defaultSetCookie { Cookie.setCookieName = "key" }
+            get ("cookie/check-no-cookie" :: Text)
+            statusIs 422
+        yit "should be able to delete a cookie" $ do
+            testSetCookie Cookie.defaultSetCookie { Cookie.setCookieName = "key" }
+            get ("cookie/check-no-cookie" :: Text)
+            statusIs 422
+            testDeleteCookie "key"
+            get ("cookie/check-no-cookie" :: Text)
+            statusIs 200
+        yit "should be able to clear all cookies" $ do
+            testSetCookie Cookie.defaultSetCookie { Cookie.setCookieName = "key" }
+            get ("cookie/check-no-cookie" :: Text)
+            statusIs 422
+            testClearCookies
+            get ("cookie/check-no-cookie" :: Text)
+            statusIs 200
+        yit "should be able to modify cookies" $ do
+            testSetCookie Cookie.defaultSetCookie { Cookie.setCookieName = "key" }
+            get ("cookie/check-no-cookie" :: Text)
+            statusIs 422
+            testModifyCookies (\_ -> Map.empty)
+            get ("cookie/check-no-cookie" :: Text)
+            statusIs 200
     describe "CSRF with cookies/headers" $ yesodSpec RoutedApp $ do
         yit "Should receive a CSRF cookie and add its value to the headers" $ do
             get ("/" :: Text)
@@ -463,6 +492,11 @@ cookieApp = liteApp $ do
             setMessage "Foo"
             () <- redirect ("/cookie/home" :: Text)
             return ()
+        onStatic "check-no-cookie" $ dispatchTo $ do
+            mCookie <- lookupCookie "key"
+            if isNothing mCookie
+                then return ()
+                else sendResponseStatus status422 ()
 
 instance Yesod RoutedApp where
     yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware

yesod-test/yesod-test.cabal

@@ -1,5 +1,5 @@
 name:               yesod-test
-version:            1.6.5.1
+version:            1.6.6
 license:            MIT
 license-file:       LICENSE
 author:             Nubis <nubis@woobiz.com.ar>
@@ -63,6 +63,7 @@ test-suite test
                           , wai-extra
                           , http-types
                           , unliftio
+                          , cookie
 
 source-repository head
   type: git