From d08f858692875c93f8d0dfbf19d4c225335475a1 Mon Sep 17 00:00:00 2001
From: Joscha <joscha@plugh.de>
Date: Wed, 12 Feb 2020 13:04:47 +0000
Subject: [PATCH] [client] Make websocket connection closing more robust

---
 client/Main.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/client/Main.hs b/client/Main.hs
index ef9f421..d6d1e19 100644
--- a/client/Main.hs
+++ b/client/Main.hs
@@ -184,12 +184,8 @@ performInitialContact conn = do
     (ServerHello _ _) -> closeWithErrorMessage conn "Invalid protocol extensions"
     _ -> closeWithErrorMessage conn "Invalid packet: Expected hello"
 
-sendCloseEvent :: BChan Event -> WS.ConnectionException -> IO ()
-sendCloseEvent eventChan =
-  writeBChan eventChan . EventConnectionClosed . T.pack . show
-
 receiveUpdates :: BChan Event -> Node -> WS.Connection -> IO ()
-receiveUpdates eventChan node conn = handle (sendCloseEvent eventChan) $ do
+receiveUpdates eventChan node conn = do
   packet <- receivePacket conn
   case packet of
     ServerUpdate path subnode -> do
@@ -211,6 +207,10 @@ runCorrectClient opts app
 
 {- Gluing everything together -}
 
+sendCloseEvent :: BChan Event -> SomeException -> IO ()
+sendCloseEvent eventChan =
+  writeBChan eventChan . EventConnectionClosed . T.pack . show
+
 main :: IO ()
 main = do
   opts <- execParser clientOptionsParserInfo
@@ -221,7 +221,7 @@ main = do
     chan <- newBChan 100
     let appState = newClientState chan node conn
     putStrLn "Starting WS thread"
-    withThread (receiveUpdates chan node conn) $ do
+    withThread (handle (sendCloseEvent chan) $ receiveUpdates chan node conn) $ do
       putStrLn "Starting UI"
       let vtyBuilder = Vty.mkVty Vty.defaultConfig
       initialVty <- vtyBuilder