diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,7 @@ # network-simple +[![Build Status](https://secure.travis-ci.org/k0001/network-simple.png)](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. diff --git a/examples/chat-tcp.hs b/examples/chat-tcp.hs --- a/examples/chat-tcp.hs +++ b/examples/chat-tcp.hs @@ -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 () diff --git a/examples/echo-tcp.hs b/examples/echo-tcp.hs --- a/examples/echo-tcp.hs +++ b/examples/echo-tcp.hs @@ -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 () diff --git a/network-simple.cabal b/network-simple.cabal --- a/network-simple.cabal +++ b/network-simple.cabal @@ -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) diff --git a/src/Network/Simple/TCP.hs b/src/Network/Simple/TCP.hs --- a/src/Network/Simple/TCP.hs +++ b/src/Network/Simple/TCP.hs @@ -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 #-} --------------------------------------------------------------------------------