From cb8c10825ba73153704f214be84b16494dab8d4b Mon Sep 17 00:00:00 2001 From: "Jakob L. Kreuze" Date: Mon, 2 Sep 2024 16:06:32 -0400 Subject: [dynamic] Add endpoint for fetching all comments --- api.scm | 6 ++- jakob/dynamic/capabilities/comment-form.scm | 3 -- jakob/dynamic/capabilities/comments.scm | 74 ++++++++++++++++++++--------- jakob/dynamic/capabilities/common.scm | 2 + 4 files changed, 57 insertions(+), 28 deletions(-) diff --git a/api.scm b/api.scm index e3b121d..43660eb 100644 --- a/api.scm +++ b/api.scm @@ -89,12 +89,13 @@ (apply values (guard (ex ((reportable-condition? ex) (values->list (format-error-response ex))) - ((equal? "application/json" (assoc-ref (request-headers request) 'accept)) + ((and (equal? "application/json" (assoc-ref (request-headers request) 'accept)) + (not (%debug-enabled))) (dump-error request body endpoint) (list (build-response #:code 500) (scm->json-string '((success . #f) (error . "Internal error."))))) - (#t + ((not (%debug-enabled)) (dump-error request body endpoint) (list (build-response #:code 500) "Internal server error."))) (fail-when-ip-blacklisted originating-ip) @@ -104,6 +105,7 @@ (('GET "apps" "comment-form" _) get-comment-form) ('(GET "api" "challenge" "proof-of-work") make-pow-challenge!) ('(GET "api" "challenge" "captcha") make-captcha-challenge!) + ('(GET "api" "all-comments") get-all-comments) ('(GET "api" "comments") get-comments) (('POST "api" "comment") put-comment) (('POST "api" "comment" "react") put-reaction) diff --git a/jakob/dynamic/capabilities/comment-form.scm b/jakob/dynamic/capabilities/comment-form.scm index 12a5f57..958e9dc 100644 --- a/jakob/dynamic/capabilities/comment-form.scm +++ b/jakob/dynamic/capabilities/comment-form.scm @@ -104,9 +104,6 @@ ,(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)) diff --git a/jakob/dynamic/capabilities/comments.scm b/jakob/dynamic/capabilities/comments.scm index fe355e2..7715174 100644 --- a/jakob/dynamic/capabilities/comments.scm +++ b/jakob/dynamic/capabilities/comments.scm @@ -34,34 +34,31 @@ #:use-module (web response) #:use-module (web uri) #:export (get-comments - get-comments-by-slug + get-all-comments put-comment put-reaction)) (define conn (connect-to-postgres-paramstring (paramstring-for-dbname "jakob_comments"))) -(define (get-comments-by-slug slug) - "Internal function for querying the approved comments on a post +(define (make-internal-comment~ . args) + (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) + '())) + (originating-network (list-ref args-needing-processing 2)) + (replies (list-ref args-needing-processing 3))) + (apply make-internal-comment + `(,@(drop-right args 4) + ,approved + ,reactions + ,replies + ,originating-network)))) -This interface exists for dynamically generating the comment view from Haunt." - (define (make-internal-comment~ . args) - (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) - '())) - (originating-network (list-ref args-needing-processing 2)) - (replies (list-ref args-needing-processing 3))) - (apply make-internal-comment - `(,@(drop-right args 4) - ,approved - ,reactions - ,replies - ,originating-network)))) - (define (order-comments comments) +(define (order-comments comments) (define seen (make-hash-table)) (define (id comment) (first comment)) (define (content comment) (drop-right comment 1)) @@ -86,13 +83,30 @@ 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, originating_network, reply_to + +(define (handle-get-comments-by-slug slug) + "Internal function for querying the approved comments on a post + +This interface exists for dynamically generating the comment view from Haunt." + + (let* ((query "SELECT id, slug, 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)) (order-comments result) '()))) +(define (handle-get-all-comments limit) + (let* ((query "SELECT id, slug, name, subject, email, comment, url, approved, reactions, originating_network, reply_to + FROM comments WHERE approved IS NOT NULL + ORDER BY approved DESC + LIMIT $1") + (result (exec-query conn query (list limit))) + (result (map (lambda (comment) + (append (drop-right comment 1) '(()))) + result))) + (map (cut apply make-internal-comment~ <>) result))) + (define (get-comments request body) "API endpoint handler for querying for the comments on a particular post @@ -108,7 +122,21 @@ This is a wrapper around `get-comments-by-slug'." (values '((content-type . (application/json))) (scm->json-string (list->vector - (map normalize-record (get-comments-by-slug (car slug)))))))) + (map normalize-record (handle-get-comments-by-slug (car slug)))))))) + +(define (get-all-comments request body) + (define (normalize-record record) + (json-string->scm (internal-comment->json record))) + (let* ((query-string (uri-query (request-uri request))) + (params (if query-string + (decode-form query-string) + '())) + (limit (or (assoc-value params "limit") "10")) + (result (handle-get-all-comments limit))) + (values '((content-type . (application/json))) + (scm->json-string + (list->vector + (map normalize-record result)))))) diff --git a/jakob/dynamic/capabilities/common.scm b/jakob/dynamic/capabilities/common.scm index 2bca1a2..f76e6e9 100644 --- a/jakob/dynamic/capabilities/common.scm +++ b/jakob/dynamic/capabilities/common.scm @@ -23,6 +23,7 @@ make-internal-comment internal-comment? internal-comment-id + internal-comment-slug internal-comment-name internal-comment-subject internal-comment-email @@ -39,6 +40,7 @@ internal-comment? json->internal-comment <=> internal-comment->json (id internal-comment-id) + (slug internal-comment-slug) (name internal-comment-name) (subject internal-comment-subject) (email internal-comment-email) -- cgit v1.3