summaryrefslogtreecommitdiff
path: root/xmppServer.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-03-11 14:16:17 -0400
committerjoe <joe@jerkface.net>2014-03-11 14:16:17 -0400
commit7167550ca24975e06e028de7c797612fff82a16d (patch)
treeb23ac7211cb1b277f7d06f6c961fd8a5d37366aa /xmppServer.hs
parentf7388f8cb19535585d35e1457985152c8ac0ddf8 (diff)
Fixed buddy-request bug
Diffstat (limited to 'xmppServer.hs')
-rw-r--r--xmppServer.hs22
1 files changed, 15 insertions, 7 deletions
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 =
679modifyRosterFile doit whose to addrs bAdd = do 679modifyRosterFile doit whose to addrs bAdd = do
680 let (mu,_,_) = splitJID to 680 let (mu,_,_) = splitJID to
681 cmp jid = runTraversableT $ do 681 cmp jid = runTraversableT $ do
682 let (mu,stored_h,mr) = splitJID (lazyByteStringToText jid) 682 let (msu,stored_h,mr) = splitJID (lazyByteStringToText jid)
683 flip (maybe mzero) mr . const $ do 683 -- Delete from file if a resource is present in file
684 flip (maybe mzero) mu $ \stored_u -> do 684 (\f -> maybe f (const mzero) mr) $ do
685 -- Delete from file if no user is present in file
686 flip (maybe mzero) msu $ \stored_u -> do
687 -- do not delete anything if no user was specified
685 flip (maybe $ return jid) mu $ \u -> do 688 flip (maybe $ return jid) mu $ \u -> do
689 -- do not delete if stored user is same as specified
686 if stored_u /= u then return jid else do 690 if stored_u /= u then return jid else do
687 stored_addrs <- lift $ nub `fmap` resolvePeer stored_h 691 stored_addrs <- lift $ resolvePeer stored_h
688 if null (stored_addrs \\ addrs) then return jid else do 692 -- do not delete if failed to resolve
689 mzero 693 if null stored_addrs then return jid else do
694 -- delete if specified address matches stored
695 if null (stored_addrs \\ addrs) then mzero else do
696 -- keep
697 return jid
690 doit (textToLazyByteString whose) 698 doit (textToLazyByteString whose)
691 cmp 699 cmp
692 (guard bAdd >> Just (textToLazyByteString to)) 700 (guard bAdd >> Just (textToLazyByteString to))
@@ -699,7 +707,7 @@ clientSubscriptionRequest state fail k stanza chan = do
699 let (mu,h,_) = splitJID to 707 let (mu,h,_) = splitJID to
700 to <- return $ unsplitJID (mu,h,Nothing) -- delete resource 708 to <- return $ unsplitJID (mu,h,Nothing) -- delete resource
701 flip (maybe fail) mu $ \u -> do 709 flip (maybe fail) mu $ \u -> do
702 addrs <- nub `fmap` resolvePeer h 710 addrs <- resolvePeer h
703 if null addrs then fail else do 711 if null addrs then fail else do
704 -- add to-address to from's solicited 712 -- add to-address to from's solicited
705 addToRosterFile ConfigFiles.modifySolicited (clientUser client) to addrs 713 addToRosterFile ConfigFiles.modifySolicited (clientUser client) to addrs