Implement a chat server
This page describes how to implement a simple chat server which can be connected to with telnet for basic chatting functionality. The server should support multiple connected users. Messages sent to the server are broadcast to all currently connected users. For this tutorial we'll use Network.Socket, which provides low-level bindings to the C-socket API.Ultimately, our cabal file will hinge on an
executable chat-server-exe hs-source-dirs: app main-is: Main.hs ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base, network default-language: Haskell2010
2 Simple socket serverWe start with a simple server. The structure of this server begins with a
-- in Main.hs module Main where import Network.Socket main :: IO () main = do sock <- socket AF_INET Stream 0 -- create socket setSocketOption sock ReuseAddr 1 -- make socket immediately reusable - eases debugging. bind sock (SockAddrInet 4242 iNADDR_ANY) -- listen on TCP port 4242. listen sock 2 -- set a max of 2 queued connections mainLoop sock -- unimplemented
In our main loop we'll build out the socket-server equivalent of a "Hello World!" example. For a given socket we'll: accept a connection, relay a simple "Hello World!", close the connection, and recurse on the original socket.
-- in Main.hs mainLoop :: Socket -> IO () mainLoop sock = do conn <- accept sock -- accept a connection and handle it runConn conn -- run our server's logic mainLoop sock -- repeat runConn :: (Socket, SockAddr) -> IO () runConn (sock, _) = do send sock "Hello!\n" close sock
Notice that accepting a socket has a return type of
3 Using System.IO for sockets
-- in the imports our Main.hs add: import System.IO -- and we'll change our `runConn` function to look like: runConn :: (Socket, SockAddr) -> IO () runConn (sock, _) = do hdl <- socketToHandle sock ReadWriteMode hSetBuffering hdl NoBuffering hPutStrLn hdl "Hello!" hClose hdl
So far the server can only handle one connection at a time. This is enough if all we want to do is have a read stream of messages, but it won't be enough if we want to have our server handle chat.Control.Concurrent is a library in Prelude which does an excellent job of lightweight thread creation and context switching. You are encouraged to check out the hackage page. To handle each user in our chat client, we'll use
forkIO :: IO () -> IO ThreadId
However, as we don't need the thread's id, we'll ignore the result.
-- add to our imports: import Control.Concurrent -- and in our mainLoop function... mainLoop sock = do conn <- accept sock forkIO (runConn conn) -- split off each connection into its own thread mainLoop sock
5 Adding communication between threadsWe'll need some way for two connections, which we've just split into separate threads, to communicate. At first, this might seem a hard problem — requiring us to manage our own event handler / pub-sub implementation as well as start to cover topics such as MVar, TVar, TMVar, and their use-cases. However, we'll let you delve into that at your own pace and will stick to using the
-- in Main.hs type Msg = String
First, let's import the module:
import Control.Concurrent.Chan -- at the top of Main.hs with the others
To ensure that all of our socket connections are running in the same channel, we'll have
main = do -- [...] chan <- newChan -- notice that newChan :: IO (Chan a) mainLoop sock chan -- pass it into the loop -- later, in mainLoop: mainLoop :: Socket -> Chan Msg -> IO () -- See how Chan now uses Msg. mainLoop sock chan = do conn <- accept sock forkIO (runConn conn chan) -- pass the channel to runConn mainLoop sock chan
At this point, we want to have
-- at the top of Main.hs import Control.Monad (liftM) import Control.Monad.Fix (fix)
runConn :: (Socket, SockAddr) -> Chan Msg -> IO () runConn (sock, _) chan = do let broadcast msg = writeChan chan msg hdl <- socketToHandle sock ReadWriteMode hSetBuffering hdl NoBuffering commLine <- dupChan chan -- fork off a thread for reading from the duplicated channel forkIO $ fix $ \loop -> do line <- readChan commLine hPutStrLn hdl line loop -- read lines from the socket and echo them back to the user fix $ \loop -> do line <- liftM init (hGetLine hdl) broadcast line loop
6 Cleanups and final code
There are two major problems left in the code. The first is the fact that the code has a memory leak because the original channel is never read by anyone. We can fix this by adding another thread just so that people have access to this channel.
The second issue is that we do not gracefully close our connections. This will require exception handling. Next we'll fix the first issue, handle the second case to a larger extend, and add the following cosmetic improvements:
- Make messages get echoed back to the user that sent them.
- Associate each connection with a name.
- Change to aliasMsgfor convience.(Int, String)
-- Main.hs, final code module Main where import Network.Socket import System.IO import Control.Exception import Control.Concurrent import Control.Concurrent.Chan import Control.Monad (liftM, when) import Control.Monad.Fix (fix) main :: IO () main = do sock <- socket AF_INET Stream 0 setSocketOption sock ReuseAddr 1 bind sock (SockAddrInet 4242 iNADDR_ANY) listen sock 2 chan <- newChan forkIO $ fix $ \loop -> do (_, msg) <- readChan chan loop mainLoop sock chan 0 type Msg = (Int, String) mainLoop :: Socket -> Chan Msg -> Int -> IO () mainLoop sock chan msgNum = do conn <- accept sock forkIO (runConn conn chan msgNum) mainLoop sock chan $! msgNum + 1 runConn :: (Socket, SockAddr) -> Chan Msg -> Int -> IO () runConn (sock, _) chan msgNum = do let broadcast msg = writeChan chan (msgNum, msg) hdl <- socketToHandle sock ReadWriteMode hSetBuffering hdl NoBuffering hPutStrLn hdl "Hi, what's your name?" name <- liftM init (hGetLine hdl) broadcast ("--> " ++ name ++ " entered chat.") hPutStrLn hdl ("Welcome, " ++ name ++ "!") commLine <- dupChan chan -- fork off a thread for reading from the duplicated channel reader <- forkIO $ fix $ \loop -> do (nextNum, line) <- readChan commLine when (msgNum /= nextNum) $ hPutStrLn hdl line loop handle (\(SomeException _) -> return ()) $ fix $ \loop -> do line <- liftM init (hGetLine hdl) case line of -- If an exception is caught, send a message and break the loop "quit" -> hPutStrLn hdl "Bye!" -- else, continue looping. _ -> broadcast (name ++ ": " ++ line) >> loop killThread reader -- kill after the loop ends broadcast ("<-- " ++ name ++ " left.") -- make a final broadcast hClose hdl -- close the handle
7 Run the server and connect with telnet
Now that we have a functional server, after building your executable and firing up the server we can start chatting! After running your server, connect to it with telnet like so:
$ telnet localhost 4242 Trying 127.0.0.1... Connected to localhost. Escape character is '^]'. Hi, what's your name?
Remember that to quit telnet, you need to
Fire up two clients and have fun chatting!