-
Notifications
You must be signed in to change notification settings - Fork 7
/
server.clj
257 lines (215 loc) · 8.85 KB
/
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 org.purefn.kurosawa.web.server
"Immutant web server component."
(:require [clojure.set :as set]
[clojure.spec.alpha :as s]
[clojure.string :as string]
[com.stuartsierra.component :as component]
[org.httpkit.server :as httpkit-server]
[ring.adapter.jetty :as jetty]
[immutant.web :as web]
[org.purefn.kurosawa.log.api :as log-api]
[org.purefn.kurosawa.log.core :as klog]
[org.purefn.kurosawa.log.protocol :as log-proto]
[org.purefn.kurosawa.web.app :as app]
[taoensso.timbre :as log])
(:import org.purefn.kurosawa.web.app.App))
;;------------------------------------------------------------------------------
;; Component.
;;------------------------------------------------------------------------------
(defrecord ImmutantServer
[config app server]
component/Lifecycle
(start [this]
(if server
(do
(log/info "Immutant web server already started")
this)
(let [_ (log/info "Starting Immutant web server with" config)
app-handle (app/app-handler app)
serv-handle (web/run app-handle
(set/rename-keys config
{::io-threads :io-threads
::worker-threads :worker-threads
::host :host
::port :port}))]
(assoc this :server serv-handle))))
(stop [this]
(if server
(do
(log/info "Stopping Immutant web server on port" (::port config))
(web/stop server)
(assoc this :server nil))
(do
(log/info "Immutant web server not running")
this)))
;;----------------------------------------------------------------------------
log-proto/Logging
(log-namespaces [_]
["org.projectodd.wunderboss.*" "org.xnio.*" "org.xnio" "org.jboss.*"])
(log-configure [this dir]
(klog/add-component-appender :immutant (log-api/log-namespaces this)
(str dir "/immutant.log"))))
(def default-worker-threads
"Default worker thread-count for the web server, which is the same as in Immutant,
that is (* 8 IO-threads) where IO-threads is available processor count."
(* 8 (.availableProcessors (Runtime/getRuntime))))
(def default-queue-capacity
"Double-buffering based bounded queue length for requests."
(* 2 default-worker-threads))
(defrecord HttpkitServer
[config app server]
component/Lifecycle
(start [this]
(if server
(do
(log/info "HTTP-Kit web server already started")
this)
(let [_ (log/info "Starting HTTP-Kit web server with" config)
app-handle (app/app-handler app)
config (merge {::worker-threads default-worker-threads
::queue-capacity default-queue-capacity
:legacy-return-value? false ; return HttpServer object
:error-logger (fn [msg ex] (log/error ex msg))
:warn-logger (fn [msg ex] (log/warn ex msg))
:event-logger (fn [event-name]
(when-not (and (some? event-name)
(string/starts-with? event-name
;; do not log 2xx status responses
"httpkit.server.status.processed.2"))
(log/info event-name)))}
(select-keys app [::worker-pool]) ; instrumented app may have instrumented thread-pool
config)
serv-handle (->> {::worker-threads :thread
::queue-capacity :queue-size
::worker-pool :worker-pool
::host :ip
::port :port}
(set/rename-keys config)
(httpkit-server/run-server app-handle))]
(assoc this :server serv-handle))))
(stop [this]
(if server
(do
(log/info "Stopping HTTP-Kit web server on port" (::port config))
(httpkit-server/server-stop! server)
(assoc this :server nil))
(do
(log/info "HTTP-Kit web server not running")
this)))
;;----------------------------------------------------------------------------
log-proto/Logging
(log-namespaces [_]
[]) ; all logs for HTTP-Kit are in org.purefn.kurosawa.web.server namespace
(log-configure [this dir]
(klog/add-component-appender :httpkit (log-api/log-namespaces this)
(str dir "/httpkit.log"))))
(defrecord JettyServer
[config app server]
component/Lifecycle
(start [this]
(if server
(do
(log/info "Jetty web server already started")
this)
(let [_ (log/info "Starting Jetty web server with" config)
{::keys [host port worker-threads]} config
app-handle (app/app-handler app)
serv-handle (jetty/run-jetty app-handle
(cond-> {:join? false
:host host
:port port}
worker-threads (assoc :max-threads worker-threads)))]
(assoc this :server serv-handle))))
(stop [this]
(if server
(do
(log/info "Stopping Jetty web server on port" (::port config))
(.stop server)
(.join server)
(assoc this :server nil))
(do
(log/info "Jetty web server not running")
this)))
;;----------------------------------------------------------------------------
log-proto/Logging
(log-namespaces [_]
["org.eclipse.jetty.*"])
(log-configure [this dir]
(klog/add-component-appender :jetty (log-api/log-namespaces this)
(str dir "/jetty.log"))))
;;------------------------------------------------------------------------------
;; Configuration
;;------------------------------------------------------------------------------
(defn default-config
"As much of the default configuration as can be determined from the current
runtime environment.
- `name` The root of the ConfigMap and Secrets directory. Defaults to
`server` if not provided."
([name]
{::host "0.0.0.0"
::port 8080})
([] (default-config "server")))
;;------------------------------------------------------------------------------
;; Creation.
;;------------------------------------------------------------------------------
(defn immutant-server
"Creates Immutant web server component from optional config and
optional app.
- `config` Web server configuration. `::host` and `::port` are
required.
- `app` If given, should be a Kurosawa app instance."
([]
(immutant-server (default-config) nil))
([config]
(immutant-server config nil))
([config app]
(->ImmutantServer config app nil)))
(defn httpkit-server
"Creates HTTP-Kit web server component from optional config and
optional app.
- `config` Web server configuration. `::host` and `::port` are
required.
- `app` If given, should be a Kurosawa app instance."
([]
(httpkit-server (default-config) nil))
([config]
(httpkit-server config nil))
([config app]
(->HttpkitServer config app nil)))
(defn jetty-server
"Creates Jetty web server component from optional config and
optional app.
- `config` Web server configuration. `::host` and `::port` are
required.
- `app` If given, should be a Kurosawa app instance."
([]
(jetty-server (default-config) nil))
([config]
(jetty-server config nil))
([config app]
(->JettyServer config app nil)))
;;------------------------------------------------------------------------------
;; Specs.
;;------------------------------------------------------------------------------
(s/def ::host string?)
(s/def ::port pos-int?)
(s/def ::io-threads pos-int?)
(s/def ::worker-threads pos-int?)
(s/def ::config (s/keys :req [::host ::port]
:opt [::io-threads ::worker-threads]))
(s/def ::app (partial instance? App))
(s/fdef immutant-server
:args (s/or :empty empty?
:one-arg (s/cat :config ::config)
:two-arg (s/cat :config ::config :app ::app))
:ret (partial instance? ImmutantServer))
(s/fdef httpkit-server
:args (s/or :empty empty?
:one-arg (s/cat :config ::config)
:two-arg (s/cat :config ::config :app ::app))
:ret (partial instance? HttpkitServer))
(s/fdef jetty-server
:args (s/or :empty empty?
:one-arg (s/cat :config ::config)
:two-arg (s/cat :config ::config :app ::app))
:ret (partial instance? JettyServer))