Finish first working version w/ indexed db cache
This commit is contained in:
parent
8bb3a3b8d7
commit
2e48899420
4 changed files with 538 additions and 65 deletions
|
|
@ -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)))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue