-- | 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 = [AI_ADDRCONFIG], addrSocketType = 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 a. a -> IO a
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 :: forall a. [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
err IOException -> [IOException] -> [IOException]
forall a. a -> [a] -> [a]
: [IOException]
acc) [IO a]
followingActs
        Right a
r -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r