makeMessage api in XMPPServer

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
     , 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)