Compat.hs

-- | 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 cg cParams =
  bracketOnError
    (resolve (connectionHostname cParams) (connectionPort cParams))
    (close . fst)
    ( \(h, _) ->
      connectFromSocket cg h cParams
    )

resolve :: String -> PortNumber -> IO (Socket, SockAddr)
resolve host port = do
    let hints = defaultHints { addrFlags = [AI_ADDRCONFIG], addrSocketType = Stream }
    addrs <- getAddrInfo (Just hints) (Just host) (Just $ show port)
    firstSuccessful $ map tryToConnect addrs
  where
    tryToConnect addr =
        bracketOnError
          (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))
          close
          (\sock -> do
            setSocketOption sock KeepAlive 1
            S.connect sock (addrAddress addr)
            return (sock, addrAddress addr)
            )
    firstSuccessful = go []
      where
        go :: [IOException] -> [IO a] -> IO a
        go []      [] = throwIO $ HostNotResolved host
        go l@(_:_) [] = throwIO $ HostCannotConnect host l
        go acc     (act:followingActs) = do
            er <- try act
            case er of
                Left err -> go (err:acc) followingActs
                Right r  -> return r