1 files changed, 13 insertions, 6 deletions

diff --git a/dht/examples/dhtd.hs b/dht/examples/dhtd.hs
index f4d04761..de315e35 100644
--- a/dht/examples/dhtd.hs
+++ b/dht/examples/dhtd.hs
@@ -1326,17 +1326,24 @@ onNewToxSession :: (IO () -> STM ())
                      -> Tox.Session
                      -> IO ()
 onNewToxSession runio sv ssvar invc ContactInfo{accounts} addrTox netcrypto = do
+    dput XMan "onNewToxSession"
     let them s = Tox.longTermKey $ runIdentity cookie -- remote tox key
          where Tox.Cookie _ cookie = Tox.handshakeCookie (sReceivedHandshake s)
 
         me   s = toPublic $ sOurKey s
 
-        onStatusChange :: (Tox.Session -> Tcp.ConnectionEvent XML.Event -> STM ())
+    uniqkey <- xor24 <$> hash24 (them netcrypto) <*> hash24 (me netcrypto)
+
+    let onStatusChange :: (Tox.Session -> Tcp.ConnectionEvent XML.Event -> STM ())
                           -> AggregateSession -> Tox.Session -> Status Tox.ToxProgress -> STM ()
         onStatusChange announce c s Established = onConnect announce c s
         onStatusChange announce _ s status      = onEOF announce s status
 
         onEOF announce s status = do
+            case status of
+                Dormant -> -- Dormant AggregateSession is useless, so discard it.
+                           modifyTVar' ssvar $ Map.delete uniqkey
+                _       -> return ()
             runio $ dput XMan $ "EOF(" ++ take 16 (showKey256 $ them s) ++ "): " ++ show status
             HashMap.lookup (Tox.key2id $ me s) <$> readTVar accounts
                 >>= mapM_ (setTerminated $ them s)
@@ -1364,12 +1371,10 @@ onNewToxSession runio sv ssvar invc ContactInfo{accounts} addrTox netcrypto = do
                                              Chunk x -> Just (Nothing,x))
                         .| toxSnk
 
-    uniqkey <- xor24 <$> hash24 (them netcrypto) <*> hash24 (me netcrypto)
-
     let me_dot_tox = xmppHostname $ me netcrypto
         them_dot_tox = xmppHostname $ them netcrypto
 
-    c <- atomically $ do
+    c <- join $ atomically $ do
         mc <- Map.lookup uniqkey <$> readTVar ssvar
         case mc of
             Nothing -> do
@@ -1387,8 +1392,10 @@ onNewToxSession runio sv ssvar invc ContactInfo{accounts} addrTox netcrypto = do
                     return $ \s e -> writeTChan (xmppEventChannel sv) ( (ck, condta s), e)
                 c <- newAggregateSession $ onStatusChange announce
                 modifyTVar' ssvar $ Map.insert uniqkey c
-                return c
-            Just c  -> return c
+                return $ do
+                    dput XMan $ "New AggregateSession!"
+                    return c
+            Just c  -> return $ return c
 
     addSession c netcrypto