Add open{Client,Server,TCPServer}SocketWithOpts

The existing interface did not allow one to set both `Linger` and `NoDelay`
socket options. With the `SocketOptValue` introduced in [this `network`
PR](haskell/network#588), this is now possible.

Network/Run/Core.hs

@@ -1,23 +1,28 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE OverloadedStrings #-}
 
 module Network.Run.Core (
     resolve,
     openSocket,
     openClientSocket,
     openClientSocketWithOptions,
+    openClientSocketWithOpts,
     openServerSocket,
     openServerSocketWithOptions,
+    openServerSocketWithOpts,
     openTCPServerSocket,
     openTCPServerSocketWithOptions,
+    openTCPServerSocketWithOpts,
     gclose,
     labelMe,
 ) where
 
+import Control.Arrow
+import Control.Concurrent
 import qualified Control.Exception as E
 import Control.Monad (when)
-import Network.Socket
+import Foreign (Storable)
 import GHC.Conc.Sync
+import Network.Socket
 
 resolve
     :: SocketType
@@ -41,38 +46,69 @@ openSocket addr = socket (addrFamily addr) (addrSocketType addr) (addrProtocol a
 
 -- | This is the same as
 --
--- > openClientSocketWithOptions []
+-- @
+-- 'openClientSocketWithOptions' []
+-- @
 openClientSocket :: AddrInfo -> IO Socket
 openClientSocket = openClientSocketWithOptions []
 
+-- | Open a client socket with the given options
+--
+-- The options are set before 'connect'. This is equivalent to
+--
+-- @
+-- 'openClientSocketWithOpts' . 'map' ('second' 'SocketOptValue')
+-- @
 openClientSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket
-openClientSocketWithOptions opts addr = E.bracketOnError (openSocket addr) close $ \sock -> do
-    mapM_ (uncurry $ setSocketOption sock) opts
+openClientSocketWithOptions = openClientSocketWithOpts . map (second SocketOptValue)
+
+-- | Open a client socket with the given options
+--
+-- This must be used rather than 'openClientSocketWithOptions' for options such
+-- as 'Network.Socket.Linger' which require a composite value
+-- ('Network.Socket.StructLinger').
+--
+-- The options are set before 'connect'.
+openClientSocketWithOpts :: [(SocketOption, SocketOptValue)] -> AddrInfo -> IO Socket
+openClientSocketWithOpts opts addr = E.bracketOnError (openSocket addr) close $ \sock -> do
+    mapM_ (uncurry $ setSocketOptValue sock) opts
     connect sock $ addrAddress addr
     return sock
 
 -- | Open socket for server use
 --
 -- This is the same as:
 --
--- > openServerSocketWithOptions []
+-- @
+-- 'openServerSocketWithOptions' []
+-- @
 openServerSocket :: AddrInfo -> IO Socket
 openServerSocket = openServerSocketWithOptions []
 
+-- | Open socket for server use, and set the provided options before binding.
+--
+-- This is equivalent to
+--
+-- @
+-- 'openServerSocketWithOpts' . 'map' ('second' 'SocketOptValue')
+-- @
+openServerSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket
+openServerSocketWithOptions = openServerSocketWithOpts . map (second SocketOptValue)
+
 -- | Open socket for server use, and set the provided options before binding.
 --
 -- In addition to the given options, the socket is configured to
 --
 -- * allow reuse of local addresses (SO_REUSEADDR)
 -- * automatically be closed during a successful @execve@ (FD_CLOEXEC)
 -- * bind to the address specified
-openServerSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket
-openServerSocketWithOptions opts addr = E.bracketOnError (openSocket addr) close $ \sock -> do
+openServerSocketWithOpts :: [(SocketOption, SocketOptValue)] -> AddrInfo -> IO Socket
+openServerSocketWithOpts opts addr = E.bracketOnError (openSocket addr) close $ \sock -> do
     setSocketOption sock ReuseAddr 1
 #if !defined(openbsd_HOST_OS)
     when (addrFamily addr == AF_INET6) $ setSocketOption sock IPv6Only 1
 #endif
-    mapM_ (uncurry $ setSocketOption sock) opts
+    mapM_ (uncurry $ setSocketOptValue sock) opts
     withFdSocket sock setCloseOnExecIfNeeded
     bind sock $ addrAddress addr
     return sock
@@ -81,10 +117,22 @@ openServerSocketWithOptions opts addr = E.bracketOnError (openSocket addr) close
 --
 -- This is the same as:
 --
--- > openTCPServerSocketWithOptions []
+-- @
+-- 'openTCPServerSocketWithOptions' []
+-- @
 openTCPServerSocket :: AddrInfo -> IO Socket
 openTCPServerSocket = openTCPServerSocketWithOptions []
 
+-- | Open socket for server use, and set the provided options before binding.
+--
+-- This is equivalent to
+--
+-- @
+-- 'openTCPServerSocketWithOpts' . 'map' ('second' 'SocketOptValue')
+-- @
+openTCPServerSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket
+openTCPServerSocketWithOptions = openTCPServerSocketWithOpts . map (second SocketOptValue)
+
 -- | Open socket for server use, and set the provided options before binding.
 --
 -- In addition to the given options, the socket is configured to
@@ -93,9 +141,9 @@ openTCPServerSocket = openTCPServerSocketWithOptions []
 -- * automatically be closed during a successful @execve@ (FD_CLOEXEC)
 -- * bind to the address specified
 -- * listen with queue length with 1024
-openTCPServerSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket
-openTCPServerSocketWithOptions opts addr = do
-    sock <- openServerSocketWithOptions opts addr
+openTCPServerSocketWithOpts :: [(SocketOption, SocketOptValue)] -> AddrInfo -> IO Socket
+openTCPServerSocketWithOpts opts addr = do
+    sock <- openServerSocketWithOpts opts addr
     listen sock 1024
     return sock
 

Network/Run/TCP.hs

@@ -8,6 +8,7 @@ module Network.Run.TCP (
     runTCPServerWithSocket,
     openTCPServerSocket,
     openTCPServerSocketWithOptions,
+    openTCPServerSocketWithOpts,
     resolve,
 
     -- * Client
@@ -18,9 +19,10 @@ module Network.Run.TCP (
     runTCPClientWithSettings,
     openClientSocket,
     openClientSocketWithOptions,
+    openClientSocketWithOpts,
 ) where
 
-import Control.Concurrent (forkFinally)
+import Control.Concurrent (forkFinally, threadDelay, forkIO)
 import qualified Control.Exception as E
 import Control.Monad (forever, void)
 import Network.Socket
@@ -30,10 +32,6 @@ import Network.Run.Core
 ----------------------------------------------------------------
 
 -- | Running a TCP server with an accepted socket and its peer name.
---
--- This is the same as:
---
--- > runTCPServerWithSocketOptions []
 runTCPServer :: Maybe HostName -> ServiceName -> (Socket -> IO a) -> IO a
 runTCPServer mhost port server = withSocketsDo $ do
     addr <- resolve Stream mhost port [AI_PASSIVE]
@@ -72,7 +70,9 @@ defaultSettings =
 --
 -- This is the same as:
 --
--- > runTCPClientWithSettings defaultSettings
+-- @
+-- 'runTCPClientWithSettings' 'defaultSettings'
+-- @
 runTCPClient :: HostName -> ServiceName -> (Socket -> IO a) -> IO a
 runTCPClient = runTCPClientWithSettings defaultSettings
 

Network/Run/TCP/Timeout.hs

@@ -9,6 +9,7 @@ module Network.Run.TCP.Timeout (
     runTCPServerWithSocket,
     openServerSocket,
     openServerSocketWithOptions,
+    openServerSocketWithOpts,
 ) where
 
 import Control.Concurrent (forkFinally)