From 7167550ca24975e06e028de7c797612fff82a16d Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 11 Mar 2014 14:16:17 -0400 Subject: Fixed buddy-request bug --- xmppServer.hs | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) (limited to 'xmppServer.hs') diff --git a/xmppServer.hs b/xmppServer.hs index 1dfb6496..9ea1a970 100644 --- a/xmppServer.hs +++ b/xmppServer.hs @@ -679,14 +679,22 @@ removeFromRosterFile doit whose to addrs = modifyRosterFile doit whose to addrs bAdd = do let (mu,_,_) = splitJID to cmp jid = runTraversableT $ do - let (mu,stored_h,mr) = splitJID (lazyByteStringToText jid) - flip (maybe mzero) mr . const $ do - flip (maybe mzero) mu $ \stored_u -> do + let (msu,stored_h,mr) = splitJID (lazyByteStringToText jid) + -- Delete from file if a resource is present in file + (\f -> maybe f (const mzero) mr) $ do + -- Delete from file if no user is present in file + flip (maybe mzero) msu $ \stored_u -> do + -- do not delete anything if no user was specified flip (maybe $ return jid) mu $ \u -> do + -- do not delete if stored user is same as specified if stored_u /= u then return jid else do - stored_addrs <- lift $ nub `fmap` resolvePeer stored_h - if null (stored_addrs \\ addrs) then return jid else do - mzero + stored_addrs <- lift $ resolvePeer stored_h + -- do not delete if failed to resolve + if null stored_addrs then return jid else do + -- delete if specified address matches stored + if null (stored_addrs \\ addrs) then mzero else do + -- keep + return jid doit (textToLazyByteString whose) cmp (guard bAdd >> Just (textToLazyByteString to)) @@ -699,7 +707,7 @@ clientSubscriptionRequest state fail k stanza chan = do let (mu,h,_) = splitJID to to <- return $ unsplitJID (mu,h,Nothing) -- delete resource flip (maybe fail) mu $ \u -> do - addrs <- nub `fmap` resolvePeer h + addrs <- resolvePeer h if null addrs then fail else do -- add to-address to from's solicited addToRosterFile ConfigFiles.modifySolicited (clientUser client) to addrs -- cgit v1.2.3