diff options
Diffstat (limited to 'haunt/jakob/dynamic/capabilities/rsvp.scm')
| -rw-r--r-- | haunt/jakob/dynamic/capabilities/rsvp.scm | 43 |
1 files changed, 35 insertions, 8 deletions
diff --git a/haunt/jakob/dynamic/capabilities/rsvp.scm b/haunt/jakob/dynamic/capabilities/rsvp.scm index 2975e4d..86fc671 100644 --- a/haunt/jakob/dynamic/capabilities/rsvp.scm +++ b/haunt/jakob/dynamic/capabilities/rsvp.scm @@ -29,7 +29,10 @@ #:use-module (web request) #:use-module (web response) #:use-module (web uri) - #:export (get-event-info post-event-rsvp)) + #:export (event-info-internal + + get-event-info + post-event-rsvp)) ;; How many bytes of entropy to use when generating vanity ID's. (define %vanity-length (make-parameter 9)) @@ -186,15 +189,16 @@ It is a base64 string, encoding `%vanity-length' bytes of randomness." (lambda (port) (base64-encode (get-bytevector-all port))))) +(define (format-rsvp rsvp) + (match rsvp + ((name email attending guests) + `((name . ,name) + (email . ,email) + (attending . ,attending) + (guests . ,guests))))) + (define (get-event-invitation invitation-code) "Handler for reading information about an event." - (define (format-rsvp rsvp) - (match rsvp - ((name email attending guests) - `((name . ,name) - (email . ,email) - (attending . ,attending) - (guests . ,guests))))) (let* ((invitation (invitation->event-id invitation-code)) (capabilities (cadr invitation)) (event (exec-query conn "SELECT * FROM events WHERE id = $1" (list (car invitation)))) @@ -256,3 +260,26 @@ It is a base64 string, encoding `%vanity-length' bytes of randomness." ((and invitation-code (valid-invite-code (car invitation-code))) (get-event-invitation (car invitation-code))) (else (panic "invalid invitation or receipt code"))))) + +(define (event-info-internal invitation-code) + (unless (valid-invite-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)) + (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))))) + (match (car event) + ((i_ title description date location) + `((title . ,title) + (description . ,description) + (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)) + ,@(if (= 1 (logand (string->number capabilities) 1)) + `((rsvps . ,(list->vector (map format-rsvp rsvps)))) + '())))))) |