peerSubscriptionRequest

1 files changed, 10 insertions, 0 deletions

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index a61601ef..02dd5134 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -23,6 +23,7 @@ module XMPPServer
     , presenceProbe
     , presenceSolicitation
     , makePresenceStanza
+    , makeInformSubscription
     , JabberShow(..)
     ) where
 
@@ -759,6 +760,15 @@ grokStanza "jabber:client" stanzaTag =
 mkname :: Text -> Text -> XML.Name
 mkname namespace name = (Name name (Just namespace) Nothing)
 
+makeInformSubscription namespace from to approved = 
+    stanzaFromList (PresenceInformSubscription approved)
+      $ [ EventBeginElement (mkname namespace "presence")
+            [ attr "from" from
+            , attr "to" to
+            , attr "type" $ if approved then "subscribed"
+                                        else "unsubscribed" ]
+        , EventEndElement (mkname namespace "presence")]
+
 makePresenceStanza namespace mjid pstat = do
     stanzaFromList PresenceStatus { presenceShow = pstat
                                   , presencePriority = Nothing