370 lines
12 KiB
Clojure
370 lines
12 KiB
Clojure
(ns cljs-http.client
|
|
(:refer-clojure :exclude [get])
|
|
(:require [cljs-http.core :as core]
|
|
[cljs-http.util :as util]
|
|
[cljs.core.async :as async :refer [<! chan close! put!]]
|
|
[cljs.reader :refer [read-string]]
|
|
[clojure.string :refer [blank? join split]]
|
|
[goog.Uri :as uri]
|
|
[no.en.core :refer [url-encode url-decode]])
|
|
(:require-macros [cljs.core.async.macros :refer [go]]))
|
|
|
|
(defn if-pos [v]
|
|
(if (and v (pos? v)) v))
|
|
|
|
(defn- acc-param [o v]
|
|
(cond
|
|
(coll? o) (conj o v)
|
|
(some? o) [o v]
|
|
:else v))
|
|
|
|
(defn parse-query-params
|
|
"Parse `s` as query params and return a hash map."
|
|
[s]
|
|
(if-not (blank? s)
|
|
(reduce
|
|
#(let [[k v] (split %2 #"=")]
|
|
(update %1
|
|
(keyword (url-decode k))
|
|
acc-param
|
|
(url-decode v)))
|
|
{} (split (str s) #"&"))))
|
|
|
|
(defn parse-url
|
|
"Parse `url` into a hash map."
|
|
[url]
|
|
(if-not (blank? url)
|
|
(let [uri (uri/parse url)
|
|
query-data (.getQueryData uri)]
|
|
{:scheme (keyword (.getScheme uri))
|
|
:server-name (.getDomain uri)
|
|
:server-port (if-pos (.getPort uri))
|
|
:uri (.getPath uri)
|
|
:query-string (if-not (.isEmpty query-data)
|
|
(str query-data))
|
|
:query-params (if-not (.isEmpty query-data)
|
|
(parse-query-params (str query-data)))})))
|
|
|
|
(def unexceptional-status?
|
|
#{200 201 202 203 204 205 206 207 300 301 302 303 307})
|
|
|
|
(defn- encode-val [k v]
|
|
(str (url-encode (name k)) "=" (url-encode (str v))))
|
|
|
|
(defn- encode-vals [k vs]
|
|
(->>
|
|
vs
|
|
(map #(encode-val k %))
|
|
(join "&")))
|
|
|
|
(defn- encode-param [[k v]]
|
|
(if (coll? v)
|
|
(encode-vals k v)
|
|
(encode-val k v)))
|
|
|
|
(defn generate-query-string [params]
|
|
(->>
|
|
params
|
|
(map encode-param)
|
|
(join "&")))
|
|
|
|
(def regex-char-esc-smap
|
|
(let [esc-chars "()*&^%$#!+"]
|
|
(zipmap esc-chars
|
|
(map #(str "\\" %) esc-chars))))
|
|
|
|
(defn escape-special
|
|
"Escape special characters -- for content-type."
|
|
[string]
|
|
(->> string
|
|
(replace regex-char-esc-smap)
|
|
(reduce str)))
|
|
|
|
(defn decode-body
|
|
"Decocde the :body of `response` with `decode-fn` if the content type matches."
|
|
[response decode-fn content-type request-method]
|
|
(if (and (not= :head request-method)
|
|
(not= 204 (:status response))
|
|
(re-find (re-pattern (str "(?i)" (escape-special content-type)))
|
|
(str (clojure.core/get (:headers response) "content-type" ""))))
|
|
(update-in response [:body] decode-fn)
|
|
response))
|
|
|
|
(defn wrap-edn-params
|
|
"Encode :edn-params in the `request` :body and set the appropriate
|
|
Content Type header."
|
|
[client]
|
|
(fn [request]
|
|
(if-let [params (:edn-params request)]
|
|
(let [headers (merge {"content-type" "application/edn"} (:headers request))]
|
|
(-> (dissoc request :edn-params)
|
|
(assoc :body (pr-str params))
|
|
(assoc :headers headers)
|
|
(client)))
|
|
(client request))))
|
|
|
|
(defn wrap-edn-response
|
|
"Decode application/edn responses."
|
|
[client]
|
|
(fn [request]
|
|
(-> #(decode-body % read-string "application/edn" (:request-method request))
|
|
(async/map [(client request)]))))
|
|
|
|
(defn wrap-default-headers
|
|
[client & [default-headers]]
|
|
(fn [request]
|
|
(if-let [default-headers (or (:default-headers request) default-headers)]
|
|
(client (assoc request :default-headers default-headers))
|
|
(client request))))
|
|
|
|
(defn wrap-accept
|
|
[client & [accept]]
|
|
(fn [request]
|
|
(if-let [accept (or (:accept request) accept)]
|
|
(client (assoc-in request [:headers "accept"] accept))
|
|
(client request))))
|
|
|
|
(defn wrap-content-type
|
|
[client & [content-type]]
|
|
(fn [request]
|
|
(if-let [content-type (or (:content-type request) content-type)]
|
|
(client (assoc-in request [:headers "content-type"] content-type))
|
|
(client request))))
|
|
|
|
(def ^{:private true} default-transit-opts
|
|
{:encoding :json :encoding-opts {}
|
|
:decoding :json :decoding-opts {}})
|
|
|
|
(defn wrap-transit-params
|
|
"Encode :transit-params in the `request` :body and set the appropriate
|
|
Content Type header.
|
|
|
|
A :transit-opts map can be optionally provided with the following keys:
|
|
|
|
:encoding #{:json, :json-verbose}
|
|
:decoding #{:json, :json-verbose}
|
|
:encoding/decoding-opts appropriate map of options to be passed to
|
|
transit writer/reader, respectively."
|
|
[client]
|
|
(fn [request]
|
|
(if-let [params (:transit-params request)]
|
|
(let [{:keys [encoding encoding-opts]} (merge default-transit-opts
|
|
(:transit-opts request))
|
|
headers (merge {"content-type" "application/transit+json"} (:headers request))]
|
|
(-> (dissoc request :transit-params)
|
|
(assoc :body (util/transit-encode params encoding encoding-opts))
|
|
(assoc :headers headers)
|
|
(client)))
|
|
(client request))))
|
|
|
|
(defn wrap-transit-response
|
|
"Decode application/transit+json responses."
|
|
[client]
|
|
(fn [request]
|
|
(let [{:keys [decoding decoding-opts]} (merge default-transit-opts
|
|
(:transit-opts request))
|
|
transit-decode #(util/transit-decode % decoding decoding-opts)]
|
|
|
|
(-> #(decode-body % transit-decode "application/transit+json" (:request-method request))
|
|
(async/map [(client request)])))))
|
|
|
|
(defn wrap-json-params
|
|
"Encode :json-params in the `request` :body and set the appropriate
|
|
Content Type header."
|
|
[client]
|
|
(fn [request]
|
|
(if-let [params (:json-params request)]
|
|
(let [headers (merge {"content-type" "application/json"} (:headers request))]
|
|
(-> (dissoc request :json-params)
|
|
(assoc :body (util/json-encode params))
|
|
(assoc :headers headers)
|
|
(client)))
|
|
(client request))))
|
|
|
|
(defn wrap-json-response
|
|
"Decode application/json responses."
|
|
[client]
|
|
(fn [request]
|
|
(-> #(decode-body % util/json-decode "application/json" (:request-method request))
|
|
(async/map [(client request)]))))
|
|
|
|
(defn wrap-query-params [client]
|
|
(fn [{:keys [query-params] :as req}]
|
|
(if query-params
|
|
(client (-> req (dissoc :query-params)
|
|
(assoc :query-string
|
|
(generate-query-string query-params))))
|
|
(client req))))
|
|
|
|
(defn wrap-form-params [client]
|
|
(fn [{:keys [form-params request-method headers] :as request}]
|
|
(if (and form-params (#{:post :put :patch :delete} request-method))
|
|
(let [headers (merge {"content-type" "application/x-www-form-urlencoded"} headers)]
|
|
(client (-> request
|
|
(dissoc :form-params)
|
|
(assoc :body (generate-query-string form-params))
|
|
(assoc :headers headers))))
|
|
(client request))))
|
|
|
|
(defn generate-form-data [params]
|
|
(let [form-data (js/FormData.)]
|
|
(doseq [[k v] params]
|
|
(if (coll? v)
|
|
(.append form-data (name k) (first v) (second v))
|
|
(.append form-data (name k) v)))
|
|
form-data))
|
|
|
|
(defn wrap-multipart-params [client]
|
|
(fn [{:keys [multipart-params request-method] :as request}]
|
|
(if (and multipart-params (#{:post :put :patch :delete} request-method))
|
|
(client (-> request
|
|
(dissoc :multipart-params)
|
|
(assoc :body (generate-form-data multipart-params))))
|
|
(client request))))
|
|
|
|
(defn wrap-method [client]
|
|
(fn [req]
|
|
(if-let [m (:method req)]
|
|
(client (-> req (dissoc :method)
|
|
(assoc :request-method m)))
|
|
(client req))))
|
|
|
|
(defn wrap-server-name [client server-name]
|
|
#(client (assoc %1 :server-name server-name)))
|
|
|
|
(defn wrap-url [client]
|
|
(fn [{:keys [query-params] :as req}]
|
|
(if-let [spec (parse-url (:url req))]
|
|
(client (-> (merge req spec)
|
|
(dissoc :url)
|
|
(update-in [:query-params] #(merge %1 query-params))))
|
|
(client req))))
|
|
|
|
(defn wrap-basic-auth
|
|
"Middleware converting the :basic-auth option or `credentials` into
|
|
an Authorization header."
|
|
[client & [credentials]]
|
|
(fn [req]
|
|
(let [credentials (or (:basic-auth req) credentials)]
|
|
(if-not (empty? credentials)
|
|
(client (-> (dissoc req :basic-auth)
|
|
(assoc-in [:headers "authorization"] (util/basic-auth credentials))))
|
|
(client req)))))
|
|
|
|
(defn wrap-oauth
|
|
"Middleware converting the :oauth-token option into an Authorization header."
|
|
[client]
|
|
(fn [req]
|
|
(if-let [oauth-token (:oauth-token req)]
|
|
(client (-> req (dissoc :oauth-token)
|
|
(assoc-in [:headers "authorization"]
|
|
(str "Bearer " oauth-token))))
|
|
(client req))))
|
|
|
|
(defn wrap-channel-from-request-map
|
|
"Pipe the response-channel into the request-map's
|
|
custom channel (e.g. to enable transducers)"
|
|
[client]
|
|
(fn [request]
|
|
(if-let [custom-channel (:channel request)]
|
|
(async/pipe (client request) custom-channel)
|
|
(client request))))
|
|
|
|
(defn wrap-request
|
|
"Returns a batteries-included HTTP request function coresponding to the given
|
|
core client. See client/request"
|
|
[request]
|
|
(-> request
|
|
wrap-accept
|
|
wrap-form-params
|
|
wrap-multipart-params
|
|
wrap-edn-params
|
|
wrap-edn-response
|
|
wrap-transit-params
|
|
wrap-transit-response
|
|
wrap-json-params
|
|
wrap-json-response
|
|
wrap-content-type
|
|
wrap-query-params
|
|
wrap-basic-auth
|
|
wrap-oauth
|
|
wrap-method
|
|
wrap-url
|
|
wrap-channel-from-request-map
|
|
wrap-default-headers))
|
|
|
|
(def #^{:doc
|
|
"Executes the HTTP request corresponding to the given map and returns the
|
|
response map for corresponding to the resulting HTTP response.
|
|
|
|
In addition to the standard Ring request keys, the following keys are also
|
|
recognized:
|
|
* :url
|
|
* :method
|
|
* :query-params"}
|
|
request (wrap-request core/request))
|
|
|
|
(defn delete
|
|
"Like #'request, but sets the :method and :url as appropriate."
|
|
[url & [req]]
|
|
(request (merge req {:method :delete :url url})))
|
|
|
|
(defn get
|
|
"Like #'request, but sets the :method and :url as appropriate."
|
|
[url & [req]]
|
|
(request (merge req {:method :get :url url})))
|
|
|
|
(defn head
|
|
"Like #'request, but sets the :method and :url as appropriate."
|
|
[url & [req]]
|
|
(request (merge req {:method :head :url url})))
|
|
|
|
(defn jsonp
|
|
"Like #'request, but sets the :method and :url as appropriate."
|
|
[url & [req]]
|
|
(request (merge req {:method :jsonp :url url})))
|
|
|
|
(defn move
|
|
"Like #'request, but sets the :method and :url as appropriate."
|
|
[url & [req]]
|
|
(request (merge req {:method :move :url url})))
|
|
|
|
(defn options
|
|
"Like #'request, but sets the :method and :url as appropriate."
|
|
[url & [req]]
|
|
(request (merge req {:method :options :url url})))
|
|
|
|
(defn patch
|
|
"Like #'request, but sets the :method and :url as appropriate."
|
|
[url & [req]]
|
|
(request (merge req {:method :patch :url url})))
|
|
|
|
(defn post
|
|
"Like #'request, but sets the :method and :url as appropriate."
|
|
[url & [req]]
|
|
(request (merge req {:method :post :url url})))
|
|
|
|
(defn put
|
|
"Like #'request, but sets the :method and :url as appropriate."
|
|
[url & [req]]
|
|
(request (merge req {:method :put :url url})))
|
|
|
|
(comment
|
|
|
|
(ns example.core
|
|
(:require [cljs-http.client :as http]
|
|
[cljs.core.async :refer [<!]])
|
|
(:require-macros [cljs.core.async.macros :refer [go]]))
|
|
|
|
(go (prn (map :login (:body (<! (get "https://api.github.com/users"))))))
|
|
|
|
(go (prn (:status (<! (get "http://api.burningswell.dev/continents")))))
|
|
|
|
(go (prn (map :name (:body (<! (get "http://api.burningswell.dev/continents"))))))
|
|
|
|
(go (let [response (<! (get "https://api.github.com/users"))]
|
|
(prn (:status response))
|
|
(prn (map :login (:body response)))))
|
|
|
|
(go (prn (<! (get "http://api.burningswell.dev/continents")))))
|