From 8a87939cdcd2e3609f5b0510c465c7aa04e53543 Mon Sep 17 00:00:00 2001
From: Philipp Balzarek <p.balzarek@googlemail.com>
Date: Tue, 13 Oct 2015 16:51:47 +0200
Subject: [PATCH] add onRosterPush callback to session configuration

---
 source/Network/Xmpp/Concurrent.hs       | 4 +++-
 source/Network/Xmpp/Concurrent/Types.hs | 4 ++++
 source/Network/Xmpp/IM/Roster.hs        | 8 ++++++--
 3 files changed, 13 insertions(+), 3 deletions(-)

diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs
index 6fade93..09a1d9e 100644
--- a/source/Network/Xmpp/Concurrent.hs
+++ b/source/Network/Xmpp/Concurrent.hs
@@ -172,7 +172,9 @@ newSession stream config realm mbSasl = runErrorT $ do
     let out = writeStanza writeSem
     boundJid <- liftIO $ withStream' (gets streamJid) stream
     let rosterH = if (enableRoster config)
-                  then [handleRoster boundJid ros out]
+                  then [handleRoster boundJid ros
+                          (fromMaybe (\_ -> return ()) $ onRosterPush config)
+                          out]
                   else []
     let presenceH = if (enablePresenceTracking config)
                     then [handlePresence (onPresenceChange config) peers out]
diff --git a/source/Network/Xmpp/Concurrent/Types.hs b/source/Network/Xmpp/Concurrent/Types.hs
index ca5fa64..bcacf62 100644
--- a/source/Network/Xmpp/Concurrent/Types.hs
+++ b/source/Network/Xmpp/Concurrent/Types.hs
@@ -85,6 +85,9 @@ data SessionConfiguration = SessionConfiguration
       -- | Enable roster handling according to rfc 6121. See 'getRoster' to
       -- acquire the current roster
     , enableRoster               :: Bool
+      -- | Callback called on a roster Push. The callback is called after the
+      -- roster is updated
+    , onRosterPush               :: Maybe (QueryItem -> IO ())
       -- | Track incomming presence stancas.
     , enablePresenceTracking     :: Bool
       -- | Callback that is invoked when the presence status of a peer changes,
@@ -112,6 +115,7 @@ instance Default SessionConfiguration where
                                          return . Text.pack . show $ curId
                                , plugins = []
                                , enableRoster = True
+                               , onRosterPush = Nothing
                                , enablePresenceTracking = True
                                , onPresenceChange = Nothing
                                , keepAlive = Just 30
diff --git a/source/Network/Xmpp/IM/Roster.hs b/source/Network/Xmpp/IM/Roster.hs
index 15a8afc..7f54b96 100644
--- a/source/Network/Xmpp/IM/Roster.hs
+++ b/source/Network/Xmpp/IM/Roster.hs
@@ -98,8 +98,11 @@ initRoster session = do
                           "Server did not return a roster: "
         Just roster -> atomically $ writeTVar (rosterRef session) roster
 
-handleRoster :: Maybe Jid -> TVar Roster -> StanzaHandler
-handleRoster mbBoundJid ref out sta _ = do
+handleRoster :: Maybe Jid
+             -> TVar Roster
+             -> (QueryItem -> IO ())
+             -> StanzaHandler
+handleRoster mbBoundJid ref onUpdate out sta _ = do
     case sta of
         IQRequestS (iqr@IQRequest{iqRequestPayload =
                                        iqb@Element{elementName = en}})
@@ -120,6 +123,7 @@ handleRoster mbBoundJid ref out sta _ = do
                                    , queryItems = [update]
                                    } -> do
                             handleUpdate v update
+                            onUpdate update
                             _ <- out $ result iqr
                             return []
                         _ -> do