From bedec86c74dc947c0422f2881ec9ac397a2f097b Mon Sep 17 00:00:00 2001 From: Maximilian Tagher Date: Mon, 14 Jan 2019 16:06:37 -0800 Subject: [PATCH] [yesod-test] Add utility functions to modify cookies --- yesod-test/ChangeLog.md | 4 ++++ yesod-test/Yesod/Test.hs | 46 +++++++++++++++++++++++++++++++++++++ yesod-test/test/main.hs | 36 ++++++++++++++++++++++++++++- yesod-test/yesod-test.cabal | 3 ++- 4 files changed, 87 insertions(+), 2 deletions(-) diff --git a/yesod-test/ChangeLog.md b/yesod-test/ChangeLog.md index 95ca253b..60ac1665 100644 --- a/yesod-test/ChangeLog.md +++ b/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) diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index 721a25fb..b027afa2 100644 --- a/yesod-test/Yesod/Test.hs +++ b/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) diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs index df6e7a5e..c488d7ee 100644 --- a/yesod-test/test/main.hs +++ b/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 diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal index f10dd0ca..9e62a2e3 100644 --- a/yesod-test/yesod-test.cabal +++ b/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 @@ -63,6 +63,7 @@ test-suite test , wai-extra , http-types , unliftio + , cookie source-repository head type: git