From a2d62033c7b0ae908a37cb16496945abec47e058 Mon Sep 17 00:00:00 2001 From: joe Date: Sat, 5 Apr 2014 13:22:28 -0400 Subject: makeMessage api in XMPPServer --- Presence/XMPPServer.hs | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) 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 , makePresenceStanza , makeInformSubscription , makeRosterUpdate + , makeMessage , JabberShow(..) ) where @@ -760,6 +761,25 @@ grokStanza "jabber:client" stanzaTag = mkname :: Text -> Text -> XML.Name mkname namespace name = (Name name (Just namespace) Nothing) +makeMessage :: Text -> Text -> Text -> Text -> IO Stanza +makeMessage namespace from to bod = + stanzaFromList typ + $ [ EventBeginElement (mkname namespace "message") + [ attr "from" from + , attr "to" to + ] + , EventBeginElement (mkname namespace "body") [] + , EventContent (ContentText bod) + , EventEndElement (mkname namespace "body") + , EventEndElement (mkname namespace "message") ] + where + typ = Message { msgThread = Nothing + , msgLangMap = [("", lsm)] + } + lsm = LangSpecificMessage + { msgBody = Just bod + , msgSubject = Nothing } + makeInformSubscription :: Text -> Text -> Text -> Bool -> IO Stanza makeInformSubscription namespace from to approved = stanzaFromList (PresenceInformSubscription approved) -- cgit v1.2.3