diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-04-22 01:13:37 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-04-22 01:13:37 -0400 |
commit | 5a48331ca8852c3c9fe500fb66ef7436ae0dc20d (patch) | |
tree | 0fab5b254f7f56048a29c00d723012557ce72b0a /WebSockets.hs | |
parent | aa2771b7615b91ba60249f6164c01dbda26c56e7 (diff) | |
download | debug-me-5a48331ca8852c3c9fe500fb66ef7436ae0dc20d.tar.gz |
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.
Diffstat (limited to 'WebSockets.hs')
-rw-r--r-- | WebSockets.hs | 12 |
1 files changed, 10 insertions, 2 deletions
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 |