{-# 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
    , clearTags
    , clearTagsCustom
    , 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tag Text] -> [Tag Text]
safeTags 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' and 'clearTags' or 'safeTagsCustom' and 'clearTagsCustom'.
filterTags :: ([Tag Text] -> [Tag Text]) -> Text -> Text
filterTags :: ([Tag Text] -> [Tag Text]) -> Text -> Text
filterTags [Tag Text] -> [Tag Text]
f = forall str. StringLike str => RenderOptions str -> [Tag str] -> str
renderTagsOptions forall str. StringLike str => RenderOptions str
renderOptions {
    optEscape :: Text -> Text
optEscape = forall a. a -> a
id -- stops &"<> from being escaped which breaks existing HTML entities
  , optMinimize :: Text -> Bool
optMinimize = \Text
x -> Text
x forall a. Ord a => a -> Set a -> Bool
`member` Set Text
voidElems -- <img><img> converts to <img />, <a/> converts to <a></a>
  } forall b c a. (b -> c) -> (a -> b) -> a -> c
.  [Tag Text] -> [Tag Text]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall str. StringLike str => [Tag str] -> [Tag str]
canonicalizeTags forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall str. StringLike str => ParseOptions str -> str -> [Tag str]
parseTagsOptions (forall str.
StringLike str =>
(str -> Maybe str) -> ParseOptions str
parseOptionsEntities (forall a b. a -> b -> a
const forall a. Maybe a
Nothing))

voidElems :: Set T.Text
voidElems :: Set Text
voidElems = forall a. Eq a => [a] -> Set a
fromAscList forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words 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 [] = forall a b. (a -> b) -> [a] -> [b]
map forall str. str -> Tag str
TagClose forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (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 forall a. Eq a => a -> a -> Bool
== Text
name = forall str. str -> Tag str
TagClose Text
name forall a. a -> [a] -> [a]
: [Text] -> [Tag Text] -> [Tag Text]
balance [Text]
xs [Tag Text]
tags
    | Text
x 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 = forall str. str -> [Attribute str] -> Tag str
TagOpen Text
name [] forall a. a -> [a] -> [a]
: forall str. str -> Tag str
TagClose Text
name forall a. a -> [a] -> [a]
: [Text] -> [Tag Text] -> [Tag Text]
balance (Text
xforall a. a -> [a] -> [a]
:[Text]
xs) [Tag Text]
tags
balance [Text]
unclosed (TagOpen Text
name [Attribute Text]
as : [Tag Text]
tags) =
    forall str. str -> [Attribute str] -> Tag str
TagOpen Text
name [Attribute Text]
as forall a. a -> [a] -> [a]
: [Text] -> [Tag Text] -> [Tag Text]
balance (Text
name forall a. a -> [a] -> [a]
: [Text]
unclosed) [Tag Text]
tags
balance [Text]
unclosed (Tag Text
t:[Tag Text]
ts) = Tag Text
t 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 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 = forall str. str -> [Attribute str] -> Tag str
TagOpen Text
name (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Attribute Text -> Maybe (Attribute Text)
sanitizeAttr [Attribute Text]
attributes) 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 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

-- | Directly removes tags even if they are not closed properly.
-- This is importent to clear out both the script and iframe tag 
-- in sequences like "<script><iframe></iframe>".
clearTags :: [Tag Text] -> [Tag Text]
clearTags :: [Tag Text] -> [Tag Text]
clearTags = (Text -> Bool) -> [Tag Text] -> [Tag Text]
clearTagsCustom Text -> Bool
clearableTagName

-- | Directly removes tags, like clearTags, but uses a custom
-- function for determining which tags are safe.
--
-- @clearTagsCustom clearableTagName@ is equivalent to
-- 'clearTags'.
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 forall a. a -> [a] -> [a]
: forall {a}. (Num a, Eq a) => a -> [Tag Text] -> [Tag Text]
go Integer
0 [Tag Text]
tags
    | Bool
otherwise = Tag Text
tag 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 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 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 forall a. Eq a => a -> a -> Bool
/= Text
name = a -> [Tag Text] -> [Tag Text]
go a
d [Tag Text]
ts
        | a
d forall a. Eq a => a -> a -> Bool
== a
0 = Tag Text
t 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 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 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 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 forall a. Ord a => a -> Set a -> Bool
`member` Set Text
sanitaryAttributes Bool -> Bool -> Bool
&&
  (Text
name 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 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 forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (Text
"style", Text
css)
sanitizeAttribute Attribute Text
attr | Attribute Text -> Bool
safeAttribute Attribute Text
attr = forall a. a -> Maybe a
Just Attribute Text
attr
                       | Bool
otherwise = 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 forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
u) of
     Just URI
p  -> (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (URI -> String
uriScheme URI
p)) Bool -> Bool -> Bool
||
                ((forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init forall a b. (a -> b) -> a -> b
$ URI -> String
uriScheme URI
p) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
encodeString

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

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

sanitaryAttributes :: Set Text
sanitaryAttributes :: Set Text
sanitaryAttributes = forall a. Ord a => [a] -> Set a
fromList ([Text]
allowed_html_uri_attributes forall a. [a] -> [a] -> [a]
++ [Text]
acceptable_attributes forall a. [a] -> [a] -> [a]
++ [Text]
mathml_attributes forall a. [a] -> [a] -> [a]
++ [Text]
svg_attributes)
  forall a. Ord a => Set a -> Set a -> Set a
\\ (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 = 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 = forall a. Ord a => [a] -> Set a
fromList forall a b. (a -> b) -> a -> b
$ [Text]
allowed_html_uri_attributes 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"]