parser.cljs

(ns ucv.controller.parser
  (:require
    [cljs.core.async :as async]
    [com.wsscode.common.async-cljs :refer [go-catch]]
    [com.wsscode.pathom.connect :as pc]
    [com.wsscode.pathom.core :as p]
    [edn-query-language.core :as eql]
    [mount.core :refer [defstate]]
    [ucv.lib.parser :as parser-lib]
    [taoensso.timbre :as log]
    ;; Need these here for proper code reload in dev.
    [ucv.controller.receipt]
    [ucv.controller.status]
    [ucv.lib.use-case :as use-case]))

(defstate parser
  :start (p/parallel-parser
           {::p/env     {::p/reader [p/map-reader
                                     pc/parallel-reader
                                     pc/open-ident-reader]}
            ::p/mutate  pc/mutate-async
            ::p/plugins [(pc/connect-plugin {::pc/register (vec (vals @use-case/pathom-registry))})
                         p/error-handler-plugin
                         p/request-cache-plugin
                         parser-lib/contextual-params
                         p/trace-plugin]}))

resolvers.cljs

(ns ucv.controller.receipt
  (:require
    [cljs.core.async :as async :refer [<!]]
    [com.wsscode.pathom.connect :as pc]
    [com.wsscode.pathom.connect :as pc]
    [com.wsscode.pathom.core :as p]
    [promenade.core :as prom :refer [mlet either->]]
    [taoensso.timbre :as log]
    [ucv.lib.promenade-extensions :as prom+]
    [ucv.controller.config :as config]
    [ucv.controller.printer :as printer]
    [ucv.controller.file :as file]
    [ucv.lib.use-case :refer [defmutation defresolver]]))

(defmutation print-receipt [env {:keys [firm order]}]
  {::pc/params [:firm :order]
   ::pc/output [:receipt-printer/success]}
  (async/go
    (log/info "Printing receipt for" firm "order/id" (:order/id order))
    (either->
      (mlet [path (str "/tmp/receipt-" (random-uuid) ".pdf")
             _    (<! (file/write-receipt path firm order))]
        (<! (printer/lp path))
        (when-not config/dev? (<! (file/delete path)))
        {:receipt-printer/success true})
      [prom+/return-error])))

(defmutation print-tickets [env {:keys [firm order]}]
  {::pc/params [:firm :order]
   ::pc/output [:receipt-printer/success]}
  (async/go
    (log/info "Printing wash-tickets for" firm "order/id" (:order/id order))
    (either->
      (mlet [path (str "/tmp/ticket-" (random-uuid) ".pdf")
             _    (<! (file/write-ticket path firm order))]
        (<! (printer/lp path))
        (<! (printer/lp path))
        (when-not config/dev? (<! (file/delete path)))
        {:receipt-printer/success true})
      [prom+/return-error])))

(defmutation print-claim-check [env {:keys [firm order]}]
  {::pc/params [:firm :order]
   ::pc/output [:receipt-printer/success]}
  (async/go
    (log/info "Printing claim-check for" firm "order/id" (:order/id order))
    (either->
      (mlet [path (str "/tmp/claim-check-" (random-uuid) ".pdf")
             _    (<! (file/write-claim-check path firm order))]
        (<! (printer/lp path))
        (when-not config/dev? (<! (file/delete path)))
        {:receipt-printer/success true})
      [prom+/return-error])))

server.cljs

(ns ucv.controller.express-server
  (:require
    ["body-parser" :as bp]
    [cljs.core.async :as async]
    [cljs.nodejs :as nodejs]
    [com.fulcrologic.fulcro.algorithms.transit :refer [transit-clj->str transit-str->clj]]
    [com.wsscode.common.async-cljs :refer [go-catch]]
    [com.wsscode.pathom.core :refer [raise-response]]
    [goog.object :as obj]
    [mount.core :refer [defstate]]
    [taoensso.sente.server-adapters.express :as sente-express]
    [taoensso.timbre :as log]
    [ucv.controller.config :as config]
    [ucv.controller.usb-detector :as usb-detector]
    [ucv.controller.websockets :as c.websockets]
    [ucv.lib.datetime :as date]
    [ucv.controller.parser :as parser]))

(def http (nodejs/require "http"))
(def express (nodejs/require "express"))
(def express-ws (nodejs/require "express-ws"))
(def ws (nodejs/require "ws"))
(def os (nodejs/require "os"))
(def cors (nodejs/require "cors"))

(defn local-ip-address []
  (let [network-interfaces (js->clj (.networkInterfaces os) :keywordize-keys true)
        network-interfaces (flatten (vals network-interfaces))
        local-ip           (->> network-interfaces
                             (filter #(and (= "IPv4" (:family %))
                                        (not= "127.0.0.1" (:address %))
                                        (not (:internal %))))
                             (map :address))]
    (log/info "found local ip address(es)" local-ip "selecting first")
    (first local-ip)))

(defn lan-address-endpoint [req res]
  (try
    (.send res (str (local-ip-address) ":" (-> config/config :port)))
    (catch :default e
      (log/error "Failed to get local url" e)
      (.send res ""))))

(defn pong-endpoint [req res]
  (log/info "ping-pong endpoint")
  (.send res "pong"))

(defn parse-req-body [req]
  (let [body (.-body req)]
    (try
      (-> body str transit-str->clj)
      (catch :default e
        (log/error "Request body" body "could not be parsed" e)
        []))))

(defn encode-resp [resp]
  (try
    (transit-clj->str resp)
    (catch :default e
      (log/error "Response" resp "could not bee encoded" e)
      "")))

(def default-error
  {:ucv/mutation-errors {:error true}})

(defn api-endpoint [req res]
  (try
    (let [body (parse-req-body req)]
      (log/debug "API request" body)
      (go-catch
        (let [result (raise-response (async/<! (@parser/parser {} body)))]
          (log/debug "API response" result)
          (->> result encode-resp (.send res)))))
    (catch :default e
      (log/error "API Endpoint failed" e)
      (.send res (encode-resp default-error)))))

(defonce _ (usb-detector/start-monitor!))

(defstate http-server
  :start (try
           (let [port   (-> config/config :port)
                 app    (express)
                 _      (.use app (cors))
                 _      (express-ws app)
                 {:keys [ring-ajax-post ring-ajax-get-or-ws-handshake]} @c.websockets/websockets
                 _      (doto app
                          (.use (bp/raw #js{"type" "application/transit+json"}))
                          ;; Using text/plain allows us to avoid the CORS preflight-request
                          ;; when using an XHR remote for communication with this server
                          ;; even though the responses are actually transit-json.
                          (.use (bp/raw #js{"type" "text/plain"}))

                          (.use (bp/urlencoded #js {:extended false}))

                          (.ws "/chsk"
                            (fn [ws req _]
                              (ring-ajax-get-or-ws-handshake req nil nil
                                {:websocket? true
                                 :websocket  ws})))

                          (.get "/chsk" ring-ajax-get-or-ws-handshake)
                          (.post "/chsk" ring-ajax-post)

                          (.post "/api" api-endpoint)
                          (.get "/lan-address" lan-address-endpoint)
                          (.get "/ping" pong-endpoint))
                 server (.listen app port (fn [] (log/info "server listening on port" port)))]
             {:server server})
           (catch :default e
             (log/error "Could not start server" e)
             {}))
  :stop (when-let [server (:server @http-server)]
          (try
            (.close server)
            (catch :default e
              (log/error "Could not stop server" e)))))

use-case.cljs

(ns ucv.lib.use-case
  #?(:cljs (:require-macros [ucv.lib.use-case]))
  (:require
    [clojure.spec.alpha :as s]
    [com.fulcrologic.fulcro.algorithms.do-not-use :as futil]
    [taoensso.timbre :as log]
    [com.wsscode.pathom.connect :as pc]
    [ucv.util]))

(defonce pathom-registry (atom {}))
(defn register! [resolver]
  (log/debug "Registering resolver" (::pc/sym resolver))
  (swap! pathom-registry assoc (::pc/sym resolver) resolver))

(s/def ::env (s/and map? #(get % :db) #(get % :conn)))
(s/def ::policy (s/or :sym symbol? :expr list?))
(s/def ::mutation-args (s/cat
                         :sym simple-symbol?
                         :doc (s/? string?)
                         :arglist vector?
                         :config map?
                         :body (s/* any?)))

#?(:clj
   (defn defpathom-backend-endpoint* [endpoint args update-database?]
     (let [{:keys [sym arglist doc config body]} (futil/conform! ::mutation-args args)
           internal-fn-sym (symbol (str (name sym) "__internal-fn__"))
           fqsym           (if (namespace sym)
                             sym
                             (symbol (name (ns-name *ns*)) (name sym)))
           {:keys [policy ex-return]} config
           config          (dissoc config :policy :ex-return)
           env-arg         (first arglist)
           params-arg      (second arglist)
           ex-msg          (str "Mutation " fqsym " unauthorized, " policy " violated")]
       (when (nil? policy)
         (throw (java.lang.IllegalArgumentException. "Config map MUST contain a :policy key")))
       `(do
          ;; Use this internal function so we can dynamically update a resolver in
          ;; dev without having to restart the whole pathom parser.
          (defn ~internal-fn-sym [env# params#]
            (if (nil? params#)
              (do
                (log/error (ex-info "Params are nil" {:params params#}))
                {})
              (let [~env-arg (assoc env# :db (deref (:db-atom env#)))
                    ~params-arg params#
                    result# (if (~policy {:env (assoc env# :db (deref (:db-atom env#))) :params params#})
                              (try ~@body
                                   (catch Throwable ex#
                                     (log/error ex# ~(str fqsym) params#)
                                     (let [ex-data#          (or (ex-data ex#) {:message (.getMessage ex#)
                                                                                :type    (.getName (class ex#))})
                                           ex-return-result# ~ex-return
                                           return#           (if (or (map? ex-return-result#) (nil? ex-return-result#))
                                                               ex-return-result#
                                                               {:ucv/mutation-errors {:error "ex-return was not a map!"}})
                                           return#           (-> return#
                                                               (update :ucv/mutation-errors merge ex-data#))]
                                       return#)))
                              (throw (ex-info ~ex-msg
                                       (let [user# (:current/user env#)
                                             firm# (:current/firm env#)]
                                         (cond-> {:status 401 :params params#}
                                           (:user/id user#) (assoc :user/id (:user/id user#))
                                           (:firm/id firm#) (assoc :firm/id (:firm/id firm#)))))))]
                ;; Override previous db value with a new one, in case this resolver
                ;; is being called from a mutation join.
                (when ~update-database?
                  (reset! (:db-atom env#) (datomic.api/db (:conn env#))))
                ;; Pathom doesn't expect nils
                (cond
                  (sequential? result#) (vec (remove nil? result#))
                  (nil? result#) {}
                  :else result#))))
          (~endpoint ~(cond-> sym
                        doc (with-meta {:doc doc})) [env# params#]
            ~config
            (~internal-fn-sym env# params#))
          (ucv.lib.use-case/register! ~sym)
          ::done))))

#?(:clj
   (defn defpathom-controller-endpoint* [endpoint args]
     (let [{:keys [sym arglist doc config body]} (futil/conform! ::mutation-args args)
           fqsym      (if (namespace sym)
                        sym
                        (symbol (name (ns-name *ns*)) (name sym)))
           {:keys [ex-return]} config
           config     (dissoc config :ex-return)
           env-arg    (first arglist)
           params-arg (second arglist)]
       `(do
          (~endpoint ~(cond-> sym
                        doc (with-meta {:doc doc})) [env# params#]
            ~config
            (let [~env-arg env#
                  ~params-arg params#
                  result# (try ~@body
                               (catch :default ex#
                                 (log/error ~(str fqsym) "failed with:" ex# (str "'" (.getMessage ex#) "'") "input:" params#)
                                 (let [ex-data#          (ex-data ex#)
                                       ex-return-result# ~ex-return
                                       return#           (if (or (map? ex-return-result#) (nil? ex-return-result#))
                                                           ex-return-result#
                                                           {:ucv/mutation-errors {:error "ex-return was not a map!"}})
                                       return#           (-> return#
                                                           (update :ucv/mutation-errors merge
                                                             (select-keys ex-data# [:alert/message])))]
                                   return#)))]
              result#))
          (ucv.lib.use-case/register! ~sym)
          ::done))))

#?(:clj
   (defmacro ^{:doc      "Defines a server-side PATHOM mutation.

Example:

(defmutation do-thing
  \"Optional docstring\"
  [params]
  {::pc/input [:param/name]  ; PATHOM config (optional)
   ::pc/output [:result/prop]}
  (with [env] ...) ; security policy (optional)
  (action [env] ...))  ; actual action (required)
                      "
               :arglists '([sym docstring? arglist config & body])} defmutation
     [& args]
     (if (boolean (:ns &env))
       (defpathom-controller-endpoint* `pc/defmutation args)
       (defpathom-backend-endpoint* `pc/defmutation args true))))

#?(:clj
   (defmacro ^{:doc      "Defines a pathom resolver but with authorization.

Example:

(defresolver resolver-name [env input]
  {::pc/input [:customer/id]
   :policy s.policy/ownership
   ...}
  {:customer/name \"Bob\"})
"
               :arglists '([sym docstring? arglist config & body])} defresolver
     [& args]
     (if (boolean (:ns &env))
       (defpathom-controller-endpoint* `pc/defresolver args)
       (defpathom-backend-endpoint* `pc/defresolver args false))))