1 files changed, 10 insertions, 18 deletions

diff --git a/Presence/Presence.hs b/Presence/Presence.hs
index 244bbead..befe47e1 100644
--- a/Presence/Presence.hs
+++ b/Presence/Presence.hs
@@ -578,17 +578,13 @@ deliverMessage state fail msg =
         mto <- fmap join $ mapM rewriteJIDForPeer (stanzaTo msg)
         fromMaybe fail {- reverse lookup failure -} $ mto <&> \(to',k) -> do
         chans <- atomically $ readTVar (pkeyToChan state)
-        fromMaybe fail $ (Map.lookup k chans) <&> \Conn { connChan = chan
-                                                        , auxData = ConnectionData (Left (Local laddr))
-                                                                                   ctyp
-                                                        } -> do
-        (n,r) <- forClient state senderk (return (Nothing,Nothing))
-                        $ \c -> return (Just (clientUser c), Just (clientResource c))
+        fromMaybe fail $ (Map.lookup k chans) <&> \conn -> do
         -- original 'from' address is discarded.
-        let from' = unsplitJID (n,addrToText laddr,r)
+        from' <- forClient state senderk (return Nothing)
+                        $ return . Just . clientJID conn
         -- dup <- atomically $ cloneStanza (msg { stanzaTo=Just to', stanzaFrom=Just from' })
-        let dup = (msg { stanzaTo=Just to', stanzaFrom=Just from' })
-        sendModifiedStanzaToPeer dup chan
+        let dup = (msg { stanzaTo=Just to', stanzaFrom=from' })
+        sendModifiedStanzaToPeer dup (connChan conn)
       PeerOrigin senderk _ -> do
         (pchans,cchans) <- atomically $ do
             pc <- readTVar (pkeyToChan state)
@@ -596,14 +592,14 @@ deliverMessage state fail msg =
             return (pc,cc)
         fromMaybe fail $ (Map.lookup senderk pchans)
             <&> \(Conn { connChan = sender_chan
-                       , auxData  = ConnectionData (Left laddr) ctyp }) -> do
+                       , auxData  = ConnectionData (Left laddr) ctyp cprof }) -> do
         fromMaybe fail $ (stanzaTo msg) <&> \to -> do
         (mine,(n,h,r)) <- rewriteJIDForClient laddr to []
         if not mine then fail else do
         let to' = unsplitJID (n,h,r)
         let (cmapVar,ckey) = case ctyp of
-                Tox  -> (clientsByProfile state , n <&> (<> ".tox") )
-                XMPP -> (clientsByUser    state , n                 )
+                Tox  -> (clientsByProfile state , Just cprof )
+                XMPP -> (clientsByUser    state , n          )
         cmap <- atomically . readTVar $ cmapVar
         chans <- fmap (fromMaybe []) $ do
             forM (ckey >>= flip Map.lookup cmap) $ \presence_container -> do
@@ -1084,14 +1080,12 @@ peerSubscriptionRequest state fail k stanza chan = do
         cmap <- readTVar (clients state)
         return (pktc,cktc,cmap)
     fromMaybe fail $ (Map.lookup k pktc)
-        <&> \Conn { auxData=ConnectionData (Left laddr) ctyp } -> do
+        <&> \Conn { auxData=ConnectionData (Left laddr) ctyp profile } -> do
     (mine,totup) <- rewriteJIDForClient laddr to []
     if not mine then fail else do
     (_,fromtup) <- rewriteJIDForClient laddr from []
     fromMaybe fail $ mto_u <&> \u -> do
     fromMaybe fail $ mfrom_u <&> \from_u -> do
-    profiles <- releventProfiles ctyp u
-    forM_ profiles $ \profile -> do
     resolved_subs <- resolvedFromRoster ConfigFiles.getSubscribers u profile
     let already_subscribed = elem (mfrom_u,k) resolved_subs
         is_wanted = case stanzaType stanza of
@@ -1225,7 +1219,7 @@ peerInformSubscription state fail k stanza = do
         return (pktc,cktc,cmap)
     fromMaybe fail $ (Map.lookup k ktc)
         <&> \(Conn { connChan=sender_chan
-                   , auxData =ConnectionData (Left laddr) ctyp }) -> do
+                   , auxData =ConnectionData (Left laddr) ctyp profile}) -> do
     (_,(from_u,from_h,_)) <- rewriteJIDForClient laddr from []
     let from'' = unsplitJID (from_u,from_h,Nothing)
         muser = do
@@ -1237,8 +1231,6 @@ peerInformSubscription state fail k stanza = do
     -- This would allow us to answer anonymous probes with 'unsubscribed'.
     fromMaybe fail $ muser <&> \user -> do
     addrs <- resolvePeer from_h
-    profiles <- releventProfiles ctyp user
-    forM_ profiles $ \profile -> do
     was_solicited <- removeFromRosterFile ConfigFiles.modifySolicited user profile from'' addrs
     subs <- resolvedFromRoster ConfigFiles.getSubscribers user profile
     let is_sub = not . null $ map (from_u,) addrs `intersect` subs