EDSL для HTML: типы как граница безопасности

Начинаем второй сквозной проект: генератор статического блога. На входе наша разметка, на выходе папка с HTML. Первый кирпич это слой, который собирает HTML. Не строками (строку слишком легко собрать криво и небезопасно), а маленьким встроенным языком: newtype Html, Structure, Content, smart-конструкторы, экранирование и экспорт-лист как настоящая граница. К концу урока невалидный и небезопасный HTML станет невыразимым по построению, а не просто нежелательным.

Идея

Прошлый проект был про чужой язык: мы читали и вычисляли Lisp. Этот другой: тут мы проектируем свой маленький язык внутри Haskell и учимся жить в экосистеме (пакет, доки, тесты, скорость). Первый и самый поучительный кусок это генерация HTML.

Заманчиво писать HTML строками: "<p>" <> text <> "</p>". Так делают все, и все на этом обжигаются. Две беды. Во-первых, ничто не мешает забыть закрыть тег или вложить <p> в <title>: строка проглотит любую кашу. Во-вторых, если text пришёл от пользователя и внутри <script>, ты только что открыл дыру: разметка пользователя утекла в твою разметку.

EDSL отвечает на обе беды сразу. Мы заводим типы Html, Structure, Content, прячем их конструкторы и даём наружу только функции, которые физически не умеют собрать кривое или небезопасное значение. Граница проходит по экспорт-листу модуля: то, что не экспортировано, снаружи не существует.

Три уровня документа, три типа:

• Html это весь документ: <html> с головой и телом.
• Structure это блок внутри тела: абзац, заголовок, список, блок кода. Блоки склеиваются друг с другом.
• Content это инлайн внутри блока: текст, ссылка, картинка, жирный или курсив. Тоже склеивается.

Слово “склеиваются” тут техническое. И Structure, и Content это Semigroup и Monoid: a <> b это два блока подряд, mempty это пустота. Это и есть публичный API склейки, ровно та абстракция из урока про Semigroup и Monoid, только теперь она несёт смысл “поставить блоки один за другим”.

Внутренний модуль: тут живут конструкторы

Заводим Press.Html.Internal. Слово Internal в имени это сигнал: сюда нельзя ходить из прикладного кода. Здесь открыто всё, включая сырые конструкторы newtype, потому что тесты и публичный фасад должны дотянуться до потрохов. Прикладной модуль импортирует не это, а Press.Html (его соберём ниже).

module Press.Html.Internal where

import Numeric.Natural (Natural)

newtype Html = Html String

newtype Structure = Structure String

newtype Content = Content String

type Title = String

newtype вокруг String тут ключевой. В рантайме Html, Structure, Content это просто строки, цены нет. На этапе компиляции это три разных типа, и компилятор не даст подсунуть Content туда, где ждут Structure. А Title это просто синоним: он ничего не охраняет, только документирует намерение в сигнатурах. Это прямая иллюстрация тезиса из урока про алгебраические типы: имя само по себе это ещё не типобезопасность, безопасность даёт скрытый конструктор плюс закрытая граница модуля.

Документ и блоки

Самый верхний конструктор оборачивает заголовок и тело в полный документ:

html_ :: Title -> Structure -> Html
html_ title content =
  Html
    ( el "html"
        ( el "head" (el "title" (escape title))
            <> el "body" (getStructureString content)
        )
    )

Дальше блоки. Каждый smart-конструктор берёт содержимое и заворачивает его в тег. Обрати внимание: имена с подчёркиванием на конце это конвенция blaze-html и lucid, чтобы не конфликтовать с возможными ключевыми словами и читаться как теги.

p_ :: Content -> Structure
p_ = Structure . el "p" . getContentString

h_ :: Natural -> Content -> Structure
h_ n = Structure . el ("h" <> show n) . getContentString

ul_ :: [Structure] -> Structure
ul_ = Structure . el "ul" . concatMap (el "li" . getStructureString)

ol_ :: [Structure] -> Structure
ol_ = Structure . el "ol" . concatMap (el "li" . getStructureString)

code_ :: String -> Structure
code_ = Structure . el "pre" . escape

Уровень заголовка это Natural, а не Int: отрицательного заголовка не бывает, и тип это фиксирует. code_ берёт сырой String и экранирует его: внутри <pre> код показываем как текст, а не исполняем.

Теперь склейка блоков. Это и есть публичная семантика “поставить подряд”:

instance Semigroup Structure where
  (<>) c1 c2 =
    Structure (getStructureString c1 <> getStructureString c2)

instance Monoid Structure where
  mempty = Structure ""

mempty это пустой блок, <> это конкатенация без швов. Законы Monoid тут выполняются автоматически, потому что конкатенация строк ассоциативна, а пустая строка нейтральна. В уроке про тесты мы это проверим property-тестом, а не на слово.

Инлайн-контент

Content живёт внутри блока. Самый важный конструктор тут txt_: единственная дверь, через которую сырой текст входит в наш HTML, и она экранирует.

txt_ :: String -> Content
txt_ = Content . escape

link_ :: FilePath -> Content -> Content
link_ path content =
  Content $
    elAttr
      "a"
      ("href=\"" <> escape path <> "\"")
      (getContentString content)

img_ :: FilePath -> Content
img_ path =
  Content $ "<img src=\"" <> escape path <> "\">"

b_ :: Content -> Content
b_ = Content . el "b" . getContentString

i_ :: Content -> Content
i_ = Content . el "i" . getContentString

instance Semigroup Content where
  (<>) c1 c2 =
    Content (getContentString c1 <> getContentString c2)

instance Monoid Content where
  mempty = Content ""

Заметь: txt_, link_, img_ все прогоняют пользовательский ввод через escape. А b_ и i_ принимают уже готовый Content, который уже был экранирован на входе. Поэтому что бы ты ни собрал из этих кирпичей, сырой текст пользователя физически не может миновать escape. Это и есть граница безопасности, и держится она на типе, а не на дисциплине программиста.

Рендер и приватные помощники

render :: Html -> String
render (Html str) = str

getStructureString :: Structure -> String
getStructureString (Structure str) = str

getContentString :: Content -> String
getContentString (Content str) = str

el :: String -> String -> String
el tag content =
  "<" <> tag <> ">" <> content <> "</" <> tag <> ">"

elAttr :: String -> String -> String -> String
elAttr tag attrs content =
  "<" <> tag <> " " <> attrs <> ">" <> content <> "</" <> tag <> ">"

И сердце безопасности, единственная функция, которая делает EDSL надёжным:

escape :: String -> String
escape =
  let
    escapeChar c =
      case c of
        '<' -> "&lt;"
        '>' -> "&gt;"
        '&' -> "&amp;"
        '"' -> "&quot;"
        '\'' -> "&#39;"
        _ -> [c]
   in
    concatMap escapeChar

Пять символов, которые иначе позволили бы строке вырваться из своего HTML-контекста, заменяются на безопасные entity. Всё остальное проходит как есть.

Эта функция настолько важна, что её стоит написать руками прямо сейчас. Реализуй escape в редакторе ниже: starter пропускает строку как есть (опасные символы утекают), и скрытые тесты краснеют, пока ты не закроешь все пять.