How to change runTCPClient timeout duration?

Question

The question is everything. I use Data.Conduit.Networkand sometimes the server is down. The default timeout takes a few minutes, my program should know in a few seconds.

{-# LANGUAGE OverloadedStrings #-}

import Data.Conduit.Network

main = do --use any IP address that isn't up....  I use 1.2.3.4 for testing
  runTCPClient (clientSettings 80 "1.2.3.4") $ \server -> do
    putStrLn "connected"

I looked up and down in the documents and the source, and the answer is simply not clear to me. I think this may be impossible ....

---

More info in response to @haoformayor ....

In the end, I used the same approach that @haoformayor suggested, but he needed to make some changes to make it work. Here is my current working code.

runTCPClientWithConnectTimeout::ClientSettings->Double->(AppData->IO ())->IO ()
runTCPClientWithConnectTimeout settings secs cont = do
  race <- newChan
  resultMVar <- newEmptyMVar

  timerThreadID <- forkIO $ do
    threadDelaySeconds secs
    writeChan race False

  clientThreadID <- forkIO $ do
    result <-
      try $
      runTCPClient settings $ \appData -> do
        writeChan race True
        cont appData
    writeChan race True --second call needed because first call won't be hit in the case of an error caught by try
    putMVar resultMVar result

  timedOut <- readChan race

  if timedOut
    then do
      killThread timerThreadID --don't want a buildup of timer threads....
      result' <- readMVar resultMVar
      case result' of
       Left e -> throw (e::SomeException)
       Right x -> return x
    else do
      error "runTCPClientWithConnectTimeout: could not connect in time"
      killThread clientThreadID

Answer 1

This is hard to do, even in the C world, without a good API.

, POSIX, Haskell connect(3). :

O_NONBLOCK , () , . , connect() , .   ~

-. , select(3), > . , , Linux.

. , C, Haskell. :

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Concurrent
import Data.Conduit.Network

-- | A more sensible unit of measurement for thread delays
threadDelaySeconds :: Double -> IO ()
threadDelaySeconds secs =
  threadDelay (ceiling $ secs * 1e6)

runTCPClientBounded :: ClientSettings -> Double -> (AppData -> IO ()) -> IO ()
runTCPClientBounded settings secs cont = do
  race <- newChan
  _ <- forkIO (timer race)
  _ <- forkIO (runTCPClient settings (handleServer race))
  winner <- readChan race
  case winner of
    Nothing ->
      error "runTCPClientBounded: could not connect in time"
    Just appdata ->
      cont appdata
  where
    timer :: Chan (Maybe AppData) -> IO ()
    timer chan = do
      putStrLn ("runTCPClientBounded: waiting $n seconds: " ++ show secs)
      threadDelaySeconds secs
      writeChan chan Nothing

    handleServer :: Chan (Maybe AppData) -> AppData -> IO ()
    handleServer chan appdata =
      writeChan chan (Just appdata)

main :: IO ()
main =
  runTCPClientBounded (clientSettings 80 "1.2.3.4") 1 (const (putStrLn "connected to 1.2.3.4!"))
  -- runTCPClientBounded (clientSettings 80 "example.com") 1 (const (putStrLn "connected to example.com!"))

, n - , runTCPClient. , ; connect(3) , . : , , , , runTCPClient , (, , , , ). .

!