Update Jetty9 server adapter to ring-jetty9-adapter's new websocket fix

src/taoensso/sente.cljc

@@ -383,7 +383,9 @@
     :allowed-origins   ; e.g. #{\"http://site.com\" ...}, defaults to :all. ; Alpha
 
     :csrf-token-fn     ; ?(fn [ring-req]) -> CSRF-token for Ajax POSTs and WS handshake.
-                       ; CSRF check will be skipped iff nil (NOT RECOMMENDED!).
+                       ; nil => CSRF check will be DISABLED (can pose a *CSRF SECURITY RISK*
+                       ; for website use cases, so please ONLY disable this check if you're
+                       ; very sure you understand the implications!).
 
     :authorized?-fn    ; ?(fn [ring-req]) -> When non-nil, (authorized?-fn <ring-req>)
                        ; must return truthy, otherwise connection requests will be
@@ -1667,8 +1669,8 @@
 
      Required arguments:
        path              ; Channel socket server route/path (typically `/chsk`)
-       ?csrf-token-or-fn ; CSRF token string or (fn [])->string to match token
-                         ; expected by server.
+       ?csrf-token-or-fn ; CSRF string or (fn [])->string to match token expected by server.
+                         ; nil => server not expecting any CSRF token.
 
      Common options:
        :type           ; e/o #{:auto :ws :ajax}. You'll usually want the default (:auto).

src/taoensso/sente/interfaces.cljc

@@ -16,10 +16,10 @@
   (sch-open?  [sch] "Returns true iff the channel is currently open.")
   (sch-close! [sch]
     "If the channel is open when called: closes the channel and returns true.
-    Otherwise noops and returns false.")
+    Otherwise noops and returns falsey.")
   (sch-send! [sch websocket? msg]
     "If the channel is open when called: sends a message over channel and
-    returns true. Otherwise noops and returns false."))
+    returns true. Otherwise noops and returns falsey."))
 
 (defprotocol IServerChanAdapter ; sch-adapter
   ;; Wraps a web server's own ring-request->ring-response interface to

src/taoensso/sente/server_adapters/jetty9.clj

@@ -8,15 +8,19 @@
   This can make it tricky to set up stateful middleware correctly
   (for example as you may want to do for CSRF protection).
 
-  See [3] for a full example.
+  See [3] for a full example. (Becareful! [3] is outdated, now you
+  can wrap normal ring handler without replicate the handler inside
+  run-jetty config, check [4])
 
   [1] https://github.com/sunng87/ring-jetty9-adapter/blob/master/examples/rj9a/websocket.clj
   [2] https://github.com/sunng87/ring-jetty9-adapter/issues/41#issuecomment-630206233
-  [3] https://gist.github.com/wavejumper/40c4cbb21d67e4415e20685710b68ea0"
-
+  [3] https://gist.github.com/wavejumper/40c4cbb21d67e4415e20685710b68ea0
+  [4] https://github.com/sunng87/ring-jetty9-adapter/pull/59
+  "
   {:author "Thomas Crowley (@wavejumper)"}
   (:require [clojure.string :as str]
             [ring.adapter.jetty9.websocket :as jetty9.websocket]
+            [ring.adapter.jetty9 :as jetty]
             [taoensso.sente.interfaces :as i]))
 
 (defn- ajax-cbs [sch]
@@ -34,18 +38,15 @@
 
 (defn- server-ch-resp
   [websocket? {:keys [on-open on-close on-msg on-error]}]
-  {:on-connect (fn [sch         ] (on-open  sch websocket?))
-   :on-text    (fn [sch msg     ] (on-msg   sch websocket? msg))
-   :on-error   (fn [sch error   ] (on-error sch websocket? error))
-   :on-close   (fn [sch status _] (on-close sch websocket? status))})
-
-(defn- websocket-req? [ring-req]
-  (when-let [s (get-in ring-req [:headers "upgrade"])]
-    (= "websocket" (str/lower-case s))))
+  (jetty/ws-upgrade-response
+   {:on-connect (fn [sch] (on-open  sch websocket?))
+    :on-text    (fn [sch msg] (on-msg   sch websocket? msg))
+    :on-error   (fn [sch error] (on-error sch websocket? error))
+    :on-close   (fn [sch status _] (on-close sch websocket? status))}))
 
 (deftype JettyServerChanAdapter []
   i/IServerChanAdapter
   (ring-req->server-ch-resp [_ req callbacks-map]
-    (server-ch-resp (websocket-req? req) callbacks-map)))
+    (server-ch-resp (jetty/ws-upgrade-request? req) callbacks-map)))
 
-(defn get-sch-adapter [] (JettyServerChanAdapter.))
+(defn get-sch-adapter [] (JettyServerChanAdapter.))

src/taoensso/sente/server_adapters/undertow.clj

@@ -2,7 +2,6 @@
   "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])
@@ -13,12 +12,13 @@
      WebSocketConnectionCallback
      WebSocketProtocolHandshakeHandler]))
 
-;; Websocket
+;;;; 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)))
+  (sch-open?  [sch] (.isOpen    sch))
+  (sch-close! [sch] (.sendClose sch))
+  (sch-send!  [sch websocket? msg] (websocket/send msg sch)))
 
 (extend-protocol response/RespondBody
   WebSocketConnectionCallback
@@ -27,53 +27,75 @@
       (.handleRequest handler exchange))))
 
 (defn- ws-ch
-  [{:keys [on-open on-close on-msg on-error]}]
+  [{:keys [on-open on-close on-msg on-error]} _adapter-opts]
   (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
+;;;; Ajax
+
 (defprotocol ISenteUndertowAjaxChannel
-  (send!  [this msg])
-  (read!  [this])
-  (close! [this]))
+  (ajax-read! [sch]))
+
+(deftype SenteUndertowAjaxChannel [resp-promise_ open?_ on-close adapter-opts]
+  i/IServerChan
+  (sch-send!  [sch websocket? msg] (deliver resp-promise_ msg) (i/sch-close! sch))
+  (sch-open?  [sch] @open?_)
+  (sch-close! [sch]
+    (when (compare-and-set! open?_ true false)
+      (deliver resp-promise_ nil)
+      (when on-close (on-close sch false nil))
+      true))
 
-(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))
+  (ajax-read! [sch]
+    (let [{:keys [ajax-resp-timeout-ms ajax-resp-timeout-val]}
+          adapter-opts]
 
-  i/IServerChan
-  (sch-send!  [this websocket? msg] (send! this msg))
-  (sch-open?  [this] @open?_)
-  (sch-close! [this] (close! this)))
+      (if ajax-resp-timeout-ms
+        (deref resp-promise_ ajax-resp-timeout-ms ajax-resp-timeout-val)
+        (deref resp-promise_)))))
 
-(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))
+(defn- ajax-ch [{:keys [on-open on-close]} adapter-opts]
+  (let [open?_ (atom true)
+        sch
+        (SenteUndertowAjaxChannel. (promise) open?_ on-close
+          adapter-opts)]
+
+    (when on-open (on-open sch false))
+    sch))
 
 (extend-protocol response/RespondBody
   SenteUndertowAjaxChannel
   (respond [body ^HttpServerExchange exchange]
-    (response/respond (read! body) exchange)))
+    (response/respond (ajax-read! body) exchange)))
+
+;;;; Adapter
 
-;; Adapter
-(deftype UndertowServerChanAdapter []
+(deftype UndertowServerChanAdapter [adapter-opts]
   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))}))
+       (ws-ch   callbacks-map adapter-opts)
+       (ajax-ch callbacks-map adapter-opts))}))
+
+(defn get-sch-adapter
+  "Returns an Undertow ServerChanAdapter. Options:
+     :ajax-resp-timeout-ms  ; Max msecs to wait for Ajax responses (default 60 secs)
+     :ajax-resp-timeout-val ; Value returned in case of above timeout
+                            ; (default `:undertow/ajax-resp-timeout`)"
+  ([] (get-sch-adapter nil))
+  ([{:as   opts
+     :keys [ajax-resp-timeout-ms
+            ajax-resp-timeout-val]
+
+     :or   {ajax-resp-timeout-ms (* 60 1000)
+            ajax-resp-timeout-val :undertow/ajax-resp-timeout}}]
 
-(defn get-sch-adapter [] (UndertowServerChanAdapter.))
+   (UndertowServerChanAdapter.
+     (assoc opts
+       :ajax-resp-timeout-ms  ajax-resp-timeout-ms
+       :ajax-resp-timeout-val ajax-resp-timeout-val))))