From ba979fa40dba2464a84abf665ec8470f6303e38d Mon Sep 17 00:00:00 2001 From: shum Date: Fri, 25 Sep 2026 15:39:18 +0000 Subject: [PATCH] core: cancel the chat callback on interrupt --- src/Simplex/Chat/Core.hs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/Simplex/Chat/Core.hs b/src/Simplex/Chat/Core.hs index 433e2605fd..ccf6f15bdb 100644 --- a/src/Simplex/Chat/Core.hs +++ b/src/Simplex/Chat/Core.hs @@ -13,12 +13,15 @@ module Simplex.Chat.Core ) where +import Control.Concurrent (forkIO) +import Control.Exception (mask, onException, throwTo) import Control.Logger.Simple import Control.Monad import Control.Monad.Except import Control.Monad.Reader import qualified Data.ByteString.Char8 as B import Data.List (find) +import Data.Maybe (isNothing) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) @@ -94,8 +97,12 @@ runSimplexChat ChatConfig {testView} ChatOpts {coreOptions = CoreChatOpts {chatR a1 <- runReaderT (startChatController True True False) cc when (chatRelay && not testView) $ askCreateRelayAddress cc u chatRelayServer headless forM_ (postStartHook chatHooks) ($ cc) - a2 <- async $ chat u cc - waitEither_ a1 a2 + -- throwTo waits while the callback is masked, so an outside interrupt cancels it from a forked thread. + -- A /_stop sent from the callback ends a1 first, which leaves the callback running. + mask $ \restore -> do + a2 <- asyncWithUnmask $ \unmask -> unmask (chat u cc) + let cancelCallback = poll a1 >>= \r -> when (isNothing r) $ void $ forkIO $ throwTo (asyncThreadId a2) AsyncCancelled + restore (waitEither_ a1 a2) `onException` cancelCallback sendChatCmdStr :: ChatController -> String -> IO (Either ChatError ChatResponse) sendChatCmdStr cc s = runReaderT (execChatCommand CSLocal (encodeUtf8 $ T.pack s) 0) cc