network-simple 0.1.0.1 → 0.2.0.0
raw patch · 4 files changed
+152/−79 lines, 4 files
Files
- examples/chat-tcp.hs +58/−0
- examples/echo-tcp.hs +31/−0
- network-simple.cabal +13/−4
- src/Network/Simple/TCP.hs +50/−75
+ examples/chat-tcp.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}++-- This is an example chat TCP server that listens on port 9000 and broadcast+-- incomming messages to every connected client.+-- Messages are treated as UTF-8 encoded text.++module Main (main) where++import Control.Concurrent.STM (STM, atomically)+import Control.Concurrent.STM.TChan (TChan, newTChanIO, writeTChan+ ,readTChan, dupTChan)+import Control.Concurrent (forkIO, killThread)+import Control.Exception (finally)+import Control.Monad (forever, when)+import Data.Char (isSpace)+import Data.Monoid ((<>))+import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import Network.Simple.TCP (listen, acceptFork)+import Network.Socket (Socket, SockAddr)+import Network.Socket.ByteString (recv, sendAll)+++main :: IO ()+main = do+ bchan <- newTChanIO :: IO (TChan T.Text)+ -- ^XXX we should really use 'newBroadcastTCHanIO' from STM-2.4+ listen "*" "9000" $ \(lsock, laddr) -> do+ putStrLn $ "Listening for TCP connections at " ++ show laddr+ forever . acceptFork lsock $ \(csock,caddr) -> do+ putStrLn $ "Accepted incoming connection from " ++ show caddr+ let talk s = writeTChan bchan $ T.pack (show caddr) <> " " <> s <> "\r\n"+ sendText = sendAll csock . encodeUtf8+ recvText = return . decodeUtf8 =<< recv csock 4096+ -- ^XXX we don't handle messages longer than 4096 bytes!+ atomically $ talk "joined."+ rochan <- atomically $ dupTChan bchan+ finally (handleClient talk rochan sendText recvText)+ (atomically $ talk "gone.")+ putStrLn $ "Closing connection from " ++ show caddr+++handleClient :: (T.Text -> STM ()) -- ^Broadcast a message to all chat users.+ -> TChan T.Text -- ^Incomming chat messages.+ -> (T.Text -> IO ()) -- ^Send text to the client.+ -> IO T.Text -- ^Receive text from the client.+ -> IO ()+handleClient talk inbox sendText recvText = do+ tid <- forkIO . forever $ atomically (readTChan inbox) >>= sendText+ fromClient+ killThread tid+ where+ fromClient = do+ t <- return . T.strip =<< recvText+ when (not (T.null t)) $ do+ atomically (talk $ "says: " <> t) >> fromClient++
+ examples/echo-tcp.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}++-- This is an example TCP server that listens on port 9000 and echoes+-- back to clients whatever they send. Incoming connections and handled+-- concurrently.++module Main (main) where++import Control.Concurrent (forkIO)+import Control.Monad+import qualified Data.ByteString.Char8 as B+import qualified Network.Simple.TCP as T+import Network.Socket.ByteString (recv, sendAll)+++main :: IO ()+main = do+ T.listen "*" "9000" $ \(lsock, laddr) -> do+ putStrLn $ "Listening for TCP connections at " ++ show laddr+ forever . T.acceptFork lsock $ \(csock, caddr) -> do+ putStrLn $ "Accepted incoming connection from " ++ show caddr+ echoloop csock++ where+ echoloop sock = do+ bs <- recv sock 4096+ when (not (B.null bs)) $ do+ sendAll sock bs+ echoloop sock++
network-simple.cabal view
@@ -1,7 +1,5 @@ name: network-simple-version: 0.1.0.1-synopsis: Simple network sockets usage patterns.-description: Simple network sockets usage patterns.+version: 0.2.0.0 homepage: https://github.com/k0001/network-simple bug-reports: https://github.com/k0001/network-simple/issues license: BSD3@@ -12,7 +10,18 @@ category: Network build-type: Simple cabal-version: >=1.8-extra-source-files: README.md PEOPLE+synopsis: Simple network sockets usage patterns.+description:+ Simple network sockets usage patterns.+ .+ See the @NEWS@ file in the source distribution to learn about any+ important changes between version.+extra-source-files:+ README.md+ PEOPLE+ examples/echo-tcp.hs+ examples/chat-tcp.hs+ source-repository head type: git
src/Network/Simple/TCP.hs view
@@ -9,31 +9,29 @@ -- Michael Snoyman. Copyright (c) 2011. See its licensing terms (BSD3) at: -- https://github.com/snoyberg/conduit/blob/master/network-conduit/LICENSE - module Network.Simple.TCP ( -- * Introduction to TCP networking -- $tcp-101 + -- * Client side+ -- $client-side+ connect+ -- * Server side -- $server-side- serve,- serveFork,+ , serve -- ** Listening- listen,+ , listen -- ** Accepting- accept,- acceptFork,-- -- * Client side- -- $client-side- connect,+ , accept+ , acceptFork -- * Low level support- bindSock,- connectSock,+ , bindSock+ , connectSock -- * Exports- HostPreference(..),+ , HostPreference(..) ) where import Control.Concurrent (ThreadId, forkIO)@@ -50,10 +48,11 @@ -- concepts you need to know about TCP sockets in order to make effective use of -- this module. ----- There's two ends in a single TCP connection: one is the TCP «server» and the--- other is the TCP «client». Each end is uniquely identified by an IP address--- and a TCP port pair, and each end knows the IP address and TCP port of the--- other end. Each end can send and receive data to and from the other end.+-- There are two ends in a single TCP connection: one is the TCP «server» and+-- the other is the TCP «client». Each end is uniquely identified by an IP+-- address and a TCP port pair, and each end knows the IP address and TCP port+-- of the other end. Each end can send and receive data to and from the other+-- end. -- -- A TCP server, once «bound» to a well-known IP address and TCP port, starts -- «listening» for incoming connections from TCP clients to such bound IP@@ -77,9 +76,6 @@ -- $client-side ----- The following functions allow you to obtain and use 'NS.Socket's useful to--- the client side of a TCP connection.--- -- Here's how you could run a TCP client: -- -- > connect "www.example.org" "80" $ \(connectionSocket, remoteAddr) -> do@@ -105,23 +101,40 @@ -- $server-side ----- The following functions allow you to obtain and use 'NS.Socket's useful to--- the server side of a TCP connection.------ Here's how you could run a TCP server that handles in different threads each+-- Here's how you can run a TCP server that handles in different threads each -- incoming connection to port @8000@ at IPv4 address @127.0.0.1@: ----- > listen (Host "127.0.0.1") "8000" $ \(listeningSocket, listeningAddr) -> do--- > putStrLn $ "Listening for incoming connections at " ++ show listeningAddr--- > forever . acceptFork listeningSocket $ \(connectionSocket, remoteAddr) -> do--- > putStrLn $ "Connection established from " ++ show remoteAddr--- > -- now you may use connectionSocket as you please within this scope.+-- > serve (Host "127.0.0.1") "8000" $ \(connectionSocket, remoteAddr) -> do+-- > putStrLn $ "TCP connection established from " ++ show remoteAddr+-- > -- now you may use connectionSocket as you please within this scope. ----- If you keep reading you'll discover there are different ways to achieve--- the same, some ways more general than others. The above one was just an--- example using a pretty general approach, you are encouraged to use simpler--- approaches such as 'serve' if those suit your needs.+-- If you need more control on the way your server runs, then you can use more+-- advanced functions such as 'listen', 'accept' and 'acceptFork'. +--------------------------------------------------------------------------------++-- | Start a TCP server that accepts incoming connections and handles them+-- concurrently in different threads.+--+-- Any acquired network resources are properly closed and discarded when done or+-- in case of exceptions.+--+-- Note: This function performs 'listen' and 'acceptFork', so you don't need to+-- perform those manually.+serve+ :: HostPreference -- ^Preferred host to bind.+ -> NS.ServiceName -- ^Service port to bind.+ -> ((NS.Socket, NS.SockAddr) -> IO ())+ -- ^Computation to run in a different thread+ -- once an incoming connection is accepted. Takes the+ -- connection socket and remote end address.+ -> IO ()+serve hp port k = do+ listen hp port $ \(lsock,_) -> do+ forever $ acceptFork lsock k++--------------------------------------------------------------------------------+ -- | Bind a TCP listening socket and use it. -- -- The listening socket is closed when done or in case of exceptions.@@ -147,45 +160,7 @@ NS.listen bsock $ max 2048 NS.maxListenQueue return x --- | Start a TCP server that sequentially accepts and uses each incoming--- connection.------ Both the listening and connection sockets are closed when done or in case of--- exceptions.------ Note: You don't need to use 'listen' nor 'accept' manually if you use this--- function.-serve- :: HostPreference -- ^Preferred host to bind.- -> NS.ServiceName -- ^Service port to bind.- -> ((NS.Socket, NS.SockAddr) -> IO r)- -- ^Computation to run once an incoming- -- connection is accepted. Takes the connection socket- -- and remote end address.- -> IO r-serve hp port k = do- listen hp port $ \(lsock,_) -> do- forever $ accept lsock k---- | Start a TCP server that accepts incoming connections and uses them--- concurrently in different threads.------ The listening and connection sockets are closed when done or in case of--- exceptions.------ Note: You don't need to use 'listen' nor 'acceptFork' manually if you use--- this function.-serveFork- :: HostPreference -- ^Preferred host to bind.- -> NS.ServiceName -- ^Service port to bind.- -> ((NS.Socket, NS.SockAddr) -> IO ())- -- ^Computation to run in a different thread- -- once an incoming connection is accepted. Takes the- -- connection socket and remote end address.- -> IO ()-serveFork hp port k = do- listen hp port $ \(lsock,_) -> do- forever $ acceptFork lsock k+-------------------------------------------------------------------------------- -- | Accept a single incoming connection and use it. --@@ -212,9 +187,9 @@ -- once an incoming connection is accepted. Takes the -- connection socket and remote end address. -> IO ThreadId-acceptFork lsock f = do- client@(csock,_) <- NS.accept lsock- forkIO $ E.finally (f client) (NS.sClose csock)+acceptFork lsock k = do+ conn@(csock,_) <- NS.accept lsock+ forkIO $ E.finally (k conn) (NS.sClose csock) {-# INLINABLE acceptFork #-} --------------------------------------------------------------------------------