diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs index 4970eaf..3544a5e 100644 --- a/source/Network/Xmpp/Concurrent.hs +++ b/source/Network/Xmpp/Concurrent.hs @@ -58,7 +58,7 @@ runHandlers hs sta = go hs sta [] where go [] _ _ = return () go (h:hands) sta' as = do res <- h sta' as - forM_ res $ \(sta, as') -> go hands sta (as ++ as') + forM_ res $ \(sta'', as') -> go hands sta'' (as ++ as') toChan :: TChan (Annotated Stanza) -> StanzaHandler toChan stanzaC _ sta as = do diff --git a/source/Network/Xmpp/Stanza.hs b/source/Network/Xmpp/Stanza.hs index 802be5a..196de02 100644 --- a/source/Network/Xmpp/Stanza.hs +++ b/source/Network/Xmpp/Stanza.hs @@ -13,19 +13,19 @@ import Network.Xmpp.Lens -- | Request subscription with an entity. presenceSubscribe :: Jid -> Presence -presenceSubscribe to = presence { presenceTo = Just to +presenceSubscribe to' = presence { presenceTo = Just to' , presenceType = Subscribe } -- | Approve a subscripton of an entity. presenceSubscribed :: Jid -> Presence -presenceSubscribed to = presence { presenceTo = Just to +presenceSubscribed to' = presence { presenceTo = Just to' , presenceType = Subscribed } -- | End a subscription with an entity. presenceUnsubscribe :: Jid -> Presence -presenceUnsubscribe to = presence { presenceTo = Just to +presenceUnsubscribe to' = presence { presenceTo = Just to' , presenceType = Unsubscribed } @@ -43,25 +43,25 @@ presenceOffline = presence {presenceType = Unavailable} -- provided message message has no "from" attribute. Sets the "from" attribute -- to 'Nothing' to let the server assign one. answerMessage :: Message -> [Element] -> Maybe Message -answerMessage Message{messageFrom = Just frm, ..} payload = +answerMessage Message{messageFrom = Just frm, ..} payload' = Just Message{ messageFrom = Nothing , messageID = Nothing , messageTo = Just frm - , messagePayload = payload + , messagePayload = payload' , .. } answerMessage _ _ = Nothing -- | Add a recipient to a presence notification. presTo :: Presence -> Jid -> Presence -presTo pres to = pres{presenceTo = Just to} +presTo pres to' = pres{presenceTo = Just to'} -- | Create an IQ error response to an IQ request using the given condition. The -- error type is derived from the condition using 'associatedErrorType' and -- both text and the application specific condition are left empty iqError :: StanzaErrorCondition -> IQRequest -> IQError -iqError condition (IQRequest iqid from _to lang _tp _bd) = - IQError iqid Nothing from lang err Nothing +iqError condition (IQRequest iqid from' _to lang' _tp _bd) = + IQError iqid Nothing from' lang' err Nothing where err = StanzaError (associatedErrorType condition) condition Nothing Nothing diff --git a/source/Network/Xmpp/Xep/ServiceDiscovery.hs b/source/Network/Xmpp/Xep/ServiceDiscovery.hs index b953f44..c48a495 100644 --- a/source/Network/Xmpp/Xep/ServiceDiscovery.hs +++ b/source/Network/Xmpp/Xep/ServiceDiscovery.hs @@ -9,9 +9,10 @@ module Network.Xmpp.Xep.ServiceDiscovery ( QueryInfoResult(..) , Identity(..) , queryInfo - , Item + , Item(..) , queryItems , DiscoError(..) + , disco ) where @@ -24,7 +25,6 @@ import Data.XML.Types import Network.Xmpp import Network.Xmpp.Types import Network.Xmpp.Concurrent.Types -import Network.Xmpp.Lens import Network.Xmpp.Marshal import Network.Xmpp.Plugins import Network.Xmpp.Stanza @@ -61,16 +61,16 @@ queryInfo :: Maybe Integer -- ^ timeout -> Maybe Text.Text -- ^ Node -> Session -> IO (Either DiscoError QueryInfoResult) -queryInfo timeout to node context = do - res <- sendIQ' timeout (Just to) Get Nothing queryBody context +queryInfo timeout to' node context = do + res <- sendIQ' timeout (Just to') Get Nothing queryBody context return $ case fst <$> res of - Left e -> Left $ DiscoIQError Nothing + Left _e -> Left $ DiscoIQError Nothing Right (IQResponseError e) -> Left $ DiscoIQError (Just e) Right (IQResponseResult r) -> case iqResultPayload r of Nothing -> Left DiscoNoQueryElement Just p -> case unpickleElem xpQueryInfo p of Left e -> Left $ DiscoXmlError p e - Right r -> Right r + Right r' -> Right r' where queryBody = pickleElem xpQueryInfo (QIR node [] []) @@ -111,8 +111,8 @@ queryItems :: Maybe Integer -- ^ Timeout -> Maybe Text.Text -- ^ Node -> Session -> IO (Either DiscoError (Maybe Text.Text, [Item])) -queryItems timeout to node session = do - res <- sendIQ' timeout (Just to) Get Nothing queryBody session +queryItems timeout to' node session' = do + res <- sendIQ' timeout (Just to') Get Nothing queryBody session' return $ case fst <$> res of Left _ -> Left $ DiscoIQError Nothing Right (IQResponseError e) -> Left $ DiscoIQError (Just e) @@ -120,7 +120,7 @@ queryItems timeout to node session = do Nothing -> Left DiscoNoQueryElement Just p -> case unpickleElem xpQueryItems p of Left e -> Left $ DiscoXmlError p e - Right r -> Right r + Right r' -> Right r' where queryBody = pickleElem xpQueryItems (node, []) @@ -131,8 +131,8 @@ handleItemsRequest :: (Maybe Text.Text -> IO (Maybe [Item])) -> [Annotation] -> IO [Annotated Stanza] handleItemsRequest getItems = handleIQRequest Get pickler $ \iqr (node, _) _ -> do - is <- getItems node - case is of + mbIs <- getItems node + case mbIs of Nothing -> return . Left $ iqError ItemNotFound iqr Just is -> return $ Right ( Just $ pickle (xpRoot pickler) (node, is) , [] @@ -152,8 +152,8 @@ infoN :: Text.Text -> Name infoN name = Name name (Just discoInfoNS) Nothing xpIdentities :: PU [Node] [Identity] -xpIdentities = xpWrap (map $(\(cat, n, tp, lang) -> Ident cat n tp lang) . fst) - (map $ \(Ident cat n tp lang) -> ((cat, n, tp, lang),())) $ +xpIdentities = xpWrap (map $(\(cat, n, tp, l) -> Ident cat n tp l) . fst) + (map $ \(Ident cat n tp l) -> ((cat, n, tp, l),())) $ xpElems (infoN "identity") (xp4Tuple (xpAttr "category" xpText)