network-run-0.2.8/0000755000000000000000000000000007346545000012205 5ustar0000000000000000network-run-0.2.8/CHANGELOG.md0000644000000000000000000000054607346545000014023 0ustar0000000000000000# Revision history for network-run ## 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.2.8/LICENSE0000644000000000000000000000276507346545000013224 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.2.8/Network/Run/0000755000000000000000000000000007346545000014402 5ustar0000000000000000network-run-0.2.8/Network/Run/Core.hs0000644000000000000000000000271107346545000015627 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Network.Run.Core ( resolve, openSocket, openClientSocket, openServerSocket, gclose, ) where import qualified Control.Exception as E import Network.Socket resolve :: SocketType -> Maybe HostName -> ServiceName -> [AddrInfoFlag] -> IO AddrInfo resolve socketType mhost port flags = head <$> 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 openClientSocket :: AddrInfo -> IO Socket openClientSocket ai = do sock <- openSocket ai connect sock $ addrAddress ai return sock -- | Open socket for server use -- -- 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 setSocketOption sock ReuseAddr 1 withFdSocket sock $ setCloseOnExecIfNeeded bind sock $ addrAddress addr return sock gclose :: Socket -> IO () #if MIN_VERSION_network(3,1,1) gclose sock = gracefulClose sock 5000 #else gclose = close #endif network-run-0.2.8/Network/Run/TCP.hs0000644000000000000000000000355507346545000015374 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Simple functions to run TCP clients and servers. module Network.Run.TCP ( runTCPClient, runTCPServer, -- * Generalized API runTCPServerWithSocket, openServerSocket, ) where import Control.Concurrent (forkFinally) import qualified Control.Exception as E import Control.Monad (forever, void) 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) gclose 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 ---------------------------------------------------------------- -- 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 -> 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) network-run-0.2.8/Network/Run/TCP/0000755000000000000000000000000007346545000015030 5ustar0000000000000000network-run-0.2.8/Network/Run/TCP/Timeout.hs0000644000000000000000000000362407346545000017017 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Simple functions to run TCP clients and servers. module Network.Run.TCP.Timeout ( runTCPServer, TimeoutServer, -- * Generalized API runTCPServerWithSocket, openClientSocket, openServerSocket, ) where import Control.Concurrent (forkFinally) import qualified Control.Exception as E import Control.Monad (forever, void) 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 an accepted socket and its peer name. runTCPServer :: Int -- ^ Timeout in second. -> Maybe HostName -> ServiceName -> TimeoutServer a -> IO a runTCPServer = runTCPServerWithSocket openServerSocket ---------------------------------------------------------------- -- Generalized API -- | Generalization of 'runTCPServer' -- -- See 'Network.Run.TCP.runTCPServerWithSocket' for additional discussion. runTCPServerWithSocket :: (AddrInfo -> IO Socket) -> 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 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 network-run-0.2.8/Network/Run/UDP.hs0000644000000000000000000000474207346545000015375 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 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 = withSocketsDo $ do addr <- resolve Datagram (Just host) port [AI_ADDRCONFIG] 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] 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 = 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) network-run-0.2.8/Setup.hs0000644000000000000000000000005707346545000013643 0ustar0000000000000000import Distribution.Simple main = defaultMain network-run-0.2.8/network-run.cabal0000644000000000000000000000171007346545000015463 0ustar0000000000000000name: network-run version: 0.2.8 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 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 source-repository head type: git location: https://github.com/kazu-yamamoto/network-run