431 lines
18 KiB
Clojure
431 lines
18 KiB
Clojure
(ns computersandblues.lodestone.app
|
|
(:require [reagent.core :as r]
|
|
[reagent.dom.client :as rd]
|
|
[clojure.string :as str]
|
|
[clojure.pprint :as pprint]
|
|
[computersandblues.lodestone.database :as db]
|
|
[computersandblues.lodestone.match :refer [query->matching-fn]]))
|
|
|
|
(defonce state (r/atom {:root nil
|
|
|
|
:section :login
|
|
|
|
:section/login {}
|
|
|
|
; TODO: Handle other lists
|
|
:section/posts {:query nil
|
|
:per-page 50
|
|
:loading #{}
|
|
; TODO: pagination
|
|
; :page 0
|
|
; :max-displayed-id nil
|
|
; :order [:date :desc]
|
|
:total 0
|
|
:displayed-posts []}}))
|
|
|
|
; TODO Ensure that cached data is up to date
|
|
; TODO Manually fetch older / newer favorites
|
|
; TODO Handle 429
|
|
; TODO Search for tags (`#foo`) and handles (`@bar`)
|
|
; TODO Explain which kind of search currently is possible
|
|
|
|
;; Mastodon API helpers
|
|
|
|
(defn- link-header
|
|
"Given a JS `Response` object, will parse the `link` header and find a link of
|
|
a given `link-type` if present. Useful for paginating API requests."
|
|
[link-type response]
|
|
(let [links (-> (.. response -headers (get "link"))
|
|
(str/split ", "))
|
|
regex (re-pattern (str "rel=(\"" link-type "\"|" link-type ")"))]
|
|
(->> (keep (fn [link]
|
|
(when (re-find regex link)
|
|
(re-seq #"http[^>]*" link))) links)
|
|
(ffirst))))
|
|
|
|
;;; default handlers
|
|
|
|
(defn- on-response [response] response)
|
|
|
|
(defn- on-error [response]
|
|
(throw (ex-info "Could not perform API request" {:response response})))
|
|
|
|
;;; main function to perform mastodon-compatible api requests
|
|
|
|
(defn mastodon-request!
|
|
"Small helper function to send authorized requests to mastodon-compatible APIs"
|
|
[{:keys [url method bearer-token payload]
|
|
:or {method :get}}]
|
|
(js/Promise.
|
|
(fn [resolve reject]
|
|
(. (js/fetch url
|
|
(clj->js (cond-> {:method (str/upper-case (name method))}
|
|
bearer-token (assoc-in [:headers :authorization] (str "Bearer " bearer-token))
|
|
payload (->
|
|
(assoc-in [:headers :content-type] "application/json; charset=utf-8")
|
|
(assoc :body (js/JSON.stringify (clj->js payload)))))))
|
|
(then (fn [res]
|
|
(if (.-ok res)
|
|
(-> (.json res)
|
|
(.then
|
|
(fn [body]
|
|
(resolve {:raw res
|
|
:body (js->clj body {:keywordize-keys true})}))))
|
|
(reject res))))))))
|
|
|
|
(defn- search-params [params]
|
|
(js/URLSearchParams. (clj->js params)))
|
|
|
|
;; all of the app's sections (i.e. different views / pieces of functionality)
|
|
|
|
;; login & application setup
|
|
|
|
;;; api interaction
|
|
|
|
;;; the auth flow works in five steps:
|
|
;;;
|
|
;;; 1. the user has to enter an instance url
|
|
;;; 2. the app sends a post request to an API endpoint for that instance, registering itself as a URL
|
|
;;; 3. the user gets redirected to a page on their server where they are asked to authorize access for this url
|
|
;;; 4. the user gets redirected back to this application with a code that is readable as a url parameter
|
|
;;; 5. the app sends a post request to a different API endpoint, using this scratch code to request a permanent bearer token
|
|
;;;
|
|
;;; any subsequent request must use the bearer token to authenticate itself.
|
|
|
|
(defn obtain-oauth-authorization-code! [application]
|
|
(set! (.-location js/window)
|
|
(str (:instance_url application)
|
|
"/oauth/authorize?"
|
|
(search-params {:response_type "code"
|
|
:client_id (:client_id application)
|
|
:redirect_uri (:redirect_uri application) ; TODO handle multiple reidrect uris?
|
|
:scope "read:favourites"}))))
|
|
|
|
(defn oauth-authorization-code [location]
|
|
(.get (js/URLSearchParams. (.-search location)) "code"))
|
|
|
|
(defn handle-oauth-authorization-code! [{:keys [application code]}]
|
|
(->
|
|
(mastodon-request! {:method :post
|
|
:url (str (:instance_url application)
|
|
"/oauth/token?"
|
|
(search-params {:grant_type "authorization_code"
|
|
:code code
|
|
:client_id (:client_id application)
|
|
:client_secret (:client_secret application)
|
|
:redirect_uri (:redirect_uri application)}))})
|
|
(.then (fn [res]
|
|
(let [bearer-token (-> res :body :access_token)
|
|
application (assoc application :bearer_token bearer-token)]
|
|
(db/put! ::db/application application)
|
|
application)))))
|
|
|
|
(defn create-remote-application!
|
|
"Initiates the entire OAuth workflow on the server side, and will redirect the
|
|
user to grant access once app creation was successful."
|
|
[{:keys [instance-url app-url]}]
|
|
; https://docs.joinmastodon.org/methods/apps/
|
|
(->
|
|
(mastodon-request! {:method :post
|
|
:url (str instance-url "/api/v1/apps")
|
|
:payload {:client_name "Lodestone"
|
|
:redirect_uris app-url
|
|
:scopes "read:favourites"
|
|
:website app-url}})
|
|
(.then (fn [{application :body}]
|
|
(let [application (assoc application :instance_url instance-url)]
|
|
(db/put! ::db/application application)
|
|
(obtain-oauth-authorization-code! application))))))
|
|
|
|
(declare fetch-posts!)
|
|
(declare refresh-displayed-posts!)
|
|
|
|
(defn setup-application!
|
|
"Handles Mastodon application setup on the client side"
|
|
[]
|
|
; we need to handle the following cases:
|
|
;
|
|
; - app is registered and we have a bearer token (setup complete)
|
|
; - app is registered, no bearer token, but code to obtain is is present in the url
|
|
; - app is registered, no bearer token is available and no code is present in the url
|
|
; - no app registered yet (first time app is setup in this browser)
|
|
;
|
|
; the last case is not handled in this function, but is handled by the
|
|
; `create-remote-application!` function that is called once the user submits
|
|
; the form with their instance URL.
|
|
(-> (db/open-cursor! ::db/application db/all)
|
|
(db/transduce-cursor (comp (take 1)
|
|
(map #(js->clj % :keywordize-keys true))))
|
|
(.then (fn [[application]]
|
|
(let [code (oauth-authorization-code (.-location js/window))]
|
|
(cond
|
|
(:bearer_token application)
|
|
(js/Promise.resolve application)
|
|
|
|
(and application code)
|
|
(handle-oauth-authorization-code!
|
|
{:application application
|
|
:code code})
|
|
|
|
; the case below will force a redirect after which the
|
|
; user will be directed back to the app. any subsequent steps
|
|
; are handled above, and they are not directly handled in the
|
|
; `.then` below, which is why they don't return promises that
|
|
; contain the `application`.
|
|
|
|
application
|
|
(obtain-oauth-authorization-code! application)))))
|
|
(.then (fn [application]
|
|
(when application
|
|
(swap! state assoc :section :posts)
|
|
(js/Promise.all #js [application (db/count! ::db/posts)]))))
|
|
(.then (fn [[application post-count]]
|
|
(when post-count
|
|
(if (zero? post-count)
|
|
(fetch-posts! {:instance-url (:instance_url application)
|
|
:bearer-token (:bearer_token application)
|
|
:continue?
|
|
(fn [response]
|
|
(and (seq (:body response))
|
|
(< (count (:favorites @state)) 500)))})
|
|
(refresh-displayed-posts! (:section/posts @state))))))))
|
|
|
|
;;; views
|
|
|
|
(defn login-section []
|
|
[:section.login
|
|
[:h2 "Login"]
|
|
[:p "After logging in, Lodestone will load the posts you starred, and allow you to efficiently sort an search them. All data is processed privately and locally in your browser."]
|
|
[:p [:strong "Please login to continue."]]
|
|
[:form.login-section {:on-submit (fn [e]
|
|
(let [instance-url (-> (js/FormData. (.-target e))
|
|
(.get "instance-url"))
|
|
app-url (str (-> js/window .-location .-protocol) "//"
|
|
(-> js/window .-location .-host)
|
|
(-> js/window .-location .-pathname))]
|
|
(.preventDefault e)
|
|
; this will cause a redirect, after which
|
|
; everything will start from `init` below
|
|
(create-remote-application! {:instance-url instance-url
|
|
:app-url app-url})))}
|
|
[:label {:for "instance-url"} "Your instance URL"]
|
|
[:input#instance-url {:placeholder "For example https://mas.to/ or https://indieweb.social"
|
|
:name "instance-url"
|
|
:type "url"
|
|
:required true}]
|
|
[:button {:type "submit"} "Login"]]])
|
|
|
|
|
|
;; favorites section
|
|
|
|
;;; api interaction
|
|
|
|
(defn- favorites-url [{:keys [instance-url limit max-id]
|
|
:or {limit 40}}]
|
|
(let [params (search-params (cond-> {:limit limit}
|
|
max-id (assoc :max_id max-id)))]
|
|
(str instance-url "/api/v1/favourites?" params)))
|
|
|
|
(defn fetch-favorites!
|
|
[{:keys [instance-url bearer-token max-id
|
|
on-response on-error continue?]
|
|
:or {continue? (fn [response]
|
|
(seq (:body response)))
|
|
on-response on-response
|
|
on-error on-error}}]
|
|
(js/console.log 'fetch-favorites! instance-url max-id bearer-token)
|
|
((fn fetch-favorites' [url]
|
|
(let [req-id (js/Date.now)]
|
|
(println :calling url)
|
|
(swap! state update-in [:section/posts :loading] conj req-id)
|
|
(-> (mastodon-request! {:url url :bearer-token bearer-token})
|
|
(.then (fn [response]
|
|
(on-response response)
|
|
(if (continue? response)
|
|
(js/setTimeout #(fetch-favorites' (link-header "next" (:raw response))) 500)
|
|
(swap! state update-in [:section/posts :loading] disj req-id))))
|
|
(.catch (fn [response]
|
|
(swap! state update-in [:section/posts :loading] disj req-id)
|
|
(on-error response))))))
|
|
(favorites-url {:instance-url instance-url :max-id max-id})))
|
|
|
|
;;; views
|
|
|
|
(defn debounce [ms f]
|
|
(let [prev (volatile! (js/Date.now))
|
|
trail (volatile! (js/setTimeout (fn dummy []) ms))]
|
|
(fn debounced-fn [& args]
|
|
(let [now (js/Date.now)]
|
|
(if (> (- now @prev) ms)
|
|
(do (vreset! prev now)
|
|
(apply f args))
|
|
(do (js/clearTimeout @trail)
|
|
(vreset! trail (js/setTimeout (fn []
|
|
(vreset! prev (js/Date.now))
|
|
(apply f args))))))))))
|
|
|
|
(defn search []
|
|
[:input {:placeholder "Start typing to search…"
|
|
:on-change (fn [e]
|
|
(let [query (.. e -target -value)]
|
|
(swap! state assoc-in [:section/posts :query] (if (str/blank? query) nil query))
|
|
(refresh-displayed-posts! (:section/posts @state))))
|
|
:value (-> @state :section/posts :query)}])
|
|
|
|
(defn- debug
|
|
"Implements a lazy pretty-printer for whatever is passed in as `obj`. The
|
|
object will only be serialized and pretty-printed when the detail view is
|
|
first toggled."
|
|
[obj]
|
|
(let [pprinted (r/atom nil)
|
|
pprint (fn [_]
|
|
(when-not @pprinted
|
|
(reset! pprinted (with-out-str (pprint/pprint obj)))))]
|
|
(fn []
|
|
[:details.debug {:on-toggle pprint
|
|
:on-mouseover pprint}
|
|
[:summary "Inspect"]
|
|
[:pre @pprinted]])))
|
|
|
|
(defn user [{:keys [user]}]
|
|
(:username user))
|
|
|
|
(defn- list-accounts [accounts]
|
|
[:<>
|
|
(->> (map-indexed (fn [idx account]
|
|
^{:key idx} [user {:user account}]) accounts)
|
|
(interleave (repeat ", "))
|
|
(drop 1))])
|
|
|
|
(defn attachment [{:keys [attachment]}]
|
|
(case (:type attachment)
|
|
"image" [:img {:src (:preview_url attachment)
|
|
:alt (:description attachment)
|
|
:lazy "lazy"}]
|
|
"video" [:video {:controls true
|
|
:width 480}
|
|
[:source {:type (str "video/" (last (str/split (:remote_url attachment) #"\.")))
|
|
:src (:remote_url attachment)}]
|
|
[:a {:href (:remote_url attachment)} (str "Original video at " (:remote_url attachment))]]
|
|
[:div [:strong "Unsupported attachment"]
|
|
[debug attachment]]))
|
|
|
|
(defn post [{:keys [post]}]
|
|
; TODO: handle (:sensitive post)
|
|
[:article.post
|
|
[:header.metadata
|
|
[:section.users
|
|
[user {:user (:account post)}]
|
|
(when (seq (:mentions post))
|
|
[:span.mentions
|
|
" (mentioning " [list-accounts (:mentions post)] ")"])]
|
|
[:section.post-info
|
|
[:time.date {:datetime (:created_at post)} (first (str/split (:created_at post) "T"))]]]
|
|
[:section.content {:dangerouslySetInnerHTML (r/unsafe-html (:content post))}
|
|
(when (seq (:media_attachments post))
|
|
[:section.attachments
|
|
(map-indexed (fn [idx item]
|
|
^{:key idx} [attachment {:attachment item}])
|
|
(:media_attachments post))])]
|
|
[:nav
|
|
[:ul.controls
|
|
[:li.control-element.url
|
|
[:a {:href (:url post) :target "_blank"} "↗ Open original post"]]
|
|
[:li.control-element.clipboard
|
|
[:a {:href "#" :on-click (fn [e]
|
|
(.preventDefault e)
|
|
(js/navigator.clipboard.writeText (:url post)))} "◎ Copy URL to clipboard"]]]]
|
|
#_[debug post]])
|
|
|
|
(defn- refresh-displayed-posts!
|
|
[posts-section]
|
|
(let [{:keys [per-page query]} posts-section
|
|
; this `xform` is responsible for filtering and building the final list
|
|
; of results by iterating through the posts in the database.
|
|
xform (comp
|
|
(filter (query->matching-fn query))
|
|
(take per-page)
|
|
(map #(js->clj % :keywordize-keys true)))
|
|
refresh-id (js/Date.now)]
|
|
(swap! state update-in [:section/posts :loading] conj refresh-id)
|
|
(-> (js/Promise.all #js [(db/count! ::db/posts)
|
|
(-> (db/open-cursor! ::db/posts "created_at" db/all "prev")
|
|
(db/transduce-cursor xform))])
|
|
(.then (fn [[total displayed-posts]]
|
|
(swap! state update :section/posts #(-> (assoc % :total total)
|
|
(assoc :displayed-posts displayed-posts)
|
|
(update :loading disj refresh-id))))))))
|
|
|
|
(def debounced-refresh! (debounce 20 (partial refresh-displayed-posts!)))
|
|
|
|
(defn- fetch-posts! [opts]
|
|
(let [defaults {:max-id nil
|
|
:on-response (fn [response]
|
|
(doseq [post (:body response)]
|
|
(db/put! ::db/posts post))
|
|
(debounced-refresh! (:section/posts @state)))}]
|
|
(fetch-favorites! (merge defaults opts))))
|
|
|
|
(defn posts-section [{:keys [posts]}]
|
|
(let [{:keys [per-page query total displayed-posts loading]} posts]
|
|
[:section.posts
|
|
[:h2 "Favorites"]
|
|
[:header.controls
|
|
[:p.display-info
|
|
(str "Loaded " total " posts"
|
|
(when (or query (> total per-page))
|
|
(str ", displaying " (count displayed-posts) (when query " matches"))))]
|
|
[:div.search-form
|
|
[search]
|
|
(when (seq loading) " …")
|
|
#_(cond (= api-state :loading) " …"
|
|
(= api-state :error) " API Error!")]]
|
|
[:ul.results (map-indexed (fn [idx p]
|
|
^{:key idx} [:li.result [post {:post p}]]) displayed-posts)]
|
|
#_[:div.load-buttons
|
|
[:button
|
|
{:on-click (fn [_]
|
|
(let [num-posts (count posts)]
|
|
(fetch-posts! {:continue? (fn [response]
|
|
(and (seq (:body response))
|
|
(< (count (:favorites @state)) (+ num-posts 1000))))})))}
|
|
"Load more"]
|
|
" "
|
|
[:button
|
|
{:on-click (fn [_]
|
|
(fetch-posts! {:continue? (fn [response]
|
|
(seq (:body response)))}))}
|
|
"Load all"]]]))
|
|
|
|
(defn app []
|
|
(let [section (:section @state)
|
|
posts (:section/posts @state)]
|
|
[:main#app
|
|
(case section
|
|
:login [login-section]
|
|
:posts [posts-section {:posts posts}])]))
|
|
|
|
;; database
|
|
|
|
(def db-version 2)
|
|
|
|
(def migrations
|
|
{1 (fn migration-0001 [db _]
|
|
(db/create-object-store! db ::db/application {:keyPath "id"})
|
|
(db/create-object-store! db ::db/posts {:keyPath "id"}))
|
|
2 (fn migration-0002 [_ txn]
|
|
(-> (db/open-store txn ::db/posts "readwrite")
|
|
(db/create-index! "created_at" "created_at" {:unique false})))})
|
|
|
|
;; go go go
|
|
|
|
(defn ^:dev/after-load render []
|
|
(rd/render (:root @state) [app]))
|
|
|
|
(defn init []
|
|
(swap! state assoc :root (rd/create-root (js/document.querySelector "#root")))
|
|
(render)
|
|
(-> (db/setup! ::database db-version migrations)
|
|
(.then #(setup-application!))
|
|
(.catch (fn [err]
|
|
(js/console.log ::db/setup! err)))))
|