chat-cli by RabbitMQ

Chat.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import System.Environment (getArgs)
import Control.Exception (bracket)
import Network.AMQP
import qualified System.IO.UTF8 as IoU8 (getLine, putStrLn)
import qualified Data.ByteString.Lazy.UTF8 as U8

main :: IO ()
main = do
    [host, roomname, username] <- getArgs
    bracket (openConnection host "/" "guest" "guest")
            closeConnection
            (\c -> runChat c roomname username)

runChat :: Connection -> String -> String -> IO ()
runChat conn roomname username = do
    chan <- openChannel conn

    let exname = roomname
    declareExchange chan newExchange { exchangeName = exname, exchangeType = "fanout" }

    let qname  = roomname ++ username
    declareQueue chan newQueue { queueName = qname, queueExclusive = True }
    bindQueue chan qname exname ""

    consumeMsgs chan qname Ack onReceived
    loop chan exname
    where
      onReceived (msg, env)= do
        IoU8.putStrLn . U8.toString $ msgBody msg
        ackEnv env

loop :: Channel -> String -> IO ()
loop chan exname = do
    text <- IoU8.getLine
    case text of
      ":q" -> return ()
      _    -> do
        publish chan exname $ U8.fromString text    -- XXX Enum.toEnum{Word8}: tag (12411) is outside of bounds (0,255)
        loop chan exname

publish :: Channel -> String -> U8.ByteString -> IO ()
publish chan exname text = publishMsg chan exname "" (
        newMsg { msgBody         = text
               , msgDeliveryMode = Just NonPersistent
               })