display errors in HUD if websocket disconnects/fails

closes #189

src/main/shadow/cljs/devtools/client/browser.cljs

@@ -24,7 +24,7 @@
 (defonce socket-ref (volatile! nil))
 
 (defn devtools-msg [msg & args]
-  (.apply (.-log js/console) nil (into-array (into [(str "%cDEVTOOLS: " msg) "color: blue;"] args))))
+  (.apply (.-log js/console) nil (into-array (into [(str "%cshadow-cljs: " msg) "color: blue;"] args))))
 
 (defn ws-msg [msg]
   (if-let [s @socket-ref]
@@ -237,6 +237,8 @@
   (reset! repl-ns-ref ns)
   (ws-msg {:type :repl/set-ns-complete :id id :ns ns}))
 
+(def close-reason-ref (volatile! nil))
+
 ;; FIXME: core.async-ify this
 (defn handle-message [{:keys [type] :as msg}]
   ;; (js/console.log "ws-msg" msg)
@@ -274,6 +276,12 @@
     :pong
     nil
 
+    :client/stale
+    (vreset! close-reason-ref "Stale Client! You are not using the latest compilation output!")
+
+    :client/no-worker
+    (vreset! close-reason-ref (str "watch for build \"" env/build-id "\" not running"))
+
     ;; default
     :ignored))
 
@@ -321,23 +329,28 @@
 
     (set! (.-onopen socket)
       (fn [e]
+        (hud/connection-error-clear!)
+        (vreset! close-reason-ref nil)
         ;; :module-format :js already patches provide
         (when (= "goog" env/module-format)
           ;; patch away the already declared exception
           (set! (.-provide js/goog) js/goog.constructNamespace_))
-        (devtools-msg "connected!")
+        (devtools-msg "WebSocket connected!")
         ))
 
     (set! (.-onclose socket)
       (fn [e]
         ;; not a big fan of reconnecting automatically since a disconnect
         ;; may signal a change of config, safer to just reload the page
-        (devtools-msg "disconnected!")
+        (devtools-msg "WebSocket disconnected!")
+        (hud/connection-error (or @close-reason-ref "Connection closed!"))
         (vreset! socket-ref nil)
         ))
 
     (set! (.-onerror socket)
-      (fn [e]))
+      (fn [e]
+        (hud/connection-error "Connection failed!")
+        (devtools-msg "websocket error" e)))
 
     (js/setTimeout heartbeat! 30000)
     ))

src/main/shadow/cljs/devtools/client/hud.cljs

@@ -241,3 +241,29 @@
               :font-size "12px"}}
      [:div {:style "color: red; margin-bottom: 10px; font-size: 2em;"} "Compilation failed!"]
      [:pre report]]))
+
+(def connection-error-id "shadow-connection-error")
+
+(defn connection-error-clear! []
+  (when-some [x (dom/by-id connection-error-id)]
+    (dom/remove x)))
+
+(defn connection-error [msg]
+  (dom-insert
+    [:div {:id connection-error-id
+           :style {:position "absolute"
+                   :pointer-events "none"
+                   :left "0px"
+                   :bottom "20px"}}
+     [:div {:style {:background "#c00"
+                    :border-top-right-radius "40px"
+                    :border-bottom-right-radius "40px"
+                    :box-shadow "2px 2px 10px #aaa"
+                    :padding "10px"
+                    :font-family "monospace"
+                    :font-size "14px"
+                    :font-weight "bold"
+                    :color "#fff"}}
+      (str "shadow-cljs - " msg)
+      ]])
+  )

src/main/shadow/cljs/devtools/server/worker/ws.clj

@@ -304,17 +304,23 @@
         proc-id
         (UUID/fromString proc-id)
 
+        ws-out
+        (get-in ctx [:ring-request :ws-out])
+
         worker-proc
         (super/get-worker supervisor build-id)]
 
     (cond
       (nil? worker-proc)
-      (do (log/warn "stale websocket client, no worker for build" build-id)
-          nil)
+      (go (>! ws-out {:type :client/no-worker}))
+      ;; can't send {:status 404 :body "no worker"}
+      ;; as there appears to be no way to access either the status code or body
+      ;; on the client via the WebSocket API to know why a websocket connection failed
+      ;; onerror returns nothing useful only that it failed
+      ;; so instead we pretend to handshake properly, send one message and disconnect
 
       (not= proc-id (:proc-id worker-proc))
-      (do (log/warn "stale websocket client, please reload client" build-id)
-          nil)
+      (go (>! ws-out {:type :client/stale}))
 
       :else
       (case action

src/main/shadow/undertow.clj

@@ -1,7 +1,7 @@
 (ns shadow.undertow
   (:require [clojure.java.io :as io]
             [clojure.string :as str]
-            [clojure.core.async :as async :refer (go <! >!)]
+            [clojure.core.async :as async :refer (go alt! <! >!)]
             [clojure.core.async.impl.protocols :as async-prot]
             [clojure.tools.logging :as log]
             [shadow.undertow.impl :as impl]
@@ -16,7 +16,8 @@
            (java.io FileInputStream)
            (java.security KeyStore)
            [org.xnio ChannelListener]
-           [java.nio.channels ClosedChannelException]))
+           [java.nio.channels ClosedChannelException]
+           [io.undertow.util AttachmentKey]))
 
 (defn ring* [handler-fn]
   (reify
@@ -48,60 +49,87 @@
   (-> (impl/exchange->ring (.get ws-exchange-field ex))
       (assoc ::channel channel)))
 
+(defonce WS-LOOP (AttachmentKey/create Object))
+(defonce WS-IN (AttachmentKey/create Object))
+(defonce WS-OUT (AttachmentKey/create Object))
+
 (defn websocket [ring-handler]
-  (Handlers/websocket
-    (reify
-      WebSocketConnectionCallback
-      (onConnect [_ exchange channel]
+  (let [ws-handler
+        (Handlers/websocket
+          (reify
+            WebSocketConnectionCallback
+            (onConnect [_ exchange channel]
+              (let [ws-in (.getAttachment exchange WS-IN)
+                    ws-out (.getAttachment exchange WS-OUT)
+                    ws-loop (.getAttachment exchange WS-LOOP)
+
+                    handler-fn
+                    (fn [channel msg]
+                      (if-not (some? msg)
+                        (async/close! ws-in)
+                        ;; FIXME: don't hardcode edn, should use transit
+                        (async/put! ws-in (edn/read-string msg))))
+
+                    close-task
+                    (reify ChannelListener
+                      (handleEvent [this ignored-event]
+                        (async/close! ws-in)
+                        (async/close! ws-out)))]
+
+                (.. channel (addCloseTask close-task))
+                (.. channel (getReceiveSetter) (set (WsTextReceiver. handler-fn)))
+                (.. channel (resumeReceives))
+
+                (go (loop []
+                      ;; try to send remaining messages before disconnect
+                      ;; if loop closes after putting something on ws-out
+                      (alt! :priority true
+                        ws-out
+                        ([msg]
+                          (if (nil? msg)
+                            ;; when out closes, also close in
+                            (async/close! ws-in)
+                            ;; try to send message, close everything if that fails
+                            (do (try
+                                  (WebSockets/sendTextBlocking (pr-str msg) channel)
+                                  ;; just ignore sending to a closed channel
+                                  (catch ClosedChannelException e
+                                    (async/close! ws-in)
+                                    (async/close! ws-out)))
+                                (recur))))
+
+                        ws-loop
+                        ([_]
+                          (.close exchange)
+                          ;; probably already closed, just in case
+                          (async/close! ws-out)
+                          (async/close! ws-in)
+                          ))))
+
+                ))))]
+
+    (ring*
+      (fn [{::impl/keys [exchange] :as ring-request}]
         (let [ws-in (async/chan 10) ;; FIXME: allow config of these, maybe even use proper buffers
               ws-out (async/chan 10)
-              ws-req (assoc (ws->ring exchange channel)
+              ws-req (assoc ring-request
                        ::ws true
                        :ws-in ws-in
                        :ws-out ws-out)
               ws-loop (ring-handler ws-req)]
 
+          ;; ws request handlers should return a go loop channel
           (if (satisfies? async-prot/ReadPort ws-loop)
-            (let [handler-fn
-                  (fn [channel msg]
-                    (if-not (some? msg)
-                      (async/close! ws-in)
-                      ;; FIXME: don't hardcode edn, should use transit
-                      (async/put! ws-in (edn/read-string msg))))
-
-                  close-task
-                  (reify ChannelListener
-                    (handleEvent [this ignored-event]
-                      (async/close! ws-in)
-                      (async/close! ws-out)))]
-
-              (.. channel (addCloseTask close-task))
-              (.. channel (getReceiveSetter) (set (WsTextReceiver. handler-fn)))
-              (.. channel (resumeReceives))
-
-              (go (loop []
-                    (when-some [msg (<! ws-out)]
-                      (try
-                        (WebSockets/sendTextBlocking (pr-str msg) channel)
-                        ;; just ignore sending to a closed channel
-                        (catch ClosedChannelException e
-                          (async/close! ws-in)
-                          (async/close! ws-out)))
-                      (recur)))
-                  ;; when out closes, also close in
-                  (async/close! ws-in))
-
-              (go (<! ws-loop)
-                  (.close exchange)
-                  ;; probably already closed, just in case
-                  (async/close! ws-out)
-                  (async/close! ws-in)))
-
-            (do (when-not (nil? ws-loop)
-                  (log/warn "websocket request not handled properly, did not return a channel" ws-loop))
-                (async/close! ws-in)
+            (do (.putAttachment exchange WS-LOOP ws-loop)
+                (.putAttachment exchange WS-IN ws-in)
+                (.putAttachment exchange WS-OUT ws-out)
+                (.handleRequest ws-handler exchange)
+                ::async)
+            ;; didn't return a loop. close channels just in case and respond normally
+            (do (async/close! ws-in)
                 (async/close! ws-out)
-                (.close exchange))))))))
+                ws-loop)
+            ))))))
 
 (defn make-ssl-context [ssl-config]
   (let [key-manager
@@ -128,7 +156,7 @@
 ;; and they aren't compatible with the way this does ws anyways
 (defn start
   ([config req-handler]
-    (start config req-handler identity))
+   (start config req-handler identity))
   ([{:keys [port host ssl-port ssl-context] :or {host "0.0.0.0"} :as config} req-handler ring-middleware]
    (let [ws-handler
          (websocket req-handler)