;;; 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 comment-form) #:use-module (gcrypt base64) #:use-module (haunt html) #:use-module (ice-9 match) #:use-module (jakob builder blog) #:use-module (jakob dynamic captcha) #:use-module (jakob dynamic util) #:use-module (jakob theme) #:use-module (jakob utils sxml) #:use-module (json) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (web request) #:use-module (web response) #:use-module (web uri) #:export (render-static-comment-form render-dynamic-comment-form get-comment-form)) (define (render-comment-field) `(fieldset (@ (id "comment-content")) (legend "Comment") (label (@ (for "name") (class "required")) "Name:") (input (@ (type "text") (id "name") (name "name") (required #t))) (label (@ (for "email")) "Email:") (input (@ (type "text") (id "email") (name "email"))) (label (@ (for "url")) "Webpage URL:") (input (@ (type "text") (id "url") (name "url"))) (label (@ (for "subject")) "Subject:") (input (@ (type "text") (id "subject") (name "subject"))) (label (@ (for "comment") (class "required")) "Comment :") (textarea (@ (id "coment") (name "comment"))) (p "(*) Indicates a required field."))) (define* (render-comment-captcha-field #:optional (captcha-id "") captcha-image #:key hidden) `(fieldset ,(if hidden '(@ (id "comment-captcha") (hidden "#t")) '(@ (id "comment-captcha"))) (legend "Captcha") (div (@ (id "captcha-challenge-primary")) (label (@ (for "captcha")) "Please evaluate the following definite integral:") (img (@ (id "captcha-image") (src ,(if captcha-image (format #f "data:image/jpeg;charset=utf-8;base64,~a" (base64-encode captcha-image)) "")))) (input (@ (type "text") (id "captcha") (name "captcha") (size 24)))) (button (@ (id "pow-trigger") (hidden #t)) "Too hard? (Or unable to see the challenge?) Click here.") (input (@ (autocomplete "off") (type "text") (id "captcha-id") (name "captcha-id") (hidden #t) (value ,captcha-id))) (input (@ (autocomplete "off") (type "text") (id "captcha-alt") (name "captcha-alt") (hidden #t))) (input (@ (autocomplete "off") (type "text") (id "captcha-alt-id") (name "captcha-alt-id") (hidden #t))) (input (@ (type "submit") (id "submit-form") (value "Submit"))))) (define (render-static-comment-form slug captcha-id captcha-image) `(div (@ (id "comment-form")) (h1 "Comment form") (form (@ (id "comment-input") (action "/api/comment") (method "post")) (input (@ (type "text") (name "slug") (hidden #t) (value ,slug))) ,(render-comment-field) ,(render-comment-captcha-field captcha-id captcha-image)) ,(script "proof-of-work.js"))) (define (render-dynamic-comment-form slug) `(div (@ (id "comment-form")) (h3 (@ (id "comment-form-header")) "Comment form") (form (@ (id "comment-input") (action "/api/comment") (method "post")) (input (@ (autocomplete "off") (type "text") (name "slug") (hidden #t) (value ,slug))) (input (@ (autocomplete "off") (type "text") (name "reply-to") (id "reply-to") (hidden #t) (value ""))) ,(render-comment-field) (fieldset (@ (id "captcha-trigger-block")) (legend "Captcha") (label "You need to complete a captcha to write a comment.") (button (@ (id "captcha-challenge-trigger")) "Click here to generate a captcha challenge")) ,(render-comment-captcha-field #:hidden #t)) ,(script "dynamic-comment-form.js") ,(script "proof-of-work.js"))) (define (get-comment-form request body) "API endpoint handler for querying for the comments on a particular post This is a wrapper around `get-comments-by-slug'." (let-values (((captcha-id captcha-image) (new-captcha!))) (let* ((path-encoded (uri-path (request-uri request))) (path (split-and-decode-uri-path path-encoded)) (slug (last path)) (form (render-static-comment-form slug captcha-id captcha-image))) (values '((content-type . (text/html))) (sxml->html-string (theme #:content form #:title "Comment prompt"))))))