Browse Source

remove IQResponseTimeout from IQResponse

IQResponseTimeout does not model an XMPP type but is instead an implementation specific signal that a user-set timeout has occured. Removing it keeps our representation closer to the defined protocol.

add IQSendError to keep the result of sendIQ' clear
master
Philipp Balzarek 12 years ago
parent
commit
da64e8758e
  1. 2
      source/Network/Xmpp/Concurrent.hs
  2. 8
      source/Network/Xmpp/Concurrent/IQ.hs
  3. 7
      source/Network/Xmpp/Concurrent/Types.hs
  4. 21
      source/Network/Xmpp/IM/Roster.hs
  5. 3
      source/Network/Xmpp/Types.hs

2
source/Network/Xmpp/Concurrent.hs

@ -117,7 +117,7 @@ handleIQ iqHands out sta = do @@ -117,7 +117,7 @@ handleIQ iqHands out sta = do
case Map.updateLookupWithKey (\_ _ -> Nothing) (iqID iq) byID of
(Nothing, _) -> return () -- We are not supposed to send an error.
(Just tmvar, byID') -> do
let answer = either IQResponseError IQResponseResult iq
let answer = Just $ either IQResponseError IQResponseResult iq
_ <- tryPutTMVar tmvar answer -- Don't block.
writeTVar handlers (byNS, byID')
where

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

@ -49,7 +49,7 @@ sendIQ timeOut to tp lang body session = do -- TODO: Add timeout @@ -49,7 +49,7 @@ sendIQ timeOut to tp lang body session = do -- TODO: Add timeout
else return Nothing
where
doTimeOut handlers iqid var = atomically $ do
p <- tryPutTMVar var IQResponseTimeout
p <- tryPutTMVar var Nothing
when p $ do
(byNS, byId) <- readTVar (iqHandlers session)
writeTVar handlers (byNS, Map.delete iqid byId)
@ -62,11 +62,11 @@ sendIQ' :: Maybe Integer @@ -62,11 +62,11 @@ sendIQ' :: Maybe Integer
-> Maybe LangTag
-> Element
-> Session
-> IO (Maybe IQResponse)
-> IO (Either IQSendError IQResponse)
sendIQ' timeout to tp lang body session = do
ref <- sendIQ timeout to tp lang body session
maybe (return Nothing) (fmap Just . atomically . takeTMVar) ref
maybe (return $ Left IQSendError) (fmap (maybe (Left IQTimeOut) Right)
. atomically . takeTMVar) ref
-- | Retrieves an IQ listener channel. If the namespace/'IQRequestType' is not
-- already handled, a new 'TChan' is created and returned as a 'Right' value.

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

@ -97,7 +97,7 @@ data Session = Session @@ -97,7 +97,7 @@ data Session = Session
-- TMVars of and TMVars for expected IQ responses (the second Text represent a
-- stanza identifier.
type IQHandlers = ( Map.Map (IQRequestType, Text) (TChan IQRequestTicket)
, Map.Map Text (TMVar IQResponse)
, Map.Map Text (TMVar (Maybe IQResponse))
)
-- | Contains whether or not a reply has been sent, and the IQ request body to
@ -110,3 +110,8 @@ data IQRequestTicket = IQRequestTicket @@ -110,3 +110,8 @@ data IQRequestTicket = IQRequestTicket
-- but failed (e.g. there is a connection failure)
, iqRequestBody :: IQRequest
}
-- | Error that can occur during sendIQ'
data IQSendError = IQSendError -- There was an error sending the IQ stanza
| IQTimeOut -- No answer was received during the allotted time
deriving (Show, Eq)

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

@ -33,7 +33,7 @@ timeout = Just 3000000 -- 3 seconds @@ -33,7 +33,7 @@ timeout = Just 3000000 -- 3 seconds
-- | Push a roster item to the server. The values for approved and ask are
-- ignored and all values for subsciption except "remove" are ignored
rosterPush :: Item -> Session -> IO (Maybe IQResponse)
rosterPush :: Item -> Session -> IO (Either IQSendError IQResponse)
rosterPush item session = do
let el = pickleElem xpQuery (Query Nothing [fromItem item])
sendIQ' timeout Nothing Set Nothing el session
@ -45,7 +45,7 @@ rosterAdd :: Jid -- ^ JID of the item @@ -45,7 +45,7 @@ rosterAdd :: Jid -- ^ JID of the item
-> Maybe Text -- ^ Name alias
-> [Text] -- ^ Groups (duplicates will be removed)
-> Session
-> IO (Maybe IQResponse)
-> IO (Either IQSendError IQResponse)
rosterAdd j n gs session = do
let el = pickleElem xpQuery (Query Nothing
[QueryItem { qiApproved = Nothing
@ -67,7 +67,7 @@ rosterRemove j sess = do @@ -67,7 +67,7 @@ rosterRemove j sess = do
Just _ -> do
res <- rosterPush (Item False False j Nothing Remove []) sess
case res of
Just (IQResponseResult IQResult{}) -> return True
Right (IQResponseResult IQResult{}) -> return True
_ -> return False
-- | Retrieve the current Roster state
@ -82,7 +82,7 @@ initRoster session = do @@ -82,7 +82,7 @@ initRoster session = do
else Nothing ) session
case mbRoster of
Nothing -> errorM "Pontarius.Xmpp"
"Server did not return a roster"
"Server did not return a roster: "
Just roster -> atomically $ writeTVar (rosterRef session) roster
handleRoster :: TVar Roster -> StanzaHandler
@ -129,22 +129,19 @@ retrieveRoster mbOldRoster sess = do @@ -129,22 +129,19 @@ retrieveRoster mbOldRoster sess = do
(pickleElem xpQuery (Query version []))
sess
case res of
Nothing -> do
errorM "Pontarius.Xmpp.Roster" "getRoster: sending stanza failed"
Left e -> do
errorM "Pontarius.Xmpp.Roster" $ "getRoster: " ++ show e
return Nothing
Just (IQResponseResult (IQResult{iqResultPayload = Just ros}))
Right (IQResponseResult (IQResult{iqResultPayload = Just ros}))
-> case unpickleElem xpQuery ros of
Left _e -> do
errorM "Pontarius.Xmpp.Roster" "getRoster: invalid query element"
return Nothing
Right ros' -> return . Just $ toRoster ros'
Just (IQResponseResult (IQResult{iqResultPayload = Nothing})) -> do
Right (IQResponseResult (IQResult{iqResultPayload = Nothing})) -> do
return mbOldRoster
-- sever indicated that no roster updates are necessary
Just IQResponseTimeout -> do
errorM "Pontarius.Xmpp.Roster" "getRoster: request timed out"
return Nothing
Just (IQResponseError e) -> do
Right (IQResponseError e) -> do
errorM "Pontarius.Xmpp.Roster" $ "getRoster: server returned error"
++ show e
return Nothing

3
source/Network/Xmpp/Types.hs

@ -119,10 +119,9 @@ data IQRequest = IQRequest { iqRequestID :: !Text @@ -119,10 +119,9 @@ data IQRequest = IQRequest { iqRequestID :: !Text
data IQRequestType = Get | Set deriving (Eq, Ord, Read, Show)
-- | A "response" Info/Query (IQ) stanza is either an 'IQError', an IQ stanza
-- of type "result" ('IQResult') or a Timeout.
-- of type "result" ('IQResult')
data IQResponse = IQResponseError IQError
| IQResponseResult IQResult
| IQResponseTimeout
deriving Show
-- | The (non-error) answer to an IQ request.

Loading…
Cancel
Save