613 lines
26 KiB
Clojure
613 lines
26 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.interop :refer [promise-all promise-resolve promise-reject]]
|
|
[computersandblues.lodestone.match :refer [query->matching-xform]]
|
|
[applied-science.js-interop :as j]))
|
|
|
|
(def posts-init-state
|
|
{:query nil
|
|
:last-update -1
|
|
; TODO: pagination
|
|
; :page 0
|
|
; :max-displayed-id nil
|
|
; :order [:date :desc]
|
|
:per-page 50
|
|
:loading #{}
|
|
:total 0
|
|
:displayed-posts []})
|
|
|
|
(defonce state (r/atom {:root nil
|
|
|
|
:section :login
|
|
|
|
:section/login {}
|
|
|
|
; TODO: Handle other lists
|
|
:section/posts posts-init-state}))
|
|
|
|
; TODO Handle 429
|
|
; TODO Search for tags (`#foo`) and handles (`@bar`)
|
|
; TODO Explain which kind of search currently is possible
|
|
|
|
;; Mastodon API helpers
|
|
|
|
(defn- now []
|
|
(js/Date.now))
|
|
|
|
(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/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]
|
|
(promise-resolve {:raw res
|
|
:body (js->clj body {:keywordize-keys true})}))))
|
|
(promise-reject res))))))
|
|
|
|
(defn- ->search-params [params]
|
|
(js/URLSearchParams. (clj->js params)))
|
|
|
|
(defn- url->search-params [url]
|
|
(.-searchParams (js/URL. url)))
|
|
|
|
;; 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]
|
|
(-> (.-search location)
|
|
(js/URLSearchParams.)
|
|
(.get "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)
|
|
path (-> js/location .-pathname)]
|
|
(.replaceState js/history nil "" path) ; remove ?code= param
|
|
(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!)
|
|
|
|
(defn- fetch-application-settings []
|
|
(let [cursor (db/open-cursor ::db/application ::db/all)]
|
|
(. (db/first-result cursor)
|
|
(then #(js->clj % :keywordize-keys true)))))
|
|
|
|
(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.
|
|
(-> (fetch-application-settings)
|
|
(.then (fn [application]
|
|
(let [code (oauth-authorization-code (.-location js/window))]
|
|
(cond
|
|
(:bearer_token application) 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)
|
|
(promise-all [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)})
|
|
(swap! state assoc-in [:section/posts :last-update] (now))))))))
|
|
|
|
;;; views
|
|
|
|
(defn login-section []
|
|
[:section.login
|
|
[:h2 "Connect your account"]
|
|
[:p "After connecting your account, Lodestone will load the posts you starred, and allow you to efficiently search through them. All data is processed privately and locally in your browser."]
|
|
[:p [:strong "Please connect your account 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"} "◰ Connect"]]])
|
|
|
|
|
|
;; favorites section
|
|
|
|
;;; api interaction
|
|
|
|
(defn- favorites-url [{:keys [instance-url limit max-id min-id]
|
|
:or {limit 40}}]
|
|
(let [params (->search-params (cond-> {:limit limit}
|
|
max-id (assoc :max_id max-id)
|
|
min-id (assoc :min_id min-id)))]
|
|
(str instance-url "/api/v1/favourites?" params)))
|
|
|
|
(defn paginate-posts!
|
|
[{:keys [instance-url bearer-token
|
|
max-id min-id
|
|
on-response on-error continue?]
|
|
:or {continue? (fn [response]
|
|
(seq (:body response)))
|
|
on-response on-response
|
|
on-error on-error}}]
|
|
((fn paginate! [url]
|
|
(let [req-id (now)]
|
|
(js/console.log :paginate! url :max-id max-id :min-id min-id)
|
|
(swap! state update-in [:section/posts :loading] conj req-id)
|
|
(-> (mastodon-request! {:url url :bearer-token bearer-token})
|
|
(.then (fn [response]
|
|
(let [url-params (url->search-params (.-url (:raw response)))
|
|
timeout 500
|
|
next-url (link-header (if (.get url-params "min_id") "prev" "next") (:raw response))]
|
|
(on-response response)
|
|
(if (and (continue? response) next-url)
|
|
(do
|
|
(js/setTimeout #(paginate! next-url) timeout)
|
|
(js/setTimeout #(swap! state update-in [:section/posts :loading] disj req-id) (+ timeout 16)))
|
|
(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 :min-id min-id})))
|
|
|
|
;;; views
|
|
|
|
(defn debounce
|
|
"Wraps `f` so it's called at most once every `ms` milliseconds. Will schedule
|
|
the last call to `f` so that it's called after the delay has passed, and will
|
|
always prefer to call the most recent call to `f` as close to the delay
|
|
as possible."
|
|
[ms f]
|
|
(let [timeout (volatile! nil)]
|
|
(fn debounced-fn [& args]
|
|
(when @timeout
|
|
(js/clearTimeout @timeout))
|
|
(vreset! timeout (js/setTimeout #(apply f args) ms)))))
|
|
|
|
(defn- refresh-displayed-posts!
|
|
[{:keys [per-page query]}]
|
|
(let [; this `xform` is responsible for filtering and building the list of
|
|
; results that is displayed to the user. it iterates through all stored
|
|
; posts in the database and returns a result that will be rendered
|
|
; by the `post` component below.
|
|
xform (comp
|
|
(query->matching-xform query)
|
|
(take per-page)
|
|
(map #(js->clj % :keywordize-keys true)))
|
|
posts-cursor (db/open-cursor ::db/posts
|
|
::db/all
|
|
{:index ::db/post-created-at
|
|
:direction :desc})
|
|
refresh-id (now)]
|
|
(swap! state update-in [:section/posts :loading] conj refresh-id)
|
|
(js/console.log :start-query (.toISOString (js/Date.)))
|
|
(. (promise-all [(db/count ::db/posts)
|
|
(db/transduce-cursor xform posts-cursor)])
|
|
(then (fn [[total displayed-posts]]
|
|
(js/console.log :end-query (.toISOString (js/Date.)))
|
|
(swap! state update :section/posts #(-> (assoc % :total total)
|
|
(assoc :displayed-posts displayed-posts)
|
|
(update :loading disj refresh-id))))))))
|
|
|
|
(defonce debounced-refresh! (debounce (* 16 16) refresh-displayed-posts!))
|
|
|
|
; we use reagent's machinery below to define a callback that runs whenever the
|
|
; values change that serve as input to the current search reults.
|
|
|
|
(def search-result-inputs (r/reaction (select-keys (:section/posts @state) [:query :per-page :last-update])))
|
|
|
|
(defonce update-search-results (r/track! (fn []
|
|
(let [inputs @search-result-inputs]
|
|
(debounced-refresh! inputs)))))
|
|
|
|
#_(defonce refresh-id-tracker (r/track! (fn []
|
|
(let [refresh-ids @(r/cursor state [:section/posts :loading])]
|
|
(js/console.log :refresh-id-tracker (count refresh-ids) refresh-ids)))))
|
|
|
|
(defn search [{:keys [query]}]
|
|
[:input {:placeholder "Start typing to search…"
|
|
:type "search"
|
|
:initial-value query
|
|
:on-change (fn [e]
|
|
(let [query (.. e -target -value)]
|
|
(swap! state assoc-in [:section/posts :query] (if (str/blank? query) nil 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]}]
|
|
[:em (:username user)])
|
|
|
|
(defn- list-accounts [accounts]
|
|
[:<>
|
|
(->> (map-indexed (fn [idx account]
|
|
^{:key idx} [user {:user account}]) accounts)
|
|
(interleave (repeat ", "))
|
|
(drop 1))])
|
|
|
|
(defn img-attachment [{:keys [attachment preview-url]}]
|
|
[:img {:src preview-url
|
|
:alt (:description attachment)
|
|
:loading "lazy"}])
|
|
|
|
(defn video-attachment [{:keys [attachment remote-url ext]}]
|
|
[:video {:controls true}
|
|
[:source {:type (str "video/" ext) :src remote-url}]
|
|
[:a {:href (:remote_url attachment)} (str "Original video at " (:remote_url attachment))]])
|
|
|
|
(defn gifv-attachment [{:keys [attachment remote-url ext]}]
|
|
(let [autoplay (r/atom false)
|
|
toggle-autoplay #(swap! autoplay not)]
|
|
(fn []
|
|
[:video {:loop true :autoplay @autoplay :muted true :on-pointer-enter toggle-autoplay}
|
|
[:source {:type (str "video/" ext) :src remote-url}]
|
|
[:a {:href (:remote_url attachment)} (str "Original video at " (:remote_url attachment))]])))
|
|
|
|
(defn attachment [{:keys [attachment]}]
|
|
(let [preview-url (or (:preview_remote_url attachment) (:preview_url attachment))
|
|
remote-url (or (:remote_url attachment) (:url attachment))
|
|
ext (last (str/split remote-url #"\."))
|
|
props {:attachment attachment :preview-url preview-url :remote-url remote-url :ext ext}]
|
|
(case (:type attachment)
|
|
"image" [img-attachment props]
|
|
"video" [video-attachment props]
|
|
"gifv" [gifv-attachment props]
|
|
[:div [:strong "Unsupported attachment"]
|
|
[debug attachment]])))
|
|
|
|
|
|
(comment
|
|
; query current results
|
|
(->> (-> @state :section/posts :displayed-posts) (map :id) (take 4) (into #{}))
|
|
|
|
; run and time a query on the database
|
|
(do
|
|
(js/console.log :start (.toISOString (js/Date.)))
|
|
(let [xform (comp #_(mapcat (j/get :tags))
|
|
#_(filter #(= "typescript" (j/get % :name)))
|
|
#_(take 10)
|
|
(filter (fn [_]
|
|
(< (rand) 0.1)) #_(comp #{"115534300206096276"} (j/get :id)))
|
|
(map (j/get :id)))
|
|
posts-cursor (db/open-cursor ::db/posts ::db/all)]
|
|
(.. (db/transduce-cursor xform conj! (transient #{}) posts-cursor)
|
|
(then persistent!)
|
|
(then (fn [result]
|
|
(js/console.log :end (.toISOString (js/Date.)))
|
|
(let [result (into (sorted-set) result)]
|
|
(js/console.log :sorted (.toISOString (js/Date.)))
|
|
(js/console.log :accts (count result))))))))
|
|
)
|
|
|
|
(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))
|
|
(into [:section.attachments]
|
|
(map (fn [item]
|
|
(let [key (str "post-" (:id post) "-attachment-" (:id item))]
|
|
^{:key key} [attachment {:attachment item}])))
|
|
(:media_attachments post)))
|
|
[:nav
|
|
[:ul.controls
|
|
[:li.control-element.url
|
|
[:a.control-button {:href (:url post) :target "_blank"} "↗ Open original post"]]
|
|
[:li.control-element.clipboard
|
|
[:a.control-button
|
|
{:href "#"
|
|
:on-click (fn [e]
|
|
(.preventDefault e)
|
|
(js/navigator.clipboard.writeText (:url post)))} "◎ Copy URL to clipboard"]]]]
|
|
#_[debug post]])
|
|
|
|
#_(defn logging [f]
|
|
(let [n (volatile! 0)]
|
|
(fn [& args]
|
|
(when (< @n 10)
|
|
(vswap! n inc)
|
|
(js/console.log :logging args)
|
|
(apply f args)))))
|
|
|
|
(defn- fetch-posts! [opts]
|
|
(let [defaults {:max-id nil
|
|
:on-response (fn [response]
|
|
(let [url-params (url->search-params (.-url (:raw response)))]
|
|
(doseq [post (:body response)]
|
|
; this returns a promise, but we don't care if these updates happen in sequence
|
|
(db/put! ::db/posts (cond-> post
|
|
; these IDs are internal server ids and it looks like
|
|
; they are not returned in any response body; they are
|
|
; required for pagination, so we're storing them to be
|
|
; able to abort and continue pagination if we want or
|
|
; if outer circumstances decide so (for example if the
|
|
; tab is closed)
|
|
(.get url-params "max_id")
|
|
(assoc :internal_id (parse-long (.get url-params "max_id")))
|
|
|
|
(.get url-params "min_id")
|
|
(assoc :internal_id (parse-long (.get url-params "min_id")))))))
|
|
(swap! state assoc-in [:section/posts :last-update] (now)))}]
|
|
(paginate-posts! (merge defaults opts))))
|
|
|
|
(defn- bound
|
|
"Returns a promise which resolves to the smallest or largest value returned by
|
|
an index."
|
|
[store-id index xform max-or-min]
|
|
(let [cursor (db/open-cursor store-id ::db/all {:index index
|
|
:direction (if (= max-or-min :min)
|
|
:asc
|
|
:desc)})]
|
|
(db/first-result xform cursor)))
|
|
|
|
(defn- fetch-more-posts! [e]
|
|
(let [internal-id-bound (partial bound ::db/posts ::db/post-internal-id (keep (j/get :internal_id)))]
|
|
(.preventDefault e)
|
|
(. (promise-all [(fetch-application-settings) (internal-id-bound :min) (internal-id-bound :max)])
|
|
(then (fn [[application min-id max-id]]
|
|
(let [opts {:instance-url (:instance_url application)
|
|
:bearer-token (:bearer_token application)}]
|
|
(when max-id
|
|
(fetch-posts! (assoc opts :min-id max-id)))
|
|
(when min-id
|
|
(fetch-posts! (assoc opts :max-id min-id)))
|
|
(when-not (or min-id max-id)
|
|
(fetch-posts! opts))))))))
|
|
|
|
(defn- disconnect-account! [e]
|
|
(.preventDefault e)
|
|
(when (js/confirm "Are you sure? This will log you out and clear your local cache.")
|
|
(. (promise-all [(db/clear! ::db/posts) (db/clear! ::db/application)])
|
|
(then (fn [_]
|
|
(swap! state #(-> (assoc % :section :login)
|
|
(assoc :section/posts posts-init-state))))))))
|
|
|
|
(defn loading-indicator [{:keys [loading]}]
|
|
(when (seq loading)
|
|
; see https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute/d#elliptical_arc_curve
|
|
[:svg.loading-indicator {:viewBox "-10 -10 120 120" :xmlns "http://www.w3.org/2000/svg"}
|
|
[:path.arc {:d "M50,0 A50,50 180 0,1 100,50"}]]))
|
|
|
|
(defn posts-section [{:keys [posts]}]
|
|
(let [{:keys [per-page query total displayed-posts loading query]} posts
|
|
n-displayed (count displayed-posts)]
|
|
[:section.posts
|
|
[:h2 "Favorites"]
|
|
[:header.controls
|
|
[:p.display-info
|
|
(str "Loaded " total " posts"
|
|
(when (or query (> total per-page))
|
|
(str ", displaying " n-displayed (when query
|
|
(if (= 1 n-displayed)
|
|
" match"
|
|
" matches")))))]
|
|
[:section.search-form
|
|
[search {:query query}]
|
|
[loading-indicator {:loading loading}]
|
|
#_(cond (= api-state :loading) " …"
|
|
(= api-state :error) " API Error!")]
|
|
[:section.buttons
|
|
[:button.control-button {:on-click fetch-more-posts! :disabled (boolean (seq loading))} "⇓ Fetch more"]
|
|
[:button.control-button {:on-click disconnect-account!} "▤ Disconnect account"]]]
|
|
(into [:ul.results]
|
|
(map (fn [p]
|
|
(let [key (str "post-" (:id p))]
|
|
^{:key key} [:li.result [post {:post p}]])))
|
|
displayed-posts)]))
|
|
|
|
;; help section
|
|
|
|
(defn help-section []
|
|
[:section.help
|
|
[:h2 "Help"]
|
|
[:h3 "Search Syntax"]
|
|
[:ul.search-syntax
|
|
[:li "Three are several places that we take into account when looking for query results"
|
|
[:ul
|
|
[:li "Post content"]
|
|
[:li "Creator of the post"]
|
|
[:li "Any mentioned account"]]]
|
|
[:li "Upper- and lowercase does not make a difference."]
|
|
[:li "All words are matched separately. They do not have to appear in the post in the same order, but they all have to appear."]
|
|
[:li "If you want to search verbatim for a phrase, \"quote it like this\""]
|
|
[:li "Lodestone tries to turn words into regular expressions. " [:code "fossi.*ergy"] " will match \"fossile energy\"." [:code "bo?ar"] " will match both boar and bar."]]])
|
|
|
|
;; the component tying it all together
|
|
|
|
(defn app []
|
|
(let [section (:section @state)
|
|
posts (:section/posts @state)]
|
|
[:main#app
|
|
(case section
|
|
:login [login-section]
|
|
:posts [posts-section {:posts posts}]
|
|
:help [help-section])]))
|
|
|
|
;; database
|
|
|
|
;;; we provide two different kinds of migrations
|
|
;;;
|
|
;;; - structural migrations
|
|
;;; - data migrations
|
|
;;;
|
|
;;; this is necessary due to the constraints imposed on us by indexeddb.
|
|
;;;
|
|
;;; structural migrations run in a callback after opening the database. they run
|
|
;;; synchronously and do things like creates stores and indices. because they run
|
|
;;; synchronously, they cannot modify any of the stored data.
|
|
;;;
|
|
;;; data migrations can do that! they run after all structural migrations for
|
|
;;; the current database version have succeeded, and work on the open database.
|
|
;;;
|
|
;;; note that for each db-version, there needs to be at least one structural or
|
|
;;; data migration. it is fine to have both for a single version, in which case
|
|
;;; the structural migration will run first.
|
|
|
|
(def db-version 4)
|
|
|
|
(def structural-migrations
|
|
{1 (fn =0001-create-stores [db _]
|
|
(db/create-object-store! db ::db/application {:keyPath "id"})
|
|
(db/create-object-store! db ::db/posts {:keyPath "id"}))
|
|
2 (fn =0002-add-post-created-at-idx [_ txn]
|
|
(-> (db/open-store txn ::db/posts "readwrite")
|
|
(db/create-index! ::db/post-created-at "created_at" {:unique false})))
|
|
3 (fn =0003-add-post-internal-id-idx [_ txn]
|
|
(-> (db/open-store txn ::db/posts "readwrite")
|
|
(db/create-index! ::db/post-internal-id "internal_id" {:unique false})))})
|
|
|
|
(def data-migrations
|
|
{4 (fn =0004-convert-internal-ids [db]
|
|
(let [cursor (db/open-cursor db ::db/posts ::db/post-internal-id ::db/all)
|
|
result (db/transduce-cursor (filter (comp string? (j/get :internal_id))) cursor)]
|
|
(.then result
|
|
(fn [rows]
|
|
(promise-all (for [row rows]
|
|
(db/put! ::db/posts (j/update! row :internal_id parse-long))))))))})
|
|
|
|
;; 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 structural-migrations data-migrations)
|
|
(.then #(setup-application!))
|
|
(.catch (fn [err]
|
|
(js/console.error ::db/setup! err)))))
|