From 0eb24ec3748a08c8e62077a755b674a46ee249d7 Mon Sep 17 00:00:00 2001
From: shum <github.shum@liber.li>
Date: Wed, 1 Apr 2026 14:40:21 +0000
Subject: [PATCH] cli: decouple key reading from processing via TQueue

---
 src/Simplex/Chat/Terminal.hs       | 10 +++++++++-
 src/Simplex/Chat/Terminal/Input.hs | 14 +++++++-------
 2 files changed, 16 insertions(+), 8 deletions(-)

diff --git a/src/Simplex/Chat/Terminal.hs b/src/Simplex/Chat/Terminal.hs
index e432343839..988d92d63b 100644
--- a/src/Simplex/Chat/Terminal.hs
+++ b/src/Simplex/Chat/Terminal.hs
@@ -8,6 +8,7 @@
 module Simplex.Chat.Terminal where
 
 import Control.Monad
+import Control.Monad.IO.Class (liftIO)
 import qualified Data.List.NonEmpty as L
 import Simplex.Chat (defaultChatConfig)
 import Simplex.Chat.Controller
@@ -22,6 +23,8 @@ import Simplex.Chat.Terminal.Output
 import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
 import Simplex.Messaging.Client (NetworkConfig (..), SMPProxyFallback (..), SMPProxyMode (..), defaultNetworkConfig)
 import Simplex.Messaging.Util (raceAny_)
+import System.Terminal (Key, Modifiers)
+import UnliftIO.STM
 #if !defined(dbPostgres)
 import Control.Exception (handle, throwIO)
 import qualified Data.ByteArray as BA
@@ -97,4 +100,9 @@ simplexChatTerminal cfg options t = run options
 #endif
 
 runChatTerminal :: ChatTerminal -> ChatController -> ChatOpts -> IO ()
-runChatTerminal ct cc opts = raceAny_ [runTerminalInput ct cc, runTerminalOutput ct cc opts, runInputLoop ct cc]
+runChatTerminal ct cc opts = do
+  keyQ <- newTQueueIO
+  raceAny_ [runKeyReader ct keyQ, runTerminalInput ct cc keyQ, runTerminalOutput ct cc opts, runInputLoop ct cc]
+
+runKeyReader :: ChatTerminal -> TQueue (Key, Modifiers) -> IO ()
+runKeyReader ct q = withChatTerm ct $ forever $ getKey >>= liftIO . atomically . writeTQueue q
diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs
index b7eebd141a..fd34451af4 100644
--- a/src/Simplex/Chat/Terminal/Input.hs
+++ b/src/Simplex/Chat/Terminal/Input.hs
@@ -151,14 +151,14 @@ sendUpdatedLiveMessage cc sentMsg LiveMessage {chatName, chatItemId} live = do
   let cmd = UpdateLiveMessage chatName chatItemId live $ T.pack sentMsg
   execChatCommand' cmd 0 `runReaderT` cc
 
-runTerminalInput :: ChatTerminal -> ChatController -> IO ()
-runTerminalInput ct cc = withChatTerm ct $ do
-  updateInput ct
-  receiveFromTTY cc ct
+runTerminalInput :: ChatTerminal -> ChatController -> TQueue (Key, Modifiers) -> IO ()
+runTerminalInput ct cc keyQ = do
+  updateInputView ct
+  receiveFromTTY keyQ cc ct
 
-receiveFromTTY :: forall m. MonadTerminal m => ChatController -> ChatTerminal -> m ()
-receiveFromTTY cc@ChatController {inputQ, currentUser, currentRemoteHost, chatStore} ct@ChatTerminal {termSize, termState, liveMessageState, activeTo} =
-  forever $ getKey >>= liftIO . processKey >> withTermLock ct (updateInput ct)
+receiveFromTTY :: TQueue (Key, Modifiers) -> ChatController -> ChatTerminal -> IO ()
+receiveFromTTY keyQ cc@ChatController {inputQ, currentUser, currentRemoteHost, chatStore} ct@ChatTerminal {termSize, termState, liveMessageState, activeTo} =
+  forever $ atomically (readTQueue keyQ) >>= processKey >> updateInputView ct
   where
     processKey :: (Key, Modifiers) -> IO ()
     processKey key = case key of