diff --git a/Data/Conduit/Network.hs b/Data/Conduit/Network.hs deleted file mode 100644 --- a/Data/Conduit/Network.hs +++ /dev/null @@ -1,236 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE CPP #-} -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 - , runTCPServerWithHandle - , ConnectionHandle (..) - -- ** 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, newEmptyMVar, putMVar, takeMVar) - -import Data.Conduit.Network.Internal -import Data.Conduit.Network.Utils (HostPreference) -import qualified Data.Conduit.Network.Utils as Utils - -#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS) --- Socket recv and accept calls on Windows platform cannot be interrupted when compiled with -threaded. --- See https://ghc.haskell.org/trac/ghc/ticket/5797 for details. --- The following enables simple workaround -#define SOCKET_ACCEPT_RECV_WORKAROUND -#endif - - -safeRecv :: Socket -> Int -> IO S.ByteString -#ifndef SOCKET_ACCEPT_RECV_WORKAROUND -safeRecv = recv -#else -safeRecv s buf = do - var <- newEmptyMVar - forkIO $ recv s buf `catch` (\(_::IOException) -> return S.empty) >>= putMVar var - takeMVar var -#endif - - --- | 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 $ safeRecv 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 - } - - -data ConnectionHandle m = ConnectionHandle { getHandle :: Socket -> NS.SockAddr -> Maybe NS.SockAddr -> m () } - -runTCPServerWithHandle :: (MonadIO m, MonadBaseControl IO m) => ServerSettings m -> ConnectionHandle m -> m () -runTCPServerWithHandle (ServerSettings port host afterBind needLocalAddr) handle = 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 - handler = getHandle handle - app' run = run (handler socket addr mlocal) >> return () - appClose run = app' run `finally` NS.sClose socket - control $ \run -> forkIO (appClose run) >> run (return ()) - - - --- | 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 settings app = runTCPServerWithHandle settings (ConnectionHandle app') - where app' socket addr mlocal = - let ad = AppData - { appSource = sourceSocket socket - , appSink = sinkSocket socket - , appSockAddr = addr - , appLocalAddr = mlocal - } - in - app ad - --- | 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 -> (AppData m -> m a) -> m a -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 = -#ifndef SOCKET_ACCEPT_RECV_WORKAROUND - loop -#else - do var <- newEmptyMVar - forkIO $ loop >>= putMVar var - takeMVar var -#endif - where - loop = - NS.accept socket `catch` \(_ :: IOException) -> do - threadDelay 1000000 - loop diff --git a/Data/Conduit/Network/Internal.hs b/Data/Conduit/Network/Internal.hs deleted file mode 100644 --- a/Data/Conduit/Network/Internal.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# 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 - } diff --git a/Data/Conduit/Network/Internal/Unix.hs b/Data/Conduit/Network/Internal/Unix.hs deleted file mode 100644 --- a/Data/Conduit/Network/Internal/Unix.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# OPTIONS_HADDOCK not-home #-} -{-# LANGUAGE KindSignatures #-} -module Data.Conduit.Network.Internal.Unix - ( AppData (..) - , ServerSettings (..) - , ClientSettings (..) - ) where - -import Data.ByteString (ByteString) -import Network.Socket (Socket) -import Data.Conduit (Source, Sink) - --- | The data passed to a Unix domain sockets @Application@. --- --- Since 1.0.2 -data AppData m = AppData - { appSource :: Source m ByteString - , appSink :: Sink ByteString m () - } - --- | Settings for a Unix domain sockets server. --- --- Since 1.0.2 -data ServerSettings m = ServerSettings - { serverPath :: FilePath - , serverAfterBind :: Socket -> m () - } - --- | Settings for a Unix domain sockets client. --- --- Since 1.0.2 -data ClientSettings (m :: * -> *) = ClientSettings - { clientPath :: FilePath - } diff --git a/Data/Conduit/Network/UDP.hs b/Data/Conduit/Network/UDP.hs deleted file mode 100644 --- a/Data/Conduit/Network/UDP.hs +++ /dev/null @@ -1,101 +0,0 @@ -{-# 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 #-} diff --git a/Data/Conduit/Network/Unix.hs b/Data/Conduit/Network/Unix.hs deleted file mode 100644 --- a/Data/Conduit/Network/Unix.hs +++ /dev/null @@ -1,139 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -module Data.Conduit.Network.Unix - ( -- * Basic utilities - sourceSocket - , sinkSocket - -- * Simple server/client interface - , Application - , AppData - , appSource - , appSink - -- ** Server - , ServerSettings - , serverSettings - , serverPath - , serverAfterBind - , runUnixServer - -- ** Client - , ClientSettings - , clientSettings - , clientPath - , runUnixClient - -- * Helper utilities - , bindPath - , getSocket - , acceptSafe - ) where - -import Data.Conduit -import Network.Socket (Socket) -import qualified Network.Socket as NS -import Data.Conduit.Network (sourceSocket, sinkSocket, acceptSafe) -import Data.Conduit.Network.Internal.Unix (AppData(..), ClientSettings(..), ServerSettings(..)) -import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Exception (throwIO, SomeException, try, finally, bracket, - bracketOnError, catch) -import Control.Monad (forever, void) -import Control.Monad.Trans.Control (control) -import Control.Concurrent (forkIO) -import System.Directory (removeFile) -import System.IO.Error (isDoesNotExistError) - --- | Attempt to connect to the given Unix domain socket path. -getSocket :: FilePath -> IO Socket -getSocket path = do - sock <- NS.socket NS.AF_UNIX NS.Stream 0 - ee <- try' $ NS.connect sock (NS.SockAddrUnix path) - 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 Unix domain socket at the given path. --- --- Since 1.0.2 -bindPath :: FilePath -> IO Socket -bindPath path = do - sock <- bracketOnError - (NS.socket NS.AF_UNIX NS.Stream 0) - NS.sClose - (\sock -> do - removeFileSafe path -- Cannot bind if the socket file exists. - NS.bindSocket sock (NS.SockAddrUnix path) - return sock) - NS.listen sock (max 2048 NS.maxListenQueue) - return sock - -removeFileSafe :: FilePath -> IO () -removeFileSafe path = - removeFile path `Control.Exception.catch` handleExists - where - handleExists e - | isDoesNotExistError e = return () - | otherwise = throwIO e - --- | A simple Unix domain sockets application. --- --- Since 1.0.2 -type Application m = AppData m -> m () - --- | Smart constructor. --- --- Since 1.0.2 -serverSettings :: Monad m - => FilePath -- ^ path to bind to - -> ServerSettings m -serverSettings path = ServerSettings - { serverPath = path - , serverAfterBind = const $ return () - } - --- | 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 1.0.2 -runUnixServer :: (MonadIO m, MonadBaseControl IO m) => ServerSettings m -> Application m -> m () -runUnixServer (ServerSettings path afterBind) app = control $ \run -> bracket - (liftIO $ bindPath path) - (liftIO . NS.sClose) - (\socket -> run $ do - afterBind socket - forever $ serve socket) - where - serve lsocket = do - (socket, _) <- liftIO $ acceptSafe lsocket - let ad = AppData - { appSource = sourceSocket socket - , appSink = sinkSocket socket - } - app' run = void $ run (app ad) - appClose run = app' run `finally` NS.sClose socket - control $ \run -> forkIO (appClose run) >> run (return ()) - --- | Smart constructor. --- --- Since 1.0.2 -clientSettings :: Monad m - => FilePath -- ^ path to connect to - -> ClientSettings m -clientSettings path = ClientSettings - { clientPath = path - } - --- | Run an @Application@ by connecting to the specified server. --- --- Since 1.0.2 -runUnixClient :: (MonadIO m, MonadBaseControl IO m) => ClientSettings m -> Application m -> m () -runUnixClient (ClientSettings path) app = control $ \run -> bracket - (getSocket path) - NS.sClose - (\sock -> run $ app AppData - { appSource = sourceSocket sock - , appSink = sinkSocket sock - }) diff --git a/Data/Conduit/Network/Utils.hs b/Data/Conduit/Network/Utils.hs deleted file mode 100644 --- a/Data/Conduit/Network/Utils.hs +++ /dev/null @@ -1,122 +0,0 @@ -{-# 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@ --- --- * @!4@ means @HostIPv4Only@ --- --- * @*6@ means @HostIPv6@ --- --- * @!6@ means @HostIPv6Only@ -data HostPreference = - HostAny - | HostIPv4 - | HostIPv4Only - | HostIPv6 - | HostIPv6Only - | 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 "!4" = HostIPv4Only - fromString "*6" = HostIPv6 - fromString "!6" = HostIPv6Only - -} - fromString s'@('*':s) = - case s of - [] -> HostAny - ['4'] -> HostIPv4 - ['6'] -> HostIPv6 - _ -> Host s' - fromString s'@('!':s) = - case s of - ['4'] -> HostIPv4Only - ['6'] -> HostIPv6Only - _ -> 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 - HostIPv4Only -> addrs4 - HostIPv6 -> addrs6 ++ addrs4 - HostIPv6Only -> addrs6 - _ -> 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' diff --git a/network-conduit.cabal b/network-conduit.cabal --- a/network-conduit.cabal +++ b/network-conduit.cabal @@ -1,6 +1,6 @@ Name: network-conduit -Version: 1.0.4 -Synopsis: Stream socket data using conduits. +Version: 1.1.0 +Synopsis: Stream socket data using conduits. (deprecated) Description: Stream socket data using conduits. License: BSD3 License-file: LICENSE @@ -10,43 +10,10 @@ Build-type: Simple Cabal-version: >=1.8 Homepage: http://github.com/snoyberg/conduit -extra-source-files: test/main.hs -flag network-bytestring - default: False - description: Use the older network and network-bytestring split packages. - 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 - if !os(windows) - Exposed-modules: Data.Conduit.Network.Unix - , Data.Conduit.Network.Internal.Unix - Build-depends: directory >= 1.1 - 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 + , conduit >= 1.1 source-repository head type: git diff --git a/test/main.hs b/test/main.hs deleted file mode 100644 --- a/test/main.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# 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 ()