Difference between revisions of "Implement a chat server"

From HaskellWiki
Jump to: navigation, search
m (update to introduction, use bind instead of depreciated bindSocket)
(Elaborated on first section of implementing a chat server. Updated some depreciated methods)
Line 4: Line 4:
 
This page describes how to implement a simple chat server. 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 [https://hackage.haskell.org/package/network-2.6.2.1/docs/Network-Socket.html Network.Socket], which provides low-level bindings to the C-socket API.
 
This page describes how to implement a simple chat server. 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 [https://hackage.haskell.org/package/network-2.6.2.1/docs/Network-Socket.html Network.Socket], which provides low-level bindings to the C-socket API.
   
== Trivial server ==
+
== Simple socket server ==
We start with a trivial server.
+
We start with a simple server. The structure of this server begins with a <hask>main</hask> method which will create a reusable socket, open up a TCP connection on port 4242 which will allow a maximum of two queued connections.
  +
 
<haskell>
 
<haskell>
  +
-- in ChatServer.hs
  +
 
import Network.Socket
 
import Network.Socket
   
 
main :: IO ()
 
main :: IO ()
 
main = do
 
main = do
-- create socket
+
sock <- socket AF_INET Stream 0 -- create socket
sock <- socket AF_INET Stream 0
+
setSocketOption sock ReuseAddr 1 -- make socket immediately reusable - eases debugging.
-- make socket immediately reusable - eases debugging.
+
bind sock (SockAddrInet 4242 iNADDR_ANY) -- listen on TCP port 4242.
setSocketOption sock ReuseAddr 1
+
listen sock 2 -- set a max of 2 queued connections
-- listen on TCP port 4242
+
mainLoop sock -- unimplemented
bind sock (SockAddrInet 4242 iNADDR_ANY)
+
-- allow a maximum of 2 outstanding connections
+
</haskell>
listen sock 2
+
mainLoop sock
+
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.
  +
  +
<haskell>
  +
-- in ChatServer.hs
   
 
mainLoop :: Socket -> IO ()
 
mainLoop :: Socket -> IO ()
 
mainLoop sock = do
 
mainLoop sock = do
-- accept one connection and handle it
+
conn <- accept sock -- accept a connection and handle it
conn <- accept sock
+
runConn conn -- run our server's logic
runConn conn
+
mainLoop sock -- repeat
mainLoop sock
 
   
 
runConn :: (Socket, SockAddr) -> IO ()
 
runConn :: (Socket, SockAddr) -> IO ()
 
runConn (sock, _) = do
 
runConn (sock, _) = do
send sock "Hi!\n"
+
send sock "Hello!\n"
sClose sock
+
close sock
 
</haskell>
 
</haskell>
   
This server creates a socket for listening on port 4242, and sends a single
 
  +
line to everyone who connects.
 
  +
Notice that accepting a socket has a return type of <hask>(Socket, SockAddr)</hask> — this corresponds to a new socket object which can be used to send and receive data for a given connection. This socket object is then closed at the end of our <hask>runConn</hask> method.
  +
  +
The <hask>SockAddr</hask>, as you can see from the <hask>runConn</hask> method, is largely uninteresting for this use-case and will simply be the initial socket address of 4242.
   
 
== Using System.IO for sockets ==
 
== Using System.IO for sockets ==

Revision as of 06:51, 4 February 2016

Introduction

This page describes how to implement a simple chat server. 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.

Simple socket server

We start with a simple server. The structure of this server begins with a main method which will create a reusable socket, open up a TCP connection on port 4242 which will allow a maximum of two queued connections.

-- in ChatServer.hs

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 ChatServer.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 (Socket, SockAddr) — this corresponds to a new socket object which can be used to send and receive data for a given connection. This socket object is then closed at the end of our runConn method.

The SockAddr, as you can see from the runConn method, is largely uninteresting for this use-case and will simply be the initial socket address of 4242.

Using System.IO for sockets

System.IO functions for input and output are much more convenient than those that Network.Socket provides. We can turn a Socket into a Handle as follows:

import System.IO
[...]
runConn (sock, _) = do
    hdl <- socketToHandle sock ReadWriteMode
    hSetBuffering hdl NoBuffering
    hPutStrLn hdl "Hi!"
    hClose hdl

Concurrency

So far the server can only handle one connection at a time. This is ok for just writing a message but won't work for a chat server. We can fix this quite easily though, using forkIO:

import Control.Concurrent
[...]
mainLoop sock = do
    conn <- accept sock
    forkIO (runConn conn)
    mainLoop sock

Adding communication between threads

This seems to be a hard problem. Luckily, the Control.Concurrent.Chan module provides exactly what we need: channels with a single write and multiple read ends. First we decide on a message type. Let's use a string for now:

type Msg = String

main will have to create a channel, and pass it to mainLoop.

import Control.Concurrent.Chan
[...]
main = do
    [...]
    chan <- newChan
    mainLoop sock chan

mainLoop in turn will pass it to runConn.

mainLoop :: Socket -> Chan Msg -> IO ()
mainLoop sock chan = do
    conn <- accept sock
    forkIO (runConn conn chan)
    mainLoop sock chan

And finally, runConn will duplicate the channel and read from it.

import Control.Monad
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
    chan' <- dupChan chan
    -- fork off thread for reading from the duplicated channel
    forkIO $ fix $ \loop -> do
        line <- readChan chan'
        hPutStrLn hdl line
        loop
    -- read lines from socket and echo them back to the user
    fix $ \loop -> do
        line <- liftM init (hGetLine hdl) 
        broadcast line
        loop

Note that runConn now actually forks another worker thread for sending messages to the connected user.

Cleanups and final code

Screenshot :)

There are two major problems left in the code. First, the code has a memory leak, because the original channel is never read by anyone. This can be fixed by adding another thread just for that purpose.

Secondly, closing connections is not handled gracefully at all. This requires exception handling.

The code below fixes the first issue and mostly fixes the second one, and adds a few cosmetic improvements:

  • messages are not echoed back to the user they came from.
  • every connection is associated with a name.
-- with apologies for the lack of comments :)

import Network.Socket
import System.IO
import Control.Exception
import Control.Concurrent
import Control.Concurrent.Chan
import Control.Monad
import Control.Monad.Fix (fix)

type Msg = (Int, String)

main :: IO ()
main = do
    chan <- newChan
    sock <- socket AF_INET Stream 0
    setSocketOption sock ReuseAddr 1
    bind sock (SockAddrInet 4242 iNADDR_ANY)
    listen sock 2
    forkIO $ fix $ \loop -> do
        (_, msg) <- readChan chan
        loop
    mainLoop sock chan 0

mainLoop :: Socket -> Chan Msg -> Int -> IO ()
mainLoop sock chan nr = do
    conn <- accept sock
    forkIO (runConn conn chan nr)
    mainLoop sock chan $! nr+1

runConn :: (Socket, SockAddr) -> Chan Msg -> Int -> IO ()
runConn (sock, _) chan nr = do
    let broadcast msg = writeChan chan (nr, msg)
    hdl <- socketToHandle sock ReadWriteMode
    hSetBuffering hdl NoBuffering
    hPutStrLn hdl "Hi, what's your name?"
    name <- liftM init (hGetLine hdl)
    broadcast ("--> " ++ name ++ " entered.")
    hPutStrLn hdl ("Welcome, " ++ name ++ "!")
    chan' <- dupChan chan
    reader <- forkIO $ fix $ \loop -> do
        (nr', line) <- readChan chan'
        when (nr /= nr') $ hPutStrLn hdl line
        loop
    handle (\(SomeException _) -> return ()) $ fix $ \loop -> do
        line <- liftM init (hGetLine hdl)
        case line of
         "quit" -> hPutStrLn hdl "Bye!"
         _      -> do
            broadcast (name ++ ": " ++ line)
            loop
    killThread reader
    broadcast ("<-- " ++ name ++ " left.")
    hClose hdl

Have fun chatting!