From: sabadev <saba@sabadev.xyz>
Date: Sat, 27 Mar 2021 15:04:23 +0000 (-0400)
Subject: Added the Sanitize module.
X-Git-Url: http://sabadev.xyz:4321/?a=commitdiff_plain;h=1c1e3c3701f2146672eb097813cdd024c699e099;p=website.git

Added the Sanitize module.
---

diff --git a/src/Html.hs b/src/Html.hs
index 50cf7b0..2f5f80c 100644
--- 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
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