-- | Main.hs
-- A module which get config and start bot.

import Config
import ParseCmd
import HTTP
import Help

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

import Data.List

main = withSocketsDo $ do
    cf <- readConfig ".primularc"
    let startURL = (csite cf)++"/"++(cprivateKey cf)

    c <- openStream (cserver cf)
    getStreamStart c

    runXMPP c $ do
      err <- startAuth (cusername cf) (cserver cf) (cpassword cf) "primula"
      if err /= 0
        then error $ "can't auth: "++(show err)++" error"
        else liftIO $ putStrLn "connected"
      sendPresence

      addHandler (isGroupchatPrivmsg (cconference cf) `conj` hasBody)
                 (messageCB cf startURL) True
      err <- joinGroupchat (cnickname cf) (cconference cf) ""
      if err /= 0
        then error $ "can't join a room: "++(show err)++" error"
        else liftIO $ putStrLn "joined a room"

    closeConnection c

-- | Callback for private messages.
messageCB :: Config -> String -> StanzaHandler
messageCB cf startURL stanza = do
    -- parse stanza here
    let sender = maybe "" id (getAttr "from" stanza)
        nick = getResource sender
        room = getBareJid sender
        body = maybe "" id (getMessageBody stanza)

    -- parse cmd
    answer <- case parseCmd (replaceToEntities body) of
      NewPost pdata -> reqAndParse "send post" postOK "/newpost" pdata
      NewThread pdata -> reqAndParse "create thread" (threadOK room)
                                    "/newthread" pdata 
      DelPost pdata -> reqAndParse "del post" delOK "/delpost" pdata
      Help -> return help
      Info -> return info
      Unknown err -> return $ "Print \"help\" for help.\n\n"++err

    sendGroupchatPrivateMessage nick room $
      if null answer
        then "Wrong response from server."
        else answer
  where
    -- simple helper functions
    isFAIL = ("FAIL" `isPrefixOf`)
    isOK = ("OK" `isPrefixOf`)
    getFAILReason = drop 5
    getOKRest = drop 3
    splitOK str = let (f, s) = break (==' ') str
                  in if null f || null s
                       then ("", "")
                       else (f, tail s)
    doURL n = (curlAdd cf)++n

    -- parse entire responce
    reqAndParse err ok cmd pdata = do
      responce <- liftIO $ sendPOST (startURL++cmd) pdata
      if isFAIL responce
        then return $ "Can't "++err++" for reason: "++
                      (getFAILReason responce)
        else if isOK responce
               then ok (getOKRest responce)
               else do
                 liftIO $ putStrLn $ "Warning! Got wrong responce: "++responce
                 return ""

    -- ok functions
    postOK str = do
      let (n, pass) = splitOK str
      return $ "Message posted: "++doURL n++", password: "++pass
    threadOK room str = do
      let (n, pass) = splitOK str
          url = doURL n
      sendGroupchatMessage room ("*** New thread: "++url)
      return $ "Thread created: "++url++", password: "++pass
    delOK _ = return "Post deleted."

---

-- |Replace special characters to XML entities.
replaceToEntities :: String -> String
replaceToEntities [] = []
replaceToEntities (char:chars) =
    let str = case char of
                '&' -> "&amp;"
                '<' -> "&lt;"
                '>' -> "&gt;"
                '"' -> "&quot;"
                '\'' -> "&apos;"
                _ -> char:[]
    in str ++ (replaceToEntities chars)