packages feed

network-run 0.3.1 → 0.4.0

raw patch · 6 files changed

+165/−80 lines, 6 files

Files

CHANGELOG.md view
@@ -1,5 +1,16 @@ # Revision history for network-run +## 0.4.0++* New API: `openTCPServerSocket`, `runTCPClientWithSettings`, etc.+* Breaking change: runTCPServerSocket takes a socket itself++## 0.3.2++* Add `openServerSocketWithOptions`, `openClientSocketWithOptions`,+  `runTCPServerWithSocketOptions`, `runTCPClientWithSocketOptions`.+  [#6](https://github.com/kazu-yamamoto/network-run/pull/6)+ ## 0.3.1  * Using close instead of gracefulClose for client
Network/Run/Core.hs view
@@ -5,13 +5,19 @@     resolve,     openSocket,     openClientSocket,+    openClientSocketWithOptions,     openServerSocket,+    openServerSocketWithOptions,+    openTCPServerSocket,+    openTCPServerSocketWithOptions,     gclose,+    labelMe, ) where  import qualified Control.Exception as E import Control.Monad (when) import Network.Socket+import GHC.Conc.Sync  resolve     :: SocketType@@ -33,32 +39,74 @@ openSocket addr = socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) #endif +-- | This is the same as+--+-- > openClientSocketWithOptions [] openClientSocket :: AddrInfo -> IO Socket-openClientSocket ai = do-    sock <- openSocket ai-    connect sock $ addrAddress ai+openClientSocket = openClientSocketWithOptions []++openClientSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket+openClientSocketWithOptions opts addr = E.bracketOnError (openSocket addr) close $ \sock -> do+    mapM_ (uncurry $ setSocketOption sock) opts+    connect sock $ addrAddress addr     return sock  -- | Open socket for server use ----- The socket is configured to+-- This is the same as: --+-- > openServerSocketWithOptions []+openServerSocket :: AddrInfo -> IO Socket+openServerSocket = openServerSocketWithOptions []++-- | 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-openServerSocket :: AddrInfo -> IO Socket-openServerSocket addr = E.bracketOnError (openSocket addr) close $ \sock -> do+openServerSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket+openServerSocketWithOptions 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-    withFdSocket sock $ setCloseOnExecIfNeeded+    mapM_ (uncurry $ setSocketOption sock) opts+    withFdSocket sock setCloseOnExecIfNeeded     bind sock $ addrAddress addr     return sock +-- | Open TCP socket for server use+--+-- This is the same as:+--+-- > openTCPServerSocketWithOptions []+openTCPServerSocket :: AddrInfo -> IO Socket+openTCPServerSocket = openTCPServerSocketWithOptions []++-- | 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+-- * listen with queue length with 1024+openTCPServerSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket+openTCPServerSocketWithOptions opts addr = do+    sock <- openServerSocketWithOptions opts addr+    listen sock 1024+    return sock+ gclose :: Socket -> IO () #if MIN_VERSION_network(3,1,1) gclose sock = gracefulClose sock 5000 #else gclose = close #endif++labelMe :: String -> IO ()+labelMe name = do+    tid <- myThreadId+    labelThread tid name
Network/Run/TCP.hs view
@@ -1,13 +1,23 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}  -- | Simple functions to run TCP clients and servers. module Network.Run.TCP (-    runTCPClient,+    -- * Server     runTCPServer,--    -- * Generalized API     runTCPServerWithSocket,-    openServerSocket,+    openTCPServerSocket,+    openTCPServerSocketWithOptions,+    resolve,++    -- * Client+    runTCPClient,+    Settings,+    defaultSettings,+    settingsOpenClientSocket,+    runTCPClientWithSettings,+    openClientSocket,+    openClientSocketWithOptions, ) where  import Control.Concurrent (forkFinally)@@ -17,42 +27,62 @@  import Network.Run.Core --- | Running a TCP client with a connected socket.-runTCPClient :: HostName -> ServiceName -> (Socket -> IO a) -> IO a-runTCPClient host port client = withSocketsDo $ do-    addr <- resolve Stream (Just host) port [AI_ADDRCONFIG]-    E.bracket (open addr) close client-  where-    open addr = E.bracketOnError (openClientSocket addr) close return+----------------------------------------------------------------  -- | 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 = runTCPServerWithSocket openServerSocket--------------------------------------------------------------------- Generalized API+runTCPServer mhost port server = withSocketsDo $ do+    addr <- resolve Stream mhost port [AI_PASSIVE]+    E.bracket (openTCPServerSocket addr) close $ \sock ->+        runTCPServerWithSocket sock server --- | Generalization of 'runTCPServer'+-- | Running a TCP client with a connected socket for a given listen+-- socket. runTCPServerWithSocket-    :: (AddrInfo -> IO Socket)-    -- ^ Initialize socket.-    ---    -- This function is called while exceptions are masked.-    ---    -- The default (used by 'runTCPServer') is 'openServerSocket'.-    -> Maybe HostName-    -> ServiceName+    :: Socket     -> (Socket -> IO a)     -- ^ Called for each incoming connection, in a new thread     -> IO a-runTCPServerWithSocket initSocket mhost port server = withSocketsDo $ do-    addr <- resolve Stream mhost port [AI_PASSIVE]-    E.bracket (open addr) close loop-  where-    open addr = E.bracketOnError (initSocket addr) close $ \sock -> do-        listen sock 1024-        return sock-    loop sock = forever $+runTCPServerWithSocket sock server = withSocketsDo $+    forever $         E.bracketOnError (accept sock) (close . fst) $             \(conn, _peer) ->-                void $ forkFinally (server conn) (const $ gclose conn)+                void $ forkFinally (labelMe "TCP server" >> server conn) (const $ gclose conn)++----------------------------------------------------------------++-- | Settings for client.+data Settings = Settings+    { settingsOpenClientSocket :: AddrInfo -> IO Socket+    -- ^ Opening a socket. Use 'openClientSocketWithOptions' to specify 'SocketOption'+    }++-- | Default settings.+defaultSettings :: Settings+defaultSettings =+    Settings+        { settingsOpenClientSocket = openClientSocket+        }++-- | Running a TCP client with a connected socket.+--+-- This is the same as:+--+-- > runTCPClientWithSettings defaultSettings+runTCPClient :: HostName -> ServiceName -> (Socket -> IO a) -> IO a+runTCPClient = runTCPClientWithSettings defaultSettings++-- | Running a TCP client with a connected socket.+runTCPClientWithSettings+    :: Settings+    -> HostName+    -> ServiceName+    -> (Socket -> IO a)+    -> IO a+runTCPClientWithSettings Settings{..} host port client = withSocketsDo $ do+    addr <- resolve Stream (Just host) port [AI_ADDRCONFIG]+    E.bracket (settingsOpenClientSocket addr) close client
Network/Run/TCP/Timeout.hs view
@@ -7,8 +7,8 @@      -- * Generalized API     runTCPServerWithSocket,-    openClientSocket,     openServerSocket,+    openServerSocketWithOptions, ) where  import Control.Concurrent (forkFinally)@@ -29,7 +29,7 @@     -- ^ A connected socket     -> IO a --- | Running a TCP server with an accepted socket and its peer name.+-- | Running a TCP server with a connected socket. runTCPServer     :: Int     -- ^ Timeout in second.@@ -37,34 +37,28 @@     -> ServiceName     -> TimeoutServer a     -> IO a-runTCPServer = runTCPServerWithSocket openServerSocket--------------------------------------------------------------------- Generalized API+runTCPServer tm mhost port server = withSocketsDo $ do+    addr <- resolve Stream mhost port [AI_PASSIVE]+    E.bracket (openTCPServerSocket addr) close $ \sock ->+        runTCPServerWithSocket tm sock server --- | Generalization of 'runTCPServer'------ See 'Network.Run.TCP.runTCPServerWithSocket' for additional discussion.+-- | Running a TCP client with a connected socket for a given listen+-- socket. runTCPServerWithSocket-    :: (AddrInfo -> IO Socket)-    -> Int+    :: Int     -- ^ Timeout in second.-    -> Maybe HostName-    -> ServiceName+    -> Socket     -> TimeoutServer a     -> IO a-runTCPServerWithSocket initSocket tm mhost port server = withSocketsDo $ do-    T.withManager (tm * 1000000) $ \mgr -> do-        addr <- resolve Stream mhost port [AI_PASSIVE]-        E.bracket (open addr) close $ loop mgr-  where-    open addr = E.bracketOnError (initSocket addr) close $ \sock -> do-        listen sock 1024-        return sock-    loop mgr sock = forever $+runTCPServerWithSocket tm sock server = withSocketsDo $ do+    T.withManager (tm * 1000000) $ \mgr -> forever $         E.bracketOnError (accept sock) (close . fst) $             \(conn, _peer) ->-                void $ forkFinally (server' mgr conn) (const $ gclose conn)+                void $+                    forkFinally+                        (labelMe "TCP timeout server" >> server' mgr conn)+                        (const $ gclose conn)+  where     server' mgr conn = do         th <- T.registerKillThread mgr $ return ()         server mgr th conn
Network/Run/UDP.hs view
@@ -46,19 +46,21 @@     mapM_ (forkIO . run) hs     run h   where-    run host = runUDPServer (Just host) port $ \lsock -> forever $ do-        (bs0, peeraddr) <- recvFrom lsock 2048-        let family = case peeraddr of-                SockAddrInet{} -> AF_INET-                SockAddrInet6{} -> AF_INET6-                _ -> error "family"-            hints =-                defaultHints-                    { addrSocketType = Datagram-                    , addrFamily = family-                    , addrFlags = [AI_PASSIVE]-                    }-        addr <- head <$> getAddrInfo (Just hints) Nothing (Just port)-        s <- openServerSocket addr-        connect s peeraddr-        void $ forkFinally (server s bs0) (\_ -> close s)+    run host = do+        labelMe $ "UDP server for " ++ h+        runUDPServer (Just host) port $ \lsock -> forever $ do+            (bs0, peeraddr) <- recvFrom lsock 2048+            let family = case peeraddr of+                    SockAddrInet{} -> AF_INET+                    SockAddrInet6{} -> AF_INET6+                    _ -> error "family"+                hints =+                    defaultHints+                        { addrSocketType = Datagram+                        , addrFamily = family+                        , addrFlags = [AI_PASSIVE]+                        }+            addr <- head <$> getAddrInfo (Just hints) Nothing (Just port)+            s <- openServerSocket addr+            connect s peeraddr+            void $ forkFinally (labelMe "UDP server" >> server s bs0) (\_ -> close s)
network-run.cabal view
@@ -1,5 +1,5 @@ name:                network-run-version:             0.3.1+version:             0.4.0 synopsis:            Simple network runner library description:         Simple functions to run network clients and servers. -- bug-reports: