1 files changed, 14 insertions, 9 deletions

diff --git a/xmppServer.hs b/xmppServer.hs
index 2476daec..823e1aba 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -223,9 +223,6 @@ toMapUnit xs = Map.fromList $ map (,()) xs
 resolveAllPeers :: [Text] -> IO (Map SockAddr ())
 resolveAllPeers hosts = fmap (toMapUnit . concat) $ Prelude.mapM (fmap (take 1) . resolvePeer) hosts
 
-configText what u =
-        fmap (map lazyByteStringToText)
-            $ what (textToLazyByteString u)
 
 rosterGetStuff
   :: (L.ByteString -> IO [L.ByteString])
@@ -260,13 +257,13 @@ rosterGetSubscribers = rosterGetStuff ConfigFiles.getSubscribers
 data Conn = Conn { connChan :: TChan Stanza
                  , auxAddr :: SockAddr }
 
-textAdapter what u = fmap (map lazyByteStringToText)
+configText what u = fmap (map lazyByteStringToText)
                         $ what (textToLazyByteString u)
 
 getBuddies' :: Text -> IO [Text]
-getBuddies' = textAdapter ConfigFiles.getBuddies
+getBuddies' = configText ConfigFiles.getBuddies
 getSolicited' :: Text -> IO [Text]
-getSolicited' = textAdapter ConfigFiles.getSolicited
+getSolicited' = configText ConfigFiles.getSolicited
 
 sendProbesAndSolicitations state k laddr chan = do
     -- get all buddies & solicited matching k for all users
@@ -469,6 +466,12 @@ setClientFlag state k flag =
 informSentRoster state k = setClientFlag state k cf_interested
 
 
+subscribedPeers user = do
+    jids <- configText ConfigFiles.getSubscribers user
+    let hosts = map ((\(_,h,_)->h) . splitJID) jids
+    fmap Map.keys $ resolveAllPeers hosts 
+
+
 -- | Send presence notification to subscribed peers.
 -- Note that a full JID from address will be added to the
 -- stanza if it is not present.
@@ -482,9 +485,7 @@ informClientPresence state k stanza = do
     when (not $ clientIsAvailable client) $ do
         setClientFlag state k cf_available
         sendCachedPresence state k
-    jids <- configText ConfigFiles.getSubscribers (clientUser client)
-    let hosts = map ((\(_,h,_)->h) . splitJID) jids
-    addrs <- fmap Map.keys $ resolveAllPeers hosts 
+    addrs <- subscribedPeers (clientUser client)
     ktc <- atomically $ readTVar (keyToChan state)
     let connected = mapMaybe (flip Map.lookup ktc . PeerKey) addrs
     forM_ connected $ \con -> do
@@ -560,6 +561,10 @@ answerProbe state k stanza chan = do
 
     flip (maybe $ return ()) muser $ \(u,conn,ch) -> do
 
+    -- only subscribed peers should get probe replies
+    addrs <- subscribedPeers u
+    when (k `elem` map PeerKey addrs) $ do
+
     replies <- runTraversableT $ do
         cbu <- lift . atomically $ readTVar (clientsByUser state)
         lpres <- liftMaybe $ Map.lookup u cbu