diff options
Diffstat (limited to 'haunt/jakob/dynamic/capabilities/comments.scm')
| -rw-r--r-- | haunt/jakob/dynamic/capabilities/comments.scm | 27 |
1 files changed, 18 insertions, 9 deletions
diff --git a/haunt/jakob/dynamic/capabilities/comments.scm b/haunt/jakob/dynamic/capabilities/comments.scm index 33f2429..ee2a52d 100644 --- a/haunt/jakob/dynamic/capabilities/comments.scm +++ b/haunt/jakob/dynamic/capabilities/comments.scm @@ -42,17 +42,21 @@ This interface exists for dynamically generating the comment view from Haunt." (define (make-internal-comment~ . args) - (let* ((args-needing-processing (take-right args 3)) + (let* ((args-needing-processing (take-right args 4)) (approved (list-ref args-needing-processing 0)) (approved (string->date approved "~Y~m~d ~H~M~S.~N")) (reactions (list-ref args-needing-processing 1)) (reactions (if reactions (with-input-from-string reactions read) '())) - (replies (list-ref args-needing-processing 2))) - + (originating-network (list-ref args-needing-processing 2)) + (replies (list-ref args-needing-processing 3))) (apply make-internal-comment - (append (drop-right args 3) (list approved reactions replies))))) + `(,@(drop-right args 4) + ,approved + ,reactions + ,replies + ,originating-network)))) (define (order-comments comments) (define seen (make-hash-table)) (define (id comment) (first comment)) @@ -78,7 +82,7 @@ This interface exists for dynamically generating the comment view from Haunt." (hash-append! seen 'terminal parsed)) (pass (cdr cur) initial-comments remaining))))) (pass comments comments '())) - (let* ((query "SELECT id, name, subject, email, comment, url, approved, reactions, reply_to + (let* ((query "SELECT id, name, subject, email, comment, url, approved, reactions, originating_network, reply_to FROM comments WHERE slug = $1 and approved IS NOT NULL") (result (exec-query conn query (list slug)))) (if (positive? (length result)) @@ -106,6 +110,10 @@ This is a wrapper around `get-comments-by-slug'." (define (put-comment request body) "API endpoint handler for submitting a comment" + (define (request-originating-network request) + (cond ((from-tor? request) "tor") + ((from-i2p? request) "i2p") + (else "clearnet"))) (define (valid-comment? form-data) (and (assoc "slug" form-data) (assoc "name" form-data) @@ -124,9 +132,9 @@ This is a wrapper around `get-comments-by-slug'." (string->number (assoc-value form-data "captcha-id")))))) (define (insert-comment form-data) (exec-query conn - "INSERT INTO comments (submitted, slug, name, subject, - email, url, comment, reply_to) - VALUES (now(), $1, $2, $3, $4, $5, $6, $7);" + "INSERT INTO comments (submitted, slug, name, subject, email, + url, comment, reply_to, originating_network) + VALUES (now(), $1, $2, $3, $4, $5, $6, $7, $8);" (list (assoc-value form-data "slug") (assoc-value form-data "name") (assoc-value form-data "subject") @@ -136,7 +144,8 @@ This is a wrapper around `get-comments-by-slug'." (if (and (assoc-value form-data "reply-to") (positive? (string-length (assoc-value form-data "reply-to")))) (assoc-value form-data "reply-to") - #f))) + #f) + (request-originating-network request))) (values (build-response #:code 307 #:headers '((Location . "https://jakob.space"))) |