module Network.Compat where

import Network.Socket
import Network.BSD (getProtocolNumber)
import System.IO (Handle, IOMode (..))

import qualified Control.Exception as Exception

connectTo :: String             -- Hostname
          -> PortNumber         -- Port Identifier
          -> IO Handle          -- Connected Socket
connectTo :: String -> PortNumber -> IO Handle
connectTo String
host PortNumber
port = do
    ProtocolNumber
proto <- String -> IO ProtocolNumber
getProtocolNumber String
"tcp"
    let hints :: AddrInfo
hints = AddrInfo
defaultHints { addrFlags :: [AddrInfoFlag]
addrFlags = [AddrInfoFlag
AI_ADDRCONFIG]
                             , addrProtocol :: ProtocolNumber
addrProtocol = ProtocolNumber
proto
                             , addrSocketType :: SocketType
addrSocketType = SocketType
Stream }
    [AddrInfo]
addrs <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo (forall a. a -> Maybe a
Just AddrInfo
hints) (forall a. a -> Maybe a
Just String
host) (forall a. a -> Maybe a
Just String
serv)
    forall a. String -> [IO a] -> IO a
firstSuccessful String
"connectTo" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map AddrInfo -> IO Handle
tryToConnect [AddrInfo]
addrs
  where
  serv :: String
serv = forall a. Show a => a -> String
show PortNumber
port

  tryToConnect :: AddrInfo -> IO Handle
tryToConnect AddrInfo
addr =
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracketOnError
        (Family -> SocketType -> ProtocolNumber -> IO Socket
socket (AddrInfo -> Family
addrFamily AddrInfo
addr) (AddrInfo -> SocketType
addrSocketType AddrInfo
addr) (AddrInfo -> ProtocolNumber
addrProtocol AddrInfo
addr))
        Socket -> IO ()
close  -- only done if there's an error
        (\Socket
sock -> do
          Socket -> SockAddr -> IO ()
connect Socket
sock (AddrInfo -> SockAddr
addrAddress AddrInfo
addr)
          Socket -> IOMode -> IO Handle
socketToHandle Socket
sock IOMode
ReadWriteMode
        )

-- Returns the first action from a list which does not throw an exception.
-- If all the actions throw exceptions (and the list of actions is not empty),
-- the last exception is thrown.
-- The operations are run outside of the catchIO cleanup handler because
-- catchIO masks asynchronous exceptions in the cleanup handler.
-- In the case of complete failure, the last exception is actually thrown.
firstSuccessful :: String -> [IO a] -> IO a
firstSuccessful :: forall a. String -> [IO a] -> IO a
firstSuccessful String
caller = forall {b}. Maybe IOException -> [IO b] -> IO b
go forall a. Maybe a
Nothing
  where
  -- Attempt the next operation, remember exception on failure
  go :: Maybe IOException -> [IO b] -> IO b
go Maybe IOException
_ (IO b
p:[IO b]
ps) =
    do Either IOException b
r <- forall a. IO a -> IO (Either IOException a)
tryIO IO b
p
       case Either IOException b
r of
         Right b
x -> forall (m :: * -> *) a. Monad m => a -> m a
return b
x
         Left  IOException
e -> Maybe IOException -> [IO b] -> IO b
go (forall a. a -> Maybe a
Just IOException
e) [IO b]
ps

  -- All operations failed, throw error if one exists
  go Maybe IOException
Nothing  [] = forall a. IOException -> IO a
ioError forall a b. (a -> b) -> a -> b
$ String -> IOException
userError forall a b. (a -> b) -> a -> b
$ String
caller forall a. [a] -> [a] -> [a]
++ String
": firstSuccessful: empty list"
  go (Just IOException
e) [] = forall e a. Exception e => e -> IO a
Exception.throwIO IOException
e

-- Version of try implemented in terms of the locally defined catchIO
tryIO :: IO a -> IO (Either Exception.IOException a)
tryIO :: forall a. IO a -> IO (Either IOException a)
tryIO IO a
m = forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Exception.catch (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right IO a
m) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)