summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRicardo Wurmus <rekado@elephly.net>2022-12-21 18:19:49 +0100
committerRicardo Wurmus <rekado@elephly.net>2022-12-21 18:19:49 +0100
commit0a2a8c9806703703cf1af62eea90538a96ef9b3d (patch)
tree932c848c230860dfce61ff7a57db4661b951c4f7
parent7d2cd1e7aa91d46ba1924213ee2199160cf5173b (diff)
Add (weipub feed).HEADmain
-rw-r--r--Makefile.am3
-rw-r--r--weipub/feed.scm69
2 files changed, 71 insertions, 1 deletions
diff --git a/Makefile.am b/Makefile.am
index a4521a7..a78de76 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -23,7 +23,8 @@ godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache
SOURCES = \
weipub/config.scm \
weipub/database.scm \
- weipub/accounts.scm
+ weipub/accounts.scm \
+ weipub/feed.scm
info_TEXINFOS = doc/weipub.texi
diff --git a/weipub/feed.scm b/weipub/feed.scm
new file mode 100644
index 0000000..57a0f96
--- /dev/null
+++ b/weipub/feed.scm
@@ -0,0 +1,69 @@
+;;; weipub - Teeny tiny activitypub thing
+;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU Affero 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
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public
+;;; License along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (weipub feed)
+ #:use-module (weipub config)
+ #:use-module (weipub accounts)
+ #:use-module (sxml simple)
+ #:use-module (sxml xpath)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:export (atom-entry->message
+ atom-feed->entries))
+
+(define-record-type <atom-entry>
+ (make-atom-entry author published url content)
+ atom-entry?
+ (author atom-entry-author)
+ (published atom-entry-published)
+ (url atom-entry-url)
+ (content atom-entry-content))
+
+(define (sxml->atom-entry sxml)
+ (let ((author
+ (and=> ((sxpath '(atom:author atom:name *text*)) sxml) first))
+ (published
+ (and=> ((sxpath '(atom:published *text*)) sxml) first))
+ (url
+ (and=> ((sxpath '(atom:link @ href *text*)) sxml) first))
+ (content
+ (and=> ((sxpath '(atom:content *text*)) sxml) first)))
+ (make-atom-entry author published url content)))
+
+(define (atom-feed->entries port)
+ "Read an atom feed XML from PORT and return a list of atom entries."
+ (let ((sxml (xml->sxml port
+ #:namespaces '((atom . "http://www.w3.org/2005/Atom")))))
+ (map sxml->atom-entry
+ ((sxpath '(// atom:entry)) sxml))))
+
+(define* (atom-entry->message entry #:key from to)
+ `(("@context" . "https://www.w3.org/ns/activitystreams")
+ ("id" . ,(format #false
+ "~a?create=true&v=1" (atom-entry-url entry)))
+ ("type" . "Create")
+ ("actor" . ,(account-url from))
+ ("to" . #("https://www.w3.org/ns/activitystreams#Public"))
+ ("cc" . ,(vector to))
+ ("object"
+ . (("id" . ,(format #false "~a?v=1" (atom-entry-url entry)))
+ ("type" . "Note")
+ ("published" . ,(atom-entry-published entry))
+ ("attributedTo" . ,(account-url from))
+ ("content" . ,(atom-entry-content entry))
+ ("to" . #("https://www.w3.org/ns/activitystreams#Public"))
+ ("attachment" . #())))))