|
| 1 | +(ns rocks.mygiftlist.http-remote |
| 2 | + (:refer-clojure :exclude [send]) |
| 3 | + (:require |
| 4 | + [clojure.string :as str] |
| 5 | + [cognitect.transit :as ct] |
| 6 | + [com.fulcrologic.fulcro.algorithms.transit :as t] |
| 7 | + [com.fulcrologic.fulcro.algorithms.tx-processing :as txn] |
| 8 | + [com.fulcrologic.fulcro.networking.http-remote :as f.http] |
| 9 | + [clojure.core.async :refer [go <!]] |
| 10 | + [com.wsscode.async.async-cljs :refer [let-chan]] |
| 11 | + [edn-query-language.core :as eql] |
| 12 | + [goog.events :as events] |
| 13 | + [taoensso.timbre :as log] |
| 14 | + [rocks.mygiftlist.authentication :as auth]) |
| 15 | + (:import [goog.net XhrIo EventType ErrorCode])) |
| 16 | + |
| 17 | +(defn wrap-fulcro-request |
| 18 | + ([handler addl-transit-handlers transit-transformation] |
| 19 | + (let [writer (t/writer (cond-> {} |
| 20 | + addl-transit-handlers |
| 21 | + (assoc :handlers addl-transit-handlers) |
| 22 | + |
| 23 | + transit-transformation |
| 24 | + (assoc :transform transit-transformation)))] |
| 25 | + (fn [{:keys [headers body] :as request}] |
| 26 | + (go |
| 27 | + (let [access-token (<! (auth/get-access-token)) |
| 28 | + [body response-type] (f.http/desired-response-type request) |
| 29 | + body (ct/write writer body) |
| 30 | + headers (assoc headers |
| 31 | + "Content-Type" "application/transit+json" |
| 32 | + "Authorization" (str "Bearer " access-token))] |
| 33 | + (handler (merge request |
| 34 | + {:body body |
| 35 | + :headers headers |
| 36 | + :method :post |
| 37 | + :response-type response-type}))))))) |
| 38 | + ([handler addl-transit-handlers] |
| 39 | + (wrap-fulcro-request handler addl-transit-handlers nil)) |
| 40 | + ([handler] |
| 41 | + (wrap-fulcro-request handler nil nil)) |
| 42 | + ([] |
| 43 | + (wrap-fulcro-request identity nil nil))) |
| 44 | + |
| 45 | +(defn fulcro-http-remote |
| 46 | + "Create a remote that (by default) communicates with the given url |
| 47 | + (which defaults to `/api`). |
| 48 | +
|
| 49 | + The request middleware is a `(fn [request] modified-request)`. The |
| 50 | + `request` will have `:url`, `:body`, `:method`, and `:headers`. The |
| 51 | + request middleware defaults to `wrap-fulcro-request` (which encodes |
| 52 | + the request in transit+json). The result of this middleware chain on |
| 53 | + the outgoing request becomes the real outgoing request. It is |
| 54 | + allowed to modify the `url`. |
| 55 | +
|
| 56 | + If the the request middleware returns a corrupt request or throws an |
| 57 | + exception then the remote code will immediately abort the request. |
| 58 | + The return value of the middleware will be used to generate a |
| 59 | + request to `:url`, with `:method` (e.g. :post), and the given |
| 60 | + headers. The body will be sent as-is without further translation. |
| 61 | + `response-middleware` is a function that returns a function `(fn |
| 62 | + [response] mod-response)` and defaults to `wrap-fulcro-response` |
| 63 | + which decodes the raw response and transforms it back to a response |
| 64 | + that Fulcro can merge. |
| 65 | +
|
| 66 | + The response will be a map containing the `:outgoing-request` which |
| 67 | + is the exact request sent on the network; `:body`, which is the raw |
| 68 | + data of the response. Additionally, there will be one or more of the |
| 69 | + following to indicate low-level details of the result: |
| 70 | + `:status-code`, `:status-text`, `:error-code` (one of :none, |
| 71 | + :exception, :http-error, :abort, or :timeout), and `:error-text`. |
| 72 | +
|
| 73 | + Middleware is allowed to morph any of this to suit its needs. |
| 74 | +
|
| 75 | + DEPRECATED: If the response middleware includes a `:transaction` key |
| 76 | + in the response with EQL, then that EQL will be used in the |
| 77 | + resulting Fulcro merge steps. This can seriously screw up built-in |
| 78 | + behaviors. You are much better off ensuring that your query matches |
| 79 | + the shape of the desired response in most cases. |
| 80 | +
|
| 81 | + The definition of `remote-error?` in the application will deterimine |
| 82 | + if happy-path or error handling will be applied to the response. The |
| 83 | + default setting in Fulcro will cause a result with a 200 status code |
| 84 | + to cause whatever happy-path logic is configured for that specific |
| 85 | + response's processing. |
| 86 | +
|
| 87 | + For example, see `m/default-result-action!` for mutations, and |
| 88 | + `df/internal-load` for loads. The `:body` key will be considered the |
| 89 | + response to use, and the optional `:transaction` key an override to |
| 90 | + the EQL query used for any merges. |
| 91 | +
|
| 92 | + See the top-level application configuration and Developer's Guide |
| 93 | + for more details." |
| 94 | + [{:keys [url request-middleware response-middleware make-xhrio] |
| 95 | + :or {url "/api" |
| 96 | + response-middleware (f.http/wrap-fulcro-response) |
| 97 | + request-middleware (wrap-fulcro-request) |
| 98 | + make-xhrio f.http/make-xhrio} |
| 99 | + :as options}] |
| 100 | + (merge options |
| 101 | + {:active-requests (atom {}) |
| 102 | + :transmit! |
| 103 | + (fn transmit! [{:keys [active-requests]} |
| 104 | + {::txn/keys [ast result-handler update-handler] |
| 105 | + :as send-node}] |
| 106 | + (go (let [edn (eql/ast->query ast) |
| 107 | + ok-handler (fn [result] |
| 108 | + (try |
| 109 | + (result-handler result) |
| 110 | + (catch :default e |
| 111 | + (log/error e "Result handler for remote" url "failed with an exception.")))) |
| 112 | + progress-handler (fn [update-msg] |
| 113 | + (let [msg {:status-code 200 |
| 114 | + :raw-progress (select-keys update-msg [:progress-phase :progress-event]) |
| 115 | + :overall-progress (f.http/progress% update-msg :overall) |
| 116 | + :receive-progress (f.http/progress% update-msg :receiving) |
| 117 | + :send-progress (f.http/progress% update-msg :sending)}] |
| 118 | + (when update-handler |
| 119 | + (try |
| 120 | + (update-handler msg) |
| 121 | + (catch :default e |
| 122 | + (log/error e "Update handler for remote" url "failed with an exception.")))))) |
| 123 | + error-handler (fn [error-result] |
| 124 | + (try |
| 125 | + (result-handler (merge error-result {:status-code 500})) |
| 126 | + (catch :default e |
| 127 | + (log/error e "Error handler for remote" url "failed with an exception."))))] |
| 128 | + (let-chan [real-request (try |
| 129 | + (request-middleware {:headers {} :body edn :url url :method :post}) |
| 130 | + (catch :default e |
| 131 | + (log/error e "Send aborted due to middleware failure ") |
| 132 | + nil))] |
| 133 | + (if real-request |
| 134 | + (let [abort-id (or |
| 135 | + (-> send-node ::txn/options ::txn/abort-id) |
| 136 | + (-> send-node ::txn/options :abort-id)) |
| 137 | + xhrio (make-xhrio) |
| 138 | + {:keys [body headers url method response-type]} real-request |
| 139 | + http-verb (-> (or method :post) name str/upper-case) |
| 140 | + extract-response #(f.http/extract-response body real-request xhrio) |
| 141 | + extract-response-mw (f.http/response-extractor* response-middleware edn real-request xhrio) |
| 142 | + gc-network-resources (f.http/cleanup-routine* abort-id active-requests xhrio) |
| 143 | + progress-routine (f.http/progress-routine* extract-response progress-handler) |
| 144 | + ok-routine (f.http/ok-routine* progress-routine extract-response-mw ok-handler error-handler) |
| 145 | + error-routine (f.http/error-routine* extract-response-mw ok-routine progress-routine error-handler) |
| 146 | + with-cleanup (fn [f] (fn [evt] (try (f evt) (finally (gc-network-resources)))))] |
| 147 | + (when abort-id |
| 148 | + (swap! active-requests update abort-id (fnil conj #{}) xhrio)) |
| 149 | + (when (and (f.http/legal-response-types response-type) (not= :default response-type)) |
| 150 | + (.setResponseType ^js xhrio (get f.http/response-types response-type))) |
| 151 | + (when progress-handler |
| 152 | + (f.http/xhrio-enable-progress-events xhrio) |
| 153 | + (events/listen xhrio (.-DOWNLOAD_PROGRESS ^js EventType) #(progress-routine :receiving %)) |
| 154 | + (events/listen xhrio (.-UPLOAD_PROGRESS ^js EventType) #(progress-routine :sending %))) |
| 155 | + (events/listen xhrio (.-SUCCESS ^js EventType) (with-cleanup ok-routine)) |
| 156 | + (events/listen xhrio (.-ABORT ^js EventType) (with-cleanup #(ok-handler {:status-text "Cancelled" |
| 157 | + ::txn/aborted? true}))) |
| 158 | + (events/listen xhrio (.-ERROR ^js EventType) (with-cleanup error-routine)) |
| 159 | + (f.http/xhrio-send xhrio url http-verb body headers)) |
| 160 | + (error-handler {:error :abort :error-text "Transmission was aborted because the request middleware returned nil or threw an exception"})))))) |
| 161 | + :abort! (fn abort! [this id] |
| 162 | + (if-let [xhrios (get @(:active-requests this) id)] |
| 163 | + (doseq [xhrio xhrios] |
| 164 | + (f.http/xhrio-abort xhrio)) |
| 165 | + (log/info "Unable to abort. No active request with abort id:" id)))})) |
0 commit comments