Merge branch 'feature/comment-reactions'

commit 626e7b65e9a7c00ed68c78400e03e27cbd4c77c0
Author: Jakob L. Kreuze <zerodaysfordays@sdf.org>
Date:   Tue Mar 14 18:05:47 2023 -0400

    Indicator when reaction attempt succeeded

commit e446f67898a05091b2f05df9ed81ca73764f6069
Author: Jakob L. Kreuze <zerodaysfordays@sdf.org>
Date:   Tue Mar 14 18:05:16 2023 -0400

    Bug fixes

commit ab6edd57158574df80fe33138e99a317c64a0861
Author: Jakob L. Kreuze <zerodaysfordays@sdf.org>
Date:   Sun Mar 12 08:43:03 2023 -0400

    Better error reporting for reactions

commit 9d0638a78333ca35aa1bd12c5c6ced8bd2d7687d
Author: Jakob L. Kreuze <zerodaysfordays@sdf.org>
Date:   Sun Mar 12 08:38:49 2023 -0400

    Update comment and weblabels

commit 4a8378715c2e4e559731b319cac920c00cb32116
Author: Jakob L. Kreuze <zerodaysfordays@sdf.org>
Date:   Sun Mar 12 08:37:40 2023 -0400

    Allow for more emojis

commit 655f40bb267cc6df82356a0422146e555b94cf99
Author: Jakob L. Kreuze <zerodaysfordays@sdf.org>
Date:   Sat Mar 11 19:35:05 2023 -0500

    Rate limit `put-reaction'

commit 6463a9f09032f22c8e39ccea757b8a7054f199ba
Author: Jakob L. Kreuze <zerodaysfordays@sdf.org>
Date:   Sat Mar 11 19:33:53 2023 -0500

    Guard against non-emoji reactions

commit 32e642f3789d163fae18824ec04e7e833713b26c
Author: Jakob L. Kreuze <zerodaysfordays@sdf.org>
Date:   Sat Mar 11 19:32:05 2023 -0500

    Reaction UI

commit 4d07077daedc30271be69c86c855795affdea860
Author: Jakob L. Kreuze <zerodaysfordays@sdf.org>
Date:   Sat Mar 11 16:51:46 2023 -0500

    Address parsing issues in `put-reaction' endpoint

8 files changed, 188 insertions, 9 deletions

diff --git a/haunt/api.scm b/haunt/api.scm
index 810b905..1cf2b44 100644
--- a/haunt/api.scm
+++ b/haunt/api.scm
@@ -73,6 +73,7 @@
              ('(GET "challenge" "captcha") make-captcha-challenge!)
              ('(GET "comments") get-comments)
              (('POST "comment") put-comment)
+             (('POST "comment" "react") put-reaction)
              (('GET "gallery") get-gallery)
              (('GET "gallery" "image") get-image)
              (('GET "rsvp" "event-info") get-event-info)
diff --git a/haunt/jakob/builder/blog.scm b/haunt/jakob/builder/blog.scm
index de1c788..3285a51 100644
--- a/haunt/jakob/builder/blog.scm
+++ b/haunt/jakob/builder/blog.scm
@@ -89,6 +89,7 @@
        (input (@ (name "source") (type "url")))
        (input (@ (value "Send Webmention") (type "submit"))))
       ,(script "section-folds.js")
+      ,(script "comment-reaction.js")
       ;; ,(script "webmention.js")
       )))
 
diff --git a/haunt/jakob/dynamic/capabilities/comments.scm b/haunt/jakob/dynamic/capabilities/comments.scm
index 98560b0..996c549 100644
--- a/haunt/jakob/dynamic/capabilities/comments.scm
+++ b/haunt/jakob/dynamic/capabilities/comments.scm
@@ -188,16 +188,14 @@ This is a wrapper around `get-comments-by-slug'."
   (define (valid-reaction? form-data)
     (and (assoc "id" form-data)
          (assoc "reaction" form-data)))
-  (let* ((query-string (uri-query (request-uri request)))
-         (form-data (if query-string
-                        (decode-form query-string)
-                        '())))
+  (let ((form-data (decode-form body)))
     (unless (assoc "id" form-data)       (panic "missing param `id'"))
     (unless (assoc "reaction" form-data) (panic "missing param `reaction'"))
-    (let ((id (assoc-value form-data "id"))
-          (reaction (assoc-value form-data "reaction"))
-          (reactions (comment-reactions id)))
-      (unless reactions (panic "no such comment"))
+    (let* ((id (assoc-value form-data "id"))
+           (reaction (assoc-value form-data "reaction"))
+           (reactions (comment-reactions id)))
+      (unless id (panic "no such comment"))
+      (unless (emoji? reaction) (panic "invalid reaction"))
       (set-reactions id (add-reaction reactions reaction))
       (values '((content-type . (application/json)))
               (scm->json-string `((success . #t)))))))
diff --git a/haunt/jakob/dynamic/rate-limiter.scm b/haunt/jakob/dynamic/rate-limiter.scm
index 36450f9..24239f6 100644
--- a/haunt/jakob/dynamic/rate-limiter.scm
+++ b/haunt/jakob/dynamic/rate-limiter.scm
@@ -37,6 +37,7 @@
 
 (define (rate-limit-for-endpoint name)
   (case name
+    ((put-reaction)   1)
     ((get-event-rsvp) 1)
     ((get-event-info) 8)
     ((get-image)      8)
diff --git a/haunt/jakob/dynamic/util.scm b/haunt/jakob/dynamic/util.scm
index a7fd38d..f6f0382 100644
--- a/haunt/jakob/dynamic/util.scm
+++ b/haunt/jakob/dynamic/util.scm
@@ -26,7 +26,8 @@
             base64-length
             decode-form
             date<?
-            hash-append!))
+            hash-append!
+            emoji?))
 
 (define (assoc-value alist key)
   "Return the `car' of `(assoc alist key)' if truthy"
@@ -82,3 +83,30 @@ If KEY does not exist in TABLE, initialize kEY to (list ITEM)"
   (if (hash-ref table key)
       (hash-set! table key (cons item (hash-ref table key)))
       (hash-set! table key (list item))))
+
+(define (emoji? str)
+  "Determine if `str' is an 'acceptable' emoji character
+
+Acceptable is the following subset:
+
+- The 'Emoticons' block
+- The 'Supplemental Symbols and Pictographs' block, excluding U+1F900
+  through U+1F90B
+- The hand symbols from the 'Miscellaneous Symbols and Pictographs'
+  block
+- The hand symbols from the 'Dingbats' block
+- U+1F37B and U+1F440
+
+Notably, U+1F946 isn't normally treated an emoji, but it is here. I
+think it should be! As an American, I should be able to use pictographs
+to express my God-given constitutional rights!"
+  (and (string? str)
+       (= 1 (string-length str))
+       (let ((codepoint (char->integer
+                         (first (string->list str)))))
+         (or (<= #x1F600 codepoint #x1F64F)
+             (<= #x1F90C codepoint #x1F9FF)
+             (<= #x1F446 codepoint #x1F450)
+             (<= #x270A codepoint #x270D)
+             (= codepoint #x1F37B)
+             (= codepoint #x1F440)))))
diff --git a/haunt/pages/weblabels.sxml b/haunt/pages/weblabels.sxml
index c90b620..d498025 100644
--- a/haunt/pages/weblabels.sxml
+++ b/haunt/pages/weblabels.sxml
@@ -42,6 +42,12 @@
                               `(p "GNU General Public License 3.0 or later")))
               (td ,(hyperlink "/static/js/webmention.js"
                               `(p "/static/js/webmention.js"))))
+          (tr (td ,(hyperlink "/static/js/comment-reactions.js"
+                              `(p "/static/js/comment-reactions.js")))
+              (td ,(hyperlink "http://www.gnu.org/licenses/gpl-3.0.html"
+                              `(p "GNU General Public License 3.0 or later")))
+              (td ,(hyperlink "/static/js/comment-reactions.js"
+                              `(p "/static/js/comment-reactions.js"))))
           (tr (td ,(hyperlink "/static/js/section-folds.js"
                               `(p "/static/js/section-folds.js")))
               (td ,(hyperlink "http://www.gnu.org/licenses/gpl-3.0.html"
diff --git a/haunt/static/css/style.css b/haunt/static/css/style.css
index b48108b..2672f7c 100644
--- a/haunt/static/css/style.css
+++ b/haunt/static/css/style.css
@@ -233,6 +233,21 @@ ul.webmention-container .comment .comment-source-identifier {
     max-width: 16px;
 }
 
+/* Widget for comment reactions. */
+
+.emoji-picker {
+    width: 16em;
+    height: 2.75em;
+    border: solid 1px;
+    overflow: scroll;
+}
+
+.emoji-picker > span {
+    margin: 2px;
+    font-size: 2em;
+}
+
+
 /* Webmention form. */
 
 #webmention-form form {
diff --git a/haunt/static/js/comment-reaction.js b/haunt/static/js/comment-reaction.js
new file mode 100644
index 0000000..db980b3
--- /dev/null
+++ b/haunt/static/js/comment-reaction.js
@@ -0,0 +1,129 @@
+/*
+ * comment-reaction.js -- Simple emoji picker and glue for reaction endpoint
+ * Copyright © 2023 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License as
+ * published by the Free Software Foundation; either version 3 of the
+ * License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program. If not, see
+ * <http://www.gnu.org/licenses/>.
+ */
+
+function encodeAsFormData(obj) {
+  // Turn the data object into an array of URL-encoded key/value pairs.
+  let urlEncodedDataPairs = [];
+  for (let key in obj) {
+    urlEncodedDataPairs.push(encodeURIComponent(key) + '=' + encodeURIComponent(obj[key]));
+  }
+  return urlEncodedDataPairs.join('&');
+}
+
+function postReaction(reaction, callback) {
+  let xhr = new XMLHttpRequest();
+  xhr.open('POST', "/api/comment/react", true);
+
+  // Endpoint expects HTML form data.
+  xhr.setRequestHeader('Content-type', 'application/x-www-form-urlencoded');
+
+  xhr.onload = function(data) {
+    switch (xhr.status) {
+    case 200:
+      callback();
+      break;
+    case 429:
+      alert("Failed -- you can react at most once an hour.");
+      break;
+    default:
+      let resp = JSON.parse(xhr.response);
+      alert("Failed -- " + resp.error);
+      break;
+    }
+  }
+  xhr.onerror = function(error) {
+    throw new Error(`Request failed: ${error}`);
+  }
+
+  xhr.send(encodeAsFormData(reaction));
+}
+
+
+// Simple Emoji picker widget.
+function selectorWidget() {
+  function emojiButton(codepoint) {
+    let span = document.createElement("span");
+    span.innerHTML = String.fromCodePoint(codepoint);
+    return span;
+  }
+
+  let selector = document.createElement("div");
+  selector.setAttribute("class", "emoji-picker");
+
+  for (let i = 0x1F600; i < 0x1F64F; i++) {
+    selector.appendChild(emojiButton(i));
+  }
+  selector.appendChild(emojiButton(0x1F37B));
+  selector.appendChild(emojiButton(0x1F440));
+  selector.appendChild(emojiButton(0x1F446));
+  selector.appendChild(emojiButton(0x1F447));
+  selector.appendChild(emojiButton(0x1F448));
+  selector.appendChild(emojiButton(0x1F449));
+  selector.appendChild(emojiButton(0x1F450));
+  selector.appendChild(emojiButton(0x270A));
+  selector.appendChild(emojiButton(0x270B));
+  selector.appendChild(emojiButton(0x270C));
+  selector.appendChild(emojiButton(0x270D));
+  for (let i = 0x1F90C; i < 0x1F9FF; i++) {
+    selector.appendChild(emojiButton(i));
+  }
+  return selector;
+}
+
+// Add a "react" button to every local comment.
+window.addEventListener("load", () => {
+  // First pass to add a separator for the buttons.
+  let replyButtons = document.querySelectorAll(".comment-reply-button");
+  for (let button of replyButtons) {
+    let parent = button.parentNode;
+    parent.innerHTML += " - ";
+
+  }
+
+  // Second pass to add the actual "react" button.
+  replyButtons = document.querySelectorAll(".comment-reply-button");
+  for (let button of replyButtons) {
+    let reactButton = document.createElement("a");
+    reactButton.setAttribute("class", "comment-react-button");
+    reactButton.setAttribute("href", "#");
+    reactButton.setAttribute("data-react-to-id", button.getAttribute("data-reply-to-id"));
+    reactButton.innerHTML = "react";
+    button.parentNode.appendChild(reactButton);
+
+    reactButton.addEventListener('click', (e) => {
+      let emojiPicker = selectorWidget();
+      button.parentNode.parentNode.insertBefore(emojiPicker, button.parentNode);
+      for (let button of emojiPicker.children) {
+        button.addEventListener('click', (e) => {
+          postReaction({
+            "id": reactButton.getAttribute("data-react-to-id"),
+            "reaction": button.innerHTML
+          }, () => {
+            let reactAcknowledgement = document.createElement("span");
+            reactAcknowledgement.innerHTML = "successfully reacted!"
+            reactButton.replaceWith(reactAcknowledgement);
+          });
+          emojiPicker.remove();
+        });
+      }
+
+      e.preventDefault();
+    });
+  }
+});