Haskell Chat

Este post apresentará um programa simples de bate-papo por Telnet na linguagem Haskell.

Este programa servirá como um servidor de bate-papo, bastando que as pessoas conectem nele para que possam trocar mensagens entre si. As pessoas não precisarão conhecer onde os outros participantes do bate-papo estão na rede, o servidor se encarregará de redirecionar cada mensagem. Ele atuará parecido com um roteador.

As informações trafegadas na rede serão texto puro, tanto do cliente quanto do servidor, sendo assim não é necessário um cliente especial para utilização do serviço de bate-papo. Os clientes poderão se conectar ao servidor utilizando o Telnet.

Cabeçalho

Nosso servidor de bate-papo será um módulo Haskell projetado para rodar como um aplicativo O nome deste módulo será Main:

module Main(main) where

Imports

Para que o bate-papo funcione e possamos enviar informações pela rede, precisamos de acesso à camada de rede do sistema operacional:

import Network

Além disto, precisaremos utilizar controles sobre efeitos colaterais para que possamos atender mais de um usuário ao mesmo tempo:

import System.IO
import Control.Monad
import Control.Concurrent

Para que nosso servidor não fique apenas como um mediador de mensagens, faremos alguns tratamentos aos textos recebidos pelos usuários, por exemplo a utilização de alguns comandos, para isto precisaremos manipular Strings, que nada mais são do que listas de caracteres:

import Data.List

Tipos

Para controlar as informações que serão armazenadas e trafegadas. Iremos definir alguns tipos para nos ajudar a realizar este controle.

Mensagens

As mensagens trocadas entre usuários nada mais são do que Strings, então esta será nossa definição de mensagem:

type Message = String

Usuários

Será necessário dinstinguir quem mandou cada mensagem para saber para quem repassar cada mensagem, evitando que o próprio usuário receba sua própria mensagem e para que o bate-papo faça sentido.

Para isto precisaremos de um tipo que represente um usuário do bate-papo e que seja possível compará-lo com outros usuários. Este usuário será identificado por um nome e, para que seja possível distinguir usuários com o mesmo nome, por um identificador único.

data ChatUser = ChatUser { 
    userId :: Int, 
    username :: String }
        deriving Eq

Mensagens de bate-papo

A mensagem que recebemos pela rede é texto puro, mas precisamos associá-la ao usuário que fez o envio. Por isto temos um tipo que vincula uma mensagem a um usuário.

data ChatMessage =
    ChatMessage { 
        messageFrom :: ChatUser, 
        messageText :: Message }

E, para que seja possível notificar sobre a entrada ou saída de algum usuário, iremos declarar também outros dois tipo de mensagens do bate-papo: as mensagens de saída e as mensagens de entrada. As mensagens de saída poderão ter algum texto de despedida do usuário.

| QuitMessage { 
        messageFrom :: ChatUser,
        messageText :: Message }
    | JoinMessage {
        messageFrom :: ChatUser }

Instâncias

Como o servidor irá transmitir apenas texto puro, ao receber uma mensagem de um usuário e repassá-la a outro, será necessário exibir o usuário que enviou a mensagem de forma textual. Para isto declaramos uma instância de Show para nosso tipo ChatUser:

instance Show ChatUser where
    show (ChatUser uid name) = 
        name ++ "(" ++ show uid ++ ")"

Também será necessário trafegar os diferentes tipos de mensagens na forma de texto puro pela rede:

instance Show ChatMessage where
    show (ChatMessage user message) =
        show user ++ ": " ++ message
    show (QuitMessage user message)
        | null message =
            "! " ++ show user ++ " saiu."
        | otherwise =
            "! " ++ show user ++ " saiu: " ++ message
    show (JoinMessage user) =
        "! " ++ show user ++ " entrou."

Main

Porta de comunicação

Nosso bate-papo tem como principal objetivo funcionar via Telnet, então para isto faremos com que o servidor escute na porta 23, que é a porta padrão utilizada pelo Telnet.

port :: PortID
port = PortNumber 23

Identificação dos usuários

O identificador único de cada usuário será determinado pela ordem de chegada no servidor, i.e. o primeiro usuário terá o identificador 1, o segundo terá o identificador 2, e assim por diante.

Suportando múltiplos usuários

Para que nosso servidor não fique travado lidando com apenas um usuário, iremos criar Threads para lidar com cada usuário de forma concorrente.

Ao receber uma mensagem de um usuário, a Thread responsável por aquela conexão terá que repassar esta informação às demais, para isto utilizaremos um canal de envio e recebimento de mensagens que será compartilhado entre todas as Threads.

Este canal funciona como um tópico, quando alguém escreve nele, todos que estiverem escutando irão receber a mensagem. Assim será possível que a Thread lidando com outro usuário receba esta mensagem através deste canal de comunicação e repasse ao cliente.

Porém, se utilizarmos apenas uma Thread por cliente, esta só teria a chance de ler deste canal de comunicação depois do cliente enviar alguma mensagem. Pois a Thread ficaria bloqueada esperando por uma escrita no Socket.

Para evitar este problema, serão utilizadas duas Threads por cliente: uma responsável pelo recebimento de mensagens e outra responsável pelo envio.

Main

Nosso servidor iniciará definindo o número inicial de conexões (userCount), criando um canal de comunicação (chan), abrindo um Socket para escutar na porta definida anteriormente (socket) e aguardando conexões.

main :: IO ()
main = withSocketsDo $ do
         let userCount = 0
         chan <- newChan
         socket <- listenOn port
         handleConnections socket userCount chan

Aceitando conexões

Ao receber uma conexão, precisamos manter o handle para realizar a leitura e escrita de mensagens. Desligamos o buffer para que as mensagens sejam trocadas em tempo real.

Após definida a conexão, precisamos liberar nosso servidor para que possa atender outros usuários, então será criado um processo concorrente que atenderá esta conexão. O identificador único do usuário será definido no processo principal para evitar que dois usuários tenham o mesmo identificador.

handleConnections :: Socket -> 
                     Int -> 
                     Chan ChatMessage ->
                     IO ()
handleConnections socket userCount chan = do
    (socketHandle, _, _) <- accept socket
    hSetBuffering socketHandle NoBuffering
    let nextUser = (userCount + 1)
    _ <- forkIO $
      handleUserConnection chan socketHandle nextUser
    handleConnections socket nextUserNumber chan

Atendendo uma conexão

Para iniciar o atendimento à uma conexão, precisamos inicialmente do nome do usuário.

handleUserConnection :: Chan ChatMessage ->
                        Handle ->
                        Int ->
                        IO ()
handleUserConnection chan socketHandle userNumber = do
    name <- readUsername socketHandle

Com o nome do usuário e o identificador único fornecido pelo processo principal do servidor, conseguimos definir o usuário desta conexão e enviar uma mensagem ao canal de comunicação informando que o usuário entrou no bate-papo.

let thisUser = ChatUser userNumber name
    broadcast chan $ JoinMessage thisUser

Para que este usuário comece a receber as mensagens do bate-papo, criamos uma Thread separada para efetuar a leitura do canal de comunicação:

chanReader <- dupChan chan
    readerThread <- forkIO $
      startReader chanReader socketHandle thisUser

Este processo irá efetuar a escrita do canal de comunicação a partir das mensagens recebidas pelo Socket do cliente. O resultado deste processo, será uma mensagem de saída do usuário, caso ele deixe alguma. Caso ele desconecte sem deixar nenhuma mensagem, a exceção será capturada e convertida em uma mensagem vazia de despedida do usuário.

quitMessage <- (startSender chan 
                            socketHandle thisUser)
                            `catch` (\_ -> return "")

Com a mensagem de despedida em mãos, informamos os demais usuários que este deixou o bate-papo. Encerramos a Thread responsável por fazer a leitura do canal de comunicação e fechamos a conexão com o cliente:

broadcast chan $ QuitMessage thisUser quitMessage
    killThread readerThread
    hClose socketHandle

Recebendo o nome do usuário

Para receber o nome do usuário, apenas enviamos uma mensagem pedindo que ele informe seu nome e fazemos a leitura do Socket:

readUsername :: Handle -> IO String
readUsername socketHandle = do
    hPutStr socketHandle "Informe seu nome: "
    readLine $ socketHandle

Recebendo mensagens do canal de comunicação

O processo responsável por receber as mensagens do canal de comunicação só será encerrado com a desconexão do usuário, então ele sempre deve estar lendo do canal e publicando ao usuário. O próprio usuário irá enviar mensagens para o canal de comunicação, para evitar que ele receba mensagens dele mesmo, é aplicado um filtro para que só sejam exibidas mensagens de usuários diferentes dele.

startReader :: Chan ChatMessage ->
               Handle ->
               ChatUser ->
               IO ()
startReader chanReader socketHandle thisUser =
    forever $ do
        message <- readChan chanReader
        when ((messageFrom message) /= thisUser) $
            display message socketHandle

Enviando mensagens ao canal de comunicação

O processo responsável por enviar mensagens ao canal de comunicação deverá terminar de alguma forma. Seja por desconexão do usuário ou por uma mensagem de despedida do mesmo.

Para que o usuário saia do bate-papo, basta que ele envie uma mensagem iniciando com /quit seguido de sua mensagem de despedida. As demais mensagens recebidas do usuário serão repassadas ao canal de comunicação e não encerrarão o processo.

startSender :: Chan ChatMessage ->
               Handle ->
               ChatUser ->
               IO String
startSender chan socketHandle thisUser = do
    line <- readLine socketHandle
    if "/quit" `isPrefixOf` line
        then return . dropWhile (== ' ') $ drop 5 line
        else do
             broadcast chan $
                 ChatMessage thisUser line
             startSender chan socketHandle thisUser

Utilitários

Notificando os processos responsáveis por cada usuário

Para enviar uma mensagem a todos os usuários, basta realizar uma escrita no canal de comunicação.

broadcast :: Chan ChatMessage -> ChatMessage -> IO ()
broadcast = writeChan

Enviando mensagens para um usuário

Para enviar uma mensagem a um usuário, escrevemos a mensagem no Socket seguida de uma quebra de linha no formato Windows, para que a utilização via Telnet seja agradável.

display :: ChatMessage -> Handle -> IO ()
display message socketHandle = do
    hPutStr socketHandle (show message ++ "\r\n")
    hFlush socketHandle

Lendo mensagens de um usuário

Para ler uma mensagem do usuário, lemos uma linha do Socket e removemos o retorno do carro, para que fique apenas a mensagem escrita por ele.

readLine :: Handle -> IO String
readLine = liftM (filter (/= '\r')) . hGetLine

Código completo

O código completo está disponível no GitHub com a descrição Sample telnet chat in Haskell.