pontarius-xmpp-0.0.4.0: Network/XMPP/Stanza.hs
{-
Copyright © 2010-2011 Jon Kristensen.
This file is part of Pontarius XMPP.
Pontarius XMPP is free software: you can redistribute it and/or modify it under
the terms of the GNU Lesser General Public License as published by the Free
Software Foundation, either version 3 of the License, or (at your option) any
later version.
Pontarius XMPP is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
details.
You should have received a copy of the GNU Lesser General Public License along
with Pontarius XMPP. If not, see <http://www.gnu.org/licenses/>.
-}
-- | Module: $Header$
-- Description: XMPP stanza types and utility functions
-- Copyright: Copyright © 2010-2011 Jon Kristensen
-- License: LGPL-3
--
-- Maintainer: info@pontarius.org
-- Stability: unstable
-- Portability: portable
--
-- This module will be documented soon.
-- Received stanzas can be assumed to have their ID and to fields set.
-- TODO: Handle error stanzas
module Network.XMPP.Stanza ( StanzaID (SID)
, From
, To
, XMLLang
, Stanza (..)
, MessageType (..)
, Message (..)
, message
, PresenceType (..)
, Presence (..)
, presence
, IQ (..)
, getId -- Just return the Id of existing IQ
, iqGet
, iqSet
, iqResult
, iqStanza
, iqAck
, iqPayloadNamespace
, iqPayload ) where
import Network.XMPP.JID
import Data.XML.Types
import qualified Data.Text as DT
import Data.Maybe (fromJust)
data StanzaID = SID String deriving (Eq, Show)
type From = JID
type To = JID
type XMLLang = String -- Validate, protect
data Stanza = Stanza { stanzaID :: Maybe StanzaID
, stanzaFrom :: Maybe From
, stanzaTo :: Maybe To
, stanzaLang :: Maybe XMLLang } deriving (Eq, Show)
stanza :: Maybe StanzaID -> Maybe From -> Maybe To -> Maybe XMLLang -> Stanza
stanza i f t l = Stanza { stanzaID = i
, stanzaFrom = f
, stanzaTo = t
, stanzaLang = l }
data MessageType = Chat |
MessageError |
Groupchat |
Headline |
Normal | -- Default
OtherMessageType String deriving (Eq, Show)
data Message = Message { messageStanza :: Stanza
, messageType :: MessageType
, messagePayload :: [Element] } deriving (Eq, Show)
message :: Maybe StanzaID -> Maybe From -> Maybe To -> Maybe XMLLang ->
MessageType -> [Element] -> Message
message i f t l t_ p = Message { messageStanza = stanza i f t l
, messageType = t_
, messagePayload = p }
data PresenceType = Subscribe | -- ^ Sender wants to subscribe to presence
Subscribed | -- ^ Sender has approved the subscription
Unsubscribe | -- ^ Sender is unsubscribing from presence
Unsubscribed | -- ^ Sender has denied or cancelled a
-- subscription
Probe | -- ^ Sender requests current presence;
-- should only be used by servers
PresenceError | -- ^ Processing or delivery of previously
-- sent presence stanza failed
Available | -- Not part of type='' [...]
-- Away |
-- Chat |
-- DoNotDisturb |
-- ExtendedAway |
Unavailable
deriving (Eq, Show)
-- | Presence stanzas are used to express an entity's network availability.
data Presence = Presence { presenceStanza :: Stanza
, presenceType :: PresenceType
, presencePayload :: [Element] } deriving (Eq, Show)
presence :: Maybe StanzaID -> Maybe From -> Maybe To -> Maybe XMLLang ->
PresenceType -> [Element] -> Presence
presence i f t l t_ p = Presence { presenceStanza = Stanza { stanzaID = i
, stanzaFrom = f
, stanzaTo = t
, stanzaLang = l }
, presenceType = t_
, presencePayload = p }
data IQ = IQGet { iqGetStanza :: Stanza, iqGetPayload :: Element } |
IQSet { iqSetStanza :: Stanza, iqSetPayload :: Element } |
IQResult { iqResultStanza :: Stanza
, iqResultPayload :: Maybe Element } deriving (Eq, Show)
iqGet :: Maybe StanzaID -> Maybe From -> Maybe To -> Maybe XMLLang -> Element ->
IQ
iqGet i f t l p = IQGet { iqGetStanza = Stanza { stanzaID = i
, stanzaFrom = f
, stanzaTo = t
, stanzaLang = l }
, iqGetPayload = p }
iqSet :: Maybe StanzaID -> Maybe From -> Maybe To -> Maybe XMLLang -> Element ->
IQ
iqSet i f t l p = IQSet { iqSetStanza = Stanza { stanzaID = i
, stanzaFrom = f
, stanzaTo = t
, stanzaLang = l }
, iqSetPayload = p }
iqResult :: Maybe StanzaID -> Maybe From -> Maybe To -> Maybe XMLLang ->
Maybe Element -> IQ
iqResult i f t l p = IQResult { iqResultStanza = Stanza { stanzaID = i
, stanzaFrom = f
, stanzaTo = t
, stanzaLang = l }
, iqResultPayload = p }
iqAck :: StanzaID -> To -> IQ
iqAck s t = iqResult (Just s) Nothing (Just t) Nothing Nothing
iqStanza :: IQ -> Stanza
iqStanza (IQGet { iqGetStanza = s }) = s
iqStanza (IQSet { iqSetStanza = s }) = s
iqStanza (IQResult { iqResultStanza = s }) = s
iqPayload :: IQ -> Maybe Element
iqPayload (IQGet {iqGetPayload = p}) = Just p
iqPayload (IQSet {iqSetPayload = p}) = Just p
iqPayload (IQResult {iqResultPayload = p}) = p
iqPayloadNamespace :: IQ -> Maybe String
iqPayloadNamespace i = case iqPayload i of
Nothing -> Nothing
Just p -> case nameNamespace $ elementName p of
Nothing -> Nothing
Just n -> Just (DT.unpack n)
-- Get the id from existing IQ
getId :: IQ -> StanzaID
getId iq = fromJust $ stanzaID $ iqStanza iq
-- =============================================================================
-- CODE NOT YET USED
-- =============================================================================
-- | All stanzas (IQ, message, presence) can cause errors, which looks like
-- <stanza-kind to='sender' type='error'>. These errors are of one of the
-- types listed below.
data StanzaErrorType = Cancel | -- ^ Error is unrecoverable - do not retry
Continue | -- ^ Conditition was a warning - proceed
Modify | -- ^ Change the data and retry
Auth | -- ^ Provide credentials and retry
Wait -- ^ Error is temporary - wait and retry
deriving (Eq, Show)
-- | The stanza errors are accommodated with one of the error conditions listed
-- below. The ones that are not self-explainatory should be documented below.
data StanzaErrorCondition = BadRequest | -- ^ Malformed XML
Conflict | -- ^ Resource or session
-- with name already
-- exists
FeatureNotImplemented |
Forbidden | -- ^ Insufficient
-- permissions
Gone | -- ^ Entity can no longer
-- be contacted at this
-- address
InternalServerError |
ItemNotFound |
JIDMalformed |
NotAcceptable | -- ^ Does not meet policy
-- criteria
NotAllowed | -- ^ No entity may perform
-- this action
NotAuthorized | -- ^ Must provide proper
-- credentials
PaymentRequired |
RecipientUnavailable | -- ^ Temporarily
-- unavailable
Redirect | -- ^ Redirecting to other
-- entity, usually
-- temporarily
RegistrationRequired |
RemoteServerNotFound |
RemoteServerTimeout |
ResourceConstraint | -- ^ Entity lacks the
-- necessary system
-- resources
ServiceUnavailable |
SubscriptionRequired |
UndefinedCondition | -- ^ Application-specific
-- condition
UnexpectedRequest -- ^ Badly timed request
deriving (Eq, Show)
-- IM/RFC:
-- data PresenceStatus = PS String deriving (Eq, Show)
-- -- TODO: Validate input.
-- presenceStatus :: String -> Maybe PresenceStatus
-- presenceStatus s = Just (PS s)