core: allow deleting last user (#3567)

* core: allow deleting last user (tests fail)

* tests, allow activating the hidden user when there is no active user

* hide logs

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

* comment

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

* comment

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

src/Simplex/Chat.hs

@@ -473,12 +473,14 @@ processChatCommand = \case
       coupleDaysAgo t = (`addUTCTime` t) . fromInteger . negate . (+ (2 * day)) <$> randomRIO (0, day)
       day = 86400
   ListUsers -> CRUsersList <$> withStoreCtx' (Just "ListUsers, getUsersInfo") getUsersInfo
-  APISetActiveUser userId' viewPwd_ -> withUser $ \user -> do
+  APISetActiveUser userId' viewPwd_ -> do
+    unlessM chatStarted $ throwChatError CEChatNotStarted
+    user_ <- chatReadVar currentUser
     user' <- privateGetUser userId'
-    validateUserPassword user user' viewPwd_
+    validateUserPassword_ user_ user' viewPwd_
     withStoreCtx' (Just "APISetActiveUser, setActiveUser") $ \db -> setActiveUser db userId'
     let user'' = user' {activeUser = True}
-    asks currentUser >>= atomically . (`writeTVar` Just user'')
+    chatWriteVar currentUser $ Just user''
     pure $ CRActiveUser user''
   SetActiveUser uName viewPwd_ -> do
     tryChatError (withStore (`getUserIdByName` uName)) >>= \case
@@ -2300,11 +2302,14 @@ processChatCommand = \case
       tryChatError (withStore (`getUser` userId)) >>= \case
         Left _ -> throwChatError CEUserUnknown
         Right user -> pure user
-    validateUserPassword :: User -> User -> Maybe UserPwd -> m ()
+    validateUserPassword :: User -> User -> Maybe UserPwd -> m ()        
-    validateUserPassword User {userId} User {userId = userId', viewPwdHash} viewPwd_ =
+    validateUserPassword = validateUserPassword_ . Just
+    validateUserPassword_ :: Maybe User -> User -> Maybe UserPwd -> m ()
+    validateUserPassword_ user_ User {userId = userId', viewPwdHash} viewPwd_ =
       forM_ viewPwdHash $ \pwdHash ->
-        let pwdOk = case viewPwd_ of
+        let userId_ = (\User {userId} -> userId) <$> user_
-              Nothing -> userId == userId'
+            pwdOk = case viewPwd_ of
+              Nothing -> userId_ == Just userId'
               Just (UserPwd viewPwd) -> validPassword viewPwd pwdHash
          in unless pwdOk $ throwChatError CEUserUnknown
     validPassword :: Text -> UserPwdHash -> Bool
@@ -2327,16 +2332,16 @@ processChatCommand = \case
           pure $ CRUserPrivacy {user, updatedUser = user'}
     checkDeleteChatUser :: User -> m ()
     checkDeleteChatUser user@User {userId} = do
-      when (activeUser user) $ throwChatError (CECantDeleteActiveUser userId)
       users <- withStore' getUsers
-      unless (length users > 1 && (isJust (viewPwdHash user) || length (filter (isNothing . viewPwdHash) users) > 1)) $
+      let otherVisible = filter (\User {userId = userId', viewPwdHash} -> userId /= userId' && isNothing viewPwdHash) users
-        throwChatError (CECantDeleteLastUser userId)
+      when (activeUser user && length otherVisible > 0) $ throwChatError (CECantDeleteActiveUser userId)
     deleteChatUser :: User -> Bool -> m ChatResponse
     deleteChatUser user delSMPQueues = do
       filesInfo <- withStore' (`getUserFileInfo` user)
       forM_ filesInfo $ \fileInfo -> deleteFile user fileInfo
       withAgent $ \a -> deleteUser a (aUserId user) delSMPQueues
       withStore' (`deleteUserRecord` user)
+      when (activeUser user) $ chatWriteVar currentUser Nothing
       ok_
     updateChatSettings :: ChatName -> (ChatSettings -> ChatSettings) -> m ChatResponse
     updateChatSettings (ChatName cType name) updateSettings = withUser $ \user -> do

src/Simplex/Chat/View.hs

@@ -474,7 +474,9 @@ chatItemDeletedText ChatItem {meta = CIMeta {itemDeleted}, content} membership_
       _ -> ""
 
 viewUsersList :: [UserInfo] -> [StyledString]
-viewUsersList = mapMaybe userInfo . sortOn ldn
+viewUsersList us =
+  let ss = mapMaybe userInfo $ sortOn ldn us
+   in if null ss then ["no users"] else ss
   where
     ldn (UserInfo User {localDisplayName = n} _) = T.toLower n
     userInfo (UserInfo User {localDisplayName = n, profile = LocalProfile {fullName}, activeUser, showNtfs, viewPwdHash} count)

tests/ChatClient.hs

@@ -18,7 +18,7 @@ import Control.Monad.Except
 import Data.ByteArray (ScrubbedBytes)
 import Data.Functor (($>))
 import Data.List (dropWhileEnd, find)
-import Data.Maybe (fromJust, isNothing)
+import Data.Maybe (isNothing)
 import qualified Data.Text as T
 import Network.Socket
 import Simplex.Chat
@@ -284,7 +284,7 @@ getTermLine cc =
     _ -> error "no output for 5 seconds"
 
 userName :: TestCC -> IO [Char]
-userName (TestCC ChatController {currentUser} _ _ _ _ _) = T.unpack . localDisplayName . fromJust <$> readTVarIO currentUser
+userName (TestCC ChatController {currentUser} _ _ _ _ _) = maybe "no current user" (T.unpack . localDisplayName) <$> readTVarIO currentUser
 
 testChat2 :: HasCallStack => Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
 testChat2 = testChatCfgOpts2 testCfg testOpts

tests/ChatTests/Direct.hs

@@ -1492,16 +1492,16 @@ testDeleteUser =
     \alice bob cath dan -> do
       connectUsers alice bob
 
-      -- cannot delete active user
+      alice ##> "/create user alisa"
+      showActiveUser alice "alisa"
 
-      alice ##> "/_delete user 1 del_smp=off"
+      -- cannot delete active user when there is another user
+
+      alice ##> "/_delete user 2 del_smp=off"
       alice <## "cannot delete active user"
 
       -- delete user without deleting SMP queues
 
-      alice ##> "/create user alisa"
-      showActiveUser alice "alisa"
-
       connectUsers alice cath
       alice <##> cath
 
@@ -1519,17 +1519,7 @@ testDeleteUser =
       -- no connection authorization error - connection wasn't deleted
       (alice </)
 
-      -- cannot delete new active user
+      -- cannot delete active user when there is another user
-
-      alice ##> "/delete user alisa"
-      alice <## "cannot delete active user"
-
-      alice ##> "/users"
-      alice <## "alisa (active)"
-
-      alice <##> cath
-
-      -- delete user deleting SMP queues
 
       alice ##> "/create user alisa2"
       showActiveUser alice "alisa2"
@@ -1537,10 +1527,17 @@ testDeleteUser =
       connectUsers alice dan
       alice <##> dan
 
+      alice ##> "/delete user alisa2"
+      alice <## "cannot delete active user"
+
       alice ##> "/users"
       alice <## "alisa"
       alice <## "alisa2 (active)"
 
+      alice <##> dan
+
+      -- delete user deleting SMP queues
+
       alice ##> "/delete user alisa"
       alice <### ["ok", "completed deleting user"]
 
@@ -1553,6 +1550,16 @@ testDeleteUser =
 
       alice <##> dan
 
+      -- delete last active user
+
+      alice ##> "/delete user alisa2 del_smp=off"
+      alice <### ["ok", "completed deleting user"]
+      alice ##> "/users"
+      alice <## "no users"
+
+      alice ##> "/create user alisa3"
+      showActiveUser alice "alisa3"
+
 testUsersDifferentCIExpirationTTL :: HasCallStack => FilePath -> IO ()
 testUsersDifferentCIExpirationTTL tmp = do
   withNewTestChat tmp "bob" bobProfile $ \bob -> do
@@ -2047,12 +2054,23 @@ testUserPrivacy =
       userVisible alice "current "
       alice ##> "/hide user new_password"
       userHidden alice "current "
-      alice ##> "/_delete user 1 del_smp=on"
-      alice <## "cannot delete last user"
-      alice ##> "/_hide user 1 \"password\""
-      alice <## "cannot hide the only not hidden user"
       alice ##> "/user alice"
       showActiveUser alice "alice (Alice)"
+      -- delete last visible active user
+      alice ##> "/_delete user 1 del_smp=on"
+      alice <### ["ok", "completed deleting user"]
+      -- hidden user is not shown
+      alice ##> "/users"
+      alice <## "no users"
+      -- but it is still possible to switch to it
+      alice ##> "/user alisa wrong_password"
+      alice <## "user does not exist or incorrect password"
+      alice ##> "/user alisa new_password"
+      showActiveUser alice "alisa"
+      alice ##> "/create user alisa2"
+      showActiveUser alice "alisa2"
+      alice ##> "/_hide user 3 \"password2\""
+      alice <## "cannot hide the only not hidden user"
       -- change profile privacy for inactive user via API requires correct password
       alice ##> "/_unmute user 2"
       alice <## "hidden user always muted when inactive"
@@ -2064,17 +2082,14 @@ testUserPrivacy =
       userVisible alice ""
       alice ##> "/_hide user 2 \"another_password\""
       userHidden alice ""
-      alice ##> "/user alisa another_password"
-      showActiveUser alice "alisa"
-      alice ##> "/user alice"
-      showActiveUser alice "alice (Alice)"
       alice ##> "/_delete user 2 del_smp=on"
       alice <## "user does not exist or incorrect password"
       alice ##> "/_delete user 2 del_smp=on \"wrong_password\""
       alice <## "user does not exist or incorrect password"
       alice ##> "/_delete user 2 del_smp=on \"another_password\""
-      alice <## "ok"
+      alice <### ["ok", "completed deleting user"]
-      alice <## "completed deleting user"
+      alice ##> "/_delete user 3 del_smp=on"
+      alice <### ["ok", "completed deleting user"]
   where
     userHidden alice current = do
       alice <## (current <> "user alisa:")