call setTerminated from destroySession

1 files changed, 11 insertions, 1 deletions

diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 2e00d61b..85e6192a 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -326,6 +326,7 @@ data NetCryptoSession = NCrypto
                                        TVar
     , ncUnrecognizedHook   :: TVar (MessageType -> NetCryptoHook)
     , ncIdleEventHooks     :: TVar [(Int,NetCryptoSession -> IO ())]
+    , ncDestoryHooks       :: TVar [(Int,NetCryptoSession -> IO ())]
     , ncIncomingTypeArray  :: TVar MsgTypeArray
     -- ^ This array maps 255 Id bytes to MessageType
     -- It should contain all messages this session understands.
@@ -412,6 +413,7 @@ data NetCryptoSessions = NCSessions
     , defaultHooks            :: Map.Map MessageType [NetCryptoHook]
     , defaultUnrecognizedHook :: MessageType -> NetCryptoHook
     , defaultIdleEventHooks   :: [(Int,NetCryptoSession -> IO ())]
+    , defaultDestroyHook      :: [(Int,NetCryptoSession -> IO ())]
     , sessionView             :: SessionView
     , msgTypeArray            :: MsgTypeArray
     , inboundQueueCapacity    :: Word32
@@ -445,10 +447,11 @@ forgetCrypto crypto (NCSessions {netCryptoSessions,netCryptoSessionsByKey}) sess
                                                                     ys -> Just ys) sPubKey)
 
 newSessionsState :: TransportCrypto
+                 -> (NetCryptoSession -> IO ())         -- ^ default destroy hook
                  -> (MessageType -> NetCryptoHook)      -- ^ default hook
                  -> Map.Map MessageType [NetCryptoHook] -- ^ all hooks, can be empty to start
                  -> IO NetCryptoSessions
-newSessionsState crypto unrechook hooks = do
+newSessionsState crypto destroyHook unrechook hooks = do
     x <- atomically $ newTVar Map.empty
     x2 <- atomically $ newTVar Map.empty
     nick <- atomically $ newTVar B.empty
@@ -479,6 +482,7 @@ newSessionsState crypto unrechook hooks = do
                       , defaultHooks            = hooks
                       , defaultUnrecognizedHook = unrechook
                       , defaultIdleEventHooks   = [(0,handleRequestsOutOfOrder)]
+                      , defaultDestroyHook      = [(0,destroyHook)]
                       , sessionView             = SessionView
                             { svNick        = nick
                             , svStatus      = status
@@ -609,6 +613,7 @@ freshCryptoSession  sessions
     ncHooks0 <- newTVar (defaultHooks sessions)
     ncUnrecognizedHook0 <- newTVar (defaultUnrecognizedHook sessions)
     ncIdleEventHooks0 <- newTVar (defaultIdleEventHooks sessions)
+    ncDestoryHooks0 <- newTVar (defaultDestroyHook sessions)
     ncIncomingTypeArray0 <- newTVar (msgTypeArray sessions)
     let idMap = foldl (\mp (x,y) -> W64.insert x y mp) W64.empty (zip [0..255] [0..255])
     (ncOutgoingIdMap0,lossyEscapeIdMap,losslessEscapeIdMap,ncOutHooks0) <- do
@@ -684,6 +689,7 @@ freshCryptoSession  sessions
                     , ncOutHooks           = ncOutHooks0
                     , ncUnrecognizedHook   = ncUnrecognizedHook0
                     , ncIdleEventHooks     = ncIdleEventHooks0
+                    , ncDestoryHooks       = ncDestoryHooks0
                     , ncAllSessions        = sessions
                     , ncIncomingTypeArray  = ncIncomingTypeArray0
                     , ncOutgoingIdMap      = ncOutgoingIdMap0
@@ -892,6 +898,10 @@ runUponHandshake netCryptoSession0 addr pktoq = do
 
 destroySession :: NetCryptoSession -> IO ()
 destroySession session = do
+    -- first run all destory hooks
+    hooks <- atomically (readTVar (ncDestoryHooks session))
+    forM_ hooks $ \(key,hook) -> hook session
+    -- now clean up threads
     let allsessions = ncAllSessions session
         sid = ncSessionId session
         stopThread :: TVar (Maybe ThreadId) -> IO ()