diff --git a/Text/HTML/SanitizeXSS.hs b/Text/HTML/SanitizeXSS.hs index e2599b2..b80b851 100644 --- a/Text/HTML/SanitizeXSS.hs +++ b/Text/HTML/SanitizeXSS.hs @@ -12,6 +12,7 @@ module Text.HTML.SanitizeXSS -- * Custom filtering , filterTags , safeTags + , mySafeTags , balanceTags -- * Utilities @@ -76,15 +77,25 @@ balance unclosed (t:ts) = t : balance unclosed ts -- | Filters out any usafe tags and attributes. Use with filterTags to create a custom filter. safeTags :: [Tag Text] -> [Tag Text] -safeTags [] = [] -safeTags (t@(TagClose name):tags) +safeTags = mySafeTags safeTagName sanitizeAttribute + +-- | Filters out unsafe tags and attributes like 'safeTags', but uses +-- custom functions for determining which tags and attributes are +-- safe. This allows you to add or remove specific tags or attributes +-- on the white list, or to use your own white list. +-- @mySafeTags safeTagName sanitizeAttribute@ is equivalent to +-- 'safeTags'. +mySafeTags :: (Text -> Bool) -> ((Text, Text) -> Maybe (Text, Text)) -> + [Tag Text] -> [Tag Text] +mySafeTags _ _ [] = [] +mySafeTags _ _ (t@(TagClose name):tags) | safeTagName name = t : safeTags tags | otherwise = safeTags tags -safeTags (TagOpen name attributes:tags) - | safeTagName name = TagOpen name - (catMaybes $ map sanitizeAttribute attributes) : safeTags tags +mySafeTags safeName sanitizeAttr (TagOpen name attributes:tags) + | safeName name = TagOpen name + (catMaybes $ map sanitizeAttr attributes) : safeTags tags | otherwise = safeTags tags -safeTags (t:tags) = t:safeTags tags +mySafeTags _ _ (t:tags) = t:safeTags tags safeTagName :: Text -> Bool safeTagName tagname = tagname `member` sanitaryTags