tools/ubot-plugins/hs-echo/app/Main.hs
author unc0rr
Thu, 17 Jun 2021 19:32:26 +0200
changeset 15794 7598960819a1
permissions -rw-r--r--
Add sample ubot plugin written in haskell

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Text.Megaparsec (Parsec, parseMaybe)
import Text.URI
import System.Environment (getEnv)
import Data.Text (Text, pack, unpack)
import Data.Maybe
import Control.Monad (when)
import Network.AMQP
import qualified Data.ByteString.Lazy.Char8 as BL

assert :: String -> Bool -> a -> a
assert message False x = error message
assert _ _ x = x

unRpack = unpack . unRText

main :: IO ()
main = do
    amqpUri <- getEnv "AMQP_URL"
    let uri = fromJust $ parseMaybe (parser :: Parsec Int Text URI) $ pack amqpUri
    when (uriScheme uri /= mkScheme "amqp") $ error "AMQP_URL environment variable scheme should be amqp"
    let Right (Authority (Just (UserInfo username (Just password))) rHost maybePort) = uriAuthority uri
 
    conn <- openConnection' (unRpack rHost) (fromInteger . toInteger $ fromMaybe 5672 maybePort) "/" (unRText username) (unRText password)
    chan <- openChannel conn

    (queueName, messageCount, consumerCount) <- declareQueue chan newQueue
    bindQueue chan queueName "irc" "cmd.echo.hedgewars"

    -- subscribe to the queue
    consumeMsgs chan queueName Ack (myCallback chan)

    getLine -- wait for keypress
    closeConnection conn
    putStrLn "connection closed"


myCallback :: Channel -> (Message,Envelope) -> IO ()
myCallback chan (msg, env) = do
    let message = BL.tail . BL.dropWhile (/= '\n') $ msgBody msg
    putStrLn $ "received message: " ++ (BL.unpack $ message)

    publishMsg chan "irc" "say.hedgewars"
        newMsg {msgBody = message}

    ackEnv env