From 0a2a8c9806703703cf1af62eea90538a96ef9b3d Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Wed, 21 Dec 2022 18:19:49 +0100
Subject: Add (weipub feed).

---
 Makefile.am     |  3 ++-
 weipub/feed.scm | 69 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 71 insertions(+), 1 deletion(-)
 create mode 100644 weipub/feed.scm

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" . #())))))
-- 
cgit v1.2.3