1 {-# LANGUAGE OverloadedStrings #-}

     2 module Main where

     3 

     4 import Text.Megaparsec (Parsec, parseMaybe)

     5 import Text.URI

     6 import System.Environment (getEnv)

     7 import Data.Text (Text, pack, unpack)

     8 import Data.Maybe

     9 import Control.Monad (when)

    10 import Network.AMQP

    11 import qualified Data.ByteString.Lazy.Char8 as BL

    12 

    13 assert :: String -> Bool -> a -> a

    14 assert message False x = error message

    15 assert _ _ x = x

    16 

    17 unRpack = unpack . unRText

    18 

    19 main :: IO ()

    20 main = do

    21     amqpUri <- getEnv "AMQP_URL"

    22     let uri = fromJust $ parseMaybe (parser :: Parsec Int Text URI) $ pack amqpUri

    23     when (uriScheme uri /= mkScheme "amqp") $ error "AMQP_URL environment variable scheme should be amqp"

    24     let Right (Authority (Just (UserInfo username (Just password))) rHost maybePort) = uriAuthority uri

    25  

    26     conn <- openConnection' (unRpack rHost) (fromInteger . toInteger $ fromMaybe 5672 maybePort) "/" (unRText username) (unRText password)

    27     chan <- openChannel conn

    28 

    29     (queueName, messageCount, consumerCount) <- declareQueue chan newQueue

    30     bindQueue chan queueName "irc" "cmd.echo.hedgewars"

    31 

    32     -- subscribe to the queue

    33     consumeMsgs chan queueName Ack (myCallback chan)

    34 

    35     getLine -- wait for keypress

    36     closeConnection conn

    37     putStrLn "connection closed"

    38 

    39 

    40 myCallback :: Channel -> (Message,Envelope) -> IO ()

    41 myCallback chan (msg, env) = do

    42     let message = BL.tail . BL.dropWhile (/= '\n') $ msgBody msg

    43     putStrLn $ "received message: " ++ (BL.unpack $ message)

    44 

    45     publishMsg chan "irc" "say.hedgewars"

    46         newMsg {msgBody = message}

    47 

    48     ackEnv env