Pass CSRF token using Sec-WebSocket-Protocol header

The proposed change tries to respect other values in the
Sec-WebSocket-Protocol header, that the caller may have set in the
headers option when calling make-channel-socket-client!

Use the pre-ws-handshake option introduced in http-kit commit to Add
the Sec-WebSocket-Protocol response header in the websocket
upgrade. Some browsers (like Google Chrome and Google Chrome derived
ones) fail to complete the upgrade if the upgrade response doesn't
include the Sec-WebSocket-Protocol with one of the sub-protocols
proposed in the request.

[Re: 465]

Author: iarenaza

src/taoensso/sente.cljc

@@ -282,6 +282,8 @@
          (.toByteArray            out))
        x)))
 
+(def ^:private sente-csrf-token-prefix "sente-csrf-token-")
+
 (defn make-channel-socket-server!
   "Takes a web server adapter[1] and returns a map with keys:
 
@@ -527,6 +529,20 @@
           ;; undefined):
           nil)
 
+        sente-csrf-token-pred
+        (fn [s]
+          (when (str/starts-with? s sente-csrf-token-prefix)
+            (subs s (count sente-csrf-token-prefix))))
+
+        ws-csrf-token
+        (fn [ring-req]
+          (let [ws? (= "websocket" (get-in ring-req [:headers "upgrade"]))
+                sec-websocket-protocol (get-in ring-req [:headers "sec-websocket-protocol"])
+                protocol-vals (when (and ws? (string? sec-websocket-protocol))
+                                (-> sec-websocket-protocol
+                                    (str/split #", *")))]
+            (some sente-csrf-token-pred protocol-vals)))
+
         bad-csrf?
         (fn [ring-req]
           (if (nil? csrf-token-fn)
@@ -538,7 +554,8 @@
                       (or
                         (get-in ring-req [:params    :csrf-token])
                         (get-in ring-req [:headers "x-csrf-token"])
-                        (get-in ring-req [:headers "x-xsrf-token"]))]
+                        (get-in ring-req [:headers "x-xsrf-token"])
+                        (ws-csrf-token ring-req))]
 
                   (not
                     (enc/const-str=
@@ -688,6 +705,13 @@
                           :?reply-fn ?reply-fn
                           :uid       uid}))))
 
+                  pre-ws-handshake
+                  (fn [server-ch ring-req]
+                    (let [csrf-token (ws-csrf-token ring-req)]
+                      {:do-handshake true
+                       :handshake-extra-headers {"Sec-WebSocket-Protocol"
+                                                 (str sente-csrf-token-prefix csrf-token)}}))
+
                   send-handshake!
                   (fn [server-ch websocket?]
                     (trove/log!
@@ -921,7 +945,8 @@
                  :on-open             on-open
                  :on-msg              on-msg
                  :on-close            on-close
-                 :on-error            on-error}))))))}))
+                 :on-error            on-error
+                 :pre-ws-handshake    pre-ws-handshake}))))))}))
 
 (def ^:dynamic *simulated-bad-conn-rate*
   "Debugging tool. Proportion ∈ℝ[0,1] of connection activities to sabotage."
@@ -1203,7 +1228,8 @@
                   (enc/oget goog/global           "MozWebSocket")
                   (enc/oget @?node-npm-websocket_ "w3cwebsocket"))]
        (delay
-         (let [socket (WebSocket. uri-str)]
+         (let [protocols (or (:sec-websocket-protocol headers) [])
+               socket (WebSocket. uri-str protocols)]
            (doto socket
              (aset "binaryType" binary-type)
              (aset "onerror"    on-error)
@@ -1435,13 +1461,18 @@
                             {:on-error   on-error
                              :on-message on-message
                              :on-close   on-close
-                             :headers    headers
+                             :headers    (update headers :sec-websocket-protocol
+                                           (fn [x]
+                                             (let [csrf-token (str sente-csrf-token-prefix
+                                                                   (get-client-csrf-token-str :dynamic (:csrf-token @state_)))]
+                                               (cond
+                                                 (string? x) [x csrf-token]
+                                                 (coll? x) (conj x csrf-token)
+                                                 :else csrf-token))))
                              :uri-str
                              (enc/merge-url-with-query-string url
                                (merge params ; 1st (don't clobber impl.):
-                                 {:client-id  client-id
-                                  :csrf-token (get-client-csrf-token-str :dynamic
-                                                (:csrf-token @state_))}))}))
+                                 {:client-id  client-id}))}))
 
                         (catch :any t
                           (trove/log! {:level :error, :id :sente.client/ws-constructor-error, :error t}))))]

src/taoensso/sente/server_adapters/http_kit.clj

@@ -18,14 +18,15 @@
 (deftype HttpKitServerChanAdapter []
   i/IServerChanAdapter
   (ring-req->server-ch-resp [sch-adapter ring-req callbacks-map]
-    (let [{:keys [on-open on-close on-msg _on-error]} callbacks-map
+    (let [{:keys [on-open on-close on-msg _on-error pre-ws-handshake]} callbacks-map
           ws? (:websocket? ring-req)]
 
       ;; Note `as-channel` requires http-kit >= v2.4.0
       ;; Returns {:body <http-kit-implementation-channel> ...}:
       (hk/as-channel ring-req
-        {:on-close   (when on-close (fn [sch status-kw] (on-close sch ws? status-kw)))
-         :on-receive (when on-msg   (fn [sch       msg] (on-msg   sch ws? msg)))
-         :on-open    (when on-open  (fn [sch          ] (on-open  sch ws?)))}))))
+        {:on-close         (when on-close (fn [sch status-kw] (on-close sch ws? status-kw)))
+         :on-receive       (when on-msg   (fn [sch       msg] (on-msg   sch ws? msg)))
+         :on-open          (when on-open  (fn [sch          ] (on-open  sch ws?)))
+         :pre-ws-handshake (when pre-ws-handshake pre-ws-handshake)}))))
 
 (defn get-sch-adapter [] (HttpKitServerChanAdapter.))