-- | Copy of 'Network.Connection.connectTo' with 'KeepAlive'
--
-- <https://hackage.haskell.org/package/connection-0.3.1/docs/src/Network.Connection.html#connectTo>
--
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

-- brittany --exactprint-only

connectTo :: ConnectionContext -> ConnectionParams -> IO Connection
connectTo :: ConnectionContext -> ConnectionParams -> IO Connection
connectTo ConnectionContext
cg ConnectionParams
cParams =
  IO (Socket, SockAddr)
-> ((Socket, SockAddr) -> IO ())
-> ((Socket, SockAddr) -> IO Connection)
-> IO Connection
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 (Socket -> IO ())
-> ((Socket, SockAddr) -> Socket) -> (Socket, SockAddr) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Socket, SockAddr) -> Socket
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 (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) (String -> Maybe String
forall a. a -> Maybe a
Just String
host) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ PortNumber -> String
forall a. Show a => a -> String
show PortNumber
port)
    [IO (Socket, SockAddr)] -> IO (Socket, SockAddr)
firstSuccessful ([IO (Socket, SockAddr)] -> IO (Socket, SockAddr))
-> [IO (Socket, SockAddr)] -> IO (Socket, SockAddr)
forall a b. (a -> b) -> a -> b
$ (AddrInfo -> IO (Socket, SockAddr))
-> [AddrInfo] -> [IO (Socket, SockAddr)]
forall a b. (a -> b) -> [a] -> [b]
map AddrInfo -> IO (Socket, SockAddr)
tryToConnect [AddrInfo]
addrs
  where
    tryToConnect :: AddrInfo -> IO (Socket, SockAddr)
tryToConnect AddrInfo
addr =
        IO Socket
-> (Socket -> IO ())
-> (Socket -> IO (Socket, SockAddr))
-> IO (Socket, SockAddr)
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)
            (Socket, SockAddr) -> IO (Socket, SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Socket
sock, AddrInfo -> SockAddr
addrAddress AddrInfo
addr)
            )
    firstSuccessful :: [IO (Socket, SockAddr)] -> IO (Socket, SockAddr)
firstSuccessful = [IOException] -> [IO (Socket, SockAddr)] -> IO (Socket, SockAddr)
forall a. [IOException] -> [IO a] -> IO a
go []
      where
        go :: [IOException] -> [IO a] -> IO a
        go :: [IOException] -> [IO a] -> IO a
go []      [] = HostNotResolved -> IO a
forall e a. Exception e => e -> IO a
throwIO (HostNotResolved -> IO a) -> HostNotResolved -> IO a
forall a b. (a -> b) -> a -> b
$ String -> HostNotResolved
HostNotResolved String
host
        go l :: [IOException]
l@(IOException
_:[IOException]
_) [] = HostCannotConnect -> IO a
forall e a. Exception e => e -> IO a
throwIO (HostCannotConnect -> IO a) -> HostCannotConnect -> IO a
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 <- IO a -> IO (Either IOException a)
forall e a. Exception e => IO a -> IO (Either e a)
try IO a
act
            case Either IOException a
er of
                Left IOException
err -> [IOException] -> [IO a] -> IO a
forall a. [IOException] -> [IO a] -> IO a
go (IOException
errIOException -> [IOException] -> [IOException]
forall a. a -> [a] -> [a]
:[IOException]
acc) [IO a]
followingActs
                Right a
r  -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r