diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 715e460c87..010cabc3d8 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -382,17 +382,17 @@ processChatCommand = \case withAgentLock a . withLock l $ action -- below code would make command responses asynchronous where they can be slow -- in View.hs `r'` should be defined as `id` in this case - procCmd :: m ChatResponse -> m ChatResponse - procCmd action = do - 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 = id + -- procCmd action = do + -- 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 = id connectViaContact :: UserId -> ConnectionRequestUri 'CMContact -> Profile -> m ChatResponse connectViaContact userId cReq profile = withChatLock $ do let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 08ad47543c..dc77335354 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -67,7 +67,7 @@ responseToView cmd testView = \case CRSentConfirmation -> r' ["confirmation sent!"] CRSentInvitation -> r' ["connection request sent!"] CRContactDeleted c -> r' [ttyContact' c <> ": contact is deleted"] - CRAcceptingContactRequest c -> r' [ttyFullContact c <> ": accepting contact request..."] + CRAcceptingContactRequest c -> r [ttyFullContact c <> ": accepting contact request..."] CRContactAlreadyExists c -> r [ttyFullContact c <> ": contact already exists"] CRContactRequestAlreadyAccepted c -> r' [ttyFullContact c <> ": sent you a duplicate contact request, but you are already connected, no action needed"] CRUserContactLinkCreated cReq -> r' $ connReqContact_ "Your new chat address is created!" cReq @@ -125,8 +125,8 @@ responseToView cmd testView = \case where r = (plain cmd :) -- this function should be `r` for "synchronous", `id` for "asynchronous" command responses - -- r' = r - r' = id + r' = r + -- r' = id testViewChats :: [AChat] -> [StyledString] testViewChats chats = [sShow $ map toChatView chats] where diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 9e7ecb1404..f10bba0d82 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -744,6 +744,7 @@ testUserContactLinkAutoAccept = cath ##> ("/c " <> cLink) cath <## "connection request sent!" + alice <## "" alice <## "cath (Catherine): accepting contact request..." concurrently_ (cath <## "alice (Alice): contact is connected")