network-conduit 0.2.1.2 → 0.2.2
raw patch · 5 files changed
+276/−271 lines, 5 filessetup-changedPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Data.Conduit.Network: type ApplicationM m = Source m ByteString -> Sink ByteString m () -> ResourceT m ()
Files
- Data/Conduit/Network.hs +178/−173
- LICENSE +30/−30
- Setup.lhs +7/−7
- network-conduit.cabal +44/−44
- test/main.hs +17/−17
Data/Conduit/Network.hs view
@@ -1,173 +1,178 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}-module Data.Conduit.Network- ( -- * Basic utilities- sourceSocket- , sinkSocket- -- * Simple TCP server/client interface.- , Application- -- ** Server- , ServerSettings (..)- , runTCPServer- -- ** Client- , ClientSettings (..)- , runTCPClient- -- * Helper utilities- , bindPort- , getSocket- ) where--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 Control.Monad.IO.Class (liftIO)-import Control.Exception (bracketOnError, IOException, throwIO, SomeException, try)-import Control.Exception.Lifted (bracket)-import Control.Monad (forever)-import Control.Monad.Trans.Resource (register)-import Control.Concurrent.Lifted (fork)---- | Stream data from the socket.------ This function does /not/ automatically close the socket.------ Since 0.0.0-sourceSocket :: ResourceIO m => Socket -> Source m ByteString-sourceSocket socket =- src- where- src = Source pull close-- pull = do- bs <- liftIO (recv socket 4096)- return $ if S.null bs then Closed else Open src bs- close = return ()---- | Stream data to the socket.------ This function does /not/ automatically close the socket.------ Since 0.0.0-sinkSocket :: ResourceIO m => Socket -> Sink ByteString m ()-sinkSocket socket =- SinkData push close- where- push bs = do- liftIO (sendAll socket bs)- return (Processing push close)- close = return ()---- | A simple TCP application. It takes two arguments: the @Source@ to read--- input data from, and the @Sink@ to send output data to.------ Since 0.2.1-type Application = Source IO ByteString- -> Sink ByteString IO ()- -> ResourceT IO ()---- | Same as @Application@, but allows an arbitrary inner monad.-type ApplicationM m = Source m ByteString- -> Sink ByteString m ()- -> ResourceT m ()---- | Settings for a TCP server. It takes a port to listen on, and an optional--- hostname to bind to.------ Since 0.2.1-data ServerSettings = ServerSettings- { serverPort :: Int- , serverHost :: Maybe String -- ^ 'Nothing' indicates no preference- }---- | 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.2.1-runTCPServer :: (Base m ~ IO, ResourceIO m) => ServerSettings -> ApplicationM m -> m ()-runTCPServer (ServerSettings port host) app = bracket- (liftIO $ bindPort host port)- (liftIO . NS.sClose)- (forever . serve)- where- serve lsocket = do- (socket, _addr) <- liftIO $ NS.accept lsocket- fork $ runResourceT $ do- _ <- register $ NS.sClose socket- app (sourceSocket socket) (sinkSocket socket)---- | Settings for a TCP client, specifying how to connect to the server.-data ClientSettings = ClientSettings- { clientPort :: Int- , clientHost :: String- }---- | Run an @Application@ by connecting to the specified server.------ Since 0.2.1-runTCPClient :: ResourceIO m => ClientSettings -> ApplicationM m -> m ()-runTCPClient (ClientSettings port host) app = bracket- (liftIO $ getSocket host port)- (liftIO . NS.sClose)- (\s -> runResourceT $ app (sourceSocket s) (sinkSocket s))---- | Attempt to connect to the given host/port.------ Since 0.2.1-getSocket :: String -> Int -> IO NS.Socket-getSocket host' port' = do- let hints = NS.defaultHints {- NS.addrFlags = [NS.AI_ADDRCONFIG]- , NS.addrSocketType = NS.Stream- }- (addr:_) <- NS.getAddrInfo (Just hints) (Just host') (Just $ show port')- sock <- NS.socket (NS.addrFamily addr) (NS.addrSocketType addr)- (NS.addrProtocol addr)- ee <- try' $ NS.connect sock (NS.addrAddress addr)- case ee of- Left e -> NS.sClose sock >> throwIO e- Right () -> return sock- 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.------ Since 0.2.1-bindPort :: Maybe String -> Int -> IO Socket-bindPort host p = do- let hints = NS.defaultHints- { NS.addrFlags =- [ NS.AI_PASSIVE- , NS.AI_NUMERICSERV- , NS.AI_NUMERICHOST- ]- , NS.addrSocketType = NS.Stream- }- port = Just . show $ p- addrs <- NS.getAddrInfo (Just hints) host port- let- tryAddrs (addr1:rest@(_:_)) =- catch- (theBody addr1)- (\(_ :: IOException) -> tryAddrs rest)- tryAddrs (addr1:[]) = theBody addr1- tryAddrs _ = error "bindPort: addrs is empty"- theBody addr =- bracketOnError- (NS.socket- (NS.addrFamily addr)- (NS.addrSocketType addr)- (NS.addrProtocol addr))- NS.sClose- (\sock -> do- NS.setSocketOption sock NS.ReuseAddr 1- NS.bindSocket sock (NS.addrAddress addr)- NS.listen sock NS.maxListenQueue- return sock- )- tryAddrs addrs+{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +module Data.Conduit.Network + ( -- * Basic utilities + sourceSocket + , sinkSocket + -- * Simple TCP server/client interface. + , Application + , ApplicationM + -- ** Server + , ServerSettings (..) + , runTCPServer + -- ** Client + , ClientSettings (..) + , runTCPClient + -- * Helper utilities + , bindPort + , getSocket + ) where + +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 Control.Monad.IO.Class (liftIO) +import Control.Exception (bracketOnError, IOException, throwIO, SomeException, try) +import Control.Exception.Lifted (bracket) +import Control.Monad (forever) +import Control.Monad.Trans.Resource (register) +import Control.Concurrent.Lifted (fork) + +-- | Stream data from the socket. +-- +-- This function does /not/ automatically close the socket. +-- +-- Since 0.0.0 +sourceSocket :: ResourceIO m => Socket -> Source m ByteString +sourceSocket socket = + src + where + src = Source pull close + + pull = do + bs <- liftIO (recv socket 4096) + return $ if S.null bs then Closed else Open src bs + close = return () + +-- | Stream data to the socket. +-- +-- This function does /not/ automatically close the socket. +-- +-- Since 0.0.0 +sinkSocket :: ResourceIO m => Socket -> Sink ByteString m () +sinkSocket socket = + SinkData push close + where + push bs = do + liftIO (sendAll socket bs) + return (Processing push close) + close = return () + +-- | A simple TCP application. It takes two arguments: the @Source@ to read +-- input data from, and the @Sink@ to send output data to. +-- +-- Since 0.2.1 +type Application = Source IO ByteString + -> Sink ByteString IO () + -> ResourceT IO () + +-- | Same as @Application@, but allows an arbitrary inner monad. +-- +-- Since 0.2.2 +type ApplicationM m = Source m ByteString + -> Sink ByteString m () + -> ResourceT m () + +-- | Settings for a TCP server. It takes a port to listen on, and an optional +-- hostname to bind to. +-- +-- Since 0.2.1 +data ServerSettings = ServerSettings + { serverPort :: Int + , serverHost :: Maybe String -- ^ 'Nothing' indicates no preference + } + +-- | 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.2.1 +runTCPServer :: (Base m ~ IO, ResourceIO m) => ServerSettings -> ApplicationM m -> m () +runTCPServer (ServerSettings port host) app = bracket + (liftIO $ bindPort host port) + (liftIO . NS.sClose) + (forever . serve) + where + serve lsocket = do + (socket, _addr) <- liftIO $ NS.accept lsocket + fork $ runResourceT $ do + _ <- register $ NS.sClose socket + app (sourceSocket socket) (sinkSocket socket) + +-- | Settings for a TCP client, specifying how to connect to the server. +-- +-- Since 0.2.1 +data ClientSettings = ClientSettings + { clientPort :: Int + , clientHost :: String + } + +-- | Run an @Application@ by connecting to the specified server. +-- +-- Since 0.2.1 +runTCPClient :: ResourceIO m => ClientSettings -> ApplicationM m -> m () +runTCPClient (ClientSettings port host) app = bracket + (liftIO $ getSocket host port) + (liftIO . NS.sClose) + (\s -> runResourceT $ app (sourceSocket s) (sinkSocket s)) + +-- | Attempt to connect to the given host/port. +-- +-- Since 0.2.1 +getSocket :: String -> Int -> IO NS.Socket +getSocket host' port' = do + let hints = NS.defaultHints { + NS.addrFlags = [NS.AI_ADDRCONFIG] + , NS.addrSocketType = NS.Stream + } + (addr:_) <- NS.getAddrInfo (Just hints) (Just host') (Just $ show port') + sock <- NS.socket (NS.addrFamily addr) (NS.addrSocketType addr) + (NS.addrProtocol addr) + ee <- try' $ NS.connect sock (NS.addrAddress addr) + case ee of + Left e -> NS.sClose sock >> throwIO e + Right () -> return sock + 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. +-- +-- Since 0.2.1 +bindPort :: Maybe String -> Int -> IO Socket +bindPort host p = do + let hints = NS.defaultHints + { NS.addrFlags = + [ NS.AI_PASSIVE + , NS.AI_NUMERICSERV + , NS.AI_NUMERICHOST + ] + , NS.addrSocketType = NS.Stream + } + port = Just . show $ p + addrs <- NS.getAddrInfo (Just hints) host port + let + tryAddrs (addr1:rest@(_:_)) = + catch + (theBody addr1) + (\(_ :: IOException) -> tryAddrs rest) + tryAddrs (addr1:[]) = theBody addr1 + tryAddrs _ = error "bindPort: addrs is empty" + theBody addr = + bracketOnError + (NS.socket + (NS.addrFamily addr) + (NS.addrSocketType addr) + (NS.addrProtocol addr)) + NS.sClose + (\sock -> do + NS.setSocketOption sock NS.ReuseAddr 1 + NS.bindSocket sock (NS.addrAddress addr) + NS.listen sock NS.maxListenQueue + return sock + ) + tryAddrs addrs
LICENSE view
@@ -1,30 +1,30 @@-Copyright (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.+Copyright (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.
Setup.lhs view
@@ -1,7 +1,7 @@-#!/usr/bin/env runhaskell--> module Main where-> import Distribution.Simple--> main :: IO ()-> main = defaultMain+#!/usr/bin/env runhaskell + +> module Main where +> import Distribution.Simple + +> main :: IO () +> main = defaultMain
network-conduit.cabal view
@@ -1,44 +1,44 @@-Name: network-conduit-Version: 0.2.1.2-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- Build-depends: base >= 4 && < 5- , transformers >= 0.2.2 && < 0.3- , bytestring >= 0.9- , conduit >= 0.2 && < 0.3- , lifted-base >= 0.1 && < 0.2- 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 && < 2.4- 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+Name: network-conduit +Version: 0.2.2 +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 + Build-depends: base >= 4 && < 5 + , transformers >= 0.2.2 && < 0.3 + , bytestring >= 0.9 + , conduit >= 0.2 && < 0.3 + , lifted-base >= 0.1 && < 0.2 + 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 && < 2.4 + 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
test/main.hs view
@@ -1,17 +1,17 @@-import Data.Conduit-import Data.Conduit.Network-import Control.Concurrent (forkIO, threadDelay)-import Control.Monad (replicateM_)--main :: IO ()-main = do- _ <- forkIO $ runTCPServer (ServerSettings 4000 Nothing) echo- threadDelay 1000- replicateM_ 10000- $ runTCPClient (ClientSettings 4000 "localhost") doNothing--echo :: Application-echo src sink = src $$ sink--doNothing :: Application-doNothing _ _ = return ()+import Data.Conduit +import Data.Conduit.Network +import Control.Concurrent (forkIO, threadDelay) +import Control.Monad (replicateM_) + +main :: IO () +main = do + _ <- forkIO $ runTCPServer (ServerSettings 4000 Nothing) echo + threadDelay 1000 + replicateM_ 10000 + $ runTCPClient (ClientSettings 4000 "localhost") doNothing + +echo :: Application +echo src sink = src $$ sink + +doNothing :: Application +doNothing _ _ = return ()