network-run-0.4.4/0000755000000000000000000000000007346545000012203 5ustar0000000000000000network-run-0.4.4/CHANGELOG.md0000644000000000000000000000237307346545000014021 0ustar0000000000000000# Revision history for network-run ## 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 [#5](https://github.com/kazu-yamamoto/network-run/pull/5) ## 0.3.0 * Specifying IPv6Only [#4](https://github.com/kazu-yamamoto/network-run/pull/4) ## 0.2.8 * runTCPClient specifies AI_ADDRCONFIG. ## 0.2.7 * Introduce `runTCPServerWithSocket` [#3](https://github.com/kazu-yamamoto/network-run/pull/3) ## 0.2.6 * Adding the Network.Run.TCP.Timeout module. ## 0.2.5 * Making accept breakable on windows [#2](https://github.com/kazu-yamamoto/network-run/pull/2) network-run-0.4.4/LICENSE0000644000000000000000000000276507346545000013222 0ustar0000000000000000Copyright (c) 2019, IIJ Innovation Institute Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. network-run-0.4.4/Network/Run/0000755000000000000000000000000007346545000014400 5ustar0000000000000000network-run-0.4.4/Network/Run/Core.hs0000644000000000000000000001136507346545000015632 0ustar0000000000000000{-# LANGUAGE CPP #-} 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 :: SocketType -> Maybe HostName -> ServiceName -> [AddrInfoFlag] -> (NonEmpty AddrInfo -> AddrInfo) -> IO AddrInfo resolve socketType mhost port flags select = select <$> getAddrInfo (Just hints) mhost (Just port) where hints = defaultHints { addrSocketType = socketType , addrFlags = flags } #if !MIN_VERSION_network(3,1,2) openSocket :: AddrInfo -> IO Socket openSocket addr = socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) #endif -- | This is the same as -- -- @ -- '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' '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 -- -- 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 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 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-0.4.4/Network/Run/TCP.hs0000644000000000000000000000541507346545000015367 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | Simple functions to run TCP clients and servers. module Network.Run.TCP ( -- * Server runTCPServer, runTCPServerWithSocket, 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 server with an accepted socket and its peer name. runTCPServer :: Maybe HostName -> ServiceName -> (Socket -> IO a) -> IO a 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) ---------------------------------------------------------------- -- | 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) -> IO a runTCPClientWithSettings Settings{..} host port client = do addr <- resolve Stream (Just host) port [AI_ADDRCONFIG] settingsSelectAddrInfo E.bracket (settingsOpenClientSocket addr) close client network-run-0.4.4/Network/Run/TCP/0000755000000000000000000000000007346545000015026 5ustar0000000000000000network-run-0.4.4/Network/Run/TCP/Timeout.hs0000644000000000000000000000325307346545000017013 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Simple functions to run TCP clients and servers. module Network.Run.TCP.Timeout ( runTCPServer, TimeoutServer, -- * Generalized API runTCPServerWithSocket, 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 import Network.Run.Core -- | A server type type TimeoutServer a = T.Manager -- ^ A global timeout manager -> T.Handle -- ^ A thread-local timeout handler -> Socket -- ^ A connected socket -> IO a -- | Running a TCP server with a connected socket. runTCPServer :: Int -- ^ Timeout in second. -> Maybe HostName -> ServiceName -> TimeoutServer a -> IO a 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 -- | Running a TCP client with a connected socket for a given listen -- socket. runTCPServerWithSocket :: Int -- ^ Timeout in second. -> Socket -> TimeoutServer a -> IO a runTCPServerWithSocket tm sock server = do T.withManager (tm * 1000000) $ \mgr -> forever $ E.bracketOnError (accept sock) (close . fst) $ \(conn, _peer) -> void $ forkFinally (server' mgr conn) (const $ gclose conn) where server' mgr conn = do labelMe "TCP timeout server" T.withHandle mgr (return ()) $ \th -> server mgr th conn network-run-0.4.4/Network/Run/UDP.hs0000644000000000000000000000520707346545000015370 0ustar0000000000000000-- | Simple functions to run UDP clients and servers. module Network.Run.UDP ( runUDPClient, runUDPServer, runUDPServerFork, ) where import Control.Concurrent (forkFinally, forkIO) 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 import Network.Run.Core -- | Running a UDP client with a socket. -- The client action takes a socket and -- server's socket address. -- They should be used with 'sendTo'. runUDPClient :: HostName -> ServiceName -> (Socket -> SockAddr -> IO a) -> IO a 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 = 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. -- The first request is given to the server. -- Suppose that the server is serving on __addrS:portS__ and -- a client connects to the service from __addrC:portC__. -- A connected socket is created by binding to __*:portS__ and -- connecting to __addrC:portC__, -- resulting in __(UDP,addrS:portS,addrC:portC)__ where -- __addrS__ is given magically. -- This approach is fragile due to NAT rebidings. runUDPServerFork :: [HostName] -> ServiceName -> (Socket -> ByteString -> IO ()) -> IO () runUDPServerFork [] _ _ = return () runUDPServerFork (h : hs) port server = do mapM_ (forkIO . run) hs run h where 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-0.4.4/Setup.hs0000644000000000000000000000005707346545000013641 0ustar0000000000000000import Distribution.Simple main = defaultMain network-run-0.4.4/network-run.cabal0000644000000000000000000000147207346545000015466 0ustar0000000000000000cabal-version: >=1.10 name: network-run version: 0.4.4 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 default-language: Haskell2010 build-depends: base >=4 && <5, bytestring, network >=3.2.4, time-manager >=0.2 && <0.3