Fix runClientWithSocket exception behaviour

[roelvandijk]

In some cases runClientWithSocket will throw a different exception than the one raised in its app argument.

Because of bracket it will always attempt to close the stream when any exception is thrown by runClientWithStream.

Consider the scenario where a thread is waiting on data. Ultimately it blocks on receive' from makeStream. If you send an asynchronous exception (like ThreadKilled) to this thread the stream will be closed because of onException in receive'.

Next runClientWithSocket will call Stream.close. This attempts to send some message over the websocket. This in turn throws the ConnectionClosed exception. But we where already in an exception handler to begin with! So now the original exception is masked by ConnectionClosed.

[basvandijk]

Hi @jaspervdj, the old behavior caused one of our threads to be unkillable. This thread was executing runClientWith. When the KillThread exception is thrown to this thread the Stream.close exception handler is called. This eventually calls send' which throws a ConnectionClosed exception if the connection is closed (which was the case in our program). This means a ThreadKilled is effectively converted into a ConnectionClosed exception. Because this thread was setup to restart on any exception (except asynchronous exceptions like KillThread) the thread became unkillable.

[jaspervdj]

Hey, I just got back from holiday. Thanks for the stellar debugging! Is there any chance you guys have something that's reproducible I can forge into a test case? If not (or it's too entangled with your proprietary code), I can probably come up with something as well.

[jaspervdj]

This can be reproduced using the rather simple:

{-# LANGUAGE OverloadedStrings #-}
module Main where

import           Control.Concurrent       (threadDelay)
import qualified Control.Concurrent.Async as Async
import qualified Control.Exception        as E
import           Control.Monad            (forever)
import qualified Data.Text                as T
import qualified Network.WebSockets       as WS

showException :: String -> IO a -> IO a
showException area m = do
    errOrX <- E.try m
    case errOrX of
        Right x                  -> return x
        Left (E.SomeException e) -> do
            putStrLn $ "-> Caught exception in " ++ area ++ ": " ++ show e
            E.throwIO e

clientApp :: WS.ClientApp ()
clientApp = \connection -> do
    WS.sendTextData connection $ T.pack "Hello world!"
    forever $ do
        msg <- showException "receiveData" $ WS.receiveData connection
        putStrLn $ "Received message: " ++ T.unpack msg

main :: IO ()
main = do
    client <- Async.async $ WS.runClient "echo.websocket.org" 80 ""
        (\c -> showException "clientApp" (clientApp c))

    _canceller <- Async.async $ do
        threadDelay $ 3 * 1000 * 1000
        putStrLn "Cancelling client from canceller..."
        Async.cancel client

    putStrLn "Awaiting result from client..."
    result <- Async.waitCatch client
    putStrLn $ "Result: " ++ show result