♻️ Refactor http client.

Start using Fetch API.

backend/src/app/http.clj

@@ -165,6 +165,5 @@
 
      ["/rpc" {:middleware [(:middleware session)
                            middleware/activity-logger]}
-
       ["/query/:type" {:get (:query-handler rpc)}]
       ["/mutation/:type" {:post (:mutation-handler rpc)}]]]]))

frontend/deps.edn

@@ -11,7 +11,7 @@
   danlentz/clj-uuid {:mvn/version "0.1.9"}
   frankiesardo/linked {:mvn/version "1.3.0"}
 
-  funcool/beicon {:mvn/version "2021.01.29-1"}
+  funcool/beicon {:mvn/version "2021.04.09-1"}
   funcool/cuerdas {:mvn/version "2020.03.26-3"}
   funcool/okulary {:mvn/version "2020.04.14-0"}
   funcool/potok {:mvn/version "3.2.0"}

frontend/src/app/main/data/fetch.cljs

@@ -1,35 +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.main.data.fetch
-  (:require
-   [promesa.core :as p]
-   [potok.core :as ptk]
-   [okulary.core :as l]
-   [app.util.object :as obj]
-   [app.main.store :as st]))
-
-(defn pending-ref []
-  (l/derived ::to-fetch st/state))
-
-(defn add [to-fetch id]
-  (let [to-fetch (or to-fetch (hash-set))]
-    (conj to-fetch id)))
-
-(defn fetch-as-data-uri [url]
-  (let [id (random-uuid)]
-    (st/emit! (fn [state] (update state ::to-fetch add id)))
-    (-> (js/fetch url)
-        (p/then (fn [res] (.blob res)))
-        (p/then (fn [blob]
-                  (let [reader (js/FileReader.)]
-                    (p/create (fn [resolve reject]
-                                (obj/set! reader "onload" #(resolve [url (.-result reader)]))
-                                (.readAsDataURL reader blob))))))
-        (p/finally #(st/emit! (fn [state] (update state ::to-fetch disj id)))))))

frontend/src/app/main/data/workspace.cljs

@@ -1321,7 +1321,9 @@
             (let [obj (maybe-translate obj objects selected)]
               (if (= type :image)
                 (let [url (cfg/resolve-file-media (:metadata obj))]
-                  (->> (http/fetch-as-data-url url)
+                  (->> (http/send! {:method :get :uri url})
+                       (rx/map :body)
+                       (rx/mapcat wapi/read-file-as-data-url)
                        (rx/map #(assoc obj ::data %))
                        (rx/take 1)))
                 (rx/of obj))))
@@ -1459,7 +1461,10 @@
   (letfn [;; Given a file-id and img (part generated by the
           ;; copy-selected event), uploads the new media.
           (upload-media [file-id imgpart]
-            (->> (http/data-url->blob (:file-data imgpart))
+            (->> (http/send! {:uri (:file-data imgpart)
+                              :response-type :blob
+                              :method :get})
+                 (rx/map :body)
                  (rx/map
                   (fn [blob]
                     {:name (:name imgpart)

frontend/src/app/main/data/workspace/persistence.cljs

@@ -394,19 +394,13 @@
      (or (contains? props :data)
          (contains? props :uris)))))
 
-(defn parse-svg [[name text]]
+(defn parse-svg
-  (->> (http/send! {:method :post
+  [[name text]]
-                    :uri "/api/svg/parse"
+  (->> (rp/query! :parse-svg {:data text})
-                    :headers {"content-type" "image/svg+xml"}
+       (rx/map #(assoc % :name name))))
-                    :body text})
-       (rx/map (fn [{:keys [status body]}]
-                 (let [result (t/decode body)]
-                   (if (= status 200)
-                     (assoc result :name name)
-                     (throw result)))))))
 
 (defn fetch-svg [name uri]
-  (->> (http/send! {:method :get :uri uri})
+  (->> (http/send! {:method :get :uri uri :mode :no-cors})
        (rx/map #(vector
                  (or name (uu/uri-name uri))
                  (:body %)))))

frontend/src/app/main/repo.cljs

@@ -10,9 +10,11 @@
 (ns app.main.repo
   (:require
    [beicon.core :as rx]
+   [lambdaisland.uri :as u]
    [cuerdas.core :as str]
    [app.config :as cfg]
-   [app.util.http-api :as http]))
+   [app.util.transit :as t]
+   [app.util.http :as http]))
 
 (defn- handle-response
   [{:keys [status body] :as response}]
@@ -30,8 +32,7 @@
     (= 0 (:status response))
     (rx/throw {:type :offline})
 
-    (and (= 200 status)
+    (= 200 status)
-         (coll? body))
     (rx/of body)
 
     (and (>= status 400)
@@ -43,21 +44,29 @@
                :status status
                :data body})))
 
-(defn send-query!
+(def ^:private base-uri (u/uri cfg/public-uri))
-  [id params]
-  (let [uri (str cfg/public-uri "/api/rpc/query/" (name id))]
-    (->> (http/send! {:method :get :uri uri :query params})
-         (rx/mapcat handle-response))))
 
-(defn send-mutation!
+(defn- send-query!
+  "A simple helper for send and receive transit data on the penpot
+  query api."
   [id params]
-  (let [uri (str cfg/public-uri "/api/rpc/mutation/" (name id))]
+  (->> (http/send! {:method :get
-    (->> (http/send! {:method :post :uri uri :body params})
+                    :uri (u/join base-uri "api/rpc/query/" (name id))
-         (rx/mapcat handle-response))))
+                    :query params})
+       (rx/map http/conditional-decode-transit)
+       (rx/mapcat handle-response)))
 
-(defn- dispatch
+(defn- send-mutation!
-  [& args]
+  "A simple helper for a common case of sending and receiving transit
-  (first args))
+  data to the penpot mutation api."
+  [id params]
+  (->> (http/send! {:method :post
+                    :uri (u/join base-uri "api/rpc/mutation/" (name id))
+                    :body (http/transit-data params)})
+       (rx/map http/conditional-decode-transit)
+       (rx/mapcat handle-response)))
+
+(defn- dispatch [& args] (first args))
 
 (defmulti query dispatch)
 (defmulti mutation dispatch)
@@ -80,53 +89,59 @@
 
 (defmethod mutation :login-with-google
   [id params]
-  (let [uri (str cfg/public-uri "/api/oauth/google")]
+  (let [uri (u/join base-uri "api/oauth/google")]
     (->> (http/send! {:method :post :uri uri :query params})
+         (rx/map http/conditional-decode-transit)
          (rx/mapcat handle-response))))
 
 (defmethod mutation :login-with-gitlab
   [id params]
-  (let [uri (str cfg/public-uri "/api/oauth/gitlab")]
+  (let [uri (u/join base-uri "api/oauth/gitlab")]
     (->> (http/send! {:method :post :uri uri :query params})
-      (rx/mapcat handle-response))))
+         (rx/map http/conditional-decode-transit)
+         (rx/mapcat handle-response))))
 
 (defmethod mutation :login-with-github
   [id params]
-  (let [uri (str cfg/public-uri "/api/oauth/github")]
+  (let [uri (u/join base-uri "api/oauth/github")]
     (->> (http/send! {:method :post :uri uri :query params})
+         (rx/map http/conditional-decode-transit)
          (rx/mapcat handle-response))))
 
-(defmethod mutation :upload-file-media-object
-  [id params]
-  (let [form (js/FormData.)]
-    (run! (fn [[key val]]
-            (if (list? val)
-              (.append form (name key) (first val) (second val))
-              (.append form (name key) val)))
-          (seq params))
-    (send-mutation! id form)))
-
 (defmethod mutation :send-feedback
   [id params]
-  (let [uri (str cfg/public-uri "/api/feedback")]
+  (->> (http/send! {:method :post
-    (->> (http/send! {:method :post :uri uri :body params})
+                    :uri (u/join base-uri "api/feedback")
-         (rx/mapcat handle-response))))
+                    :body (http/transit-data params)})
+       (rx/map http/conditional-decode-transit)
+       (rx/mapcat handle-response)))
 
-(defmethod mutation :update-profile-photo
+(defmethod query :export
   [id params]
-  (let [form (js/FormData.)]
+  (->> (http/send! {:method :post
-    (run! (fn [[key val]]
+                    :uri (u/join base-uri "export")
-            (.append form (name key) val))
+                    :body (http/transit-data params)
-          (seq params))
+                    :response-type :blob})
-    (send-mutation! id form)))
+       (rx/mapcat handle-response)))
 
-(defmethod mutation :update-team-photo
+(defmethod query :parse-svg
+  [id {:keys [data] :as params}]
+  (->> (http/send! {:method :post
+                    :uri (u/join base-uri "api/svg/parse")
+                    :headers {"content-type" "image/svg+xml"}
+                    :body data
+                    :response-type :text})
+       (rx/map http/conditional-decode-transit)
+       (rx/mapcat handle-response)))
+
+(derive :upload-file-media-object ::multipart-upload)
+(derive :update-profile-photo ::multipart-upload)
+(derive :update-team-photo ::multipart-upload)
+
+(defmethod mutation ::multipart-upload
   [id params]
-  (let [form (js/FormData.)]
+  (->> (http/send! {:method :post
-    (run! (fn [[key val]]
+                    :uri  (u/join base-uri "/api/rpc/mutation/" (name id))
-            (.append form (name key) val))
+                    :body (http/form-data params)})
-          (seq params))
+       (rx/map http/conditional-decode-transit)
-    (send-mutation! id form)))
+       (rx/mapcat handle-response)))
-
-(def client-error? http/client-error?)
-(def server-error? http/server-error?)

frontend/src/app/main/ui/shapes/image.cljs

@@ -5,19 +5,20 @@
 ;; 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.main.ui.shapes.image
   (:require
-   [rumext.alpha :as mf]
-   [app.config :as cfg]
    [app.common.geom.shapes :as geom]
+   [app.config :as cfg]
+   [app.main.ui.context :as muc]
    [app.main.ui.shapes.attrs :as attrs]
    [app.util.dom :as dom]
+   [app.util.http :as http]
    [app.util.object :as obj]
-   [app.main.ui.context :as muc]
+   [app.util.webapi :as wapi]
-   [app.main.data.fetch :as df]
+   [beicon.core :as rx]
-   [promesa.core :as p]))
+   [rumext.alpha :as mf]))
 
 (mf/defc image-shape
   {::mf/wrap-props false}
@@ -33,8 +34,12 @@
      (mf/deps uri)
      (fn []
        (if embed-resources?
-         (-> (df/fetch-as-data-uri uri)
+         (->> (http/send! {:method :get
-             (p/then #(reset! data-uri (second %)))))))
+                           :uri uri
+                           :response-type :blob})
+              (rx/map :body)
+              (rx/mapcat wapi/read-file-as-data-url)
+              (rx/subs #(reset! data-uri  %))))))
 
     (let [transform (geom/transform-matrix shape)
           props (-> (attrs/extract-style-attrs shape)

frontend/src/app/main/ui/shapes/text/embed.cljs

@@ -11,12 +11,14 @@
   (:require
    [app.common.data :as d]
    [app.common.text :as txt]
-   [app.main.data.fetch :as df]
    [app.main.fonts :as fonts]
+   [app.util.http :as http]
+   [app.util.webapi :as wapi]
    [app.util.object :as obj]
    [clojure.set :as set]
    [cuerdas.core :as str]
    [promesa.core :as p]
+   [beicon.core :as rx]
    [rumext.alpha :as mf]))
 
 (def font-face-template "
@@ -44,10 +46,12 @@
   "Given a font and the variant-id, retrieves the style CSS for it."
   [{:keys [id backend family variants] :as font} font-variant-id]
   (if (= :google backend)
-    (-> (fonts/gfont-url family [{:id font-variant-id}])
+    (->> (http/send! {:method :get
-        (js/fetch)
+                      :mode :no-cors
-        (p/then (fn [res] (.text res))))
+                      :uri (fonts/gfont-url family [{:id font-variant-id}])
-
+                      :response-type :text})
+         (rx/map :body)
+         (http/as-promise))
     (let [{:keys [name weight style suffix] :as variant} (d/seek #(= (:id %) font-variant-id) variants)
           result (str/fmt font-face-template {:family family
                                               :style style
@@ -55,14 +59,26 @@
                                               :weight weight})]
       (p/resolved result))))
 
+(defn- to-promise
+  [observable]
+  (p/create (fn [resolve reject]
+              (->> (rx/take 1 observable)
+                   (rx/subs resolve reject)))))
+
 (defn get-font-data
   "Parses the CSS and retrieves the font data as DataURI."
   [^string css]
-  (->> css
+  (let [uris (->> (re-seq #"url\(([^)]+)\)" css)
-       (re-seq #"url\(([^)]+)\)")
+                  (map second))]
-       (map second)
+    (->> (rx/from (seq uris))
-       (map df/fetch-as-data-uri)
+         (rx/mapcat (fn [uri]
-       (p/all)))
+                      (http/send! {:method :get
+                                   :uri uri
+                                   :response-type :blob})))
+         (rx/map :body)
+         (rx/mapcat wapi/read-file-as-data-url)
+         (rx/reduce conj [])
+         (http/as-promise))))
 
 (defn embed-font
   "Given a font-id and font-variant-id, retrieves the CSS for it and

frontend/src/app/main/ui/workspace/sidebar/options/menus/exports.cljs

@@ -5,7 +5,7 @@
 ;; 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.main.ui.workspace.sidebar.options.menus.exports
   (:require
@@ -13,26 +13,24 @@
    [beicon.core :as rx]
    [rumext.alpha :as mf]
    [app.common.data :as d]
+   [app.main.repo :as rp]
    [app.main.ui.icons :as i]
    [app.main.data.messages :as dm]
    [app.main.data.workspace :as udw]
    [app.main.store :as st]
    [app.util.object :as obj]
    [app.util.dom :as dom]
-   [app.util.http-api :as http]
+   [app.util.http :as http]
    [app.util.i18n :as i18n :refer  [tr t]]))
 
 (defn- request-export
   [shape exports]
-  (http/send! {:method :post
+  (rp/query! :export
-               :uri "/export"
+             {:page-id (:page-id shape)
-               :response-type :blob
+              :file-id  (:file-id shape)
-               :auth true
+              :object-id (:id shape)
-               :body {:page-id (:page-id shape)
+              :name (:name shape)
-                      :file-id  (:file-id shape)
+              :exports exports}))
-                      :object-id (:id shape)
-                      :name (:name shape)
-                      :exports exports}}))
 
 (defn- trigger-download
   [filename blob]
@@ -68,12 +66,11 @@
            (swap! loading? not)
            (->> (request-export (assoc shape :page-id page-id :file-id file-id) exports)
                 (rx/subs
-                 (fn [{:keys [status body] :as response}]
+                 (fn [body]
-                   (js/console.log status body)
+                   (trigger-download filename body))
-                   (if (= status 200)
+                 (fn [error]
-                     (trigger-download filename body)
+                   (swap! loading? not)
-                     (st/emit! (dm/error (tr "errors.unexpected-error")))))
+                   (st/emit! (dm/error (tr "errors.unexpected-error"))))
-                 (constantly nil)
                  (fn []
                    (swap! loading? not))))))
 

frontend/src/app/main/ui/workspace/viewport/pixel_overlay.cljs

@@ -5,13 +5,12 @@
 ;; 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.main.ui.workspace.viewport.pixel-overlay
   (:require
    [app.common.uuid :as uuid]
    [app.main.data.colors :as dwc]
-   [app.main.data.fetch :as mdf]
    [app.main.data.modal :as modal]
    [app.main.refs :as refs]
    [app.main.store :as st]

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]
+   [cuerdas.core :as str]
-   [clojure.string :as str]
+   [lambdaisland.uri :as u]
-   [goog.events :as events])
+   [promesa.core :as p]))
-  (:import
+
-   [goog.net ErrorCode EventType]
+(defprotocol IBodyData
-   [goog.net.XhrIo ResponseType]
+  "A helper for define body data with the appropiate headers."
-   [goog.net XhrIo]
+  (-update-headers [_ headers])
-   [goog.Uri QueryData]
+  (-get-body-data [_]))
-   [goog Uri]))
+
+(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]
+  (into {} (map vec) (seq (.entries ^js headers))))
-               (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)))
 
 (def default-headers
   {"x-frontend-version" (:full @cfg/version)})
 
-(defn- fetch
+(defn fetch
-  [{:keys [method uri query-string query headers body] :as request}
+  [{:keys [method uri query headers body timeout mode]
-   {:keys [timeout credentials? response-type]
+    :or {timeout 10000 mode :cors headers {}}}]
-    :or {timeout 0 credentials? false response-type :text}}]
+  (rx/Observable.create
-  (let [uri (create-uri uri query-string query)
+   (fn [subscriber]
-        headers (merge default-headers headers)
+     (let [controller    (js/AbortController.)
-        headers (if headers (clj->js headers) #js {})
+           signal        (.-signal ^js controller)
-        method (translate-method method)
+           unsubscribed? (volatile! false)
-        xhr (doto (XhrIo.)
+           abortable?    (volatile! true)
-              (.setResponseType (translate-response-type response-type))
+           query         (cond
-              (.setWithCredentials credentials?)
+                           (string? query) query
-              (.setTimeoutInterval timeout))]
+                           (map? query)    (u/map->query-string query)
-    (rx/create
+                           :else nil)
-     (fn [sink]
+           uri           (cond-> uri
-       (letfn [(on-complete [event]
+                           (string? uri) (u/uri)
-                 (let [type (translate-error-code (.getLastErrorCode xhr))
+                           (some? query) (assoc :query query))
-                       status (.getStatus xhr)]
+           headers       (->> (d/merge headers default-headers)
-                   (if (pos? status)
+                              (-update-headers body))
-                     (sink (rx/end
+           body          (-get-body-data body)
-                            {:status status
+           params        #js {:method (translate-method method)
-                             :body (.getResponse xhr)
+                              :headers (clj->js headers)
-                             :headers (normalize-headers (.getResponseHeaders xhr))}))
+                              :body body
-                     (sink (rx/end
+                              :mode (d/name mode)
-                            {:status 0
+                              :redirect "follow"
-                             :error (if (= type :http) :abort type)
+                              :credentials "same-origin"
-                             ::xhr xhr})))))]
+                              :referrerPolicy "no-referrer"
-         (events/listen xhr EventType.COMPLETE on-complete)
+                              :signal signal}]
-         (.send xhr uri method body headers)
+       (-> (js/fetch (str uri) params)
-         #(.abort xhr))))))
+           (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!
+(defn as-promise
-  ([request]
+  [observable]
-   (send! request nil))
+  (p/create (fn [resolve reject]
-  ([request options]
+              (->> (rx/take 1 observable)
-   (fetch request options)))
+                   (rx/subs resolve reject)))))
-
-(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)))

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?)

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]
+        (->> (rx/create (fn [subs]
-                           (let [key (e/listen history "navigate" (fn [o] (sink (.-token ^js o))))]
+                           (let [key (e/listen history "navigate" (fn [o] (rx/push! subs (.-token ^js o))))]
                              (fn []
                                (bhistory/disable! history)
                                (e/unlistenByKey key)))))

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]
+   [promesa.core :as p]))
-   [app.util.transit :as t]))
+
+(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
+  (file-reader #(.readAsText %1 file)))
-   (fn [sink]
-     (let [fr (js/FileReader.)]
-       (aset fr "onload" #(sink (rx/end (.-result fr))))
-       (.readAsText fr file)
-       (constantly nil)))))
 
-(defn read-file-as-dataurl
+(defn read-file-as-data-url
   [file]
-  (rx/create
+  (file-reader #(.readAsDataURL ^js %1 file)))
-   (fn [sick]
-     (let [fr (js/FileReader.)]
-       (aset fr "onload" #(sick (rx/end (.-result fr))))
-       (.readAsDataURL fr file))
-     (constantly nil))))
 
 (defn ^boolean blob?
   [v]

frontend/src/app/worker/thumbnails.cljs

@@ -15,7 +15,7 @@
    [app.main.fonts :as fonts]
    [app.main.exports :as exports]
    [app.worker.impl :as impl]
-   [app.util.http-api :as http]
+   [app.util.http :as http]
    ["react-dom/server" :as rds]))
 
 (defn- handle-response
@@ -39,6 +39,7 @@
        (->> (http/send! {:uri uri
                          :query {:file-id file-id :id page-id}
                          :method :get})
+            (rx/map http/conditional-decode-transit)
             (rx/mapcat handle-response)
             (rx/subs (fn [body]
                        (resolve body))