It's working :)

2023-10-02 18:02:03 +02:00 · 2023-10-02 18:02:03 +02:00 · d225dc21f6
commit d225dc21f6
3 changed files with 170 additions and 0 deletions
--- a/looptober.clj
+++ b/looptober.clj
@ -0,0 +1,98 @@
+(ns looptober
+  (:require [clojure.string :as str]
+            [org.httpkit.client :as http]
+            [org.httpkit.server :refer [run-server ]]
+            [cheshire.core :as json]
+            [clojure.data.xml :as xml]))
+
+(xml/alias-uri 'xspf "http://xspf.org/ns/0/")
+
+(defn find-in [pred xs]
+  (first (filter #(when (pred %) (reduced %)) xs)))
+
+;; the nested map looks like this:
+;; {"instance.url" [timestamp-in-ms [status ...]]}
+(defonce response-cache (atom {}))
+
+(def update-interval (* 1000 60 30)) ;; 30 min
+
+(defn paginate!
+  "Fetch all mastodon statuses where `min-id` < status < `max-id`.
+  Takes a `pred` to filter statuses, will stop if no status matches the pred."
+  ([url pred min-id] (paginate! url pred min-id nil))
+  ([url pred min-id max-id]
+   (println "calling paginate! with" min-id max-id)
+   (let [req (http/get url {:query-params {:min_id min-id
+                                           :max_id max-id}})
+         result (filterv pred (json/parse-string (:body @req) true))]
+     (concat result (when (seq result)
+                      (paginate! url pred min-id (:id (last result))))))))
+
+(defn audio-attachment [status]
+  (find-in #(= (:type %) "audio") (-> status :media_attachments)))
+
+(defn fetch-loops!
+  ([instance-url]
+   ;; cache update logic
+   (let [now (System/currentTimeMillis)
+         [last-fetch statuses] (get @response-cache instance-url)
+         max-status (first statuses)]
+     (if (or (nil? last-fetch)
+             (> (- now last-fetch) update-interval))
+       (let [updated (swap! response-cache assoc instance-url
+                            [now
+                             (let [new-statuses (paginate! (format "%s/api/v1/timelines/tag/looptober" instance-url)
+                                                           (fn [status]
+                                                             (and (neg? (compare (:id max-status) (:id status)))
+                                                                  (neg? (compare (or (:created_at max-status) "2023-10-01T00:00:00.000Z") (:created_at status)))))
+                                                           (:id max-status))]
+                               (concat (filterv audio-attachment new-statuses) statuses))])
+             [_ statuses] (get updated instance-url)]
+         statuses)
+       statuses))))
+
+(defn ->xspf [statuses]
+  (xml/sexp-as-element
+   ;; see https://www.xspf.org/quickstart
+   [::xspf/playlist {:xmlns "http://xspf.org/ns/0/" :version "1"}
+    [::xspf/title "Looptober"]
+    [::xspf/creator "The Fediverse"]
+    ;; TODO: :location
+    [::xspf/trackList
+     (map (fn [status]
+            (let [file (audio-attachment status)]
+              [::xspf/track
+               [::xspf/creator (-> status :account :acct)]
+               [::xspf/image (-> status :account :avatar)]
+               [::xspf/annotation (str (when (not= "" (:spoiler_text status))
+                                         (str (:spoiler_text status) "\n\n"))
+                                       (:content status))]
+               [::xspf/info (-> status :url)]
+               [::xspf/duration (-> file :meta :original :duration (* 1000) int)]
+               [::xspf/location (:remote_url file)]])) statuses)]]))
+
+(defn app [req]
+  (let [instance-url (if (not= "/" (:uri req))
+                       (str "https://"
+                            (-> (str/replace (:uri req) #"^/" "")
+                                (str/replace #".xspf$" "")))
+                       "https://post.lurk.org")
+        statuses (fetch-loops! instance-url)]
+    {:status 200
+     :headers {"Content-Type" "application/xspf+xml"}
+     :body (xml/indent-str (->xspf statuses))}))
+
+(defonce server
+  (atom nil))
+
+(defn stop-server []
+  (when-not (nil? @server)
+    ;; graceful shutdown: wait 100ms for existing requests to be finished
+    ;; :timeout is optional, when no timeout, stop immediately
+    (@server :timeout 100)
+    (reset! server nil)))
+
+(defn -main [& args]
+  (println "Starting server on port 8080")
+  (reset! server (run-server #'app {:port 8080}))
+  @(promise)) ;; keep running