From 6b264121bee3b5c08af388f20c5273ef8956bc5e Mon Sep 17 00:00:00 2001
From: James Crayne <jim.crayne@gmail.com>
Date: Sat, 3 Nov 2018 03:00:58 -0400
Subject: addDestroySessionHook

---
 src/Network/Tox.hs                 | 34 ++--------------------------------
 src/Network/Tox/Crypto/Handlers.hs |  9 +++++++++
 2 files changed, 11 insertions(+), 32 deletions(-)

(limited to 'src/Network')

diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 3ad2b11e..861d71d3 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -363,32 +363,6 @@ 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 -> do
-                mp <- readTVar (netCryptoSessionsByKey (ncAllSessions session))
-                case Map.lookup (ncTheirPublicKey session) mp of
-                    Just sessionsWithThisPublicKey
-                        | relevantSessions <- filter ((/=ncSessionId session) . ncSessionId) sessionsWithThisPublicKey
-                        , not (null relevantSessions)
-                        -> do
-                     let showsession x = printf "%x" (ncSessionId x)
-                     return . Left $ "Not calling setTerminated on " ++ show (key2id (ncTheirPublicKey session))
-                                            ++" despite session(" ++ showsession session
-                                            ++ ") failure. (Still have sessions: ["
-                                            ++ Data.List.intercalate "," (map showsession relevantSessions)
-                                            ++ "]"
-                    _ -> Right <$> setTerminated (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.
        -> Maybe NetCryptoSessions    -- ^ State of all one-on-one Tox links.
@@ -411,13 +385,9 @@ newToxOverTransport keydb addr mbSessionsState suppliedDHTKey udp = do
     (crypto0,sessionsState0) <- case mbSessionsState of
                                  Nothing -> do
                                     crypto <- newCrypto
-                                    sessionsState <- newSessionsState crypto (mkDefaultDestroyHook roster) defaultUnRecHook defaultCryptoDataHooks
+                                    sessionsState <- newSessionsState crypto (const $ dput XUnexpected "Missing destroy hook!") defaultUnRecHook defaultCryptoDataHooks
                                     return (crypto,sessionsState)
-                                 Just s -> do
-                                    let oldhook = defaultDestroyHook s
-                                        oldhook' = filter ((==0) . fst) oldhook
-                                        newhook = (0,mkDefaultDestroyHook roster):oldhook'
-                                    return (transportCrypto s, s { defaultDestroyHook = newhook})
+                                 Just s -> return (transportCrypto s, s)
 
     let -- patch in supplied DHT key
         crypto1 = fromMaybe crypto0 $do
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index f0332df0..50224178 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -360,6 +360,15 @@ type NewSessionHook = IOHook (Maybe NoSpam) NetCryptoSession
 addNewSessionHook :: NetCryptoSessions -> NewSessionHook -> STM ()
 addNewSessionHook allsessions@(NCSessions { announceNewSessionHooks }) hook = modifyTVar announceNewSessionHooks (hook:)
 
+addDestroySessionHook :: NetCryptoSession -> (Maybe Int) -> (NetCryptoSession -> IO ()) -> STM Int
+addDestroySessionHook netcrypto mbkey hook = do
+    modifyTVar (ncDestoryHooks netcrypto) $ \hooklist ->
+        case mbkey of
+            Just key -> ((key,hook):filter ((/=key) . fst) hooklist)
+            Nothing -> let maxkey = maximum (map fst hooklist)
+                           in if null hooklist then [(0,hook)] else (maxkey+1,hook):hooklist
+    fst . head <$> readTVar (ncDestoryHooks netcrypto)
+
 forgetCrypto :: TransportCrypto -> NetCryptoSessions -> NetCryptoSession -> STM ()
 forgetCrypto crypto (NCSessions {netCryptoSessions,netCryptoSessionsByKey}) session = do
     let HaveDHTKey addr = ncSockAddr session
-- 
cgit v1.2.3