badges: service group with multi-use codes (#7578)

* core: cancel the chat callback on interrupt

* badges: add multi-use codes

* badges: add the managed group

* badges: document multi-use codes and the group

* core: sign test badges with whole-second expiry

* badges: rework tracker and reply texts

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