IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: allow deleting last user (#3567)

Browse Source 
* 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>
This commit is contained in:
Evgeny Poberezkin
2023-12-19 10:26:01 +00:00
committed by GitHub
parent 5e042d222e
commit 7b073ba9f8
4 changed files with 61 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
src/Simplex/Chat.hs
View File

@@ -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 {userId} User {userId = userId', viewPwdHash} viewPwd_ =
validateUserPassword :: User -> User -> Maybe UserPwd -> m ()
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
Nothing -> userId == userId'
let userId_ = (\User {userId} -> userId) <$> user_
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)) $
throwChatError (CECantDeleteLastUser userId)
let otherVisible = filter (\User {userId = userId', viewPwdHash} -> userId /= userId' && isNothing viewPwdHash) users
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

4
src/Simplex/Chat/View.hs
View File

@@ -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)