module Network.Compat where
import Network.Socket
import Network.BSD (getProtocolNumber)
import System.IO (Handle, IOMode (..))
import qualified Control.Exception as Exception
connectTo :: String
-> PortNumber
-> IO Handle
connectTo host port = do
proto <- getProtocolNumber "tcp"
let hints = defaultHints { addrFlags = [AI_ADDRCONFIG]
, addrProtocol = proto
, addrSocketType = Stream }
addrs <- getAddrInfo (Just hints) (Just host) (Just serv)
firstSuccessful "connectTo" $ map tryToConnect addrs
where
serv = show port
tryToConnect addr =
Exception.bracketOnError
(socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))
close
(\sock -> do
connect sock (addrAddress addr)
socketToHandle sock ReadWriteMode
)
firstSuccessful :: String -> [IO a] -> IO a
firstSuccessful caller = go Nothing
where
go _ (p:ps) =
do r <- tryIO p
case r of
Right x -> return x
Left e -> go (Just e) ps
go Nothing [] = ioError $ userError $ caller ++ ": firstSuccessful: empty list"
go (Just e) [] = Exception.throwIO e
tryIO :: IO a -> IO (Either Exception.IOException a)
tryIO m = Exception.catch (fmap Right m) (return . Left)