network-simple 0.2.1.0 → 0.3.0
raw patch · 5 files changed
+106/−101 lines, 5 filesdep +exceptionsdep +transformers
Dependencies added: exceptions, transformers
Files
- README.md +2/−0
- examples/chat-tcp.hs +14/−16
- examples/echo-tcp.hs +8/−11
- network-simple.cabal +9/−5
- src/Network/Simple/TCP.hs +73/−69
README.md view
@@ -1,5 +1,7 @@ # network-simple +[](http://travis-ci.org/k0001/network-simple)+ Haskell library abstracring over simple network sockets usage patterns. Currently, only TCP sockets are supported. Support for UDP and Unix sockets is planned for future versions.
examples/chat-tcp.hs view
@@ -11,28 +11,26 @@ ,readTChan, dupTChan) import Control.Concurrent (forkIO, killThread) import Control.Exception (finally)-import Control.Monad (forever, when)+import Control.Monad (forever, when, liftM) 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, withSocketsDo)-import Network.Socket (Socket, SockAddr)-import Network.Socket.ByteString (recv, sendAll)+import Network.Simple.TCP as S main :: IO ()-main = withSocketsDo $ do+main = S.withSocketsDo $ do bchan <- newTChanIO :: IO (TChan T.Text) -- ^XXX we should really use 'newBroadcastTCHanIO' from STM-2.4- listen "*" "9000" $ \(lsock, laddr) -> do+ S.listen "*" "9000" $ \(lsock, laddr) -> do putStrLn $ "Listening for TCP connections at " ++ show laddr- forever . acceptFork lsock $ \(csock,caddr) -> do+ forever . S.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!+ sendText = S.send csock . encodeUtf8+ recvText = fmap decodeUtf8 `liftM` S.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)@@ -43,7 +41,7 @@ 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 (Maybe T.Text) -- ^Receive text from the client. -> IO () handleClient talk inbox sendText recvText = do tid <- forkIO . forever $ atomically (readTChan inbox) >>= sendText@@ -51,8 +49,8 @@ killThread tid where fromClient = do- t <- return . T.strip =<< recvText- when (not (T.null t)) $ do- atomically (talk $ "says: " <> t) >> fromClient--+ mt <- recvText+ case fmap T.strip mt of+ Just t | not (T.null t) ->+ atomically (talk $ "says: " <> t) >> fromClient+ _ -> return ()
examples/echo-tcp.hs view
@@ -9,23 +9,20 @@ 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)+import qualified Network.Simple.TCP as S main :: IO ()-main = T.withSocketsDo $ do- T.listen "*" "9000" $ \(lsock, laddr) -> do+main = S.withSocketsDo $ do+ S.listen "*" "9000" $ \(lsock, laddr) -> do putStrLn $ "Listening for TCP connections at " ++ show laddr- forever . T.acceptFork lsock $ \(csock, caddr) -> do+ forever . S.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--+ mbs <- S.recv sock 4096+ case mbs of+ Just bs -> S.send sock bs >> echoloop sock+ Nothing -> return ()
network-simple.cabal view
@@ -1,5 +1,5 @@ name: network-simple-version: 0.2.1.0+version: 0.3.0 homepage: https://github.com/k0001/network-simple bug-reports: https://github.com/k0001/network-simple/issues license: BSD3@@ -12,7 +12,8 @@ cabal-version: >=1.8 synopsis: Simple network sockets usage patterns. description:- Simple network sockets usage patterns.+ This module exports functions that abstract simple network socket+ usage patterns. . See the @NEWS@ file in the source distribution to learn about any important changes between version.@@ -31,6 +32,9 @@ hs-source-dirs: src exposed-modules: Network.Simple.TCP other-modules: Network.Simple.Internal- build-depends: base (>=4.5 && < 5)- , network (>=2.3 && <2.5)- , bytestring (>=0.9.2.1 && <0.11)+ build-depends: base (>=4.5 && < 5)+ , network (>=2.3 && <2.5)+ , bytestring (>=0.9.2.1 && <0.11)+ , transformers (>=0.2 && <0.4)+ -- Packages not in The Haskell Platform+ , exceptions (>=0.3 && <0.4)
src/Network/Simple/TCP.hs view
@@ -1,5 +1,12 @@+{-# LANGUAGE CPP #-}+ -- | This module exports functions that abstract simple TCP 'NS.Socket' -- usage patterns.+--+-- This module uses 'MonadIO' and 'C.MonadCatch' extensively so that you can+-- reuse these functions in monads other than 'IO'. However, if you don't care+-- about any of that, just pretend you are using the 'IO' monad all the time+-- and everything will work as expected. -- Some code in this file was adapted from the @pipes-network@ library by -- Renzo Carbonara. Copyright (c) 2012-2013. See its licensing terms (BSD3) at:@@ -33,23 +40,30 @@ -- * Low level support , bindSock , connectSock+ , closeSock -- * Note to Windows users- -- $windows-users , NS.withSocketsDo -- * Types , HostPreference(..)+ -- ** Re-exported from @Network.Socket@+ , NS.HostName+ , NS.ServiceName+ , NS.Socket+ , NS.SockAddr ) where import Control.Concurrent (ThreadId, forkIO) import qualified Control.Exception as E+import qualified Control.Monad.Catch as C import Control.Monad+import Control.Monad.IO.Class (MonadIO(liftIO)) import qualified Data.ByteString as BS import Data.List (partition) import qualified Network.Socket as NS import Network.Simple.Internal-import qualified Network.Socket.ByteString+import qualified Network.Socket.ByteString as NSB -------------------------------------------------------------------------------- -- $tcp-101@@ -84,40 +98,12 @@ -------------------------------------------------------------------------------- --- $windows-users------ If you are running Windows, then you /must/ call 'NS.withSocketsDo', just--- once, right at the beginning of your program. That is, change your program's--- 'main' function from:------ @--- main = do--- print \"Hello world\"--- -- rest of the program...--- @------ To:------ @--- main = 'NS.withSocketsDo' $ do--- print \"Hello world\"--- -- rest of the program...--- @------ If you don't do this, your networking code won't work and you will get many--- unexpected errors at runtime. If you use an operating system other than--- Windows then you don't need to do this, but it is harmless to do it, so it's--- recommended that you do for portability reasons.------------------------------------------------------------------------------------ -- $client-side -- -- Here's how you could run a TCP client: -- -- @--- 'connect' \"www.example.org\" \"80\" $ \(connectionSocket, remoteAddr) -> do+-- 'connect' \"www.example.org\" \"80\" $ \\(connectionSocket, remoteAddr) -> do -- putStrLn $ \"Connection established to \" ++ show remoteAddr -- -- Now you may use connectionSocket as you please within this scope, -- -- possibly using 'recv' and 'send' to interact with the remote end.@@ -128,15 +114,17 @@ -- The connection socket is closed when done or in case of exceptions. -- -- If you prefer to acquire and close the socket yourself, then use--- 'connectSock' and the 'NS.sClose' function from "Network.Socket" instead.+-- 'connectSock' and 'closeSock'. connect- :: NS.HostName -- ^Server hostname.+ :: (MonadIO m, C.MonadCatch m)+ => NS.HostName -- ^Server hostname. -> NS.ServiceName -- ^Server service port.- -> ((NS.Socket, NS.SockAddr) -> IO r)+ -> ((NS.Socket, NS.SockAddr) -> m r) -- ^Computation taking the communication socket -- and the server address.- -> IO r-connect host port = E.bracket (connectSock host port) (NS.sClose . fst)+ -> m r+connect host port = C.bracket (connectSock host port)+ (closeSock . fst) -------------------------------------------------------------------------------- @@ -146,7 +134,7 @@ -- incoming connection to port @8000@ at IPv4 address @127.0.0.1@: -- -- @--- 'serve' ('Host' \"127.0.0.1\") \"8000\" $ \(connectionSocket, remoteAddr) -> do+-- '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, -- -- possibly using 'recv' and 'send' to interact with the remote end.@@ -166,14 +154,15 @@ -- Note: This function performs 'listen' and 'acceptFork', so you don't need to -- perform those manually. serve- :: HostPreference -- ^Preferred host to bind.+ :: MonadIO m+ => 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+ -> m ()+serve hp port k = liftIO $ do listen hp port $ \(lsock,_) -> do forever $ acceptFork lsock k @@ -183,25 +172,25 @@ -- -- The listening socket is closed when done or in case of exceptions. ----- If you prefer to acquire and close the socket yourself, then use--- 'bindSock' and the 'NS.listen' and 'NS.sClose' functions from--- "Network.Socket" instead.+-- If you prefer to acquire and close the socket yourself, then use 'bindSock',+-- 'closeSock' and the 'NS.listen' function from "Network.Socket" instead. -- -- Note: 'N.maxListenQueue' is tipically 128, which is too small for high -- performance servers. So, we use the maximum between 'N.maxListenQueue' and -- 2048 as the default size of the listening queue. The 'NS.NoDelay' and -- 'NS.ReuseAddr' options are set on the socket. listen- :: HostPreference -- ^Preferred host to bind.+ :: (MonadIO m, C.MonadCatch m)+ => HostPreference -- ^Preferred host to bind. -> NS.ServiceName -- ^Service port to bind.- -> ((NS.Socket, NS.SockAddr) -> IO r)+ -> ((NS.Socket, NS.SockAddr) -> m r) -- ^Computation taking the listening socket and -- the address it's bound to.- -> IO r-listen hp port = E.bracket listen' (NS.sClose . fst)+ -> m r+listen hp port = C.bracket listen' (closeSock . fst) where listen' = do x@(bsock,_) <- bindSock hp port- NS.listen bsock $ max 2048 NS.maxListenQueue+ liftIO . NS.listen bsock $ max 2048 NS.maxListenQueue return x --------------------------------------------------------------------------------@@ -210,31 +199,33 @@ -- -- The connection socket is closed when done or in case of exceptions. accept- :: NS.Socket -- ^Listening and bound socket.- -> ((NS.Socket, NS.SockAddr) -> IO b)+ :: (MonadIO m, C.MonadCatch m)+ => NS.Socket -- ^Listening and bound socket.+ -> ((NS.Socket, NS.SockAddr) -> m r) -- ^Computation to run once an incoming -- connection is accepted. Takes the connection socket -- and remote end address.- -> IO b+ -> m r accept lsock k = do- conn@(csock,_) <- NS.accept lsock- E.finally (k conn) (NS.sClose csock)+ conn@(csock,_) <- liftIO (NS.accept lsock)+ C.finally (k conn) (closeSock csock) {-# INLINABLE accept #-} -- | Accept a single incoming connection and use it in a different thread. -- -- The connection socket is closed when done or in case of exceptions. acceptFork- :: NS.Socket -- ^Listening and bound socket.+ :: MonadIO m+ => NS.Socket -- ^Listening and bound socket. -> ((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 ThreadId-acceptFork lsock k = do+ -> m ThreadId+acceptFork lsock k = liftIO $ do conn@(csock,_) <- NS.accept lsock forkFinally (k conn)- (\ea -> do NS.sClose csock+ (\ea -> do closeSock csock either E.throwIO return ea) {-# INLINABLE acceptFork #-} @@ -242,17 +233,18 @@ -- | Obtain a 'NS.Socket' connected to the given host and TCP service port. ----- The obtained 'NS.Socket' should be closed manually using 'NS.sClose' when+-- The obtained 'NS.Socket' should be closed manually using 'closeSock' when -- it's not needed anymore, otherwise you risk having the socket open for much -- longer than needed. -- -- Prefer to use 'connect' if you will be using the socket within a limited -- scope and would like it to be closed immediately after its usage or in case -- of exceptions.-connectSock :: NS.HostName -> NS.ServiceName -> IO (NS.Socket, NS.SockAddr)-connectSock host port = do+connectSock :: MonadIO m+ => NS.HostName -> NS.ServiceName -> m (NS.Socket, NS.SockAddr)+connectSock host port = liftIO $ do (addr:_) <- NS.getAddrInfo (Just hints) (Just host) (Just port)- E.bracketOnError (newSocket addr) NS.sClose $ \sock -> do+ E.bracketOnError (newSocket addr) closeSock $ \sock -> do let sockAddr = NS.addrAddress addr NS.connect sock sockAddr return (sock, sockAddr)@@ -262,14 +254,15 @@ -- | Obtain a 'NS.Socket' bound to the given host name and TCP service port. ----- The obtained 'NS.Socket' should be closed manually using 'NS.sClose' when+-- The obtained 'NS.Socket' should be closed manually using 'closeSock' when -- it's not needed anymore. -- -- Prefer to use 'listen' if you will be listening on this socket and using it -- within a limited scope, and would like it to be closed immediately after its -- usage or in case of exceptions.-bindSock :: HostPreference -> NS.ServiceName -> IO (NS.Socket, NS.SockAddr)-bindSock hp port = do+bindSock :: MonadIO m+ => HostPreference -> NS.ServiceName -> m (NS.Socket, NS.SockAddr)+bindSock hp port = liftIO $ do addrs <- NS.getAddrInfo (Just hints) (hpHostName hp) (Just port) let addrs' = case hp of HostIPv4 -> prioritize isIPv4addr addrs@@ -285,13 +278,24 @@ tryAddrs (x:xs) = E.catch (useAddr x) (\e -> let _ = e :: E.IOException in tryAddrs xs) - useAddr addr = E.bracketOnError (newSocket addr) NS.sClose $ \sock -> do+ useAddr addr = E.bracketOnError (newSocket addr) closeSock $ \sock -> do let sockAddr = NS.addrAddress addr NS.setSocketOption sock NS.NoDelay 1 NS.setSocketOption sock NS.ReuseAddr 1 NS.bindSocket sock sockAddr return (sock, sockAddr) ++-- | Close the 'NS.Socket'.+closeSock :: MonadIO m => NS.Socket -> m ()+closeSock = liftIO .+#if MIN_VERSION_network(2,4,0)+ NS.close+#else+ NS.sClose+#endif+{-# INLINE closeSock #-}+ -------------------------------------------------------------------------------- -- Utils @@ -299,17 +303,17 @@ -- -- Returns `Nothing` if the remote end closed the connection or end-of-input was -- reached. The number of returned bytes might be less than the specified limit.-recv :: NS.Socket -> Int -> IO (Maybe BS.ByteString)+recv :: MonadIO m => NS.Socket -> Int -> m (Maybe BS.ByteString) recv sock nbytes = do- bs <- Network.Socket.ByteString.recv sock nbytes+ bs <- liftIO (NSB.recv sock nbytes) if BS.null bs then return Nothing else return (Just bs) {-# INLINE recv #-} -- | Writes the given bytes to the socket.-send :: NS.Socket -> BS.ByteString -> IO ()-send = Network.Socket.ByteString.sendAll+send :: MonadIO m => NS.Socket -> BS.ByteString -> m ()+send sock = \bs -> liftIO (NSB.sendAll sock bs) {-# INLINE send #-} --------------------------------------------------------------------------------