[scheme] Initial comments API

1 files changed, 113 insertions, 0 deletions

diff --git a/dynamic/api.scm b/dynamic/api.scm
new file mode 100644
index 0000000..463ceab
--- /dev/null
+++ b/dynamic/api.scm
@@ -0,0 +1,113 @@
+(use-modules (base64)
+             (captcha)
+             (json)
+             (srfi srfi-1)
+             (srfi srfi-11)
+             (srfi srfi-13)
+             (srfi srfi-26)
+             (rnrs bytevectors)
+             (ice-9 match)
+             (web server)
+             (web request)
+             (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"))
+
+;; Util.
+
+(define (acons-list k v alist)
+  "Add V to K to alist as list"
+  (let ((value (assoc-ref alist k)))
+    (if value
+        (let ((alist (alist-delete k alist)))
+          (acons k (cons v value) alist))
+        (acons k (list v) alist))))
+
+(define (list->alist lst)
+  "Build a alist of list based on a list of key and values.
+
+   Multiple values can be associated with the same key"
+  (let next ((lst lst)
+             (out '()))
+    (if (null? lst)
+        out
+        (next (cdr lst) (acons-list (caar lst) (cdar lst) out)))))
+
+(define (decode-form bv)
+  "Convert BV querystring or form data to an alist"
+  (define string (utf8->string bv))
+  (define pairs (map (cut string-split <> #\=)
+                     ;; semi-colon and amp can be used as pair separator
+                     (append-map (cut string-split <> #\;)
+                                 (string-split string #\&))))
+  (list->alist (map (match-lambda
+                      ((key value)
+                       (cons (uri-decode key) (uri-decode value)))) pairs)))
+
+(define (request-path-components request)
+  (split-and-decode-uri-path (uri-path (request-uri request))))
+
+(define (not-found request)
+  (values (build-response #:code 404)
+          (string-append "Resource not found: "
+                         (uri->string (request-uri request)))))
+
+;; 
+
+(define (get-comments request body)
+  (values '((content-type . (application/json)))
+          (scm->json-string
+           '((title . "whoa buddy")
+             (author . "Jakob Kreuze")
+             (date . "2022-03-27")
+             (text . "bad take, bad take!")))))
+
+(define (put-comment request body)
+  (display (decode-form body))
+  (newline)
+  (values '((content-type . (text/plain))) "Hello hacker!"))
+
+(define (make-challenge request body)
+  (let-values (((uuid value image) (new-captcha)))
+    (hash-set! challenges uuid value)
+    (hash-for-each (lambda (x y) (display x) (newline)) challenges)
+    (values `((content-type . (application/base64))
+              (access-control-allow-origin . "*")
+              (x-captcha-id . ,uuid))
+            (base64-encode image))))
+
+(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)
+     (_ (lambda (. args) (not-found request))))
+   request body))
+
+(define (main-request-handler request body)
+  (let ((path (request-path-components request)))
+    (if (string= "api" (first path))
+        (handle-api-request request body (drop path 1))
+        (not-found request))))
+
+(run-server main-request-handler 'http '(#:port 8081))