1 files changed, 19 insertions, 3 deletions

diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index cebbebfb..26488657 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -354,6 +354,18 @@ getOnionAlias crypto dhtself remoteNode = atomically $ do
             _ -> ni { nodeId = key2id (onionAliasPublic crypto) }
     return $ Onion.OnionDestination Onion.SearchingAlias alias Nothing
 
+mkDefaultDestroyHook :: ContactInfo extra -> NetCryptoSession -> IO ()
+mkDefaultDestroyHook roster = \session -> do
+   now <- getPOSIXTime
+   r <- atomically $ do
+           accounts <- readTVar (accounts roster) -- :: STM (HashMap NodeId (Account extra)
+           let mbAccount = HashMap.lookup (key2id $ ncMyPublicKey session) accounts -- :: STM (Maybe (Account extra)
+           case mbAccount of
+            Just account -> Right <$> setTerminated now (ncTheirPublicKey session) account
+            Nothing -> return . Left $ "(defaultDestroyHook) their is no account! pubkey=" ++ show (key2id (ncTheirPublicKey session))
+   case r of
+    Left msg -> dput XMan msg
+    _ -> return ()
 
 newTox :: TVar Onion.AnnouncedKeys   -- ^ Store of announced keys we are a rendezvous for.
        -> SockAddr                   -- ^ Bind-address to listen on.
@@ -362,14 +374,18 @@ newTox :: TVar Onion.AnnouncedKeys   -- ^ Store of announced keys we are a rende
        -> IO (Tox extra)
 newTox keydb addr mbSessionsState suppliedDHTKey = do
     (udp,sock) <- {- addVerbosity <$> -} udpTransport' addr
+    roster <- newContactInfo
     (crypto0,sessionsState0) <- case mbSessionsState of
                                  Nothing -> do
                                     crypto <- newCrypto
-                                    sessionsState <- newSessionsState crypto defaultUnRecHook defaultCryptoDataHooks
+                                    sessionsState <- newSessionsState crypto (mkDefaultDestroyHook roster) defaultUnRecHook defaultCryptoDataHooks
                                     return (crypto,sessionsState)
-                                 Just s -> return (transportCrypto s, s)
+                                 Just s -> do
+                                    let oldhook = defaultDestroyHook s
+                                        oldhook' = filter ((==0) . fst) oldhook
+                                        newhook = (0,mkDefaultDestroyHook roster):oldhook'
+                                    return (transportCrypto s, s { defaultDestroyHook = newhook})
 
-    roster <- newContactInfo
     let -- patch in supplied DHT key
         crypto1 = fromMaybe crypto0 $do
             k <- suppliedDHTKey