packages feed

Ranka-0.1: Main.hs

import Omegle

import Network
import Network.XMPP
import Network.XMPP.MUC

import Data.Maybe

-- | Settings.
username = "username"
server = "jabber.ru"
password = "password"
resource = "Nya-nya nya-nya nihao nya coda tsugeraha tsude karu saa!"
room = "room@conference.jabber.ru"
room_pass = ""
nick = "Ranka_bot"

-----------------------------------------------
main :: IO ()
main = withSocketsDo $ do
    c <- openStream server
    getStreamStart c

    runXMPP c $ do
       err <- startAuth username server password resource
       if err /= 0
         then error $ "can't auth: "++(show err)++" error"
         else liftIO $ putStrLn "connected"

       sendPresence

       err' <- joinGroupchat nick room room_pass
       if err' /= 0
         then error $ "can't join groupchat: "++(show err')++" error"
         else liftIO $ putStrLn "joined"

       omegleState <- liftIO $ newOmegleState
       addHandler grpHandler (groupchatCB omegleState c) True

    closeConnection c
  where
    grpHandler = isGroupchatMessage `conj` hasBody `conj` noTstamp `conj` notMy
    noTstamp = not . attributeMatches "xmlns" (=="jabber:x:delay") . x
    x = maybe (XML [] [] []) id . xmlPath ["x"]
    notMy = not . attributeMatches "from" (==(room++"/"++nick))

-- | Groupchat callback.
groupchatCB :: OmegleState -> TCPConnection -> StanzaHandler
groupchatCB omegleState c stanza = do
    let sender = maybe "" id (getAttr "from" stanza)
        nick' = getResource sender
        body = maybe "" id (getMessageBody stanza)
        (command, text') = break (==' ') body
        text = if null text' then "" else tail text'

    result <- liftIO $ case command of
      "$state" | null text -> getOmegleState omegleState
      "$start" | null text -> startOmegle omegleState c room
      "$stop"  | null text -> stopOmegle omegleState
      "$send"  | not $ null text -> sendToOmegle omegleState text
      "$s"     | not $ null text -> startAndSendToOmegle omegleState c room text
      cmd | ((cmd == nick++",") ||
             (cmd == nick++":") ||
             (cmd == nick     )) &&
             (not $ null text) -> startAndSendToOmegle omegleState c room text
      "$help" | null text -> return $
        "Ranka -— omegle.com gate.\n\n"++
        "Available commands:\n"++
        "$help     this help message\n"++
        "$state    show chat state\n"++
        "$start    start chat\n"++
        "$stop     stop chat\n"++
        "$send     send message\n"++
        "$s <msg> | "++nick++"[:,] <msg>    start chat or/and send message"
      ('$':_) -> return "wrong syntax"
      _ -> return ""

    if null result
      then return ()
      else sendGroupchatMessage room (nick'++", "++result)