~jakob/blog

05de590c934cae434c62d6f71605b7ce7d23348e — Jakob L. Kreuze 11 months ago f0e1a3a feature/static-rsvp-form
Finalize capability
M haunt/api.scm => haunt/api.scm +2 -0
@@ 21,6 21,7 @@
             (jakob dynamic capabilities comments)
             (jakob dynamic capabilities gallery)
             (jakob dynamic capabilities rsvp)
             (jakob dynamic capabilities rsvp-form)
             (jakob dynamic errors)
             (jakob dynamic logging)
             (jakob dynamic rate-limiter)


@@ 78,6 79,7 @@
             (('GET "gallery" "image") get-image)
             (('GET "rsvp" "event-info") get-event-info)
             (('POST "rsvp") post-event-rsvp)
             (('GET "event" _) get-rsvp-form)
             (_ (lambda (. args) (not-found request)))))
          request body))))))


M haunt/jakob/dynamic/capabilities/rsvp-form.scm => haunt/jakob/dynamic/capabilities/rsvp-form.scm +114 -21
@@ 15,27 15,28 @@
;;; <http://www.gnu.org/licenses/>.

(define-module (jakob dynamic capabilities rsvp-form)
  ;; #:use-module (gcrypt base64)
  #:use-module (haunt html)
  ;; #:use-module (ice-9 match)
  #:use-module (jakob dynamic capabilities rsvp)
  ;; #:use-module (jakob dynamic captcha)
  ;; #:use-module (jakob dynamic util)
  #:use-module (jakob dynamic util)
  #:use-module (jakob theme)
  #:use-module (jakob utils sxml)
  ;; #:use-module (json)
  #:use-module (json)
  #:use-module (rnrs bytevectors)
  #:use-module (srfi srfi-1)
  ;; #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-11)
  #:use-module (sxml simple)
  #:use-module (web request)
  ;; #:use-module (web response)
  #:use-module (web uri)
  #:export (get-rsvp-form))
  #:export (get-rsvp-form
            get-rsvp-edit-form
            post-rsvp-form
            post-rsvp-edit-form))

(define (event-name invitation-code)
  (let ((event-info (event-info-internal invitation-code)))
    (assoc-ref event-info 'title)))

(define (render-rsvp-form invitation-code)
(define* (render-rsvp-form invitation-code #:optional edit)
  (let ((event-info (event-info-internal invitation-code)))
    `((div (@ (id "rsvp"))
       (div (@ (id "event-info"))


@@ 46,31 47,86 @@
                        '()))
            (p ,(assoc-ref event-info 'location))
            (p ,(assoc-ref event-info 'date))
            (p ,(assoc-ref event-info 'description))
       (form (@ (id "rsvp-input"))
            ,@(drop (call-with-input-string (assoc-ref event-info 'description) xml->sxml) 1)
       (form (@ (id "rsvp-input")
                (method "post")
                (action ,(if edit
                             (format #f "/api/event/edit/~a" invitation-code)
                             (format #f "/api/event/~a" invitation-code))))
        (fieldset
         ,@(if edit
               `((input (@ (hidden #t) (name "update") (value ,invitation-code))))
               `((input (@ (hidden #t) (name "id") (value ,invitation-code)))))
         (legend "Your Info")
         (label (@ (for "name")) "Name:")
         (input (@ (type "text") (id "name") (name "name") (required #t) (size 24)))
         (input (@ (type "text")
                   (id "name")
                   (name "name")
                   (value ,(if (and edit (assoc-ref event-info 'name))
                               (assoc-ref event-info 'name)
                               ""))
                   (required #t)
                   (size 24)))
         (label (@ (for "email")) "Email:")
         (input (@ (type "text") (id "email") (name "email") (required #t) (size 24))))
         (input (@ (type "text")
                   (id "email")
                   (name "email")
                   (value ,(if (and edit (assoc-ref event-info 'email))
                               (assoc-ref event-info 'email)
                               ""))
                   (required #t)
                   (size 24))))
        (fieldset
         (legend "RSVP Status")
         (input (@ (type "radio") (id "attending") (name "rsvp")))
         (input (@ (type "radio")
                   (id "attending")
                   (name "rsvp")
                   (value "attending")
                   ,@(if (and edit
                              (assoc-ref event-info 'attending)
                              (string= "attending" (assoc-ref event-info 'attending)))
                         '((checked #t))
                         '())))
         (label (@ (for "attending")) "Attending")
         (input (@ (type "radio") (id "tentative") (name "rsvp")))
         (input (@ (type "radio")
                   (id "tentative")
                   (name "rsvp")
                   (value "tentative")
                   ,@(if (and edit
                              (assoc-ref event-info 'attending)
                              (string= "tentative" (assoc-ref event-info 'attending)))
                         '((checked #t))
                         '())))
         (label (@ (for "tentative")) "Tentative")
         (input (@ (type "radio") (id "not-attending") (name "rsvp")))
         (input (@ (type "radio")
                   (id "not-attending")
                   (name "rsvp")
                   (value "not-attending")
                   ,@(if (and edit
                              (assoc-ref event-info 'attending)
                              (string= "not-attending" (assoc-ref event-info 'attending)))
                         '((checked #t))
                         '())))
         (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 "-"))))
         (div (@ (id "guest-view"))
          (input (@ (type "text") (id "guest-list") (name "guests"))))
         (input (@ (type "button") (id "add-entry") (value "+") (hidden #t)))
         (input (@ (type "button") (id "remove-entry") (value "-") (hidden #t))))
        (fieldset
         (legend "All Set?")
         (input (@ (type "button") (id "submit-form") (value "Submit")))))
       (div (@ (id "rsvp-global"))))))))
         (input (@ (type "submit") (id "submit-form") (value "Submit")))))
       ,(script "rsvp-min.js"))))))

(define* (render-receipt params)
  (let ((receipt-url (format #f "https://jakob.space/api/event/edit/~a"
                             (assoc-ref params "receipt"))))
    `((div (@ (id "rsvp"))
       (p "Thanks for registering! Please bookmark or save the following link: "
          ,(hyperlink receipt-url receipt-url)
          ".")
       (p "This will enable you to edit your RSVP later.")))))

(define (get-rsvp-form request body)
  ;; TODO


@@ 83,3 139,40 @@
             (theme
              #:title (format #f "You've Been Invited to ~a!" (event-name invitation-code))
              #:content form)))))

(define (get-rsvp-edit-form request body)
  ;; TODO
  (let* ((path-encoded (uri-path (request-uri request)))
         (path (split-and-decode-uri-path path-encoded))
         (invitation-code (last path))
         (form (render-rsvp-form invitation-code #t)))
    (values '((content-type . (text/html)))
            (sxml->html-string
             (theme
              #:title (format #f "Edit Your Invitation to ~a" (event-name invitation-code))
              #:content form)))))

(define (formdata->alist params)
  (map (lambda (pair)
         (cons (car pair) (cadr pair)))
       params))

(define (post-rsvp-form request body)
  ;; TODO
  (let* ((params (formdata->alist (decode-form (utf8->string body)))))
    (let-values (((_ json) (create-new-event-rsvp params)))
      (values '((content-type . (text/html)))
              (sxml->html-string
               (theme
                #:title (format #f "Thank you!")
                #:content (render-receipt (json-string->scm json))))))))

(define (post-rsvp-edit-form request body)
  ;; TODO
  (let* ((params (formdata->alist (decode-form (utf8->string body)))))
    (let-values (((_ json) (update-event-rsvp params)))
      (values '((content-type . (text/html)))
              (sxml->html-string
               (theme
                #:title (format #f "Thank you!")
                #:content (render-receipt (json-string->scm json))))))))

M haunt/jakob/dynamic/capabilities/rsvp.scm => haunt/jakob/dynamic/capabilities/rsvp.scm +13 -6
@@ 30,6 30,8 @@
  #:use-module (web response)
  #:use-module (web uri)
  #:export (event-info-internal
            create-new-event-rsvp
            update-event-rsvp

            get-event-info
            post-event-rsvp))


@@ 262,10 264,15 @@ It is a base64 string, encoding `%vanity-length' bytes of randomness."
          (else (panic "invalid invitation or receipt code")))))

(define (event-info-internal invitation-code)
  (unless (valid-invite-code invitation-code)
  (unless (or (valid-invite-code invitation-code)
              (valid-receipt-code invitation-code))
    (panic "invalid invite or receipt code"))
  (let* ((rsvp (exec-query conn "SELECT invitation_id, fullname, email, attending, guests FROM rsvps WHERE vanity = $1" (list invitation-code)))
         (invitation (invitation->event-id invitation-code))
         ;; If `invitation-code' specifies a valid receipt, use it as such.
         ;; Otherwise, treat it as an invitation code.
         (invitation (invitation->event-id (if (positive? (length rsvp))
                                               (caar rsvp)
                                               invitation-code)))
         (capabilities (cadr invitation))
         (event (exec-query conn "SELECT * FROM events WHERE id = $1" (list (car invitation))))
         (rsvps (exec-query conn "SELECT fullname, email, attending, guests FROM rsvps WHERE event_id = $1" (list (car invitation)))))


@@ 276,10 283,10 @@ It is a base64 string, encoding `%vanity-length' bytes of randomness."
         (image . ,(get-event-image (car invitation)))
         (date . ,date)
         (location . ,location)
         (name . ,(list-ref (car rsvp) 1))
         (email . ,(list-ref (car rsvp) 2))
         (attending . ,(list-ref (car rsvp) 3))
         (guests . ,(list-ref (car rsvp) 4))
         (name . ,(and (positive? (length rsvp)) (list-ref (car rsvp) 1)))
         (email . ,(and (positive? (length rsvp)) (list-ref (car rsvp) 2)))
         (attending . ,(and (positive? (length rsvp)) (list-ref (car rsvp) 3)))
         (guests . ,(and (positive? (length rsvp)) (list-ref (car rsvp) 4)))
         ,@(if (= 1 (logand (string->number capabilities) 1))
               `((rsvps . ,(list->vector (map format-rsvp rsvps))))
               '()))))))

A haunt/static/js/rsvp-min.js => haunt/static/js/rsvp-min.js +49 -0
@@ 0,0 1,49 @@
/*
 * rsvp-min.js -- UX improvements for static RSVP form page.
 * 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/>.
 */

// Common nodes.
const guestView = document.getElementById("guest-view");
const guestList = document.getElementById("guest-list");
const addEntryButton = document.getElementById("add-entry");
const removeEntryButton = document.getElementById("remove-entry");

// Enable visual elements.
guestList.setAttribute("hidden", true);
addEntryButton.removeAttribute("hidden");
removeEntryButton.removeAttribute("hidden");

function updateGuestList() {
  guestList.value = guestView.childNodes.map((node) => node.value).join(",");
}

addEntry.addEventListener("click", () => {
  let i = guestView.childNodes.length;
  let elem = document.createElement("input");
  elem.type = "text";
  elem.name = `guest-${i}`;
  guestView.appendChild(elem);

  elem.addEventListener("input", updateGuestList);
});
removeEntry.addEventListener("click", () => {
  if (guestView.lastChild) {
    guestView.lastChild.remove();
  }
  updateGuestList();
});