A version of castra.cljs without jquery

castra.cljs

;; Copyright (c) Alan Dipert and Micha Niskin. All rights reserved.
;; The use and distribution terms for this software are covered by the
;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;; which can be found in the file epl-v10.html at the root of this distribution.
;; By using this software in any fashion, you are agreeing to be bound by
;; the terms of this license.
;; You must not remove this notice, or any other, from this software.
(ns upgradingdave.castra
  (:require [cognitect.transit :as t]
            [goog.labs.net.xhr :as gxhr])
  (:import  [goog.async Deferred]
            [goog Promise]))

;; helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn- safe-pop
  [x]
  (or (try (pop x) (catch js/Error e)) x))

(defn- assoc-when
  [m k v]
  (if-not v m (assoc m k v)))

;; public api ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def ^:dynamic *validate-only*
  "Only validate request parameters, don't actually do it?"
  nil)

(defn ex?
  "Returns true if x is an ExceptionInfo."
  [x]
  (instance? ExceptionInfo x))

(defn make-ex
  "Given either an existing exception or a map, returns an ExceptionInfo
  object with the special status and serverStack properties set. If ex is
  an exception already then ex itself is returned."
  [ex]
  (if (ex? ex)
    ex
    (let [{:keys [status message data stack cause]} ex]
      (doto (ex-info message (or data {}) cause)
        (aset "serverStack" stack)
        (aset "status" status)))))

(defn- xhr-resp-headers
  [xhr headers]
  (reduce #(if-let [x (.getResponseHeader xhr %2)] (assoc %1 %2 x) %1) {} headers))

(defn ajax-fn
  "Ajax request implementation using Closure ajax machinery."
  [{:keys [url timeout credentials headers body]}]
  (let [opts (-> {"headers"   (merge 
                               headers
                               {gxhr/CONTENT_TYPE_HEADER
                                "application/json"})
                  "timeoutMs" timeout}
                 ;; TODO: test credentials
                 (assoc-when "withCredentials" credentials))
        resp (fn [x]
               {:status      (.-status x)
                :status-text (.-statusText x)
                :body        (.-responseText x)
                :headers     (xhr-resp-headers 
                              x 
                              ["X-Castra-Tunnel" "X-Castra-Session"])})]
    (-> (gxhr/send "POST" url (clj->js body) (clj->js opts))
        (.then 
         ;; resolve will receive the xhr
         (fn [x] (resp x))
         ;; TODO need to test this
         ;; reject will receive a xhr.HttpError or xhr.Error on network error
         (fn [x] (resp x))))
    ))

(def ^:private storage-key (str ::session))

(defn- get-session [ ] (.getItem js/localStorage storage-key))
(defn- set-session [x] (if (= x "DELETE")
                         (.removeItem js/localStorage storage-key)
                         (when x (.setItem js/localStorage storage-key x))))

(defn ajax
  [{:keys [ajax-fn clj->json json->clj on-error] :as opts} expr]
  (let [headers (-> {"X-Castra-Csrf"          "true"
                     "X-Castra-Tunnel"        "transit"
                     "X-Castra-Validate-Only" (str (boolean *validate-only*))
                     "Accept"                 "application/json"}
                    (assoc-when "X-Castra-Session" (get-session)))
        body    (if (string? expr) expr (clj->json expr))
        wrap-ex #(make-ex {:message "Server Error" :cause %})
        ajax-ex #(wrap-ex (make-ex {:status %1 :message %2}))
        prom'   (ajax-fn (merge opts {:headers headers :body body}))
        resp    #(-> (json->clj %) 
                     (try (catch js/Error e {:error (wrap-ex e)})))]
    (-> prom'
        (.then
         (fn [{:keys [headers body]}]
           (set-session (get headers "X-Castra-Session"))
           (let [{:keys [ok error]} (resp body)]
             (or (and (not error) ok)
                 (doto (make-ex error) on-error))))
         (fn [{:keys [headers body status status-text]}]
           (doto (ajax-ex status status-text) on-error))))))

(defn with-default-opts
  [& [opts]]
  (->> opts (merge {:timeout     0
                    :credentials true
                    :on-error    identity
                    :ajax-fn     ajax-fn
                    :json->clj   (partial t/read (t/reader :json))
                    :clj->json   (partial t/write (t/writer :json))
                    :url         (.. js/window -location -href)})))

(defn mkremote
  "Given state error and loading input cells, returns an RPC function. The
  optional :url keyword argument can be used to specify the URL to which the
  POST requests will be made."
  [endpoint state error loading & [opts]]
  (fn [& args]
    (let [live?  (not *validate-only*)
          prom   (Promise.withResolver)
          unload #(vec (remove (partial = prom) %))]
      (when live? (swap! loading (fnil conj []) prom))
      (let [prom' (-> (ajax 
                       (with-default-opts opts) `[~endpoint ~@args])
                      (.then
                       #(do (when live?
                              (reset! error nil)
                              (reset! state %))
                            (.resolve prom))
                       #(do (when live? (reset! error %))
                            (.reject prom)))
                      (.thenAlways
                       #(when live? (swap! loading unload))))]
        (doto prom (aset "xhr" prom'))
        ))))

mkremote.cljs

(defn- mkremote
  "Given app db, returns a castra RPC function that can be used as a
  re-frame handler."
  [endpoint path & [opts]]
  (fn [db [_ args]]
    (let [prom   (Promise.withResolver)
          unload #(vec (remove (partial = prom) %))]
      (let [prom' (-> (ajax 
                       (with-default-opts opts) `[~endpoint ~args])
                      (.then
                       #(do 
                          (dispatch [:process-response [path %1]])
                          (.resolve prom))
                       #(do 
                          (dispatch [:bad-response path %1])
                          (.reject prom)))
                      (.thenAlways
                       #(dispatch [:finish-response unload])))]
        (update-in db [:loading] #(conj (or % []) 
                                        (doto prom (aset "xhr" prom')))))
      )))

;; TODO: I think it might be better if all rpc calls return session
;; state? Need to think about authentication some more. 
(register-handler
 :process-response
 (fn [db [_ [path resp]]]

   ;; The server might send a valid response, but the response will
   ;; contain an exception object rather than the expected data.
   (if-let [e (ex-data resp)]
     (cond 

       ;; this probably means cookie session expired
       (= (:photos.api/msg e) "unauthorized")
       (-> db
           (assoc-in path     nil)
           (assoc-in [:user]  nil)
           (assoc-in [:error] e))

       :else
       (-> db
           (assoc-in path     nil)
           (assoc-in [:error] e)))

     ;; success!
     (assoc-in db path resp))))

;; If there's a problem with the http request (network failure or
;; something strange) then this will get triggered. 
;; TODO this has not been tested
(register-handler 
 :bad-response
 (fn [db [path resp]]
   ;; (js/console.error "BAD RESPONSE")
   db))

(register-handler 
 :finish-response
 (fn [db [unload]]
   (update-in db [:loading] unload)))

I really like the ideas and design of castra. I was experimenting with using it on a personal project where I used reagent. Since nothing else in the project required jquery, I wondered if I could remove the dependency on jquery from the castra.cljs. Here's what I came up with. It uses goog.labs.net.xhr, goog.async.Deferred, and goog.Promise, instead of jquery deferred, async and promises .

I just took core.cljs from the castra project, copied and pasted and changed it to work. But with a little extra work, I think this could be tweaked so that jquery is optional (but still leave it as the default).

Maybe have two separate implementations of ajax-fn: a jquery-ajax-fn and a goog-ajax-fn or something along those lines.

Also, the custom version of the mkremote function in mkremote.cljs above works with the reframe library.