107 lines
4.5 KiB
Clojure
107 lines
4.5 KiB
Clojure
(ns looptober
|
|
(:require [clojure.string :as str]
|
|
[clojure.data.xml :as xml]
|
|
[cheshire.core :as json]
|
|
[org.httpkit.client :as http]
|
|
[org.httpkit.server :refer [run-server]]))
|
|
|
|
(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 token pred min-id] (paginate url token pred min-id nil))
|
|
([url token pred min-id max-id]
|
|
(println "calling paginate with" min-id max-id)
|
|
(let [opts (cond-> {:query-params {:min_id min-id
|
|
:max_id max-id}}
|
|
token (assoc :headers {"Authorization" (format "Bearer %s" token)}))
|
|
req (http/get url opts)
|
|
result (filterv pred (json/parse-string (:body @req) true))]
|
|
(concat result (when (seq result)
|
|
(paginate url token pred min-id (:id (last result))))))))
|
|
|
|
(defn audio-attachment [status]
|
|
(find-in #(= (:type %) "audio") (-> status :media_attachments)))
|
|
|
|
(defn fetch-loops
|
|
([instance-url token]
|
|
;; 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)
|
|
token
|
|
(fn [status]
|
|
(and (neg? (compare (:id max-status) (:id status)))
|
|
(neg? (compare (: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)
|
|
acct (-> status :account :acct)]
|
|
[::xspf/track
|
|
[::xspf/creator (str acct (when-not (re-find #"@" acct)
|
|
(str "@" (.getHost (java.net.URL. (-> status :url))))))]
|
|
[::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 (: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")
|
|
token (some-> (:body req) (slurp) (json/parse-string true) :token)
|
|
statuses (fetch-loops instance-url token)]
|
|
{: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]
|
|
(let [port (Integer/parseInt (or (first args) "8080") 10)]
|
|
(println (format "Starting server on port %d" port))
|
|
(reset! server (run-server #'app {:port port}))
|
|
@(promise))) ;; keep running
|
|
|
|
(comment (reset! server (run-server #'app {:port 8080})))
|