{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Network.Run.TCP (
runTCPClient
, runTCPServer
) where
import Control.Concurrent (forkFinally)
import qualified Control.Exception as E
import Control.Monad (forever, void)
import Network.Socket
runTCPClient :: HostName -> ServiceName -> (Socket -> IO a) -> IO a
runTCPClient host port client = withSocketsDo $ do
addr <- resolve
#if MIN_VERSION_network(3,1,1)
E.bracket (open addr) (\sock -> gracefulClose sock 5000) client
#else
E.bracket (open addr) close client
#endif
where
resolve = do
let hints = defaultHints { addrSocketType = Stream }
head <$> getAddrInfo (Just hints) (Just host) (Just port)
open addr = do
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
connect sock $ addrAddress addr
return sock
runTCPServer :: Maybe HostName -> ServiceName -> (Socket -> SockAddr -> IO a) -> IO a
runTCPServer mhost port server = withSocketsDo $ do
addr <- resolve
E.bracket (open addr) close loop
where
resolve = do
let hints = defaultHints {
addrFlags = [AI_PASSIVE]
, addrSocketType = Stream
}
head <$> getAddrInfo (Just hints) mhost (Just port)
open addr = do
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
setSocketOption sock ReuseAddr 1
withFdSocket sock $ setCloseOnExecIfNeeded
bind sock $ addrAddress addr
listen sock 1024
return sock
loop sock = forever $ do
(conn, peer) <- accept sock
#if MIN_VERSION_network(3,1,1)
void $ forkFinally (server conn peer) (const $ gracefulClose conn 5000)
#else
void $ forkFinally (server conn peer) (const $ close conn)
#endif