Added the Sanitize module.

diff --git a/src/Html.hs b/src/Html.hs
index 50cf7b0..2f5f80c 100644 (file)
--- a/src/Html.hs
+++ b/src/Html.hs
@@ -5,6 +5,7 @@ import Control.Monad (void)
 import Control.Monad.IO.Class (MonadIO(..), liftIO)
 import Data.Maybe (fromMaybe)
 import Lucid
+import Sanitize
 import Servant
 import System.Directory (getDirectoryContents)
 import qualified Data.Text as T
@@ -13,7 +14,7 @@ import qualified Data.Text.IO as T
 htmlContainer :: (MonadIO m) => Maybe Theme -> Html a -> m (Html ())
 htmlContainer theme contents = do
   nav <- navigation theme
-  pure $ void $ with doctypehtml_ [lang_ "en"] $ do
+  pure $ sanitizeHtml $ void $ with doctypehtml_ [lang_ "en"] $ do
     head_ $ do
       title_ $ toHtml siteTitle
       meta_ [charset_ "utf8"]

diff --git a/src/Sanitize.hs b/src/Sanitize.hs
new file mode 100644 (file)
index 0000000..734939f
--- /dev/null
+++ b/src/Sanitize.hs
@@ -0,0 +1,11 @@
+module Sanitize where
+
+import Lucid (Html(..), renderText, toHtmlRaw)
+import Text.HTML.TagSoup.Tree (parseTree, renderTree, transformTree, TagTree(..))
+import qualified Data.Text.Lazy as T
+
+sanitizeHtml :: Html () -> Html ()
+sanitizeHtml = toHtmlRaw . renderTree . transformTree sanitizeTree . parseTree . renderText
+
+sanitizeTree :: TagTree T.Text -> [TagTree T.Text]
+sanitizeTree = pure