-
-
Notifications
You must be signed in to change notification settings - Fork 137
/
server.cljs
86 lines (73 loc) · 3.26 KB
/
server.cljs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
(ns fulcro.server
(:require-macros fulcro.server)
(:require
[fulcro.client.network :as net]
[fulcro.util :as util]
[fulcro.logging :as log]
[fulcro.client.primitives :as prim]))
;; This namespace is useful for building mock servers in cljs demos
(defmulti read-entity
"The multimethod for Fulcro's built-in support for reading an entity."
(fn [env entity-type id params] entity-type))
(defmulti read-root
"The multimethod for Fulcro's built-in support for querying with a keyword "
(fn [env keyword params] keyword))
(defn server-read
"A built-in read method for Fulcro's built-in server parser."
[env k params]
(let [k (-> env :ast :key)]
(if (util/ident? k)
(read-entity env (first k) (second k) params)
(read-root env k params))))
(defmulti server-mutate prim/dispatch)
(defn fulcro-parser
"Builds and returns a parser that uses Fulcro's query and mutation handling. See `defquery-entity`, `defquery-root`,
and `defmutation` in the `fulcro.server` namespace."
[]
(prim/parser {:read server-read :mutate server-mutate}))
(defn generate-response
"Generate a Fulcro-compatible response containing at least a status code, headers, and body. You should
pre-populate at least the body of the input-response.
The content type of the returned response will always be pegged to 'application/transit+json'."
[{:keys [status body headers] :or {status 200} :as input-response}]
(-> (assoc input-response :status status :body body)
(update :headers assoc "Content-Type" "application/transit+json")))
(defn raise-response [resp]
(reduce (fn [acc [k v]]
(if (and (symbol? k) (not (nil? (:result v))))
(assoc acc k (:result v))
(assoc acc k v)))
{} resp))
(defn valid-response? [result]
(and
(not (contains? result ::exception))
(not (some (fn [[_ {:keys [fulcro.client.primitives/error]}]] (some? error)) result))))
(defn augment-map [response]
(->> (keep #(some-> (second %) meta :fulcro.server/augment-response) response)
(reduce (fn [response f] (f response)) {})))
(defn process-errors [error] {:status 500 :body error})
(defn handle-api-request [parser env query]
(generate-response
(let [parse-result (try
(raise-response (parser env query))
(catch :default e {::exception e}))]
(if (valid-response? parse-result)
(merge {:status 200 :body parse-result} (augment-map parse-result))
(process-errors parse-result)))))
(defrecord ServerEmulator [parser delayms]
net/FulcroNetwork
(send [this edn done-callback error-callback]
(js/console.log "Server request is " edn)
(let [{:keys [body status] :as response} (handle-api-request parser {} edn)]
(js/console.log "Server response is " response)
(if (= 200 status)
(js/setTimeout #(done-callback body) delayms)
(do
(log/error "Server responded with an error" response)
(error-callback body)))))
(start [this]))
(defn new-server-emulator
"Create a server emulator that can be installed as client-side networking. If you do not supply a parser,
then it will create one that works with the normal server-side macros."
([] (ServerEmulator. (fulcro-parser) 0))
([parser delay] (ServerEmulator. parser delay)))