(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]] [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- promise-all [xs] (js/Promise.all (apply array xs))) (defn- promise-resolve [val] (js/Promise.resolve val)) (defn- promise-reject [val] (js/Promise.reject val)) (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 [prev (volatile! (now))] (fn debounced-fn [& args] (when (< ms (- (now) @prev)) (js/requestAnimationFrame #(apply f args))) (vreset! prev (now))))) (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 (filter (query->matching-fn 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) (. (promise-all [(db/count ::db/posts) (db/transduce-cursor xform posts-cursor)]) (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 48 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))))) (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 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 #"\."))] (case (:type attachment) "image" [:img {:src preview-url :srcset (str preview-url ", " remote-url) :alt (:description attachment) :loading "lazy"}] "video" [:video {:controls true} [:source {:type (str "video/" ext) :src remote-url}] [:a {:href (:remote_url attachment)} (str "Original video at " (:remote_url attachment))]] "gifv" (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))]])) [:div [:strong "Unsupported attachment"] [debug attachment]]))) (comment ; query current results (-> @state :section/posts :displayed-posts) ; 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)) 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.))) (js/console.log :accts 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)) [:section.attachments (map-indexed (fn [idx item] ^{:key idx} [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; 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- internal-post-id "Returns a promise which resolves to the smallest or largest internal post id. This is useful to continue interrupted paginated requests." [max-or-min] (let [posts-cursor (db/open-cursor ::db/posts ::db/all {:index ::db/post-internal-id :direction (if (= max-or-min :min) :asc :desc)})] (db/first-result (keep (j/get :internal_id)) posts-cursor))) (defn- fetch-more-posts! [e] (.preventDefault e) (. (promise-all [(fetch-application-settings) (internal-post-id :min) (internal-post-id :max)]) (then (fn [[application min-id max-id]] (when max-id (fetch-posts! {:instance-url (:instance_url application) :bearer-token (:bearer_token application) :min-id max-id})) (when min-id (fetch-posts! {:instance-url (:instance_url application) :bearer-token (:bearer_token application) :max-id min-id})) (when-not (or min-id max-id) (fetch-posts! {:instance-url (:instance_url application) :bearer-token (:bearer_token application)})))))) (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"]]] [:ul.results (map-indexed (fn [idx p] ^{:key idx} [: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 (def db-version 3) (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! ::db/post-created-at "created_at" {:unique false}))) 3 (fn migration-0003 [_ txn] (-> (db/open-store txn ::db/posts "readwrite") (db/create-index! ::db/post-internal-id "internal_id" {:unique false})))}) (defn- convert-internal-ids! [] ; TODO figure out when we can remove this again (let [cursor (db/open-cursor ::db/posts ::db/all) result (db/transduce-cursor (filter (comp string? (j/get :internal_id))) cursor)] (.then result (fn [rows] (doseq [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 migrations) (.then #(setup-application!)) (.then #(convert-internal-ids!)) (.catch (fn [err] (js/console.error ::db/setup! err)))))