Browse Source

pass old roster to roster update callback

master
Philipp Balzarek 10 years ago
parent
commit
5ddfdc5815
  1. 2
      source/Network/Xmpp/Concurrent.hs
  2. 2
      source/Network/Xmpp/Concurrent/Types.hs
  3. 9
      source/Network/Xmpp/IM/Roster.hs

2
source/Network/Xmpp/Concurrent.hs

@ -188,7 +188,7 @@ newSession stream config realm mbSasl = runErrorT $ do @@ -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)

2
source/Network/Xmpp/Concurrent/Types.hs

@ -70,7 +70,7 @@ type Plugin = (XmppElement -> IO (Either XmppFailure ())) -- ^ pass stanza to @@ -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

9
source/Network/Xmpp/IM/Roster.hs

@ -133,19 +133,20 @@ handleRoster mbBoundJid ref onUpdate out sta _ = do @@ -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) []

Loading…
Cancel
Save