-
-
Notifications
You must be signed in to change notification settings - Fork 193
/
undertow.clj
79 lines (69 loc) · 2.66 KB
/
undertow.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
(ns taoensso.sente.server-adapters.undertow
"Sente server adapter for ring-undertow-adapter."
{:author "Nik Peric"}
(:require
[clojure.core.async :as async]
[ring.adapter.undertow.websocket :as websocket]
[ring.adapter.undertow.response :as response]
[taoensso.sente.interfaces :as i])
(:import
[io.undertow.websockets.core WebSocketChannel]
[io.undertow.server HttpServerExchange]
[io.undertow.websockets
WebSocketConnectionCallback
WebSocketProtocolHandshakeHandler]))
;; Websocket
(extend-type WebSocketChannel
i/IServerChan
(sch-open? [this] (.isOpen this))
(sch-close! [this] (.sendClose this))
(sch-send! [this websocket? msg] (websocket/send msg this)))
(extend-protocol response/RespondBody
WebSocketConnectionCallback
(respond [body ^HttpServerExchange exchange]
(let [handler (WebSocketProtocolHandshakeHandler. body)]
(.handleRequest handler exchange))))
(defn- ws-ch
[{:keys [on-open on-close on-msg on-error]}]
(websocket/ws-callback
{:on-open (when on-open (fn [{:keys [channel]}] (on-open channel true)))
:on-error (when on-error (fn [{:keys [channel error]}] (on-error channel true error)))
:on-message (when on-msg (fn [{:keys [channel data]}] (on-msg channel true data)))
:on-close-message (when on-close (fn [{:keys [channel message]}] (on-close channel true message)))}))
;; AJAX
(defprotocol ISenteUndertowAjaxChannel
(send! [this msg])
(read! [this])
(close! [this]))
(deftype SenteUndertowAjaxChannel [ch open?_ on-close]
ISenteUndertowAjaxChannel
(send! [this msg] (async/put! ch msg (fn [_] (close! this))))
(read! [this] (async/<!! ch))
(close! [this]
(when on-close (on-close ch false nil))
(reset! open?_ false)
(async/close! ch))
i/IServerChan
(sch-send! [this websocket? msg] (send! this msg))
(sch-open? [this] @open?_)
(sch-close! [this] (close! this)))
(defn- ajax-ch [{:keys [on-open on-close]}]
(let [ch (async/chan 1)
open?_ (atom true)
channel (SenteUndertowAjaxChannel. ch open?_ on-close)]
(when on-open (on-open channel false))
channel))
(extend-protocol response/RespondBody
SenteUndertowAjaxChannel
(respond [body ^HttpServerExchange exchange]
(response/respond (read! body) exchange)))
;; Adapter
(deftype UndertowServerChanAdapter []
i/IServerChanAdapter
(ring-req->server-ch-resp [sch-adapter ring-req callbacks-map]
;; Returns {:body <websocket-implementation-channel> ...}:
{:body
(if (:websocket? ring-req)
(ws-ch callbacks-map)
(ajax-ch callbacks-map))}))
(defn get-sch-adapter [] (UndertowServerChanAdapter.))