core: save the time user profile was opened at to order in ui (#4920)

* core: save the time user profile was opened at to order in ui

* replace timestamp with order

src/Simplex/Chat.hs

@@ -593,8 +593,7 @@ processChatCommand' vr = \case
     user_ <- chatReadVar currentUser
     user' <- privateGetUser userId'
     validateUserPassword_ user_ user' viewPwd_
-    withFastStore' (`setActiveUser` userId')
-    let user'' = user' {activeUser = True}
+    user'' <- withFastStore' (`setActiveUser` user')
     chatWriteVar currentUser $ Just user''
     pure $ CRActiveUser user''
   SetActiveUser uName viewPwd_ -> do

src/Simplex/Chat/Core.hs

@@ -74,9 +74,7 @@ getSelectActiveUser st = do
     selectUser :: [User] -> IO (Maybe User)
     selectUser = \case
       [] -> pure Nothing
-      [user@User {userId}] -> do
-        withTransaction st (`setActiveUser` userId)
-        pure $ Just user
+      [user] -> Just <$> withTransaction st (`setActiveUser` user)
       users -> do
         putStrLn "Select user profile:"
         forM_ (zip [1 :: Int ..] users) $ \(n, user) -> putStrLn $ show n <> ": " <> userStr user
@@ -88,10 +86,9 @@ getSelectActiveUser st = do
               Nothing -> putStrLn "not a number" >> loop
               Just n
                 | n <= 0 || n > length users -> putStrLn "invalid user number" >> loop
-                | otherwise -> do
-                    let user@User {userId} = users !! (n - 1)
-                    withTransaction st (`setActiveUser` userId)
-                    pure $ Just user
+                | otherwise ->
+                    let user = users !! (n - 1)
+                     in Just <$> withTransaction st (`setActiveUser` user)
 
 createActiveUser :: ChatController -> IO User
 createActiveUser cc = do

src/Simplex/Chat/Migrations/M20240920_user_order.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20240920_user_order where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20240920_user_order :: Query
+m20240920_user_order =
+  [sql|
+ALTER TABLE users ADD COLUMN active_order INTEGER NOT NULL DEFAULT 0;
+|]
+
+down_m20240920_user_order :: Query
+down_m20240920_user_order =
+  [sql|
+ALTER TABLE users DROP COLUMN active_order;
+|]

src/Simplex/Chat/Migrations/chat_schema.sql

@@ -35,7 +35,8 @@ CREATE TABLE users(
   send_rcpts_contacts INTEGER NOT NULL DEFAULT 0,
   send_rcpts_small_groups INTEGER NOT NULL DEFAULT 0,
   user_member_profile_updated_at TEXT,
-  ui_themes TEXT, -- 1 for active user
+  ui_themes TEXT,
+  active_order INTEGER NOT NULL DEFAULT 0, -- 1 for active user
   FOREIGN KEY(user_id, local_display_name)
   REFERENCES display_names(user_id, local_display_name)
   ON DELETE RESTRICT

src/Simplex/Chat/Store/Migrations.hs

@@ -111,6 +111,7 @@ import Simplex.Chat.Migrations.M20240510_chat_items_via_proxy
 import Simplex.Chat.Migrations.M20240515_rcv_files_user_approved_relays
 import Simplex.Chat.Migrations.M20240528_quota_err_counter
 import Simplex.Chat.Migrations.M20240827_calls_uuid
+import Simplex.Chat.Migrations.M20240920_user_order
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -221,7 +222,8 @@ schemaMigrations =
     ("20240510_chat_items_via_proxy", m20240510_chat_items_via_proxy, Just down_m20240510_chat_items_via_proxy),
     ("20240515_rcv_files_user_approved_relays", m20240515_rcv_files_user_approved_relays, Just down_m20240515_rcv_files_user_approved_relays),
     ("20240528_quota_err_counter", m20240528_quota_err_counter, Just down_m20240528_quota_err_counter),
-    ("20240827_calls_uuid", m20240827_calls_uuid, Just down_m20240827_calls_uuid)
+    ("20240827_calls_uuid", m20240827_calls_uuid, Just down_m20240827_calls_uuid),
+    ("20240920_user_order", m20240920_user_order, Just down_m20240920_user_order)
   ]
 
 -- | The list of migrations in ascending order by date

src/Simplex/Chat/Store/Profiles.hs

@@ -19,7 +19,6 @@ module Simplex.Chat.Store.Profiles
     getUsersInfo,
     getUsers,
     setActiveUser,
-    getSetActiveUser,
     getUser,
     getUserIdByName,
     getUserByAConnId,
@@ -106,10 +105,11 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image,
     let showNtfs = True
         sendRcptsContacts = True
         sendRcptsSmallGroups = True
+    order <- getNextActiveOrder db
     DB.execute
       db
-      "INSERT INTO users (agent_user_id, local_display_name, active_user, contact_id, show_ntfs, send_rcpts_contacts, send_rcpts_small_groups, created_at, updated_at) VALUES (?,?,?,0,?,?,?,?,?)"
-      (auId, displayName, activeUser, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, currentTs, currentTs)
+      "INSERT INTO users (agent_user_id, local_display_name, active_user, active_order, contact_id, show_ntfs, send_rcpts_contacts, send_rcpts_small_groups, created_at, updated_at) VALUES (?,?,?,?,0,?,?,?,?,?)"
+      (auId, displayName, activeUser, order, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, currentTs, currentTs)
     userId <- insertedRowId db
     DB.execute
       db
@@ -126,7 +126,7 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image,
       (profileId, displayName, userId, True, currentTs, currentTs, currentTs)
     contactId <- insertedRowId db
     DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId)
-    pure $ toUser $ (userId, auId, contactId, profileId, activeUser, displayName, fullName, image, Nothing, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, Nothing, Nothing, Nothing, Nothing)
+    pure $ toUser $ (userId, auId, contactId, profileId, activeUser, order, displayName, fullName, image, Nothing, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, Nothing, Nothing, Nothing, Nothing)
 
 getUsersInfo :: DB.Connection -> IO [UserInfo]
 getUsersInfo db = getUsers db >>= mapM getUserInfo
@@ -161,15 +161,19 @@ getUsers :: DB.Connection -> IO [User]
 getUsers db =
   map toUser <$> DB.query_ db userQuery
 
-setActiveUser :: DB.Connection -> UserId -> IO ()
-setActiveUser db userId = do
+setActiveUser :: DB.Connection -> User -> IO User
+setActiveUser db user@User {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)
+  activeOrder <- getNextActiveOrder db
+  DB.execute db "UPDATE users SET active_user = 1, active_order = ? WHERE user_id = ?" (activeOrder, userId)
+  pure user {activeUser = True, activeOrder}
 
-getSetActiveUser :: DB.Connection -> UserId -> ExceptT StoreError IO User
-getSetActiveUser db userId = do
-  liftIO $ setActiveUser db userId
-  getUser db userId
+getNextActiveOrder :: DB.Connection -> IO Int64
+getNextActiveOrder db = do
+  order <- fromMaybe 0 . join <$> maybeFirstRow fromOnly (DB.query_ db "SELECT max(active_order) FROM users")
+  if order == maxBound
+    then 0 <$ DB.execute db "UPDATE users SET active_order = active_order - ?" (Only (maxBound :: Int64))
+    else pure $ order + 1
 
 getUser :: DB.Connection -> UserId -> ExceptT StoreError IO User
 getUser db userId =

src/Simplex/Chat/Store/Shared.hs

@@ -422,16 +422,16 @@ toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, userCo
 userQuery :: Query
 userQuery =
   [sql|
-    SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.local_display_name, ucp.full_name, ucp.image, ucp.contact_link, ucp.preferences,
+    SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.image, ucp.contact_link, ucp.preferences,
       u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes
     FROM users u
     JOIN contacts uct ON uct.contact_id = u.contact_id
     JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
   |]
 
-toUser :: (UserId, UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences) :. (Bool, Bool, Bool, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, Maybe UIThemeEntityOverrides) -> User
-toUser ((userId, auId, userContactId, profileId, activeUser, displayName, fullName, image, contactLink, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, uiThemes)) =
-  User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash, userMemberProfileUpdatedAt, uiThemes}
+toUser :: (UserId, UserId, ContactId, ProfileId, Bool, Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences) :. (Bool, Bool, Bool, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, Maybe UIThemeEntityOverrides) -> User
+toUser ((userId, auId, userContactId, profileId, activeUser, activeOrder, displayName, fullName, image, contactLink, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, uiThemes)) =
+  User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, activeOrder, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash, userMemberProfileUpdatedAt, uiThemes}
   where
     profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences = userPreferences, localAlias = ""}
     fullPreferences = mergePreferences Nothing userPreferences

src/Simplex/Chat/Types.hs

@@ -113,6 +113,7 @@ data User = User
     profile :: LocalProfile,
     fullPreferences :: FullPreferences,
     activeUser :: Bool,
+    activeOrder :: Int64,
     viewPwdHash :: Maybe UserPwdHash,
     showNtfs :: Bool,
     sendRcptsContacts :: Bool,