diff options
Diffstat (limited to 'haunt/jakob/utils/webmention.scm')
| -rw-r--r-- | haunt/jakob/utils/webmention.scm | 135 |
1 files changed, 0 insertions, 135 deletions
diff --git a/haunt/jakob/utils/webmention.scm b/haunt/jakob/utils/webmention.scm deleted file mode 100644 index 713ce39..0000000 --- a/haunt/jakob/utils/webmention.scm +++ /dev/null @@ -1,135 +0,0 @@ -;;; Copyright © 2019 - 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/>. - -(define-module (jakob utils webmention) - #:use-module (ice-9 receive) - #:use-module (ice-9 iconv) - #:use-module (ice-9 match) - #:use-module (srfi srfi-19) - #:use-module (srfi srfi-43) - #:use-module (json) - #:use-module (web client) - #:use-module (web response) - #:use-module (oop goops) - #:export (render-comment-view - fetch-webmentions)) - -(define (wm-not-null? value) - (and value - (not (eqv? 'null value)) - (not (string= "" value)))) - -(define (format-comment webmention) - "Format `webmention', an alist, as SXML for a comment-type interaction" - (define (strip uri) - "Attempt to remove any sort of protocol specification from `uri'" - (let* ((needle "://") - (index (string-contains uri needle))) - (if index - (strip (substring uri (+ index (string-length needle)))) - uri))) - (let* ((author (assoc-ref webmention "author")) - (author-name (assoc-ref author "name")) - (author-url (assoc-ref author "url")) - (author-url - (if (wm-not-null? author-url) - author-url - (assoc-ref webmention "wm-source"))) - (author-photo (assoc-ref author "photo")) - (author-photo - (cond ((string-prefix? "https://lobste.rs/" author-url) "/static/image/lobsters.png") - ((wm-not-null? author-photo) author-photo) - (else "/static/image/default-icon.png"))) - (content (assoc-ref webmention "content")) - (content-text (assoc-ref content "text")) - (published-time (assoc-ref webmention "published")) - (received-time (assoc-ref webmention "wm-received")) - (url (assoc-ref webmention "url")) - (time (if (eqv? 'null published-time) received-time published-time))) - `(li (@ (class "p-comment h-cite comment comment-source-webmention")) - (img (@ (class "comment-source-identifier") - (alt "Webmention logo") - (src "/static/image/webmention-logo.png"))) - (div (@ (class "p-author h-card author")) - (img (@ (class "u-photo") (src ,author-photo))) - (a (@ (class "p-name u-url") - (href ,author-url)) - ,author-name) - (a (@ (class "author-url") - (href ,author-url)) - ,(strip author-url))) - (div (@ (class "e-content p-name comment-content")) - ,content-text) - (div (@ (class "metaline")) - (a (@ (class "u-url") - (href ,url)) - (time (@ (class "dt-published") - (datetime ,time)) - ,(date->string - (string->date time "~Y~m~d~H~M~S") - "~B ~e, ~Y at ~H:~M"))))))) - -(define (format-interaction webmention) - "Format `webmention', an alist, as SXML for a rich interaction without content" - (let* ((author (assoc-ref webmention "author")) - (author-name (assoc-ref author "name")) - (author-url (assoc-ref author "url")) - (author-url - (if (wm-not-null? author-url) - author-url - (assoc-ref webmention "wm-source"))) - (author-photo (assoc-ref author "photo")) - (author-photo - (cond ((string-prefix? "https://lobste.rs/" author-url) "/static/image/lobsters.png") - ((wm-not-null? author-photo) author-photo) - (else "/static/image/default-icon.png")))) - `(li (@ (class "p-comment h-cite interaction comment-source-webmention")) - (a (@ (href ,author-url)) - (img (@ (class "u-photo") (src ,author-photo)))) - (div (@ (class "e-content p-name comment-content")) - (em - ,(match (assoc-ref webmention "wm-property") - ("repost-of" "Reposted this!") - ("like-of" "Favorited this!") - ("bookmark-of" "Bookmarked this!") - ("mention-of" "Mentioned this!") - (_ "[No Text Provided]")))) - (img (@ (class "comment-source-identifier") - (alt "Webmention logo") - (src "/static/image/webmention-logo.png")))))) - -(define (render-comment-view response) - "Render `response', the output of `fetch-webmentions', as SXML" - (vector->list - (vector-map (lambda (_ x) - (if (and (assoc-ref x "content") - (not (string= (assoc-ref x "wm-property") "repost-of"))) - (format-comment x) - (format-interaction x))) - (assoc-ref response "children")))) - -(define (fetch-webmentions slug) - "Blocking call to webmention.io to retrieve a vector of all Webmentions for `slug'" - (define prefixes '("http://jakob.space/" "https://jakob.space/" - "http://jakob.space/blog/" "https://jakob.space/blog/")) - (let* ((target-queries (map (lambda (pre) - (format #f "target[]=~a~a.html" pre slug)) - prefixes)) - (url (format #f "https://webmention.io/api/mentions.jf2?per-page=200&page=0&~a" - (string-join target-queries "&")))) - (receive (response-status response-body) - (http-request url) - (call-with-input-string (bytevector->string response-body "UTF-8") json->scm)))) |