[dynamic] Move to `haunt' directory and `jakob' namespace

There will likely be some refactoring later as part of this change, since we can
unify the `util' namespaces.

20 files changed, 763 insertions, 45 deletions

diff --git a/.gitmodules b/.gitmodules
index 461dfa9..c94555d 100644
--- a/.gitmodules
+++ b/.gitmodules
@@ -1,3 +1,3 @@
 [submodule "ext-srfi-197"]
-	path = ext-srfi-197
+	path = haunt/ext-srfi-197
 	url = https://github.com/ar-nelson/srfi-197
diff --git a/ext-srfi-197 b/ext-srfi-197
deleted file mode 160000
-Subproject 78ced23a1af519ee2969939138b3ffff442f339
diff --git a/dynamic/api.scm b/haunt/api.scm
index 451c5c6..e9c5642 100644
--- a/dynamic/api.scm
+++ b/haunt/api.scm
@@ -14,16 +14,14 @@
 ;;; along with this program. If not, see
 ;;; <http://www.gnu.org/licenses/>.
 
-(use-modules (dynamic capabilities comment-form)
-             (dynamic capabilities comments)
-             (dynamic capabilities gallery)
-             (dynamic capabilities rsvp)
-             (dynamic logging)
+(use-modules (ice-9 match)
+             (jakob dynamic capabilities gallery)
+             (jakob dynamic capabilities rsvp)
+             (jakob dynamic logging)
              (srfi srfi-1)
-             (ice-9 match)
-             (web server)
              (web request)
              (web response)
+             (web server)
              (web uri))
 
 (define (not-found request)
@@ -39,15 +37,13 @@
         (args (uri-query (request-uri request))))
     (log-append! 'info (format #f "~a ~a (~a) (~a)" method endpoint args originating-ip)))
   ((match (cons (request-method request) endpoint)
-     ('(GET  "dynamic" "comment-form") get-comment-form)
-     ('(GET "challenge") make-challenge)
-     ('(GET  "api" "comments") get-comments)
-     ('(POST "api" "comment") put-comment)
-     ('(POST "api" "react") put-reaction)
-     ('(GET  "api" "gallery") get-gallery)
-     ('(GET  "api" "gallery" "image") get-image)
-     ('(GET  "api" "rsvp" "event-info") get-event-info)
-     ('(POST "api" "rsvp") post-event-rsvp)
+     ;; ('(GET "challenge") make-challenge)
+     ;; ('(GET "comments") get-comments)
+     ;; ('(POST "comment") put-comment)
+     ('(GET "gallery") get-gallery)
+     ('(GET "gallery" "image") get-image)
+     ('(GET "rsvp" "event-info") get-event-info)
+     ('(POST "rsvp") post-event-rsvp)
      (_ (lambda (. args) (not-found request))))
    request body))
 
@@ -70,11 +66,9 @@
   (let* ((path-encoded (uri-path (request-uri request)))
          (path (split-and-decode-uri-path path-encoded)))
     (define-values (response resp-body)
-      (if (or (string= "api" (first path))
-              (string= "dynamic" (first path)))
-          ;; (handle-api-request request body (drop path 1))
-          (handle-api-request request body path)
+      (if (string= "api" (first path))
+          (handle-api-request request body (drop path 1))
           (not-found request)))
     (values (wrap-response response) resp-body)))
 
-(run-server main-request-handler 'http `(#:addr ,INADDR_ANY #:port 8080))
+(run-server main-request-handler)
diff --git a/dynamic/README.md b/haunt/jakob/dynamic/README.md
index 0f64827..0f64827 100644
--- a/dynamic/README.md
+++ b/haunt/jakob/dynamic/README.md
diff --git a/haunt/jakob/dynamic/base64.scm b/haunt/jakob/dynamic/base64.scm
new file mode 100644
index 0000000..149f7ba
--- /dev/null
+++ b/haunt/jakob/dynamic/base64.scm
@@ -0,0 +1,353 @@
+;; -*- mode: scheme; coding: utf-8 -*-
+;;
+;; This module was renamed from (weinholt text base64 (1 0 20100612)) to
+;; (guix base64) by Nikita Karetnikov <nikita@karetnikov.org> on
+;; February 12, 2014.  It was later renamed to (gcrypt base64) by
+;; Christopher Allan Webber <cwebber@dustycloud.org> on May 20, 2017.
+;;
+;; Some optimizations made by Ludovic Courtès <ludo@gnu.org>, 2015.
+;; Turned into a Guile module (instead of R6RS).
+;;
+;; 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/>.
+;;
+;; This file incorporates work covered by the following copyright and
+;; permission notice:
+;;
+;;   Copyright © 2009, 2010, 2012, 2013, 2018 Göran Weinholt <goran@weinholt.se>
+;;
+;;   Permission is hereby granted, free of charge, to any person obtaining a
+;;   copy of this software and associated documentation files (the "Software"),
+;;   to deal in the Software without restriction, including without limitation
+;;   the rights to use, copy, modify, merge, publish, distribute, sublicense,
+;;   and/or sell copies of the Software, and to permit persons to whom the
+;;   Software is furnished to do so, subject to the following conditions:
+;;
+;;   The above copyright notice and this permission notice shall be included in
+;;   all copies or substantial portions of the Software.
+;;
+;;   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;;   IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;;   FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
+;;   THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+;;   LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+;;   FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;   DEALINGS IN THE SOFTWARE.
+
+;; RFC 4648 Base-N Encodings
+
+(define-module (base64)
+  #:export (base64-encode
+            base64-decode
+            base64-alphabet
+            base64url-alphabet
+            get-delimited-base64
+            put-delimited-base64)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-60)
+  #:use-module (rnrs bytevectors)
+  #:use-module (rnrs io ports))
+
+
+(define-syntax define-alias
+  (syntax-rules ()
+    ((_ new old)
+     (define-syntax new (identifier-syntax old)))))
+
+;; Force the use of Guile's own primitives to avoid the overhead of its 'fx'
+;; procedures.
+
+(define-alias fxbit-field bit-field)
+(define-alias fxarithmetic-shift ash)
+(define-alias fxarithmetic-shift-left ash)
+(define-alias fxand logand)
+(define-alias fxior logior)
+(define-alias fxxor logxor)
+(define-alias fx=? =)
+(define-alias fx<=? <=)
+(define-alias fxzero? zero?)
+(define-alias fx+ +)
+(define-alias fx- -)
+(define-alias fxmod modulo)
+(define-alias mod modulo)
+
+(define-syntax-rule (assert exp)
+  (unless exp
+    (throw 'assertion-failure 'exp)))
+
+(define base64-alphabet
+  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
+
+(define base64url-alphabet
+  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
+
+(define base64-encode
+  (case-lambda
+    ;; Simple interface. Returns a string containing the canonical
+    ;; base64 representation of the given bytevector.
+    ((bv)
+     (base64-encode bv 0 (bytevector-length bv) #f #f base64-alphabet #f))
+    ((bv start)
+     (base64-encode bv start (bytevector-length bv) #f #f base64-alphabet #f))
+    ((bv start end)
+     (base64-encode bv start end #f #f base64-alphabet #f))
+    ((bv start end line-length)
+     (base64-encode bv start end line-length #f base64-alphabet #f))
+    ((bv start end line-length no-padding)
+     (base64-encode bv start end line-length no-padding base64-alphabet #f))
+    ((bv start end line-length no-padding alphabet)
+     (base64-encode bv start end line-length no-padding alphabet #f))
+    ;; Base64 encodes the bytes [start,end[ in the given bytevector.
+    ;; Lines are limited to line-length characters (unless #f),
+    ;; which must be a multiple of four. To omit the padding
+    ;; characters (#\=) set no-padding to a true value. If port is
+    ;; #f, returns a string.
+    ((bv start end line-length no-padding alphabet port)
+     (assert (or (not line-length) (zero? (mod line-length 4))))
+     (let-values (((p extract) (if port
+                                   (values port (lambda () (values)))
+                                   (open-string-output-port))))
+       (letrec ((put (if line-length
+                         (let ((chars 0))
+                           (lambda (p c)
+                             (when (fx=? chars line-length)
+                               (set! chars 0)
+                               (put-char p #\linefeed))
+                             (set! chars (fx+ chars 1))
+                             (put-char p c)))
+                         put-char)))
+         (let lp ((i start))
+           (cond ((= i end))
+                 ((<= (+ i 3) end)
+                  (let ((x (bytevector-uint-ref bv i (endianness big) 3)))
+                    (put p (string-ref alphabet (fxbit-field x 18 24)))
+                    (put p (string-ref alphabet (fxbit-field x 12 18)))
+                    (put p (string-ref alphabet (fxbit-field x 6 12)))
+                    (put p (string-ref alphabet (fxbit-field x 0 6)))
+                    (lp (+ i 3))))
+                 ((<= (+ i 2) end)
+                  (let ((x (fxarithmetic-shift-left (bytevector-u16-ref bv i (endianness big)) 8)))
+                    (put p (string-ref alphabet (fxbit-field x 18 24)))
+                    (put p (string-ref alphabet (fxbit-field x 12 18)))
+                    (put p (string-ref alphabet (fxbit-field x 6 12)))
+                    (unless no-padding
+                      (put p #\=))))
+                 (else
+                  (let ((x (fxarithmetic-shift-left (bytevector-u8-ref bv i) 16)))
+                    (put p (string-ref alphabet (fxbit-field x 18 24)))
+                    (put p (string-ref alphabet (fxbit-field x 12 18)))
+                    (unless no-padding
+                      (put p #\=)
+                      (put p #\=)))))))
+       (extract)))))
+
+;; Create a lookup table for the alphabet and remember the latest table.
+(define get-decode-table
+  (let ((ascii-table #f)
+        (extra-table '())     ;in the unlikely case of unicode chars
+        (table-alphabet #f))
+    (lambda (alphabet)
+      (unless (eq? alphabet table-alphabet)
+        ;; Rebuild the table.
+        (do ((ascii (make-vector 128 #f))
+             (extra '())
+             (i 0 (+ i 1)))
+            ((= i (string-length alphabet))
+             (set! ascii-table ascii)
+             (set! extra-table extra))
+          (let ((c (char->integer (string-ref alphabet i))))
+            (if (fx<=? c 127)
+                (vector-set! ascii c i)
+                (set! extra (cons (cons c i) extra)))))
+        (set! table-alphabet alphabet))
+      (values ascii-table extra-table))))
+
+;; Decodes a base64 string, optionally ignoring non-alphabet
+;; characters and lack of padding.
+(define base64-decode
+  (case-lambda
+    ((str)
+     (base64-decode str base64-alphabet #f))
+    ((str alphabet)
+     (base64-decode str alphabet #f))
+    ((str alphabet port)
+     (base64-decode str alphabet port #t))
+    ((str alphabet port strict?)
+     (base64-decode str alphabet port strict? #t))
+    ((str alphabet port strict? strict-padding?)
+     (define (pad? c) (eqv? c (char->integer #\=)))
+     (let-values (((p extract) (if port
+                                   (values port (lambda () (values)))
+                                   (open-bytevector-output-port)))
+                  ((ascii extra) (get-decode-table alphabet)))
+       (define-syntax lookup
+         (syntax-rules ()
+           ((_ c) (or (and (fx<=? c 127) (vector-ref ascii c))
+                      (cond ((assv c extra) => cdr)
+                            (else #f))))))
+       (let lp-restart ((str str))
+         (let* ((len (if strict?
+                         (string-length str)
+                         (let lp ((i (fx- (string-length str) 1)))
+                           ;; Skip trailing invalid chars.
+                           (cond ((fxzero? i) 0)
+                                 ((let ((c (char->integer (string-ref str i))))
+                                    (or (lookup c) (pad? c)))
+                                  (fx+ i 1))
+                                 (else (lp (fx- i 1))))))))
+           (let lp ((i 0))
+             (cond
+              ((fx=? i len)
+               (extract))
+              ((fx<=? i (fx- len 4))
+               (let lp* ((c1 (char->integer (string-ref str i)))
+                         (c2 (char->integer (string-ref str (fx+ i 1))))
+                         (c3 (char->integer (string-ref str (fx+ i 2))))
+                         (c4 (char->integer (string-ref str (fx+ i 3))))
+                         (i i))
+                 (let ((i1 (lookup c1)) (i2 (lookup c2))
+                       (i3 (lookup c3)) (i4 (lookup c4)))
+                   (cond
+                    ((and i1 i2 i3 i4)
+                     ;; All characters present and accounted for.
+                     ;; The most common case.
+                     (let ((x (fxior (fxarithmetic-shift-left i1 18)
+                                     (fxarithmetic-shift-left i2 12)
+                                     (fxarithmetic-shift-left i3 6)
+                                     i4)))
+                       (put-u8 p (fxbit-field x 16 24))
+                       (put-u8 p (fxbit-field x 8 16))
+                       (put-u8 p (fxbit-field x 0 8))
+                       (lp (fx+ i 4))))
+                    ((and i1 i2 i3 (pad? c4) (= i (- len 4)))
+                     ;; One padding character at the end of the input.
+                     (let ((x (fxior (fxarithmetic-shift-left i1 18)
+                                     (fxarithmetic-shift-left i2 12)
+                                     (fxarithmetic-shift-left i3 6))))
+                       (put-u8 p (fxbit-field x 16 24))
+                       (put-u8 p (fxbit-field x 8 16))
+                       (lp (fx+ i 4))))
+                    ((and i1 i2 (pad? c3) (pad? c4) (= i (- len 4)))
+                     ;; Two padding characters.
+                     (let ((x (fxior (fxarithmetic-shift-left i1 18)
+                                     (fxarithmetic-shift-left i2 12))))
+                       (put-u8 p (fxbit-field x 16 24))
+                       (lp (fx+ i 4))))
+                    ((not strict?)
+                     ;; Non-alphabet characters.
+                     (let lp ((i i) (c* '()) (n 4))
+                       (cond ((fxzero? n)
+                              ;; Found four valid characters.
+                              (lp* (cadddr c*) (caddr c*) (cadr c*) (car c*)
+                                   (fx- i 4)))
+                             ((fx=? i len)
+                              (error 'base64-decode
+                                     "Invalid input in non-strict mode."
+                                     i c*))
+                             (else
+                              ;; Gather alphabetic (or valid
+                              ;; padding) characters.
+                              (let ((c (char->integer (string-ref str i))))
+                                (cond ((or (lookup c)
+                                           (and (pad? c)
+                                                (fx<=? n 2)
+                                                (fx=? i (fx- len n))))
+                                       (lp (fx+ i 1) (cons c c*) (fx- n 1)))
+                                      (else
+                                       (lp (fx+ i 1) c* n))))))))
+                    (else
+                     (error 'base64-decode
+                            "Invalid input in strict mode."
+                            c1 c2 c3 c4))))))
+              ((not strict-padding?)
+               ;; Append an appropriate amount of padding after the
+               ;; remaining characters.
+               (if (<= 2 (- len i) 3)
+                   (lp-restart (string-append (substring str i (string-length str))
+                                              (if (= (- len i) 2) "==" "=")))
+                   (error 'base64-decode "The input is too short." i)))
+              (else
+               (error 'base64-decode
+                      "The input is too short, it may be missing padding."
+                      i))))))))))
+
+(define (get-line-comp f port)
+  (if (port-eof? port)
+      (eof-object)
+      (f (get-line port))))
+
+;; Reads the common -----BEGIN/END type----- delimited format from
+;; the given port. Returns two values: a string with the type and a
+;; bytevector containing the base64 decoded data. The second value
+;; is the eof object if there is an eof before the BEGIN delimiter.
+(define get-delimited-base64
+  (case-lambda
+    ((port)
+     (get-delimited-base64 port #t))
+    ((port strict)
+     (define (get-first-data-line port)
+       ;; Some MIME data has header fields in the same format as mail
+       ;; or http. These are ignored.
+       (let ((line (get-line-comp string-trim-both port)))
+         (cond ((eof-object? line) line)
+               ((string-index line #\:)
+                (let lp ()               ;read until empty line
+                  (let ((line (get-line-comp string-trim-both port)))
+                    (if (string=? line "")
+                        (get-line-comp string-trim-both port)
+                        (lp)))))
+               (else line))))
+     (let ((line (get-line-comp string-trim-both port)))
+       (cond ((eof-object? line)
+              (values "" (eof-object)))
+             ((string=? line "")
+              (get-delimited-base64 port))
+             ((and (string-prefix? "-----BEGIN " line)
+                   (string-suffix? "-----" line))
+              (let* ((type (substring line 11 (- (string-length line) 5)))
+                     (endline (string-append "-----END " type "-----")))
+                (let-values ([(outp extract) (open-bytevector-output-port)])
+                  (let lp ((previous "") (line (get-first-data-line port)))
+                    (cond ((eof-object? line)
+                           (error 'get-delimited-base64
+                                  "unexpected end of file"))
+                          ((string-prefix? "-" line)
+                           (unless (string=? line endline)
+                             (error 'get-delimited-base64
+                                    "bad end delimiter" type line))
+                           (values type (extract)))
+                          ((and (= (string-length line) 5)
+                                (string-prefix? "=" line))
+                           ;; Skip Radix-64 checksum
+                           (lp previous (get-line-comp string-trim-both port)))
+                          ((not (fxzero? (fxmod (fx+ (string-length previous)
+                                                     (string-length line))
+                                                4)))
+                           ;; OpenSSH outputs lines with a bad length
+                           (lp (string-append previous line)
+                               (get-line-comp string-trim-both port)))
+                          (else
+                           (base64-decode (string-append previous line) base64-alphabet outp)
+                           (lp "" (get-line-comp string-trim-both port))))))))
+             (else ;skip garbage (like in openssl x509 -in foo -text output).
+              (get-delimited-base64 port)))))))
+
+(define put-delimited-base64
+  (case-lambda
+    ((port type bv line-length)
+     (display (string-append "-----BEGIN " type "-----\n") port)
+     (base64-encode bv 0 (bytevector-length bv)
+                    line-length #f base64-alphabet port)
+     (display (string-append "\n-----END " type "-----\n") port))
+    ((port type bv)
+     (put-delimited-base64 port type bv 76))))
diff --git a/dynamic/capabilities/comment-form.scm b/haunt/jakob/dynamic/capabilities/comment-form.scm
index beded53..b435089 100644
--- a/dynamic/capabilities/comment-form.scm
+++ b/haunt/jakob/dynamic/capabilities/comment-form.scm
@@ -14,10 +14,10 @@
 ;;; along with this program. If not, see
 ;;; <http://www.gnu.org/licenses/>.
 
-(define-module (dynamic capabilities comment-form)
-  #:use-module (dynamic util)
+(define-module (jakob dynamic capabilities comment-form)
   #:use-module (haunt html)
   #:use-module (ice-9 match)
+  #:use-module (jakob dynamic util)
   #:use-module (jakob theme)
   #:use-module (json)
   #:use-module (web request)
diff --git a/dynamic/capabilities/comments.scm b/haunt/jakob/dynamic/capabilities/comments.scm
index 945e382..d4159fa 100644
--- a/dynamic/capabilities/comments.scm
+++ b/haunt/jakob/dynamic/capabilities/comments.scm
@@ -14,9 +14,9 @@
 ;;; along with this program. If not, see
 ;;; <http://www.gnu.org/licenses/>.
 
-(define-module (dynamic capabilities comments)
-  #:use-module (dynamic util)
+(define-module (jakob dynamic capabilities comments)
   #:use-module (ice-9 match)
+  #:use-module (jakob dynamic util)
   #:use-module (json)
   #:use-module (squee)
   #:use-module (web request)
@@ -35,17 +35,18 @@
 This interface exists for dynamically generating the comment view from Haunt."
   (define (format-comment comment)
     (match comment
-      ((id name subject email comment url reactions)
+      ((id name subject email comment url approved reactions)
        `((id . ,id)
          (name . ,name)
          (subject . ,subject)
          (email . ,email)
          (comment . ,comment)
          (url . ,url)
+         (publish-time . ,approved)
          (reactions . ,(if reactions
                            (with-input-from-string reactions read)
                            '()))))))
-  (let* ((query "SELECT id, name, subject, email, comment, url, reactions
+  (let* ((query "SELECT id, name, subject, email, comment, url, approved, reactions
                  FROM comments WHERE slug = $1 and approved IS NOT NULL")
          (result (exec-query conn query (list slug))))
     (map format-comment result)))
diff --git a/dynamic/capabilities/gallery.scm b/haunt/jakob/dynamic/capabilities/gallery.scm
index 1d63061..b8b46c9 100644
--- a/dynamic/capabilities/gallery.scm
+++ b/haunt/jakob/dynamic/capabilities/gallery.scm
@@ -14,11 +14,11 @@
 ;;; along with this program. If not, see
 ;;; <http://www.gnu.org/licenses/>.
 
-(define-module (dynamic capabilities gallery)
-  #:use-module (dynamic util)
+(define-module (jakob dynamic capabilities gallery)
   #:use-module (ice-9 binary-ports)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
+  #:use-module (jakob dynamic util)
   #:use-module (json)
   #:use-module (squee)
   #:use-module (srfi srfi-1)
diff --git a/dynamic/capabilities/rsvp.scm b/haunt/jakob/dynamic/capabilities/rsvp.scm
index 4ac2eff..c02b758 100644
--- a/dynamic/capabilities/rsvp.scm
+++ b/haunt/jakob/dynamic/capabilities/rsvp.scm
@@ -14,11 +14,11 @@
 ;;; along with this program. If not, see
 ;;; <http://www.gnu.org/licenses/>.
 
-(define-module (dynamic capabilities rsvp)
+(define-module (jakob dynamic capabilities rsvp)
   #:use-module (base64)
-  #:use-module (dynamic util)
   #:use-module (ice-9 binary-ports)
   #:use-module (ice-9 match)
+  #:use-module (jakob dynamic util)
   #:use-module (json)
   #:use-module (rnrs bytevectors)
   #:use-module (squee)
diff --git a/dynamic/captcha.scm b/haunt/jakob/dynamic/captcha.scm
index b095ebf..b095ebf 100644
--- a/dynamic/captcha.scm
+++ b/haunt/jakob/dynamic/captcha.scm
diff --git a/dynamic/import-images.sh b/haunt/jakob/dynamic/import-images.sh
index 23f6130..23f6130 100644
--- a/dynamic/import-images.sh
+++ b/haunt/jakob/dynamic/import-images.sh
diff --git a/dynamic/logging.scm b/haunt/jakob/dynamic/logging.scm
index dab2464..42b367d 100644
--- a/dynamic/logging.scm
+++ b/haunt/jakob/dynamic/logging.scm
@@ -14,7 +14,7 @@
 ;;; along with this program. If not, see
 ;;; <http://www.gnu.org/licenses/>.
 
-(define-module (dynamic logging)
+(define-module (jakob dynamic logging)
   #:use-module (ice-9 format)
   #:use-module (srfi srfi-19)
   #:export (log-append!))
diff --git a/dynamic/schema-comments.sql b/haunt/jakob/dynamic/schema-comments.sql
index b2cb652..b2cb652 100644
--- a/dynamic/schema-comments.sql
+++ b/haunt/jakob/dynamic/schema-comments.sql
diff --git a/dynamic/schema-gallery.sql b/haunt/jakob/dynamic/schema-gallery.sql
index bad4100..bad4100 100644
--- a/dynamic/schema-gallery.sql
+++ b/haunt/jakob/dynamic/schema-gallery.sql
diff --git a/dynamic/schema-rsvp.sql b/haunt/jakob/dynamic/schema-rsvp.sql
index 3e6a21f..3e6a21f 100644
--- a/dynamic/schema-rsvp.sql
+++ b/haunt/jakob/dynamic/schema-rsvp.sql
diff --git a/dynamic/util.scm b/haunt/jakob/dynamic/util.scm
index b2e7221..6cdb4e5 100644
--- a/dynamic/util.scm
+++ b/haunt/jakob/dynamic/util.scm
@@ -14,7 +14,7 @@
 ;;; along with this program. If not, see
 ;;; <http://www.gnu.org/licenses/>.
 
-(define-module (dynamic util)
+(define-module (jakob dynamic util)
   #:use-module (ice-9 match)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
diff --git a/haunt/jakob/utils/comments.scm b/haunt/jakob/utils/comments.scm
index 3f55345..45c97c5 100644
--- a/haunt/jakob/utils/comments.scm
+++ b/haunt/jakob/utils/comments.scm
@@ -16,8 +16,6 @@
 
 (define-module (jakob utils comments)
   #:use-module (commonmark)
-  ;; #:use-module (dynamic capabilities comments)
-  #:use-module (dynamic util)
   #:use-module (gcrypt base16)
   #:use-module (gcrypt hash)
   #:use-module (ice-9 receive)
@@ -26,6 +24,8 @@
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-43)
   #:use-module (srfi-197)
+  #:use-module (jakob dynamic capabilities comments)
+  #:use-module (jakob dynamic util)
   #:use-module (json)
   #:use-module (web client)
   #:use-module (web response)
@@ -64,7 +64,7 @@
   (let* ((author-name (assoc-ref comment 'name))
          (author-url (assoc-ref comment 'url))
          (author-photo (gravatar-url (assoc-ref comment 'email)))
-         (publish-datetime (assoc-ref comment 'published))
+         (publish-datetime (assoc-ref comment 'publish-time))
          (content-text (assoc-ref comment 'comment))
          (content-reactions (assoc-ref comment 'reactions)))
     `(li (@ (class "p-comment h-cite comment comment-source-internal"))
@@ -83,13 +83,11 @@
               ,@(chain content-text
                        (safe-markdown->sxml _)))
          (div (@ (class "metaline"))
-              (a (@ (class "u-url")
-                    (href ,author-url))
-                 (time (@ (class "dt-published")
-                          (datetime ,publish-datetime))
-                       ,(date->string
-                         (string->date publish-datetime "~Y~m~d~H~M~S")
-                         "~B ~e, ~Y at ~H:~M"))))
+              (time (@ (class "dt-published")
+                       (datetime ,publish-datetime))
+                    ,(date->string
+                      (string->date publish-datetime "~Y~m~d ~H~M~S.~N")
+                      "~B ~e, ~Y at ~H:~M")))
          (ul (@ (class "comment-reactions"))
              ,@(map (match-lambda
                       ((emote . count)
diff --git a/haunt/pages/about.sxml b/haunt/pages/about.sxml
index 56b6abf..d8b7f74 100644
--- a/haunt/pages/about.sxml
+++ b/haunt/pages/about.sxml
@@ -330,7 +330,7 @@ old."
 (theme
  #:title "About"
  #:content
-   (ul (@ (class "horizontal-list"))
+ `((ul (@ (class "horizontal-list"))
        (li "Email: " (strong "zerodaysfordays at ‌​‌‌‌​‌‌‍‌​‌‌​​​​‍‌​‌‌​​​‌‍‌‌​‌‌​​​‍‌​‌​‌​‌‌‍‌‌​‌‌‌‌‌‍‌​‌‌‌​​‌‍‌​‌​‌​‌​‍‌​‌‌‌‌​​‍‌​‌‌​‌​​‍‌​‌‌​‌‌​‍‌​‌‌​​​‌‍‌​‌‌‌​​​‍‌‌​‌‌‌‌‌‍‌​‌​‌‌​​‍‌​‌​‌‌‌‌‍‌​‌‌‌‌‌​‍‌​‌‌​​‌​‍‌‌​‌‌‌‌‌‍‌​‌‌​​‌​‍‌​‌‌‌​‌​sdf.org"))
        (li "XMPP: " (strong "jakob at ‌​‌‌‌​‌‌‍‌​‌‌​​​​‍‌​‌‌​​​‌‍‌‌​‌‌​​​‍‌​‌​‌​‌‌‍‌‌​‌‌‌‌‌‍‌​‌‌‌​​‌‍‌​‌​‌​‌​‍‌​‌‌‌‌​​‍‌​‌‌​‌​​‍‌​‌‌​‌‌​‍‌​‌‌​​​‌‍‌​‌‌‌​​​‍‌‌​‌‌‌‌‌‍‌​‌​‌‌​​‍‌​‌​‌‌‌‌‍‌​‌‌‌‌‌​‍‌​‌‌​​‌​‍‌‌​‌‌‌‌‌‍‌​‌‌​​‌​‍‌​‌‌‌​‌​xmpp.is"))
        (li "IRC: " (strong "tsarfox on irc.libera.chat.")))
diff --git a/haunt/squee.scm b/haunt/squee.scm
new file mode 100644
index 0000000..443fa09
--- /dev/null
+++ b/haunt/squee.scm
@@ -0,0 +1,372 @@
+;;; squee --- A guile interface to postgres via the ffi
+
+;; Copyright (C) 2015 Christopher Allan Webber <cwebber@dustycloud.org>
+
+;; This library is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Lesser General Public
+;; License as published by the Free Software Foundation; either
+;; version 3 of the License, or (at your option) any later version.
+;;
+;; This library 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
+;; Lesser General Public License for more details.
+;;
+;; You should have received a copy of the GNU Lesser General Public
+;; License along with this library; if not, write to the Free Software
+;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (squee)
+  #:use-module (system foreign)
+  #:use-module (rnrs enums)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
+  #:use-module (srfi srfi-26)
+  #:export (;; The important ones
+            connect-to-postgres-paramstring
+            exec-query
+            pg-conn-finish
+
+            ;; enums and indexes of enums
+            conn-status-enum conn-status-enum-index
+            polling-status-enum polling-status-index
+            exec-status-enum exec-status-enum-index
+            transaction-status-enum transaction-status-enum-index
+            verbosity-enum verbosity-enum-index
+            ping-enum ping-enum-index
+
+            ;; **repl and error messages only!**
+            enum-set-ref
+
+            ;; Connection stuff
+            <pg-conn> pg-conn? wrap-pg-conn unwrap-pg-conn
+
+            ;; @@: We don't export the result pointer though!
+            ;;   as this needs to be cleared to avoid memory
+            ;;   leaks...
+            ;;
+            ;;   We might provide a (exec-with-result-ptr)
+            ;;   that cleans up the result pointer after calling
+            ;;   some thunk though?
+            ;;
+            ;;   These are still useful for building your own
+            ;;   serializer though...
+            result-num-rows result-num-cols result-get-value
+            result-serializer-simple-list result-metadata))
+
+(define libpq (dynamic-link "libpq"))
+
+;; ---------------------
+;; Enums from libpq-fe.h
+;; ---------------------
+
+(define conn-status-enum
+  (make-enumeration
+   '(connection-ok
+     connection-bad
+     connection-started connection-made
+     connection-awaiting-response connection-auth-ok
+     connection-auth-ok connection-setenv
+     connection-ssl-startup
+     connection-needed)))
+
+(define conn-status-enum-index
+  (enum-set-indexer conn-status-enum))
+
+(define polling-status-enum
+  (make-enumeration
+   '(polling-failed
+     polling-reading
+     polling-writing
+     polling-ok
+     polling-active)))
+
+(define polling-status-enum-index
+  (enum-set-indexer polling-status-enum))
+
+(define exec-status-enum
+  (make-enumeration
+   '(empty-query
+     command-ok tuples-ok
+     copy-out copy-in
+     bad-response
+     nonfatal-error fatal-error
+     copy-both
+     single-tuple)))
+
+(define exec-status-enum-index
+  (enum-set-indexer exec-status-enum))
+
+(define transaction-status-enum
+  (make-enumeration
+   '(idle active intrans inerror unknown)))
+
+(define transaction-status-enum-index
+  (enum-set-indexer transaction-status-enum))
+
+(define verbosity-enum
+  (make-enumeration
+   '(terse default verbose)))
+
+(define verbosity-enum-index
+  (enum-set-indexer verbosity-enum))
+
+(define ping-enum
+  (make-enumeration
+   '(ok reject no-response no-attempt)))
+
+(define ping-enum-index
+  (enum-set-indexer ping-enum))
+
+(define-wrapped-pointer-type <pg-conn>
+  pg-conn?
+  wrap-pg-conn unwrap-pg-conn
+  (lambda (pg-conn port)
+    (format port "#<pg-conn ~x (~a)>"
+            (pointer-address (unwrap-pg-conn pg-conn))
+            (let ((status (pg-conn-status pg-conn)))
+              (cond ((eq? status (conn-status-enum-index 'connection-ok))
+                     "connected")
+                    ((eq? status (conn-status-enum-index 'connection-bad))
+                     (let ((conn-error (pg-conn-error-message pg-conn)))
+                       (if (equal? conn-error "")
+                           "disconnected"
+                           (format #f "disconnected, error: ~s" conn-error))))
+                    (#t
+                     (symbol->string
+                      (pg-conn-status-symbol pg-conn))))))))
+
+
+;; This one should NOT be exposed to the outside world!  We have our
+;; own result structure...
+
+(define-wrapped-pointer-type <result-ptr>
+  result-ptr?
+  wrap-result-ptr unwrap-result-ptr
+  (lambda (result-ptr port)
+    (format port "#<result-ptr ~x>"
+            (pointer-address (unwrap-result-ptr result-ptr)))))
+
+
+(define (enum-set-ref enum-set k)
+  "Take an ENUM-SET and get the item at position K
+
+This is O(n) but theoretically we don't use it much.
+Again, REPL only!"
+  (list-ref (enum-set->list enum-set) k))
+
+
+(define-syntax-rule (define-foreign-libpq name return_type func_name arg_types)
+  (define name
+    (pointer->procedure return_type
+                        (dynamic-func func_name libpq)
+                        arg_types)))
+
+
+(define-foreign-libpq %PQconnectdb '* "PQconnectdb" (list '*))
+(define-foreign-libpq %PQstatus int "PQstatus" (list '*))
+(define-foreign-libpq %PQerrorMessage '* "PQerrorMessage" (list '*))
+(define-foreign-libpq %PQfinish void "PQfinish" (list '*))
+(define-foreign-libpq %PQntuples int "PQntuples" (list '*))
+(define-foreign-libpq %PQnfields int "PQnfields" (list '*))
+
+
+(define-foreign-libpq %PQexec '* "PQexec" (list '* '*))
+(define-foreign-libpq %PQexecParams
+  '*  ;; Returns a PGresult
+  "PQexecParams"
+  (list '* ;; connection
+        '* ;; command, a string
+        int ;; number of parameters
+        '* ;; paramTypes, ok to leave NULL
+        '* ;; paramValues, here goes your actual parameters!
+        '* ;; paramLengths, ok to leave NULL
+        '* ;; paramFormats, ok to leave NULL
+        int)) ;; resultFormat... probably 0!
+
+(define-foreign-libpq %PQresultStatus int "PQresultStatus" (list '*))
+(define-foreign-libpq %PQresStatus '* "PQresStatus" (list int))
+(define-foreign-libpq %PQresultErrorMessage '* "PQresultErrorMessage" (list '*))
+(define-foreign-libpq %PQclear void "PQclear" (list '*))
+
+(define-foreign-libpq %PQcmdtuples '* "PQcmdTuples" (list '*))
+(define-foreign-libpq %PQntuples int "PQntuples" (list '*))
+(define-foreign-libpq %PQnfields int "PQnfields" (list '*))
+(define-foreign-libpq %PQgetisnull int "PQgetisnull" (list '* int int))
+(define-foreign-libpq %PQgetvalue '* "PQgetvalue" (list '* int int))
+
+
+;; Via mark_weaver.  Thanks Mark!
+;;
+;; So, apparently we can use a struct of strings just like an array
+;; of strings.  Because magic, and because Mark thinks the C standard
+;; allows it enough!
+
+(define (string-pointer-list->string-array ls)
+  "Take a list of strings, generate a C-compatible list of free strings"
+  (make-c-struct
+   (make-list (+ 1 (length ls)) '*)
+   (append ls (list %null-pointer))))
+
+(define (pg-conn-status pg-conn)
+  "Get the connection status from a postgres connection"
+  (%PQstatus (unwrap-pg-conn pg-conn)))
+
+(define (pg-conn-status-symbol pg-conn)
+  "Human readable version of the pg-conn status.
+
+Inefficient... don't use this in normal code... it's just for you and
+the REPL!  (Well, we do use it for errors, because those are
+comparatively \"rare\" so this is okay.)  Compare against the enum
+value of the symbol instead."
+  (let ((status (pg-conn-status pg-conn)))
+    (if (< status (length (enum-set->list conn-status-enum)))
+        (enum-set-ref conn-status-enum
+                (pg-conn-status pg-conn))
+        ;; Weird, this is bigger than our enum of statuses
+        (string->symbol
+         (format #f "unknown-status-~a" status)))))
+
+
+(define (pg-conn-error-message pg-conn)
+  "Get an error message for this connection"
+  (pointer->string (%PQerrorMessage (unwrap-pg-conn pg-conn))))
+
+
+(define (pg-conn-finish pg-conn)
+  "Close out a database connection.
+
+If the connection is already closed, this simply returns #f."
+  (if (eq? (pg-conn-status pg-conn)
+           (conn-status-enum-index 'connection-ok))
+      (begin
+        (%PQfinish (unwrap-pg-conn pg-conn))
+        #t)
+      #f))
+
+(define (connect-to-postgres-paramstring paramstring)
+  "Open a connection to the database via a parameter string"
+  (let* ((conn-pointer (%PQconnectdb (string->pointer paramstring)))
+         (pg-conn (wrap-pg-conn conn-pointer)))
+    (if (eq? conn-pointer %null-pointer)
+        (throw 'psql-connect-error
+               #f "Unable to establish connection"))
+    (let ((status (pg-conn-status pg-conn)))
+      (if (eq? status (conn-status-enum-index 'connection-ok))
+          pg-conn
+          (throw 'psql-connect-error
+                (enum-set-ref conn-status-enum status)
+                (pg-conn-error-message pg-conn))))))
+
+
+(define (result-num-rows result-ptr)
+  (%PQntuples (unwrap-result-ptr result-ptr)))
+
+(define (result-num-cols result-ptr)
+  (%PQnfields (unwrap-result-ptr result-ptr)))
+
+(define (result-get-value result-ptr row col)
+  (let ((res (unwrap-result-ptr result-ptr)))
+    (and (eqv? (%PQgetisnull res row col) 0)
+         (pointer->string
+          (%PQgetvalue res row col)))))
+
+
+;; @@: We ought to also have a vector version...
+;;     and other serializations...
+(define (result-serializer-simple-list result-ptr)
+  "Get a simple list of lists representing the result of the query"
+  (let ((rows-range (iota (result-num-rows result-ptr)))
+        (cols-range (iota (result-num-cols result-ptr))))
+    (map
+     (lambda (row-i)
+       (map
+        (lambda (col-i)
+          (result-get-value result-ptr row-i col-i))
+        cols-range))
+     rows-range)))
+
+;; TODO
+(define (result-metadata result-ptr)
+  #f)
+
+
+(define (result-ptr-clear result-ptr)
+  (%PQclear (unwrap-result-ptr result-ptr)))
+
+(define (result-error-message result-ptr)
+  (%PQresultErrorMessage (unwrap-result-ptr result-ptr)))
+
+
+(define* (exec-query pg-conn command #:optional (params '())
+                     #:key (serializer result-serializer-simple-list))
+  (let* ((param-pointers
+          (map (lambda (param)
+                 (if param
+                     (string->pointer param)
+                     %null-pointer))
+               params))
+         (command-pointer
+          (string->pointer command))
+         (param-array-pointer
+          (string-pointer-list->string-array param-pointers))
+         (result-ptr
+          (wrap-result-ptr
+           (if (null? params)
+               (%PQexec
+                (unwrap-pg-conn pg-conn)
+                command-pointer)
+               (%PQexecParams
+                (unwrap-pg-conn pg-conn)
+                command-pointer
+                (length params)
+                %null-pointer
+                param-array-pointer
+                %null-pointer %null-pointer 0)))))
+
+    ;; Protect the pointers, and thus the memory regions they point to
+    ;; from garbage collection, until %PQexecParams has returned
+    (identity param-pointers)
+    (identity command-pointer)
+    (identity param-array-pointer)
+
+    (if (eq? result-ptr %null-pointer)
+        ;; Presumably a database connection issue...
+        (throw 'psql-query-error
+               ;; See below for psql-query-error param definition
+               #f #f (pg-conn-error-message pg-conn)))
+
+    (let ((status (%PQresultStatus (unwrap-result-ptr result-ptr))))
+      (cond
+       ;; This is the kind of query that returns tuples
+       ((eq? status (exec-status-enum-index 'tuples-ok))
+        (let ((serialized-result (serializer result-ptr))
+              (metadata (result-metadata result-ptr)))
+          ;; Gotta clear the result to prevent memory leaks
+          (result-ptr-clear result-ptr)
+          (values serialized-result metadata)))
+
+       ;; This doesn't return tuples, eg it's a DELETE or something.
+       ((eq? status (exec-status-enum-index 'command-ok))
+        (let ((metadata (result-metadata result-ptr))
+              (rows (%PQcmdtuples (unwrap-result-ptr result-ptr))))
+          ;; Gotta clear the result to prevent memory leaks
+          (result-ptr-clear result-ptr)
+          ;; Return the number of affected rows.
+          (values (string->number
+                   (pointer->string rows)) metadata)))
+
+       ;; Uhoh, anything else is an error!
+       (#t
+        (let ((status-message (pointer->string (%PQresStatus status)))
+              (error-message (pointer->string
+                              (%PQresultErrorMessage (unwrap-result-ptr
+                                                      result-ptr)))))
+          (result-ptr-clear result-ptr)
+          (throw 'psql-query-error
+                 ;; @@: Do we need result-status?
+                 ;; (error-symbol result-status result-error-message)
+                 (enum-set-ref exec-status-enum status)
+                 status-message error-message)))))))
+
+;; (define conn (connect-to-postgres-paramstring "dbname=sandbox"))
diff --git a/srfi-197.scm b/haunt/srfi-197.scm
index 93fc0ab..93fc0ab 100644
--- a/srfi-197.scm
+++ b/haunt/srfi-197.scm