Unsoliceted Code Review – Haskell Chat Server Edition

work safe

Our most recent Sep book club has been The Passionate Programmer. One of the things mentioned was taking some third party code and reviewing it.

This is not a new idea. Many people has said the best way to understand the code you write is to understand the good and bad of code written by other people. In addition, reading code in a language you are learning exposes you to functions you might not understand as well as idioms you don’t understand. We had an idea of meeting occasionally over lunch and tackling some code. Here’s kinda what I’m thinking that would look like. Please comment and let me know if there’s something else I’m missing.

With that in mind, I found an article on the Haskell Wiki where they implement a chat server in Haskell.

I’m only posting the code review for the final version. Technically, the final version and my changes to make it compile. There are more about that in the comments. I added my initials, BJB, to the comments I made and if I had to look up an API, I provided a link to where I learned about it.

This chat server has a couple of interesting features. It uses lightweight threading to handle multiple incoming and outgoing IO. It uses channels to communicate across these threads. The forking calls are also used to create separate “loops of control” for each IO channel being handled.

Below are the comments I’ve added to the program.

-- Socket based network library
-- http://www.haskell.org/ghc/docs/6.10.4/html/libraries/network/Network-Socket.html
import Network.Socket
-- System io calls.  Posix based
-- http://lambda.haskell.org/hp-tmp/docs/2011.2.0.0/ghc-doc/libraries/haskell2010-1.0.0.0/System-IO.html
import System.IO
-- for exceptions
-- http://haskell.org/ghc/docs/latest/html/libraries/base/Control-Exception.html
import Control.Exception
-- concurrent primitives
-- http://www.haskell.org/ghc/docs/latest/html/libraries/base/Control-Concurrent.html
import Control.Concurrent
-- concurrent channels
-- http://www.haskell.org/ghc/docs/latest/html/libraries/base/Control-Concurrent-Chan.html
import Control.Concurrent.Chan
-- http://www.haskell.org/ghc/docs/latest/html/libararies/base/Control-Monad.html
import Control.Monad
-- http://www.haskell.org/ghc/docs/latest/html/libraries/base-4.4.0.0/Control-Monad-Fix.html
import Control.Monad.Fix (fix)
 
-- BJB - our message type will be an id and a string message to be passed to all
--     - channels not on that Id
type Msg = (Int, String)
 
-- BJB - The main function is run as an IO Monad
main :: IO ()
main = do
    -- BJB Create a new channel for the server side communication
    chan <- newChan
    -- create socket
    -- BJB - The socket is of type AF_INET http://en.wikipedia.org/wiki/AF_INET
    --       The socket type is Stream, which means they are connected, ie failure on
    --       on party breaks both connections
    sock <- socket AF_INET Stream 0
    -- make socket immediately reusable - eases debuggin
    -- BJB - Socket option SO_REUSEADDR
    --       http://publib.boulder.ibm.com/infocenter/iseries/v5r3/index.jsp?topic=%2Fapis%2Fssocko.htm
    setSocketOption sock ReuseAddr 1
    -- listen on TCP port 4242
    -- BJB - could be written as `bindSocket sock $ SockAddrInet 4242 iNADDR_ANY`
    --       iNADDR_ANY is the ipv4 wildcard.  4242 is the port
    --       this takes the socket and binds it to the network interface
    bindSocket sock (SockAddrInet 4242 iNADDR_ANY)
    -- listen on TCP port 4242
    -- BJB - could be written as `bindSocket sock $ SockAddrInet 4242 iNADDR_ANY`
    --       iNADDR_ANY is the ipv4 wildcard.  4242 is the port
    --       this takes the socket and binds it to the network 
    listen sock 2
    -- BJB - recursive sink to pull data off the first chanel
    --     - this is to prevent the channel from filling it's
    --     - buffer without removing any data
    --     - See below for more information about fix and how it works
    forkIO $ fix $ \loop -> do
        (_, msg) <- readChan chan
        loop
    -- BJB - Passing the channel to the loop with an id
    mainLoop sock chan 0
 
-- handles all incoming connections
-- since it performs IO, it too must operate in the IO monad
mainLoop :: Socket -> Chan Msg -> Int -> IO ()
mainLoop sock chan nr = do
    -- accept on connection and handle it
    -- BJB - http://en.wikipedia.org/wiki/Berkeley_sockets#accept.28.29
    --       waits for a connection to a client
    --       a connection is a (Socket, SockAddr)
    conn <- accept sock
    -- BJB - passes the connection to the handler function
    --     - type of forkIO is IO() -> IO ThreadId
    --     - it's a lightweight thread
    --     - not for use if there are system threads excpected by the
    --     - underlying libraries
    --     - pass the channel to the socket handlers
    forkIO (runConn conn chan nr)
    -- BJB - loops back to accept the next connection
    --     - increment the connection id
    --     - the $! operator is defined as
    --     - f $! x = x `seq` f x
    --     - seq forces evaluation of a function, this increments
    --     - the connection id explicitly before the recursive call is made
    mainLoop sock chan $! nr+1


-- BJB Need to constrain the error handler used below to only receive an IOException
-- Will try to find out why later
errorHandler :: IOException -> IO()
-- BJB - the return () or return unit/void means do nothing
errorHandler _ = return ()

-- sends a message to the incomming socket
runConn :: (Socket, SockAddr) -> Chan Msg -> Int -> IO ()
runConn (sock, _) chan nr = do
    -- BJB - define a helper to broadcast a mesage to the channel
    --     - note: it closes over the channel
    let broadcast msg = writeChan chan (nr, msg)
    -- BJB - socketToHandle converts a network socket to a handle
    --     - a read / write handle
    hdl <- socketToHandle sock ReadWriteMode
    -- BJB - set to nobuffer, no need to flush
    hSetBuffering hdl NoBuffering
    -- BJB - As the user for their name
    hPutStrLn hdl "Hi, what's your name?"
    -- BJB - Store the user name
    name <- liftM init (hGetLine hdl)
    -- BJB - Tell everyone the user entered.
    --     - the ++ operator concats two lists efficientlyd
    broadcast ("--> " ++ name ++ " entered.")
    -- BJB - welcome the user on their socket
    hPutStrLn hdl ("Welcome, " ++ name ++ "!")
    -- BJB - duplicate the chanel
    --     - chan' is used to read
    --     - chan is used to write
    chan' <- dupChan chan
    -- fork off thread for reading fro the duplicate channel
    -- BJB - fix turns a lamba (taking a function as an arg and calling that at the end)
    --     -  into a loop
    --     - fix f = f (fix f)
    --     - http://en.wikibooks.org/wiki/Haskell/Fix_and_recursion
    --     - remember forkIO's threadId so we can work on it later
    reader <- forkIO $ fix $ \loop -> do
        (nr', line) <- readChan chan'
        -- BJB - if the message comes from a channel that isn't mine,
        --     - send it over the socket, otherwise skip it
        when (nr /= nr') $ hPutStrLn hdl line
        loop
    -- BJB - right now, this won't even compile
    --     - I suspect it isn't compiling because it's looking for an exception,
    --     - but one isn't present
    --     - handle is of type handle::Exception e => (e -> IO a) -> IO a -> IO a
    --     - the (e -> IO a) is an exception handler
    --     - However, the compiler wants it to be tightented down to only (IOException -> IO a)
    --     - this is done by using the errorHandler defined above as opposed to the 
    --     - lambda from the original article
    handle errorHandler $fix $ \loop -> do
        -- BJB - http://en.wikibooks.org/wiki/Haskell/Monad_transformers#liftM
        --     - liftM turns init into a monad to take the line from the socket
        --     - init is used to kill the \n character
        line <- liftM init (hGetLine hdl)
        case line of
         -- BJB - quit if needed
         "quit" -> hPutStrLn hdl "Bye!"
         -- BJB - otherwise broadcast
         _      -> do
                   broadcast (name ++ ": " ++ line)
                   loop
    -- BJB - close the reader thread.
    --     - this isn't a problem because the previous line will not get here
    --     - until the writer chanel is closed from the 'quit' command
    killThread reader
    -- BJB - Let the room know this user left
    broadcast ("<-- " ++ name ++ " left.")
    -- BJB - close the socket/handle
    hClose hdl
No Comments

Leave a Reply

Allowed tags: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>