From dbee96a6a4e8ef7b478c9a161e89a0c8e8b573f6 Mon Sep 17 00:00:00 2001 From: Onyeka Obi Date: Tue, 31 Mar 2026 13:12:10 -0700 Subject: [PATCH 1/2] Allow configuring via html-lang file Read an optional html-lang file from the project root to set the lang attribute on the generated tag. If the file contains e.g. "fr", the output becomes . If absent or empty, the tag is plain as before. Fixes #84. --- compiler/src/Generate/Html.hs | 7 +++++-- extra/Lamdera/Live.hs | 12 ++++++++++++ 2 files changed, 17 insertions(+), 2 deletions(-) diff --git a/compiler/src/Generate/Html.hs b/compiler/src/Generate/Html.hs index e6470068d..7417a0771 100644 --- a/compiler/src/Generate/Html.hs +++ b/compiler/src/Generate/Html.hs @@ -71,9 +71,12 @@ sandwich_ root moduleName javascript = customHead else "" <> name <> "" + + htmlTag = Lamdera.unsafe $ Lamdera.Live.lamderaHtmlLang root in - [r| - + "\n" + <> htmlTag + <> [r| diff --git a/extra/Lamdera/Live.hs b/extra/Lamdera/Live.hs index 7aa7e0d40..a78a5e52b 100644 --- a/extra/Lamdera/Live.hs +++ b/extra/Lamdera/Live.hs @@ -64,6 +64,18 @@ lamderaLiveHead root = do pure (False, "") +lamderaHtmlLang :: FilePath -> IO B.Builder +lamderaHtmlLang root = do + langM <- readUtf8Text $ root "html-lang" + pure $ maybe "" toHtmlTag langM + where + toHtmlTag lang = + let trimmed = T.strip lang in + if T.null trimmed + then "" + else " T.encodeUtf8Builder trimmed <> "\">" + + lamderaLive :: BS.ByteString lamderaLive = $(bsToExp =<< runIO (Lamdera.Relative.readByteString "extra/dist/live.js")) From ef41b8fa52ac4d2b0573efb99a1550ca21eb88f8 Mon Sep 17 00:00:00 2001 From: Onyeka Obi Date: Wed, 8 Apr 2026 13:45:45 -0700 Subject: [PATCH 2/2] HTML-escape the html-lang attribute value Prevents attribute injection via the html-lang file by escaping &, ", <, > as HTML entities. Addresses PR review feedback from lydell. --- extra/Lamdera/Live.hs | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/extra/Lamdera/Live.hs b/extra/Lamdera/Live.hs index a78a5e52b..eef29e02b 100644 --- a/extra/Lamdera/Live.hs +++ b/extra/Lamdera/Live.hs @@ -6,7 +6,8 @@ module Lamdera.Live where import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as B -import qualified Data.Text.Encoding as T +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE import qualified System.Directory as Dir import System.FilePath as FP import Control.Exception (finally, throw) @@ -40,16 +41,16 @@ lamderaLiveSrc = overrideM <- readUtf8Text overridePathBuilt case overrideM of Just override -> do - pure (T.encodeUtf8Builder override) + pure (TE.encodeUtf8Builder override) Nothing -> do Lamdera.debug $ "Couldn't load override " ++ overridePath ++ ", using compiled lamderaLive" - pure (T.encodeUtf8Builder (T.decodeUtf8 lamderaLive)) + pure (TE.encodeUtf8Builder (TE.decodeUtf8 lamderaLive)) else do Lamdera.debug $ "Couldn't find override " ++ overridePath ++ ", using compiled lamderaLive" - pure (T.encodeUtf8Builder (T.decodeUtf8 lamderaLive)) + pure (TE.encodeUtf8Builder (TE.decodeUtf8 lamderaLive)) else do Lamdera.debug $ "🗿 Using compiled lamderaLive" - pure (T.encodeUtf8Builder (T.decodeUtf8 lamderaLive)) + pure (TE.encodeUtf8Builder (TE.decodeUtf8 lamderaLive)) -- @TODO means we have to restart live for any changes... how to improve that? @@ -58,7 +59,7 @@ lamderaLiveHead root = do headHtmlM <- readUtf8Text $ root "head.html" case headHtmlM of Just headHtml -> - pure (True, T.encodeUtf8Builder headHtml) + pure (True, TE.encodeUtf8Builder headHtml) Nothing -> pure (False, "") @@ -73,7 +74,14 @@ lamderaHtmlLang root = do let trimmed = T.strip lang in if T.null trimmed then "" - else " T.encodeUtf8Builder trimmed <> "\">" + else " TE.encodeUtf8Builder (escapeHtmlAttr trimmed) <> "\">" + + escapeHtmlAttr = T.concatMap $ \c -> case c of + '&' -> "&" + '"' -> """ + '<' -> "<" + '>' -> ">" + _ -> T.singleton c lamderaLive :: BS.ByteString