diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 1102a98b1..5c6a10d81 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -335,7 +335,7 @@ processChatCommand = \case tryError (withStore (`getUserIdByName` uName)) >>= \case Left _ -> throwChatError CEUserUnknown Right userId -> processChatCommand $ APISetActiveUser userId viewPwd_ - APIHideUser userId' (UserPwd viewPwd) -> withUser $ \_ -> do + APIHideUser userId' (UserPwd viewPwd) -> withUser $ \user -> do user' <- privateGetUser userId' case viewPwdHash user' of Just _ -> throwChatError $ CEUserAlreadyHidden userId' @@ -344,7 +344,7 @@ processChatCommand = \case users <- withStore' getUsers unless (length (filter (isNothing . viewPwdHash) users) > 1) $ throwChatError $ CECantHideLastUser userId' viewPwdHash' <- hashPassword - setUserPrivacy user' {viewPwdHash = viewPwdHash', showNtfs = False} + setUserPrivacy user user' {viewPwdHash = viewPwdHash', showNtfs = False} where hashPassword = do salt <- drgRandomBytes 16 @@ -356,18 +356,18 @@ processChatCommand = \case Nothing -> throwChatError $ CEUserNotHidden userId' _ -> do validateUserPassword user user' viewPwd_ - setUserPrivacy user' {viewPwdHash = Nothing, showNtfs = True} + setUserPrivacy user user' {viewPwdHash = Nothing, showNtfs = True} APIMuteUser userId' viewPwd_ -> withUser $ \user -> do user' <- privateGetUser userId' validateUserPassword user user' viewPwd_ - setUserPrivacy user' {showNtfs = False} + setUserPrivacy user user' {showNtfs = False} APIUnmuteUser userId' viewPwd_ -> withUser $ \user -> do user' <- privateGetUser userId' case viewPwdHash user' of Just _ -> throwChatError $ CECantUnmuteHiddenUser userId' _ -> do validateUserPassword user user' viewPwd_ - setUserPrivacy user' {showNtfs = True} + setUserPrivacy user user' {showNtfs = True} HideUser viewPwd -> withUser $ \User {userId} -> processChatCommand $ APIHideUser userId viewPwd UnhideUser -> withUser $ \User {userId} -> processChatCommand $ APIUnhideUser userId Nothing MuteUser -> withUser $ \User {userId} -> processChatCommand $ APIMuteUser userId Nothing @@ -1706,11 +1706,15 @@ processChatCommand = \case validPassword :: Text -> UserPwdHash -> Bool validPassword pwd UserPwdHash {hash = B64UrlByteString hash, salt = B64UrlByteString salt} = hash == C.sha512Hash (encodeUtf8 pwd <> salt) - setUserPrivacy :: User -> m ChatResponse - setUserPrivacy user = do - asks currentUser >>= atomically . (`writeTVar` Just user) - withStore' (`updateUserPrivacy` user) - pure $ CRUserPrivacy user + setUserPrivacy :: User -> User -> m ChatResponse + setUserPrivacy user@User {userId} user'@User {userId = userId'} + | userId == userId' = do + asks currentUser >>= atomically . (`writeTVar` Just user') + withStore' (`updateUserPrivacy` user') + pure $ CRUserPrivacy {user = user', updatedUser = user'} + | otherwise = do + withStore' (`updateUserPrivacy` user') + pure $ CRUserPrivacy {user, updatedUser = user'} checkDeleteChatUser :: User -> m () checkDeleteChatUser user@User {userId} = do when (activeUser user) $ throwChatError (CECantDeleteActiveUser userId) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 7bd7d6fd4..18e0a285b 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -421,7 +421,7 @@ data ChatResponse | CRFileTransferStatus User (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus | CRUserProfile {user :: User, profile :: Profile} | CRUserProfileNoChange {user :: User} - | CRUserPrivacy {user :: User} + | CRUserPrivacy {user :: User, updatedUser :: User} | CRVersionInfo {versionInfo :: CoreVersionInfo, chatMigrations :: [UpMigration], agentMigrations :: [UpMigration]} | CRInvitation {user :: User, connReqInvitation :: ConnReqInvitation} | CRSentConfirmation {user :: User} diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 2352b1e94..4ffda616f 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -116,7 +116,7 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case CRFileTransferStatus u ftStatus -> ttyUser u $ viewFileTransferStatus ftStatus CRUserProfile u p -> ttyUser u $ viewUserProfile p CRUserProfileNoChange u -> ttyUser u ["user profile did not change"] - CRUserPrivacy u -> ttyUserPrefix u $ viewUserPrivacy u + CRUserPrivacy u u' -> ttyUserPrefix u $ viewUserPrivacy u u' CRVersionInfo info _ _ -> viewVersionInfo logLevel info CRInvitation u cReq -> ttyUser u $ viewConnReqInvitation cReq CRSentConfirmation u -> ttyUser u ["confirmation sent!"] @@ -740,10 +740,11 @@ viewUserProfile Profile {displayName, fullName} = "(the updated profile will be sent to all your contacts)" ] -viewUserPrivacy :: User -> [StyledString] -viewUserPrivacy User {showNtfs, viewPwdHash} = - [ "user messages are " <> if showNtfs then "shown" else "hidden (use /tail to view)", - "user profile is " <> if isJust viewPwdHash then "hidden" else "visible" +viewUserPrivacy :: User -> User -> [StyledString] +viewUserPrivacy User {userId} User {userId = userId', localDisplayName = n', showNtfs, viewPwdHash} = + [ (if userId == userId' then "current " else "") <> "user " <> plain n' <> ":", + "messages are " <> if showNtfs then "shown" else "hidden (use /tail to view)", + "profile is " <> if isJust viewPwdHash then "hidden" else "visible" ] -- TODO make more generic messages or split diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 6116eeb29..6106ba5ee 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -1518,7 +1518,7 @@ testUserPrivacy = alice <# "bob> hey" -- hide user profile alice ##> "/hide user my_password" - userHidden alice + userHidden alice "current " -- shows messages when active bob #> "@alisa hello again" alice <# "bob> hello again" @@ -1559,9 +1559,9 @@ testUserPrivacy = alice ##> "/hide user password" alice <## "user is already hidden" alice ##> "/unhide user" - userVisible alice + userVisible alice "current " alice ##> "/hide user new_password" - userHidden alice + userHidden alice "current " alice ##> "/_delete user 1 del_smp=on" alice <## "cannot delete last user" alice ##> "/_hide user 1 \"password\"" @@ -1578,10 +1578,9 @@ testUserPrivacy = alice ##> "/_unhide user 2 \"wrong_password\"" alice <## "user does not exist or incorrect password" alice ##> "/_unhide user 2 \"new_password\"" - userVisible alice + userVisible alice "" alice ##> "/_hide user 2 \"another_password\"" - userHidden alice - -- check new password + userHidden alice "" alice ##> "/user alisa another_password" showActiveUser alice "alisa" alice ##> "/user alice" @@ -1594,12 +1593,14 @@ testUserPrivacy = alice <## "ok" alice <## "completed deleting user" where - userHidden alice = do - alice <## "user messages are hidden (use /tail to view)" - alice <## "user profile is hidden" - userVisible alice = do - alice <## "user messages are shown" - alice <## "user profile is visible" + userHidden alice current = do + alice <## (current <> "user alisa:") + alice <## "messages are hidden (use /tail to view)" + alice <## "profile is hidden" + userVisible alice current = do + alice <## (current <> "user alisa:") + alice <## "messages are shown" + alice <## "profile is visible" testSetChatItemTTL :: HasCallStack => FilePath -> IO () testSetChatItemTTL =