@@ 0,0 1,108 @@
+-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 3 of the License, or
+-- any later version.
+--
+-- This program 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 General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+module Network.Protocol.XMPP.Internal.Stanza where
+import Network.Protocol.XMPP.JID (JID)
+import qualified Data.Text as T
+import Text.XML.HXT.DOM.Interface (XmlTree)
+
+class Stanza a where
+ stanzaTo :: a -> Maybe JID
+ stanzaFrom :: a -> Maybe JID
+ stanzaID :: a -> Maybe T.Text
+ stanzaLang :: a -> Maybe T.Text
+ stanzaPayloads :: a -> [XmlTree]
+ stanzaTree :: a -> XmlTree
+
+data ReceivedStanza
+ = ReceivedMessage Message
+ | ReceivedPresence Presence
+ | ReceivedIQ IQ
+
+data Message = Message
+ { messageType :: MessageType
+ , messageTo :: Maybe JID
+ , messageFrom :: Maybe JID
+ , messageID :: Maybe T.Text
+ , messageLang :: Maybe T.Text
+ , messagePayloads :: [XmlTree]
+ }
+
+instance Stanza Message where
+ stanzaTo = messageTo
+ stanzaFrom = messageFrom
+ stanzaID = messageID
+ stanzaLang = messageLang
+ stanzaPayloads = messagePayloads
+ stanzaTree = undefined
+
+data MessageType
+ = MessageNormal
+ | MessageCHat
+ | MessageGroupChat
+ | MessageHeadline
+ | MessageError
+ deriving (Show, Eq)
+
+data Presence = Presence
+ { presenceType :: PresenceType
+ , presenceTo :: Maybe JID
+ , presenceFrom :: Maybe JID
+ , presenceID :: Maybe T.Text
+ , presenceLang :: Maybe T.Text
+ , presencePayloads :: [XmlTree]
+ }
+
+instance Stanza Presence where
+ stanzaTo = presenceTo
+ stanzaFrom = presenceFrom
+ stanzaID = presenceID
+ stanzaLang = presenceLang
+ stanzaPayloads = presencePayloads
+ stanzaTree = undefined
+
+data PresenceType
+ = PresenceUnavailable
+ | PresenceSubscribe
+ | PresenceSubscribed
+ | PresenceUnsubscribe
+ | PresenceUnsubscribed
+ | PresenceProbe
+ | PresenceError
+ deriving (Show, Eq)
+
+data IQ = IQ
+ { iqType :: IQType
+ , iqTo :: Maybe JID
+ , iqFrom :: Maybe JID
+ , iqID :: Maybe T.Text
+ , iqLang :: Maybe T.Text
+ , iqPayload :: XmlTree
+ }
+
+instance Stanza IQ where
+ stanzaTo = iqTo
+ stanzaFrom = iqFrom
+ stanzaID = iqID
+ stanzaLang = iqLang
+ stanzaPayloads iq = [iqPayload iq]
+ stanzaTree = undefined
+
+data IQType
+ = IQGet
+ | IQSet
+ | IQResult
+ | IQError
+ deriving (Show, Eq)
@@ 0,0 1,26 @@
+-- Copyright (C) 2010 John Millikin <jmillikin@gmail.com>
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 3 of the License, or
+-- any later version.
+--
+-- This program 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 General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+module Network.Protocol.XMPP.Stanza
+ ( Stanza (stanzaTo, stanzaFrom, stanzaID, stanzaLang, stanzaPayloads)
+ , ReceivedStanza (..)
+ , Message (..)
+ , Presence (..)
+ , IQ (..)
+ , MessageType (..)
+ , PresenceType (..)
+ , IQType (..)
+ ) where
+import Network.Protocol.XMPP.Internal.Stanza
@@ 1,145 0,0 @@
-{- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>
-
- This program is free software: you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation, either version 3 of the License, or
- any later version.
-
- This program 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 General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
--}
-
-module Network.Protocol.XMPP.Stanzas (
- StanzaType(..)
- ,Stanza(..)
- ,treeToStanza
- ,stanzaToTree
- ) where
-
-import Text.XML.HXT.DOM.Interface (XmlTree)
-import Text.XML.HXT.Arrow ((>>>), (&&&))
-import qualified Text.XML.HXT.Arrow as A
-
-import Network.Protocol.XMPP.JID (JID, jidFormat, jidParse)
-import Network.Protocol.XMPP.Util (mkElement, mkQName)
-import qualified Text.XML.HXT.DOM.XmlNode as XN
-
-data StanzaType =
- MessageNormal
- | MessageChat
- | MessageGroupChat
- | MessageHeadline
- | MessageError
-
- | PresenceUnavailable
- | PresenceSubscribe
- | PresenceSubscribed
- | PresenceUnsubscribe
- | PresenceUnsubscribed
- | PresenceProbe
- | PresenceError
-
- | IQGet
- | IQSet
- | IQResult
- | IQError
- deriving (Show, Eq)
-
-data Stanza = Stanza
- {
- stanzaType :: StanzaType
- ,stanzaTo :: Maybe JID
- ,stanzaFrom :: Maybe JID
- ,stanzaID :: String
- ,stanzaLang :: String
- ,stanzaPayloads :: [XmlTree]
- }
- deriving (Show, Eq)
-
-stanzaTypeMap :: [((String, String, String), StanzaType)]
-stanzaTypeMap = mkStanzaTypeMap $ [
- ("jabber:client", "message", [
- ("normal", MessageNormal)
- ,("chat", MessageChat)
- ,("groupchat", MessageGroupChat)
- ,("headline", MessageHeadline)
- ,("error", MessageError)
- ])
- ,("jabber:client", "presence", [
- ("unavailable", PresenceUnavailable)
- ,("subscribe", PresenceSubscribe)
- ,("subscribed", PresenceSubscribed)
- ,("unsubscribe", PresenceUnsubscribe)
- ,("unsubscribed", PresenceUnsubscribed)
- ,("probe", PresenceProbe)
- ,("error", PresenceError)
- ])
- ,("jabber:client", "iq", [
- ("get", IQGet)
- ,("set", IQSet)
- ,("result", IQResult)
- ,("error", IQError)
- ])
- ]
- where mkStanzaTypeMap raw = do
- (ns, elementName, typeStrings) <- raw
- (typeString, type') <- typeStrings
- return ((ns, elementName, typeString), type')
-
-stanzaTypeToStr :: StanzaType -> (String, String, String)
-stanzaTypeToStr t = let
- step [] = undefined
- step ((ret, t'):tms)
- | t == t' = ret
- | otherwise = step tms
- in step stanzaTypeMap
-
-stanzaTypeFromStr :: String -> String -> String -> Maybe StanzaType
-stanzaTypeFromStr ns elementName typeString = let
- key = (ns, elementName, typeString)
- step [] = Nothing
- step ((key', ret):tms)
- | key == key' = Just ret
- | otherwise = step tms
- in step stanzaTypeMap
-
-treeToStanza :: XmlTree -> [Stanza]
-treeToStanza t = do
- to <- return . jidParse =<< A.runLA (A.getAttrValue "to") t
- from <- return . jidParse =<< A.runLA (A.getAttrValue "from") t
- id' <- A.runLA (A.getAttrValue "id") t
- lang <- A.runLA (A.getAttrValue "lang") t
-
- ns <- A.runLA A.getNamespaceUri t
- elementName <- A.runLA A.getLocalPart t
- typeString <- A.runLA (A.getAttrValue "type") t
-
- let payloads = A.runLA (A.getChildren >>> A.isElem) t
-
- case stanzaTypeFromStr ns elementName typeString of
- Nothing -> []
- Just type' -> [Stanza type' to from id' lang payloads]
-
-stanzaToTree :: Stanza -> XmlTree
-stanzaToTree s = let
- (ns, elementName, typeString) = stanzaTypeToStr (stanzaType s)
-
- attrs' = [
- autoAttr "to" (maybe "" jidFormat . stanzaTo)
- ,autoAttr "from" (maybe "" jidFormat . stanzaFrom)
- ,autoAttr "id" stanzaID
- ,autoAttr "xml:lang" stanzaLang
- ,\_ -> [("", "type", typeString)]
- ]
- attrs = concatMap ($ s) attrs'
- in mkElement (ns, elementName) attrs (stanzaPayloads s)
-
-autoAttr :: String -> (Stanza -> String) -> Stanza -> [(String, String, String)]
-autoAttr attr f stanza = case f stanza of
- "" -> []
- text -> [("", attr, text)]