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 * 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

@@ -15,7 +15,7 @@
 
 --------------------------------------------------------------------------------
 import           Data.Int    (Int64)
 import           Data.Monoid (Monoid (..))
 import           Prelude
 
 
@@ -31,6 +31,8 @@
     { 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 @@
 -- * 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

@@ -33,7 +33,7 @@
 --------------------------------------------------------------------------------
 import qualified Data.ByteString.Builder                   as Builder
 import qualified Data.ByteString.Builder.Extra             as Builder
 import           Control.Applicative                       (pure, (*>), (<$>),
                                                             (<*), (<*>))
 import           Control.Exception                         (Exception)
 import qualified Data.Attoparsec.ByteString                as A
@@ -44,7 +44,7 @@
 import           Data.ByteString.Internal                  (c2w)
 import qualified Data.CaseInsensitive                      as CI
 import           Data.Dynamic                              (Typeable)
 import           Data.Monoid                               (mappend, mconcat)
 import qualified Network.WebSockets.Extensions.Description as Extensions
 
 
@@ -101,6 +101,8 @@
     -- | 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