packages feed

network-run 0.3.1 → 0.5.0

raw patch · 6 files changed

Files

CHANGELOG.md view
@@ -1,5 +1,38 @@ # Revision history for network-run +## 0.5.0++* Fixing a bug that TimeoutServer is not killed.+* Breaking change: the signatures of Timeout.runTCPServer and +  Timeout.runTCPServerWithSocket are changed.++## 0.4.3++* Using time-manager >= 0.2.++## 0.4.2++* Using `withHandle` of time-manager.++## 0.4.1++* Make sure to cancel Handles.+  [#13](https://github.com/kazu-yamamoto/network-run/pull/13)+* New API: `openClientSocketWithOpts`, `openServerSocketWithOpts`+  and `openTCPServerSocketWithOpts`.+  [#12](https://github.com/kazu-yamamoto/network-run/pull/12)++## 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
@@ -1,16 +1,27 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}  module Network.Run.Core (     resolve,     openSocket,     openClientSocket,+    openClientSocketWithOptions,+    openClientSocketWithOpts,     openServerSocket,+    openServerSocketWithOptions,+    openServerSocketWithOpts,+    openTCPServerSocket,+    openTCPServerSocketWithOptions,+    openTCPServerSocketWithOpts,     gclose,+    labelMe, ) where +import Data.List.NonEmpty (NonEmpty)+import Control.Arrow+import Control.Concurrent import qualified Control.Exception as E import Control.Monad (when)+import GHC.Conc.Sync import Network.Socket  resolve@@ -18,9 +29,10 @@     -> Maybe HostName     -> ServiceName     -> [AddrInfoFlag]+    -> (NonEmpty AddrInfo -> AddrInfo)     -> IO AddrInfo-resolve socketType mhost port flags =-    head <$> getAddrInfo (Just hints) mhost (Just port)+resolve socketType mhost port flags select =+    select <$> getAddrInfo (Just hints) mhost (Just port)   where     hints =         defaultHints@@ -33,32 +45,117 @@ 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 []++-- | Open a client socket with the given options+--+-- The options are set before 'connect'. This is equivalent to+--+-- @+-- 'openClientSocketWithOpts' . 'map' ('second' 'SockOptValue')+-- @+openClientSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket+openClientSocketWithOptions = openClientSocketWithOpts . map (second SockOptValue)++-- | 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, SockOptValue)] -> AddrInfo -> IO Socket+openClientSocketWithOpts opts addr = E.bracketOnError (openSocket addr) close $ \sock -> do+    mapM_ (uncurry $ setSockOptValue 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.+--+-- This is equivalent to+--+-- @+-- 'openServerSocketWithOpts' . 'map' ('second' 'SockOptValue')+-- @+openServerSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket+openServerSocketWithOptions = openServerSocketWithOpts . map (second SockOptValue)++-- | 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+openServerSocketWithOpts :: [(SocketOption, SockOptValue)] -> 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-    withFdSocket sock $ setCloseOnExecIfNeeded+    mapM_ (uncurry $ setSockOptValue 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.+--+-- This is equivalent to+--+-- @+-- 'openTCPServerSocketWithOpts' . 'map' ('second' 'SockOptValue')+-- @+openTCPServerSocketWithOptions :: [(SocketOption, Int)] -> AddrInfo -> IO Socket+openTCPServerSocketWithOptions = openTCPServerSocketWithOpts . map (second SockOptValue)++-- | 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+openTCPServerSocketWithOpts :: [(SocketOption, SockOptValue)] -> AddrInfo -> IO Socket+openTCPServerSocketWithOpts opts addr = do+    sock <- openServerSocketWithOpts 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,58 +1,93 @@ {-# 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,+    openTCPServerSocketWithOpts,+    resolve,++    -- * Client+    runTCPClient,+    Settings,+    defaultSettings,+    settingsOpenClientSocket,+    settingsSelectAddrInfo,+    runTCPClientWithSettings,+    openClientSocket,+    openClientSocketWithOptions,+    openClientSocketWithOpts, ) where  import Control.Concurrent (forkFinally) import qualified Control.Exception as E import Control.Monad (forever, void)+import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NE import Network.Socket  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. runTCPServer :: Maybe HostName -> ServiceName -> (Socket -> IO a) -> IO a-runTCPServer = runTCPServerWithSocket openServerSocket+runTCPServer mhost port server = do+    addr <- resolve Stream mhost port [AI_PASSIVE] NE.head+    E.bracket (openTCPServerSocket addr) close $ \sock ->+        runTCPServerWithSocket sock server +-- | Running a TCP client with a connected socket for a given listen+-- socket.+runTCPServerWithSocket+    :: Socket+    -> (Socket -> IO a)+    -- ^ Called for each incoming connection, in a new thread+    -> IO a+runTCPServerWithSocket sock server = forever $+    E.bracketOnError (accept sock) (close . fst) $+        \(conn, _peer) ->+            void $ forkFinally (labelMe "TCP server" >> server conn) (const $ gclose conn)+ ------------------------------------------------------------------- Generalized API --- | Generalization of 'runTCPServer'-runTCPServerWithSocket-    :: (AddrInfo -> IO Socket)-    -- ^ Initialize socket.-    ---    -- This function is called while exceptions are masked.-    ---    -- The default (used by 'runTCPServer') is 'openServerSocket'.-    -> Maybe HostName+-- | Settings for client.+data Settings = Settings+    { settingsOpenClientSocket :: AddrInfo -> IO Socket+    -- ^ Opening a socket. Use 'openClientSocketWithOptions' to specify 'SocketOption'+    , settingsSelectAddrInfo :: NonEmpty AddrInfo -> AddrInfo+    -- ^ Selecting 'AddrInfo'.+    }++-- | Default settings.+defaultSettings :: Settings+defaultSettings =+    Settings+        { settingsOpenClientSocket = openClientSocket+        , settingsSelectAddrInfo = NE.head+        }++-- | 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)-    -- ^ 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 $-        E.bracketOnError (accept sock) (close . fst) $-            \(conn, _peer) ->-                void $ forkFinally (server conn) (const $ gclose conn)+runTCPClientWithSettings Settings{..} host port client = do+    addr <- resolve Stream (Just host) port [AI_ADDRCONFIG] settingsSelectAddrInfo+    E.bracket (settingsOpenClientSocket addr) close client
Network/Run/TCP/Timeout.hs view
@@ -7,13 +7,15 @@      -- * Generalized API     runTCPServerWithSocket,-    openClientSocket,     openServerSocket,+    openServerSocketWithOptions,+    openServerSocketWithOpts, ) where  import Control.Concurrent (forkFinally) import qualified Control.Exception as E import Control.Monad (forever, void)+import qualified Data.List.NonEmpty as NE import Network.Socket import qualified System.TimeManager as T @@ -29,42 +31,32 @@     -- ^ 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.     -> Maybe HostName     -> ServiceName-    -> TimeoutServer a-    -> IO a-runTCPServer = runTCPServerWithSocket openServerSocket--------------------------------------------------------------------- Generalized API+    -> TimeoutServer ()+    -> IO ()+runTCPServer tm mhost port server = do+    addr <- resolve Stream mhost port [AI_PASSIVE] NE.head+    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-    -> 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+    -> Socket+    -> TimeoutServer ()+    -> IO ()+runTCPServerWithSocket tm sock server = do+    T.withManager (tm * 1000000) $ \mgr -> forever $+        E.bracketOnError (accept sock) (close . fst) $ \(conn, _peer) ->+            void $ forkFinally (runServer mgr conn) (const $ gclose conn)   where-    open addr = E.bracketOnError (initSocket addr) close $ \sock -> do-        listen sock 1024-        return sock-    loop mgr sock = forever $-        E.bracketOnError (accept sock) (close . fst) $-            \(conn, _peer) ->-                void $ forkFinally (server' mgr conn) (const $ gclose conn)-    server' mgr conn = do-        th <- T.registerKillThread mgr $ return ()-        server mgr th conn+    runServer mgr conn = do+        labelMe "TCP timeout server"+        T.withHandleKillThread mgr (return ()) $ \th -> server mgr th conn
Network/Run/UDP.hs view
@@ -9,6 +9,7 @@ import qualified Control.Exception as E import Control.Monad (forever, void) import Data.ByteString (ByteString)+import qualified Data.List.NonEmpty as NE import Network.Socket import Network.Socket.ByteString @@ -19,15 +20,15 @@ --   server's socket address. --   They should be used with 'sendTo'. runUDPClient :: HostName -> ServiceName -> (Socket -> SockAddr -> IO a) -> IO a-runUDPClient host port client = withSocketsDo $ do-    addr <- resolve Datagram (Just host) port [AI_ADDRCONFIG]+runUDPClient host port client = do+    addr <- resolve Datagram (Just host) port [AI_ADDRCONFIG] NE.head     let sockAddr = addrAddress addr     E.bracket (openSocket addr) close $ \sock -> client sock sockAddr  -- | Running a UDP server with an open socket in a single Haskell thread. runUDPServer :: Maybe HostName -> ServiceName -> (Socket -> IO a) -> IO a-runUDPServer mhost port server = withSocketsDo $ do-    addr <- resolve Datagram mhost port [AI_PASSIVE]+runUDPServer mhost port server = do+    addr <- resolve Datagram mhost port [AI_PASSIVE] NE.head     E.bracket (openServerSocket addr) close server  -- | Running a UDP server with a connected socket in each Haskell thread.@@ -46,19 +47,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 <- NE.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,30 +1,30 @@-name:                network-run-version:             0.3.1-synopsis:            Simple network runner library-description:         Simple functions to run network clients and servers.--- bug-reports:-license:             BSD3-license-file:        LICENSE-author:              Kazu Yamamoto-maintainer:          kazu@iij.ad.jp-category:            Network-build-type:          Simple-extra-source-files:  CHANGELOG.md-cabal-version:       >=1.10+cabal-version:      >=1.10+name:               network-run+version:            0.5.0+license:            BSD3+license-file:       LICENSE+maintainer:         kazu@iij.ad.jp+author:             Kazu Yamamoto+synopsis:           Simple network runner library+description:        Simple functions to run network clients and servers.+category:           Network+build-type:         Simple+extra-source-files: CHANGELOG.md +source-repository head+    type:     git+    location: https://github.com/kazu-yamamoto/network-run+ library-  exposed-modules:     Network.Run.TCP-                       Network.Run.TCP.Timeout-                       Network.Run.UDP-  other-modules:       Network.Run.Core-  -- other-extensions:-  build-depends:       base >= 4 && < 5-                     , bytestring-                     , network >= 3.1.0-                     , time-manager-  -- hs-source-dirs:-  default-language:    Haskell2010+    exposed-modules:+        Network.Run.TCP+        Network.Run.TCP.Timeout+        Network.Run.UDP -source-repository head-  type:                git-  location:            https://github.com/kazu-yamamoto/network-run+    other-modules:    Network.Run.Core+    default-language: Haskell2010+    build-depends:+        base >=4 && <5,+        bytestring,+        network >=3.2.4,+        time-manager >=0.2 && <0.4