From 5a48331ca8852c3c9fe500fb66ef7436ae0dc20d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 22 Apr 2017 01:13:37 -0400 Subject: clean up connection closing For some reason, runClient throws ConnectionClosed on apparently clean shutdown. This happens even though clientApp uses sendClose, and the server receives it and shuts down entirely cleanly. --- WebSockets.hs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) (limited to 'WebSockets.hs') diff --git a/WebSockets.hs b/WebSockets.hs index 25f2162..0ec0c10 100644 --- a/WebSockets.hs +++ b/WebSockets.hs @@ -15,8 +15,15 @@ import qualified Data.Text as T import Data.List import Data.Maybe -runClientApp :: ClientApp a -> IO a -runClientApp = runClient "localhost" 8081 "/" +runClientApp :: ClientApp () -> IO () +runClientApp app = catchJust catchconnclosed + (runClient "localhost" 8081 "/" app) + (\_ -> return ()) + where + -- For some reason, runClient throws ConnectionClosed + -- when the server hangs up cleanly. Catch this unwanted exception. + catchconnclosed ConnectionClosed = Just () + catchconnclosed _ = Nothing -- | Make a client that sends and receives Messages over a websocket. clientApp @@ -39,6 +46,7 @@ clientApp mode a conn = do Just <$> atomically (readTChan schan) return (schan, rchan, sthread, rthread) cleanup (_, _, sthread, rthread) = do + sendClose conn ("done" :: T.Text) cancel sthread cancel rthread go sid (schan, rchan, _, _) = a schan rchan sid -- cgit v1.2.3