{-# LANGUAGE OverloadedStrings #-}
import Text.HTML.SanitizeXSS
import Text.HTML.SanitizeXSS.Css
import Data.Text (Text)
import Test.Hspec
import Test.HUnit (assert, (@?=), Assertion)
test :: (Text -> Text) -> Text -> Text -> Assertion
test f actual expected = do
let result = f actual
result @?= expected
sanitized, sanitizedB, sanitizedC :: Text -> Text -> Expectation
sanitized = test sanitize
sanitizedB = test sanitizeBalance
sanitizedC = test sanitizeCustom
sanitizeCustom :: Text -> Text
sanitizeCustom = filterTags $ safeTagsCustom mySafeName mySanitizeAttr
where
mySafeName t = t `elem` myTags || safeTagName t
mySanitizeAttr (key, val) | key `elem` myAttrs = Just (key, val)
mySanitizeAttr x = sanitizeAttribute x
myTags = ["custtag"]
myAttrs = ["custattr"]
main :: IO ()
main = hspec $ do
describe "html sanitizing" $ do
it "big test" $ do
let testHTML = " safeanchor Unbalanced"
test sanitizeBalance testHTML " safeanchor Unbalanced"
sanitized testHTML " safeanchor Unbalanced"
it "relativeURI" $ do
let testRelativeURI = "bar"
sanitized testRelativeURI testRelativeURI
it "protocol hack" $
sanitized "" ""
it "object hack" $
sanitized "" ""
it "embed hack" $
sanitized "" ""
it "ucase image hack" $
sanitized "" ""
describe "allowedCssAttributeValue" $ do
it "allows hex" $ do
assert $ allowedCssAttributeValue "#abc"
assert $ allowedCssAttributeValue "#123"
assert $ not $ allowedCssAttributeValue "abc"
assert $ not $ allowedCssAttributeValue "123abc"
it "allows rgb" $ do
assert $ allowedCssAttributeValue "rgb(1,3,3)"
assert $ not $ allowedCssAttributeValue "rgb()"
it "allows units" $ do
assert $ allowedCssAttributeValue "10 px"
assert $ not $ allowedCssAttributeValue "10 abc"
describe "css sanitizing" $ do
it "removes style when empty" $
sanitized "" ""
it "allows any non-url value for white-listed properties" $ do
let whiteCss = ""
sanitized whiteCss whiteCss
it "rejects any url value" $ do
let whiteCss = ""
sanitized whiteCss ""
it "rejects properties not on the white list" $ do
let blackCss = ""
sanitized blackCss ""
it "rejects invalid units for grey-listed css" $ do
let greyCss = ""
sanitized greyCss ""
it "allows valid units for grey-listed css" $ do
let grey2Css = ""
sanitized grey2Css grey2Css
describe "balancing" $ do
it "adds missing elements" $ do
sanitizedB "foo" "foo"
it "doesn't add closing voids" $ do
sanitizedB "" ""
it "removes closing voids" $ do
sanitizedB "" ""
it "interleaved" $
sanitizedB "helloworld" "helloworld"
describe "customized white list" $ do
it "does not filter custom tags" $ do
let custtag = "
"
sanitizedC custtag custtag
it "filters non-custom tags" $ do
sanitizedC "
" ""
it "does not filter custom attributes" $ do
let custattr = ""
sanitizedC custattr custattr
it "filters non-custom attributes" $ do
sanitizedC "" ""