module Network.Connection.Compat
( connectTo
, module Network.Connection
) where
import Prelude
import Control.Exception (IOException, bracketOnError, throwIO, try)
import Network.Connection hiding (connectTo)
import Network.Socket
import qualified Network.Socket as S
connectTo :: ConnectionContext -> ConnectionParams -> IO Connection
connectTo :: ConnectionContext -> ConnectionParams -> IO Connection
connectTo ConnectionContext
cg ConnectionParams
cParams =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
(String -> PortNumber -> IO (Socket, SockAddr)
resolve (ConnectionParams -> String
connectionHostname ConnectionParams
cParams) (ConnectionParams -> PortNumber
connectionPort ConnectionParams
cParams))
(Socket -> IO ()
close forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
( \(Socket
h, SockAddr
_) ->
ConnectionContext -> Socket -> ConnectionParams -> IO Connection
connectFromSocket ConnectionContext
cg Socket
h ConnectionParams
cParams
)
resolve :: String -> PortNumber -> IO (Socket, SockAddr)
resolve :: String -> PortNumber -> IO (Socket, SockAddr)
resolve String
host PortNumber
port = do
let hints :: AddrInfo
hints = AddrInfo
defaultHints {addrFlags :: [AddrInfoFlag]
addrFlags = [AddrInfoFlag
AI_ADDRCONFIG], 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 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show PortNumber
port)
[IO (Socket, SockAddr)] -> IO (Socket, SockAddr)
firstSuccessful forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map AddrInfo -> IO (Socket, SockAddr)
tryToConnect [AddrInfo]
addrs
where
tryToConnect :: AddrInfo -> IO (Socket, SockAddr)
tryToConnect AddrInfo
addr =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
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
( \Socket
sock -> do
Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
sock SocketOption
KeepAlive Int
1
Socket -> SockAddr -> IO ()
S.connect Socket
sock (AddrInfo -> SockAddr
addrAddress AddrInfo
addr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Socket
sock, AddrInfo -> SockAddr
addrAddress AddrInfo
addr)
)
firstSuccessful :: [IO (Socket, SockAddr)] -> IO (Socket, SockAddr)
firstSuccessful = forall a. [IOException] -> [IO a] -> IO a
go []
where
go :: [IOException] -> [IO a] -> IO a
go :: forall a. [IOException] -> [IO a] -> IO a
go [] [] = forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> HostNotResolved
HostNotResolved String
host
go l :: [IOException]
l@(IOException
_ : [IOException]
_) [] = forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> [IOException] -> HostCannotConnect
HostCannotConnect String
host [IOException]
l
go [IOException]
acc (IO a
act : [IO a]
followingActs) = do
Either IOException a
er <- forall e a. Exception e => IO a -> IO (Either e a)
try IO a
act
case Either IOException a
er of
Left IOException
err -> forall a. [IOException] -> [IO a] -> IO a
go (IOException
err forall a. a -> [a] -> [a]
: [IOException]
acc) [IO a]
followingActs
Right a
r -> forall (m :: * -> *) a. Monad m => a -> m a
return a
r