Browse Source

add onRosterPush callback to session configuration

master
Philipp Balzarek 10 years ago
parent
commit
8a87939cdc
  1. 4
      source/Network/Xmpp/Concurrent.hs
  2. 4
      source/Network/Xmpp/Concurrent/Types.hs
  3. 8
      source/Network/Xmpp/IM/Roster.hs

4
source/Network/Xmpp/Concurrent.hs

@ -172,7 +172,9 @@ newSession stream config realm mbSasl = runErrorT $ do
let out = writeStanza writeSem let out = writeStanza writeSem
boundJid <- liftIO $ withStream' (gets streamJid) stream boundJid <- liftIO $ withStream' (gets streamJid) stream
let rosterH = if (enableRoster config) let rosterH = if (enableRoster config)
then [handleRoster boundJid ros out] then [handleRoster boundJid ros
(fromMaybe (\_ -> return ()) $ onRosterPush config)
out]
else [] else []
let presenceH = if (enablePresenceTracking config) let presenceH = if (enablePresenceTracking config)
then [handlePresence (onPresenceChange config) peers out] then [handlePresence (onPresenceChange config) peers out]

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

@ -85,6 +85,9 @@ data SessionConfiguration = SessionConfiguration
-- | Enable roster handling according to rfc 6121. See 'getRoster' to -- | Enable roster handling according to rfc 6121. See 'getRoster' to
-- acquire the current roster -- acquire the current roster
, enableRoster :: Bool , 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. -- | Track incomming presence stancas.
, enablePresenceTracking :: Bool , enablePresenceTracking :: Bool
-- | Callback that is invoked when the presence status of a peer changes, -- | 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 return . Text.pack . show $ curId
, plugins = [] , plugins = []
, enableRoster = True , enableRoster = True
, onRosterPush = Nothing
, enablePresenceTracking = True , enablePresenceTracking = True
, onPresenceChange = Nothing , onPresenceChange = Nothing
, keepAlive = Just 30 , keepAlive = Just 30

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

@ -98,8 +98,11 @@ initRoster session = do
"Server did not return a roster: " "Server did not return a roster: "
Just roster -> atomically $ writeTVar (rosterRef session) roster Just roster -> atomically $ writeTVar (rosterRef session) roster
handleRoster :: Maybe Jid -> TVar Roster -> StanzaHandler handleRoster :: Maybe Jid
handleRoster mbBoundJid ref out sta _ = do -> TVar Roster
-> (QueryItem -> IO ())
-> StanzaHandler
handleRoster mbBoundJid ref onUpdate out sta _ = do
case sta of case sta of
IQRequestS (iqr@IQRequest{iqRequestPayload = IQRequestS (iqr@IQRequest{iqRequestPayload =
iqb@Element{elementName = en}}) iqb@Element{elementName = en}})
@ -120,6 +123,7 @@ handleRoster mbBoundJid ref out sta _ = do
, queryItems = [update] , queryItems = [update]
} -> do } -> do
handleUpdate v update handleUpdate v update
onUpdate update
_ <- out $ result iqr _ <- out $ result iqr
return [] return []
_ -> do _ -> do

Loading…
Cancel
Save