{-# LANGUAGE OverloadedStrings #-}
-- | Sanatize HTML to prevent XSS attacks.
--
-- See README.md <http://github.com/gregwebs/haskell-xss-sanitize> for more details.
module Text.HTML.SanitizeXSS
    (
    -- * Sanitize
      sanitize
    , sanitizeBalance
    , sanitizeXSS

    -- * Custom filtering
    , filterTags
    , safeTags
    , safeTagsCustom
    , balanceTags

    -- * Utilities
    , safeTagName
    , sanitizeAttribute
    , sanitaryURI
    ) where

import Text.HTML.SanitizeXSS.Css

import Text.HTML.TagSoup

import Data.Set (Set(), member, notMember, (\\), fromList, fromAscList)
import Data.Char ( toLower )
import Data.Text (Text)
import qualified Data.Text as T

import Network.URI ( parseURIReference, URI (..),
                     isAllowedInURI, escapeURIString, uriScheme )
import Codec.Binary.UTF8.String ( encodeString )

import Data.Maybe (mapMaybe)


-- | Sanitize HTML to prevent XSS attacks.  This is equivalent to @filterTags safeTags@.
sanitize :: Text -> Text
sanitize :: Text -> Text
sanitize = Text -> Text
sanitizeXSS

-- | alias of sanitize function
sanitizeXSS :: Text -> Text
sanitizeXSS :: Text -> Text
sanitizeXSS = ([Tag Text] -> [Tag Text]) -> Text -> Text
filterTags ([Tag Text] -> [Tag Text]
safeTags ([Tag Text] -> [Tag Text])
-> ([Tag Text] -> [Tag Text]) -> [Tag Text] -> [Tag Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tag Text] -> [Tag Text]
clearTags)

-- | Sanitize HTML to prevent XSS attacks and also make sure the tags are balanced.
--   This is equivalent to @filterTags (balanceTags . safeTags)@.
sanitizeBalance :: Text -> Text
sanitizeBalance :: Text -> Text
sanitizeBalance = ([Tag Text] -> [Tag Text]) -> Text -> Text
filterTags ([Tag Text] -> [Tag Text]
balanceTags ([Tag Text] -> [Tag Text])
-> ([Tag Text] -> [Tag Text]) -> [Tag Text] -> [Tag Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tag Text] -> [Tag Text]
safeTags ([Tag Text] -> [Tag Text])
-> ([Tag Text] -> [Tag Text]) -> [Tag Text] -> [Tag Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tag Text] -> [Tag Text]
clearTags)

-- | Filter which makes sure the tags are balanced.  Use with 'filterTags' and 'safeTags' to create a custom filter.
balanceTags :: [Tag Text] -> [Tag Text]
balanceTags :: [Tag Text] -> [Tag Text]
balanceTags = [Text] -> [Tag Text] -> [Tag Text]
balance []

-- | Parse the given text to a list of tags, apply the given filtering
-- function, and render back to HTML. You can insert your own custom
-- filtering, but make sure you compose your filtering function with
-- 'safeTags' or 'safeTagsCustom'.
filterTags :: ([Tag Text] -> [Tag Text]) -> Text -> Text
filterTags :: ([Tag Text] -> [Tag Text]) -> Text -> Text
filterTags [Tag Text] -> [Tag Text]
f = RenderOptions Text -> [Tag Text] -> Text
forall str. StringLike str => RenderOptions str -> [Tag str] -> str
renderTagsOptions RenderOptions Text
forall str. StringLike str => RenderOptions str
renderOptions {
    optMinimize :: Text -> Bool
optMinimize = \Text
x -> Text
x Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`member` Set Text
voidElems -- <img><img> converts to <img />, <a/> converts to <a></a>
  } ([Tag Text] -> Text) -> (Text -> [Tag Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  [Tag Text] -> [Tag Text]
f ([Tag Text] -> [Tag Text])
-> (Text -> [Tag Text]) -> Text -> [Tag Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tag Text] -> [Tag Text]
forall str. StringLike str => [Tag str] -> [Tag str]
canonicalizeTags ([Tag Text] -> [Tag Text])
-> (Text -> [Tag Text]) -> Text -> [Tag Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Tag Text]
forall str. StringLike str => str -> [Tag str]
parseTags

voidElems :: Set T.Text
voidElems :: Set Text
voidElems = [Text] -> Set Text
forall a. Eq a => [a] -> Set a
fromAscList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
"area base br col command embed hr img input keygen link meta param source track wbr"

balance :: [Text] -- ^ unclosed tags
        -> [Tag Text] -> [Tag Text]
balance :: [Text] -> [Tag Text] -> [Tag Text]
balance [Text]
unclosed [] = (Text -> Tag Text) -> [Text] -> [Tag Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Tag Text
forall str. str -> Tag str
TagClose ([Text] -> [Tag Text]) -> [Text] -> [Tag Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`notMember` Set Text
voidElems) [Text]
unclosed
balance (Text
x:[Text]
xs) tags' :: [Tag Text]
tags'@(TagClose Text
name:[Tag Text]
tags)
    | Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name = Text -> Tag Text
forall str. str -> Tag str
TagClose Text
name Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: [Text] -> [Tag Text] -> [Tag Text]
balance [Text]
xs [Tag Text]
tags
    | Text
x Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`member` Set Text
voidElems = [Text] -> [Tag Text] -> [Tag Text]
balance [Text]
xs [Tag Text]
tags'
    | Bool
otherwise = Text -> [Attribute Text] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
name [] Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: Text -> Tag Text
forall str. str -> Tag str
TagClose Text
name Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: [Text] -> [Tag Text] -> [Tag Text]
balance (Text
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
xs) [Tag Text]
tags
balance [Text]
unclosed (TagOpen Text
name [Attribute Text]
as : [Tag Text]
tags) =
    Text -> [Attribute Text] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
name [Attribute Text]
as Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: [Text] -> [Tag Text] -> [Tag Text]
balance (Text
name Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
unclosed) [Tag Text]
tags
balance [Text]
unclosed (Tag Text
t:[Tag Text]
ts) = Tag Text
t Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: [Text] -> [Tag Text] -> [Tag Text]
balance [Text]
unclosed [Tag Text]
ts

-- | Filters out unsafe tags and sanitizes attributes. Use with
-- filterTags to create a custom filter.
safeTags :: [Tag Text] -> [Tag Text]
safeTags :: [Tag Text] -> [Tag Text]
safeTags = (Text -> Bool)
-> (Attribute Text -> Maybe (Attribute Text))
-> [Tag Text]
-> [Tag Text]
safeTagsCustom Text -> Bool
safeTagName Attribute Text -> Maybe (Attribute Text)
sanitizeAttribute

-- | Filters out unsafe tags and sanitizes attributes, like
-- 'safeTags', but uses custom functions for determining which tags
-- are safe and for sanitizing attributes. This allows you to add or
-- remove specific tags or attributes on the white list, or to use
-- your own white list.
--
-- @safeTagsCustom safeTagName sanitizeAttribute@ is equivalent to
-- 'safeTags'.
--
-- @since 0.3.6
safeTagsCustom ::
     (Text -> Bool)                       -- ^ Select safe tags, like
                                          -- 'safeTagName'
  -> ((Text, Text) -> Maybe (Text, Text)) -- ^ Sanitize attributes,
                                          -- like 'sanitizeAttribute'
  -> [Tag Text] -> [Tag Text]
safeTagsCustom :: (Text -> Bool)
-> (Attribute Text -> Maybe (Attribute Text))
-> [Tag Text]
-> [Tag Text]
safeTagsCustom Text -> Bool
_ Attribute Text -> Maybe (Attribute Text)
_ [] = []
safeTagsCustom Text -> Bool
safeName Attribute Text -> Maybe (Attribute Text)
sanitizeAttr (t :: Tag Text
t@(TagClose Text
name):[Tag Text]
tags)
    | Text -> Bool
safeName Text
name = Tag Text
t Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: (Text -> Bool)
-> (Attribute Text -> Maybe (Attribute Text))
-> [Tag Text]
-> [Tag Text]
safeTagsCustom Text -> Bool
safeName Attribute Text -> Maybe (Attribute Text)
sanitizeAttr [Tag Text]
tags
    | Bool
otherwise = (Text -> Bool)
-> (Attribute Text -> Maybe (Attribute Text))
-> [Tag Text]
-> [Tag Text]
safeTagsCustom Text -> Bool
safeName Attribute Text -> Maybe (Attribute Text)
sanitizeAttr [Tag Text]
tags
safeTagsCustom Text -> Bool
safeName Attribute Text -> Maybe (Attribute Text)
sanitizeAttr (TagOpen Text
name [Attribute Text]
attributes:[Tag Text]
tags)
  | Text -> Bool
safeName Text
name = Text -> [Attribute Text] -> Tag Text
forall str. str -> [Attribute str] -> Tag str
TagOpen Text
name ((Attribute Text -> Maybe (Attribute Text))
-> [Attribute Text] -> [Attribute Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Attribute Text -> Maybe (Attribute Text)
sanitizeAttr [Attribute Text]
attributes) Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
:
      (Text -> Bool)
-> (Attribute Text -> Maybe (Attribute Text))
-> [Tag Text]
-> [Tag Text]
safeTagsCustom Text -> Bool
safeName Attribute Text -> Maybe (Attribute Text)
sanitizeAttr [Tag Text]
tags
  | Bool
otherwise = (Text -> Bool)
-> (Attribute Text -> Maybe (Attribute Text))
-> [Tag Text]
-> [Tag Text]
safeTagsCustom Text -> Bool
safeName Attribute Text -> Maybe (Attribute Text)
sanitizeAttr [Tag Text]
tags
safeTagsCustom Text -> Bool
n Attribute Text -> Maybe (Attribute Text)
a (Tag Text
t:[Tag Text]
tags) = Tag Text
t Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: (Text -> Bool)
-> (Attribute Text -> Maybe (Attribute Text))
-> [Tag Text]
-> [Tag Text]
safeTagsCustom Text -> Bool
n Attribute Text -> Maybe (Attribute Text)
a [Tag Text]
tags

clearTags :: [Tag Text] -> [Tag Text]
clearTags :: [Tag Text] -> [Tag Text]
clearTags = (Text -> Bool) -> [Tag Text] -> [Tag Text]
clearTagsCustom Text -> Bool
clearableTagName

clearTagsCustom :: (Text -> Bool) -> [Tag Text] -> [Tag Text]
clearTagsCustom :: (Text -> Bool) -> [Tag Text] -> [Tag Text]
clearTagsCustom Text -> Bool
_ [] = []
clearTagsCustom Text -> Bool
clearableName (tag :: Tag Text
tag@(TagOpen Text
name [Attribute Text]
_) : [Tag Text]
tags)
    | Text -> Bool
clearableName Text
name = Tag Text
tag Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: Integer -> [Tag Text] -> [Tag Text]
forall a. (Num a, Eq a) => a -> [Tag Text] -> [Tag Text]
go Integer
0 [Tag Text]
tags
    | Bool
otherwise = Tag Text
tag Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: (Text -> Bool) -> [Tag Text] -> [Tag Text]
clearTagsCustom Text -> Bool
clearableName [Tag Text]
tags
  where
    go :: a -> [Tag Text] -> [Tag Text]
go a
d (t :: Tag Text
t@(TagOpen Text
n [Attribute Text]
_) : [Tag Text]
ts)
        | Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
name = a -> [Tag Text] -> [Tag Text]
go a
d [Tag Text]
ts
        | Bool
otherwise = a -> [Tag Text] -> [Tag Text]
go (a
d a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) [Tag Text]
ts
    go a
d (t :: Tag Text
t@(TagClose Text
n) : [Tag Text]
ts)
        | Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
name = a -> [Tag Text] -> [Tag Text]
go a
d [Tag Text]
ts
        | a
d a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = Tag Text
t Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: (Text -> Bool) -> [Tag Text] -> [Tag Text]
clearTagsCustom Text -> Bool
clearableName [Tag Text]
ts
        | Bool
otherwise = a -> [Tag Text] -> [Tag Text]
go (a
d a -> a -> a
forall a. Num a => a -> a -> a
- a
1) [Tag Text]
ts
    go a
d (Tag Text
t : [Tag Text]
ts) = a -> [Tag Text] -> [Tag Text]
go a
d [Tag Text]
ts
    go a
d [] = []
clearTagsCustom Text -> Bool
clearableName (Tag Text
t : [Tag Text]
tags) = Tag Text
t Tag Text -> [Tag Text] -> [Tag Text]
forall a. a -> [a] -> [a]
: (Text -> Bool) -> [Tag Text] -> [Tag Text]
clearTagsCustom Text -> Bool
clearableName [Tag Text]
tags

safeTagName :: Text -> Bool
safeTagName :: Text -> Bool
safeTagName Text
tagname = Text
tagname Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`member` Set Text
sanitaryTags

safeAttribute :: (Text, Text) -> Bool
safeAttribute :: Attribute Text -> Bool
safeAttribute (Text
name, Text
value) = Text
name Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`member` Set Text
sanitaryAttributes Bool -> Bool -> Bool
&&
  (Text
name Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`notMember` Set Text
uri_attributes Bool -> Bool -> Bool
|| Text -> Bool
sanitaryURI Text
value)

clearableTagName :: Text -> Bool
clearableTagName :: Text -> Bool
clearableTagName Text
tagname = Text
tagname Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`member` Set Text
clearableTags

-- | low-level API if you have your own HTML parser. Used by safeTags.
sanitizeAttribute :: (Text, Text) -> Maybe (Text, Text)
sanitizeAttribute :: Attribute Text -> Maybe (Attribute Text)
sanitizeAttribute (Text
"style", Text
value) =
    let css :: Text
css = Text -> Text
sanitizeCSS Text
value
    in  if Text -> Bool
T.null Text
css then Maybe (Attribute Text)
forall a. Maybe a
Nothing else Attribute Text -> Maybe (Attribute Text)
forall a. a -> Maybe a
Just (Text
"style", Text
css)
sanitizeAttribute Attribute Text
attr | Attribute Text -> Bool
safeAttribute Attribute Text
attr = Attribute Text -> Maybe (Attribute Text)
forall a. a -> Maybe a
Just Attribute Text
attr
                       | Bool
otherwise = Maybe (Attribute Text)
forall a. Maybe a
Nothing
         

-- | Returns @True@ if the specified URI is not a potential security risk.
sanitaryURI :: Text -> Bool
sanitaryURI :: Text -> Bool
sanitaryURI Text
u =
  case String -> Maybe URI
parseURIReference (String -> String
escapeURI (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
u) of
     Just URI
p  -> (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (URI -> String
uriScheme URI
p)) Bool -> Bool -> Bool
||
                (((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
init (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ URI -> String
uriScheme URI
p) String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`member` Set String
safeURISchemes)
     Maybe URI
Nothing -> Bool
False


-- | Escape unicode characters in a URI.  Characters that are
-- already valid in a URI, including % and ?, are left alone.
escapeURI :: String -> String
escapeURI :: String -> String
escapeURI = (Char -> Bool) -> String -> String
escapeURIString Char -> Bool
isAllowedInURI (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
encodeString

safeURISchemes :: Set String
safeURISchemes :: Set String
safeURISchemes = [String] -> Set String
forall a. Ord a => [a] -> Set a
fromList [String]
acceptable_protocols

sanitaryTags :: Set Text
sanitaryTags :: Set Text
sanitaryTags = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
fromList ([Text]
acceptable_elements [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
mathml_elements [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
svg_elements)
  Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
\\ ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
fromList [Text]
svg_allow_local_href) -- extra filtering not implemented

sanitaryAttributes :: Set Text
sanitaryAttributes :: Set Text
sanitaryAttributes = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
fromList ([Text]
allowed_html_uri_attributes [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
acceptable_attributes [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
mathml_attributes [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
svg_attributes)
  Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
\\ ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
fromList [Text]
svg_attr_val_allows_ref) -- extra unescaping not implemented

clearableTags :: Set Text
clearableTags :: Set Text
clearableTags = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
fromList [Text
"script", Text
"style"]

allowed_html_uri_attributes :: [Text]
allowed_html_uri_attributes :: [Text]
allowed_html_uri_attributes = [Text
"href", Text
"src", Text
"cite", Text
"action", Text
"longdesc"]

uri_attributes :: Set Text
uri_attributes :: Set Text
uri_attributes = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ [Text]
allowed_html_uri_attributes [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"xlink:href", Text
"xml:base"]

acceptable_elements :: [Text]
acceptable_elements :: [Text]
acceptable_elements = [Text
"a", Text
"abbr", Text
"acronym", Text
"address", Text
"area",
    Text
"article", Text
"aside", Text
"audio", Text
"b", Text
"big", Text
"blockquote", Text
"br", Text
"button",
    Text
"canvas", Text
"caption", Text
"center", Text
"cite", Text
"code", Text
"col", Text
"colgroup",
    Text
"command", Text
"datagrid", Text
"datalist", Text
"dd", Text
"del", Text
"details", Text
"dfn",
    Text
"dialog", Text
"dir", Text
"div", Text
"dl", Text
"dt", Text
"em", Text
"event-source", Text
"fieldset",
    Text
"figcaption", Text
"figure", Text
"footer", Text
"font", Text
"form", Text
"header", Text
"h1", Text
"h2",
    Text
"h3", Text
"h4", Text
"h5", Text
"h6", Text
"hr", Text
"i", Text
"img", Text
"input", Text
"ins", Text
"keygen",
    Text
"kbd", Text
"label", Text
"legend", Text
"li", Text
"m", Text
"main", Text
"map", Text
"menu", Text
"meter", Text
"multicol",
    Text
"nav", Text
"nextid", Text
"ol", Text
"output", Text
"optgroup", Text
"option", Text
"p", Text
"pre",
    Text
"progress", Text
"q", Text
"s", Text
"samp", Text
"section", Text
"select", Text
"small", Text
"sound",
    Text
"source", Text
"spacer", Text
"span", Text
"strike", Text
"strong", Text
"sub", Text
"sup", Text
"table",
    Text
"tbody", Text
"td", Text
"textarea", Text
"time", Text
"tfoot", Text
"th", Text
"thead", Text
"tr", Text
"tt",
    Text
"u", Text
"ul", Text
"var", Text
"video"]
  
mathml_elements :: [Text]
mathml_elements :: [Text]
mathml_elements = [Text
"maction", Text
"math", Text
"merror", Text
"mfrac", Text
"mi",
    Text
"mmultiscripts", Text
"mn", Text
"mo", Text
"mover", Text
"mpadded", Text
"mphantom",
    Text
"mprescripts", Text
"mroot", Text
"mrow", Text
"mspace", Text
"msqrt", Text
"mstyle", Text
"msub",
    Text
"msubsup", Text
"msup", Text
"mtable", Text
"mtd", Text
"mtext", Text
"mtr", Text
"munder",
    Text
"munderover", Text
"none"]

-- this should include altGlyph I think
svg_elements :: [Text]
svg_elements :: [Text]
svg_elements = [Text
"a", Text
"animate", Text
"animateColor", Text
"animateMotion",
    Text
"animateTransform", Text
"clipPath", Text
"circle", Text
"defs", Text
"desc", Text
"ellipse",
    Text
"font-face", Text
"font-face-name", Text
"font-face-src", Text
"g", Text
"glyph", Text
"hkern",
    Text
"linearGradient", Text
"line", Text
"marker", Text
"metadata", Text
"missing-glyph",
    Text
"mpath", Text
"path", Text
"polygon", Text
"polyline", Text
"radialGradient", Text
"rect",
    Text
"set", Text
"stop", Text
"svg", Text
"switch", Text
"text", Text
"title", Text
"tspan", Text
"use"]
  
acceptable_attributes :: [Text]
acceptable_attributes :: [Text]
acceptable_attributes = [Text
"abbr", Text
"accept", Text
"accept-charset", Text
"accesskey",
    Text
"align", Text
"alt", Text
"autocomplete", Text
"autofocus", Text
"axis",
    Text
"background", Text
"balance", Text
"bgcolor", Text
"bgproperties", Text
"border",
    Text
"bordercolor", Text
"bordercolordark", Text
"bordercolorlight", Text
"bottompadding",
    Text
"cellpadding", Text
"cellspacing", Text
"ch", Text
"challenge", Text
"char", Text
"charoff",
    Text
"choff", Text
"charset", Text
"checked", Text
"class", Text
"clear", Text
"color",
    Text
"cols", Text
"colspan", Text
"compact", Text
"contenteditable", Text
"controls", Text
"coords",
    -- "data", TODO: allow this with further filtering
    Text
"datafld", Text
"datapagesize", Text
"datasrc", Text
"datetime", Text
"default",
    Text
"delay", Text
"dir", Text
"disabled", Text
"draggable", Text
"dynsrc", Text
"enctype", Text
"end",
    Text
"face", Text
"for", Text
"form", Text
"frame", Text
"galleryimg", Text
"gutter", Text
"headers",
    Text
"height", Text
"hidefocus", Text
"hidden", Text
"high", Text
"hreflang", Text
"hspace",
    Text
"icon", Text
"id", Text
"inputmode", Text
"ismap", Text
"keytype", Text
"label", Text
"leftspacing",
    Text
"lang", Text
"list", Text
"loop", Text
"loopcount", Text
"loopend",
    Text
"loopstart", Text
"low", Text
"lowsrc", Text
"max", Text
"maxlength", Text
"media", Text
"method",
    Text
"min", Text
"multiple", Text
"name", Text
"nohref", Text
"noshade", Text
"nowrap", Text
"open",
    Text
"optimum", Text
"pattern", Text
"ping", Text
"point-size", Text
"prompt", Text
"pqg",
    Text
"radiogroup", Text
"readonly", Text
"rel", Text
"repeat-max", Text
"repeat-min",
    Text
"replace", Text
"required", Text
"rev", Text
"rightspacing", Text
"rows", Text
"rowspan",
    Text
"rules", Text
"scope", Text
"selected", Text
"shape", Text
"size", Text
"span", Text
"start",
    Text
"step",
    Text
"style", -- gets further filtering
    Text
"summary", Text
"suppress", Text
"tabindex", Text
"target",
    Text
"template", Text
"title", Text
"toppadding", Text
"type", Text
"unselectable", Text
"usemap",
    Text
"urn", Text
"valign", Text
"value", Text
"variable", Text
"volume", Text
"vspace", Text
"vrml",
    Text
"width", Text
"wrap", Text
"xml:lang"]

acceptable_protocols :: [String]
acceptable_protocols :: [String]
acceptable_protocols = [ String
"ed2k", String
"ftp", String
"http", String
"https", String
"irc",
    String
"mailto", String
"news", String
"gopher", String
"nntp", String
"telnet", String
"webcal",
    String
"xmpp", String
"callto", String
"feed", String
"urn", String
"aim", String
"rsync", String
"tag",
    String
"ssh", String
"sftp", String
"rtsp", String
"afs" ]

mathml_attributes :: [Text]
mathml_attributes :: [Text]
mathml_attributes = [Text
"actiontype", Text
"align", Text
"columnalign", Text
"columnalign",
    Text
"columnalign", Text
"columnlines", Text
"columnspacing", Text
"columnspan", Text
"depth",
    Text
"display", Text
"displaystyle", Text
"equalcolumns", Text
"equalrows", Text
"fence",
    Text
"fontstyle", Text
"fontweight", Text
"frame", Text
"height", Text
"linethickness", Text
"lspace",
    Text
"mathbackground", Text
"mathcolor", Text
"mathvariant", Text
"mathvariant", Text
"maxsize",
    Text
"minsize", Text
"other", Text
"rowalign", Text
"rowalign", Text
"rowalign", Text
"rowlines",
    Text
"rowspacing", Text
"rowspan", Text
"rspace", Text
"scriptlevel", Text
"selection",
    Text
"separator", Text
"stretchy", Text
"width", Text
"width", Text
"xlink:href", Text
"xlink:show",
    Text
"xlink:type", Text
"xmlns", Text
"xmlns:xlink"]

svg_attributes :: [Text]
svg_attributes :: [Text]
svg_attributes = [Text
"accent-height", Text
"accumulate", Text
"additive", Text
"alphabetic",
    Text
"arabic-form", Text
"ascent", Text
"attributeName", Text
"attributeType",
    Text
"baseProfile", Text
"bbox", Text
"begin", Text
"by", Text
"calcMode", Text
"cap-height",
    Text
"class", Text
"clip-path", Text
"color", Text
"color-rendering", Text
"content", Text
"cx",
    Text
"cy", Text
"d", Text
"dx", Text
"dy", Text
"descent", Text
"display", Text
"dur", Text
"end", Text
"fill",
    Text
"fill-opacity", Text
"fill-rule", Text
"font-family", Text
"font-size",
    Text
"font-stretch", Text
"font-style", Text
"font-variant", Text
"font-weight", Text
"from",
    Text
"fx", Text
"fy", Text
"g1", Text
"g2", Text
"glyph-name", Text
"gradientUnits", Text
"hanging",
    Text
"height", Text
"horiz-adv-x", Text
"horiz-origin-x", Text
"id", Text
"ideographic", Text
"k",
    Text
"keyPoints", Text
"keySplines", Text
"keyTimes", Text
"lang", Text
"marker-end",
    Text
"marker-mid", Text
"marker-start", Text
"markerHeight", Text
"markerUnits",
    Text
"markerWidth", Text
"mathematical", Text
"max", Text
"min", Text
"name", Text
"offset",
    Text
"opacity", Text
"orient", Text
"origin", Text
"overline-position",
    Text
"overline-thickness", Text
"panose-1", Text
"path", Text
"pathLength", Text
"points",
    Text
"preserveAspectRatio", Text
"r", Text
"refX", Text
"refY", Text
"repeatCount",
    Text
"repeatDur", Text
"requiredExtensions", Text
"requiredFeatures", Text
"restart",
    Text
"rotate", Text
"rx", Text
"ry", Text
"slope", Text
"stemh", Text
"stemv", Text
"stop-color",
    Text
"stop-opacity", Text
"strikethrough-position", Text
"strikethrough-thickness",
    Text
"stroke", Text
"stroke-dasharray", Text
"stroke-dashoffset", Text
"stroke-linecap",
    Text
"stroke-linejoin", Text
"stroke-miterlimit", Text
"stroke-opacity",
    Text
"stroke-width", Text
"systemLanguage", Text
"target", Text
"text-anchor", Text
"to",
    Text
"transform", Text
"type", Text
"u1", Text
"u2", Text
"underline-position",
    Text
"underline-thickness", Text
"unicode", Text
"unicode-range", Text
"units-per-em",
    Text
"values", Text
"version", Text
"viewBox", Text
"visibility", Text
"width", Text
"widths", Text
"x",
    Text
"x-height", Text
"x1", Text
"x2", Text
"xlink:actuate", Text
"xlink:arcrole",
    Text
"xlink:href", Text
"xlink:role", Text
"xlink:show", Text
"xlink:title", Text
"xlink:type",
    Text
"xml:base", Text
"xml:lang", Text
"xml:space", Text
"xmlns", Text
"xmlns:xlink", Text
"y",
    Text
"y1", Text
"y2", Text
"zoomAndPan"]

-- the values for these need to be escaped
svg_attr_val_allows_ref :: [Text]
svg_attr_val_allows_ref :: [Text]
svg_attr_val_allows_ref = [Text
"clip-path", Text
"color-profile", Text
"cursor", Text
"fill",
    Text
"filter", Text
"marker", Text
"marker-start", Text
"marker-mid", Text
"marker-end",
    Text
"mask", Text
"stroke"]

svg_allow_local_href :: [Text]
svg_allow_local_href :: [Text]
svg_allow_local_href = [Text
"altGlyph", Text
"animate", Text
"animateColor",
    Text
"animateMotion", Text
"animateTransform", Text
"cursor", Text
"feImage", Text
"filter",
    Text
"linearGradient", Text
"pattern", Text
"radialGradient", Text
"textpath", Text
"tref",
    Text
"set", Text
"use"]