Fixed redundant session close and memory leak.

1 files changed, 22 insertions, 9 deletions

diff --git a/ToxManager.hs b/ToxManager.hs
index 40377b62..01403d9d 100644
--- a/ToxManager.hs
+++ b/ToxManager.hs
@@ -221,10 +221,13 @@ toxman ssvar announcer toxbkts tox presence = ToxManager
                    themid <- readMaybe $ T.unpack them
                    return (id2key meid, id2key themid)
         forM m $ \(me,them) -> do
-            u <- xor24 <$> hash24 me <*> hash24 them
+            u <- meAndThem me them
             return $ addrToPeerKey $ Remote $ peerAddress $ uniqueAsKey u
     }
 
+meAndThem :: PublicKey -> PublicKey -> IO Uniq24
+meAndThem me them = xor24 <$> hash24 me <*> hash24 them
+
 key2jid :: Word32 -> PublicKey -> Text
 key2jid nospam key = T.pack $ show $ NoSpamId nsp key
  where
@@ -656,6 +659,14 @@ stopConnecting ToxToXMPP{txAnnouncer=announcer,txAccount=acnt} them reason = do
     cancel announcer akeyC
     cancel announcer akeyD
 
+closeSessions :: NodeId{-me-} -> NodeId{-them-} -> TVar (Map.Map Uniq24 AggregateSession) -> IO ()
+closeSessions me them ssvar = do
+    m <- atomically $ readTVar ssvar
+    u <- meAndThem (id2key me) (id2key them)
+    forM_ (Map.lookup u m) $ \ag -> do
+        -- Just True <- checkCompatible ag (id2key me) (id2key them)
+        closeAll ag
+
 forkAccountWatcher :: TVar (Map.Map Uniq24 AggregateSession)
                       -> Account JabberClients -> Tox JabberClients -> PresenceState Pending -> Announcer -> IO ThreadId
 forkAccountWatcher ssvar acc tox st announcer = forkIO $ do
@@ -676,19 +687,21 @@ forkAccountWatcher ssvar acc tox st announcer = forkIO $ do
 
     -- Loop endlessly until accountExtra is null.
     fix $ \loop -> do
-    mev <- atomically $
-            (Just <$> readTChan chan)
-            `orElse` do
-                refs <- readTVar $ accountExtra acc
-                check $ Map.null refs
-                return Nothing
+        mev <- atomically $
+                (Just <$> readTChan chan)
+                `orElse` do
+                    refs <- readTVar $ accountExtra acc
+                    check $ Map.null refs
+                    return Nothing
 
-    forM_ mev $ \ev -> dispatch tx ev >> loop
+        forM_ mev $ \ev -> dispatch tx ev >> loop
 
+    -- Stop tasks associated with each contact for this account.
     cs <- atomically $ readTVar (contacts acc)
+    let me = key2id $ toPublic $ userSecret acc
     forM_ (HashMap.toList cs) $ \(them,c) -> do
         stopConnecting tx (id2key them) "disabled account"
-        -- TODO: closeAll for each relevant session in ssvar.
+        closeSessions me them ssvar
 
 
 toxAnnounceInterval :: POSIXTime