461 lines
15 KiB
Clojure
Executable File
461 lines
15 KiB
Clojure
Executable File
(ns ajax.core
|
|
(:require goog.net.EventType
|
|
goog.net.ErrorCode
|
|
[goog.net.XhrIo :as xhr]
|
|
[goog.net.XhrManager :as xhrm]
|
|
[goog.Uri :as uri]
|
|
[goog.json :as goog-json]
|
|
[goog.Uri.QueryData :as query-data]
|
|
[goog.json.Serializer]
|
|
[goog.events :as events]
|
|
[goog.structs :as structs]
|
|
[cljs.reader :as reader]
|
|
[clojure.string :as str]
|
|
[cognitect.transit :as t])
|
|
(:require-macros [ajax.macros :as m]
|
|
[poppea :as p]))
|
|
|
|
(defprotocol AjaxImpl
|
|
"An abstraction for a javascript class that implements
|
|
Ajax calls."
|
|
(-js-ajax-request [this uri method body headers handler opts]
|
|
"Makes an actual ajax request. All parameters except opts
|
|
are in JS format. Should return an AjaxRequest."))
|
|
|
|
(defprotocol AjaxRequest
|
|
"An abstraction for a running ajax request."
|
|
(-abort [this]
|
|
"Aborts a running ajax request, if possible."))
|
|
|
|
(defprotocol DirectlySubmittable
|
|
"A marker interface for types that can be directly sent to XhrIo.")
|
|
|
|
(defprotocol AjaxResponse
|
|
"An abstraction for an ajax response."
|
|
(-status [this]
|
|
"Returns the HTTP Status of the response as an integer.")
|
|
(-status-text [this]
|
|
"Returns the HTTP Status Text of the response as a string.")
|
|
(-body [this]
|
|
"Returns the response body as a string or as type specified in response-format
|
|
such as a blob or arraybuffer.")
|
|
(-get-response-header [this header]
|
|
"Gets the specified response header (specified by a string) as a string.")
|
|
(-was-aborted [this]
|
|
"Was the response aborted."))
|
|
|
|
(m/register-directly-submittable js/FormData js/ArrayBufferView
|
|
js/Blob js/Document)
|
|
|
|
(defn submittable? [params]
|
|
(or (satisfies? DirectlySubmittable params)
|
|
(string? params)))
|
|
|
|
(extend-type goog.net.XhrIo
|
|
AjaxImpl
|
|
(-js-ajax-request
|
|
[this uri method body headers handler
|
|
{:keys [timeout with-credentials]
|
|
:or {with-credentials false
|
|
timeout 0}}]
|
|
(doto this
|
|
(events/listen goog.net.EventType/COMPLETE
|
|
#(handler (.-target %)))
|
|
(.setTimeoutInterval timeout)
|
|
(.setWithCredentials with-credentials)
|
|
(.send uri method body (clj->js headers))))
|
|
AjaxRequest
|
|
(-abort [this] (.abort this goog.net.ErrorCode/ABORT))
|
|
AjaxResponse
|
|
(-body [this] (.getResponseText this))
|
|
(-status [this] (.getStatus this))
|
|
(-status-text [this] (.getStatusText this))
|
|
(-get-response-header [this header]
|
|
(.getResponseHeader this header))
|
|
(-was-aborted [this]
|
|
(= (.getLastErrorCode this) goog.net.ErrorCode/ABORT)))
|
|
|
|
(defn ready-state
|
|
[e]
|
|
({0 :not-initialized
|
|
1 :connection-established
|
|
2 :request-received
|
|
3 :processing-request
|
|
4 :response-ready} (.-readyState (.-target e))))
|
|
|
|
(extend-type js/XMLHttpRequest
|
|
AjaxImpl
|
|
(-js-ajax-request
|
|
[this uri method body headers handler
|
|
{:keys [timeout with-credentials response-format]
|
|
:or {with-credentials false
|
|
timeout 0}}]
|
|
(set! (.-withCredentials this) with-credentials)
|
|
(set! (.-onreadystatechange this) #(when (= :response-ready (ready-state %)) (handler this)))
|
|
(.open this method uri true)
|
|
(set! (.-timeout this) timeout)
|
|
; IE8 needs timeout to be set between open and send
|
|
; https://msdn.microsoft.com/en-us/library/cc304105(v=vs.85).aspx
|
|
(when-let [response-type (:type response-format)]
|
|
(set! (.-responseType this) (name response-type)))
|
|
(doseq [[k v] headers]
|
|
(.setRequestHeader this k v))
|
|
(.send this (or body ""))
|
|
this)
|
|
AjaxRequest
|
|
(-abort [this] (.abort this))
|
|
AjaxResponse
|
|
(-body [this] (.-response this))
|
|
(-status [this] (.-status this))
|
|
(-status-text [this] (.-statusText this))
|
|
(-get-response-header [this header]
|
|
(.getResponseHeader this header))
|
|
(-was-aborted [this] (= 0 (.-readyState this))))
|
|
|
|
(extend-type goog.net.XhrManager
|
|
AjaxImpl
|
|
(-js-ajax-request
|
|
[this uri method body headers handler
|
|
{:keys [id timeout priority max-retries]}]
|
|
(.send this id uri method body (clj->js headers)
|
|
priority handler max-retries)))
|
|
|
|
(defn abort ([this] (-abort this)))
|
|
|
|
(defn success? [status]
|
|
(some #{status} [200 201 202 204 205 206]))
|
|
|
|
;;; Standard Formats
|
|
|
|
(defn read-edn [xhrio]
|
|
(reader/read-string (-body xhrio)))
|
|
|
|
(defn edn-response-format
|
|
([] {:read read-edn
|
|
:description "EDN"
|
|
:content-type "application/edn"})
|
|
([opts] (edn-response-format)))
|
|
|
|
(defn edn-request-format []
|
|
{:write pr-str
|
|
:content-type "application/edn"})
|
|
|
|
(p/defn-curried transit-write
|
|
[writer params]
|
|
(t/write writer params))
|
|
|
|
(defn transit-request-format
|
|
([] (transit-request-format {}))
|
|
([{:keys [type writer] :as opts}]
|
|
(let [writer (or writer (t/writer (or type :json) opts))]
|
|
{:write (transit-write writer)
|
|
:content-type "application/transit+json"})))
|
|
|
|
(p/defn-curried transit-read [reader raw xhrio]
|
|
(let [text (-body xhrio)
|
|
data (t/read reader text)]
|
|
(if raw data (js->clj data))))
|
|
|
|
(defn transit-response-format
|
|
([] (transit-response-format {}))
|
|
([{:keys [type reader raw] :as opts}]
|
|
(let [reader (or reader (t/reader (or type :json) opts))]
|
|
{:read (transit-read reader raw)
|
|
:description "Transit"
|
|
:content-type "application/transit+json"})))
|
|
|
|
(defn params-to-str [params]
|
|
(if params
|
|
(-> params
|
|
clj->js
|
|
structs/Map.
|
|
query-data/createFromMap
|
|
.toString)))
|
|
|
|
(defn url-request-format []
|
|
{:write params-to-str
|
|
:content-type "application/x-www-form-urlencoded"})
|
|
|
|
(defn raw-response-format
|
|
([] {:read -body :description "raw text" :content-type "*/*"})
|
|
([opts] (raw-response-format)))
|
|
|
|
(defn write-json [data]
|
|
(.serialize (goog.json.Serializer.) (clj->js data)))
|
|
|
|
(defn json-request-format []
|
|
{:write write-json
|
|
:content-type "application/json"})
|
|
|
|
(p/defn-curried json-read [prefix raw keywords? xhrio]
|
|
(let [text (-body xhrio)
|
|
text (if (and prefix (= 0 (.indexOf text prefix)))
|
|
(.substring text (.length prefix))
|
|
text)
|
|
json (goog-json/parse text)]
|
|
(if raw
|
|
json
|
|
(js->clj json :keywordize-keys keywords?))))
|
|
|
|
(defn json-response-format
|
|
"Returns a JSON response format. Options include
|
|
:keywords? Returns the keys as keywords
|
|
:prefix A prefix that needs to be stripped off. This is to
|
|
combat JSON hijacking. If you're using JSON with GET request,
|
|
you should think about using this.
|
|
http://stackoverflow.com/questions/2669690/why-does-google-prepend-while1-to-their-json-responses
|
|
http://haacked.com/archive/2009/06/24/json-hijacking.aspx"
|
|
([] (json-response-format {}))
|
|
([{:keys [prefix keywords? raw]}]
|
|
{:read (json-read prefix raw keywords?)
|
|
:description (str "JSON"
|
|
(if prefix (str " prefix '" prefix "'"))
|
|
(if keywords? " keywordize"))
|
|
:content-type "application/json"}))
|
|
|
|
;;; Detection and Accept Code
|
|
|
|
(def default-formats
|
|
[json-response-format
|
|
edn-response-format
|
|
transit-response-format
|
|
["text/plain" raw-response-format]
|
|
["text/html" raw-response-format]
|
|
raw-response-format])
|
|
|
|
(p/defn-curried get-format [opts format-entry]
|
|
(cond (vector? format-entry) (get-format opts
|
|
(second format-entry))
|
|
(map? format-entry) format-entry
|
|
; Must be a format generating function
|
|
:else (format-entry opts)))
|
|
|
|
(p/defn-curried accept-entry [opts format-entry]
|
|
(or (if (vector? format-entry)
|
|
(first format-entry)
|
|
(:content-type (get-format opts format-entry)))
|
|
"*/*"))
|
|
|
|
(p/defn-curried detect-content-type [content-type opts format-entry]
|
|
(let [accept (accept-entry opts format-entry)]
|
|
(or (= accept "*/*")
|
|
(>= (.indexOf content-type accept) 0))))
|
|
|
|
(defn get-default-format [xhrio {:keys [response-format] :as opts}]
|
|
(let [f (detect-content-type
|
|
(or (-get-response-header xhrio "Content-Type") "")
|
|
opts)]
|
|
(->> response-format
|
|
(filter f)
|
|
first
|
|
(get-format opts))))
|
|
|
|
(p/defn-curried detect-response-format-read
|
|
[opts xhrio]
|
|
((:read (get-default-format xhrio opts)) xhrio))
|
|
|
|
(defn accept-header [{:keys [response-format] :as opts}]
|
|
(if (vector? response-format)
|
|
(str/join ", " (map (accept-entry opts) response-format))
|
|
(accept-entry opts response-format)))
|
|
|
|
(defn detect-response-format
|
|
([] (detect-response-format {:response-format default-formats}))
|
|
([opts]
|
|
(let [accept (accept-header opts)]
|
|
{:read (detect-response-format-read opts)
|
|
:format (str "(from " accept ")")
|
|
:content-type accept})))
|
|
|
|
;;; AJAX calls
|
|
|
|
(defn get-response-format [{:keys [response-format] :as opts}]
|
|
(cond
|
|
(vector? response-format) (detect-response-format opts)
|
|
(map? response-format) response-format
|
|
(ifn? response-format) {:read response-format
|
|
:description "custom"
|
|
:content-type "*/*"}
|
|
:else (throw (js/Error. (str "unrecognized response format: " response-format)))))
|
|
|
|
(defn exception-response [e status {:keys [description]} xhrio]
|
|
(let [response {:status status
|
|
:failure :error
|
|
:response nil}
|
|
status-text (str (.-message e)
|
|
" Format should have been "
|
|
description)
|
|
parse-error (assoc response
|
|
:status-text status-text
|
|
:failure :parse
|
|
:original-text (-body xhrio))]
|
|
(if (success? status)
|
|
parse-error
|
|
(assoc response
|
|
:status-text (-status-text xhrio)
|
|
:parse-error parse-error))))
|
|
|
|
(defn fail [status status-text failure & params]
|
|
(let [response {:status status
|
|
:status-text status-text
|
|
:failure failure}]
|
|
[false (reduce conj
|
|
response
|
|
(map vec (partition 2 params)))]))
|
|
|
|
(defn interpret-response [{:keys [read] :as format} xhrio]
|
|
(try
|
|
(let [status (-status xhrio)
|
|
fail (partial fail status)]
|
|
(case status
|
|
-1 (if (-was-aborted xhrio)
|
|
(fail "Request aborted by client." :aborted)
|
|
(fail "Request timed out." :timeout))
|
|
204 [true nil] ; 204 and 205 should have empty responses
|
|
205 [true nil]
|
|
(try
|
|
(let [response (read xhrio)]
|
|
(if (success? status)
|
|
[true response]
|
|
(fail (-status-text xhrio) :error :response response)))
|
|
(catch js/Object e
|
|
[false (exception-response e status format xhrio)]))))
|
|
(catch js/Object e
|
|
; These errors should never happen
|
|
(fail 0 (.-message e) :exception :exception e))))
|
|
|
|
(defn no-format [xhrio]
|
|
(throw (js/Error. "No response format was supplied.")))
|
|
|
|
(defn uri-with-params [uri params]
|
|
(if params
|
|
(str uri
|
|
(if (re-find #"\?" uri) "&" "?") ; add & if uri contains ?
|
|
(params-to-str params))
|
|
uri))
|
|
|
|
(defn get-request-format [format]
|
|
(cond
|
|
(map? format) format
|
|
(ifn? format) {:write format :content-type "text/plain"}
|
|
:else nil))
|
|
|
|
(defn normalize-method [method]
|
|
(if (keyword? method)
|
|
(str/upper-case (name method))
|
|
method))
|
|
|
|
(defn process-inputs [{:keys [uri method format params headers]}
|
|
{:keys [content-type]}]
|
|
(let [headers (merge {"Accept" content-type}
|
|
(or headers {}))]
|
|
(if (= (normalize-method method) "GET")
|
|
[(uri-with-params uri params) nil headers]
|
|
(let [{:keys [write content-type]}
|
|
(get-request-format format)
|
|
body (cond
|
|
(not (nil? write)) (write params)
|
|
(submittable? params) params
|
|
:else (throw (js/Error. (str "unrecognized request format: " format))))
|
|
content-type (if content-type
|
|
{"Content-Type" (str content-type "; charset=utf-8")})
|
|
headers (merge headers content-type)]
|
|
[uri body headers]))))
|
|
|
|
(p/defn-curried js-handler [response-format handler xhrio]
|
|
(let [response
|
|
(interpret-response response-format xhrio)]
|
|
(handler response)))
|
|
|
|
(defn base-handler [response-format {:keys [handler]}]
|
|
(if handler
|
|
(js-handler response-format handler)
|
|
(throw (js/Error. "No ajax handler provided."))))
|
|
|
|
(defn ajax-request
|
|
[{:keys [method api] :as opts}]
|
|
(let [response-format (get-response-format opts)
|
|
method (normalize-method method)
|
|
[uri body headers] (process-inputs opts response-format)
|
|
handler (base-handler response-format opts)
|
|
api (or api (new goog.net.XhrIo))]
|
|
(-js-ajax-request api uri method body
|
|
headers handler opts)))
|
|
|
|
;;; "Easy" API beyond this point
|
|
|
|
(defn keyword-request-format [format format-params]
|
|
(cond
|
|
(map? format) format
|
|
(fn? format) {:write format}
|
|
(nil? format) (transit-request-format format-params)
|
|
:else (case format
|
|
:transit (transit-request-format format-params)
|
|
:json (json-request-format)
|
|
:edn (edn-request-format)
|
|
:raw (url-request-format)
|
|
:url (url-request-format)
|
|
nil)))
|
|
|
|
(defn keyword-response-format-2 [format format-params]
|
|
(cond
|
|
(vector? format) [(first format)
|
|
(keyword-response-format-2 (second format)
|
|
format-params)]
|
|
(map? format) format
|
|
(fn? format) {:read format :description "custom"}
|
|
(nil? format) (detect-response-format)
|
|
:else (case format
|
|
:transit (transit-response-format format-params)
|
|
:json (json-response-format format-params)
|
|
:edn (edn-response-format)
|
|
:raw (raw-response-format)
|
|
:detect (detect-response-format)
|
|
nil)))
|
|
|
|
(defn keyword-response-format [format format-params]
|
|
(if (vector? format)
|
|
(->> format
|
|
(map #(keyword-response-format-2 % format-params))
|
|
(apply vector))
|
|
(keyword-response-format-2 format format-params)))
|
|
|
|
(p/defn-curried transform-handler
|
|
[{:keys [handler error-handler finally]} [ok result]]
|
|
(if-let [h (if ok handler error-handler)]
|
|
(h result))
|
|
(when (fn? finally)
|
|
(finally)))
|
|
|
|
(defn transform-opts [{:keys [method format response-format params]
|
|
:as opts}]
|
|
"Note that if you call GET, POST et al, this function gets
|
|
called and will include JSON and EDN code in your JS.
|
|
If you don't want this to happen, use ajax-request directly
|
|
(and use advanced optimisation)."
|
|
(let [needs-format
|
|
(not (or (submittable? params)
|
|
(= method "GET")))
|
|
rf (if (or format needs-format)
|
|
(keyword-request-format format opts))]
|
|
(assoc opts
|
|
:handler (transform-handler opts)
|
|
:format rf
|
|
:response-format (keyword-response-format response-format opts))))
|
|
|
|
(defn easy-ajax-request [uri method opts]
|
|
(-> opts
|
|
(assoc :uri uri
|
|
:method method)
|
|
ajax.core/transform-opts
|
|
ajax.core/ajax-request))
|
|
|
|
(m/easy-api GET)
|
|
(m/easy-api HEAD)
|
|
(m/easy-api POST)
|
|
(m/easy-api PUT)
|
|
(m/easy-api DELETE)
|
|
(m/easy-api OPTIONS)
|
|
(m/easy-api TRACE)
|
|
(m/easy-api PATCH)
|