From f2ab31fe71cc9c428154be1fe31fd6dab573d0f1 Mon Sep 17 00:00:00 2001 From: Philipp Balzarek Date: Tue, 24 Apr 2012 23:12:31 +0200 Subject: [PATCH] preliminary shaping of API structure, documentation --- pontarius.cabal | 8 +- src/Data/Conduit/TLS.hs | 1 + src/Network/XMPP.hs | 152 +++++++++++++++++++++++---- src/Network/XMPP/Bind.hs | 4 +- src/Network/XMPP/Concurrent.hs | 11 +- src/Network/XMPP/Concurrent/Monad.hs | 11 +- src/Network/XMPP/Concurrent/Types.hs | 1 + src/Network/XMPP/JID.hs | 50 ++++++--- src/Network/XMPP/Message.hs | 18 +++- src/Network/XMPP/Presence.hs | 15 +-- src/Network/XMPP/TLS.hs | 1 + src/Network/XMPP/Types.hs | 92 ++++++++-------- src/Tests.hs | 14 +-- src/Text/XML/Stream/Elements.hs | 1 + 14 files changed, 271 insertions(+), 108 deletions(-) diff --git a/pontarius.cabal b/pontarius.cabal index 5240d2f..e555639 100644 --- a/pontarius.cabal +++ b/pontarius.cabal @@ -12,7 +12,7 @@ Stability: alpha Bug-Reports: mailto:jon.kristensen@nejla.com -- Package-URL: Synopsis: An incomplete implementation of RFC 6120 (XMPP: Core) -Description: Pontarius is a work in progress of an implementation of +Description: Pontarius is a work in progress implementation of RFC 6120 (XMPP: Core). Category: Network Tested-With: GHC == 7.4.1 @@ -61,8 +61,10 @@ Library , Network.XMPP.TLS , Network.XMPP.Bind , Network.XMPP.Session - , Text.XML.Stream.Elements - , Data.Conduit.TLS + Other-modules: Network.XMPP.JID + , Network.XMPP.Concurrent.IQ + , Network.XMPP.Concurrent.Threads + , Network.XMPP.Concurrent.Monad GHC-Options: -Wall diff --git a/src/Data/Conduit/TLS.hs b/src/Data/Conduit/TLS.hs index 642ba6e..4673353 100644 --- a/src/Data/Conduit/TLS.hs +++ b/src/Data/Conduit/TLS.hs @@ -1,4 +1,5 @@ {-# Language NoMonomorphismRestriction #-} +{-# OPTIONS_HADDOCK hide #-} module Data.Conduit.TLS ( tlsinit -- , conduitStdout diff --git a/src/Network/XMPP.hs b/src/Network/XMPP.hs index 76d87a8..1a78a42 100644 --- a/src/Network/XMPP.hs +++ b/src/Network/XMPP.hs @@ -13,9 +13,12 @@ -- Stability: unstable -- Portability: portable -- --- XMPP is an open standard, extendable, and secure communications --- protocol designed on top of XML, TLS, and SASL. Pontarius XMPP is --- an XMPP client library, implementing the core capabilities of XMPP +-- The Extensible Messaging and Presence Protocol (XMPP) is an open technology for +-- real-time communication, which powers a wide range of applications including +-- instant messaging, presence, multi-party chat, voice and video calls, +-- collaboration, lightweight middleware, content syndication, and generalized +-- routing of XML data. +-- Pontarius an XMPP client library, implementing the core capabilities of XMPP -- (RFC 6120). -- -- Developers using this library are assumed to understand how XMPP @@ -30,21 +33,109 @@ {-# LANGUAGE NoMonomorphismRestriction, OverloadedStrings #-} module Network.XMPP - ( module Network.XMPP.Bind - , module Network.XMPP.Concurrent - , module Network.XMPP.Monad - , module Network.XMPP.SASL - , module Network.XMPP.Session - , module Network.XMPP.Stream - , module Network.XMPP.TLS - , module Network.XMPP.Types - , module Network.XMPP.Presence - , module Network.XMPP.Message - , xmppConnect - , xmppNewSession + ( -- * Session management + xmppNewSession , connect , startTLS , auth + , endSession + , setSessionEndHandler + -- * JID + -- | A JID (historically: Jabber ID) is XMPPs native format + -- for addressing entities in the network. It is somewhat similar to an + -- email-address but contains three parts instead of two: + , JID(..) + -- * Stanzas + -- | @Stanzas@ are the the smallest unit of communication in @XMPP@. They + -- come in 3 flavors: + -- + -- * @'Message'@, for traditional IM-style message passing between peers + -- + -- * @'Presence'@, for communicating status updates + -- + -- * IQ (info/query), with a request-response semantics + -- + -- All stanza types have the following attributes in common: + -- + -- * The /id/ attribute is used by the originating entity to track + -- any response or error stanza that it might receive in relation to + -- the generated stanza from another entity (such as an intermediate + -- server or the intended recipient). It is up to the originating + -- entity whether the value of the 'id' attribute is unique only + -- within its current stream or unique globally. + -- + -- * The /from/ attribute specifies the JID of the sender. + -- + -- * The /to/ attribute specifies the JID of the intended recipient + -- for the stanza. + -- + -- * The /type/ attribute specifies the purpose or context of the + -- message, presence, or IQ stanza. The particular allowable values + -- for the 'type' attribute vary depending on whether the stanza is + -- a message, presence, or IQ stanza. + + -- ** Messages + -- | The /message/ stanza is a /push/ mechanism whereby one entity pushes + -- information to another entity, similar to the communications that occur in + -- a system such as email. + -- + -- + , Message + , MessageError + -- *** creating + , module Network.XMPP.Message + -- *** sending + , sendMessage + -- *** receiving + , pullMessage + , waitForMessage + , waitForMessageError + , filterMessages + -- ** Presence + -- | The /presence/ stanza is a specialized /broadcast/ + -- or /publish-subscribe/ mechanism, whereby multiple entities + -- receive information about an entity to which they have + -- subscribed. + -- + -- + , Presence(..) + , PresenceError(..) + , ShowType(..) + -- *** creating + , module Network.XMPP.Presence + -- *** sending + , sendPresence + -- *** receiving + , pullPresence + , waitForPresence + -- ** IQ + -- | Info\/Query, or IQ, is a /request-response/ mechanism, similar in some + -- ways to the Hypertext Transfer Protocol @HTTP@. The semantics of IQ enable + -- an entity to make a request of, and receive a response from, another + -- entity. The data content and precise semantics of the request and response + -- is defined by the schema or other structural definition associated with the + -- XML namespace that + -- qualifies the direct child element of the IQ element. IQ interactions + -- follow a common pattern of structured data + -- exchange such as get/result or set/result (although an error can be returned + -- in reply to a request if appropriate) + -- + -- + , IQRequest(..) + , IQRequestType(..) + , IQResult(..) + , IQError(..) + , sendIQ + , sendIQ' + , answerIQ + , listenIQChan + , iqRequestPayload + , iqResultPayload + -- * Threads + , XMPPThread + , forkXMPP + -- * Misc + , exampleParams ) where import Data.Text as Text @@ -53,27 +144,46 @@ import Network import qualified Network.TLS as TLS import Network.XMPP.Bind import Network.XMPP.Concurrent -import Network.XMPP.Message +import Network.XMPP.Message hiding (message) import Network.XMPP.Monad -import Network.XMPP.Presence +import Network.XMPP.Presence hiding (presence) import Network.XMPP.SASL import Network.XMPP.Session import Network.XMPP.Stream import Network.XMPP.TLS import Network.XMPP.Types -xmppConnect :: HostName -> Text -> XMPPConMonad (Either StreamError ()) -xmppConnect address hostname = xmppRawConnect address hostname >> xmppStartStream +import Control.Monad.Error +-- | Create a new, pristine session without an active connection. xmppNewSession :: XMPPThread a -> IO (a, XMPPConState) xmppNewSession = withNewSession . runThreaded +-- | Connect to host with given address. +xmppConnect :: HostName -> Text -> XMPPConMonad (Either StreamError ()) +xmppConnect address hostname = xmppRawConnect address hostname >> xmppStartStream +-- | Attempts to secure the connection using TLS. Will return +-- 'TLSNoServerSupport' when the server does not offer TLS or does not +-- expect it at this time. startTLS :: TLS.TLSParams -> XMPPThread (Either XMPPTLSError ()) startTLS = withConnection . xmppStartTLS -auth :: Text.Text -> Text.Text -> XMPPThread (Either String Text.Text) -auth username passwd = withConnection $ xmppSASL username passwd + +-- | Authenticate to the server with the given username and password +-- and bind a resource +auth :: Text.Text -- ^ The username + -> Text.Text -- ^ The password + -> Maybe Text -- ^ The desired resource or 'Nothing' to let the server + -- assign one + -> XMPPThread (Either SaslError Text.Text) +auth username passwd resource = runErrorT $ do + ErrorT . withConnection $ xmppSASL username passwd + res <- lift $ xmppBind resource + lift $ startSession + return res + +-- | Connect to an xmpp server connect :: HostName -> Text -> XMPPThread (Either StreamError ()) connect address hostname = withConnection $ xmppConnect address hostname diff --git a/src/Network/XMPP/Bind.hs b/src/Network/XMPP/Bind.hs index 51be0c3..b525923 100644 --- a/src/Network/XMPP/Bind.hs +++ b/src/Network/XMPP/Bind.hs @@ -40,8 +40,8 @@ jidP = bindP $ xpElemNodes "jid" (xpContent xpPrim) -- server-generated resource and extract the JID from the non-error -- response. -xmppThreadedBind :: Maybe Text -> XMPPThread Text -xmppThreadedBind rsrc = do +xmppBind :: Maybe Text -> XMPPThread Text +xmppBind rsrc = do answer <- sendIQ' Nothing Set Nothing (bindBody rsrc) let (Right IQResult{iqResultPayload = Just b}) = answer -- TODO: Error handling let Right (JID _n _d (Just r)) = unpickleElem jidP b diff --git a/src/Network/XMPP/Concurrent.hs b/src/Network/XMPP/Concurrent.hs index c360236..fe15713 100644 --- a/src/Network/XMPP/Concurrent.hs +++ b/src/Network/XMPP/Concurrent.hs @@ -1,9 +1,10 @@ module Network.XMPP.Concurrent -( module Network.XMPP.Concurrent.Types -, module Network.XMPP.Concurrent.Monad -, module Network.XMPP.Concurrent.Threads -, module Network.XMPP.Concurrent.IQ -) where + ( Thread + , XMPPThread + , module Network.XMPP.Concurrent.Monad + , module Network.XMPP.Concurrent.Threads + , module Network.XMPP.Concurrent.IQ + ) where import Network.XMPP.Concurrent.Types import Network.XMPP.Concurrent.Monad diff --git a/src/Network/XMPP/Concurrent/Monad.hs b/src/Network/XMPP/Concurrent/Monad.hs index 4ec4c78..f4a9f23 100644 --- a/src/Network/XMPP/Concurrent/Monad.hs +++ b/src/Network/XMPP/Concurrent/Monad.hs @@ -18,20 +18,23 @@ import Network.XMPP.Monad -- | Register a new IQ listener. IQ requests matching the type and namespace will -- be put in the channel. +-- +-- Return the new channel or Nothing if this namespace/'IQRequestType' +-- combination was alread handled listenIQChan :: IQRequestType -- ^ type of IQs to receive (Get / Set) -> Text -- ^ namespace of the child element - -> XMPPThread (Bool, TChan (IQRequest, TVar Bool)) + -> XMPPThread (Maybe ( TChan (IQRequest, TVar Bool))) listenIQChan tp ns = do handlers <- asks iqHandlers liftIO . atomically $ do (byNS, byID) <- readTVar handlers iqCh <- newTChan - let (present, byNS') = Map.insertLookupWithKey' (\_ new _ -> new) + let (present, byNS') = Map.insertLookupWithKey' (\_ _ old -> old) (tp,ns) iqCh byNS writeTVar handlers (byNS', byID) return $ case present of - Nothing -> (True, iqCh) - Just iqCh' -> (False, iqCh') + Nothing -> Just iqCh + Just iqCh' -> Nothing -- | get the inbound stanza channel, duplicates from master if necessary -- please note that once duplicated it will keep filling up, call diff --git a/src/Network/XMPP/Concurrent/Types.hs b/src/Network/XMPP/Concurrent/Types.hs index 3f741f1..fa15f7e 100644 --- a/src/Network/XMPP/Concurrent/Types.hs +++ b/src/Network/XMPP/Concurrent/Types.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE DeriveDataTypeable #-} module Network.XMPP.Concurrent.Types where diff --git a/src/Network/XMPP/JID.hs b/src/Network/XMPP/JID.hs index 304a098..9d44130 100644 --- a/src/Network/XMPP/JID.hs +++ b/src/Network/XMPP/JID.hs @@ -37,16 +37,41 @@ import qualified Data.Text as Text import qualified Text.NamePrep as SP import qualified Text.StringPrep as SP --- | --- @From@ is a readability type synonym for @Address@. - --- | Jabber ID (JID) datatype -data JID = JID { localpart :: !(Maybe Text) - -- ^ Account name +data JID = JID { + -- | The @localpart@ of a JID is an optional identifier + -- placed before the domainpart and separated from the + -- latter by a \'\@\' character. Typically a + -- localpart uniquely identifies the entity requesting + -- and using network access provided by a server + -- (i.e., a local account), although it can also + -- represent other kinds of entities (e.g., a chat + -- room associated with a multi-user chat service). + -- The entity represented by an XMPP localpart is + -- addressed within the context of a specific domain + -- (i.e., @localpart\@domainpart@). + + localpart :: !(Maybe Text) + -- | The domainpart typically identifies the /home/ + -- server to which clients connect for XML routing and + -- data management functionality. However, it is not + -- necessary for an XMPP domainpart to identify an + -- entity that provides core XMPP server functionality + -- (e.g., a domainpart can identify an entity such as a + -- multi-user chat service, a publish-subscribe + -- service, or a user directory). , domainpart :: !Text - -- ^ Server adress + -- | The resourcepart of a JID is an optional + -- identifier placed after the domainpart and + -- separated from the latter by the \'\/\' character. A + -- resourcepart can modify either a + -- @localpart\@domainpart@ address or a mere + -- @domainpart@ address. Typically a resourcepart + -- uniquely identifies a specific connection (e.g., a + -- device or location) or object (e.g., an occupant + -- in a multi-user chat room) belonging to the entity + -- associated with an XMPP localpart at a domain + -- (i.e., @localpart\@domainpart/resourcepart@). , resourcepart :: !(Maybe Text) - -- ^ Resource name } instance Show JID where @@ -64,8 +89,7 @@ instance Read JID where instance IsString JID where fromString = fromJust . fromText . Text.pack --- | --- Converts a string to a JID. +-- | Converts a Text to a JID. fromText :: Text -> Maybe JID fromText t = do (l, d, r) <- eitherToMaybe $ AP.parseOnly jidParts t @@ -73,9 +97,7 @@ fromText t = do where eitherToMaybe = either (const Nothing) Just - --- | --- Converts localpart, domainpart, and resourcepart strings to a JID. +-- | Converts localpart, domainpart, and resourcepart strings to a JID. -- Runs the appropriate stringprep profiles and validates the parts. fromStrings :: Maybe Text -> Text -> Maybe Text -> Maybe JID fromStrings l d r = do @@ -108,7 +130,7 @@ fromStrings l d r = do -- validHostname :: Text -> Bool -- validHostname _ = True -- TODO --- | Returns True if the JID is `bare', and False otherwise. +-- | Returns True if the JID is /bare/, and False otherwise. isBare :: JID -> Bool isBare j | resourcepart j == Nothing = True | otherwise = False diff --git a/src/Network/XMPP/Message.hs b/src/Network/XMPP/Message.hs index 6d1dadc..b472dba 100644 --- a/src/Network/XMPP/Message.hs +++ b/src/Network/XMPP/Message.hs @@ -1,11 +1,21 @@ {-# LANGUAGE RecordWildCards #-} -module Network.XMPP.Message where +-- | Message handling +module Network.XMPP.Message + ( Message(..) + , MessageType(..) + , MessageError(..) + , message + , simpleMessage + , answerMessage + ) + where import Data.Text(Text) import Data.XML.Types import Network.XMPP.Types +-- The empty message message :: Message message = Message { messageID = Nothing , messageFrom = Nothing @@ -18,7 +28,11 @@ message = Message { messageID = Nothing , messagePayload = [] } -simpleMessage :: JID -> Text -> Message + +-- | Create simple message, containing nothing but a body text +simpleMessage :: JID -- ^ Recipient + -> Text -- ^ Myssage body + -> Message simpleMessage to txt = message { messageTo = Just to , messageBody = Just txt } diff --git a/src/Network/XMPP/Presence.hs b/src/Network/XMPP/Presence.hs index f948596..501f60f 100644 --- a/src/Network/XMPP/Presence.hs +++ b/src/Network/XMPP/Presence.hs @@ -1,9 +1,10 @@ +{-# OPTIONS_HADDOCK hide #-} module Network.XMPP.Presence where import Data.Text(Text) import Network.XMPP.Types - +-- | The empty presence. presence :: Presence presence = Presence { presenceID = Nothing , presenceFrom = Nothing @@ -16,6 +17,7 @@ presence = Presence { presenceID = Nothing , presencePayload = [] } +-- | Request subscription with an entity presenceSubscribe :: JID -> Presence presenceSubscribe to = presence { presenceTo = Just to , presenceType = Just Subscribe @@ -45,14 +47,15 @@ presenceUnsubscribe to = presence { presenceTo = Just to isPresenceUnsubscribe :: Presence -> Bool isPresenceUnsubscribe pres = presenceType pres == (Just Unsubscribe) --- | Signals to the server that the client is available for communication +-- | Signal to the server that the client is available for communication presenceOnline :: Presence presenceOnline = presence --- | Signals to the server that the client is no longer available for communication. +-- | Signal to the server that the client is no longer available for communication. presenceOffline :: Presence presenceOffline = presence {presenceType = Just Unavailable} +-- Change your status status :: Maybe Text -- ^ Status message -> Maybe ShowType -- ^ Status Type @@ -63,16 +66,16 @@ status txt showType prio = presence { presenceShowType = showType , presenceStatus = txt } --- | Sets the current availability status. This implicitly sets the clients +-- | Set the current availability status. This implicitly sets the clients -- status online presenceAvail :: ShowType -> Presence presenceAvail showType = status Nothing (Just showType) Nothing --- | Sets the current status message. This implicitly sets the clients +-- | Set the current status message. This implicitly sets the clients -- status online presenceMessage :: Text -> Presence presenceMessage txt = status (Just txt) Nothing Nothing --- | Adds a recipient to a presence notification +-- | Add a recipient to a presence notification presTo :: Presence -> JID -> Presence presTo pres to = pres{presenceTo = Just to} \ No newline at end of file diff --git a/src/Network/XMPP/TLS.hs b/src/Network/XMPP/TLS.hs index b5a91a4..8cfc0a4 100644 --- a/src/Network/XMPP/TLS.hs +++ b/src/Network/XMPP/TLS.hs @@ -36,6 +36,7 @@ exampleParams = TLS.defaultParams return TLS.CertificateUsageAccept } +-- | Error conditions that may arise during TLS negotiation. data XMPPTLSError = TLSError TLSError | TLSNoServerSupport | TLSNoConnection diff --git a/src/Network/XMPP/Types.hs b/src/Network/XMPP/Types.hs index b08d15e..c8f4619 100644 --- a/src/Network/XMPP/Types.hs +++ b/src/Network/XMPP/Types.hs @@ -117,10 +117,6 @@ data Stanza = IQRequestS IQRequest -- | -- A "request" Info/Query (IQ) stanza is one with either "get" or -- "set" as type. They are guaranteed to always contain a payload. --- --- Objects of this type cannot be generated by Pontarius applications, --- but are only created internally. - data IQRequest = IQRequest { iqRequestID :: StanzaId , iqRequestFrom :: Maybe JID , iqRequestTo :: Maybe JID @@ -130,7 +126,7 @@ data IQRequest = IQRequest { iqRequestID :: StanzaId } deriving (Show) - +-- | The type of request that is made data IQRequestType = Get | Set deriving (Eq, Ord) instance Show IQRequestType where @@ -142,21 +138,12 @@ instance Read IQRequestType where readsPrec _ "set" = [(Set, "")] readsPrec _ _ = [] - --- | --- A "response" Info/Query (IQ) stanza is one with either "result" or --- "error" as type. We have devided IQ responses into two types. --- --- Objects of this type cannot be generated by Pontarius applications, --- but are only created internally. +-- | A "response" Info/Query (IQ) stanza is eitheran 'IQError' or an IQ stanza +-- with the type "result" ('IQResult') type IQResponse = Either IQError IQResult - --- | --- Objects of this type cannot be generated by Pontarius applications, --- but are only created internally. - +-- | The answer to an IQ request data IQResult = IQResult { iqResultID :: StanzaId , iqResultFrom :: Maybe JID , iqResultTo :: Maybe JID @@ -164,11 +151,7 @@ data IQResult = IQResult { iqResultID :: StanzaId , iqResultPayload :: Maybe Element } deriving (Show) - --- | --- Objects of this type cannot be generated by Pontarius applications, --- but are only created internally. - +-- | The answer to an IQ request that generated an error data IQError = IQError { iqErrorID :: StanzaId , iqErrorFrom :: Maybe JID , iqErrorTo :: Maybe JID @@ -178,12 +161,7 @@ data IQError = IQError { iqErrorID :: StanzaId } deriving (Show) --- | --- A non-error message stanza. --- --- Objects of this type cannot be generated by Pontarius applications, --- but are only created internally. - +-- | The message stanza. Used for /push/ type communication data Message = Message { messageID :: Maybe StanzaId , messageFrom :: Maybe JID , messageTo :: Maybe JID @@ -196,13 +174,7 @@ data Message = Message { messageID :: Maybe StanzaId } deriving (Show) - --- | --- An error message stanza. --- --- Objects of this type cannot be generated by Pontarius applications, --- but are only created internally. - +-- | An error stanza generated in response to a 'Message' data MessageError = MessageError { messageErrorID :: Maybe StanzaId , messageErrorFrom :: Maybe JID , messageErrorTo :: Maybe JID @@ -213,15 +185,47 @@ data MessageError = MessageError { messageErrorID :: Maybe StanzaId deriving (Show) --- | --- @MessageType@ holds XMPP message types as defined in XMPP-IM. The --- "error" message type is left out as errors are wrapped in --- @MessageError@. - -data MessageType = Chat | -- ^ - GroupChat | -- ^ - Headline | -- ^ - Normal -- ^ The default message type +-- | The type of a Message being sent +-- () +data MessageType = -- | The message is sent in the context of a one-to-one chat + -- session. Typically an interactive client will present a + -- message of type /chat/ in an interface that enables + -- one-to-one chat between the two parties, including an + -- appropriate conversation history. + Chat + -- | The message is sent in the context of a + -- multi-user chat environment (similar to that of + -- @IRC@). Typically a receiving client will + -- present a message of type /groupchat/ in an + -- interface that enables many-to-many chat + -- between the parties, including a roster of + -- parties in the chatroom and an appropriate + -- conversation history. + | GroupChat + -- | The message provides an alert, a + -- notification, or other transient information to + -- which no reply is expected (e.g., news + -- headlines, sports updates, near-real-time + -- market data, or syndicated content). Because no + -- reply to the message is expected, typically a + -- receiving client will present a message of type + -- /headline/ in an interface that appropriately + -- differentiates the message from standalone + -- messages, chat messages, and groupchat messages + -- (e.g., by not providing the recipient with the + -- ability to reply). + | Headline + -- | The message is a standalone message that is + -- sent outside the context of a one-to-one + -- conversation or groupchat, and to which it is + -- expected that the recipient will + -- reply. Typically a receiving client will + -- present a message of type /normal/ in an + -- interface that enables the recipient to reply, + -- but without a conversation history. + -- + -- This is the /default/ value + | Normal deriving (Eq) diff --git a/src/Tests.hs b/src/Tests.hs index ff194c4..cca1d1f 100644 --- a/src/Tests.hs +++ b/src/Tests.hs @@ -53,9 +53,11 @@ payloadP = xpWrap (\((counter,flag) , message) -> Payload counter flag message) invertPayload (Payload count flag message) = Payload (count + 1) (not flag) (Text.reverse message) iqResponder = do - (free, chan) <- listenIQChan Get testNS - unless free $ liftIO $ putStrLn "Channel was already taken" - >> error "hanging up" + chan' <- listenIQChan Get testNS + chan <- case chan' of + Nothing -> liftIO $ putStrLn "Channel was already taken" + >> error "hanging up" + Just c -> return c forever $ do next@(iq,_) <- liftIO . atomically $ readTChan chan let Right payload = unpickleElem payloadP $ iqRequestPayload iq @@ -95,12 +97,10 @@ runMain debug number = do debug' "running" connect "localhost" "species64739.dyndns.org" startTLS exampleParams - saslResponse <- auth (fromJust $ localpart we) "pwd" + saslResponse <- auth (fromJust $ localpart we) "pwd" (resourcepart we) case saslResponse of Right _ -> return () - Left e -> error e - xmppThreadedBind (resourcepart we) - startSession + Left e -> error "saslerror" debug' "session standing" sendPresence presenceOnline forkXMPP autoAccept diff --git a/src/Text/XML/Stream/Elements.hs b/src/Text/XML/Stream/Elements.hs index 952854d..4be9ff6 100644 --- a/src/Text/XML/Stream/Elements.hs +++ b/src/Text/XML/Stream/Elements.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_HADDOCK hide #-} module Text.XML.Stream.Elements where import Control.Applicative ((<$>))