diff --git a/public/index.html b/public/index.html index bf753aa..bbe72a0 100644 --- a/public/index.html +++ b/public/index.html @@ -11,7 +11,7 @@ body { margin: 24px; min-height: 100vh; - max-width: 1000px; + max-width: 960px; background: #fbf5de; color: #222; font-family: sans-serif; @@ -72,9 +72,25 @@ clear: both; } - input { + input, + button { margin: 3px 0; padding: 3px; + border: 2px solid #222; + color: #222; + background: rgba(255, 255, 255, 0.8); + } + + section.login label, + section.login input { + display: block; + width: 100%; + max-width: 480px; + } + + section.login input, + section.login button { + padding: 6px; } .controls { @@ -100,8 +116,11 @@

Lodestone

-

Lodestone is an application to help you navigate the fediverse. It surfaces things you enjoyed and provides a search that runs fully in your own browser.

-
+

Lodestone is an application to help you navigate the Fediverse. It surfaces things you enjoyed and allows you to sift through them again. It aims to be a companion to the server hosting your Mastodon instance, or any other compatible Fediverse software.

+
+ Loading application… + +
diff --git a/shadow-cljs.edn b/shadow-cljs.edn index ca3369a..a7e1149 100644 --- a/shadow-cljs.edn +++ b/shadow-cljs.edn @@ -5,10 +5,8 @@ "src/test"] :dependencies - [[datascript/datascript "1.7.8"] ; unused - - [reagent/reagent "2.0.1"] - [io.github.tonsky/fast-edn "1.1.3"] + [[reagent/reagent "2.0.1"] + [applied-science/js-interop "0.4.2"] [binaryage/devtools "1.0.7"] ; loaded automatically, see https://shadow-cljs.github.io/docs/UsersGuide.html#_preloads ] @@ -18,4 +16,5 @@ :builds {:frontend {:target :browser - :modules {:main {:init-fn computersandblues.lodestone.app/init}}}}} + :modules {:main {:init-fn computersandblues.lodestone.app/init}} + :js-options {:entry-keys ["module" "browser" "main"]}}}} diff --git a/src/main/computersandblues/lodestone/app.cljs b/src/main/computersandblues/lodestone/app.cljs index 9ffc3bc..12cdfaf 100644 --- a/src/main/computersandblues/lodestone/app.cljs +++ b/src/main/computersandblues/lodestone/app.cljs @@ -1,47 +1,286 @@ (ns computersandblues.lodestone.app (:require [reagent.core :as r] [reagent.dom.client :as rd] + [applied-science.js-interop :as j] [clojure.string :as str] - [clojure.pprint :as pprint])) - + [clojure.pprint :as pprint] + [computersandblues.lodestone.database :as db])) (defonce state (r/atom {:root nil - :query nil + + :section :login + + :section/login {} + ; TODO: Handle other lists - :favorites []})) + :section/posts {:query nil + :per-page 50 + ; TODO: pagination + ; :page 0 + ; :max-displayed-id nil + ; :order [:date :desc] + :total 0 + :displayed-posts []}})) -; TODO: Login / Landing Page / Store bearer token in localstorage +;; Mastodon API helpers -(defn fetch-favs [{:keys [server-url bearer-token]}] - ; TODO: Pagination - (let [url (str server-url "/api/v1/favourites") - auth-header (str "Bearer " bearer-token)] - (.. (js/fetch url - #js {:method "GET" - :headers #js {"Authorization" auth-header}}) +(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) - (.then (.json res) - (fn [body] - {:raw res - :body (js->clj body {:keywordize-keys true})})) - (do - (println res) - (throw (ex-info "Could not fetch favorites" {:response 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!) + +(comment + (-> (db/open-cursor! ::db/application db/all) + (db/transduce-cursor (comp (take 1) + (map ))) + (.then db/cursor-value)) + ) + +(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}}] + ((fn fetch-favorites' [url] + (println :calling url) + (swap! state assoc :api/state :loading) + (-> (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 dissoc :api/state :loading)))) + (.catch (fn [response] + (swap! state dissoc :api/state) + (on-error response))))) + (favorites-url {:instance-url instance-url :max-id max-id}))) + +;;; views + +(defn debounce [ms f] + (let [timeout (volatile! nil)] + (fn debounced-fn [& args] + (when @timeout + (js/clearTimeout @timeout)) + (js/console.log "debounced-fn called" (js/Date.now)) + (vreset! timeout + (js/setTimeout (fn scheduled-fn [] + (js/console.log "scheduled-fn called" (js/Date.now)) + (vreset! timeout nil) + (apply f args)) ms))))) (defn search [] [:input {:placeholder "Start typing to search…" :on-change (fn [e] (let [query (.. e -target -value)] - (swap! state assoc :query (if (str/blank? query) nil query)))) - :value (:query @state)}]) + (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 [obj] - (let [pprinted (r/atom nil)] +(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 (fn [_] - (when-not @pprinted - (reset! pprinted (with-out-str (pprint/pprint obj)))))} + [:details.debug {:on-toggle pprint + :on-mouseover pprint} [:summary "Inspect"] [:pre @pprinted]]))) @@ -49,14 +288,20 @@ (:username user)) (defn attachment [{:keys [attachment]}] - (prn attachment) (case (:type attachment) "image" [:img {:src (:preview_url attachment) - :alt (:description 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) - ; TODO: handle attachments [:article [:div.users [user {:user (:account post)}] @@ -69,40 +314,107 @@ (interleave (repeat ", ")) (drop 1)) ")"])] [:div.url [:a {:href (:url post)} (:url post)]] - [:div.content {:dangerouslySetInnerHTML (r/unsafe-html (:content post))}] - (when (seq (:media_attachments post)) - [:div.attachments (map-indexed (fn [idx item] - ^{:key idx} [attachment {:attachment item}]) - (:media_attachments post))]) + [:div.content {:dangerouslySetInnerHTML (r/unsafe-html (:content post))} + (when (seq (:media_attachments post)) + [:div.attachments (map-indexed (fn [idx item] + ^{:key idx} [attachment {:attachment item}] + (:media_attachments post)))])] #_[debug post]]) -(defn app [] - (let [favorites (:favorites @state) - query (:query @state) +(defn ->regex [s] + (try + (js/RegExp. s "i") + (catch js/Error _ + (js/RegExp. (js/RegExp.escape s) "i")))) + +(defn- refresh-displayed-posts! + [posts-section] + (let [{:keys [per-page query]} posts-section matches? (if query - (partial re-find (js/RegExp. query "i")) + (partial re-find (->regex query)) (constantly true)) - matches (filter (fn [post] - (or (matches? (:content post)) - (matches? (-> post :account :acct)) ; search for url + username of poster - (some #(matches? (:username %)) (:mentions post)))) ; search only for username of mentions - favorites)] - [:div#app - [:h1 "Lodestone"] + ; this `xform` is responsible for filtering and building the final list + ; of results by iterating through the posts in the database. + xform (comp + (filter (fn [post] + (or (matches? (j/get post :content)) + (matches? (j/get-in post [:account :acct])) ; search for url + username of poster + (some #(matches? (j/get % :username)) (j/get post :mentions))))) ; search only for username of mentions + (take per-page) + (map #(js->clj % :keywordize-keys true)))] + (-> (js/Promise.all #js [(db/count! ::db/posts) + (-> (db/open-cursor! ::db/posts 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)))))))) + +(def debounced-refresh! (debounce 100 (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]} posts] + [:section.favorites [:h2 "Favorites"] - [:span (str "Loaded " (count favorites) " favorites" - (when query - (str ", displaying " (count matches) " matches")))] - [:div [search]] - [:ul (map-indexed (fn [idx favorite] - ^{:key idx} [:li [post {:post favorite}]]) matches)]])) + [: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] + #_(cond (= api-state :loading) " …" + (= api-state :error) " API Error!")]] + [:ul.results (map-indexed (fn [idx favorite] + ^{:key idx} [:li [post {:post favorite}]]) 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 1) + +(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"}))}) + +;; go go go (defn ^:dev/after-load render [] (rd/render (:root @state) [app])) (defn init [] - (-> (fetch-favs {:server-url "https://post.lurk.org" - :bearer-token "CHANGEME"}) - (.then #(swap! state assoc :favorites (:body %)))) - (swap! state assoc :root (rd/create-root (.-body js/document))) - (render)) + (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))))) diff --git a/src/main/computersandblues/lodestone/database.cljs b/src/main/computersandblues/lodestone/database.cljs new file mode 100644 index 0000000..5b9e310 --- /dev/null +++ b/src/main/computersandblues/lodestone/database.cljs @@ -0,0 +1,143 @@ +(ns computersandblues.lodestone.database + (:require [clojure.string :as str])) + +(defonce +db+ (atom nil)) + +(defn setup! [namespace db-version migrations] + (assert (some? (migrations db-version)) "Will not increase db version as no migration is found") + (let [request (js/indexedDB.open (str namespace) db-version)] + (js/Promise. + (fn [resolve reject] + (doto request + (.addEventListener "success" + (fn [ev] + (let [db (.-result request)] + ; see https://javascript.info/indexeddb#parallel-update-problem + (.addEventListener db "versionchange" + (fn [] + (.. request -result close) + (js/alert "Database is outdated! Please reload the browser window."))) + (reset! +db+ db) + (resolve @+db+ ev)))) + (.addEventListener "upgradeneeded" + (fn [ev] + (let [db (.-result request) + old-version (.-oldVersion ev)] + (js/console.log ::upgradeneeded ev db) + (doseq [version (range (inc old-version) (inc db-version)) + :let [migration (migrations version)]] + (migration db))))) + ; we don't add a listener for "blocked" events because we handle "versionchange" above + (.addEventListener "error" (fn [ev] (reject (.-result request) ev)))))))) + +(defn open-store + ([db store-id] + (open-store db store-id "readonly")) + ([db store-id permissions] + (let [store-id (str store-id) ; simplifies using keywords as store identifiers + txn (.transaction db store-id permissions)] + (.objectStore txn store-id)))) + +(defn create-object-store! [db store-id key-opts] + (.createObjectStore db (str store-id) (clj->js key-opts))) + +(defn- promisify [request] + (js/Promise. (fn [resolve reject] + (doto request + (.addEventListener "success" (fn [] (resolve (.-result request)))) + (.addEventListener "error" (fn [] (reject (.-error request)))))))) + +(defn add! [store-id object] + (let [store (open-store @+db+ store-id "readwrite") + request (.add store (clj->js object))] + (promisify request))) + +(defn put! [store-id object] + (let [store (open-store @+db+ store-id "readwrite") + request (.put store (clj->js object))] + (promisify request))) + +(defn get! [store-id k] + (let [store (open-store @+db+ store-id) + request (.get store k)] + (promisify request))) + +(defn get-all! [store-id key-range] + (let [store (open-store @+db+ store-id) + request (.getAll store key-range)] + (promisify request))) + +(defn open-cursor! + ([store-id key-range] (open-cursor! store-id key-range "next")) + ([store-id key-range direction] + (let [store (open-store @+db+ store-id)] + (.openCursor store key-range direction)))) + +(defn cursor-value [cursor] + (js->clj (some-> cursor .-value) :keywordize-keys true)) + +#_(defn logging [f] + (let [n (volatile! 0)] + (fn [& args] + (when (< @n 10) + (vswap! n inc) + (js/console.log :logging args) + (apply f args))))) + +(defn transduce-cursor + "Allows to transduce over all values in a cursor. + + Takes a transducer `xform`, a reducing function `rf` and an initial `init`. + If no `init` is given, it will default to `(rf)`. If no `rf` is given, the + resulting value will be a persistent vector containing the result of all steps." + ([cursor-req xform] + ; optimization: work with a transient vector before returning the final result + (-> (transduce-cursor cursor-req xform conj! (transient [])) + (.then persistent!))) + ([cursor-req xform rf] + (transduce-cursor cursor-req xform rf (rf))) + ([cursor-req xform rf init] + (let [result (volatile! init) + xform (xform rf)] + (js/Promise. + (fn [resolve _] + (.addEventListener cursor-req "success" + (fn [ev] + (if-let [cursor (-> ev .-target .-result)] + ; NOTE: each step will work with the raw js value + ; to avoid unnecessary conversion costs. + (let [step (xform @result (.-value cursor))] + (if (reduced? step) + (do + (vreset! result @step) + (resolve @result)) + (do + (vreset! result step) + (.continue cursor)))) + (resolve @result))))))))) + +(def all (js/IDBKeyRange.lowerBound "")) + +(comment + + (let [re (js/RegExp. "user" "i")] + (do (print "starting…" (js/Date.)) + (-> (open-cursor! ::posts all) + (transduce-cursor (comp (filter #(re-find re (.-content %))) + (take 50) + (map #(js->clj % :keywordize-keys true)))) + (.then (fn [result] + (print "done!" (js/Date.)) + (js/console.log (first result))))))) + + ) + +(defn delete! [store-id k] + (let [store (open-store @+db+ store-id) + request (.delete store k)] + (promisify request))) + +(defn count! [store-id] + (let [store (open-store @+db+ store-id) + request (.count store)] + (promisify request)))