1 files changed, 61 insertions, 30 deletions

diff --git a/ToxToXMPP.hs b/ToxToXMPP.hs
index d6a31f1e..cc3b929d 100644
--- a/ToxToXMPP.hs
+++ b/ToxToXMPP.hs
@@ -100,13 +100,23 @@ key2jid nospam key = T.pack $ show $ NoSpamId nsp key
     nlo = fromIntegral (0x0FFFF .&. nospam) :: Word16
     nhi = fromIntegral (0x0FFFF .&. (nospam `shiftR` 16)) :: Word16
 
-dispatch :: Announcer -> Account -> PresenceState -> ContactEvent -> IO ()
-dispatch acr acnt st (SessionEstablished theirKey) = return ()
-dispatch acr acnt st (SessionTerminated theirKey)  = return ()
-dispatch acr acnt st (AddrChange   theirkey saddr)                    = return () -- todo
-dispatch acr acnt st (PolicyChange theirkey policy                  ) = return () -- todo
-dispatch acr acnt st (OnionRouted  theirkey (OnionDHTPublicKey pkey)) = return () -- todo
-dispatch acr acnt st (OnionRouted  theirkey (OnionFriendRequest fr) ) = do
+data ToxToXMPP = ToxToXMPP
+    { txAnnouncer :: Announcer
+    , txAccount   :: Account
+    , txPresence  :: PresenceState
+    , txTox       :: Tox
+    }
+
+dispatch :: ToxToXMPP -> ContactEvent -> IO ()
+dispatch tx (SessionEstablished theirKey) = stopConnecting tx theirKey
+dispatch tx (SessionTerminated theirKey)  = startConnecting tx theirKey
+dispatch tx (AddrChange   theirkey saddr)                    = return () -- todo
+dispatch tx (PolicyChange theirkey policy                  ) = return () -- todo
+dispatch tx (OnionRouted  theirkey (OnionDHTPublicKey pkey)) = return () -- todo
+dispatch tx (OnionRouted  theirkey (OnionFriendRequest fr) ) = do
+    let ToxToXMPP { txAnnouncer = acr
+                  , txAccount   = acnt
+                  , txPresence  = st } = tx
     k2c <- atomically $ do
         refs <- readTVar (clientRefs acnt)
         k2c <- Map.filterWithKey (\k _ -> k `Set.member` refs) <$> readTVar (keyToChan st)
@@ -134,28 +144,20 @@ akeyDHTKeyShare announcer me them = atomically $ do
 akeyConnect announcer me them = atomically $ do
     packAnnounceKey announcer $ "connect:" ++ (take 8 $ show me) ++ ":" ++ show them
 
-forkAccountWatcher :: Account -> Tox -> PresenceState -> Announcer -> IO ThreadId
-forkAccountWatcher acc tox st announcer = forkIO $ do
-    myThreadId >>= flip labelThread ("tox-xmpp:"
-                                      ++ show (key2id $ toPublic $ userSecret acc))
-    (chan,contacts) <- atomically $ do
-                chan <- dupTChan $ eventChan acc -- duplicate broadcast channel for reading.
-                contacts <- readTVar (contacts acc)
-                return (chan,contacts)
-    -- TODO: process information in contacts HashMap.
-
-    let nearNodes nid = do
-            bkts4 <- readTVar $ routing4 $ toxRouting tox
-            bkts6 <- readTVar $ routing6 $ toxRouting tox
-            let nss = map (R.kclosest (searchSpace (toxQSearch tox)) searchK nid)
-                          [bkts4,bkts6]
-            return $ foldr interweave [] nss
-
-
-    forM_ (HashMap.toList contacts) $ \(them,Contact{contactPolicy}) -> do
-        wanted <- atomically $ (==Just TryingToConnect) <$> readTVar contactPolicy
+startConnecting0 :: ToxToXMPP -> PublicKey -> Contact -> IO ()
+startConnecting0 tx them contact = do
+        let ToxToXMPP { txTox       = tox
+                      , txAnnouncer = announcer
+                      , txAccount   = acnt     } = tx
+        let nearNodes nid = do
+                bkts4 <- readTVar $ routing4 $ toxRouting tox
+                bkts6 <- readTVar $ routing6 $ toxRouting tox
+                let nss = map (R.kclosest (searchSpace (toxQSearch tox)) searchK nid)
+                              [bkts4,bkts6]
+                return $ foldr interweave [] nss
+        wanted <- atomically $ (==Just TryingToConnect) <$> readTVar (contactPolicy contact)
         when wanted $ do
-            let pub = toPublic $ userSecret acc
+            let pub = toPublic $ userSecret acnt
                 me  = key2id pub
             akey <- akeyDHTKeyShare announcer me them
                     -- We send this packet every 30 seconds if there is more
@@ -183,12 +185,40 @@ forkAccountWatcher acc tox st announcer = forkIO $ do
                                             (Tox.AnnouncedRendezvous theirkey rendezvous)
                                             (pub,Tox.OnionDHTPublicKey dkey))
                                      nearNodes
-                                     them
+                                     (key2id them)
                                      30) -- every 30 seconds
                      pub
 
+startConnecting :: ToxToXMPP -> PublicKey -> IO ()
+startConnecting tx them = do
+    mc <- atomically $ HashMap.lookup (key2id them)
+                        <$> readTVar (contacts $ txAccount tx)
+    forM_ mc $ startConnecting0 tx them
 
 
+stopConnecting :: ToxToXMPP -> PublicKey -> IO ()
+stopConnecting ToxToXMPP{txAnnouncer=announcer,txAccount=acnt} them = do
+    let pub = toPublic $ userSecret acnt
+        me  = key2id pub
+    akey <- akeyDHTKeyShare announcer me them
+    cancel announcer akey
+
+forkAccountWatcher :: Account -> Tox -> PresenceState -> Announcer -> IO ThreadId
+forkAccountWatcher acc tox st announcer = forkIO $ do
+    myThreadId >>= flip labelThread ("tox-xmpp:"
+                                      ++ show (key2id $ toPublic $ userSecret acc))
+    (chan,contacts) <- atomically $ do
+                chan <- dupTChan $ eventChan acc -- duplicate broadcast channel for reading.
+                contacts <- readTVar (contacts acc)
+                return (chan,contacts)
+    let tx = ToxToXMPP { txAnnouncer = announcer
+                       , txAccount   = acc
+                       , txPresence  = st
+                       , txTox       = tox
+                       }
+    forM_ (HashMap.toList contacts) $ \(them,c) -> do
+        startConnecting0 tx (id2key them) c
+
     -- Loop endlessly until clientRefs is null.
     fix $ \loop -> do
     mev <- atomically $
@@ -197,7 +227,8 @@ forkAccountWatcher acc tox st announcer = forkIO $ do
                 refs <- readTVar $ clientRefs acc
                 check $ Set.null refs
                 return Nothing
-    forM_ mev $ \ev -> dispatch announcer acc st ev >> loop
+
+    forM_ mev $ \ev -> dispatch tx ev >> loop
 
 toxQSearch :: Tox.Tox -> Search Tox.NodeId (IP, PortNumber) Nonce32 Tox.NodeInfo Tox.Rendezvous
 toxQSearch tox = Tox.toxidSearch (Tox.onionTimeout tox) (Tox.toxCryptoKeys tox) (Tox.toxOnion tox)