rpc.cljs.hl

(ns app.rpc
  (:require-macros
    [adzerk.env :as env])
  (:require
    [ui.util :as util]
    [ui.paging :as p :refer-macros [defp]]
    [castra.core :as castra :refer [mkremote]]))

(env/def
  GEIR_BRANCH      nil
  GEIR_COMMIT      nil
  GEIR_BACKEND_URL :required)

;; file uploads ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

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


(defn multipart-ajax-fn
  "Ajax request implementation using the standard jQuery ajax machinery."
  [{:keys [url timeout credentials headers body]}]
  (let [prom (.Deferred js/jQuery)
        opts (-> {"async"       true
                  "contentType" false
                  "data"        body
                  "headers"     headers
                  "processData" false
                  "type"        "POST"
                  "url"         url
                  "timeout"     timeout}
                 (assoc-when "xhrFields" (assoc-when nil "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"])})]
    (-> (.ajax js/jQuery (clj->js opts))
        (.done (fn [_ _ x] (.resolve prom (resp x))))
        (.fail (fn [x _ _] (.reject  prom (resp x)))))
    prom))

(defn clj->form-data
  [[endpoint x]]
  (let [d (js/FormData.)]
    (.append d "castra-endpoint" (name endpoint))
    (doseq [[k v] x] (.append d (name k) (if (nil? v) "" v)))
    d))

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

(defc rpc-loading    nil)
(defc offline?       nil)

(defc= flash-message
  (cond (seq rpc-loading) "loading"
        offline?          "We're having trouble communicating with the server, please wait."))

(defn pr-ex [ex]
  (when ex
    (group- "RPC error: ~(.-message ex)"
            (error "'(.-serverStack ex)"))))

(defmulti global-rpc-error (fn [ex] (:pre (:data ex))) :default ::default)

(def rpc-opts {:credentials false
               :timeout     30000
               :on-error    #(do (pr-ex %) (global-rpc-error %))
               :url         GEIR_BACKEND_URL})

(def multipart-opts {:clj->json clj->form-data
                     :ajax-fn   multipart-ajax-fn})

(defn remote [endpoint & {:keys [state loading error opts]}]
  (with-meta
    (mkremote (if (namespace endpoint)
                endpoint
                (symbol "geir-backend.core" (name endpoint)))
              (or state   (cell nil))
              (or error   (cell nil))
              (or loading rpc-loading)
              (merge (update-in rpc-opts [:url] #(str % "/" (name endpoint)))
                     opts))
    {:endpoint endpoint}))

(defn action [endpoint page & [remote-opts]]
  (remote endpoint :state (:data page) :loading (cell nil) :opts remote-opts))

;; stem cells ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defc version          nil)
(defc user             ::unknown)

;; derived state ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defc= admin?          (:admin user))
(defc= feature-flags   (:flags user))
(defc= custom-fields   (:customfields user))
(defc= api-key         (:apikey user))
(defc= network         (:networkid user))
(defc= user-loaded?    (not= user ::unknown))
(defc= logged-in?      (and user-loaded? (number? network) (pos? network)))
(defc= logged-out?     (and user-loaded? (not logged-in?)))

;; paginated remotes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defp logins               (remote 'logins))
(defp flight-priorities    (remote 'priorities))
(defp sbc-site-select      (remote 'sites-not-in-channel) :sorting {:by :title :order :asc} :page-size 10)
(defp campaigns            (remote 'campaigns) :sorting {:by :startdate :order :desc})
(defp flights              (remote 'flights))
(defp current-flight       (remote 'flight))
(defp advertisers          (remote 'advertisers))
(defp creatives            (remote 'creatives :sorting {:by :title :order :asc}))
(defp creatives-by-flight  (remote 'creatives-by-flight :sorting {:by :title :order :asc}))
(defp creative-adtypes     (remote 'creative-adtypes))
(defp countries            (remote 'countries))

(defc current-channel        nil)
(defc current-site           nil)
(defc current-campaign       nil)
(defc current-flight-channel nil)
(defc current-advertiser     nil)

(defc all-adtypes nil)

(let [max-adtypes 500
      r (remote 'adtypes :state all-adtypes)]
  ;; FIXME: max-adtypes is a temporary workaround; as of 2015-07-29 no
  ;;        network is associated with more than 300 ad types. We do this
  ;;        to get all ad types without pagination so we can populate a
  ;;        form with ad type options.
  (defn get-all-adtypes []
    (r {:paging {:size max-adtypes}})))

;; remotes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def ping
  (remote 'login
          :state   user
          :loading (cell nil)
          :opts    (update-in rpc-opts [:url] #(str % "/ping"))))

(def login                        (remote 'login  :state user :loading (cell nil)))
(def logout                       (remote 'logout :state user :loading (cell nil)))
(def forgot                       (remote 'forgot :state user :loading (cell nil)))
(def upsert-flight!               (action 'upsert-flight! current-flight))
(def upsert-creative!             (action 'upsert-creative! creatives multipart-opts))
(def remove-creative-from-flight! (action 'remove-creative-from-flight! creatives-by-flight))
(def delete-creative!             (action 'delete-creative! creatives))

(def create-category!             (remote 'create-category!))
(def set-campaign-activeness!     (remote 'set-campaign-activeness! :state (:data campaigns)))
(def set-flight-activeness!       (remote 'set-flight-activeness!   :state (:data flights)))

;; init ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; reset the version after every RPC call
(let [xhr-version #(.getResponseHeader % "X-Geir-Version")
      timeout     #(= "timeout" (.-statusText %))]
  (.ajaxSetup js/jQuery (js-obj "complete" #(reset! version (xhr-version %1))
                                "success"  #(reset! offline? false)
                                "error"    #(reset! offline? (timeout %1)))))

;; poll for current status
((fn poll-ping [] (.always (ping) #(with-timeout 30000 (poll-ping)))))

;; global rpc error handlers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmethod global-rpc-error ::default     [ex] nil)
(defmethod global-rpc-error :have-network [ex] (when @logged-in? (login)))
(defmethod global-rpc-error :have-api-key [ex] (when @logged-in? (login)))

;; custom elements ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defelem when-loading
  [attr kids]
  ((div :toggle (cell= (not (or logged-in? logged-out?)))) attr kids))

(defelem when-logged-in
  [attr kids]
  ((div :toggle logged-in?) attr kids))

(defelem when-logged-out
  [attr kids]
  ((div :toggle logged-out?) attr kids))

(defn when-feature
  [feature elem]
  (elem :toggle (cell= (get feature-flags feature))))
 
;;

(defn toggle-handler
  [endpoint entity {:keys [data] :as page}]
  #(cell-let [{:keys [isactive] :as ent} entity]
             ((remote endpoint :state data)
              @entity (not @isactive) (p/page-opts page))))