From 5ddfdc5815c9aed8b1c6e62a0bb1304a2fe5e944 Mon Sep 17 00:00:00 2001
From: Philipp Balzarek <p.balzarek@googlemail.com>
Date: Thu, 21 Jan 2016 14:51:12 +0100
Subject: [PATCH] pass old roster to roster update callback

---
 source/Network/Xmpp/Concurrent.hs       | 2 +-
 source/Network/Xmpp/Concurrent/Types.hs | 2 +-
 source/Network/Xmpp/IM/Roster.hs        | 9 +++++----
 3 files changed, 7 insertions(+), 6 deletions(-)

diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs
index 2877114..46385eb 100644
--- a/source/Network/Xmpp/Concurrent.hs
+++ b/source/Network/Xmpp/Concurrent.hs
@@ -188,7 +188,7 @@ newSession stream config realm mbSasl = runErrorT $ do
     boundJid <- liftIO $ withStream' (gets streamJid) stream
     let rosterH = if (enableRoster config)
                   then [handleRoster boundJid rosRef
-                          (fromMaybe (\_ -> return ()) $ onRosterPush config)
+                          (fromMaybe (\_ _ -> return ()) $ onRosterPush config)
                           (out)]
                   else []
     let presenceH = if (enablePresenceTracking config)
diff --git a/source/Network/Xmpp/Concurrent/Types.hs b/source/Network/Xmpp/Concurrent/Types.hs
index e90c4c5..88c0b3d 100644
--- a/source/Network/Xmpp/Concurrent/Types.hs
+++ b/source/Network/Xmpp/Concurrent/Types.hs
@@ -70,7 +70,7 @@ type Plugin = (XmppElement -> IO (Either XmppFailure ())) -- ^ pass stanza to
                                                           -- next plugin
               -> ErrorT XmppFailure IO Plugin'
 
-type RosterPushCallback = RosterUpdate -> IO ()
+type RosterPushCallback = Roster -> RosterUpdate -> IO ()
 
 -- | Configuration for the @Session@ object.
 data SessionConfiguration = SessionConfiguration
diff --git a/source/Network/Xmpp/IM/Roster.hs b/source/Network/Xmpp/IM/Roster.hs
index 9f67e9d..9c0d553 100644
--- a/source/Network/Xmpp/IM/Roster.hs
+++ b/source/Network/Xmpp/IM/Roster.hs
@@ -133,19 +133,20 @@ handleRoster mbBoundJid ref onUpdate out sta _ = do
                     else return [(sta, [])]
         _ -> return [(sta, [])]
   where
-    handleUpdate v' update =
+    handleUpdate v' update = do
+        oldRoster <- atomically $ readTVar ref
         case qiSubscription update of
          Just Remove -> do
              let j = qiJid update
-             onUpdate $ RosterUpdateRemove j
+             onUpdate oldRoster $ RosterUpdateRemove j
              updateRoster (Map.delete j)
          _ -> do
              let i = (toItem update)
-             onUpdate $ RosterUpdateAdd i
+             onUpdate oldRoster $ RosterUpdateAdd i
              updateRoster $ Map.insert (qiJid update) i
       where
         updateRoster f = atomically . modifyTVar ref $
-                         \(Roster v is) -> Roster (v' `mplus` v) (f is)
+                           \(Roster v is) -> Roster (v' `mplus` v) (f is)
 
     badRequest (IQRequest iqid from _to lang _tp bd _attrs) =
         IQErrorS $ IQError iqid Nothing from lang errBR (Just bd) []