diff options
| -rw-r--r-- | dynamic/api.scm | 113 | ||||
| -rw-r--r-- | dynamic/captcha.scm | 107 | ||||
| -rw-r--r-- | haunt/jakob/builder/blog.scm | 31 | ||||
| -rw-r--r-- | haunt/static/js/local.js | 110 |
4 files changed, 361 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)) diff --git a/dynamic/captcha.scm b/dynamic/captcha.scm new file mode 100644 index 0000000..c4380fb --- /dev/null +++ b/dynamic/captcha.scm @@ -0,0 +1,107 @@ +(define-module (captcha) + #:use-module (ice-9 binary-ports) + #:use-module (ice-9 local-eval) + #:use-module (ice-9 match) + #:use-module (ice-9 popen) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 threads) + #:use-module (srfi srfi-1) + #:export (new-captcha)) + +(define proc-mutex (make-mutex)) + +(define (random-term) + (match (random 5) + (0 `(* ,(+ 1 (random 10)) x)) + (1 `(* ,(+ 1 (random 10)) (expt x ,(random 10)))) + (2 `(* ,(+ 1 (random 10)) (exp x))) + (3 `(* ,(+ 1 (random 10)) (cos x))) + (4 `(* ,(+ 1 (random 10)) (sin x))))) + +(define (sexp->latex sexp) + (match sexp + (('+ rest ...) (string-join (map sexp->latex rest) " + ")) + (('* rest ...) (string-join (map sexp->latex rest) " \\cdot ")) + (('sin term) (format #f "\\sin(~a)" (sexp->latex term))) + (('cos term) (format #f "\\cos(~a)" (sexp->latex term))) + (('expt term n) (format #f "~a^{~a}" (sexp->latex term) (sexp->latex n))) + (('exp term) (format #f "e^{~a}" (sexp->latex term))) + ('x "x") + (n (cond ((and (number? n) (positive? n)) (format #f "~a" n)) + ((and (number? n) (negative? n)) (format #f "(~a)" n)) + ((number? n) "0") + (else (error "Do not know how to convert to latex." n)))))) + +(define (differentiate-sexp sexp) + (match sexp + (('+ rest ...) `(+ ,@(map differentiate-sexp rest))) + (('* coeff term) (if (number? coeff) + `(* ,coeff ,(differentiate-sexp term)) + (error "Do not know how to differentiate."))) + (('sin term) `(* ,(differentiate-sexp term) (cos ,term))) + (('cos term) `(* -1 ,(differentiate-sexp term) (sin ,term))) + (('exp term) `(* ,(differentiate-sexp term) (exp ,term))) + (('expt term n) `(* ,n (expt ,term ,(- n 1)))) + ('x 1) + (n (if (number? n) + 0 + (error "Do not know how to differentiate."))))) + +(define (simplify-sexp sexp) + (match sexp + (('+ rest ...) `(+ ,@(map simplify-sexp rest))) + (('* 1 term) (simplify-sexp term)) + (('* 1 rest ...) (simplify-sexp `(* ,@rest))) + (('sin term) `(sin ,(simplify-sexp term))) + (('sin term) `(cos ,(simplify-sexp term))) + (('exp term) `(exp ,(simplify-sexp term))) + (('expt term 1) (simplify-sexp term)) + (('expt term n) `(expt ,(simplify-sexp term) ,(simplify-sexp n))) + (term term))) + +(define (random-expression) + (let ((n-terms (+ 2 (random 3)))) + `(+ ,@(map (lambda (x) (random-term)) (iota n-terms))))) + +(define (latex->image src) + (chdir "/tmp") + (with-mutex proc-mutex + (call-with-output-file "formula.tex" + (lambda (port) + (format port "\\def\\formula{~a} +\\documentclass[border=2pt]{standalone} +\\usepackage{amsmath} +\\usepackage{varwidth} +\\begin{document} +\\begin{varwidth}{\\linewidth} +\\[ \\formula \\] +\\end{varwidth} +\\end{document} +" src))) + (unless (eqv? 0 (status:exit-val (system "pdflatex formula.tex"))) + (error "Cannot generate PDF")) + (let* ((port (open-input-pipe "convert -density 300 formula.pdf -quality 90 png:-")) + (data (get-bytevector-all port))) + (unless (eqv? 0 (status:exit-val (close-pipe port))) + (error "Cannot generate PNG")) + data))) + +(define (new-uuid) + (with-mutex proc-mutex + (let* ((port (open-input-pipe "uuidgen")) + (str (read-line port))) + (close-pipe port) + str))) + +(define (new-captcha) + (let* ((lower-bound (random 10)) + (upper-bound (+ lower-bound 1 (random 9))) + (expression (random-expression)) + (latex-src (sexp->latex (simplify-sexp (differentiate-sexp expression))))) + (values (new-uuid) + (- (local-eval expression (let ((x upper-bound)) (the-environment))) + (local-eval expression (let ((x lower-bound)) (the-environment)))) + (latex->image (format #f "\\int_{~a}^{~a} ~a \\, dx" + lower-bound + upper-bound + latex-src))))) diff --git a/haunt/jakob/builder/blog.scm b/haunt/jakob/builder/blog.scm index 8f02a80..2e54998 100644 --- a/haunt/jakob/builder/blog.scm +++ b/haunt/jakob/builder/blog.scm @@ -80,6 +80,37 @@ ".")) (article ,(post-sxml post)) (section + (@ (id "comments")) + (h2 "Comments for this Page") + (ul (@ (id "comment-container"))) + (form + (@ (action "https://jakob.space/api/comment") + (method "post")) + (label (@ (for "name")) "Name:") + (br) + (input (@ (name "name") (id "name") (type "text"))) + (br) + (label (@ (for "email")) "Email (optional; only used for Gravatar):") + (br) + (input (@ (name "email") (id "email") (type "text"))) + (br) + (label (@ (for "url")) "Homepage (optional):") + (br) + (input (@ (name "url") (id "url") (type "text"))) + (br) + (label (@ (for "comment")) "Comment (Markdown supported):") + (br) + (textarea (@ (name "comment") (id "comment") (rows "4") (cols "50") (maxlength "1024"))) + (br) + (label (@ (for "captcha")) "Captcha: Please integrate the following definite integral.") + (br) + (img (@ (id "captcha") (alt "captcha-image"))) + (br) + (input (@ (name "captcha") (id "captcha") (type "text"))) + (br) + (input (@ (value "Submit") (type "submit")))) + ,(script "local.js")) + (section (@ (id "webmention")) (h2 ,(hyperlink "https://indieweb.org/Webmention" "Webmentions") " for this Page") diff --git a/haunt/static/js/local.js b/haunt/static/js/local.js new file mode 100644 index 0000000..51e0ea1 --- /dev/null +++ b/haunt/static/js/local.js @@ -0,0 +1,110 @@ +/* + * local.js -- Fetch and display local comments. + * Copyright © 2022 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/>. + */ + +function getData(url, callback) { + let xhr = new XMLHttpRequest(); + xhr.onload = function(data) { + callback(data); + } + xhr.onerror = function(error) { + throw new Error(`Request failed: ${error}`); + } +} + +function makeComment(comment) { + const strip = (uri) => { + const sep = "://"; + return uri.substring(uri.indexOf(sep) + sep.length); + }; + + const element = (type, attributes) => { + let res = document.createElement(type); + for (const attribute in attributes) { + res.setAttribute(attribute, attributes[attribute]); + } + return res; + }; + + // Create the h-card section. + let avatar = element("img", { + "class": "u-photo", + "src": `https://www.gravatar.com/avatar/${comment.iconHash}?s=200` + }); + + let authorName = element("a", { + "class": "p-name u-url", + "href": comment.authorUrl + }); + authorName.textContent = comment.authorName; + + let authorURI = element("a", { + "class": "author_url", + "href": comment.author.url + }); + authorURI.textContent = strip(comment.author.url); + + let hCardContainer = element("div", { + "class": "p-author h-card author" + }); + hCardContainer.appendChild(avatar); + hCardContainer.appendChild(authorName); + hCardContainer.appendChild(authorURI); + + // Create the content section. + let contentContainer = element("div", { + "class": "e-content p-name comment-content", + }); + + contentContainer.textContent = comment.content; + + // Create the metaline section. + let pubTime = comment.published; + let time = element("time", { + "class": "dt-published", + "datetime": pubTime, + }); + time.textContent = (new Date(pubTime)).toString(); + + let linkBack = element("a", { + "class": "u-url", + "href": comment.url + }); + linkBack.appendChild(time); + + let metalineContainer = element("div", { + "class": "metaline" + }); + metalineContainer.appendChild(linkBack); + + // Put it all together. + let wrapper = element("li", { + "class": "p-comment h-cite comment", + }); + wrapper.appendChild(hCardContainer); + wrapper.appendChild(contentContainer); + wrapper.appendChild(metalineContainer); + + return wrapper; +} + +getData("http://localhost:8081/api/challenge", (b64data) => { + console.log("Here2"); + document.getElementById("captcha").src = 'data:image/png;base64,' + b64data; +}); +console.log("Here1"); |