From d225dc21f6869521cff10bb235133bd040007c82 Mon Sep 17 00:00:00 2001
From: arne <noreply@null.arnes.space>
Date: Mon, 2 Oct 2023 18:02:03 +0200
Subject: [PATCH] It's working :)

---
 .gitignore    | 71 +++++++++++++++++++++++++++++++++++++
 bb.edn        |  1 +
 looptober.clj | 98 +++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 170 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 bb.edn
 create mode 100644 looptober.clj

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..1ee16a9
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,71 @@
+# Created by https://www.toptal.com/developers/gitignore/api/clojure,emacs
+# Edit at https://www.toptal.com/developers/gitignore?templates=clojure,emacs
+
+### Clojure ###
+pom.xml
+pom.xml.asc
+*.jar
+*.class
+/lib/
+/classes/
+/target/
+/checkouts/
+.lein-deps-sum
+.lein-repl-history
+.lein-plugins/
+.lein-failures
+.nrepl-port
+.cpcache/
+
+### Emacs ###
+# -*- mode: gitignore; -*-
+*~
+\#*\#
+/.emacs.desktop
+/.emacs.desktop.lock
+*.elc
+auto-save-list
+tramp
+.\#*
+
+# Org-mode
+.org-id-locations
+*_archive
+
+# flymake-mode
+*_flymake.*
+
+# eshell files
+/eshell/history
+/eshell/lastdir
+
+# elpa packages
+/elpa/
+
+# reftex files
+*.rel
+
+# AUCTeX auto folder
+/auto/
+
+# cask packages
+.cask/
+dist/
+
+# Flycheck
+flycheck_*.el
+
+# server auth directory
+/server/
+
+# projectiles files
+.projectile
+
+# directory configuration
+.dir-locals.el
+
+# network security
+/network-security.data
+
+
+# End of https://www.toptal.com/developers/gitignore/api/clojure,emacs
diff --git a/bb.edn b/bb.edn
new file mode 100644
index 0000000..5837a2a
--- /dev/null
+++ b/bb.edn
@@ -0,0 +1 @@
+{:paths ["."]}
diff --git a/looptober.clj b/looptober.clj
new file mode 100644
index 0000000..4fc415d
--- /dev/null
+++ 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