From a6b6c116c6124fc6bd0a58d2828dec82ac3ac257 Mon Sep 17 00:00:00 2001 From: Your Name Date: Sun, 4 Oct 2026 23:22:58 -0400 Subject: [PATCH] Count the upload in the status line MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The transfer is the longest part of an import on anything but a local server, and it was the only part with no number on it: `uploading video…` sat unchanged from the first byte to the last, however many there were, and only the extraction that followed it ever counted. Most of what "slow" means to whoever is waiting was a spinner of unknown length. `fetch` cannot report this. A Request built from a FormData gives no way to observe its own upload — the promise settles when the response arrives — so `POST-form` gained an XMLHttpRequest arity, which is the one thing XHR can still do that fetch cannot. `fail` became `failure`, building the ex-info rather than throwing it, because the two transports raise it differently: fetch throws inside a `.then` and XHR has to reject by hand. `sending` dispatches only when the whole percentage moves, since the browser fires progress as often as it pleases and each dispatch re-renders the pane. Video, sound and image uploads all report. Co-Authored-By: Claude Opus 5 --- frontend/src/arthur/events/footage.cljs | 26 ++++++++- frontend/src/arthur/fx/http.cljs | 77 +++++++++++++++++++++---- 2 files changed, 89 insertions(+), 14 deletions(-) diff --git a/frontend/src/arthur/events/footage.cljs b/frontend/src/arthur/events/footage.cljs index a88f926..7a25a0a 100644 --- a/frontend/src/arthur/events/footage.cljs +++ b/frontend/src/arthur/events/footage.cljs @@ -334,12 +334,32 @@ (.catch (fn [error] (rf/dispatch [::failed (or (ex-message error) (str error))]))))) +(defn- sending + "A progress callback that puts the whole percentage sent in the status line. + + ONLY WHEN THE PERCENTAGE MOVES. The browser fires upload progress as often as + it pleases and a status line has something new to say a hundred times at most, + and each dispatch here re-renders the pane. + + Worth having at all because the transfer is the longest part of an import on + anything but a local server, and it was the part with no number on it: + `uploading video…` sat unchanged from the first byte to the last, however many + there were, and only the extraction that followed it ever counted. See + `arthur.fx.http/POST-form`." + [label] + (let [reported (atom -1)] + (fn [fraction] + (let [percent (js/Math.round (* 100 fraction))] + (when (not= percent @reported) + (reset! reported percent) + (rf/dispatch [::progress (str label " " percent "%")])))))) + (rf/reg-fx ::upload! (fn [file] (let [form (js/FormData.)] (.append form "file" file) - (-> (http/POST-form "/api/sources" form) + (-> (http/POST-form "/api/sources" form (sending "uploading video…")) (.then (fn [^js source] (rf/dispatch [::progress "queued for extraction…"]) (http/POST "/api/extractions" #js {:source (.-id source) @@ -353,7 +373,7 @@ (fn [file] (let [form (js/FormData.)] (.append form "file" file) - (-> (http/POST-form "/api/sounds" form) + (-> (http/POST-form "/api/sounds" form (sending "uploading sound…")) (.then (fn [^js sound] (rf/dispatch [::uploaded (.-id sound) "sound imported"]))) (.catch (fn [error] (rf/dispatch [::failed (or (ex-message error) (str error))]))))))) @@ -363,7 +383,7 @@ (fn [file] (let [form (js/FormData.)] (.append form "file" file) - (-> (http/POST-form "/api/images" form) + (-> (http/POST-form "/api/images" form (sending "uploading image…")) (.then (fn [^js image] (rf/dispatch [::uploaded (.-id image) "image imported"]))) (.catch (fn [error] (rf/dispatch [::failed (or (ex-message error) (str error))]))))))) diff --git a/frontend/src/arthur/fx/http.cljs b/frontend/src/arthur/fx/http.cljs index f4e3650..29d5ec5 100644 --- a/frontend/src/arthur/fx/http.cljs +++ b/frontend/src/arthur/fx/http.cljs @@ -19,17 +19,28 @@ (when (= "csrftoken" (str/trim (or k ""))) v))) (str/split (or (.-cookie js/document) "") #";"))) -(defn- fail +(defn- failure "Turn a non-2xx into an ex-info carrying what the server said. The server's message is the useful one — \"this clip names tier-2 blocks the server does not have\" — and a status code alone would put the interesting half - of it in a console nobody is watching." - [response body] - (throw (ex-info (or (some-> body .-error) - (str "the server answered " (.-status response))) - {:status (.-status response) - :body (when body (js->clj body :keywordize-keys true))}))) + of it in a console nobody is watching. + + Built rather than thrown, because the two transports below raise it in + different ways: `fetch` throws inside a `.then` and XHR has to reject a promise + by hand." + [status body] + (ex-info (or (some-> body .-error) + (str "the server answered " status)) + {:status status + :body (when body (js->clj body :keywordize-keys true))})) + +(defn- parse + "A response body as a parsed JS value, or nil. An empty 204 and a 500 whose + body is an HTML error page both land here, and neither is worth an exception." + [text] + (when (seq text) + (try (js/JSON.parse text) (catch :default _ nil)))) (defn request! ([method url] (request! method url nil)) @@ -47,14 +58,58 @@ (.then (fn [response] (-> (.text response) (.then (fn [text] - (let [parsed (when (seq text) - (try (js/JSON.parse text) (catch :default _ nil)))] + (let [parsed (parse text)] (if (.-ok response) parsed - (fail response parsed)))))))))))) + (throw (failure (.-status response) parsed))))))))))))) + +(defn POST-form + "A multipart POST, optionally reporting how much of the body has gone out. + + XMLHttpRequest RATHER THAN `fetch`, for the one thing fetch cannot do: a + Request built from a FormData gives no way to observe its own upload, so the + promise settles when the response arrives and everything before that is a + single unknown. On the one call that sends a whole video that unknown is + minutes long, and a spinner with no number on it is most of what \"slow\" means + to whoever is waiting — so this is worth the twenty lines XHR costs. + + `on-progress` is called with the fraction sent, 0.0 to 1.0. Only while the + browser can say what the total is: a body whose length it cannot compute + reports nothing rather than a made-up number. + + CONTENT-TYPE IS DELIBERATELY NOT SET. The browser has to write the multipart + boundary into it, and setting it by hand sends a body the server cannot parse." + ([url body] (request! "POST" url body)) + ([url body on-progress] + (js/Promise. + (fn [resolve reject] + (let [xhr (js/XMLHttpRequest.)] + (.open xhr "POST" url) + (.setRequestHeader xhr "Accept" "application/json") + (.setRequestHeader xhr "X-CSRFToken" (or (csrf-token) "")) + (set! (.. xhr -upload -onprogress) + (fn [^js event] + (when (and (.-lengthComputable event) (pos? (.-total event))) + (on-progress (/ (.-loaded event) (.-total event)))))) + (set! (.-onload xhr) + (fn [] + (let [parsed (parse (.-responseText xhr))] + (if (<= 200 (.-status xhr) 299) + (resolve parsed) + (reject (failure (.-status xhr) parsed)))))) + ;; The three ways a send produces no response at all. None of them has a + ;; status, so none of them can go through `failure` — and a dropped + ;; upload has to say so, because it is the one failure here that is + ;; routine rather than a bug. + (set! (.-onerror xhr) + (fn [_] (reject (ex-info "the upload did not reach the server" {})))) + (set! (.-onabort xhr) + (fn [_] (reject (ex-info "the upload was cancelled" {})))) + (set! (.-ontimeout xhr) + (fn [_] (reject (ex-info "the upload timed out" {})))) + (.send xhr body)))))) (defn GET [url] (request! "GET" url)) (defn POST [url body] (request! "POST" url body)) -(defn POST-form [url body] (request! "POST" url body)) (defn PUT [url body] (request! "PUT" url body)) (defn PATCH [url body] (request! "PATCH" url body))