Difference between revisions of "Implement a chat server"
m (Import Network.Socket.ByteString for the function send and change some codes) |
m (Removed excessive line breaks) |
||
Line 104: | Line 104: | ||
Notice that this datatype has a [https://en.wikipedia.org/wiki/Kind_%28type_theory%29 kind] of <hask>* -> *</hask>. To make this datatype concrete, we'll need to decide on a message type. This can be anything serializable, so to keep things simple we'll use <hask>String</hask> and create a type alias of <hask>Msg</hask> to make things a little more semantic. |
Notice that this datatype has a [https://en.wikipedia.org/wiki/Kind_%28type_theory%29 kind] of <hask>* -> *</hask>. To make this datatype concrete, we'll need to decide on a message type. This can be anything serializable, so to keep things simple we'll use <hask>String</hask> and create a type alias of <hask>Msg</hask> to make things a little more semantic. |
||
− | |||
<haskell> |
<haskell> |
||
Line 110: | Line 109: | ||
type Msg = String |
type Msg = String |
||
</haskell> |
</haskell> |
||
− | |||
We do not need to explicitly import the module because it is imported by <hask>Control.Concurrent</hask>. To ensure that all of our socket connections are running in the same channel, we'll have <hask>main</hask> create it and pass it to <hask>mainLoop</hask> which will, in turn, pass the channel to each thread in <hask>runConn</hask>. We'll adjust our code as follows: |
We do not need to explicitly import the module because it is imported by <hask>Control.Concurrent</hask>. To ensure that all of our socket connections are running in the same channel, we'll have <hask>main</hask> create it and pass it to <hask>mainLoop</hask> which will, in turn, pass the channel to each thread in <hask>runConn</hask>. We'll adjust our code as follows: |
||
− | |||
<haskell> |
<haskell> |
||
Line 129: | Line 126: | ||
mainLoop sock chan |
mainLoop sock chan |
||
</haskell> |
</haskell> |
||
− | |||
At this point, we want to have <hask>runConn</hask> duplicate the channel in order to communicate with it. First, we'll need a couple of helpers, [https://hackage.haskell.org/package/base-4.10.0.0/docs/Prelude.html#v:fmap fmap] and [https://hackage.haskell.org/package/base-4.8.2.0/docs/Control-Monad-Fix.html fix]. In short, <hask>fmap</hask> allows us to elegantly lift a function over some structure, while <hask>fix</hask> allows us to define a Monadic fixpoint. |
At this point, we want to have <hask>runConn</hask> duplicate the channel in order to communicate with it. First, we'll need a couple of helpers, [https://hackage.haskell.org/package/base-4.10.0.0/docs/Prelude.html#v:fmap fmap] and [https://hackage.haskell.org/package/base-4.8.2.0/docs/Control-Monad-Fix.html fix]. In short, <hask>fmap</hask> allows us to elegantly lift a function over some structure, while <hask>fix</hask> allows us to define a Monadic fixpoint. |
||
− | |||
<haskell> |
<haskell> |
||
Line 175: | Line 170: | ||
We'll import <hask>Control.Exception</hask> and handle exceptions in our final code, below: |
We'll import <hask>Control.Exception</hask> and handle exceptions in our final code, below: |
||
− | |||
<haskell> |
<haskell> |
||
Line 252: | Line 246: | ||
Hi, what's your name? |
Hi, what's your name? |
||
</haskell> |
</haskell> |
||
− | |||
Remember that to quit telnet, you need to <hask>^]</hask> and run <hask>quit</hask> after dropping into the telnet prompt. |
Remember that to quit telnet, you need to <hask>^]</hask> and run <hask>quit</hask> after dropping into the telnet prompt. |
Revision as of 09:59, 10 April 2024
Introduction
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
section which might look like the following:
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
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 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 0) -- 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
{-# LANGUAGE OverloadedStrings #-}
import Network.Socket.ByteString (send)
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
Network.Socket
incorrectly represents binary data in send
and recv
and, as a result, use of these functions is not advised and may lead to bugs. Network.Socket
actually recommends using these same methods defined in the ByteString module. However, to keep things simple, we'll stick to System.IO
for input and output.
Importing our new module and turning our Socket
into a Handle
now looks like the following:
-- 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
Concurrency
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
to create a new thread for each connection. Notice that the signature of forkIO
is:
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
Adding communication between threads
We'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 Control.Concurrent.Chan
module which can take care of all of this for us.
Control.Concurrent.Chan provides exactly what we need: unbounded FIFO channels with a single write and multiple read ends. It's a very simple module where we'll take advantage of the abstract Chan
datatype: data Chan a
Notice that this datatype has a kind of * -> *
. To make this datatype concrete, we'll need to decide on a message type. This can be anything serializable, so to keep things simple we'll use String
and create a type alias of Msg
to make things a little more semantic.
-- in Main.hs
type Msg = String
We do not need to explicitly import the module because it is imported by Control.Concurrent
. To ensure that all of our socket connections are running in the same channel, we'll have main
create it and pass it to mainLoop
which will, in turn, pass the channel to each thread in runConn
. We'll adjust our code as follows:
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 runConn
duplicate the channel in order to communicate with it. First, we'll need a couple of helpers, fmap and fix. In short, fmap
allows us to elegantly lift a function over some structure, while fix
allows us to define a Monadic fixpoint.
-- at the top of Main.hs
import Control.Monad.Fix (fix)
From Control.Concurrent.Chan
we'll use some simple functions which are self-explanatory: writeChan
, readChan
, and dupChan
. Of note, dupChan
will create a new channel which will start empty and have any data written to either it or the original be available from both locations. This creates a way to broadcast messages.
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 <- fmap init (hGetLine hdl)
broadcast line
loop
Notice how runConn
, running in a separate thread from our main one, now forks another worker thread for sending messages to the connected user.
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
Msg
to alias(Int, String)
for convenience.
We'll import Control.Exception
and handle exceptions in our final code, below:
-- Main.hs, final code
module Main where
import Network.Socket
import System.IO
import Control.Exception
import Control.Concurrent
import Control.Monad (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
(_, _) <- 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 <- fmap 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 <- fmap 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
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 ^]
and run quit
after dropping into the telnet prompt.
Fire up two clients and have fun chatting!