XMPP-0.0.3: XMPP library

Network.XMPP

Contents

Description

This library aims to make writing XMPP clients (in particular bots) easy and fun. Here is a small example:

 import Network
 import Network.XMPP
 
 -- The bot's JID is "bot@example.com"
 botUsername = "bot"
 botServer = "example.com"
 botPassword = "secret"
 botResource = "bot"
 
 main :: IO ()
 main = withSocketsDo $
   do
     -- Connect to server...
     c <- openStream botServer
     getStreamStart c
 
     runXMPP c $ do
       -- ...authenticate...
       startAuth botUsername botServer botPassword botResource
       sendpresence
       -- ...and do something.
       run
 
 run :: XMPP ()
 run = do
   -- Wait for an incoming message...
   msg <- waitForStanza (isChat `conj` hasBody)
   let sender = maybe "" id (getAttr "from" msg)
       len = length $ maybe "" id (getMessageBody msg)
   -- ...answer...
   sendMessage sender ("Your message was "++(show len)++" characters long.")
   -- ...and repeat.
   run

XMPP is a protocol for streaming XML also known as Jabber. It is described in RFCs 3920 and 3921, and in a series of XMPP Extension Protocols (XEPs). All of this can be found at http://www.xmpp.org.

Synopsis

The XMPP monad

data XMPP a Source

A function in the XMPP monad behaves a bit like a thread in a cooperative threading system: when it decides to wait for more input, it "sleeps", letting other "threads" run, until input matching a certain predicate arrives.

Instances

runXMPP :: XMPPConnection c => c -> XMPP () -> IO ()Source

Run a function in the XMPP monad using the given XMPP connection. After that, keep looping as long as there are handlers waiting for incoming stanzas.

sendStanza :: XMLElem -> XMPP ()Source

Send an XMPP stanza.

addHandlerSource

Arguments

:: StanzaPredicate

Stanza predicate.

-> StanzaHandler

Stanza handler.

-> Bool

Catch more than one stanza?

-> XMPP () 

When a stanza matching the predicate arrives, call the given handler. This is analogous to spawning a new thread, except that the "thread" is only run if and when a matching stanza arrives.

Stanza handlers can be one-shot or permanent, as indicated by the third argument.

waitForStanza :: StanzaPredicate -> XMPP XMLElemSource

Suspend execution of current function while waiting for a stanza matching the predicate.

quit :: XMPP ()Source

Terminate the loop as soon as the current function exits. This works by removing all stanza handlers, which makes runXMPP exit.

type StanzaPredicate = XMLElem -> BoolSource

A stanza predicate.

type StanzaHandler = XMLElem -> XMPP ()Source

A handler function for a stanza.

liftIO :: MonadIO m => forall a. IO a -> m a

XML functions

data XMLElem Source

A data structure representing an XML element.

Constructors

XML String [(String, String)] [XMLElem]

Tags have a name, a list of attributes, and a list of child elements.

CData String

Character data just contains a string.

Instances

xmlPath :: [String] -> XMLElem -> Maybe XMLElemSource

Follow a "path" of named subtags in an XML tree. For every element in the given list, find the subtag with that name and proceed recursively.

xmlPath' :: [String] -> [XMLElem] -> Maybe XMLElemSource

Default xmlPath doesn't find subtag2 if we have tag1subtag1 and tag1subtag2 in xml stanza.

getAttr :: String -> XMLElem -> Maybe StringSource

Get the value of an attribute in the given tag.

getCdata :: XMLElem -> Maybe StringSource

Get the character data subelement of the given tag.

allChilds :: XMLElem -> [XMLElem]Source

Get all childs of the XML element

xmlToString :: Bool -> XMLElem -> StringSource

Convert the tag back to XML. If the first parameter is true, close the tag.

Stanza manipulation

sendIqSource

Arguments

:: String

JID of recipient

-> String

Type of IQ, either "get" or "set"

-> [XMLElem]

Payload elements

-> XMPP String

ID of sent stanza

Send an IQ request, returning the randomly generated ID.

sendIqWaitSource

Arguments

:: String

JID of recipient

-> String

Type of IQ, either "get" or "set"

-> [XMLElem]

Payload elements

-> XMPP XMLElem

Response stanza

Send an IQ request and wait for the response, without blocking other activity.

hasBody :: StanzaPredicateSource

Return true if the message stanza has body text.

getMessageBody :: XMLElem -> Maybe StringSource

Get the body text of the message stanza, if any.

sendMessageSource

Arguments

:: String

JID of recipient

-> String

Text of message

-> XMPP () 

Send an ordinary "chat" type message.

sendPresence :: Integer -> XMPP ()Source

Send ordinary online presence.

conj :: (a -> Bool) -> (a -> Bool) -> a -> BoolSource

Conjunction ("and") of two predicates.

attributeMatchesSource

Arguments

:: String

Attribute name

-> (String -> Bool)

Attribute value predicate

-> StanzaPredicate 

Apply the predicate to the named attribute. Return false if the tag has no such attribute.

isMessage :: StanzaPredicateSource

Return true if the tag is a message stanza.

isPresence :: StanzaPredicateSource

Return true if the tag is a presence stanza.

isIq :: StanzaPredicateSource

Return true if the tag is an IQ stanza.

isChat :: StanzaPredicateSource

Return true if the tag is a chat message.

isFrom :: String -> StanzaPredicateSource

Return true if the stanza is from the given JID.

iqXmlns :: String -> StanzaPredicateSource

Return true if the stanza is an IQ stanza in the given namespace.

iqGet :: String -> StanzaPredicateSource

Return true if the stanza is a "get" request in the given namespace.

iqSet :: String -> StanzaPredicateSource

Return true if the stanza is a "set" request in the given namespace.

handleVersionSource

Arguments

:: String

Client name

-> String

Client version

-> String

Operating system

-> XMPP () 

Establish a handler for answering to version requests with the given information. See XEP-0092: Software Version.

getErrorCode :: XMLElem -> IntegerSource

Return stanza's error code or -1 (if can't parse error node). Zero if no error.

hasNodeName :: String -> StanzaPredicateSource

Return true if the tag has the given name.

JID functions

getUsername :: String -> StringSource

Get username part of JID, i.e. the part before the @ sign. Return "" if the JID contains no @ sign.

getResource :: String -> StringSource

Get resource part of JID, i.e. the part after /. Return "" if the JID has no resource.

getBareJid :: String -> StringSource

Get the bare JID, i.e. everything except the resource.

Authentication

startAuthSource

Arguments

:: String

Username (part before @ in JID)

-> String

Server (part after @ in JID)

-> String

Password

-> String

Resource (unique identifier for this connection)

-> Integer

Resource priority

-> XMPP Integer

Error number. Zero if authentication succeeded.

Non-SASL authentication, following XEP-0078.

TCP connections

data TCPConnection Source

An XMPP connection over TCP.

openStream :: String -> IO TCPConnectionSource

Open a TCP connection to the named server, port 5222, and send a stream header. This should really check SRV records.

getStreamStart :: TCPConnection -> IO XMLElemSource

Get the stream header that the server sent. This needs to be called before doing anything else with the stream.

Abstract connections

class XMPPConnection c whereSource

A class for various kinds of XMPP connections.

Methods

getStanzas :: c -> IO [XMLElem]Source

Get incoming stanzas from the connection.

sendStanza :: c -> XMLElem -> IO ()Source

Send a stanza on the connection.

closeConnection :: c -> IO ()Source

Close the connection.