It's working :)
This commit is contained in:
commit
d225dc21f6
3 changed files with 170 additions and 0 deletions
71
.gitignore
vendored
Normal file
71
.gitignore
vendored
Normal file
|
|
@ -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
|
||||
1
bb.edn
Normal file
1
bb.edn
Normal file
|
|
@ -0,0 +1 @@
|
|||
{:paths ["."]}
|
||||
98
looptober.clj
Normal file
98
looptober.clj
Normal file
|
|
@ -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
|
||||
Loading…
Add table
Add a link
Reference in a new issue