yesod-test 1.5.8 → 1.5.9
raw patch · 4 files changed
+151/−13 lines, 4 filesdep ~yesod-form
Dependency ranges changed: yesod-form
Files
- ChangeLog.md +4/−0
- Yesod/Test.hs +106/−11
- test/main.hs +39/−0
- yesod-test.cabal +2/−2
ChangeLog.md view
@@ -1,3 +1,7 @@+## 1.5.9+* Add byLabelExact and related functions+[#1459](https://github.com/yesodweb/yesod/pull/1459)+ ## 1.5.8 * Added implicit parameter HasCallStack to assertions. [#1421](https://github.com/yesodweb/yesod/pull/1421)
Yesod/Test.hs view
@@ -73,7 +73,9 @@ -- These functions let you add parameters to your request based -- on currently displayed label names. , byLabel+ , byLabelExact , fileByLabel+ , fileByLabelExact -- *** CSRF Tokens -- | In order to prevent CSRF exploits, yesod-form adds a hidden input@@ -162,6 +164,8 @@ type HasCallStack = (() :: Constraint) #endif +{-# DEPRECATED byLabel "This function seems to have multiple bugs (ref: https://github.com/yesodweb/yesod/pull/1459). Use byLabelExact instead" #-}+{-# DEPRECATED fileByLabel "This function seems to have multiple bugs (ref: https://github.com/yesodweb/yesod/pull/1459). Use fileByLabelExact instead" #-} -- | The state used in a single test case defined using 'yit' --@@ -339,7 +343,7 @@ -- | Asserts that the two given values are equal. ----- In case they are not equal, error mesasge includes the two values.+-- In case they are not equal, error message includes the two values. -- -- @since 1.5.2 assertEq :: (HasCallStack, Eq a, Show a) => String -> a -> a -> YesodExample site ()@@ -523,23 +527,24 @@ addPostData (MultipleItemsPostData posts) contents = MultipleItemsPostData $ ReqFilePart name path contents mimetype : posts +-- | -- This looks up the name of a field based on the contents of the label pointing to it.-nameFromLabel :: T.Text -> RequestBuilder site T.Text-nameFromLabel label = do+genericNameFromLabel :: (T.Text -> T.Text -> Bool) -> T.Text -> RequestBuilder site T.Text+genericNameFromLabel match label = do mres <- fmap rbdResponse ST.get res <- case mres of- Nothing -> failure "nameFromLabel: No response available"+ Nothing -> failure "genericNameFromLabel: No response available" Just res -> return res let body = simpleBody res mlabel = parseHTML body $// C.element "label"- >=> contentContains label+ >=> isContentMatch label mfor = mlabel >>= attribute "for" - contentContains x c- | x `T.isInfixOf` T.concat (c $// content) = [c]+ isContentMatch x c+ | x `match` T.concat (c $// content) = [c] | otherwise = [] case mfor of@@ -566,6 +571,14 @@ (<>) :: T.Text -> T.Text -> T.Text (<>) = T.append +byLabelWithMatch :: (T.Text -> T.Text -> Bool) -- ^ The matching method which is used to find labels (i.e. exact, contains)+ -> T.Text -- ^ The text contained in the @\<label>@.+ -> T.Text -- ^ The value to set the parameter to.+ -> RequestBuilder site ()+byLabelWithMatch match label value = do+ name <- genericNameFromLabel match label+ addPostParam name value+ -- How does this work for the alternate <label><input></label> syntax? -- | Finds the @\<label>@ with the given value, finds its corresponding @\<input>@, then adds a parameter@@ -591,13 +604,61 @@ -- > <form method="POST"> -- > <label>Username <input name="f1"> </label> -- > </form>+--+-- Warning: This function looks for any label that contains the provided text.+-- If multiple labels contain that text, this function will throw an error,+-- as in the example below:+--+-- > <form method="POST">+-- > <label for="nickname">Nickname</label>+-- > <input id="nickname" name="f1" />+--+-- > <label for="nickname2">Nickname2</label>+-- > <input id="nickname2" name="f2" />+-- > </form>+--+-- > request $ do+-- > byLabel "Nickname" "Snoyberger"+--+-- Then, it throws "More than one label contained" error.+--+-- Therefore, this function is deprecated. Please consider using 'byLabelExact',+-- which performs the exact match over the provided text. byLabel :: T.Text -- ^ The text contained in the @\<label>@. -> T.Text -- ^ The value to set the parameter to. -> RequestBuilder site ()-byLabel label value = do- name <- nameFromLabel label- addPostParam name value+byLabel = byLabelWithMatch T.isInfixOf +-- | Finds the @\<label>@ with the given value, finds its corresponding @\<input>@, then adds a parameter+-- for that input to the request body.+--+-- ==== __Examples__+--+-- Given this HTML, we want to submit @f1=Michael@ to the server:+--+-- > <form method="POST">+-- > <label for="user">Username</label>+-- > <input id="user" name="f1" />+-- > </form>+--+-- You can set this parameter like so:+--+-- > request $ do+-- > byLabel "Username" "Michael"+--+-- This function also supports the implicit label syntax, in which+-- the @\<input>@ is nested inside the @\<label>@ rather than specified with @for@:+--+-- > <form method="POST">+-- > <label>Username <input name="f1"> </label>+-- > </form>+--+-- @since 1.5.9+byLabelExact :: T.Text -- ^ The text in the @\<label>@.+ -> T.Text -- ^ The value to set the parameter to.+ -> RequestBuilder site ()+byLabelExact = byLabelWithMatch (==)+ -- | Finds the @\<label>@ with the given value, finds its corresponding @\<input>@, then adds a file for that input to the request body. -- -- ==== __Examples__@@ -620,12 +681,46 @@ -- > <form method="POST"> -- > <label>Please submit an image <input type="file" name="f1"> </label> -- > </form>+--+-- Warning: This function has the same issue as 'byLabel'. Please use 'fileByLabelExact' instead. fileByLabel :: T.Text -- ^ The text contained in the @\<label>@. -> FilePath -- ^ The path to the file. -> T.Text -- ^ The MIME type of the file, e.g. "image/png". -> RequestBuilder site () fileByLabel label path mime = do- name <- nameFromLabel label+ name <- genericNameFromLabel T.isInfixOf label+ addFile name path mime++ -- | Finds the @\<label>@ with the given value, finds its corresponding @\<input>@, then adds a file for that input to the request body.+--+-- ==== __Examples__+--+-- Given this HTML, we want to submit a file with the parameter name @f1@ to the server:+--+-- > <form method="POST">+-- > <label for="imageInput">Please submit an image</label>+-- > <input id="imageInput" type="file" name="f1" accept="image/*">+-- > </form>+--+-- You can set this parameter like so:+--+-- > request $ do+-- > fileByLabel "Please submit an image" "static/img/picture.png" "img/png"+--+-- This function also supports the implicit label syntax, in which+-- the @\<input>@ is nested inside the @\<label>@ rather than specified with @for@:+--+-- > <form method="POST">+-- > <label>Please submit an image <input type="file" name="f1"> </label>+-- > </form>+--+-- @since 1.5.9+fileByLabelExact :: T.Text -- ^ The text contained in the @\<label>@.+ -> FilePath -- ^ The path to the file.+ -> T.Text -- ^ The MIME type of the file, e.g. "image/png".+ -> RequestBuilder site ()+fileByLabelExact label path mime = do+ name <- genericNameFromLabel (==) label addFile name path mime -- | Lookups the hidden input named "_token" and adds its value to the params.
test/main.hs view
@@ -150,6 +150,18 @@ addToken statusIs 200 bodyEquals "12345"+ yit "labels WForm" $ do+ get ("/wform" :: Text)+ statusIs 200++ request $ do+ setMethod "POST"+ setUrl ("/wform" :: Text)+ byLabel "Some WLabel" "12345"+ fileByLabel "Some WFile" "test/main.hs" "text/plain"+ addToken+ statusIs 200+ bodyEquals "12345" yit "finding html" $ do get ("/html" :: Text) statusIs 200@@ -203,6 +215,22 @@ setMethod "POST" setUrl ("/labels" :: Text) byLabel "Foo Bar" "yes"+ ydescribe "labels2" $ do+ yit "fails with \"More than one label contained\" error" $ do+ get ("/labels2" :: Text)+ (bad :: Either SomeException ()) <- try (request $ do+ setMethod "POST"+ setUrl ("labels2" :: Text)+ byLabel "hobby" "fishing")+ assertEq "failure wasn't called" (isLeft bad) True+ yit "byLabelExact performs an exact match over the given label name" $ do+ get ("/labels2" :: Text)+ (bad :: Either SomeException ()) <- try (request $ do+ setMethod "POST"+ setUrl ("labels2" :: Text)+ byLabelExact "hobby" "fishing")+ assertEq "failure was called" (isRight bad) True+ ydescribe "Content-Type handling" $ do yit "can set a content-type" $ do request $ do@@ -334,6 +362,15 @@ case mfoo of FormSuccess (foo, _) -> return $ toHtml foo _ -> defaultLayout widget+ onStatic "wform" $ dispatchTo $ do+ ((mfoo, widget), _) <- runFormPost $ renderDivs $ wFormToAForm $ do+ field1F <- wreq textField "Some WLabel" Nothing+ field2F <- wreq fileField "Some WFile" Nothing++ return $ (,) Control.Applicative.<$> field1F <*> field2F+ case mfoo of+ FormSuccess (foo, _) -> return $ toHtml foo+ _ -> defaultLayout widget onStatic "html" $ dispatchTo $ return ("<html><head><title>Hello</title></head><body><p>Hello World</p><p>Hello Moon</p></body></html>" :: Text) @@ -341,6 +378,8 @@ return ("<html><head><title>A link</title></head><body><a href=\"/html\" id=\"thelink\">Link!</a></body></html>" :: Text) onStatic "labels" $ dispatchTo $ return ("<html><label><input type='checkbox' name='fooname' id='foobar'>Foo Bar</label></html>" :: Text)+ onStatic "labels2" $ dispatchTo $+ return ("<html><label for='hobby'>hobby</label><label for='hobby2'>hobby2</label><input type='text' name='hobby' id='hobby'><input type='text' name='hobby2' id='hobby2'></html>" :: Text) onStatic "checkContentType" $ dispatchTo $ do headers <- requestHeaders <$> waiRequest
yesod-test.cabal view
@@ -1,5 +1,5 @@ name: yesod-test-version: 1.5.8+version: 1.5.9 license: MIT license-file: LICENSE author: Nubis <nubis@woobiz.com.ar>@@ -58,7 +58,7 @@ , containers , html-conduit , yesod-core- , yesod-form+ , yesod-form >= 1.4.14 , text , wai , lifted-base