1 files changed, 31 insertions, 3 deletions

diff --git a/ToxManager.hs b/ToxManager.hs
index 14b2070c..793a3b8a 100644
--- a/ToxManager.hs
+++ b/ToxManager.hs
@@ -9,16 +9,19 @@ module ToxManager where
 import Announcer
 import Announcer.Tox
 import ClientState
+import ConfigFiles
 import Control.Arrow
 import Control.Concurrent.STM
 import Control.Monad
 import Crypto.Tox
-import qualified Data.ByteArray              as BA
 import Data.Bits
+import qualified Data.ByteArray              as BA
 import Data.Function
 import qualified Data.HashMap.Strict         as HashMap
+import Data.List
 import qualified Data.Map                    as Map
 import Data.Maybe
+import Data.Ord
 import qualified Data.Set                    as Set
 import qualified Data.Text                   as T
          ;import Data.Text                   (Text)
@@ -56,9 +59,9 @@ import Control.Concurrent.Lifted.Instrument
 import Control.Concurrent.Lifted
 import GHC.Conc                  (labelThread)
 #endif
-import GHC.Conc                  (unsafeIOToSTM)
 import Connection
 import Connection.Tcp (TCPStatus)
+import GHC.Conc       (unsafeIOToSTM)
 
 
 toxAnnounceSendData :: Tox.Tox JabberClients
@@ -476,7 +479,8 @@ realShakeHands myseckey theirpubkey theirDhtKey allsessions saddr cookie = do
 
 
 dispatch :: ToxToXMPP -> ContactEvent -> IO ()
-dispatch tx (SessionEstablished theirKey)                    = stopConnecting tx theirKey "established"
+dispatch tx (SessionEstablished theirKey)                    = do stopConnecting tx theirKey "established"
+                                                                  updateRoster tx theirKey
 dispatch tx (SessionTerminated theirKey)                     = startConnecting tx theirKey "terminated"
 dispatch tx (AddrChange   theirKey saddr)                    = gotAddr saddr tx theirKey
 dispatch tx (PolicyChange theirkey TryingToConnect         ) = startConnecting tx theirkey "policy"
@@ -521,6 +525,30 @@ akeyConnect announcer me them =
     packAnnounceKey announcer $ "connect(" ++ (take 8 $ show me) ++ ")" ++ show (key2id them)
 
 
+
+-- | Because Tox does not have a friend-request response, we consider an
+-- established connection to be an implicit two-way subscription.
+updateRoster :: ToxToXMPP -> PublicKey -> IO ()
+updateRoster tx them = do
+    let me = toPublic $ userSecret $ txAccount tx
+        profile = T.pack $ show (key2id me) ++ ".tox"
+        jid = T.pack $ show (key2id them) ++ ".tox"
+        man = manager (txPresence tx) profile
+    addr <- do
+        u <- xor24 <$> hash24 me <*> hash24 them
+        return [ addrToPeerKey . Remote . peerAddress . uniqueAsKey $ u ]
+    mp <- atomically $ Map.lookup profile <$> readTVar (clientsByProfile $ txPresence tx)
+    forM_ mp $ \LocalPresence{networkClients} -> do
+    let css = groupBy ((==) `on` clientUser)  -- We treat all clients from a single user as one.
+              $ sortBy (comparing clientUser)
+              $ Map.elems networkClients
+    forM_ css $ \(c:_) -> do
+    let user = clientUser c
+    addToRosterFile man modifyBuddies     user profile jid addr
+    addToRosterFile man modifySubscribers user profile jid addr
+    -- Cancel friend-request sending.
+    modifyRosterFile man modifySolicited user profile jid addr False True
+
 -- | Returns a list of nospam values to use for friend requests to send to a
 -- remote peer.  This list is non-empty only when it is desirable to send
 -- friend requests.