Browse Source

Check IQ response from addresses

master
Philipp Balzarek 12 years ago
parent
commit
4efb81758c
  1. 5
      source/Network/Xmpp/Concurrent.hs
  2. 5
      source/Network/Xmpp/Concurrent/IQ.hs
  3. 2
      source/Network/Xmpp/Concurrent/Types.hs

5
source/Network/Xmpp/Concurrent.hs

@ -121,7 +121,8 @@ handleIQ iqHands out sta as = do
handleIQResponse :: TVar IQHandlers -> Either IQError IQResult -> IO () handleIQResponse :: TVar IQHandlers -> Either IQError IQResult -> IO ()
handleIQResponse handlers iq = atomically $ do handleIQResponse handlers iq = atomically $ do
(byNS, byID) <- readTVar handlers (byNS, byID) <- readTVar handlers
case Map.updateLookupWithKey (\_ _ -> Nothing) (iqID iq) byID of case Map.updateLookupWithKey (\_ _ -> Nothing) (iqID iq, iqFrom iq)
byID of
(Nothing, _) -> return () -- We are not supposed to send an error. (Nothing, _) -> return () -- We are not supposed to send an error.
(Just tmvar, byID') -> do (Just tmvar, byID') -> do
let answer = Just (either IQResponseError IQResponseResult iq, as) let answer = Just (either IQResponseError IQResponseResult iq, as)
@ -130,6 +131,8 @@ handleIQ iqHands out sta as = do
where where
iqID (Left err') = iqErrorID err' iqID (Left err') = iqErrorID err'
iqID (Right iq') = iqResultID iq' iqID (Right iq') = iqResultID iq'
iqFrom (Left err') = iqErrorFrom err'
iqFrom (Right iq') = iqResultFrom iq'
-- | Creates and initializes a new Xmpp context. -- | Creates and initializes a new Xmpp context.
newSession :: Stream newSession :: Stream

5
source/Network/Xmpp/Concurrent/IQ.hs

@ -33,10 +33,11 @@ sendIQ :: Maybe Integer -- ^ Timeout . When the timeout is reached the response
-> IO (Either XmppFailure (TMVar (Maybe (Annotated IQResponse)))) -> IO (Either XmppFailure (TMVar (Maybe (Annotated IQResponse))))
sendIQ timeOut to tp lang body session = do -- TODO: Add timeout sendIQ timeOut to tp lang body session = do -- TODO: Add timeout
newId <- idGenerator session newId <- idGenerator session
let key = (newId, to)
ref <- atomically $ do ref <- atomically $ do
resRef <- newEmptyTMVar resRef <- newEmptyTMVar
(byNS, byId) <- readTVar (iqHandlers session) (byNS, byId) <- readTVar (iqHandlers session)
writeTVar (iqHandlers session) (byNS, Map.insert newId resRef byId) writeTVar (iqHandlers session) (byNS, Map.insert key resRef byId)
-- TODO: Check for id collisions (shouldn't happen?) -- TODO: Check for id collisions (shouldn't happen?)
return resRef return resRef
res <- sendStanza (IQRequestS $ IQRequest newId Nothing to lang tp body) session res <- sendStanza (IQRequestS $ IQRequest newId Nothing to lang tp body) session
@ -46,7 +47,7 @@ sendIQ timeOut to tp lang body session = do -- TODO: Add timeout
Nothing -> return () Nothing -> return ()
Just t -> void . forkIO $ do Just t -> void . forkIO $ do
delay t delay t
doTimeOut (iqHandlers session) newId ref doTimeOut (iqHandlers session) key ref
return $ Right ref return $ Right ref
Left e -> return $ Left e Left e -> return $ Left e
where where

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

@ -135,7 +135,7 @@ data Session = Session
-- TMVars of and TMVars for expected IQ responses (the second Text represent a -- TMVars of and TMVars for expected IQ responses (the second Text represent a
-- stanza identifier. -- stanza identifier.
type IQHandlers = ( Map.Map (IQRequestType, Text) (TChan IQRequestTicket) type IQHandlers = ( Map.Map (IQRequestType, Text) (TChan IQRequestTicket)
, Map.Map Text (TMVar (Maybe (Annotated IQResponse))) , Map.Map (Text, Maybe Jid) (TMVar (Maybe (Annotated IQResponse)))
) )
-- | Contains whether or not a reply has been sent, and the IQ request body to -- | Contains whether or not a reply has been sent, and the IQ request body to

Loading…
Cancel
Save