From 292c3344600abb389f5b8fba7a35fca374049ae6 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Wed, 2 Feb 2022 17:47:27 +0000
Subject: [PATCH] make slow commands asynchronous (#258)

---
 src/Simplex/Chat.hs      | 24 +++++++++++++-----------
 src/Simplex/Chat/View.hs |  4 ++--
 2 files changed, 15 insertions(+), 13 deletions(-)

diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 9f2a71762..8e993f1b7 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -358,17 +358,19 @@ processChatCommand user@User {userId, profile} = \case
   ShowVersion -> pure CRVersionInfo
   where
     procCmd :: m ChatResponse -> m ChatResponse
-    procCmd a = do
-      a
-    -- ! below code would make command responses asynchronous where they can be slow
-    -- ! in View.hs `r'` should be defined as `id` in this case
-    -- gVar <- asks idsDrg
-    -- corrId <- liftIO $ CorrId <$> randomBytes gVar 8
-    -- q <- asks outputQ
-    -- void . forkIO $ atomically . writeTBQueue q =<<
-    --   (Just corrId,) <$> (a `catchError` (pure . CRChatError))
-    -- pure $ CRCmdAccepted corrId
-    -- a corrId
+    procCmd action = do
+      -- below code would make command responses asynchronous where they can be slow
+      -- in View.hs `r'` should be defined as `id` in this case
+      ChatController {chatLock = l, smpAgent = a, outputQ = q, idsDrg = gVar} <- ask
+      corrId <- liftIO $ SMP.CorrId <$> randomBytes gVar 8
+      void . forkIO $
+        withAgentLock a . withLock l $
+          atomically . writeTBQueue q
+            =<< (Just corrId,) <$> (action `catchError` (pure . CRChatError))
+      pure $ CRCmdAccepted corrId
+    -- use function below to make commands "synchronous"
+    -- procCmd :: m ChatResponse -> m ChatResponse
+    -- procCmd action = action
     connect :: ConnectionRequestUri c -> ChatMsgEvent -> m ()
     connect cReq msg = do
       connId <- withAgent $ \a -> joinConnection a cReq $ directMessage msg
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 6897efaf7..285b7295c 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -117,8 +117,8 @@ responseToView cmd = \case
   where
     api = (highlight cmd :)
     r = (plain cmd :)
-    -- this function should be `id` in case of asynchronous command responses
-    r' = r
+    -- this function should be `r` for "synchronous" command responses
+    r' = id
 
 viewChatItem :: ChatInfo c -> ChatItem c d -> [StyledString]
 viewChatItem chat (ChatItem cd meta content) = case (chat, cd) of