Fix addToken_ needing a trailing space to work.

The fix can add spaces in place where none or only one where expected.
The css parser has been modified to remove trailing or multiple spaces.
This might be a bit more lax that official CSS spec.
This commit is contained in:
Maxime Bourget 2016-04-11 21:15:27 +01:00
parent 4d6448b0dd
commit 62fc67a444
3 changed files with 15 additions and 3 deletions

View File

@ -577,7 +577,7 @@ fileByLabel label path mime = do
-- > addToken_ "#formID" -- > addToken_ "#formID"
addToken_ :: Query -> RequestBuilder site () addToken_ :: Query -> RequestBuilder site ()
addToken_ scope = do addToken_ scope = do
matches <- htmlQuery' rbdResponse ["Tried to get CSRF token with addToken'"] $ scope <> "input[name=_token][type=hidden][value]" matches <- htmlQuery' rbdResponse ["Tried to get CSRF token with addToken'"] $ scope <> " input[name=_token][type=hidden][value]"
case matches of case matches of
[] -> failure $ "No CSRF token found in the current page" [] -> failure $ "No CSRF token found in the current page"
element:[] -> addPostParam "_token" $ head $ attribute "value" $ parseHTML element element:[] -> addPostParam "_token" $ head $ attribute "value" $ parseHTML element

View File

@ -51,14 +51,14 @@ parseQuery = parseOnly cssQuery
-- Below this line is the Parsec parser for css queries. -- Below this line is the Parsec parser for css queries.
cssQuery :: Parser [[SelectorGroup]] cssQuery :: Parser [[SelectorGroup]]
cssQuery = sepBy rules (char ',' >> optional (char ' ')) cssQuery = many (char ' ') >> sepBy rules (char ',' >> optional (char ' '))
rules :: Parser [SelectorGroup] rules :: Parser [SelectorGroup]
rules = many $ directChildren <|> deepChildren rules = many $ directChildren <|> deepChildren
directChildren :: Parser SelectorGroup directChildren :: Parser SelectorGroup
directChildren = directChildren =
string "> " >> DirectChildren <$> pOptionalTrailingSpace parseSelectors string "> " >> (many (char ' ')) >> DirectChildren <$> pOptionalTrailingSpace parseSelectors
deepChildren :: Parser SelectorGroup deepChildren :: Parser SelectorGroup
deepChildren = pOptionalTrailingSpace $ DeepChildren <$> parseSelectors deepChildren = pOptionalTrailingSpace $ DeepChildren <$> parseSelectors

View File

@ -140,6 +140,18 @@ main = hspec $ do
htmlAnyContain "p" "World" htmlAnyContain "p" "World"
htmlAnyContain "p" "Moon" htmlAnyContain "p" "Moon"
htmlNoneContain "p" "Sun" htmlNoneContain "p" "Sun"
yit "CSRF token" $ do
get ("/form" :: Text)
statusIs 200
request $ do
setMethod "POST"
setUrl ("/form" :: Text)
byLabel "Some Label" "12345"
fileByLabel "Some File" "test/main.hs" "text/plain"
addToken_ "body"
statusIs 200
bodyEquals "12345"
ydescribe "utf8 paths" $ do ydescribe "utf8 paths" $ do
yit "from path" $ do yit "from path" $ do