api

apps/android/app/src/main/java/chat/simplex/app/model/SimpleXAPI.kt

@@ -1611,7 +1611,7 @@ sealed class CC {
   val cmdString: String get() = when (this) {
     is Console -> cmd
     is ShowActiveUser -> "/u"
-    is CreateActiveUser -> "/u ${profile.displayName} ${profile.fullName}"
+    is CreateActiveUser -> "/create user ${profile.displayName} ${profile.fullName}"
     is StartChat -> "/_start subscribe=on expire=${onOff(expire)}"
     is ApiStopChat -> "/_stop"
     is SetFilesFolder -> "/_files_folder $filesFolder"

apps/ios/SimpleXChat/APITypes.swift

@@ -95,7 +95,7 @@ public enum ChatCommand {
         get {
             switch self {
             case .showActiveUser: return "/u"
-            case let .createActiveUser(profile): return "/u \(profile.displayName) \(profile.fullName)"
+            case let .createActiveUser(profile): return "/create user \(profile.displayName) \(profile.fullName)"
             case let .startChat(subscribe, expire): return "/_start subscribe=\(onOff(subscribe)) expire=\(onOff(expire))"
             case .apiStopChat: return "/_stop"
             case .apiActivateChat: return "/_app activate"

packages/simplex-chat-client/typescript/src/command.ts

@@ -450,7 +450,7 @@ export function cmdString(cmd: ChatCommand): string {
     case "showActiveUser":
       return "/u"
     case "createActiveUser":
-      return `/u ${JSON.stringify(cmd.profile)}`
+      return `/create user ${JSON.stringify(cmd.profile)}`
     case "startChat":
       return `/_start subscribe=${cmd.subscribeConnections ? "on" : "off"} expire=${cmd.expireChatItems ? "on" : "off"}`
     case "apiStopChat":

src/Simplex/Chat.hs

@@ -253,10 +253,27 @@ processChatCommand = \case
   ShowActiveUser -> withUser' $ pure . CRActiveUser
   CreateActiveUser p -> do
     u <- asks currentUser
-    whenM (isJust <$> readTVarIO u) $ throwChatError CEActiveUserExists
+    -- whenM (isJust <$> readTVarIO u) $ throwChatError CEActiveUserExists
     user <- withStore $ \db -> createUser db p True
     atomically . writeTVar u $ Just user
     pure $ CRActiveUser user
+  ListUsers -> do
+    users <- withStore' $ \db -> getUsers db
+    pure $ CRUsersList users
+  APISetActiveUser userId -> do
+    u <- asks currentUser
+    user <- withStore $ \db -> getSetActiveUser db userId
+    atomically . writeTVar u $ Just user
+    pure CRCmdOk
+  SetActiveUser uName -> withUserName uName APISetActiveUser
+  APIDeleteUser _userId -> do
+    -- check not the only user
+    -- withStore' $ \db -> deleteUser db userId
+    -- ? other cleanup
+    -- set active user to first/arbitrary user?
+    -- unset if current user
+    pure CRCmdOk
+  DeleteUser uName -> withUserName uName APIDeleteUser
   StartChat subConns enableExpireCIs -> withUser' $ \user ->
     asks agentAsync >>= readTVarIO >>= \case
       Just _ -> pure CRChatRunning
@@ -1233,6 +1250,8 @@ processChatCommand = \case
     withStoreChanged a = checkChatStopped $ a >> setStoreChanged $> CRCmdOk
     checkStoreNotChanged :: m ChatResponse -> m ChatResponse
     checkStoreNotChanged = ifM (asks chatStoreChanged >>= readTVarIO) (throwChatError CEChatStoreChanged)
+    withUserName :: UserName -> (UserId -> ChatCommand) -> m ChatResponse
+    withUserName uName cmd = withStore (`getUserIdByName` uName) >>= processChatCommand . cmd
     withContactName :: ContactName -> (ContactId -> ChatCommand) -> m ChatResponse
     withContactName cName cmd = withUser $ \user ->
       withStore (\db -> getContactIdByName db user cName) >>= processChatCommand . cmd
@@ -3538,7 +3557,7 @@ getCreateActiveUser st = do
             Right user -> pure user
     selectUser :: [User] -> IO User
     selectUser [user] = do
-      withTransaction st (`setActiveUser` userId user)
+      withTransaction st (`setActiveUser` userId (user :: User))
       pure user
     selectUser users = do
       putStrLn "Select user profile:"
@@ -3553,7 +3572,7 @@ getCreateActiveUser st = do
               | n <= 0 || n > length users -> putStrLn "invalid user number" >> loop
               | otherwise -> do
                 let user = users !! (n - 1)
-                withTransaction st (`setActiveUser` userId user)
+                withTransaction st (`setActiveUser` userId (user :: User))
                 pure user
     userStr :: User -> String
     userStr User {localDisplayName, profile = LocalProfile {fullName}} =
@@ -3626,7 +3645,12 @@ chatCommandP =
   choice
     [ "/mute " *> ((`ShowMessages` False) <$> chatNameP'),
       "/unmute " *> ((`ShowMessages` True) <$> chatNameP'),
-      ("/user " <|> "/u ") *> (CreateActiveUser <$> userProfile),
+      "/create user " *> (CreateActiveUser <$> userProfile),
+      "/users" $> ListUsers,
+      "/_user " *> (APISetActiveUser <$> A.decimal),
+      ("/user " <|> "/u ") *> (SetActiveUser <$> displayName),
+      "/_delete user " *> (APIDeleteUser <$> A.decimal),
+      "/delete user " *> (DeleteUser <$> displayName),
       ("/user" <|> "/u") $> ShowActiveUser,
       "/_start subscribe=" *> (StartChat <$> onOffP <* " expire=" <*> onOffP),
       "/_start" $> StartChat True True,

src/Simplex/Chat/Controller.hs

@@ -140,6 +140,11 @@ instance ToJSON HelpSection where
 data ChatCommand
   = ShowActiveUser
   | CreateActiveUser Profile
+  | ListUsers
+  | APISetActiveUser UserId
+  | SetActiveUser UserName
+  | APIDeleteUser UserId
+  | DeleteUser UserName
   | StartChat {subscribeConnections :: Bool, enableExpireChatItems :: Bool}
   | APIStopChat
   | APIActivateChat
@@ -286,6 +291,7 @@ data ChatCommand
 
 data ChatResponse
   = CRActiveUser {user :: User}
+  | CRUsersList {users :: [User]}
   | CRChatStarted
   | CRChatRunning
   | CRChatStopped

src/Simplex/Chat/Store.hs

@@ -28,6 +28,8 @@ module Simplex.Chat.Store
     createUser,
     getUsers,
     setActiveUser,
+    getSetActiveUser,
+    getUserIdByName,
     createDirectConnection,
     createConnReqConnection,
     getProfileById,
@@ -460,6 +462,30 @@ setActiveUser db userId = do
   DB.execute_ db "UPDATE users SET active_user = 0"
   DB.execute db "UPDATE users SET active_user = 1 WHERE user_id = ?" (Only userId)
 
+getSetActiveUser :: DB.Connection -> UserId -> ExceptT StoreError IO User
+getSetActiveUser db userId = do
+  liftIO $ setActiveUser db userId
+  getUser_ db userId
+
+getUser_ :: DB.Connection -> UserId -> ExceptT StoreError IO User
+getUser_ db userId =
+  ExceptT . firstRow toUser (SEUserNotFound userId) $
+    DB.query
+      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)
+
 createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> IO PendingContactConnection
 createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId = do
   createdAt <- getCurrentTime
@@ -4803,7 +4829,9 @@ randomBytes gVar = atomically . stateTVar gVar . randomBytesGenerate
 -- These error type constructors must be added to mobile apps
 data StoreError
   = SEDuplicateName
-  | SEContactNotFound {contactId :: Int64}
+  | SEUserNotFound {userId :: UserId}
+  | SEUserNotFoundByName {contactName :: ContactName}
+  | SEContactNotFound {contactId :: ContactId}
   | SEContactNotFoundByName {contactName :: ContactName}
   | SEContactNotReady {contactName :: ContactName}
   | SEDuplicateContactLink

src/Simplex/Chat/Types.hs

@@ -216,6 +216,8 @@ instance ToJSON ConnReqUriHash where
 
 data ContactOrRequest = CORContact Contact | CORRequest UserContactRequest
 
+type UserName = Text
+
 type ContactName = Text
 
 type GroupName = Text

src/Simplex/Chat/View.hs

@@ -59,6 +59,7 @@ serializeChatResponse user_ ts = unlines . map unStyle . responseToView user_ Fa
 responseToView :: Maybe User -> Bool -> Bool -> CurrentTime -> ChatResponse -> [StyledString]
 responseToView user_ testView liveItems ts = \case
   CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile
+  CRUsersList users -> viewUsersList users
   CRChatStarted -> ["chat started"]
   CRChatRunning -> ["chat is running"]
   CRChatStopped -> ["chat stopped"]
@@ -256,6 +257,13 @@ responseToView user_ testView liveItems ts = \case
       | muted chat chatItem = []
       | otherwise = s
 
+viewUsersList :: [User] -> [StyledString]
+viewUsersList =
+  let ldn = T.toLower . (localDisplayName :: User -> ContactName)
+   in map (\user@User {profile = LocalProfile {displayName, fullName}} -> ttyFullName displayName fullName <> active user) . sortOn ldn
+  where
+    active User {activeUser} = if activeUser then highlight' " (active)" else ""
+
 muted :: ChatInfo c -> ChatItem c d -> Bool
 muted chat ChatItem {chatDir} = case (chat, chatDir) of
   (DirectChat Contact {chatSettings = DisableNtfs}, CIDirectRcv) -> True
@@ -1179,6 +1187,7 @@ viewChatError = \case
   -- e -> ["chat error: " <> sShow e]
   ChatErrorStore err -> case err of
     SEDuplicateName -> ["this display name is already used by user, contact or group"]
+    SEUserNotFoundByName u -> ["no user " <> ttyContact u]
     SEContactNotFoundByName c -> ["no contact " <> ttyContact c]
     SEContactNotReady c -> ["contact " <> ttyContact c <> " is not active yet"]
     SEGroupNotFoundByName g -> ["no group " <> ttyGroup g]

tests/MobileTests.hs

@@ -25,9 +25,9 @@ noActiveUser = "{\"resp\":{\"type\":\"chatCmdError\",\"chatError\":{\"type\":\"e
 
 activeUserExists :: String
 #if defined(darwin_HOST_OS) && defined(swiftJSON)
-activeUserExists = "{\"resp\":{\"chatCmdError\":{\"chatError\":{\"error\":{\"errorType\":{\"activeUserExists\":{}}}}}}}"
+activeUserExists = "{\"resp\":{\"chatCmdError\":{\"chatError\":{\"errorStore\":{\"storeError\":{\"duplicateName\":{}}}}}}}"
 #else
-activeUserExists = "{\"resp\":{\"type\":\"chatCmdError\",\"chatError\":{\"type\":\"error\",\"errorType\":{\"type\":\"activeUserExists\"}}}}"
+activeUserExists = "{\"resp\":{\"type\":\"chatCmdError\",\"chatError\":{\"type\":\"errorStore\",\"storeError\":{\"type\":\"duplicateName\"}}}}"
 #endif
 
 activeUser :: String
@@ -85,7 +85,7 @@ testChatApiNoUser = withTmpFiles $ do
   Left (DBMErrorNotADatabase _) <- chatMigrateInit testDBPrefix "myKey"
   chatSendCmd cc "/u" `shouldReturn` noActiveUser
   chatSendCmd cc "/_start" `shouldReturn` noActiveUser
-  chatSendCmd cc "/u alice Alice" `shouldReturn` activeUser
+  chatSendCmd cc "/create user alice Alice" `shouldReturn` activeUser
   chatSendCmd cc "/_start" `shouldReturn` chatStarted
 
 testChatApi :: IO ()
@@ -98,7 +98,7 @@ testChatApi = withTmpFiles $ do
   Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix ""
   Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "anotherKey"
   chatSendCmd cc "/u" `shouldReturn` activeUser
-  chatSendCmd cc "/u alice Alice" `shouldReturn` activeUserExists
+  chatSendCmd cc "/create user alice Alice" `shouldReturn` activeUserExists
   chatSendCmd cc "/_start" `shouldReturn` chatStarted
   chatRecvMsg cc `shouldReturn` contactSubSummary
   chatRecvMsg cc `shouldReturn` userContactSubSummary