1 files changed, 79 insertions, 0 deletions
diff --git a/jakob/dynamic/capabilities/gallery.scm b/jakob/dynamic/capabilities/gallery.scm
new file mode 100644
index 0000000..7087149
--- /dev/null
+++ b/jakob/dynamic/capabilities/gallery.scm
@@ -0,0 +1,79 @@
+;;; Copyright © 2019 - 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/>.
+
+(define-module (jakob dynamic capabilities gallery)
+  #:use-module (haunt html)
+  #:use-module (ice-9 match)
+  #:use-module (jakob dynamic config)
+  #:use-module (jakob dynamic errors)
+  #:use-module (jakob dynamic util)
+  #:use-module (jakob theme)
+  #:use-module (squee)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (web request)
+  #:use-module (web response)
+  #:use-module (web uri)
+  #:export (get-gallery get-image))
+
+(define conn (connect-to-postgres-paramstring (paramstring-for-dbname "jakob_gallery")))
+
+;; How many bytes of entropy to use when generating vanity ID's.
+(define %vanity-length (make-parameter 9))
+
+;; Path where gallery images are stored.
+(define %gallery-image-directory (make-parameter "/home/jakob/gallery-images/"))
+
+(define (valid-gallery-code code)
+  "Check database to see if `code' names a nonempty gallery."
+  (and (= (string-length code) (base64-length (%vanity-length)))
+       (positive?
+        (length
+         (exec-query conn "SELECT * FROM images WHERE vanity = $1"
+                     (list code))))))
+
+(define (render-gallery code)
+  (define info
+    (first
+     (exec-query conn "SELECT title, description, datetime FROM galleries WHERE vanity = $1" (list code))))
+  (define images
+    (exec-query conn "SELECT title, filename, thumb_filename, datetime FROM images WHERE vanity = $1" (list code)))
+  (match info
+    ((title description datetime)
+     `(div (@ (id "gallery-container"))
+           (h1 ,title)
+           (h3 ,description)
+           ,(map (lambda (image)
+                   (match image
+                     ((title filename thumbnail datetime)
+                      `(a (@ (href ,(format #f "/static-ext/~a" filename)))
+                          (img (@ (src ,(format #f "/static-ext/~a" thumbnail))
+                                  (alt ,title)
+                                  (title ,(format #f "~a - ~a" title datetime))))))))
+                 images)))))
+
+(define (get-gallery request body)
+  (let* ((query-string (uri-query (request-uri request)))
+         (params (if query-string
+                     (decode-form query-string)
+                     '()))
+         (code (if (assoc-ref params "g")
+                   (car (assoc-ref params "g"))
+                   (panic "no gallery code provided"))))
+    (unless (valid-gallery-code code) (panic "invalid gallery code"))
+    (values '((content-type . (text/html)))
+              (sxml->html-string
+               (theme #:title "Photo Gallery" #:content (render-gallery code))))))