Browse Source

preliminary shaping of API structure, documentation

master
Philipp Balzarek 14 years ago
parent
commit
f2ab31fe71
  1. 8
      pontarius.cabal
  2. 1
      src/Data/Conduit/TLS.hs
  3. 152
      src/Network/XMPP.hs
  4. 4
      src/Network/XMPP/Bind.hs
  5. 3
      src/Network/XMPP/Concurrent.hs
  6. 11
      src/Network/XMPP/Concurrent/Monad.hs
  7. 1
      src/Network/XMPP/Concurrent/Types.hs
  8. 50
      src/Network/XMPP/JID.hs
  9. 18
      src/Network/XMPP/Message.hs
  10. 15
      src/Network/XMPP/Presence.hs
  11. 1
      src/Network/XMPP/TLS.hs
  12. 92
      src/Network/XMPP/Types.hs
  13. 12
      src/Tests.hs
  14. 1
      src/Text/XML/Stream/Elements.hs

8
pontarius.cabal

@ -12,7 +12,7 @@ Stability: alpha
Bug-Reports: mailto:jon.kristensen@nejla.com Bug-Reports: mailto:jon.kristensen@nejla.com
-- Package-URL: -- Package-URL:
Synopsis: An incomplete implementation of RFC 6120 (XMPP: Core) 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). RFC 6120 (XMPP: Core).
Category: Network Category: Network
Tested-With: GHC == 7.4.1 Tested-With: GHC == 7.4.1
@ -61,8 +61,10 @@ Library
, Network.XMPP.TLS , Network.XMPP.TLS
, Network.XMPP.Bind , Network.XMPP.Bind
, Network.XMPP.Session , Network.XMPP.Session
, Text.XML.Stream.Elements Other-modules: Network.XMPP.JID
, Data.Conduit.TLS , Network.XMPP.Concurrent.IQ
, Network.XMPP.Concurrent.Threads
, Network.XMPP.Concurrent.Monad
GHC-Options: -Wall GHC-Options: -Wall

1
src/Data/Conduit/TLS.hs

@ -1,4 +1,5 @@
{-# Language NoMonomorphismRestriction #-} {-# Language NoMonomorphismRestriction #-}
{-# OPTIONS_HADDOCK hide #-}
module Data.Conduit.TLS module Data.Conduit.TLS
( tlsinit ( tlsinit
-- , conduitStdout -- , conduitStdout

152
src/Network/XMPP.hs

@ -13,9 +13,12 @@
-- Stability: unstable -- Stability: unstable
-- Portability: portable -- Portability: portable
-- --
-- XMPP is an open standard, extendable, and secure communications -- The Extensible Messaging and Presence Protocol (XMPP) is an open technology for
-- protocol designed on top of XML, TLS, and SASL. Pontarius XMPP is -- real-time communication, which powers a wide range of applications including
-- an XMPP client library, implementing the core capabilities of XMPP -- 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). -- (RFC 6120).
-- --
-- Developers using this library are assumed to understand how XMPP -- Developers using this library are assumed to understand how XMPP
@ -30,21 +33,109 @@
{-# LANGUAGE NoMonomorphismRestriction, OverloadedStrings #-} {-# LANGUAGE NoMonomorphismRestriction, OverloadedStrings #-}
module Network.XMPP module Network.XMPP
( module Network.XMPP.Bind ( -- * Session management
, module Network.XMPP.Concurrent xmppNewSession
, 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
, connect , connect
, startTLS , startTLS
, auth , 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.
--
-- <http://xmpp.org/rfcs/rfc6120.html#stanzas-semantics-message>
, 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.
--
-- <http://xmpp.org/rfcs/rfc6120.html#stanzas-semantics-presence>
, 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)
--
-- <http://xmpp.org/rfcs/rfc6120.html#stanzas-semantics-iq>
, IQRequest(..)
, IQRequestType(..)
, IQResult(..)
, IQError(..)
, sendIQ
, sendIQ'
, answerIQ
, listenIQChan
, iqRequestPayload
, iqResultPayload
-- * Threads
, XMPPThread
, forkXMPP
-- * Misc
, exampleParams
) where ) where
import Data.Text as Text import Data.Text as Text
@ -53,27 +144,46 @@ import Network
import qualified Network.TLS as TLS import qualified Network.TLS as TLS
import Network.XMPP.Bind import Network.XMPP.Bind
import Network.XMPP.Concurrent import Network.XMPP.Concurrent
import Network.XMPP.Message import Network.XMPP.Message hiding (message)
import Network.XMPP.Monad import Network.XMPP.Monad
import Network.XMPP.Presence import Network.XMPP.Presence hiding (presence)
import Network.XMPP.SASL import Network.XMPP.SASL
import Network.XMPP.Session import Network.XMPP.Session
import Network.XMPP.Stream import Network.XMPP.Stream
import Network.XMPP.TLS import Network.XMPP.TLS
import Network.XMPP.Types import Network.XMPP.Types
xmppConnect :: HostName -> Text -> XMPPConMonad (Either StreamError ()) import Control.Monad.Error
xmppConnect address hostname = xmppRawConnect address hostname >> xmppStartStream
-- | Create a new, pristine session without an active connection.
xmppNewSession :: XMPPThread a -> IO (a, XMPPConState) xmppNewSession :: XMPPThread a -> IO (a, XMPPConState)
xmppNewSession = withNewSession . runThreaded 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 :: TLS.TLSParams -> XMPPThread (Either XMPPTLSError ())
startTLS = withConnection . xmppStartTLS 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 :: HostName -> Text -> XMPPThread (Either StreamError ())
connect address hostname = withConnection $ xmppConnect address hostname connect address hostname = withConnection $ xmppConnect address hostname

4
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 -- server-generated resource and extract the JID from the non-error
-- response. -- response.
xmppThreadedBind :: Maybe Text -> XMPPThread Text xmppBind :: Maybe Text -> XMPPThread Text
xmppThreadedBind rsrc = do xmppBind rsrc = do
answer <- sendIQ' Nothing Set Nothing (bindBody rsrc) answer <- sendIQ' Nothing Set Nothing (bindBody rsrc)
let (Right IQResult{iqResultPayload = Just b}) = answer -- TODO: Error handling let (Right IQResult{iqResultPayload = Just b}) = answer -- TODO: Error handling
let Right (JID _n _d (Just r)) = unpickleElem jidP b let Right (JID _n _d (Just r)) = unpickleElem jidP b

3
src/Network/XMPP/Concurrent.hs

@ -1,5 +1,6 @@
module Network.XMPP.Concurrent module Network.XMPP.Concurrent
( module Network.XMPP.Concurrent.Types ( Thread
, XMPPThread
, module Network.XMPP.Concurrent.Monad , module Network.XMPP.Concurrent.Monad
, module Network.XMPP.Concurrent.Threads , module Network.XMPP.Concurrent.Threads
, module Network.XMPP.Concurrent.IQ , module Network.XMPP.Concurrent.IQ

11
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 -- | Register a new IQ listener. IQ requests matching the type and namespace will
-- be put in the channel. -- 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) listenIQChan :: IQRequestType -- ^ type of IQs to receive (Get / Set)
-> Text -- ^ namespace of the child element -> Text -- ^ namespace of the child element
-> XMPPThread (Bool, TChan (IQRequest, TVar Bool)) -> XMPPThread (Maybe ( TChan (IQRequest, TVar Bool)))
listenIQChan tp ns = do listenIQChan tp ns = do
handlers <- asks iqHandlers handlers <- asks iqHandlers
liftIO . atomically $ do liftIO . atomically $ do
(byNS, byID) <- readTVar handlers (byNS, byID) <- readTVar handlers
iqCh <- newTChan iqCh <- newTChan
let (present, byNS') = Map.insertLookupWithKey' (\_ new _ -> new) let (present, byNS') = Map.insertLookupWithKey' (\_ _ old -> old)
(tp,ns) iqCh byNS (tp,ns) iqCh byNS
writeTVar handlers (byNS', byID) writeTVar handlers (byNS', byID)
return $ case present of return $ case present of
Nothing -> (True, iqCh) Nothing -> Just iqCh
Just iqCh' -> (False, iqCh') Just iqCh' -> Nothing
-- | get the inbound stanza channel, duplicates from master if necessary -- | get the inbound stanza channel, duplicates from master if necessary
-- please note that once duplicated it will keep filling up, call -- please note that once duplicated it will keep filling up, call

1
src/Network/XMPP/Concurrent/Types.hs

@ -1,3 +1,4 @@
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
module Network.XMPP.Concurrent.Types where module Network.XMPP.Concurrent.Types where

50
src/Network/XMPP/JID.hs

@ -37,16 +37,41 @@ import qualified Data.Text as Text
import qualified Text.NamePrep as SP import qualified Text.NamePrep as SP
import qualified Text.StringPrep as SP import qualified Text.StringPrep as SP
-- | data JID = JID {
-- @From@ is a readability type synonym for @Address@. -- | The @localpart@ of a JID is an optional identifier
-- placed before the domainpart and separated from the
-- | Jabber ID (JID) datatype -- latter by a \'\@\' character. Typically a
data JID = JID { localpart :: !(Maybe Text) -- localpart uniquely identifies the entity requesting
-- ^ Account name -- 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 , 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) , resourcepart :: !(Maybe Text)
-- ^ Resource name
} }
instance Show JID where instance Show JID where
@ -64,8 +89,7 @@ instance Read JID where
instance IsString JID where instance IsString JID where
fromString = fromJust . fromText . Text.pack fromString = fromJust . fromText . Text.pack
-- | -- | Converts a Text to a JID.
-- Converts a string to a JID.
fromText :: Text -> Maybe JID fromText :: Text -> Maybe JID
fromText t = do fromText t = do
(l, d, r) <- eitherToMaybe $ AP.parseOnly jidParts t (l, d, r) <- eitherToMaybe $ AP.parseOnly jidParts t
@ -73,9 +97,7 @@ fromText t = do
where where
eitherToMaybe = either (const Nothing) Just 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. -- Runs the appropriate stringprep profiles and validates the parts.
fromStrings :: Maybe Text -> Text -> Maybe Text -> Maybe JID fromStrings :: Maybe Text -> Text -> Maybe Text -> Maybe JID
fromStrings l d r = do fromStrings l d r = do
@ -108,7 +130,7 @@ fromStrings l d r = do
-- validHostname :: Text -> Bool -- validHostname :: Text -> Bool
-- validHostname _ = True -- TODO -- 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 :: JID -> Bool
isBare j | resourcepart j == Nothing = True isBare j | resourcepart j == Nothing = True
| otherwise = False | otherwise = False

18
src/Network/XMPP/Message.hs

@ -1,11 +1,21 @@
{-# LANGUAGE RecordWildCards #-} {-# 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.Text(Text)
import Data.XML.Types import Data.XML.Types
import Network.XMPP.Types import Network.XMPP.Types
-- The empty message
message :: Message message :: Message
message = Message { messageID = Nothing message = Message { messageID = Nothing
, messageFrom = Nothing , messageFrom = Nothing
@ -18,7 +28,11 @@ message = Message { messageID = Nothing
, messagePayload = [] , 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 simpleMessage to txt = message { messageTo = Just to
, messageBody = Just txt , messageBody = Just txt
} }

15
src/Network/XMPP/Presence.hs

@ -1,9 +1,10 @@
{-# OPTIONS_HADDOCK hide #-}
module Network.XMPP.Presence where module Network.XMPP.Presence where
import Data.Text(Text) import Data.Text(Text)
import Network.XMPP.Types import Network.XMPP.Types
-- | The empty presence.
presence :: Presence presence :: Presence
presence = Presence { presenceID = Nothing presence = Presence { presenceID = Nothing
, presenceFrom = Nothing , presenceFrom = Nothing
@ -16,6 +17,7 @@ presence = Presence { presenceID = Nothing
, presencePayload = [] , presencePayload = []
} }
-- | Request subscription with an entity
presenceSubscribe :: JID -> Presence presenceSubscribe :: JID -> Presence
presenceSubscribe to = presence { presenceTo = Just to presenceSubscribe to = presence { presenceTo = Just to
, presenceType = Just Subscribe , presenceType = Just Subscribe
@ -45,14 +47,15 @@ presenceUnsubscribe to = presence { presenceTo = Just to
isPresenceUnsubscribe :: Presence -> Bool isPresenceUnsubscribe :: Presence -> Bool
isPresenceUnsubscribe pres = presenceType pres == (Just Unsubscribe) 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
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
presenceOffline = presence {presenceType = Just Unavailable} presenceOffline = presence {presenceType = Just Unavailable}
-- Change your status
status status
:: Maybe Text -- ^ Status message :: Maybe Text -- ^ Status message
-> Maybe ShowType -- ^ Status Type -> Maybe ShowType -- ^ Status Type
@ -63,16 +66,16 @@ status txt showType prio = presence { presenceShowType = showType
, presenceStatus = txt , presenceStatus = txt
} }
-- | Sets the current availability status. This implicitly sets the clients -- | Set the current availability status. This implicitly sets the clients
-- status online -- status online
presenceAvail :: ShowType -> Presence presenceAvail :: ShowType -> Presence
presenceAvail showType = status Nothing (Just showType) Nothing 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 -- status online
presenceMessage :: Text -> Presence presenceMessage :: Text -> Presence
presenceMessage txt = status (Just txt) Nothing Nothing 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 :: Presence -> JID -> Presence
presTo pres to = pres{presenceTo = Just to} presTo pres to = pres{presenceTo = Just to}

1
src/Network/XMPP/TLS.hs

@ -36,6 +36,7 @@ exampleParams = TLS.defaultParams
return TLS.CertificateUsageAccept return TLS.CertificateUsageAccept
} }
-- | Error conditions that may arise during TLS negotiation.
data XMPPTLSError = TLSError TLSError data XMPPTLSError = TLSError TLSError
| TLSNoServerSupport | TLSNoServerSupport
| TLSNoConnection | TLSNoConnection

92
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 -- A "request" Info/Query (IQ) stanza is one with either "get" or
-- "set" as type. They are guaranteed to always contain a payload. -- "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 data IQRequest = IQRequest { iqRequestID :: StanzaId
, iqRequestFrom :: Maybe JID , iqRequestFrom :: Maybe JID
, iqRequestTo :: Maybe JID , iqRequestTo :: Maybe JID
@ -130,7 +126,7 @@ data IQRequest = IQRequest { iqRequestID :: StanzaId
} }
deriving (Show) deriving (Show)
-- | The type of request that is made
data IQRequestType = Get | Set deriving (Eq, Ord) data IQRequestType = Get | Set deriving (Eq, Ord)
instance Show IQRequestType where instance Show IQRequestType where
@ -142,21 +138,12 @@ instance Read IQRequestType where
readsPrec _ "set" = [(Set, "")] readsPrec _ "set" = [(Set, "")]
readsPrec _ _ = [] readsPrec _ _ = []
-- | A "response" Info/Query (IQ) stanza is eitheran 'IQError' or an IQ stanza
-- | -- with the type "result" ('IQResult')
-- 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.
type IQResponse = Either IQError IQResult type IQResponse = Either IQError IQResult
-- | The answer to an IQ request
-- |
-- Objects of this type cannot be generated by Pontarius applications,
-- but are only created internally.
data IQResult = IQResult { iqResultID :: StanzaId data IQResult = IQResult { iqResultID :: StanzaId
, iqResultFrom :: Maybe JID , iqResultFrom :: Maybe JID
, iqResultTo :: Maybe JID , iqResultTo :: Maybe JID
@ -164,11 +151,7 @@ data IQResult = IQResult { iqResultID :: StanzaId
, iqResultPayload :: Maybe Element } , iqResultPayload :: Maybe Element }
deriving (Show) deriving (Show)
-- | The answer to an IQ request that generated an error
-- |
-- Objects of this type cannot be generated by Pontarius applications,
-- but are only created internally.
data IQError = IQError { iqErrorID :: StanzaId data IQError = IQError { iqErrorID :: StanzaId
, iqErrorFrom :: Maybe JID , iqErrorFrom :: Maybe JID
, iqErrorTo :: Maybe JID , iqErrorTo :: Maybe JID
@ -178,12 +161,7 @@ data IQError = IQError { iqErrorID :: StanzaId
} }
deriving (Show) deriving (Show)
-- | -- | The message stanza. Used for /push/ type communication
-- A non-error message stanza.
--
-- Objects of this type cannot be generated by Pontarius applications,
-- but are only created internally.
data Message = Message { messageID :: Maybe StanzaId data Message = Message { messageID :: Maybe StanzaId
, messageFrom :: Maybe JID , messageFrom :: Maybe JID
, messageTo :: Maybe JID , messageTo :: Maybe JID
@ -196,13 +174,7 @@ data Message = Message { messageID :: Maybe StanzaId
} }
deriving (Show) deriving (Show)
-- | An error stanza generated in response to a 'Message'
-- |
-- An error message stanza.
--
-- Objects of this type cannot be generated by Pontarius applications,
-- but are only created internally.
data MessageError = MessageError { messageErrorID :: Maybe StanzaId data MessageError = MessageError { messageErrorID :: Maybe StanzaId
, messageErrorFrom :: Maybe JID , messageErrorFrom :: Maybe JID
, messageErrorTo :: Maybe JID , messageErrorTo :: Maybe JID
@ -213,15 +185,47 @@ data MessageError = MessageError { messageErrorID :: Maybe StanzaId
deriving (Show) deriving (Show)
-- | -- | The type of a Message being sent
-- @MessageType@ holds XMPP message types as defined in XMPP-IM. The -- (<http://xmpp.org/rfcs/rfc6121.html#message-syntax-type>)
-- "error" message type is left out as errors are wrapped in data MessageType = -- | The message is sent in the context of a one-to-one chat
-- @MessageError@. -- session. Typically an interactive client will present a
-- message of type /chat/ in an interface that enables
data MessageType = Chat | -- ^ -- one-to-one chat between the two parties, including an
GroupChat | -- ^ -- appropriate conversation history.
Headline | -- ^ Chat
Normal -- ^ The default message type -- | 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) deriving (Eq)

12
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) invertPayload (Payload count flag message) = Payload (count + 1) (not flag) (Text.reverse message)
iqResponder = do iqResponder = do
(free, chan) <- listenIQChan Get testNS chan' <- listenIQChan Get testNS
unless free $ liftIO $ putStrLn "Channel was already taken" chan <- case chan' of
Nothing -> liftIO $ putStrLn "Channel was already taken"
>> error "hanging up" >> error "hanging up"
Just c -> return c
forever $ do forever $ do
next@(iq,_) <- liftIO . atomically $ readTChan chan next@(iq,_) <- liftIO . atomically $ readTChan chan
let Right payload = unpickleElem payloadP $ iqRequestPayload iq let Right payload = unpickleElem payloadP $ iqRequestPayload iq
@ -95,12 +97,10 @@ runMain debug number = do
debug' "running" debug' "running"
connect "localhost" "species64739.dyndns.org" connect "localhost" "species64739.dyndns.org"
startTLS exampleParams startTLS exampleParams
saslResponse <- auth (fromJust $ localpart we) "pwd" saslResponse <- auth (fromJust $ localpart we) "pwd" (resourcepart we)
case saslResponse of case saslResponse of
Right _ -> return () Right _ -> return ()
Left e -> error e Left e -> error "saslerror"
xmppThreadedBind (resourcepart we)
startSession
debug' "session standing" debug' "session standing"
sendPresence presenceOnline sendPresence presenceOnline
forkXMPP autoAccept forkXMPP autoAccept

1
src/Text/XML/Stream/Elements.hs

@ -1,3 +1,4 @@
{-# OPTIONS_HADDOCK hide #-}
module Text.XML.Stream.Elements where module Text.XML.Stream.Elements where
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))

Loading…
Cancel
Save