♻️ Refactor http client.

Start using Fetch API.
2025-07-26 05:17:18 +02:00 · 2021-04-09 17:21:34 +02:00 · 2021-04-09 17:21:34 +02:00 · 7d14aef393
commit 7d14aef393
parent 9a0f6018a7
15 changed files with 257 additions and 305 deletions
--- a/frontend/src/app/util/http.cljs
+++ b/frontend/src/app/util/http.cljs
@ -5,25 +5,34 @@
 ;; This Source Code Form is "Incompatible With Secondary Licenses", as
 ;; defined by the Mozilla Public License, v. 2.0.
 ;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL

 (ns app.util.http
  "A http client with rx streams interface."
-  (:refer-clojure :exclude [get])
  (:require
+   [app.common.data :as d]
   [app.config :as cfg]
   [app.util.object :as obj]
   [app.util.transit :as t]
   [beicon.core :as rx]
-   [cljs.core :as c]
-   [clojure.string :as str]
-   [goog.events :as events])
-  (:import
-   [goog.net ErrorCode EventType]
-   [goog.net.XhrIo ResponseType]
-   [goog.net XhrIo]
-   [goog.Uri QueryData]
-   [goog Uri]))
+   [cuerdas.core :as str]
+   [lambdaisland.uri :as u]
+   [promesa.core :as p]))
+
+(defprotocol IBodyData
+  "A helper for define body data with the appropiate headers."
+  (-update-headers [_ headers])
+  (-get-body-data [_]))
+
+(extend-protocol IBodyData
+  js/FormData
+  (-get-body-data [it] it)
+  (-update-headers [it headers]
+    (dissoc headers "content-type" "Content-Type"))
+
+  default
+  (-get-body-data [it] it)
+  (-update-headers [it headers] headers))

 (defn translate-method
  [method]
@ -37,70 +46,93 @@
    :delete  "DELETE"
    :trace   "TRACE"))

-(defn- normalize-headers
+(defn parse-headers
  [headers]
-  (reduce-kv (fn [acc k v]
-               (assoc acc (str/lower-case k) v))
-             {} (js->clj headers)))
-
-(defn- translate-error-code
-  [code]
-  (condp = code
-    ErrorCode.TIMEOUT    :timeout
-    ErrorCode.EXCEPTION  :exception
-    ErrorCode.HTTP_ERROR :http
-    ErrorCode.ABORT      :abort
-    ErrorCode.OFFLINE    :offline
-    nil))
-
-(defn- translate-response-type
-  [type]
-  (case type
-    :text ResponseType.TEXT
-    :blob ResponseType.BLOB
-    ResponseType.DEFAULT))
-
-(defn- create-uri
-  [uri qs qp]
-  (let [uri (Uri. uri)]
-    (when qs (.setQuery uri qs))
-    (when qp
-      (let [dt (.createFromMap QueryData (clj->js  qp))]
-        (.setQueryData uri dt)))
-    (.toString uri)))
+  (into {} (map vec) (seq (.entries ^js headers))))

 (def default-headers
  {"x-frontend-version" (:full @cfg/version)})

-(defn- fetch
-  [{:keys [method uri query-string query headers body] :as request}
-   {:keys [timeout credentials? response-type]
-    :or {timeout 0 credentials? false response-type :text}}]
-  (let [uri (create-uri uri query-string query)
-        headers (merge default-headers headers)
-        headers (if headers (clj->js headers) #js {})
-        method (translate-method method)
-        xhr (doto (XhrIo.)
-              (.setResponseType (translate-response-type response-type))
-              (.setWithCredentials credentials?)
-              (.setTimeoutInterval timeout))]
-    (rx/create
-     (fn [sink]
-       (letfn [(on-complete [event]
-                 (let [type (translate-error-code (.getLastErrorCode xhr))
-                       status (.getStatus xhr)]
-                   (if (pos? status)
-                     (sink (rx/end
-                            {:status status
-                             :body (.getResponse xhr)
-                             :headers (normalize-headers (.getResponseHeaders xhr))}))
-                     (sink (rx/end
-                            {:status 0
-                             :error (if (= type :http) :abort type)
-                             ::xhr xhr})))))]
-         (events/listen xhr EventType.COMPLETE on-complete)
-         (.send xhr uri method body headers)
-         #(.abort xhr))))))
+(defn fetch
+  [{:keys [method uri query headers body timeout mode]
+    :or {timeout 10000 mode :cors headers {}}}]
+  (rx/Observable.create
+   (fn [subscriber]
+     (let [controller    (js/AbortController.)
+           signal        (.-signal ^js controller)
+           unsubscribed? (volatile! false)
+           abortable?    (volatile! true)
+           query         (cond
+                           (string? query) query
+                           (map? query)    (u/map->query-string query)
+                           :else nil)
+           uri           (cond-> uri
+                           (string? uri) (u/uri)
+                           (some? query) (assoc :query query))
+           headers       (->> (d/merge headers default-headers)
+                              (-update-headers body))
+           body          (-get-body-data body)
+           params        #js {:method (translate-method method)
+                              :headers (clj->js headers)
+                              :body body
+                              :mode (d/name mode)
+                              :redirect "follow"
+                              :credentials "same-origin"
+                              :referrerPolicy "no-referrer"
+                              :signal signal}]
+       (-> (js/fetch (str uri) params)
+           (p/then (fn [response]
+                     (vreset! abortable? false)
+                     (.next ^js subscriber response)
+                     (.complete ^js subscriber)))
+           (p/catch (fn [err]
+                      (vreset! abortable? false)
+                      (when-not @unsubscribed?
+                        (.error ^js subscriber err)))))
+       (fn []
+         (vreset! unsubscribed? true)
+         (when @abortable?
+           (.abort ^js controller)))))))
+
+(defn send!
+  [{:keys [response-type] :or {response-type :text} :as params}]
+  (letfn [(on-response [response]
+            (let [body (case response-type
+                         :json (.json ^js response)
+                         :text (.text ^js response)
+                         :blob (.blob ^js response))]
+              (->> (rx/from body)
+                   (rx/map (fn [body]
+                             {::response response
+                              :status    (.-status ^js response)
+                              :headers   (parse-headers (.-headers ^js response))
+                              :body      body})))))]
+    (->> (fetch params)
+         (rx/mapcat on-response))))
+
+(defn form-data
+  [data]
+  (letfn [(append [form k v]
+            (if (list? v)
+              (.append form (name k) (first v) (second v))
+              (.append form (name k) v))
+            form)]
+    (reduce-kv append (js/FormData.) data)))
+
+(defn transit-data
+  [data]
+  (reify IBodyData
+    (-get-body-data [_] (t/encode data))
+    (-update-headers [_ headers]
+      (assoc headers "content-type" "application/transit+json"))))
+
+(defn conditional-decode-transit
+  [{:keys [body headers status] :as response}]
+  (let [contentype (get headers "content-type")]
+    (if (and (str/starts-with? contentype "application/transit+json")
+             (pos? (count body)))
+      (assoc response :body (t/decode body))
+      response)))

 (defn success?
  [{:keys [status]}]
@ -114,25 +146,8 @@
  [{:keys [status]}]
  (<= 400 status 499))

-(defn send!
-  ([request]
-   (send! request nil))
-  ([request options]
-   (fetch request options)))
-
-(defn fetch-as-data-url
-  [url]
-  (->> (send! {:method :get :uri url} {:response-type :blob})
-       (rx/mapcat (fn [{:keys [body] :as rsp}]
-                    (let [reader (js/FileReader.)]
-                      (rx/create (fn [sink]
-                                   (obj/set! reader "onload" #(sink (reduced (.-result reader))))
-                                   (.readAsDataURL reader body))))))))
-
-
-
-(defn data-url->blob
-  [durl]
-  (->> (send! {:method :get :uri durl} {:response-type :blob})
-       (rx/map :body)
-       (rx/take 1)))
+(defn as-promise
+  [observable]
+  (p/create (fn [resolve reject]
+              (->> (rx/take 1 observable)
+                   (rx/subs resolve reject)))))
--- a/frontend/src/app/util/http_api.cljs
+++ b/frontend/src/app/util/http_api.cljs
@ -1,59 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
-
-(ns app.util.http-api
-  "A specific customizations of http client for api access."
-  (:require
-   [beicon.core :as rx]
-   [cuerdas.core :as str]
-   [app.util.http :as http]
-   [app.util.transit :as t]))
-
-(defn- conditional-decode
-  [{:keys [body headers status] :as response}]
-  (let [contentype (get headers "content-type")]
-    (if (and (str/starts-with? contentype "application/transit+json")
-             (pos? (count body)))
-      (assoc response :body (t/decode body))
-      response)))
-
-(defn- handle-http-status
-  [{:keys [body status] :as response}]
-  (if (http/success? response)
-    (rx/of {:status status :payload body})
-    (rx/throw {:status status :payload body})))
-
-(def ^:private default-headers
-  {"content-type" "application/transit+json"})
-
-(defn- impl-send
-  [{:keys [body headers auth method query uri response-type]
-    :or {auth true response-type :text}}]
-  (let [headers (merge {"Accept" "application/transit+json,*/*"}
-                       (when (map? body) default-headers)
-                       headers)
-        request {:method method
-                 :uri uri
-                 :headers headers
-                 :query query
-                 :body (if (map? body)
-                         (t/encode body)
-                         body)}
-        options {:response-type response-type
-                 :credentials? auth}]
-    (http/send! request options)))
-
-(defn send!
-  [request]
-  (->> (impl-send request)
-       (rx/map conditional-decode)))
-
-(def success? http/success?)
-(def client-error? http/client-error?)
-(def server-error? http/server-error?)
--- a/frontend/src/app/util/router.cljs
+++ b/frontend/src/app/util/router.cljs
@ -147,8 +147,8 @@
            history (:history state)
            router  (:router state)]
        (ts/schedule #(on-change router (.getToken ^js history)))
-        (->> (rx/create (fn [sink]
-                           (let [key (e/listen history "navigate" (fn [o] (sink (.-token ^js o))))]
+        (->> (rx/create (fn [subs]
+                           (let [key (e/listen history "navigate" (fn [o] (rx/push! subs (.-token ^js o))))]
                             (fn []
                               (bhistory/disable! history)
                               (e/unlistenByKey key)))))
--- a/frontend/src/app/util/webapi.cljs
+++ b/frontend/src/app/util/webapi.cljs
@ -5,36 +5,36 @@
 ;; This Source Code Form is "Incompatible With Secondary Licenses", as
 ;; defined by the Mozilla Public License, v. 2.0.
 ;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL

 (ns app.util.webapi
  "HTML5 web api helpers."
  (:require
+   [app.common.data :as d]
   [app.common.exceptions :as ex]
   [app.util.object :as obj]
-   [promesa.core :as p]
+   [app.util.transit :as t]
   [beicon.core :as rx]
   [cuerdas.core :as str]
-   [app.common.data :as d]
-   [app.util.transit :as t]))
+   [promesa.core :as p]))
+
+(defn- file-reader
+  [f]
+  (rx/create
+   (fn [subs]
+     (let [reader (js/FileReader.)]
+       (obj/set! reader "onload" #(do (rx/push! subs (.-result reader))
+                                      (rx/end! subs)))
+       (f reader)
+       (constantly nil)))))

 (defn read-file-as-text
  [file]
-  (rx/create
-   (fn [sink]
-     (let [fr (js/FileReader.)]
-       (aset fr "onload" #(sink (rx/end (.-result fr))))
-       (.readAsText fr file)
-       (constantly nil)))))
+  (file-reader #(.readAsText %1 file)))

-(defn read-file-as-dataurl
+(defn read-file-as-data-url
  [file]
-  (rx/create
-   (fn [sick]
-     (let [fr (js/FileReader.)]
-       (aset fr "onload" #(sick (rx/end (.-result fr))))
-       (.readAsDataURL fr file))
-     (constantly nil))))
+  (file-reader #(.readAsDataURL ^js %1 file)))

 (defn ^boolean blob?
  [v]