summaryrefslogtreecommitdiff
path: root/Presence/XMPPServer.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Presence/XMPPServer.hs')
-rw-r--r--Presence/XMPPServer.hs20
1 files changed, 20 insertions, 0 deletions
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 03a167ee..0c34ebb3 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -24,6 +24,7 @@ module XMPPServer
24 , makePresenceStanza 24 , makePresenceStanza
25 , makeInformSubscription 25 , makeInformSubscription
26 , makeRosterUpdate 26 , makeRosterUpdate
27 , makeMessage
27 , JabberShow(..) 28 , JabberShow(..)
28 ) where 29 ) where
29 30
@@ -760,6 +761,25 @@ grokStanza "jabber:client" stanzaTag =
760mkname :: Text -> Text -> XML.Name 761mkname :: Text -> Text -> XML.Name
761mkname namespace name = (Name name (Just namespace) Nothing) 762mkname namespace name = (Name name (Just namespace) Nothing)
762 763
764makeMessage :: Text -> Text -> Text -> Text -> IO Stanza
765makeMessage namespace from to bod =
766 stanzaFromList typ
767 $ [ EventBeginElement (mkname namespace "message")
768 [ attr "from" from
769 , attr "to" to
770 ]
771 , EventBeginElement (mkname namespace "body") []
772 , EventContent (ContentText bod)
773 , EventEndElement (mkname namespace "body")
774 , EventEndElement (mkname namespace "message") ]
775 where
776 typ = Message { msgThread = Nothing
777 , msgLangMap = [("", lsm)]
778 }
779 lsm = LangSpecificMessage
780 { msgBody = Just bod
781 , msgSubject = Nothing }
782
763makeInformSubscription :: Text -> Text -> Text -> Bool -> IO Stanza 783makeInformSubscription :: Text -> Text -> Text -> Bool -> IO Stanza
764makeInformSubscription namespace from to approved = 784makeInformSubscription namespace from to approved =
765 stanzaFromList (PresenceInformSubscription approved) 785 stanzaFromList (PresenceInformSubscription approved)