diff options
Diffstat (limited to 'dynamic')
| -rw-r--r-- | dynamic/api.scm | 113 | ||||
| -rw-r--r-- | dynamic/captcha.scm | 107 |
2 files changed, 220 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))))) |