pontarius-xmpp-0.0.3.0: Examples/EchoClient.hs

{-

This file (EchoClient.hs) illustrates how to connect, authenticate and set a
presence with Pontarius XMPP. The contents of this file may be used freely, as
if it is in the public domain.

-}


import Network.XMPP

import Control.Concurrent.Chan (Chan, readChan, writeChan)
import Data.Maybe
import Data.XML.Types
import qualified Data.Text as DT


-- Account and server details.

host = "test.pontarius.org"
userName = "sprint3-xmpp"
server = "test.pontarius.org"
port = 5222
resource = "echo-client"
password = ""


-- Creates a Pontarius XMPP session and requests to connect.

main :: IO ()
main =
  do (inEvents, outEvents) <- createSession
     writeChan outEvents $ XOEConnect host port
     loop inEvents outEvents


-- All "in" events (incoming events to this program, events from Pontarius XMPP)
-- are being processed in this loop. A state variable could be added here.

loop :: Chan XMPPInEvent -> Chan XMPPOutEvent -> IO ()
loop c c_ =
  do e <- readChan c
     -- putStrLn $ "XMPPInEvent received: " ++ (show e)
     processEvent e
     loop c c_
  where
    processEvent :: XMPPInEvent -> IO ()
    
    -- When connected, authenticate
    processEvent XIEConnectionSucceeded =
      writeChan c_ $ XOEAuthenticate userName password resource
    
    -- When authenticated, set presence
    processEvent XIEAuthenticationSucceeded =
      writeChan c_ $ XOEPresence $
        presence Nothing Nothing Nothing Nothing Available []
    
    -- Auto-accept subscriptions when asked and ask for subscription
    processEvent (XIEPresence (Presence { presenceStanza = stanza
                                        , presenceType = Subscribe })) = do
      let jid = stanzaFrom stanza
      writeChan c_ $ XOEPresence $ presence Nothing Nothing jid Nothing
        Subscribed []
      writeChan c_ $ XOEPresence $ presence Nothing Nothing jid Nothing
        Subscribe []
      return ()
    
    -- Echo messages
    processEvent (XIEMessage m) =
      writeChan c_ $ XOEMessage $
        message Nothing Nothing (stanzaFrom $ messageStanza m) Nothing
        (messageType m) (messagePayload m)
    processEvent _ = return ()