near/computersandblues.lodestone
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Finish first working version w/ indexed db cache

Browse source
This commit is contained in:
arne 2025-11-18 12:49:07 +01:00
commit 2e48899420
4 changed files with 538 additions and 65 deletions
Download patch file Download diff file Expand all files Collapse all files

27
public/index.html
View file

@ -11,7 +11,7 @@
body { body {
margin: 24px; margin: 24px;
min-height: 100vh; min-height: 100vh;
max-width: 1000px; max-width: 960px;
background: #fbf5de; background: #fbf5de;
color: #222; color: #222;
font-family: sans-serif; font-family: sans-serif;
@ -72,9 +72,25 @@
clear: both; clear: both;
} }
input { input,
button {
margin: 3px 0; margin: 3px 0;
padding: 3px; 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 { .controls {
@ -100,8 +116,11 @@
<body> <body>
<img class="illustration" src="./img/lodestone_attracting_nails.png" width="150" /> <img class="illustration" src="./img/lodestone_attracting_nails.png" width="150" />
<h1>Lodestone</h1> <h1>Lodestone</h1>
<p>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.</p> <p>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.</p>
<div id="root"></div> <div id="root">
Loading application…
<noscript>Please turn on JavaScript to run the application.</noscript>
</div>
<script src="/js/main.js"></script> <script src="/js/main.js"></script>
</body> </body>
</html> </html>

9
shadow-cljs.edn
View file

@ -5,10 +5,8 @@
"src/test"] "src/test"]
:dependencies :dependencies
[[datascript/datascript "1.7.8"] ; unused [[reagent/reagent "2.0.1"]
[applied-science/js-interop "0.4.2"]
[reagent/reagent "2.0.1"]
[io.github.tonsky/fast-edn "1.1.3"]
[binaryage/devtools "1.0.7"] ; loaded automatically, see https://shadow-cljs.github.io/docs/UsersGuide.html#_preloads [binaryage/devtools "1.0.7"] ; loaded automatically, see https://shadow-cljs.github.io/docs/UsersGuide.html#_preloads
] ]
@ -18,4 +16,5 @@
:builds :builds
{:frontend {:frontend
{:target :browser {: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"]}}}}

424
src/main/computersandblues/lodestone/app.cljs
View file

@ -1,47 +1,286 @@
(ns computersandblues.lodestone.app (ns computersandblues.lodestone.app
(:require [reagent.core :as r] (:require [reagent.core :as r]
[reagent.dom.client :as rd] [reagent.dom.client :as rd]
[applied-science.js-interop :as j]
[clojure.string :as str] [clojure.string :as str]
[clojure.pprint :as pprint])) [clojure.pprint :as pprint]
[computersandblues.lodestone.database :as db]))
(defonce state (r/atom {:root nil (defonce state (r/atom {:root nil
:query nil
:section :login
:section/login {}
; TODO: Handle other lists ; 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]}] (defn- link-header
; TODO: Pagination "Given a JS `Response` object, will parse the `link` header and find a link of
(let [url (str server-url "/api/v1/favourites") a given `link-type` if present. Useful for paginating API requests."
auth-header (str "Bearer " bearer-token)] [link-type response]
(.. (js/fetch url (let [links (-> (.. response -headers (get "link"))
#js {:method "GET" (str/split ", "))
:headers #js {"Authorization" auth-header}}) 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] (then (fn [res]
(if (.-ok res) (if (.-ok res)
(.then (.json res) (-> (.json res)
(fn [body] (.then
{:raw res (fn [body]
:body (js->clj body {:keywordize-keys true})})) (resolve {:raw res
(do :body (js->clj body {:keywordize-keys true})}))))
(println res) (reject res))))))))
(throw (ex-info "Could not fetch favorites" {:response 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 [] (defn search []
[:input {:placeholder "Start typing to search…" [:input {:placeholder "Start typing to search…"
:on-change (fn [e] :on-change (fn [e]
(let [query (.. e -target -value)] (let [query (.. e -target -value)]
(swap! state assoc :query (if (str/blank? query) nil query)))) (swap! state assoc-in [:section/posts :query] (if (str/blank? query) nil query))
:value (:query @state)}]) (refresh-displayed-posts! (:section/posts @state))))
:value (-> @state :section/posts :query)}])
(defn debug [obj] (defn- debug
(let [pprinted (r/atom nil)] "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 [] (fn []
[:details.debug {:on-toggle (fn [_] [:details.debug {:on-toggle pprint
(when-not @pprinted :on-mouseover pprint}
(reset! pprinted (with-out-str (pprint/pprint obj)))))}
[:summary "Inspect"] [:summary "Inspect"]
[:pre @pprinted]]))) [:pre @pprinted]])))
@ -49,14 +288,20 @@
(:username user)) (:username user))
(defn attachment [{:keys [attachment]}] (defn attachment [{:keys [attachment]}]
(prn attachment)
(case (:type attachment) (case (:type attachment)
"image" [:img {:src (:preview_url 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]}] (defn post [{:keys [post]}]
; TODO: handle (:sensitive post) ; TODO: handle (:sensitive post)
; TODO: handle attachments
[:article [:article
[:div.users [:div.users
[user {:user (:account post)}] [user {:user (:account post)}]
@ -69,40 +314,107 @@
(interleave (repeat ", ")) (interleave (repeat ", "))
(drop 1)) ")"])] (drop 1)) ")"])]
[:div.url [:a {:href (:url post)} (:url post)]] [:div.url [:a {:href (:url post)} (:url post)]]
[:div.content {:dangerouslySetInnerHTML (r/unsafe-html (:content post))}] [:div.content {:dangerouslySetInnerHTML (r/unsafe-html (:content post))}
(when (seq (:media_attachments post)) (when (seq (:media_attachments post))
[:div.attachments (map-indexed (fn [idx item] [:div.attachments (map-indexed (fn [idx item]
^{:key idx} [attachment {:attachment item}]) ^{:key idx} [attachment {:attachment item}]
(:media_attachments post))]) (:media_attachments post)))])]
#_[debug post]]) #_[debug post]])
(defn app [] (defn ->regex [s]
(let [favorites (:favorites @state) (try
query (:query @state) (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 matches? (if query
(partial re-find (js/RegExp. query "i")) (partial re-find (->regex query))
(constantly true)) (constantly true))
matches (filter (fn [post] ; this `xform` is responsible for filtering and building the final list
(or (matches? (:content post)) ; of results by iterating through the posts in the database.
(matches? (-> post :account :acct)) ; search for url + username of poster xform (comp
(some #(matches? (:username %)) (:mentions post)))) ; search only for username of mentions (filter (fn [post]
favorites)] (or (matches? (j/get post :content))
[:div#app (matches? (j/get-in post [:account :acct])) ; search for url + username of poster
[:h1 "Lodestone"] (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"] [:h2 "Favorites"]
[:span (str "Loaded " (count favorites) " favorites" [:header.controls
(when query [:p.display-info
(str ", displaying " (count matches) " matches")))] (str "Loaded " total " posts"
[:div [search]] (when (or query (> total per-page))
[:ul (map-indexed (fn [idx favorite] (str ", displaying " (count displayed-posts) (when query " matches"))))]
^{:key idx} [:li [post {:post favorite}]]) 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 [] (defn ^:dev/after-load render []
(rd/render (:root @state) [app])) (rd/render (:root @state) [app]))
(defn init [] (defn init []
(-> (fetch-favs {:server-url "https://post.lurk.org" (swap! state assoc :root (rd/create-root (js/document.querySelector "#root")))
:bearer-token "CHANGEME"}) (render)
(.then #(swap! state assoc :favorites (:body %)))) (-> (db/setup! ::database db-version migrations)
(swap! state assoc :root (rd/create-root (.-body js/document))) (.then #(setup-application!))
(render)) (.catch (fn [err]
(js/console.log ::db/setup! err)))))

143
src/main/computersandblues/lodestone/database.cljs Normal file
View file

@ -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)))