[scheme] Initial RSVP implementation

3 files changed, 115 insertions, 19 deletions

diff --git a/dynamic/api.scm b/dynamic/api.scm
index 463ceab..1bd3540 100644
--- a/dynamic/api.scm
+++ b/dynamic/api.scm
@@ -1,3 +1,5 @@
+(add-to-load-path (dirname (current-filename)))
+
 (use-modules (base64)
              (captcha)
              (json)
@@ -5,6 +7,7 @@
              (srfi srfi-11)
              (srfi srfi-13)
              (srfi srfi-26)
+             (squee)
              (rnrs bytevectors)
              (ice-9 match)
              (web server)
@@ -12,24 +15,11 @@
              (web response)
              (web uri))
 
-;; Data model for comments:
-;; CREATE TABLE comments(
-;;     id SERIAL PRIMARY KEY,
-;;     approved TIMESTAMP,
-;;     submitted TIMESTAMP NOT NULL,
-;;     slug VARCHAR(100) NOT NULL,
-;;     name VARCHAR(50) NOT NULL,
-;;     email VARCHAR(100),
-;;     url VARCHAR(100),
-;;     comment VARCHAR(1024) NOT NULL
-;; );
-
-;; Use `now' for `submitted'.
-
 ;; Globals.
 
 (define challenges (make-hash-table))
-;; (define conn (connect-to-postgres-paramstring "dbname=jakob-comments"))
+;; (define conn (connect-to-postgres-paramstring "dbname=jakob_comments"))
+(define conn (connect-to-postgres-paramstring "dbname=jakob_rsvp"))
 
 ;; Util.
 
@@ -53,7 +43,7 @@
 
 (define (decode-form bv)
   "Convert BV querystring or form data to an alist"
-  (define string (utf8->string bv))
+  (define string (if (string? bv) bv (utf8->string bv)))
   (define pairs (map (cut string-split <> #\=)
                      ;; semi-colon and amp can be used as pair separator
                      (append-map (cut string-split <> #\;)
@@ -94,13 +84,74 @@
               (x-captcha-id . ,uuid))
             (base64-encode image))))
 
+(define (valid-invite-code invitation)
+  (and (= (string-length))))
+
+(define (post-event-rsvp request body)
+  (let* ((params (json-string->scm (utf8->string body)))
+         (invitation-code (assoc-ref params "id"))
+         (name (assoc-ref params "name"))
+         (email (assoc-ref params "email"))
+         (guests (assoc-ref params "guests")))
+    (cond ((not (and invitation-code name email guests))
+           (values (build-response #:code 400 #:headers '((Access-Control-Allow-Origin . "*")))
+                   (scm->json-string
+                    `((success . #f)
+                      (error . "Invalid form data")))))
+          ((> 1 (length (exec-query conn "SELECT event_id FROM invitations WHERE vanity = $1" (list invitation-code))))
+           (values (build-response #:code 400 #:headers '((Access-Control-Allow-Origin . "*")))
+                   (scm->json-string
+                    `((success . #f)
+                      (error . "Invalid invitation code")))))
+          (else
+           (let* ((event-id (caar (exec-query conn "SELECT event_id FROM invitations WHERE vanity = $1" (list invitation-code)))))
+             (exec-query conn "INSERT INTO rsvps (event_id, fullname, email, guests) VALUES ($1, $2, $3, $4)" (list event-id name email guests))
+             (values '((content-type . (application/json))
+                       (Access-Control-Allow-Origin . "*"))
+                     (scm->json-string
+                      `((success . #t)))))))))
+
+(define (get-event-info request body)
+  (define (format-rsvp rsvp)
+    (match rsvp
+      ((name email guests)
+       `((name . ,name)
+         (email . ,email)
+         (guests . ,guests)))))
+  (let* ((params (decode-form (uri-query (request-uri request))))
+         (invitation-code (car (assoc-ref params "i")))
+         (invitation (exec-query conn "SELECT event_id, capabilities FROM invitations WHERE vanity = $1" (list invitation-code))))
+    (if (> 1 (length invitation))
+        (values (build-response #:code 400 #:headers '((Access-Control-Allow-Origin . "*")))
+                (scm->json-string
+                 `((success . #f)
+                   (error . "Invalid invitation code"))))
+        (let* ((capabilities (cadar invitation))
+               (event (exec-query conn "SELECT * FROM events WHERE id = $1" (list (caar invitation))))
+               (rsvps (exec-query conn "SELECT fullname, email, guests FROM rsvps WHERE event_id = $1" (list (caar invitation)))))
+          (match (car event)
+            ((i_ title description date location)
+             (values '((content-type . (application/json))
+                       (Access-Control-Allow-Origin . "*"))
+                     (scm->json-string
+                      `((title . ,title)
+                        (description . ,description)
+                        (image . #f)
+                        (date . ,date)
+                        (location . ,location)
+                        ,@(if (= 1 (logand (string->number capabilities) 1))
+                              `((rsvps . ,(list->vector (map format-rsvp rsvps))))
+                              '()))))))))))
+
 (define (handle-api-request request body endpoint)
   (display (cons (request-method request) endpoint))
   (newline)
   ((match (cons (request-method request) endpoint)
-     ('(GET "challenge") make-challenge)
-     ('(GET "comments") get-comments)
-     ('(POST "comment") put-comment)
+     ;; ('(GET "challenge") make-challenge)
+     ;; ('(GET "comments") get-comments)
+     ;; ('(POST "comment") put-comment)
+     ('(GET "rsvp" "event-info") get-event-info)
+     ('(POST "rsvp") post-event-rsvp)
      (_ (lambda (. args) (not-found request))))
    request body))
 
diff --git a/dynamic/schema-comments.sql b/dynamic/schema-comments.sql
new file mode 100644
index 0000000..1c690f3
--- /dev/null
+++ b/dynamic/schema-comments.sql
@@ -0,0 +1,12 @@
+CREATE TABLE comments(
+    id SERIAL PRIMARY KEY,
+    approved TIMESTAMP,
+    submitted TIMESTAMP NOT NULL,
+    slug VARCHAR(100) NOT NULL,
+    name VARCHAR(50) NOT NULL,
+    email VARCHAR(100),
+    url VARCHAR(100),
+    comment VARCHAR(1024) NOT NULL
+);
+
+-- Use `now' for `submitted'.
diff --git a/dynamic/schema-rsvp.sql b/dynamic/schema-rsvp.sql
new file mode 100644
index 0000000..42c8c41
--- /dev/null
+++ b/dynamic/schema-rsvp.sql
@@ -0,0 +1,33 @@
+CREATE TABLE IF NOT EXISTS events (
+  id SERIAL,
+  title varchar(128) NOT NULL,
+  description varchar(16384) NOT NULL,
+  datetime timestamp with time zone NOT NULL,
+  location varchar(128) NOT NULL,
+  PRIMARY KEY (id)
+);
+
+CREATE TABLE IF NOT EXISTS invitations (
+  id SERIAL,
+  vanity char(12) NOT NULL,
+  comments varchar(1024) NOT NULL,
+  created_on timestamp with time zone default current_timestamp,
+  capabilities bigint NOT NULL,
+  event_id integer NOT NULL,
+  PRIMARY KEY (id)
+);
+
+CREATE TABLE IF NOT EXISTS rsvps (
+  id SERIAL,
+  vanity char(12) NOT NULL,
+  event_id bigint NOT NULL,
+  fullname varchar(128) NOT NULL,
+  email varchar(256) NOT NULL,
+  guests varchar(1024) NOT NULL,
+  attending varchar(32) NOT NULL,
+  PRIMARY KEY (id)
+);
+
+-- `rsvps` contains the bare minimum. If we later decide we need additional
+-- fields, we'll have an additional table mapping events.id to attribute names
+-- and rsvps.id to attribute values.