diff options
Diffstat (limited to 'Presence')
-rw-r--r-- | Presence/Presence.hs | 21 |
1 files changed, 12 insertions, 9 deletions
diff --git a/Presence/Presence.hs b/Presence/Presence.hs index 4765b05a..c614cc4e 100644 --- a/Presence/Presence.hs +++ b/Presence/Presence.hs | |||
@@ -828,7 +828,6 @@ sendCachedPresence state k = do | |||
828 | mcon <- atomically $ do ktc <- readTVar (keyToChan state) | 828 | mcon <- atomically $ do ktc <- readTVar (keyToChan state) |
829 | return $ Map.lookup k ktc | 829 | return $ Map.lookup k ktc |
830 | flip (maybe $ return ()) mcon $ \con -> do | 830 | flip (maybe $ return ()) mcon $ \con -> do |
831 | -- me <- textHostName | ||
832 | forM_ (Map.toList onlines) $ \(pk, umap) -> do | 831 | forM_ (Map.toList onlines) $ \(pk, umap) -> do |
833 | forM_ (Map.toList umap) $ \(user,rp) -> do | 832 | forM_ (Map.toList umap) $ \(user,rp) -> do |
834 | let h = peerKeyToText pk | 833 | let h = peerKeyToText pk |
@@ -842,7 +841,7 @@ sendCachedPresence state k = do | |||
842 | (connChan con) | 841 | (connChan con) |
843 | 842 | ||
844 | pending <- configText ConfigFiles.getPending (clientUser client) (clientProfile client) | 843 | pending <- configText ConfigFiles.getPending (clientUser client) (clientProfile client) |
845 | hostname <- textHostName | 844 | hostname <- nameForClient state k |
846 | forM_ pending $ \pending_jid -> do | 845 | forM_ pending $ \pending_jid -> do |
847 | let cjid = unsplitJID ( Just $ clientUser client | 846 | let cjid = unsplitJID ( Just $ clientUser client |
848 | , hostname | 847 | , hostname |
@@ -936,7 +935,7 @@ clientSubscriptionRequest state fail k stanza chan = do | |||
936 | 935 | ||
937 | case stanzaType stanza of | 936 | case stanzaType stanza of |
938 | PresenceRequestSubscription True -> do | 937 | PresenceRequestSubscription True -> do |
939 | hostname <- textHostName | 938 | hostname <- nameForClient state k |
940 | let cjid = unsplitJID (Just $ clientUser client, hostname,Nothing) | 939 | let cjid = unsplitJID (Just $ clientUser client, hostname,Nothing) |
941 | chans <- clientCons state ktc (clientUser client) | 940 | chans <- clientCons state ktc (clientUser client) |
942 | forM_ chans $ \( Conn { connChan=chan }, client ) -> do | 941 | forM_ chans $ \( Conn { connChan=chan }, client ) -> do |
@@ -986,7 +985,11 @@ resolvedFromRoster doit u profile = do | |||
986 | 985 | ||
987 | clientCons :: PresenceState | 986 | clientCons :: PresenceState |
988 | -> Map ConnectionKey t -> Text -> IO [(t, ClientState)] | 987 | -> Map ConnectionKey t -> Text -> IO [(t, ClientState)] |
989 | clientCons state ktc u = do | 988 | clientCons state ktc u = map snd <$> clientCons' state ktc u |
989 | |||
990 | clientCons' :: PresenceState | ||
991 | -> Map ConnectionKey t -> Text -> IO [(ConnectionKey,(t, ClientState))] | ||
992 | clientCons' state ktc u = do | ||
990 | mlp <- atomically $ do | 993 | mlp <- atomically $ do |
991 | cmap <- readTVar $ clientsByUser state | 994 | cmap <- readTVar $ clientsByUser state |
992 | return $ Map.lookup u cmap | 995 | return $ Map.lookup u cmap |
@@ -994,7 +997,7 @@ clientCons state ktc u = do | |||
994 | Map.toList (networkClients lp) | 997 | Map.toList (networkClients lp) |
995 | doit (k,client) = do | 998 | doit (k,client) = do |
996 | con <- Map.lookup k ktc | 999 | con <- Map.lookup k ktc |
997 | return (con,client) | 1000 | return (k,(con,client)) |
998 | return $ mapMaybe doit ks | 1001 | return $ mapMaybe doit ks |
999 | 1002 | ||
1000 | peerSubscriptionRequest :: PresenceState -> IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO () | 1003 | peerSubscriptionRequest :: PresenceState -> IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO () |
@@ -1121,7 +1124,7 @@ clientInformSubscription state fail k stanza = do | |||
1121 | is_intereseted <- atomically $ clientIsInterested client | 1124 | is_intereseted <- atomically $ clientIsInterested client |
1122 | when is_intereseted $ do | 1125 | when is_intereseted $ do |
1123 | flip (maybe $ return ()) (Map.lookup ck ktc) $ \con -> do | 1126 | flip (maybe $ return ()) (Map.lookup ck ktc) $ \con -> do |
1124 | hostname <- textHostName | 1127 | hostname <- nameForClient state ck |
1125 | -- TODO: Should cjid include the resource? | 1128 | -- TODO: Should cjid include the resource? |
1126 | let cjid = unsplitJID (mu, hostname, Nothing) | 1129 | let cjid = unsplitJID (mu, hostname, Nothing) |
1127 | update <- makeRosterUpdate cjid to [relationship] | 1130 | update <- makeRosterUpdate cjid to [relationship] |
@@ -1183,10 +1186,10 @@ peerInformSubscription state fail k stanza = do | |||
1183 | addToRosterFile addf user profile from'' addrs | 1186 | addToRosterFile addf user profile from'' addrs |
1184 | removeFromRosterFile remf user profile from'' addrs | 1187 | removeFromRosterFile remf user profile from'' addrs |
1185 | 1188 | ||
1186 | hostname <- textHostName | 1189 | chans <- clientCons' state ktc user |
1190 | forM_ chans $ \(ckey,(Conn { connChan=chan }, client)) -> do | ||
1191 | hostname <- nameForClient state ckey | ||
1187 | let to' = unsplitJID (Just user, hostname, Nothing) | 1192 | let to' = unsplitJID (Just user, hostname, Nothing) |
1188 | chans <- clientCons state ktc user | ||
1189 | forM_ chans $ \(Conn { connChan=chan }, client) -> do | ||
1190 | update <- makeRosterUpdate to' from'' [relationship] | 1193 | update <- makeRosterUpdate to' from'' [relationship] |
1191 | is_intereseted <- atomically $ clientIsInterested client | 1194 | is_intereseted <- atomically $ clientIsInterested client |
1192 | when is_intereseted $ do | 1195 | when is_intereseted $ do |