UCR

src/Simplex/Chat/Bot.hs

@@ -22,8 +22,8 @@ chatBotRepl :: String -> (String -> String) -> User -> ChatController -> IO ()
 chatBotRepl welcome answer _user cc = do
   initializeBotAddress cc
   race_ (forever $ void getLine) . forever $ do
-    (_, resp) <- atomically . readTBQueue $ outputQ cc
+    (_, UCR {chatResponse}) <- atomically . readTBQueue $ outputQ cc
-    case resp of
+    case chatResponse of
       CRContactConnected contact _ -> do
         contactConnected contact
         void $ sendMsg contact welcome

src/Simplex/Chat/Controller.hs

@@ -113,7 +113,7 @@ data ChatController = ChatController
     chatStoreChanged :: TVar Bool, -- if True, chat should be fully restarted
     idsDrg :: TVar ChaChaDRG,
     inputQ :: TBQueue String,
-    outputQ :: TBQueue (Maybe CorrId, ChatResponse),
+    outputQ :: TBQueue (Maybe CorrId, UserChatResponse),
     notifyQ :: TBQueue Notification,
     sendNotification :: Notification -> IO (),
     chatLock :: Lock,
@@ -289,6 +289,19 @@ data ChatCommand
   | ResetAgentStats
   deriving (Show)
 
+data UserChatResponse = UCR
+  { user :: Maybe User,
+    chatResponse :: ChatResponse
+  }
+  deriving (Show, Generic)
+
+instance ToJSON UserChatResponse where
+  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
+  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+
+ucr :: User -> ChatResponse -> UserChatResponse
+ucr u = UCR (Just u)
+
 data ChatResponse
   = CRActiveUser {user :: User}
   | CRUsersList {users :: [User]}
@@ -557,7 +570,8 @@ instance ToJSON ChatError where
 
 data ChatErrorType
   = CENoActiveUser
-  | CEActiveUserExists
+  | CENoConnectionUser {agentConnId :: AgentConnId}
+  | CEActiveUserExists -- TODO delete
   | CEChatNotStarted
   | CEChatNotStopped
   | CEChatStoreChanged

src/Simplex/Chat/Mobile.hs

@@ -229,7 +229,7 @@ chatParseServer = LB.unpack . J.encode . toServerAddress . strDecode . B.pack
     enc :: StrEncoding a => a -> String
     enc = B.unpack . strEncode
 
-data APIResponse = APIResponse {corr :: Maybe CorrId, resp :: ChatResponse}
+data APIResponse = APIResponse {corr :: Maybe CorrId, resp :: UserChatResponse}
   deriving (Generic)
 
 instance ToJSON APIResponse where

src/Simplex/Chat/Store.hs

@@ -30,6 +30,7 @@ module Simplex.Chat.Store
     setActiveUser,
     getSetActiveUser,
     getUserIdByName,
+    getUserByAConnId,
     createDirectConnection,
     createConnReqConnection,
     getProfileById,
@@ -442,15 +443,16 @@ createUser db Profile {displayName, fullName, image, preferences = userPreferenc
 
 getUsers :: DB.Connection -> IO [User]
 getUsers db =
-  map toUser
+  map toUser <$> DB.query_ db userQuery
-    <$> DB.query_
+
-      db
+userQuery :: Query
-      [sql|
+userQuery =
-        SELECT u.user_id, u.contact_id, p.contact_profile_id, u.active_user, u.local_display_name, p.full_name, p.image, p.preferences
+  [sql|
-        FROM users u
+    SELECT u.user_id, u.contact_id, cp.contact_profile_id, u.active_user, u.local_display_name, cp.full_name, cp.image, cp.preferences
-        JOIN contacts c ON u.contact_id = c.contact_id
+    FROM users u
-        JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
+    JOIN contacts ct ON ct.contact_id = u.contact_id
-      |]
+    JOIN contact_profiles cp ON cp.contact_profile_id = ct.contact_profile_id
+  |]
 
 toUser :: (UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe Preferences) -> User
 toUser (userId, userContactId, profileId, activeUser, displayName, fullName, image, userPreferences) =
@@ -470,22 +472,18 @@ getSetActiveUser db userId = do
 getUser_ :: DB.Connection -> UserId -> ExceptT StoreError IO User
 getUser_ db userId =
   ExceptT . firstRow toUser (SEUserNotFound userId) $
-    DB.query
+    DB.query db (userQuery <> " WHERE u.user_id = ?") (Only userId)
-      db
-      [sql|
-        SELECT u.user_id, u.contact_id, p.contact_profile_id, u.active_user, u.local_display_name, p.full_name, p.image, p.preferences
-        FROM users u
-        JOIN contacts c ON u.contact_id = c.contact_id
-        JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
-        WHERE u.user_id = ?
-      |]
-      (Only userId)
 
 getUserIdByName :: DB.Connection -> UserName -> ExceptT StoreError IO Int64
 getUserIdByName db uName =
   ExceptT . firstRow fromOnly (SEUserNotFoundByName uName) $
     DB.query db "SELECT user_id FROM users WHERE local_display_name = ?" (Only uName)
 
+getUserByAConnId :: DB.Connection -> AgentConnId -> IO (Maybe User)
+getUserByAConnId db agentConnId =
+  maybeFirstRow toUser $
+    DB.query db (userQuery <> " JOIN connections c ON c.user_id = u.user_id WHERE c.agent_conn_id = ?") (Only agentConnId)
+
 createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> IO PendingContactConnection
 createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId = do
   createdAt <- getCurrentTime

src/Simplex/Chat/Terminal/Input.hs

@@ -41,12 +41,12 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
   let bs = encodeUtf8 $ T.pack s
       cmd = parseChatCommand bs
   unless (isMessage cmd) $ echo s
-  r <- runReaderT (execChatCommand bs) cc
+  resp@UCR {chatResponse} <- runReaderT (execChatCommand bs) cc
-  case r of
+  case chatResponse of
     CRChatCmdError _ -> when (isMessage cmd) $ echo s
     _ -> pure ()
-  printRespToTerminal ct cc False r
+  printRespToTerminal ct cc False resp
-  startLiveMessage cmd r
+  startLiveMessage cmd resp
   where
     echo s = printToTerminal ct [plain s]
     isMessage = \case
@@ -57,8 +57,8 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
       Right SendGroupMessageQuote {} -> True
       Right SendMessageBroadcast {} -> True
       _ -> False
-    startLiveMessage :: Either a ChatCommand -> ChatResponse -> IO ()
+    startLiveMessage :: Either a ChatCommand -> UserChatResponse -> IO ()
-    startLiveMessage (Right (SendLiveMessage chatName msg)) (CRNewChatItem (AChatItem cType SMDSnd _ ChatItem {meta = CIMeta {itemId}})) = do
+    startLiveMessage (Right (SendLiveMessage chatName msg)) UCR {chatResponse = CRNewChatItem (AChatItem cType SMDSnd _ ChatItem {meta = CIMeta {itemId}})} = do
       whenM (isNothing <$> readTVarIO liveMessageState) $ do
         let s = T.unpack $ safeDecodeUtf8 msg
             int = case cType of SCTGroup -> 5000000; _ -> 3000000 :: Int
@@ -93,7 +93,7 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
         updateLiveMessage typedMsg lm = case liveMessageToSend typedMsg lm of
           Just sentMsg ->
             sendUpdatedLiveMessage cc sentMsg lm True >>= \case
-              CRChatItemUpdated {} -> setLiveMessage lm {sentMsg, typedMsg}
+              UCR {chatResponse = CRChatItemUpdated {}} -> setLiveMessage lm {sentMsg, typedMsg}
               _ -> do
                 -- TODO print error
                 setLiveMessage lm {typedMsg}
@@ -107,11 +107,11 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
               | otherwise = (s <> reverse (c : w), "")
     startLiveMessage _ _ = pure ()
 
-sendUpdatedLiveMessage :: ChatController -> String -> LiveMessage -> Bool -> IO ChatResponse
+sendUpdatedLiveMessage :: ChatController -> String -> LiveMessage -> Bool -> IO UserChatResponse
 sendUpdatedLiveMessage cc sentMsg LiveMessage {chatName, chatItemId} live = do
   let bs = encodeUtf8 $ T.pack sentMsg
       cmd = UpdateLiveMessage chatName chatItemId live bs
-  either CRChatCmdError id <$> runExceptT (processChatCommand cmd) `runReaderT` cc
+  either (UCR Nothing . CRChatCmdError) id <$> runExceptT (processChatCommand cmd) `runReaderT` cc -- ucr user?
 
 runTerminalInput :: ChatTerminal -> ChatController -> IO ()
 runTerminalInput ct cc = withChatTerm ct $ do

src/Simplex/Chat/Terminal/Output.hs

@@ -93,13 +93,13 @@ withTermLock ChatTerminal {termLock} action = do
 runTerminalOutput :: ChatTerminal -> ChatController -> IO ()
 runTerminalOutput ct cc@ChatController {outputQ, showLiveItems} = do
   forever $ do
-    (_, r) <- atomically $ readTBQueue outputQ
+    (_, resp@UCR {chatResponse}) <- atomically $ readTBQueue outputQ
-    case r of
+    case chatResponse of
       CRNewChatItem ci -> markChatItemRead ci
       CRChatItemUpdated ci -> markChatItemRead ci
       _ -> pure ()
     liveItems <- readTVarIO showLiveItems
-    printRespToTerminal ct cc liveItems r
+    printRespToTerminal ct cc liveItems resp
   where
     markChatItemRead :: AChatItem -> IO ()
     markChatItemRead (AChatItem _ _ chat item@ChatItem {meta = CIMeta {itemStatus}}) =
@@ -110,7 +110,7 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems} = do
           void $ runReaderT (runExceptT $ processChatCommand (APIChatRead chatRef (Just (itemId, itemId)))) cc
         _ -> pure ()
 
-printRespToTerminal :: ChatTerminal -> ChatController -> Bool -> ChatResponse -> IO ()
+printRespToTerminal :: ChatTerminal -> ChatController -> Bool -> UserChatResponse -> IO ()
 printRespToTerminal ct cc liveItems r = do
   let testV = testView $ config cc
   user <- readTVarIO $ currentUser cc

src/Simplex/Chat/View.hs

@@ -53,11 +53,11 @@ import System.Console.ANSI.Types
 
 type CurrentTime = UTCTime
 
-serializeChatResponse :: Maybe User -> CurrentTime -> ChatResponse -> String
+serializeChatResponse :: Maybe User -> CurrentTime -> UserChatResponse -> String
 serializeChatResponse user_ ts = unlines . map unStyle . responseToView user_ False False ts
 
-responseToView :: Maybe User -> Bool -> Bool -> CurrentTime -> ChatResponse -> [StyledString]
+responseToView :: Maybe User -> Bool -> Bool -> CurrentTime -> UserChatResponse -> [StyledString]
-responseToView user_ testView liveItems ts = \case
+responseToView user_ testView liveItems ts UCR {user = responseUser, chatResponse} = case chatResponse of
   CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile
   CRUsersList users -> viewUsersList users
   CRChatStarted -> ["chat started"]
@@ -1138,6 +1138,7 @@ viewChatError :: ChatError -> [StyledString]
 viewChatError = \case
   ChatError err -> case err of
     CENoActiveUser -> ["error: active user is required"]
+    CENoConnectionUser agentConnId -> ["error: connection has no user, conn id: " <> sShow agentConnId]
     CEActiveUserExists -> ["error: active user already exists"]
     CEChatNotStarted -> ["error: chat not started"]
     CEChatNotStopped -> ["error: chat not stopped"]