;;; Copyright © 2019 - 2023 Jakob L. Kreuze ;;; ;;; 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 ;;; . (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))))))