151 lines
5.5 KiB
Clojure
151 lines
5.5 KiB
Clojure
(ns cljs-http.core
|
|
(:import [goog.net EventType ErrorCode XhrIo]
|
|
[goog.net Jsonp])
|
|
(:require-macros [cljs.core.async.macros :refer [go]])
|
|
(:require [cljs-http.util :as util]
|
|
[cljs.core.async :as async]
|
|
[clojure.string :as s]))
|
|
|
|
(def pending-requests (atom {}))
|
|
|
|
(defn abort!
|
|
"Attempt to close the given channel and abort the pending HTTP request
|
|
with which it is associated."
|
|
[channel]
|
|
(when-let [req (@pending-requests channel)]
|
|
(swap! pending-requests dissoc channel)
|
|
(async/close! channel)
|
|
(if (.hasOwnProperty req "abort")
|
|
(.abort req)
|
|
(.cancel (:jsonp req) (:request req)))))
|
|
|
|
(defn- aborted? [xhr]
|
|
(= (.getLastErrorCode xhr) goog.net.ErrorCode.ABORT))
|
|
|
|
(defn apply-default-headers!
|
|
"Takes an XhrIo object and applies the default-headers to it."
|
|
[xhr headers]
|
|
(let [formatted-h (zipmap (map util/camelize (keys headers)) (vals headers))]
|
|
(dorun
|
|
(map (fn [[k v]]
|
|
(.set (.-headers xhr) k v))
|
|
formatted-h))))
|
|
|
|
(defn apply-response-type!
|
|
"Takes an XhrIo object and sets response-type if not nil."
|
|
[xhr response-type]
|
|
(.setResponseType xhr
|
|
(case response-type
|
|
:array-buffer XhrIo.ResponseType.ARRAY_BUFFER
|
|
:blob XhrIo.ResponseType.BLOB
|
|
:document XhrIo.ResponseType.DOCUMENT
|
|
:text XhrIo.ResponseType.TEXT
|
|
:default XhrIo.ResponseType.DEFAULT
|
|
nil XhrIo.ResponseType.DEFAULT)))
|
|
|
|
(defn build-xhr
|
|
"Builds an XhrIo object from the request parameters."
|
|
[{:keys [with-credentials? default-headers response-type] :as request}]
|
|
(let [timeout (or (:timeout request) 0)
|
|
send-credentials (if (nil? with-credentials?)
|
|
true
|
|
with-credentials?)]
|
|
(doto (XhrIo.)
|
|
(apply-default-headers! default-headers)
|
|
(apply-response-type! response-type)
|
|
(.setTimeoutInterval timeout)
|
|
(.setWithCredentials send-credentials))))
|
|
|
|
;; goog.net.ErrorCode constants to CLJS keywords
|
|
(def error-kw
|
|
{0 :no-error
|
|
1 :access-denied
|
|
2 :file-not-found
|
|
3 :ff-silent-error
|
|
4 :custom-error
|
|
5 :exception
|
|
6 :http-error
|
|
7 :abort
|
|
8 :timeout
|
|
9 :offline})
|
|
|
|
(defn xhr
|
|
"Execute the HTTP request corresponding to the given Ring request
|
|
map and return a core.async channel."
|
|
[{:keys [request-method headers body with-credentials? cancel progress] :as request}]
|
|
(let [channel (async/chan)
|
|
request-url (util/build-url request)
|
|
method (name (or request-method :get))
|
|
headers (util/build-headers headers)
|
|
xhr (build-xhr request)]
|
|
(swap! pending-requests assoc channel xhr)
|
|
(.listen xhr EventType.COMPLETE
|
|
(fn [evt]
|
|
(let [target (.-target evt)
|
|
response {:status (.getStatus target)
|
|
:success (.isSuccess target)
|
|
:body (.getResponse target)
|
|
:headers (util/parse-headers (.getAllResponseHeaders target))
|
|
:trace-redirects [request-url (.getLastUri target)]
|
|
:error-code (error-kw (.getLastErrorCode target))
|
|
:error-text (.getLastError target)}]
|
|
(if-not (aborted? xhr)
|
|
(async/put! channel response))
|
|
(swap! pending-requests dissoc channel)
|
|
(if cancel (async/close! cancel))
|
|
(async/close! channel))))
|
|
|
|
(when progress
|
|
(let [listener (fn [direction evt]
|
|
(async/put! progress (merge {:direction direction :loaded (.-loaded evt)}
|
|
(if (.-lengthComputable evt) {:total (.-total evt)}))))]
|
|
(doto xhr
|
|
(.setProgressEventsEnabled true)
|
|
(.listen EventType.UPLOAD_PROGRESS (partial listener :upload))
|
|
(.listen EventType.DOWNLOAD_PROGRESS (partial listener :download)))))
|
|
|
|
(.send xhr request-url method body headers)
|
|
(if cancel
|
|
(go
|
|
(let [v (async/<! cancel)]
|
|
(if (not (.isComplete xhr))
|
|
(.abort xhr)))))
|
|
channel))
|
|
|
|
(defn jsonp
|
|
"Execute the JSONP request corresponding to the given Ring request
|
|
map and return a core.async channel."
|
|
[{:keys [timeout callback-name cancel keywordize-keys?]
|
|
:or {keywordize-keys? true}
|
|
:as request}]
|
|
(let [channel (async/chan)
|
|
jsonp (Jsonp. (util/build-url request) callback-name)]
|
|
(.setRequestTimeout jsonp timeout)
|
|
(let [req (.send jsonp nil
|
|
(fn success-callback [data]
|
|
(let [response {:status 200
|
|
:success true
|
|
:body (js->clj data :keywordize-keys keywordize-keys?)}]
|
|
(async/put! channel response)
|
|
(swap! pending-requests dissoc channel)
|
|
(if cancel (async/close! cancel))
|
|
(async/close! channel)))
|
|
(fn error-callback []
|
|
(swap! pending-requests dissoc channel)
|
|
(if cancel (async/close! cancel))
|
|
(async/close! channel)))]
|
|
(swap! pending-requests assoc channel {:jsonp jsonp :request req})
|
|
(if cancel
|
|
(go
|
|
(let [v (async/<! cancel)]
|
|
(.cancel jsonp req)))))
|
|
channel))
|
|
|
|
(defn request
|
|
"Execute the HTTP request corresponding to the given Ring request
|
|
map and return a core.async channel."
|
|
[{:keys [request-method] :as request}]
|
|
(if (= request-method :jsonp)
|
|
(jsonp request)
|
|
(xhr request)))
|