diff options
Diffstat (limited to 'haunt')
| -rw-r--r-- | haunt/api.scm | 2 | ||||
| -rw-r--r-- | haunt/jakob/dynamic/capabilities/rsvp-form.scm | 135 | ||||
| -rw-r--r-- | haunt/jakob/dynamic/capabilities/rsvp.scm | 19 | ||||
| -rw-r--r-- | haunt/static/js/rsvp-min.js | 49 |
4 files changed, 178 insertions, 27 deletions
diff --git a/haunt/api.scm b/haunt/api.scm index 1cf2b44..3d20280 100644 --- a/haunt/api.scm +++ b/haunt/api.scm @@ -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)))))) diff --git a/haunt/jakob/dynamic/capabilities/rsvp-form.scm b/haunt/jakob/dynamic/capabilities/rsvp-form.scm index 8c97c58..853fa60 100644 --- a/haunt/jakob/dynamic/capabilities/rsvp-form.scm +++ b/haunt/jakob/dynamic/capabilities/rsvp-form.scm @@ -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)))))))) diff --git a/haunt/jakob/dynamic/capabilities/rsvp.scm b/haunt/jakob/dynamic/capabilities/rsvp.scm index 86fc671..60625a0 100644 --- a/haunt/jakob/dynamic/capabilities/rsvp.scm +++ b/haunt/jakob/dynamic/capabilities/rsvp.scm @@ -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)))) '())))))) diff --git a/haunt/static/js/rsvp-min.js b/haunt/static/js/rsvp-min.js new file mode 100644 index 0000000..8c6d053 --- /dev/null +++ b/haunt/static/js/rsvp-min.js @@ -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(); +}); |