{-# 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 :: Text -> Text -> Expectation
sanitized = test sanitize
sanitizedB = test sanitizeBalance
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 "" ""