-
-
Notifications
You must be signed in to change notification settings - Fork 137
/
easy_server.clj
257 lines (227 loc) · 11.4 KB
/
easy_server.clj
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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
(ns fulcro.easy-server
(:require
[com.stuartsierra.component :as component]
[clojure.set :as set]
[clojure.java.io :as io]
[fulcro.util :as util]
[fulcro.server :as server]
[fulcro.logging :as log])
(:gen-class))
(defonce externs (atom {}))
(def externs-needed '([bidi.bidi [match-route]]
[org.httpkit.server [run-server]]
[ring.middleware.content-type [wrap-content-type]]
[ring.middleware.gzip [wrap-gzip]]
[ring.middleware.not-modified [wrap-not-modified]]
[ring.middleware.resource [wrap-resource]]
[ring.util.response [resource-response]]))
(def invoke (util/build-invoke externs externs-needed))
(defn index [req]
(assoc (invoke 'ring.util.response/resource-response (str "index.html") {:root "public"})
:headers {"Content-Type" "text/html"}))
(defn api
"The /api Request handler. The incoming request will have a database connection, parser, and error handler
already injected. This function should be fairly static, in that it calls the parser, and if the parser
does not throw and exception it wraps the return value in a transit response. If the parser throws
an exception, then it calls the injected error handler with the request and the exception. Thus,
you can define the handling of all API requests via system injection at startup."
[{:keys [transit-params parser env] :as req}]
(server/handle-api-request parser env transit-params))
(def default-api-key "/api")
(defn app-namify-api [default-routes app-name]
(if-not app-name default-routes
(update default-routes 1
(fn [m]
(let [api-val (get m default-api-key)]
(-> m
(dissoc default-api-key)
(assoc (str "/" app-name default-api-key) api-val)))))))
(def default-routes
["" {"/" :index
default-api-key {:get :api
:post :api}}])
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Handler Code
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn route-handler [req]
(let [routes (app-namify-api default-routes (:app-name req))
match (invoke 'bidi.bidi/match-route routes (:uri req)
:request-method (:request-method req))]
(case (:handler match)
;; explicit handling of / as index.html. wrap-resources does the rest
:index (index req)
:api (api req)
nil)))
(defn wrap-connection
"Ring middleware function that invokes the general handler with the parser and parsing environment on the request."
[handler route-handler api-parser om-parsing-env app-name]
(fn [req]
(or (route-handler (assoc req
:parser api-parser
:env (assoc om-parsing-env :request req)
:app-name app-name))
(handler req))))
(defn wrap-extra-routes [dflt-handler {:as extra-routes :keys [routes handlers]} om-parsing-env]
(if-not extra-routes dflt-handler
(do (assert (and routes handlers) extra-routes)
(fn [req]
(let [match (invoke 'bidi.bidi/match-route routes (:uri req) :request-method (:request-method req))]
(if-let [bidi-handler (get handlers (:handler match))]
(bidi-handler (assoc om-parsing-env :request req) match)
(dflt-handler req)))))))
(defn not-found-handler []
(fn [req]
{:status 404
:headers {"Content-Type" "text/html"}
:body (io/input-stream (io/resource "public/not-found.html"))}))
(defn handler
"Create a web request handler that sends all requests through a parser. The om-parsing-env of the parses
will include any components that were injected into the handler.
Returns a function that handles requests."
[api-parser om-parsing-env extra-routes app-name pre-hook fallback-hook]
;; NOTE: ALL resources served via wrap-resources (from the public subdirectory). The BIDI route maps / -> index.html
(as-> (not-found-handler) h
(fallback-hook h)
(wrap-connection h route-handler api-parser om-parsing-env app-name)
(server/wrap-transit-params h)
(server/wrap-transit-response h)
(invoke 'ring.middleware.resource/wrap-resource h "public")
(wrap-extra-routes h extra-routes om-parsing-env)
(pre-hook h)
(invoke 'ring.middleware.content-type/wrap-content-type h)
(invoke 'ring.middleware.not-modified/wrap-not-modified h)
(invoke 'ring.middleware.gzip/wrap-gzip h)))
(defprotocol IHandler
(set-pre-hook! [this pre-hook]
"Sets the handler before any important handlers are run.")
(get-pre-hook [this]
"Gets the current pre-hook handler.")
(set-fallback-hook! [this fallback-hook]
"Sets the fallback handler in case nothing else returned.")
(get-fallback-hook [this]
"Gets the current fallback-hook handler."))
(defrecord Handler [stack api-parser injected-keys extra-routes app-name pre-hook fallback-hook]
component/Lifecycle
(start [component]
(assert (every? (set (keys component)) injected-keys)
(str "You asked to inject " injected-keys
" but " (set/difference injected-keys (set (keys component)))
" do not exist."))
(log/info "Creating web server handler.")
(let [om-parsing-env (select-keys component injected-keys)
req-handler (handler api-parser om-parsing-env extra-routes app-name
@pre-hook @fallback-hook)]
(reset! stack req-handler)
(assoc component :env om-parsing-env
:middleware (fn [req] (@stack req)))))
(stop [component]
(log/info "Tearing down web server handler.")
(assoc component :middleware nil :stack nil :pre-hook nil :fallback-hook nil))
IHandler
(set-pre-hook! [this new-pre-hook]
(reset! pre-hook new-pre-hook)
(reset! stack
(handler api-parser (select-keys this injected-keys)
extra-routes app-name @pre-hook @fallback-hook))
this)
(get-pre-hook [this]
@pre-hook)
(set-fallback-hook! [this new-fallback-hook]
(reset! fallback-hook new-fallback-hook)
(reset! stack
(handler api-parser (select-keys this injected-keys)
extra-routes app-name @pre-hook @fallback-hook))
this)
(get-fallback-hook [this]
@fallback-hook))
(defn build-handler
"Build a web request handler.
Parameters:
- `api-parser`: A Parser that can interpret incoming API queries, and return the proper response. Return is the response when no exception is thrown.
- `injections`: A vector of keywords to identify component dependencies. Components injected here can be made available to your parser.
- `extra-routes`: See `make-fulcro-server`
- `app-name`: See `make-fulcro-server`
"
[api-parser injections & {:keys [extra-routes app-name]}]
(component/using
(map->Handler {:api-parser api-parser
:injected-keys injections
:stack (atom nil)
:pre-hook (atom identity)
:fallback-hook (atom identity)
:extra-routes extra-routes
:app-name app-name})
(vec (into #{:config} injections))))
(def http-kit-opts
[:ip :port :thread :worker-name-prefix
:queue-size :max-body :max-line])
(defrecord WebServer [port handler server]
component/Lifecycle
(start [this]
(try
(let [server-opts (select-keys (-> this :config :value) http-kit-opts)
port (:port server-opts)
started-server (invoke 'org.httpkit.server/run-server (:middleware handler) server-opts)]
(log/info (str "Web server (http://localhost:" port ")") "started successfully. Config of http-kit options:" server-opts)
(assoc this :port port :server started-server))
(catch Exception e
(log/fatal "Failed to start web server " e)
(throw e))))
(stop [this]
(if-not server this
(do (server)
(log/info "web server stopped.")
(assoc this :server nil)))))
(defn make-web-server
"Builds a web server with an optional argument that
specifies which component to get `:middleware` from,
defaults to `:handler`. This component requires that your
system has a Config component under the key :config."
[& [handler]]
(component/using (map->WebServer {}) {:config :config :handler (or handler :handler)}))
(defn make-fulcro-server
"Make a new fulcro server.
Parameters:
*`config-path` OPTIONAL, a string of the path to your configuration file on disk.
The system property -Dconfig=/path/to/conf can also be passed in from the jvm.
*`components` OPTIONAL, a map of Sierra component instances keyed by their desired names in the overall system component.
These additional components will merged with the fulcro-server components to compose a new system component.
*`parser` OPTIONAL, an om parser function for parsing requests made of the server. To report errors, the
parser must throw an ExceptionInfo with a map with keys `:status`, `:headers`, and `:body`.
This map will be converted into the response sent to the client. Defaults to `server/fulcro-parser`
*`parser-injections` a vector of keywords which represent components which will be injected as the om parsing env.
*`extra-routes` OPTIONAL, a map containing `:routes` and `:handlers`,
where routes is a bidi routing data structure,
and handlers are map from handler name to a function of type :: Env -> BidiMatch -> Res
see `handler/wrap-extra-routes` & handler-spec for more.
*`app-name` OPTIONAL, a string that will turn \"/api\" into \"<app-name>/api\"
Returns a Sierra system component.
"
[& {:keys [app-name parser parser-injections config-path components extra-routes]
:or {config-path "/usr/local/etc/fulcro.edn" parser (server/fulcro-parser)}
:as params}]
{:pre [(some-> parser fn?)
(or (nil? components) (map? components))
(or (nil? extra-routes)
(and (map? extra-routes)
(:routes extra-routes)
(map? (:handlers extra-routes))))
(or (nil? parser-injections)
(and (set? parser-injections)
(every? keyword? parser-injections)))]}
(let [handler (build-handler parser parser-injections
:extra-routes extra-routes
:app-name app-name)
built-in-components [:config (server/new-config config-path)
:handler handler
:server (make-web-server)]
all-components (flatten (concat built-in-components components))]
(apply component/system-map all-components)))
(defn make-fulcro-test-server
"Make sure to inject a :seeder component in the group of components that you pass in!"
[& {:keys [parser parser-injections components]}]
(let [handler (build-handler parser parser-injections)
built-in-components [:config (server/new-config "test.edn")
:handler handler]
all-components (flatten (concat built-in-components components))]
(apply component/system-map all-components)))