[dynamic] Re-implement gallery using SSR

7 files changed, 45 insertions, 177 deletions

diff --git a/haunt/api.scm b/haunt/api.scm
index 1cf2b44..3ae6748 100644
--- a/haunt/api.scm
+++ b/haunt/api.scm
@@ -74,10 +74,9 @@
              ('(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)
              (('POST "rsvp") post-event-rsvp)
+             (('GET  "apps" "gallery")                   get-gallery)
              (_ (lambda (. args) (not-found request)))))
           request body))))))
 
diff --git a/haunt/jakob/dynamic/capabilities/common.scm b/haunt/jakob/dynamic/capabilities/common.scm
index 4f6d3d9..0e7d7b8 100644
--- a/haunt/jakob/dynamic/capabilities/common.scm
+++ b/haunt/jakob/dynamic/capabilities/common.scm
@@ -1,3 +1,19 @@
+;;; Copyright © 2019 - 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/>.
+
 (define-module (jakob dynamic capabilities common)
   #:use-module (jakob dynamic util)
   #:use-module (json)
diff --git a/haunt/jakob/dynamic/capabilities/gallery.scm b/haunt/jakob/dynamic/capabilities/gallery.scm
index f0c5b66..591335e 100644
--- a/haunt/jakob/dynamic/capabilities/gallery.scm
+++ b/haunt/jakob/dynamic/capabilities/gallery.scm
@@ -15,15 +15,15 @@
 ;;; <http://www.gnu.org/licenses/>.
 
 (define-module (jakob dynamic capabilities gallery)
-  #:use-module (ice-9 binary-ports)
-  #:use-module (ice-9 ftw)
+  #:use-module (haunt html)
   #:use-module (ice-9 match)
   #:use-module (jakob dynamic database)
   #:use-module (jakob dynamic errors)
   #:use-module (jakob dynamic util)
-  #:use-module (json)
+  #:use-module (jakob theme)
   #:use-module (squee)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
   #:use-module (web request)
   #:use-module (web response)
   #:use-module (web uri)
@@ -45,61 +45,35 @@
          (exec-query conn "SELECT * FROM images WHERE vanity = $1"
                      (list code))))))
 
-(define (get-gallery-images code)
-  "Handler for enumerating the image in a gallery."
-  (define (format-image image)
-    (match image
-      ((title filename thumbnail datetime)
-       `((title . ,title)
-         (filename . ,filename)
-         (thumbnail . ,thumbnail)
-         (datetime . ,datetime)))))
-  (let* ((images (exec-query conn "SELECT title, filename, thumb_filename, datetime FROM images WHERE vanity = $1" (list code))))
-    (list->vector (map format-image images))))
-
-(define (get-gallery-info code)
-  "Handler for enumerating the image in a gallery."
-  (define (format-gallery info)
-    (match info
-      ((title description datetime)
-       `((title . ,title)
-         (description . ,description)
-         (datetime . ,datetime)))))
-  (let* ((info (exec-query conn "SELECT title, description, datetime FROM galleries WHERE vanity = $1" (list code))))
-    (format-gallery (car info))))
+(define (render-gallery code)
+  (define info
+    (first
+     (exec-query conn "SELECT title, description, datetime FROM galleries WHERE vanity = $1" (list code))))
+  (define images
+    (exec-query conn "SELECT title, filename, thumb_filename, datetime FROM images WHERE vanity = $1" (list code)))
+  (match info
+    ((title description datetime)
+     `(div (@ (id "gallery-container"))
+           (h1 ,title)
+           (h3 ,description)
+           ,(map (lambda (image)
+                   (match image
+                     ((title filename thumbnail datetime)
+                      `(a (@ (href ,(format #f "/static-ext/~a" filename)))
+                          (img (@ (src ,(format #f "/static-ext/~a" thumbnail))
+                                  (alt ,title)
+                                  (title ,(format #f "~a - ~a" title datetime))))))))
+                 images)))))
 
 (define (get-gallery request body)
   (let* ((query-string (uri-query (request-uri request)))
          (params (if query-string
                      (decode-form query-string)
                      '()))
-         (code (car (assoc-ref params "g"))))
+         (code (if (assoc-ref params "g")
+                   (car (assoc-ref params "g"))
+                   (panic "no gallery code provided"))))
     (unless (valid-gallery-code code) (panic "invalid gallery code"))
-    (values '((content-type . (application/json)))
-            (scm->json-string `((info . ,(get-gallery-info code))
-                                (images . ,(get-gallery-images code)))))))
-
-(define (image-exists? file-name)
-  (define (string/= a b) (not (string= a b)))
-  (and (string/= file-name ".")
-       (string/= file-name "..")
-       (member file-name (scandir (%gallery-image-directory)))))
-
-(define (read-image file-name)
-  (let* ((ext (string-downcase (last (string-split file-name #\.))))
-         (mime (cond ((string= ext "jpg") 'image/jpeg)
-                     ((string= ext "png") 'image/png)
-                     (else (error "Unknown MIME type.")))))
-    (values `((content-type . (,mime)))
-            (call-with-input-file (format #f "~a/~a" (%gallery-image-directory) file-name)
-              (lambda (port)
-                (get-bytevector-all port))))))
-
-(define (get-image request body)
-  (let* ((query-string (uri-query (request-uri request)))
-         (params (if query-string
-                     (decode-form query-string)
-                     '()))
-         (file-name (car (assoc-ref params "name"))))
-    (unless (image-exists? file-name) (panic "invalid filename"))
-    (read-image file-name)))
+    (values '((content-type . (text/html)))
+              (sxml->html-string
+               (theme #:title "Photo Gallery" #:content (render-gallery code))))))
diff --git a/haunt/pages/gallery.sxml b/haunt/pages/gallery.sxml
deleted file mode 100644
index f01dda0..0000000
--- a/haunt/pages/gallery.sxml
+++ /dev/null
@@ -1,12 +0,0 @@
-(use-modules (jakob theme)
-             (jakob utils sxml))
-
-(theme
- #:title "Photo Gallery"
- #:content
- `((div (@ (id "gallery-container"))
-        (div (@ (id "loading"))
-             ,(image "hourglass.gif")
-             (p "Loading..."))
-        (div (@ (id "event-info"))))
-   ,(script "gallery.js")))
diff --git a/haunt/pages/rsvp.sxml b/haunt/pages/rsvp.sxml
deleted file mode 100644
index 617350f..0000000
--- a/haunt/pages/rsvp.sxml
+++ /dev/null
@@ -1,37 +0,0 @@
-(use-modules (jakob theme)
-             (jakob utils sxml))
-
-(theme
- #:title "You've Been Invited to an Event!"
- #:content
- `((div (@ (id "rsvp"))
-        (div (@ (id "loading"))
-             ,(image "hourglass.gif")
-             (p "Loading..."))
-        (div (@ (id "event-info")))
-        (form (@ (id "rsvp-input") (hidden #t))
-              (fieldset
-               (legend "Your Info")
-               (label (@ (for "name")) "Name:")
-               (input (@ (type "text") (id "name") (name "name") (required #t) (size 24)))
-               (label (@ (for "email")) "Email:")
-               (input (@ (type "text") (id "email") (name "email") (required #t) (size 24))))
-              (fieldset
-               (legend "RSVP Status")
-               (input (@ (type "radio") (id "attending") (name "rsvp")))
-               (label (@ (for "attending")) "Attending")
-               (input (@ (type "radio") (id "tentative") (name "rsvp")))
-               (label (@ (for "tentative")) "Tentative")
-               (input (@ (type "radio") (id "not-attending") (name "rsvp")))
-               (label (@ (for "not-attending")) "Not Attending"))
-              (fieldset
-               (legend "Guests")
-               (div (@ (id "guest-view")))
-               (input (@ (type "button") (id "add-entry") (value "+")))
-               (input (@ (type "button") (id "remove-entry") (value "-"))))
-              (fieldset
-               (legend "All Set?")
-               (input (@ (type "button") (id "submit-form") (value "Submit")))))
-        (div (@ (id "rsvp-global"))))
-   
-   ,(script "rsvp.js")))
diff --git a/haunt/pages/weblabels.sxml b/haunt/pages/weblabels.sxml
index d498025..b57d0e1 100644
--- a/haunt/pages/weblabels.sxml
+++ b/haunt/pages/weblabels.sxml
@@ -60,12 +60,6 @@
                               `(p "GNU General Public License 3.0 or later")))
               (td ,(hyperlink "/static/js/rsvp.js"
                               `(p "/static/js/rsvp.js"))))
-          (tr (td ,(hyperlink "/static/js/gallery.js"
-                              `(p "/static/js/gallery.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/gallery.js"
-                              `(p "/static/js/gallery.js"))))
           (tr (td ,(hyperlink "/static/js/oneko.js"
                               `(p "/static/js/oneko.js")))
               (td ,(hyperlink "http://www.jclark.com/xml/copying.txt"
diff --git a/haunt/static/js/gallery.js b/haunt/static/js/gallery.js
deleted file mode 100644
index 038340c..0000000
--- a/haunt/static/js/gallery.js
+++ /dev/null
@@ -1,66 +0,0 @@
-/*
- * gallery.js -- Simple web-based gallery viewer.
- * Copyright © 2022 - 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/>.
- */
-
-// Immediately send off an XHR to load info from the backend.
-const urlParams = new URLSearchParams(window.location.search);
-if (!urlParams.get("g")) {
-  document.getElementById("loading").remove();
-  let elem = document.createElement("p");
-  elem.innerHTML = "No gallery code provided.";
-  document.getElementById("gallery-container").appendChild(elem);
-} else {
-  let xhr = new XMLHttpRequest();
-  xhr.open("GET", `${location.protocol}//${location.host}/api/gallery?g=${urlParams.get("g")}`);
-  xhr.send();
-  xhr.onload = function(data) {
-    document.getElementById("loading").remove();
-    if (xhr.status != 200) {
-      let elem = document.createElement("p");
-      elem.innerHTML = "Invalid gallery code.";
-      document.getElementById("gallery-container").appendChild(elem);
-    } else {
-      let response = JSON.parse(xhr.response);
-
-      let elem = document.createElement("h1");
-      elem.innerHTML = response.info.title;
-      document.getElementById("gallery-container").appendChild(elem);
-
-      elem = document.createElement("h3");
-      elem.innerHTML = response.info.description;
-      document.getElementById("gallery-container").appendChild(elem);
-
-      let imagesContainer = document.createElement("div");
-      document.getElementById("gallery-container").appendChild(imagesContainer);
-
-      for (let image of response.images) {
-        elem = document.createElement("a");
-        elem.href = `${location.protocol}//${location.host}/static-ext/${image.filename}`;
-        let thumb = document.createElement("img");
-        thumb.src = `${location.protocol}//${location.host}/static-ext/${image.thumbnail}`;
-        thumb.alt = `${image.title}`;
-        thumb.title = `${image.title} - ${image.datetime}`;
-        elem.appendChild(thumb);
-        imagesContainer.appendChild(elem);
-      }
-    }
-  }
-  xhr.onerror = function(error) {
-    throw new Error(`Request failed: ${error}`);
-  }
-}