parser.cljc

(ns populace.parser
  (:refer-clojure :exclude [read])
  (:require [populace.user :as user]
            [om.next.impl.parser :as parser]
            [#?(:clj juxt.datomic.extras
                :cljs populace.utils.datascript)
             :refer (DatomicConnection as-conn as-db to-ref-id to-entity-map)]
            #?@(:clj
                [[populace.auth.client :refer :all]
                 [populace.config :refer [config filter-cljs]]
                 [populace.web.chsk :as chsk]
                 [aleph.http :as http]
                 [bidi.bidi :refer (path-for RouteProvider tag)]
                 [bolt.authentication :refer :all]
                 [populace.user.protocols :refer [UserStore]]
                 [bolt.authentication.protocols :refer (RequestAuthenticator)]
                 [datomic.api :as d]
                 [hara.event :refer :all]
                 [holon.datomic.utils :refer :all]
                 [ring.middleware.transit :refer [wrap-transit]]
                 [ib5k.component.ctr :as ctr]
                 [om.next.server :as om]
                 [plumbing.core :refer :all]
                 [schema.core :as s]
                 [taoensso.timbre :as log]]
                :cljs
                [[cljs.core.async :refer [chan put!]]
                 [cognitect.transit :as t]
                 [datascript.core :as d]
                 [goog.dom :as gdom]
                 [ib5k.component.ctr :as ctr]
                 [om.next :as om :refer-macros [defui]]
                 [quile.component
                  :as component :refer [Lifecycle system-map system-using using]]
                 [schema.core :as s :include-macros true]
                 [shodan.console :as c :include-macros true]]))
  #?(:cljs
     (:require-macros [cljs.core.async.macros :refer [go]]))
  #?(:cljs
     (:import [goog.net XhrIo])))

#?(:cljs (enable-console-print!))

;; ========== Read ==========

(defmulti readf parser/dispatch)

(defmethod readf :default
  [_ k _]
  {:value {:error (str "No handler for read key " k)}})

;; user/find
#?(:clj
   (defmethod readf :user/find
     [ctx k params]
     {:value [(user/user ctx params)]})
   :cljs
   (defmethod readf :user/find
     [ctx k params]
     (or (some->> (user/user ctx params)
                  (hash-map :value))
         {:remote true})))

;; ========== Mutate ==========

(defmulti mutatef parser/dispatch)

#?(:clj
   (defmethod mutatef :default
     [_ k _]
     {:value {:error (str "No handler for mutation key " k)}})

   :cljs
   (defmethod mutatef :default
     [_ _ _]
     {:remote true}))

;; user/update
#?(:clj
   (do
     (defmethod mutatef 'user/update
       [{:keys [conn]} k user]
       (let [lookup (or (to-ref-id user)
                        [:user/uid (:user/uid user)])
             {:keys [db/id user/uid]} (d/entity (as-db conn) lookup)]
         {:value [{:app/user [(assoc user :db/id id)]}]
          :clients #{uid}
          :action (fn []
                    (update-entity! conn lookup user))})))

   :cljs
   (do
     (defmethod mutatef 'user/update
       [{:keys [state]} k user]
       {:remote true
        :action (fn [] (d/transact! state [user]))})))

#?(:clj
   (do
     (defn generate-response [data & [status]]
       {:status  (or status 200)
        :headers {"Content-Type" "application/transit+json"}
        :body    data})

     (defn wrap-client-push
       [mutatef]
       (fn [{:keys [req] :as ctx} k params]
         (let [{:keys [value clients] :as res} (mutatef ctx k params)
               clients (disj (set clients) (:bolt/subject-identifier req))]
           (when (seq clients)
             (doseq [uid clients]
               @(chsk/push-client! uid {k value})))
           (dissoc res :clients))))

     (defn parse
       [ctx params]
       (log/info "parse" params)
       ((om/parser {:read readf :mutate (wrap-client-push mutatef)}) ctx params))

     (s/defrecord Parser
         [conn :- (s/protocol DatomicConnection)
          oauth-client :- (s/protocol RequestAuthenticator)
          user-store :- (s/protocol UserStore)
          location :- s/Str
          context :- s/Str]
       RouteProvider
       (routes [this]
         [context
          (-> (fn [req]
                (->> req
                     :transit-params
                     (parse {:conn conn
                             :req req})
                     generate-response))
              (wrap-authorization this location :user.scopes/user))]))

     (def new-parser
       (-> map->Parser
           (ctr/wrap-using [:conn :oauth-client :user-store])
           (ctr/wrap-defaults {:context "/api"})
           (ctr/wrap-kargs))))
   :cljs
   (do
     (defn transit-post [conn url]
       (fn [{:keys [remote]} cb]
         (.send XhrIo url
                (fn [e]
                  (this-as this
                           (let [resp (t/read (t/reader :json) (.getResponseText this))]
                             ;; (c/log "transit-resp" (pr-str resp))
                             (cb resp))))
                "POST" (t/write (t/writer :json) remote)
                #js {"Content-Type" "application/transit+json"})))

     (defn transit-post-chan [conn url edn]
       (let [c (chan)]
         ((transit-post conn url) edn (fn [res] (put! c res)))
         c))

     (defn parse-delta
       [delta]
       (->> (for [[action value] delta]
              (if (keyword? action)
                {:keys [action]
                 :value value}
                (let [value (->> value
                                 (mapv #(if (keyword? %) {% []} %))
                                 (into {}))]
                  {:keys (keys value)
                   :value (apply concat (vals value))})))
            (reduce (partial merge-with concat))))

     (defn merge-delta
       [conn]
       (fn [reconciler state delta]
         (let [{:keys [keys value]} (parse-delta delta)]
           (d/transact conn value)
           {:keys keys
            :next @conn})))

     (s/defrecord Reconciler
         [conn
          target :- s/Str
          root
          send-uri
          reconciler]
       Lifecycle
       (start [this]
         (let [reconciler (om/reconciler
                           {:state conn
                            :parser (om/parser {:read readf
                                                :mutate mutatef})
                            :send (transit-post conn send-uri)
                            :merge (merge-delta conn)})]
           (om/add-root! reconciler root (gdom/getElement target))
           (assoc this :reconciler reconciler)))
       (stop [this]
         (om.next/remove-root! reconciler (gdom/getElement target))
         this))

     (def new-reconciler
       (-> map->Reconciler
           (ctr/wrap-using [:conn])
           (ctr/wrap-defaults {:send-uri "/api"
                               :target "root"})
           (ctr/wrap-kargs)))))