Merge pull request #237 from cachix/connection-timeout

Client: default to 30s for connection timeout

src/Network/WebSockets/Client.hs

@@ -26,6 +26,7 @@ import           Data.IORef                    (newIORef)
 import qualified Data.Text                     as T
 import qualified Data.Text.Encoding            as T
 import qualified Network.Socket                as S
+import           System.Timeout                (timeout)
 
 
 --------------------------------------------------------------------------------
@@ -75,10 +76,12 @@ runClientWith host port path0 opts customHeaders app = do
     S.setSocketOption sock S.NoDelay 1
 
     -- Connect WebSocket and run client
-    res <- finally
-        (S.connect sock (S.addrAddress addr) >>
-         runClientWithSocket sock fullHost path opts customHeaders app)
-        (S.close sock)
+    res <- bracket
+        (timeout (connectionTimeout opts * 1000 * 1000) $ S.connect sock (S.addrAddress addr))
+        (const $ S.close sock) $ \maybeConnected -> case maybeConnected of
+            Nothing -> throwIO $ ConnectionTimeout
+            Just () -> runClientWithSocket sock fullHost path opts customHeaders app
+
 
     -- Clean up
     return res

src/Network/WebSockets/Connection/Options.hs

@@ -31,6 +31,8 @@ data ConnectionOptions = ConnectionOptions
     { connectionOnPong                :: !(IO ())
       -- ^ Whenever a 'pong' is received, this IO action is executed. It can be
       -- used to tickle connections or fire missiles.
+    , connectionTimeout               :: !Int
+      -- ^ Timeout for connection establishment in seconds. Only used in the client.
     , connectionCompressionOptions    :: !CompressionOptions
       -- ^ Enable 'PermessageDeflate'.
     , connectionStrictUnicode         :: !Bool
@@ -59,9 +61,11 @@ data ConnectionOptions = ConnectionOptions
 -- * Nothing happens when a pong is received.
 -- * Compression is disabled.
 -- * Lenient unicode decoding.
+-- * 30 second timeout for connection establishment.
 defaultConnectionOptions :: ConnectionOptions
 defaultConnectionOptions = ConnectionOptions
     { connectionOnPong                = return ()
+    , connectionTimeout               = 30
     , connectionCompressionOptions    = NoCompression
     , connectionStrictUnicode         = False
     , connectionFramePayloadSizeLimit = mempty

src/Network/WebSockets/Http.hs

@@ -101,6 +101,8 @@ data HandshakeException
     -- | The request was well-formed, but the library user rejected it.
     -- (e.g. "unknown path")
     | RequestRejected RequestHead ResponseHead
+    -- | The connection timed out
+    | ConnectionTimeout
     -- | for example "EOF came too early" (which is actually a parse error)
     -- or for your own errors. (like "unknown path"?)
     | OtherHandshakeException String