haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add more documentation to yesod-test

Browse Source 
This adds high-level documentation to yesod-test, plus some function documentation
This commit is contained in:
Maximilian Tagher 2020-05-31 16:35:27 -04:00
parent 074865bca9
commit c3fa2adddd
1 changed files with 186 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

193
yesod-test/Yesod/Test.hs
View File

@ -10,7 +10,7 @@
{-|
Yesod.Test is a pragmatic framework for testing web applications built
using wai and persistent.
using wai.
By pragmatic I may also mean 'dirty'. Its main goal is to encourage integration
and system testing of web applications by making everything /easy to test/.
@ -24,8 +24,86 @@ This is very useful for testing web applications built in yesod, for example,
where your forms may have field names generated by the framework or a randomly
generated CSRF token input.
Your database is also directly available so you can use 'runDB' to set up
=== Example project
The best way to see an example project using yesod-test is to create a scaffolded Yesod project:
@stack new projectname yesod-sqlite@
(See https://github.com/commercialhaskell/stack-templates/wiki#yesod for the full list of Yesod templates)
The scaffolded project makes your database directly available in tests, so you can use 'runDB' to set up
backend pre-conditions, or to assert that your session is having the desired effect.
It also handles wiping your database between each test.
=== Example code
The code below should give you a high-level idea of yesod-test's capabilities.
Note that it uses helper functions like @withApp@ and @runDB@ from the scaffolded project; these aren't provided by yesod-test.
@
spec :: Spec
spec = withApp $ do
describe \"Homepage\" $ do
it "loads the homepage with a valid status code" $ do
'get' HomeR
'statusIs' 200
describe \"Login Form\" $ do
it "Only allows dashboard access after logging in" $ do
'get' DashboardR
'statusIs' 401
'get' HomeR
-- Assert a \<p\> tag exists on the page
'htmlAnyContain' \"p\" \"Login\"
-- yesod-test provides a 'RequestBuilder' monad for building up HTTP requests
'request' $ do
-- Lookup the HTML \<label\> with the text Username, and set a POST parameter for that field with the value Felipe
'byLabelExact' \"Username\" \"Felipe\"
'byLabelExact' \"Password\" "pass\"
'setMethod' \"POST\"
'setUrl' SignupR
'statusIs' 200
-- The previous request will have stored a session cookie, so we can access the dashboard now
'get' DashboardR
'statusIs' 200
-- Assert a user with the name Felipe was added to the database
[Entity userId user] <- runDB $ selectList [] []
'assertEq' "A single user named Felipe is created" (userUsername user) \"Felipe\"
describe \"JSON\" $ do
it "Can make requests using JSON, and parse JSON responses" $ do
-- Precondition: Create a user with the name \"George\"
runDB $ insert_ $ User \"George\" "pass"
'request' $ do
-- Use the Aeson library to send JSON to the server
'setRequestBody' ('Data.Aeson.encode' $ LoginRequest \"George\" "pass")
'addRequestHeader' (\"Accept\", "application/json")
'addRequestHeader' ("Content-Type", "application/json")
'setUrl' LoginR
'statusIs' 200
-- Parse the request's response as JSON
(signupResponse :: SignupResponse) <- 'requireJSONResponse'
@
=== HUnit / HSpec integration
yesod-test is built on top of hspec, which is itself built on top of HUnit.
You can use existing assertion functions from those libraries, but you'll need to use `liftIO` with them:
@
liftIO $ actualTimesCalled `'Test.Hspec.Expectations.shouldBe'` expectedTimesCalled -- hspec assertion
@
@
liftIO $ 'Test.HUnit.Base.assertBool' "a is greater than b" (a > b) -- HUnit assertion
@
yesod-test provides a handful of assertion functions that are already lifted, such as 'assertEq', as well.
-}
@ -459,7 +537,7 @@ htmlQuery = htmlQuery' yedResponse []
-- | Asserts that the two given values are equal.
--
-- In case they are not equal, error message includes the two values.
-- In case they are not equal, the error message includes the two values.
--
-- @since 1.5.2
assertEq :: (HasCallStack, Eq a, Show a) => String -> a -> a -> YesodExample site ()
@ -471,7 +549,7 @@ assertEq m a b =
-- | Asserts that the two given values are not equal.
--
-- In case they are equal, error mesasge includes the values.
-- In case they are equal, the error message includes the values.
--
-- @since 1.5.6
assertNotEq :: (HasCallStack, Eq a, Show a) => String -> a -> a -> YesodExample site ()
@ -491,6 +569,11 @@ assertEqualNoShow :: (HasCallStack, Eq a) => String -> a -> a -> YesodExample si
assertEqualNoShow msg a b = liftIO $ HUnit.assertBool msg (a == b)
-- | Assert the last response status is as expected.
--
-- ==== __Examples__
--
-- > get HomeR
-- > statusIs 200
statusIs :: HasCallStack => Int -> YesodExample site ()
statusIs number = withResponse $ \ SResponse { simpleStatus = s } ->
liftIO $ flip HUnit.assertBool (H.statusCode s == number) $ concat
@ -499,6 +582,17 @@ statusIs number = withResponse $ \ SResponse { simpleStatus = s } ->
]
-- | Assert the given header key/value pair was returned.
--
-- ==== __Examples__
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > get HomeR
-- > assertHeader "key" "value"
--
-- > import qualified Data.CaseInsensitive as CI
-- > import qualified Data.ByteString.Char8 as BS8
-- > getHomeR
-- > assertHeader (CI.mk (BS8.pack "key")) (BS8.pack "value")
assertHeader :: HasCallStack => CI BS8.ByteString -> BS8.ByteString -> YesodExample site ()
assertHeader header value = withResponse $ \ SResponse { simpleHeaders = h } ->
case lookup header h of
@ -519,6 +613,17 @@ assertHeader header value = withResponse $ \ SResponse { simpleHeaders = h } ->
]
-- | Assert the given header was not included in the response.
--
-- ==== __Examples__
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > get HomeR
-- > assertNoHeader "key"
--
-- > import qualified Data.CaseInsensitive as CI
-- > import qualified Data.ByteString.Char8 as BS8
-- > getHomeR
-- > assertNoHeader (CI.mk (BS8.pack "key"))
assertNoHeader :: HasCallStack => CI BS8.ByteString -> YesodExample site ()
assertNoHeader header = withResponse $ \ SResponse { simpleHeaders = h } ->
case lookup header h of
@ -532,6 +637,11 @@ assertNoHeader header = withResponse $ \ SResponse { simpleHeaders = h } ->
-- | Assert the last response is exactly equal to the given text. This is
-- useful for testing API responses.
--
-- ==== __Examples__
--
-- > get HomeR
-- > bodyEquals "<html><body><h1>Hello, World</h1></body></html>"
bodyEquals :: HasCallStack => String -> YesodExample site ()
bodyEquals text = withResponse $ \ res -> do
let actual = simpleBody res
@ -544,6 +654,11 @@ bodyEquals text = withResponse $ \ res -> do
-- | Assert the last response has the given text. The check is performed using the response
-- body in full text form.
--
-- ==== __Examples__
--
-- > get HomeR
-- > bodyContains "<h1>Foo</h1>"
bodyContains :: HasCallStack => String -> YesodExample site ()
bodyContains text = withResponse $ \ res ->
liftIO $ HUnit.assertBool ("Expected body to contain " ++ text) $
@ -551,6 +666,12 @@ bodyContains text = withResponse $ \ res ->
-- | Assert the last response doesn't have the given text. The check is performed using the response
-- body in full text form.
--
-- ==== __Examples__
--
-- > get HomeR
-- > bodyNotContains "<h1>Foo</h1>
--
-- @since 1.5.3
bodyNotContains :: HasCallStack => String -> YesodExample site ()
bodyNotContains text = withResponse $ \ res ->
@ -562,6 +683,16 @@ contains a b = DL.isInfixOf b (TL.unpack $ decodeUtf8 a)
-- | Queries the HTML using a CSS selector, and all matched elements must contain
-- the given string.
--
-- ==== __Examples__
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > get HomeR
-- > htmlAllContain "p" "Hello" -- Every <p> tag contains the string "Hello"
--
-- > import qualified Data.Text as T
-- > get HomeR
-- > htmlAllContain (T.pack "h1#mainTitle") "Sign Up Now!" -- All <h1> tags with the ID mainTitle contain the string "Sign Up Now!"
htmlAllContain :: HasCallStack => Query -> String -> YesodExample site ()
htmlAllContain query search = do
matches <- htmlQuery query
@ -573,6 +704,12 @@ htmlAllContain query search = do
-- | Queries the HTML using a CSS selector, and passes if any matched
-- element contains the given string.
--
-- ==== __Examples__
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > get HomeR
-- > htmlAnyContain "p" "Hello" -- At least one <p> tag contains the string "Hello"
--
-- Since 0.3.5
htmlAnyContain :: HasCallStack => Query -> String -> YesodExample site ()
htmlAnyContain query search = do
@ -584,7 +721,13 @@ htmlAnyContain query search = do
-- | Queries the HTML using a CSS selector, and fails if any matched
-- element contains the given string (in other words, it is the logical
-- inverse of htmlAnyContains).
-- inverse of htmlAnyContain).
--
-- ==== __Examples__
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > get HomeR
-- > htmlNoneContain ".my-class" "Hello" -- No tags with the class "my-class" contain the string "Hello"
--
-- Since 1.2.2
htmlNoneContain :: HasCallStack => Query -> String -> YesodExample site ()
@ -597,6 +740,12 @@ htmlNoneContain query search = do
-- | Performs a CSS query on the last response and asserts the matched elements
-- are as many as expected.
--
-- ==== __Examples__
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > get HomeR
-- > htmlNoneContain "p" 3 -- There are exactly 3 <p> tags in the response
htmlCount :: HasCallStack => Query -> Int -> YesodExample site ()
htmlCount query count = do
matches <- fmap DL.length $ htmlQuery query
@ -634,18 +783,42 @@ requireJSONResponse = do
failure $ T.concat ["Failed to parse JSON response; error: ", T.pack err, "JSON: ", bodyPreview]
Right v -> return v
-- | Outputs the last response body to stderr (So it doesn't get captured by HSpec)
-- | Outputs the last response body to stderr (So it doesn't get captured by HSpec). Useful for debugging.
--
-- ==== __Examples__
--
-- > get HomeR
-- > printBody
printBody :: YesodExample site ()
printBody = withResponse $ \ SResponse { simpleBody = b } ->
liftIO $ BSL8.hPutStrLn stderr b
-- | Performs a CSS query and print the matches to stderr.
--
-- ==== __Examples__
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > get HomeR
-- > printMatches "h1" -- Prints all h1 tags
printMatches :: Query -> YesodExample site ()
printMatches query = do
matches <- htmlQuery query
liftIO $ hPutStrLn stderr $ show matches
-- | Add a parameter with the given name and value to the request body.
-- | Add a parameter with the given name and value to the request body.
-- This function can be called multiple times to add multiple parameters, and be mixed with calls to 'addFile'.
--
-- "Post parameter" is an informal description of what is submitted by making an HTTP POST with an HTML @\<form\>@.
-- Like HTML @\<form\>@s, yesod-test will default to a @Content-Type@ of @application/x-www-form-urlencoded@ if no files are added,
-- and switch to @multipart/form-data@ if files are added.
--
-- Calling this function after using 'setRequestBody' will raise an error.
--
-- ==== __Examples__
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > post $ do
-- > addPostParam "key" "value"
addPostParam :: T.Text -> T.Text -> RequestBuilder site ()
addPostParam name value =
modifySIO $ \rbd -> rbd { rbdPostData = (addPostData (rbdPostData rbd)) }
@ -654,6 +827,12 @@ addPostParam name value =
MultipleItemsPostData $ ReqKvPart name value : posts
-- | Add a parameter with the given name and value to the query string.
--
-- ==== __Examples__
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > request $ do
-- > addGetParam "key" "value" -- Adds ?key=value to the URL
addGetParam :: T.Text -> T.Text -> RequestBuilder site ()
addGetParam name value = modifySIO $ \rbd -> rbd
{ rbdGets = (TE.encodeUtf8 name, Just $ TE.encodeUtf8 value)