* proper comment escaping

1 files changed, 9 insertions, 1 deletions

diff --git a/src/Main.hs b/src/Main.hs
index fe111f76668a..8adef253a591 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -120,10 +120,18 @@ addComment acid lang eId = do
   nCtext <- lookText' "ctext"
   nComment <- Comment <$> pure now
                       <*> lookText' "cname"
-                      <*> pure (entryEscape nCtext)
+                      <*> pure (commentEscape nCtext)
   update' acid (AddComment eId nComment)
   seeOther ("/" ++ show lang ++ "/" ++ show eId) (toResponse())
 
+commentEscape :: Text -> Text
+commentEscape = newlineEscape . ltEscape . gtEscape . ampEscape
+    where
+        newlineEscape = T.replace "\n" "<br>"
+        ampEscape = T.replace "&" "&amp;"
+        ltEscape = T.replace "<" "&lt;"
+        gtEscape = T.replace ">" "&gt;"
+
 {- ADMIN stuff -} 
 
 postEntry :: AcidState Blog -> ServerPart Response