network-run-0.2.6/0000755000000000000000000000000007346545000012203 5ustar0000000000000000network-run-0.2.6/CHANGELOG.md0000644000000000000000000000021707346545000014014 0ustar0000000000000000# Revision history for network-run ## 0.2.5 * Making accept breakable on windows [#2](https://github.com/kazu-yamamoto/network-run/pull/2) network-run-0.2.6/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.2.6/Network/Run/0000755000000000000000000000000007346545000014400 5ustar0000000000000000network-run-0.2.6/Network/Run/Core.hs0000644000000000000000000000210407346545000015621 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Network.Run.Core ( resolve, openSocket, openServerSocket, gclose, ) where import qualified Control.Exception as E import Network.Socket resolve :: SocketType -> Maybe HostName -> ServiceName -> Bool -> IO AddrInfo resolve socketType mhost port passive = head <$> getAddrInfo (Just hints) mhost (Just port) where hints = defaultHints { addrSocketType = socketType , addrFlags = if passive then [AI_PASSIVE] else [] } #if !MIN_VERSION_network(3,1,2) openSocket :: AddrInfo -> IO Socket openSocket addr = socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) #endif 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.6/Network/Run/TCP.hs0000644000000000000000000000244007346545000015362 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Simple functions to run TCP clients and servers. module Network.Run.TCP ( runTCPClient, runTCPServer, ) 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 False E.bracket (open addr) gclose client where open addr = E.bracketOnError (openSocket addr) close $ \sock -> do connect sock $ addrAddress addr return sock -- | 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 = withSocketsDo $ do addr <- resolve Stream mhost port True E.bracket (open addr) close loop where open addr = E.bracketOnError (openServerSocket 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.6/Network/Run/TCP/0000755000000000000000000000000007346545000015026 5ustar0000000000000000network-run-0.2.6/Network/Run/TCP/Timeout.hs0000644000000000000000000000256107346545000017014 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Simple functions to run TCP clients and servers. module Network.Run.TCP.Timeout ( runTCPServer, TimeoutServer, ) 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 tm mhost port server = withSocketsDo $ do T.withManager (tm * 1000000) $ \mgr -> do addr <- resolve Stream mhost port True E.bracket (open addr) close $ loop mgr where open addr = E.bracketOnError (openServerSocket 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.6/Network/Run/UDP.hs0000644000000000000000000000472007346545000015367 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 False 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 True 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.6/Setup.hs0000644000000000000000000000005707346545000013641 0ustar0000000000000000import Distribution.Simple main = defaultMain network-run-0.2.6/network-run.cabal0000644000000000000000000000171007346545000015461 0ustar0000000000000000name: network-run version: 0.2.6 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