Client: default to 30s for connection timeout

src/Network/WebSockets/Client.hs

@@ -25,6 +25,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)
 
 
 --------------------------------------------------------------------------------
@@ -74,10 +75,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) $ 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 microseconds.
     , connectionCompressionOptions    :: !CompressionOptions
       -- ^ Enable 'PermessageDeflate'.
     , connectionStrictUnicode         :: !Bool
@@ -62,6 +64,7 @@ data ConnectionOptions = ConnectionOptions
 defaultConnectionOptions :: ConnectionOptions
 defaultConnectionOptions = ConnectionOptions
     { connectionOnPong                = return ()
+    , connectionTimeout               = 30 * 1000 * 1000
     , 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 Request String
+    -- | 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