network-conduit-1.0.0/0000755000000000000000000000000012110322706013024 5ustar0000000000000000network-conduit-1.0.0/LICENSE0000644000000000000000000000276712110322706014045 0ustar0000000000000000Copyright (c)2011, Michael Snoyman 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 Michael Snoyman nor the names of other 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-conduit-1.0.0/network-conduit.cabal0000644000000000000000000000330312110322706017143 0ustar0000000000000000Name: network-conduit Version: 1.0.0 Synopsis: Stream socket data using conduits. Description: Stream socket data using conduits. License: BSD3 License-file: LICENSE Author: Michael Snoyman Maintainer: michael@snoyman.com Category: Data, Conduit, Network Build-type: Simple Cabal-version: >=1.8 Homepage: http://github.com/snoyberg/conduit extra-source-files: test/main.hs flag network-bytestring default: False Library Exposed-modules: Data.Conduit.Network , Data.Conduit.Network.UDP , Data.Conduit.Network.Internal other-modules: Data.Conduit.Network.Utils Build-depends: base >= 4 && < 5 , transformers >= 0.2.2 && < 0.4 , bytestring >= 0.9 , conduit >= 1.0 && < 1.1 , lifted-base >= 0.1 , monad-control >= 0.3 && < 0.4 if flag(network-bytestring) build-depends: network >= 2.2.1 && < 2.2.3 , network-bytestring >= 0.1.3 && < 0.1.4 else build-depends: network >= 2.3 ghc-options: -Wall test-suite test hs-source-dirs: test main-is: main.hs type: exitcode-stdio-1.0 cpp-options: -DTEST build-depends: conduit , base , network-conduit ghc-options: -Wall -threaded source-repository head type: git location: git://github.com/snoyberg/conduit.git network-conduit-1.0.0/Setup.lhs0000644000000000000000000000016212110322706014633 0ustar0000000000000000#!/usr/bin/env runhaskell > module Main where > import Distribution.Simple > main :: IO () > main = defaultMain network-conduit-1.0.0/test/0000755000000000000000000000000012110322706014003 5ustar0000000000000000network-conduit-1.0.0/test/main.hs0000644000000000000000000000074112110322706015265 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} import Data.Conduit import Data.Conduit.Network import Control.Concurrent (forkIO, threadDelay) import Control.Monad (replicateM_) main :: IO () main = do _ <- forkIO $ runTCPServer (serverSettings 4009 "*4") echo threadDelay 1000000 replicateM_ 10000 $ runTCPClient (clientSettings 4009 "127.0.0.1") doNothing echo :: Application IO echo ad = appSource ad $$ appSink ad doNothing :: Application IO doNothing _ = return () network-conduit-1.0.0/Data/0000755000000000000000000000000012110322706013675 5ustar0000000000000000network-conduit-1.0.0/Data/Conduit/0000755000000000000000000000000012110322706015302 5ustar0000000000000000network-conduit-1.0.0/Data/Conduit/Network.hs0000644000000000000000000001353612110322706017277 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} module Data.Conduit.Network ( -- * Basic utilities sourceSocket , sinkSocket -- * Simple TCP server/client interface. , Application , AppData , appSource , appSink , appSockAddr , appLocalAddr -- ** Server , ServerSettings , serverSettings , serverPort , serverHost , serverAfterBind , serverNeedLocalAddr , runTCPServer -- ** Client , ClientSettings , clientSettings , clientPort , clientHost , runTCPClient -- * Helper utilities , HostPreference (..) , bindPort , getSocket , acceptSafe ) where import Prelude hiding (catch) import Data.Conduit import qualified Network.Socket as NS import Network.Socket (Socket) import Network.Socket.ByteString (sendAll, recv) import Data.ByteString (ByteString) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Exception (throwIO, SomeException, try, finally, bracket, IOException, catch) import Control.Monad (forever) import Control.Monad.Trans.Control (MonadBaseControl, control) import Control.Monad.Trans.Class (lift) import Control.Concurrent (forkIO, threadDelay) import Data.Conduit.Network.Internal import Data.Conduit.Network.Utils (HostPreference) import qualified Data.Conduit.Network.Utils as Utils -- | Stream data from the socket. -- -- This function does /not/ automatically close the socket. -- -- Since 0.0.0 sourceSocket :: MonadIO m => Socket -> Producer m ByteString sourceSocket socket = loop where loop = do bs <- lift $ liftIO $ recv socket 4096 if S.null bs then return () else yield bs >> loop -- | Stream data to the socket. -- -- This function does /not/ automatically close the socket. -- -- Since 0.0.0 sinkSocket :: MonadIO m => Socket -> Consumer ByteString m () sinkSocket socket = loop where loop = await >>= maybe (return ()) (\bs -> lift (liftIO $ sendAll socket bs) >> loop) -- | A simple TCP application. -- -- Since 0.6.0 type Application m = AppData m -> m () -- | Smart constructor. -- -- Since 0.6.0 serverSettings :: Monad m => Int -- ^ port to bind to -> HostPreference -- ^ host binding preferences -> ServerSettings m serverSettings port host = ServerSettings { serverPort = port , serverHost = host , serverAfterBind = const $ return () , serverNeedLocalAddr = False } -- | Run an @Application@ with the given settings. This function will create a -- new listening socket, accept connections on it, and spawn a new thread for -- each connection. -- -- Since 0.6.0 runTCPServer :: (MonadIO m, MonadBaseControl IO m) => ServerSettings m -> Application m -> m () runTCPServer (ServerSettings port host afterBind needLocalAddr) app = control $ \run -> bracket (liftIO $ bindPort port host) (liftIO . NS.sClose) (\socket -> run $ do afterBind socket forever $ serve socket) where serve lsocket = do (socket, addr) <- liftIO $ acceptSafe lsocket mlocal <- if needLocalAddr then fmap Just $ liftIO (NS.getSocketName socket) else return Nothing let ad = AppData { appSource = sourceSocket socket , appSink = sinkSocket socket , appSockAddr = addr , appLocalAddr = mlocal } app' run = run (app ad) >> return () appClose run = app' run `finally` NS.sClose socket control $ \run -> forkIO (appClose run) >> run (return ()) -- | Smart constructor. -- -- Since 0.6.0 clientSettings :: Monad m => Int -- ^ port to connect to -> ByteString -- ^ host to connect to -> ClientSettings m clientSettings port host = ClientSettings { clientPort = port , clientHost = host } -- | Run an @Application@ by connecting to the specified server. -- -- Since 0.6.0 runTCPClient :: (MonadIO m, MonadBaseControl IO m) => ClientSettings m -> Application m -> m () runTCPClient (ClientSettings port host) app = control $ \run -> bracket (getSocket host port) (NS.sClose . fst) (\(s, address) -> run $ app AppData { appSource = sourceSocket s , appSink = sinkSocket s , appSockAddr = address , appLocalAddr = Nothing }) -- | Attempt to connect to the given host/port. -- -- Since 0.6.0 getSocket :: ByteString -> Int -> IO (NS.Socket, NS.SockAddr) getSocket host' port' = do (sock, addr) <- Utils.getSocket (S8.unpack host') port' NS.Stream ee <- try' $ NS.connect sock (NS.addrAddress addr) case ee of Left e -> NS.sClose sock >> throwIO e Right () -> return (sock, NS.addrAddress addr) where try' :: IO a -> IO (Either SomeException a) try' = try -- | Attempt to bind a listening @Socket@ on the given host/port. If no host is -- given, will use the first address available. -- 'maxListenQueue' is topically 128 which is too short for -- high performance servers. So, we specify 'max 2048 maxListenQueue' to -- the listen queue. -- -- Since 0.3.0 bindPort :: Int -> HostPreference -> IO Socket bindPort p s = do sock <- Utils.bindPort p s NS.Stream NS.listen sock (max 2048 NS.maxListenQueue) return sock -- | Try to accept a connection, recovering automatically from exceptions. -- -- As reported by Kazu against Warp, "resource exhausted (Too many open files)" -- may be thrown by accept(). This function will catch that exception, wait a -- second, and then try again. -- -- Since 0.6.0 acceptSafe :: Socket -> IO (Socket, NS.SockAddr) acceptSafe socket = loop where loop = NS.accept socket `catch` \(_ :: IOException) -> do threadDelay 1000000 loop network-conduit-1.0.0/Data/Conduit/Network/0000755000000000000000000000000012110322706016733 5ustar0000000000000000network-conduit-1.0.0/Data/Conduit/Network/Utils.hs0000644000000000000000000000716712110322706020402 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} module Data.Conduit.Network.Utils ( -- * Helper utilities HostPreference (..) , bindPort , getSocket ) where import Network.Socket (AddrInfo, Socket, SocketType) import qualified Network.Socket as NS import Data.String (IsString (fromString)) import Control.Exception (bracketOnError, IOException) import qualified Control.Exception as E -- | Attempt to connect to the given host/port using given @SocketType@. getSocket :: String -> Int -> SocketType -> IO (Socket, AddrInfo) getSocket host' port' sockettype = do let hints = NS.defaultHints { NS.addrFlags = [NS.AI_ADDRCONFIG] , NS.addrSocketType = sockettype } (addr:_) <- NS.getAddrInfo (Just hints) (Just host') (Just $ show port') sock <- NS.socket (NS.addrFamily addr) (NS.addrSocketType addr) (NS.addrProtocol addr) return (sock, addr) -- | Which host to bind. -- -- Note: The @IsString@ instance recognizes the following special values: -- -- * @*@ means @HostAny@ -- -- * @*4@ means @HostIPv4@ -- -- * @*6@ means @HostIPv6@ data HostPreference = HostAny | HostIPv4 | HostIPv6 | Host String deriving (Eq, Ord, Show, Read) instance IsString HostPreference where -- The funny code coming up is to get around some irritating warnings from -- GHC. I should be able to just write: {- fromString "*" = HostAny fromString "*4" = HostIPv4 fromString "*6" = HostIPv6 -} fromString s'@('*':s) = case s of [] -> HostAny ['4'] -> HostIPv4 ['6'] -> HostIPv6 _ -> Host s' fromString s = Host s -- | Attempt to bind a listening @Socket@ on the given host/port using given -- @SocketType@. If no host is given, will use the first address available. bindPort :: Int -> HostPreference -> SocketType -> IO Socket bindPort p s sockettype = do let hints = NS.defaultHints { NS.addrFlags = [ NS.AI_PASSIVE , NS.AI_NUMERICSERV , NS.AI_NUMERICHOST ] , NS.addrSocketType = sockettype } host = case s of Host s' -> Just s' _ -> Nothing port = Just . show $ p addrs <- NS.getAddrInfo (Just hints) host port -- Choose an IPv6 socket if exists. This ensures the socket can -- handle both IPv4 and IPv6 if v6only is false. let addrs4 = filter (\x -> NS.addrFamily x /= NS.AF_INET6) addrs addrs6 = filter (\x -> NS.addrFamily x == NS.AF_INET6) addrs addrs' = case s of HostIPv4 -> addrs4 ++ addrs6 HostIPv6 -> addrs6 ++ addrs4 _ -> addrs tryAddrs (addr1:rest@(_:_)) = E.catch (theBody addr1) (\(_ :: IOException) -> tryAddrs rest) tryAddrs (addr1:[]) = theBody addr1 tryAddrs _ = error "bindPort: addrs is empty" sockOpts = case sockettype of NS.Datagram -> [(NS.ReuseAddr,1)] _ -> [(NS.NoDelay,1), (NS.ReuseAddr,1)] theBody addr = bracketOnError (NS.socket (NS.addrFamily addr) (NS.addrSocketType addr) (NS.addrProtocol addr)) NS.sClose (\sock -> do mapM_ (\(opt,v) -> NS.setSocketOption sock opt v) sockOpts NS.bindSocket sock (NS.addrAddress addr) return sock ) tryAddrs addrs' network-conduit-1.0.0/Data/Conduit/Network/Internal.hs0000644000000000000000000000210012110322706021034 0ustar0000000000000000{-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE KindSignatures #-} module Data.Conduit.Network.Internal ( AppData (..) , ServerSettings (..) , ClientSettings (..) ) where import Data.ByteString (ByteString) import Network.Socket (Socket, SockAddr) import Data.Conduit (Source, Sink) import Data.Conduit.Network.Utils (HostPreference) -- | The data passed to an @Application@. -- -- Since 0.6.0 data AppData m = AppData { appSource :: Source m ByteString , appSink :: Sink ByteString m () , appSockAddr :: SockAddr , appLocalAddr :: Maybe SockAddr } -- | Settings for a TCP server. It takes a port to listen on, and an optional -- hostname to bind to. -- -- Since 0.6.0 data ServerSettings m = ServerSettings { serverPort :: Int , serverHost :: HostPreference , serverAfterBind :: Socket -> m () , serverNeedLocalAddr :: Bool } -- | Settings for a TCP client, specifying how to connect to the server. -- -- Since 0.6.0 data ClientSettings (m :: * -> *) = ClientSettings { clientPort :: Int , clientHost :: ByteString } network-conduit-1.0.0/Data/Conduit/Network/UDP.hs0000644000000000000000000000700412110322706017720 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} module Data.Conduit.Network.UDP ( -- * UDP message representation Message (..) -- * Basic utilities , sourceSocket , sinkSocket , sinkAllSocket , sinkToSocket , sinkAllToSocket -- * Helper Utilities , HostPreference (..) , bindPort , getSocket ) where import Data.Conduit import Network.Socket (AddrInfo, SockAddr, Socket) import qualified Network.Socket as NS import Network.Socket.ByteString (recvFrom, send, sendAll, sendTo, sendAllTo) import Data.ByteString (ByteString) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad (void) import Control.Monad.Trans.Class (lift) import Data.Conduit.Network.Utils (HostPreference) import qualified Data.Conduit.Network.Utils as Utils -- | Representation of a single message data Message = Message { msgData :: {-# UNPACK #-} !ByteString , msgSender :: !SockAddr } -- | Stream messages from the socket. -- -- The given @len@ defines the maximum packet size. Every produced item -- contains the message payload and the origin address. -- -- This function does /not/ automatically close the socket. sourceSocket :: MonadIO m => Socket -> Int -> Producer m Message sourceSocket socket len = loop where loop = do (bs, addr) <- lift $ liftIO $ recvFrom socket len yield (Message bs addr) >> loop -- | Stream messages to the connected socket. -- -- The payload is sent using @send@, so some of it might be lost. -- -- This function does /not/ automatically close the socket. sinkSocket :: MonadIO m => Socket -> Consumer ByteString m () sinkSocket = sinkSocketHelper (\sock bs -> void $ send sock bs) -- | Stream messages to the connected socket. -- -- The payload is sent using @sendAll@, so it might end up in multiple packets. -- -- This function does /not/ automatically close the socket. sinkAllSocket :: MonadIO m => Socket -> Consumer ByteString m () sinkAllSocket = sinkSocketHelper sendAll -- | Stream messages to the socket. -- -- Every handled item contains the message payload and the destination -- address. The payload is sent using @sendTo@, so some of it might be -- lost. -- -- This function does /not/ automatically close the socket. sinkToSocket :: MonadIO m => Socket -> Consumer Message m () sinkToSocket = sinkSocketHelper (\sock (Message bs addr) -> void $ sendTo sock bs addr) -- | Stream messages to the socket. -- -- Every handled item contains the message payload and the destination -- address. The payload is sent using @sendAllTo@, so it might end up in -- multiple packets. -- -- This function does /not/ automatically close the socket. sinkAllToSocket :: MonadIO m => Socket -> Consumer Message m () sinkAllToSocket = sinkSocketHelper (\sock (Message bs addr) -> sendAllTo sock bs addr) -- | Attempt to connect to the given host/port. getSocket :: String -> Int -> IO (Socket, AddrInfo) getSocket host' port' = Utils.getSocket host' port' NS.Datagram -- | Attempt to bind a listening @Socket@ on the given host/port. If no host is -- given, will use the first address available. bindPort :: Int -> HostPreference -> IO Socket bindPort p s = Utils.bindPort p s NS.Datagram -- Internal sinkSocketHelper :: MonadIO m => (Socket -> a -> IO ()) -> Socket -> Consumer a m () sinkSocketHelper act socket = loop where loop = await >>= maybe (return ()) (\a -> lift (liftIO $ act socket a) >> loop) {-# INLINE sinkSocketHelper #-}