diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index efa6b107..570879bb 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -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 \ tag exists on the page + 'htmlAnyContain' \"p\" \"Login\" + + -- yesod-test provides a 'RequestBuilder' monad for building up HTTP requests + 'request' $ do + -- Lookup the HTML \ 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 "

Hello, World

" 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 "

Foo

" 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 "

Foo

+-- -- @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

tag contains the string "Hello" +-- +-- > import qualified Data.Text as T +-- > get HomeR +-- > htmlAllContain (T.pack "h1#mainTitle") "Sign Up Now!" -- All

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

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

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 @\@. +-- Like HTML @\@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)