✨ Add a debug helper that simulates an intermediary response

2026-09-24 12:56:15 +00:00 · 2026-09-18 09:48:25 +02:00 · 2026-09-18 09:48:25 +02:00 · fb4d70a82a
commit fb4d70a82a
parent 34b24a9d9d
1 changed files with 81 additions and 0 deletions
--- a/frontend/src/debug.cljs
+++ b/frontend/src/debug.cljs
@ -374,6 +374,87 @@
        (.text response))
      (p/then apply-changes)))

+(def ^:private simulated-error-body
+  "Stands in for the error page a proxy or CDN writes when it answers instead
+  of the backend."
+  "<html><head><title>Simulated error</title></head><body>simulated intermediary response</body></html>")
+
+(defonce ^:private pending-http-error (atom nil))
+
+(defn- simulated-status
+  "Status to answer `uri` with, or nil to let the request through. A
+  simulation without a deadline answers one call; one with a deadline answers
+  every matching call until it runs out."
+  [uri]
+  (let [{:keys [method status until]} @pending-http-error]
+    (when (and (some? method)
+               (str/includes? uri (str "/api/main/methods/" method)))
+      (cond
+        (nil? until)              (do (reset! pending-http-error nil) status)
+        (< (js/Date.now) until)   status
+        :else                     (do (reset! pending-http-error nil) nil)))))
+
+;; The original fetch and the wrapper standing in for it, or nil when unhooked.
+(defonce ^:private http-error-hook (atom nil))
+
+(defn- install-http-error-hook!
+  []
+  (when (nil? @http-error-hook)
+    (let [original (unchecked-get js/globalThis "fetch")
+          wrapper  (fn [input params]
+                     (let [uri (if (string? input) input (unchecked-get input "url"))]
+                       (if-let [status (simulated-status uri)]
+                         (p/resolved (js/Response. simulated-error-body
+                                                   #js {:status status
+                                                        :headers #js {"content-type" "text/html"}}))
+                         (.call original js/globalThis input params))))]
+      (reset! http-error-hook {:original original :wrapper wrapper})
+      (unchecked-set js/globalThis "fetch" wrapper))))
+
+(defn- remove-http-error-hook!
+  []
+  (when-let [{:keys [original wrapper]} @http-error-hook]
+    ;; Restore only while the wrapper is still installed, so a later
+    ;; wrapper survives.
+    (when (identical? wrapper (unchecked-get js/globalThis "fetch"))
+      (unchecked-set js/globalThis "fetch" original))
+    (reset! http-error-hook nil)))
+
+(defn ^:export simulateHttpError
+  "Answers calls to an API method with `status` and a body that carries no
+  Penpot error code, the way a CDN or a corporate proxy does. Every other
+  request goes through untouched.
+
+  Without `seconds` the simulation is spent once it answers one call. With
+  `seconds` it answers every matching call for that long, which is how to
+  watch a save retry, warn, keep retrying and finally recover.
+
+  debug.simulateHttpError('update-file')
+  debug.simulateHttpError('get-comment-threads', 403)
+  debug.simulateHttpError('update-file', 524, 120)"
+  ([method]
+   (simulateHttpError method 524 nil))
+  ([method status]
+   (simulateHttpError method status nil))
+  ([method status seconds]
+   (install-http-error-hook!)
+   (let [until (when (and (number? seconds) (pos? seconds))
+                 (+ (js/Date.now) (* 1000 seconds)))]
+     (reset! pending-http-error {:method method
+                                 :status status
+                                 :until until})
+     (if (some? until)
+       (str "every " method " call will be answered with " status
+            " for the next " seconds " seconds")
+       (str "the next " method " call will be answered with " status)))))
+
+(defn ^:export clearHttpErrorSimulation
+  "Stops a running simulation and takes the wrapper off `fetch`."
+  []
+  (reset! pending-http-error nil)
+  (remove-http-error-hook!)
+  "requests reach the backend again")
+
 (defn ^:export reset-viewport
  []
  (st/emit!