jgm · jgm · Jan 13, 2025 · Oct 16, 2024 · Oct 16, 2024 · Oct 16, 2024
diff --git a/README.markdown b/README.markdown
@@ -567,7 +567,7 @@ Now add the following lines to the apache configuration file for the
       SetOutputFilter  proxy-html
       ProxyPassReverse /
       ProxyHTMLURLMap  /   /wiki/
-      ProxyHTMLDocType "<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>" XHTML
+      ProxyHTMLDocType html5
       RequestHeader unset Accept-Encoding
     </Location>
 

diff --git a/data/markup.HTML b/data/markup.HTML
@@ -1,6 +1,6 @@
 # Markup
 
-The syntax for wiki pages is standard XHTML. All tags must be
+The syntax for wiki pages is standard HTML 5. All tags must be
 properly closed.
 
 ## Wiki links

diff --git a/data/markupHelp/HTML b/data/markupHelp/HTML
@@ -45,6 +45,6 @@ external</a>,
 </dl>
 ~~~~~~~~
 
-For more: [xhtml tutorial](http://www.w3schools.com/Xhtml/),
+For more: [HTML tutorial](https://developer.mozilla.org/en-US/docs/Learn/HTML),
 [pandoc](http://pandoc.org/README.html).
 
diff --git a/data/templates/page.st b/data/templates/page.st
@@ -1,6 +1,5 @@
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
-          "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml">
+<!DOCTYPE html>
+<html>
   <head>
     <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
     <meta name="viewport" content="width=device-width, initial-scale=1.0">

diff --git a/gitit.cabal b/gitit.cabal
@@ -158,7 +158,7 @@ Library
                      xml-types >= 0.3,
                      xss-sanitize >= 0.3 && < 0.4,
                      tagsoup >= 0.13 && < 0.15,
-                     blaze-html >= 0.4 && < 0.10,
+                     blaze-html >= 0.5 && < 0.10,
                      json >= 0.4 && < 0.12,
                      uri-bytestring >= 0.2.3.3,
                      split,

diff --git a/src/Network/Gitit/Authentication.hs b/src/Network/Gitit/Authentication.hs
diff --git a/src/Network/Gitit/ContentTransformer.hs b/src/Network/Gitit/ContentTransformer.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
 {-
 Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>,
 Anton van Straaten <anton@appsolutions.com>
@@ -76,7 +77,6 @@ import Control.Monad.Except (throwError)
 import Data.Foldable (traverse_)
 import Data.List (stripPrefix)
 import Data.Maybe (isNothing, mapMaybe)
-import Data.Semigroup ((<>))
 import Network.Gitit.Cache (lookupCache, cacheContents)
 import Network.Gitit.Framework hiding (uriPath)
 import Network.Gitit.Layout
@@ -93,13 +93,6 @@ import qualified Text.Pandoc.Builder as B
 import Text.HTML.SanitizeXSS (sanitizeBalance)
 import Skylighting hiding (Context)
 import Text.Pandoc hiding (MathML, WebTeX, MathJax)
-import Text.XHtml hiding ( (</>), dir, method, password, rev )
-import Text.XHtml.Strict (stringToHtmlString)
-#if MIN_VERSION_blaze_html(0,5,0)
-import Text.Blaze.Html.Renderer.String as Blaze ( renderHtml )
-#else
-import Text.Blaze.Renderer.String as Blaze ( renderHtml )
-#endif
 import URI.ByteString (Query(Query), URIRef(uriPath), laxURIParserOptions,
                        parseURI, uriQuery)
 import qualified Data.Text as T
@@ -108,6 +101,12 @@ import qualified Data.ByteString.Char8 as SC (pack, unpack)
 import qualified Data.ByteString.Lazy as L (toChunks, fromChunks)
 import qualified Data.FileStore as FS
 import qualified Text.Pandoc as Pandoc
+import Data.String (IsString(fromString))
+import Text.Blaze.Html.Renderer.String as Blaze ( renderHtml )
+import Text.Blaze.Html5 hiding (u, s, contents, source, html, title, map)
+import Text.Blaze.Html5.Attributes hiding (id)
+import qualified Text.Blaze.Html5 as Html5
+import qualified Text.Blaze.Html5.Attributes as Html5.Attr
 
 --
 -- ContentTransformer runners
@@ -199,7 +198,7 @@ preview = runPageTransformer $
           contentsToPage >>=
           pageToWikiPandoc >>=
           pandocToHtml >>=
-          return . toResponse . renderHtmlFragment
+          return . toResponse . renderHtml
 
 -- | Applies pre-commit plugins to raw page source, possibly
 -- modifying it.
@@ -336,6 +335,8 @@ pageToPandoc page' = do
                              , ctxMeta = pageMeta page' }
   either (liftIO . E.throwIO) return $ readerFor (pageFormat page') (pageLHS page') (pageText page')
 
+data WasRedirect = WasRedirect | WasNoRedirect
+
 -- | Detects if the page is a redirect page and handles accordingly. The exact
 -- behaviour is as follows:
 --
@@ -378,56 +379,51 @@ handleRedirects page = case lookup "redirect" (pageMeta page) of
   where
     addMessage message = modifyContext $ \context -> context
         { ctxLayout = (ctxLayout context)
-            { pgMessages = pgMessages (ctxLayout context) ++ [message]
+            { pgMessages = pgMessages (ctxLayout context) ++ [renderHtml message]
             }
         }
     redirectedFrom source = do
         (url, html) <- processSource source
-        return $ concat
-            [ "Redirected from <a href=\""
-            , url
-            , "?redirect=no\" title=\"Go to original page\">"
-            , html
-            , "</a>"
+        return $ mconcat
+            [ "Redirected from ",
+               a ! href (url WasNoRedirect) ! title "Go to original page" $ html
             ]
     doubleRedirect source destination = do
         (url, html) <- processSource source
         (url', html') <- processDestination destination
-        return $ concat
-            [ "This page normally redirects to <a href=\""
-            , url'
-            , "\" title=\"Continue to destination\">"
-            , html'
-            , "</a>, but as you were already redirected from <a href=\""
-            , url
-            , "?redirect=no\" title=\"Go to original page\">"
-            , html
-            , "</a>"
+        return $ mconcat
+            [ "This page normally redirects to "
+            , a ! href (fromString $ url' WasRedirect) ! title "Continue to destination" $ html'
+            , ", but as you were already redirected from "
+            , a ! href (url WasNoRedirect) ! title "Go to original page" $ html
             , ", this was stopped to prevent a double-redirect."
             ]
     cancelledRedirect destination = do
         (url', html') <- processDestination destination
-        return $ concat
-            [ "This page redirects to <a href=\""
-            , url'
-            , "\" title=\"Continue to destination\">"
-            , html'
-            , "</a>."
+        return $ mconcat
+            [ "This page redirects to "
+            , a ! href (fromString $ url' WasRedirect) ! title "Continue to destination" $ html'
             ]
     processSource source = do
         base' <- getWikiBase
-        let url = stringToHtmlString $ base' ++ urlForPage source
-        let html = stringToHtmlString source
+        let url redir = fromString @AttributeValue $
+              base' ++ urlForPage source ++ case redir of
+                WasNoRedirect -> "?redirect=no"
+                WasRedirect -> ""
+        let html = fromString @Html source
         return (url, html)
     processDestination destination = do
         base' <- getWikiBase
         let (page', fragment) = break (== '#') destination
-        let url = stringToHtmlString $ concat
+        let url redir = concat
              [ base'
              , urlForPage page'
              , fragment
-             ]
-        let html = stringToHtmlString page'
+
+             ] ++ case redir of
+                WasNoRedirect -> "?redirect=no"
+                WasRedirect -> ""
+        let html = fromString @Html page'
         return (url, html)
     getSource = do
         cfg <- lift getConfig
@@ -465,26 +461,25 @@ handleRedirects page = case lookup "redirect" (pageMeta page) of
                              , urlForPage (pageName page)
                              , "?redirect=yes"
                              ]
-                        lift $ seeOther url' $ withBody $ concat
-                            [ "<!doctype html><html><head><title>307 Redirect"
-                            , "</title></head><body><p>You are being <a href=\""
-                            , stringToHtmlString url'
-                            , "\">redirected</a>.</body></p></html>"
+                        lift $ seeOther url' $ withBody $ renderHtml $ docTypeHtml $ mconcat
+                            [ Html5.head $ Html5.title "307 Redirect"
+                            , Html5.body $ p $ mconcat [
+                                "You are being",
+                                a ! href (fromString url') $ "redirected."
+                              ]
                             ]
              Just True -> fmap Left $ do
                 (url', html') <- processDestination destination
-                lift $ ok $ withBody $ concat
-                    [ "<!doctype html><html><head><title>Redirecting to "
-                    , html'
-                    , "</title><meta http-equiv=\"refresh\" contents=\"0; url="
-                    , url'
-                    , "\" /><script type=\"text/javascript\">window.location=\""
-                    , url'
-                    , "\"</script></head><body><p>Redirecting to <a href=\""
-                    , url'
-                    , "\">"
-                    , html'
-                    , "</a>...</p></body></html>"
+                lift $ ok $ withBody $ renderHtml $ docTypeHtml $ mconcat
+                    [ Html5.head $ mconcat
+                        [ Html5.title $ "Redirecting to" <> html'
+                        , meta ! httpEquiv "refresh" ! content (fromString $ "0; url=" <> url' WasRedirect)
+                        , script ! type_ "text/javascript" $ fromString $ "window.location=\"" <> url' WasRedirect <> "\""
+                        ],
+                      Html5.body $ p $ mconcat
+                        [ "Redirecting to "
+                        , a ! href (fromString $ url' WasRedirect) $ html'
+                        ]
                     ]
              Just False -> do
                 cancelledRedirect destination >>= addMessage
@@ -509,7 +504,7 @@ pandocToHtml pandocContents = do
     case res of
       Right t -> return t
       Left e  -> throwError $ PandocTemplateError $ T.pack e
-  return $ primHtml $ T.unpack .
+  return $ preEscapedToHtml @T.Text .
            (if xssSanitize cfg then sanitizeBalance else id) $
            either E.throw id . runPure $ writeHtml5String def{
                         writerTemplate = Just compiledTemplate
@@ -542,8 +537,7 @@ highlightSource (Just source) = do
                             , traceOutput = False} l
                         $ T.pack $ filter (/='\r') source of
                     Left e ->  fail (show e)
-                    Right r -> return $ primHtml $ Blaze.renderHtml
-                                      $ formatHtmlBlock formatOpts r
+                    Right r -> return $ formatHtmlBlock formatOpts r
 
 --
 -- Plugin combinators
@@ -607,11 +601,11 @@ wikiDivify :: Html -> ContentTransformer Html
 wikiDivify c = do
   categories <- liftM ctxCategories get
   base' <- lift getWikiBase
-  let categoryLink ctg = li (anchor ! [href $ base' ++ "/_category/" ++ ctg] << ctg)
+  let categoryLink ctg = li (a ! href (fromString $ base' ++ "/_category/" ++ ctg) $ fromString ctg)
   let htmlCategories = if null categories
-                          then noHtml
-                          else thediv ! [identifier "categoryList"] << ulist << map categoryLink categories
-  return $ thediv ! [identifier "wikipage"] << [c, htmlCategories]
+                          then mempty
+                          else Html5.div ! Html5.Attr.id "categoryList" $ ul $ foldMap categoryLink categories
+  return $ Html5.div ! Html5.Attr.id "wikipage" $ c <> htmlCategories
 
 -- | Adds page title to a Pandoc document.
 addPageTitleToPandoc :: String -> Pandoc -> ContentTransformer Pandoc