From 38be27271f48c71ac5bc5097531f0411bffc8bc3 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Mon, 2 Oct 2023 21:56:11 +0100 Subject: [PATCH] core: profile names with spaces (#3105) * core: profile names with spaces * test * more test * update name validation, export C API * refactor * validate name when creating profile in CLI * validate display name in all APIs when it is changed --- simplex-chat.cabal | 1 + src/Simplex/Chat.hs | 52 +++++++++--- src/Simplex/Chat/Controller.hs | 1 + src/Simplex/Chat/Mobile.hs | 6 ++ src/Simplex/Chat/View.hs | 143 ++++++++++++++++++--------------- tests/ChatTests/Profiles.hs | 75 ++++++++++++++++- tests/ChatTests/Utils.hs | 2 +- tests/MobileTests.hs | 10 +++ tests/Test.hs | 2 + tests/ValidNames.hs | 27 +++++++ 10 files changed, 237 insertions(+), 82 deletions(-) create mode 100644 tests/ValidNames.hs diff --git a/simplex-chat.cabal b/simplex-chat.cabal index ac641f841e..0b613310f7 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -456,6 +456,7 @@ test-suite simplex-chat-test MobileTests ProtocolTests SchemaDump + ValidNames ViewTests WebRTCTests Broadcast.Bot diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 5b56c0ac84..5d370ee651 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -32,7 +32,7 @@ import Data.Bifunctor (bimap, first) import qualified Data.ByteString.Base64 as B64 import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B -import Data.Char (isSpace, toLower) +import Data.Char import Data.Constraint (Dict (..)) import Data.Either (fromRight, rights) import Data.Fixed (div') @@ -359,6 +359,7 @@ processChatCommand :: forall m. ChatMonad m => ChatCommand -> m ChatResponse processChatCommand = \case ShowActiveUser -> withUser' $ pure . CRActiveUser CreateActiveUser NewUser {profile, sameServers, pastTimestamp} -> do + forM_ profile $ \Profile {displayName} -> checkValidName displayName p@Profile {displayName} <- liftIO $ maybe generateRandomProfile pure profile u <- asks currentUser (smp, smpServers) <- chooseServers SPSMP @@ -1457,7 +1458,8 @@ processChatCommand = \case chatRef <- getChatRef user chatName chatItemId <- getChatItemIdByText user chatRef msg processChatCommand $ APIChatItemReaction chatRef chatItemId add reaction - APINewGroup userId gProfile -> withUserId userId $ \user -> do + APINewGroup userId gProfile@GroupProfile {displayName} -> withUserId userId $ \user -> do + checkValidName displayName gVar <- asks idsDrg groupInfo <- withStore $ \db -> createNewGroup db gVar user gProfile pure $ CRGroupCreated user groupInfo @@ -1962,9 +1964,10 @@ processChatCommand = \case updateProfile :: User -> Profile -> m ChatResponse updateProfile user p' = updateProfile_ user p' $ withStore $ \db -> updateUserProfile db user p' updateProfile_ :: User -> Profile -> m User -> m ChatResponse - updateProfile_ user@User {profile = p} p' updateUser + updateProfile_ user@User {profile = p@LocalProfile {displayName = n}} p'@Profile {displayName = n'} updateUser | p' == fromLocalProfile p = pure $ CRUserProfileNoChange user | otherwise = do + when (n /= n') $ checkValidName n' -- read contacts before user update to correctly merge preferences -- [incognito] filter out contacts with whom user has incognito connections contacts <- @@ -2006,8 +2009,9 @@ processChatCommand = \case when (directOrUsed ct') $ createSndFeatureItems user ct ct' pure $ CRContactPrefsUpdated user ct ct' runUpdateGroupProfile :: User -> Group -> GroupProfile -> m ChatResponse - runUpdateGroupProfile user (Group g@GroupInfo {groupProfile = p} ms) p' = do + runUpdateGroupProfile user (Group g@GroupInfo {groupProfile = p@GroupProfile {displayName = n}} ms) p'@GroupProfile {displayName = n'} = do assertUserGroupRole g GROwner + when (n /= n') $ checkValidName n' g' <- withStore $ \db -> updateGroupProfile db user g p' (msg, _) <- sendGroupMessage user g' ms (XGrpInfo p') let cd = CDGroupSnd g' @@ -2016,6 +2020,10 @@ processChatCommand = \case toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat g') ci) createGroupFeatureChangedItems user cd CISndGroupFeature g g' pure $ CRGroupUpdated user g g' Nothing + checkValidName :: GroupName -> m () + checkValidName displayName = do + let validName = T.pack $ mkValidName $ T.unpack displayName + when (displayName /= validName) $ throwChatError CEInvalidDisplayName {displayName, validName} assertUserGroupRole :: GroupInfo -> GroupMemberRole -> m () assertUserGroupRole g@GroupInfo {membership} requiredRole = do when (membership.memberRole < requiredRole) $ throwChatError $ CEGroupUserRole g requiredRole @@ -5245,8 +5253,7 @@ getCreateActiveUser st testView = do where loop = do displayName <- getContactName - fullName <- T.pack <$> getWithPrompt "full name (optional)" - withTransaction st (\db -> runExceptT $ createUserRecord db (AgentUserId 1) Profile {displayName, fullName, image = Nothing, contactLink = Nothing, preferences = Nothing} True) >>= \case + withTransaction st (\db -> runExceptT $ createUserRecord db (AgentUserId 1) Profile {displayName, fullName = "", image = Nothing, contactLink = Nothing, preferences = Nothing} True) >>= \case Left SEDuplicateName -> do putStrLn "chosen display name is already used by another profile on this device, choose another one" loop @@ -5276,10 +5283,13 @@ getCreateActiveUser st testView = do T.unpack $ localDisplayName <> if T.null fullName || localDisplayName == fullName then "" else " (" <> fullName <> ")" getContactName :: IO ContactName getContactName = do - displayName <- getWithPrompt "display name (no spaces)" - if null displayName || isJust (find (== ' ') displayName) - then putStrLn "display name has space(s), choose another one" >> getContactName - else pure $ T.pack displayName + displayName <- getWithPrompt "display name" + let validName = mkValidName displayName + if + | null displayName -> putStrLn "display name can't be empty" >> getContactName + | null validName -> putStrLn "display name is invalid, please choose another" >> getContactName + | displayName /= validName -> putStrLn ("display name is invalid, you could use this one: " <> validName) >> getContactName + | otherwise -> pure $ T.pack displayName getWithPrompt :: String -> IO String getWithPrompt s = putStr (s <> ": ") >> hFlush stdout >> getLine @@ -5610,7 +5620,13 @@ chatCommandP = mcTextP = MCText . safeDecodeUtf8 <$> A.takeByteString msgContentP = "text " *> mcTextP <|> "json " *> jsonP ciDeleteMode = "broadcast" $> CIDMBroadcast <|> "internal" $> CIDMInternal - displayName = safeDecodeUtf8 <$> (B.cons <$> A.satisfy refChar <*> A.takeTill (== ' ')) + displayName = safeDecodeUtf8 <$> (quoted "'\"" <|> takeNameTill isSpace) + where + takeNameTill p = + A.peekChar' >>= \c -> + if refChar c then A.takeTill p else fail "invalid first character in display name" + quoted cs = A.choice [A.char c *> takeNameTill (== c) <* A.char c | c <- cs] + refChar c = c > ' ' && c /= '#' && c /= '@' sendMsgQuote msgDir = SendMessageQuote <$> displayName <* A.space <*> pure msgDir <*> quotedMsg <*> msgTextP quotedMsg = safeDecodeUtf8 <$> (A.char '(' *> A.takeTill (== ')') <* A.char ')') <* optional A.space reactionP = MREmoji <$> (mrEmojiChar <$?> (toEmoji <$> A.anyChar)) @@ -5623,7 +5639,6 @@ chatCommandP = '*' -> head "❤️" '^' -> '🚀' c -> c - refChar c = c > ' ' && c /= '#' && c /= '@' liveMessageP = " live=" *> onOffP <|> pure False sendMessageTTLP = " ttl=" *> ((Just <$> A.decimal) <|> ("default" $> Nothing)) <|> pure Nothing receiptSettings = do @@ -5718,3 +5733,16 @@ timeItToView s action = do let diff = diffToMilliseconds $ diffUTCTime t2 t1 toView $ CRTimedAction s diff pure a + +mkValidName :: String -> String +mkValidName = reverse . dropWhile isSpace . fst . foldl' addChar ("", '\NUL') + where + addChar (r, prev) c = if notProhibited && validChar then (c' : r, c') else (r, prev) + where + c' = if isSpace c then ' ' else c + validChar + | prev == '\NUL' || isSpace prev = validFirstChar + | isPunctuation prev = validFirstChar || isSpace c + | otherwise = validFirstChar || isSpace c || isMark c || isPunctuation c + validFirstChar = isLetter c || isNumber c || isSymbol c + notProhibited = c `notElem` ("@#'\"`" :: String) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 15c06cba94..61840b8e84 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -882,6 +882,7 @@ data ChatErrorType | CEEmptyUserPassword {userId :: UserId} | CEUserAlreadyHidden {userId :: UserId} | CEUserNotHidden {userId :: UserId} + | CEInvalidDisplayName {displayName :: Text, validName :: Text} | CEChatNotStarted | CEChatNotStopped | CEChatStoreChanged diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index 700548bb12..783e38ef3f 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -65,6 +65,8 @@ foreign export ccall "chat_parse_server" cChatParseServer :: CString -> IO CJSON foreign export ccall "chat_password_hash" cChatPasswordHash :: CString -> CString -> IO CString +foreign export ccall "chat_valid_name" cChatValidName :: CString -> IO CString + foreign export ccall "chat_encrypt_media" cChatEncryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString foreign export ccall "chat_decrypt_media" cChatDecryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString @@ -124,6 +126,10 @@ cChatPasswordHash cPwd cSalt = do salt <- B.packCString cSalt newCStringFromBS $ chatPasswordHash pwd salt +-- This function supports utf8 strings +cChatValidName :: CString -> IO CString +cChatValidName cName = newCString . mkValidName =<< peekCString cName + mobileChatOpts :: String -> String -> ChatOpts mobileChatOpts dbFilePrefix dbKey = ChatOpts diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 01bdfba95a..5eb9df3ad2 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -15,7 +15,7 @@ import Data.Aeson (ToJSON) import qualified Data.Aeson as J import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as LB -import Data.Char (toUpper) +import Data.Char (isSpace, toUpper) import Data.Function (on) import Data.Int (Int64) import Data.List (groupBy, intercalate, intersperse, partition, sortOn) @@ -224,7 +224,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView CRLeftMember u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " left the group"] CRGroupEmpty u g -> ttyUser u [ttyFullGroup g <> ": group is empty"] CRGroupRemoved u g -> ttyUser u [ttyFullGroup g <> ": you are no longer a member or group deleted"] - CRGroupDeleted u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> groupName' g) <> " to delete the local copy of the group"] + CRGroupDeleted u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> viewGroupName g) <> " to delete the local copy of the group"] CRGroupUpdated u g g' m -> ttyUser u $ viewGroupUpdated g g' m CRGroupProfile u g -> ttyUser u $ viewGroupProfile g CRGroupDescription u g -> ttyUser u $ viewGroupDescription g @@ -674,10 +674,7 @@ viewContactNotFound cName suspectedMember = ["no contact " <> ttyContact cName <> useMessageMember] where useMessageMember = case suspectedMember of - Just (g, m) -> do - let GroupInfo {localDisplayName = gName} = g - GroupMember {localDisplayName = mName} = m - ", use " <> highlight' ("@#" <> T.unpack gName <> " " <> T.unpack mName <> " ") + Just (g, m) -> ", use " <> highlight ("@#" <> viewGroupName g <> " " <> viewMemberName m <> " ") _ -> "" viewChatCleared :: AChatInfo -> [StyledString] @@ -732,14 +729,14 @@ groupLink_ intro g cReq mRole = (plain . strEncode) cReq, "", "Anybody can connect to you and join group as " <> showRole mRole <> " with: " <> highlight' "/c ", - "to show it again: " <> highlight ("/show link #" <> groupName' g), - "to delete it: " <> highlight ("/delete link #" <> groupName' g) <> " (joined members will remain connected to you)" + "to show it again: " <> highlight ("/show link #" <> viewGroupName g), + "to delete it: " <> highlight ("/delete link #" <> viewGroupName g) <> " (joined members will remain connected to you)" ] viewGroupLinkDeleted :: GroupInfo -> [StyledString] viewGroupLinkDeleted g = [ "Group link is deleted - joined members will remain connected.", - "To create a new group link use " <> highlight ("/create link #" <> groupName' g) + "To create a new group link use " <> highlight ("/create link #" <> viewGroupName g) ] viewSentInvitation :: Maybe Profile -> Bool -> [StyledString] @@ -756,20 +753,20 @@ viewSentInvitation incognitoProfile testView = viewReceivedContactRequest :: ContactName -> Profile -> [StyledString] viewReceivedContactRequest c Profile {fullName} = [ ttyFullName c fullName <> " wants to connect to you!", - "to accept: " <> highlight ("/ac " <> c), - "to reject: " <> highlight ("/rc " <> c) <> " (the sender will NOT be notified)" + "to accept: " <> highlight ("/ac " <> viewName c), + "to reject: " <> highlight ("/rc " <> viewName c) <> " (the sender will NOT be notified)" ] viewGroupCreated :: GroupInfo -> [StyledString] -viewGroupCreated g@GroupInfo {localDisplayName = n} = +viewGroupCreated g = [ "group " <> ttyFullGroup g <> " is created", - "to add members use " <> highlight ("/a " <> n <> " ") <> " or " <> highlight ("/create link #" <> n) + "to add members use " <> highlight ("/a " <> viewGroupName g <> " ") <> " or " <> highlight ("/create link #" <> viewGroupName g) ] viewCannotResendInvitation :: GroupInfo -> ContactName -> [StyledString] -viewCannotResendInvitation GroupInfo {localDisplayName = gn} c = - [ ttyContact c <> " is already invited to group " <> ttyGroup gn, - "to re-send invitation: " <> highlight ("/rm " <> gn <> " " <> c) <> ", " <> highlight ("/a " <> gn <> " " <> c) +viewCannotResendInvitation g c = + [ ttyContact c <> " is already invited to group " <> ttyGroup' g, + "to re-send invitation: " <> highlight ("/rm " <> viewGroupName g <> " " <> c) <> ", " <> highlight ("/a " <> viewGroupName g <> " " <> viewName c) ] viewDirectMessagesProhibited :: MsgDirection -> Contact -> [StyledString] @@ -790,11 +787,11 @@ viewReceivedGroupInvitation :: GroupInfo -> Contact -> GroupMemberRole -> [Style viewReceivedGroupInvitation g c role = ttyFullGroup g <> ": " <> ttyContact' c <> " invites you to join the group as " <> plain (strEncode role) : case incognitoMembershipProfile g of - Just mp -> ["use " <> highlight ("/j " <> groupName' g) <> " to join incognito as " <> incognitoProfile' (fromLocalProfile mp)] - Nothing -> ["use " <> highlight ("/j " <> groupName' g) <> " to accept"] + Just mp -> ["use " <> highlight ("/j " <> viewGroupName g) <> " to join incognito as " <> incognitoProfile' (fromLocalProfile mp)] + Nothing -> ["use " <> highlight ("/j " <> viewGroupName g) <> " to accept"] groupPreserved :: GroupInfo -> [StyledString] -groupPreserved g = ["use " <> highlight ("/d #" <> groupName' g) <> " to delete the group"] +groupPreserved g = ["use " <> highlight ("/d #" <> viewGroupName g) <> " to delete the group"] connectedMember :: GroupMember -> StyledString connectedMember m = case memberCategory m of @@ -845,7 +842,7 @@ viewGroupMembers (Group GroupInfo {membership} members) = map groupMember . filt _ -> "" viewContactConnected :: Contact -> Maybe Profile -> Bool -> [StyledString] -viewContactConnected ct@Contact {localDisplayName} userIncognitoProfile testView = +viewContactConnected ct userIncognitoProfile testView = case userIncognitoProfile of Just profile -> if testView @@ -854,7 +851,7 @@ viewContactConnected ct@Contact {localDisplayName} userIncognitoProfile testView where message = [ ttyFullContact ct <> ": contact is connected, your incognito profile for this contact is " <> incognitoProfile' profile, - "use " <> highlight ("/i " <> localDisplayName) <> " to print out this incognito profile again" + "use " <> highlight ("/i " <> viewContactName ct) <> " to print out this incognito profile again" ] Nothing -> [ttyFullContact ct <> ": contact is connected"] @@ -865,10 +862,10 @@ viewGroupsList gs = map groupSS $ sortOn (ldn_ . fst) gs where ldn_ :: GroupInfo -> Text ldn_ g = T.toLower g.localDisplayName - groupSS (g@GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}, membership, chatSettings}, GroupSummary {currentMembers}) = + groupSS (g@GroupInfo {membership, chatSettings}, GroupSummary {currentMembers}) = case memberStatus membership of GSMemInvited -> groupInvitation' g - s -> membershipIncognito g <> ttyGroup ldn <> optFullName ldn fullName <> viewMemberStatus s + s -> membershipIncognito g <> ttyFullGroup g <> viewMemberStatus s where viewMemberStatus = \case GSMemRemoved -> delete "you are removed" @@ -876,18 +873,18 @@ viewGroupsList gs = map groupSS $ sortOn (ldn_ . fst) gs GSMemGroupDeleted -> delete "group deleted" _ | enableNtfs chatSettings -> " (" <> memberCount <> ")" - | otherwise -> " (" <> memberCount <> ", muted, you can " <> highlight ("/unmute #" <> ldn) <> ")" - delete reason = " (" <> reason <> ", delete local copy: " <> highlight ("/d #" <> ldn) <> ")" + | otherwise -> " (" <> memberCount <> ", muted, you can " <> highlight ("/unmute #" <> viewGroupName g) <> ")" + delete reason = " (" <> reason <> ", delete local copy: " <> highlight ("/d #" <> viewGroupName g) <> ")" memberCount = sShow currentMembers <> " member" <> if currentMembers == 1 then "" else "s" groupInvitation' :: GroupInfo -> StyledString groupInvitation' g@GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}} = - highlight ("#" <> ldn) + highlight ("#" <> viewName ldn) <> optFullName ldn fullName <> " - you are invited (" - <> highlight ("/j " <> ldn) + <> highlight ("/j " <> viewName ldn) <> joinText - <> highlight ("/d #" <> ldn) + <> highlight ("/d #" <> viewName ldn) <> " to delete invitation)" where joinText = case incognitoMembershipProfile g of @@ -895,21 +892,21 @@ groupInvitation' g@GroupInfo {localDisplayName = ldn, groupProfile = GroupProfil Nothing -> " to join, " viewContactsMerged :: Contact -> Contact -> [StyledString] -viewContactsMerged _into@Contact {localDisplayName = c1} _merged@Contact {localDisplayName = c2} = - [ "contact " <> ttyContact c2 <> " is merged into " <> ttyContact c1, - "use " <> ttyToContact c1 <> highlight' "" <> " to send messages" +viewContactsMerged c1 c2 = + [ "contact " <> ttyContact' c2 <> " is merged into " <> ttyContact' c1, + "use " <> ttyToContact' c1 <> highlight' "" <> " to send messages" ] viewUserProfile :: Profile -> [StyledString] viewUserProfile Profile {displayName, fullName} = [ "user profile: " <> ttyFullName displayName fullName, - "use " <> highlight' "/p []" <> " to change it", + "use " <> highlight' "/p " <> " to change it", "(the updated profile will be sent to all your contacts)" ] viewUserPrivacy :: User -> User -> [StyledString] viewUserPrivacy User {userId} User {userId = userId', localDisplayName = n', showNtfs, viewPwdHash} = - [ (if userId == userId' then "current " else "") <> "user " <> plain n' <> ":", + [ plain $ (if userId == userId' then "current " else "") <> "user " <> viewName n' <> ":", "messages are " <> if showNtfs then "shown" else "hidden (use /tail to view)", "profile is " <> if isJust viewPwdHash then "hidden" else "visible" ] @@ -1055,18 +1052,18 @@ viewGroupMemberSwitch g m (SwitchProgress qd phase _) = case qd of QDSnd -> [ttyGroup' g <> ": " <> ttyMember m <> " " <> viewSwitchPhase phase <> " for you"] viewContactRatchetSync :: Contact -> RatchetSyncProgress -> [StyledString] -viewContactRatchetSync ct@Contact {localDisplayName = c} RatchetSyncProgress {ratchetSyncStatus = rss} = +viewContactRatchetSync ct RatchetSyncProgress {ratchetSyncStatus = rss} = [ttyContact' ct <> ": " <> (plain . ratchetSyncStatusToText) rss] <> help where - help = ["use " <> highlight ("/sync " <> c) <> " to synchronize" | rss `elem` [RSAllowed, RSRequired]] + help = ["use " <> highlight ("/sync " <> viewContactName ct) <> " to synchronize" | rss `elem` [RSAllowed, RSRequired]] viewGroupMemberRatchetSync :: GroupInfo -> GroupMember -> RatchetSyncProgress -> [StyledString] -viewGroupMemberRatchetSync g m@GroupMember {localDisplayName = n} RatchetSyncProgress {ratchetSyncStatus = rss} = +viewGroupMemberRatchetSync g m RatchetSyncProgress {ratchetSyncStatus = rss} = [ttyGroup' g <> " " <> ttyMember m <> ": " <> (plain . ratchetSyncStatusToText) rss] <> help where - help = ["use " <> highlight ("/sync #" <> groupName' g <> " " <> n) <> " to synchronize" | rss `elem` [RSAllowed, RSRequired]] + help = ["use " <> highlight ("/sync #" <> viewGroupName g <> " " <> viewMemberName m) <> " to synchronize" | rss `elem` [RSAllowed, RSRequired]] viewContactVerificationReset :: Contact -> [StyledString] viewContactVerificationReset ct = @@ -1077,10 +1074,10 @@ viewGroupMemberVerificationReset g m = [ttyGroup' g <> " " <> ttyMember m <> ": security code changed"] viewContactCode :: Contact -> Text -> Bool -> [StyledString] -viewContactCode ct@Contact {localDisplayName = c} = viewSecurityCode (ttyContact' ct) ("/verify " <> c <> " ") +viewContactCode ct = viewSecurityCode (ttyContact' ct) ("/verify " <> viewContactName ct <> " ") viewGroupMemberCode :: GroupInfo -> GroupMember -> Text -> Bool -> [StyledString] -viewGroupMemberCode g m@GroupMember {localDisplayName = n} = viewSecurityCode (ttyGroup' g <> " " <> ttyMember m) ("/verify #" <> groupName' g <> " " <> n <> " ") +viewGroupMemberCode g m = viewSecurityCode (ttyGroup' g <> " " <> ttyMember m) ("/verify #" <> viewGroupName g <> " " <> viewMemberName m <> " ") viewSecurityCode :: StyledString -> Text -> Text -> Bool -> [StyledString] viewSecurityCode name cmd code testView @@ -1206,9 +1203,9 @@ bold' :: String -> StyledString bold' = styled Bold viewContactAliasUpdated :: Contact -> [StyledString] -viewContactAliasUpdated Contact {localDisplayName = n, profile = LocalProfile {localAlias}} - | localAlias == "" = ["contact " <> ttyContact n <> " alias removed"] - | otherwise = ["contact " <> ttyContact n <> " alias updated: " <> plain localAlias] +viewContactAliasUpdated ct@Contact {profile = LocalProfile {localAlias}} + | localAlias == "" = ["contact " <> ttyContact' ct <> " alias removed"] + | otherwise = ["contact " <> ttyContact' ct <> " alias updated: " <> plain localAlias] viewConnectionAliasUpdated :: PendingContactConnection -> [StyledString] viewConnectionAliasUpdated PendingContactConnection {pccConnId, localAlias} @@ -1385,10 +1382,10 @@ savingFile' testView (AChatItem _ _ chat ChatItem {file = Just CIFile {fileId, f savingFile' _ _ = ["saving file"] -- shouldn't happen receivingFile_' :: StyledString -> AChatItem -> [StyledString] -receivingFile_' status (AChatItem _ _ (DirectChat Contact {localDisplayName = c}) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIDirectRcv}) = - [status <> " receiving " <> fileTransferStr fileId fileName <> " from " <> ttyContact c] -receivingFile_' status (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIGroupRcv GroupMember {localDisplayName = m}}) = - [status <> " receiving " <> fileTransferStr fileId fileName <> " from " <> ttyContact m] +receivingFile_' status (AChatItem _ _ (DirectChat c) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIDirectRcv}) = + [status <> " receiving " <> fileTransferStr fileId fileName <> " from " <> ttyContact' c] +receivingFile_' status (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIGroupRcv m}) = + [status <> " receiving " <> fileTransferStr fileId fileName <> " from " <> ttyMember m] receivingFile_' status _ = [status <> " receiving file"] -- shouldn't happen receivingFile_ :: StyledString -> RcvFileTransfer -> [StyledString] @@ -1556,6 +1553,9 @@ viewChatError logLevel = \case CEEmptyUserPassword _ -> ["user password is required"] CEUserAlreadyHidden _ -> ["user is already hidden"] CEUserNotHidden _ -> ["user is not hidden"] + CEInvalidDisplayName {displayName, validName} -> map plain $ + ["invalid display name: " <> viewName displayName] + <> ["you could use this one: " <> viewName validName | not (T.null validName)] CEChatNotStarted -> ["error: chat not started"] CEChatNotStopped -> ["error: chat not stopped"] CEChatStoreChanged -> ["error: chat store changed, please restart chat"] @@ -1568,8 +1568,8 @@ viewChatError logLevel = \case ] CEContactNotFound cName m_ -> viewContactNotFound cName m_ CEContactNotReady c -> [ttyContact' c <> ": not ready"] + CEContactDisabled ct -> [ttyContact' ct <> ": disabled, to enable: " <> highlight ("/enable " <> viewContactName ct) <> ", to delete: " <> highlight ("/d " <> viewContactName ct)] CEContactNotActive c -> [ttyContact' c <> ": not active"] - CEContactDisabled Contact {localDisplayName = c} -> [ttyContact c <> ": disabled, to enable: " <> highlight ("/enable " <> c) <> ", to delete: " <> highlight ("/d " <> c)] CEConnectionDisabled Connection {connId, connType} -> [plain $ "connection " <> textEncode connType <> " (" <> tshow connId <> ") is disabled" | logLevel <= CLLWarning] CEGroupDuplicateMember c -> ["contact " <> ttyContact c <> " is already in the group"] CEGroupDuplicateMemberId -> ["cannot add member - duplicate member ID"] @@ -1581,7 +1581,7 @@ viewChatError logLevel = \case CEContactIncognitoCantInvite -> ["you're using your main profile for this group - prohibited to invite contacts to whom you are connected incognito"] CEGroupIncognitoCantInvite -> ["you've connected to this group using an incognito profile - prohibited to invite contacts"] CEGroupContactRole c -> ["contact " <> ttyContact c <> " has insufficient permissions for this group action"] - CEGroupNotJoined g -> ["you did not join this group, use " <> highlight ("/join #" <> groupName' g)] + CEGroupNotJoined g -> ["you did not join this group, use " <> highlight ("/join #" <> viewGroupName g)] CEGroupMemberNotActive -> ["your group connection is not active yet, try later"] CEGroupMemberUserRemoved -> ["you are no longer a member of the group"] CEGroupMemberNotFound -> ["group doesn't have this member"] @@ -1641,8 +1641,8 @@ viewChatError logLevel = \case SEFileIdNotFoundBySharedMsgId _ -> [] -- recipient tried to accept cancelled file SEConnectionNotFound agentConnId -> ["event connection not found, agent ID: " <> sShow agentConnId | logLevel <= CLLWarning] -- mutes delete group error SEChatItemNotFoundByText text -> ["message not found by text: " <> plain text] - SEDuplicateGroupLink g -> ["you already have link for this group, to show: " <> highlight ("/show link #" <> groupName' g)] - SEGroupLinkNotFound g -> ["no group link, to create: " <> highlight ("/create link #" <> groupName' g)] + SEDuplicateGroupLink g -> ["you already have link for this group, to show: " <> highlight ("/show link #" <> viewGroupName g)] + SEGroupLinkNotFound g -> ["no group link, to create: " <> highlight ("/create link #" <> viewGroupName g)] e -> ["chat db error: " <> sShow e] ChatErrorDatabase err -> case err of DBErrorEncrypted -> ["error: chat database is already encrypted"] @@ -1687,8 +1687,8 @@ viewChatError logLevel = \case viewConnectionEntityDisabled :: ConnectionEntity -> [StyledString] viewConnectionEntityDisabled entity = case entity of - RcvDirectMsgConnection _ (Just Contact {localDisplayName = c}) -> ["[" <> entityLabel <> "] connection is disabled, to enable: " <> highlight ("/enable " <> c) <> ", to delete: " <> highlight ("/d " <> c)] - RcvGroupMsgConnection _ GroupInfo {localDisplayName = g} GroupMember {localDisplayName = m} -> ["[" <> entityLabel <> "] connection is disabled, to enable: " <> highlight ("/enable #" <> g <> " " <> m)] + RcvDirectMsgConnection _ (Just c) -> ["[" <> entityLabel <> "] connection is disabled, to enable: " <> highlight ("/enable " <> viewContactName c) <> ", to delete: " <> highlight ("/d " <> viewContactName c)] + RcvGroupMsgConnection _ g m -> ["[" <> entityLabel <> "] connection is disabled, to enable: " <> highlight ("/enable #" <> viewGroupName g <> " " <> viewMemberName m)] _ -> ["[" <> entityLabel <> "] connection is disabled"] where entityLabel = connEntityLabel entity @@ -1703,7 +1703,7 @@ connEntityLabel = \case UserContactConnection _ UserContact {} -> "contact address" ttyContact :: ContactName -> StyledString -ttyContact = styled $ colored Green +ttyContact = styled (colored Green) . viewName ttyContact' :: Contact -> StyledString ttyContact' Contact {localDisplayName = c} = ttyContact c @@ -1723,37 +1723,46 @@ ttyFullName :: ContactName -> Text -> StyledString ttyFullName c fullName = ttyContact c <> optFullName c fullName ttyToContact :: ContactName -> StyledString -ttyToContact c = ttyTo $ "@" <> c <> " " +ttyToContact c = ttyTo $ "@" <> viewName c <> " " ttyToContact' :: Contact -> StyledString ttyToContact' ct@Contact {localDisplayName = c} = ctIncognito ct <> ttyToContact c ttyToContactEdited' :: Contact -> StyledString -ttyToContactEdited' ct@Contact {localDisplayName = c} = ctIncognito ct <> ttyTo ("@" <> c <> " [edited] ") +ttyToContactEdited' ct@Contact {localDisplayName = c} = ctIncognito ct <> ttyTo ("@" <> viewName c <> " [edited] ") ttyQuotedContact :: Contact -> StyledString -ttyQuotedContact Contact {localDisplayName = c} = ttyFrom $ c <> ">" +ttyQuotedContact Contact {localDisplayName = c} = ttyFrom $ viewName c <> ">" ttyQuotedMember :: Maybe GroupMember -> StyledString -ttyQuotedMember (Just GroupMember {localDisplayName = c}) = "> " <> ttyFrom c +ttyQuotedMember (Just GroupMember {localDisplayName = c}) = "> " <> ttyFrom (viewName c) ttyQuotedMember _ = "> " <> ttyFrom "?" ttyFromContact :: Contact -> StyledString -ttyFromContact ct@Contact {localDisplayName = c} = ctIncognito ct <> ttyFrom (c <> "> ") +ttyFromContact ct@Contact {localDisplayName = c} = ctIncognito ct <> ttyFrom (viewName c <> "> ") ttyFromContactEdited :: Contact -> StyledString -ttyFromContactEdited ct@Contact {localDisplayName = c} = ctIncognito ct <> ttyFrom (c <> "> [edited] ") +ttyFromContactEdited ct@Contact {localDisplayName = c} = ctIncognito ct <> ttyFrom (viewName c <> "> [edited] ") ttyFromContactDeleted :: Contact -> Maybe Text -> StyledString ttyFromContactDeleted ct@Contact {localDisplayName = c} deletedText_ = - ctIncognito ct <> ttyFrom (c <> "> " <> maybe "" (\t -> "[" <> t <> "] ") deletedText_) + ctIncognito ct <> ttyFrom (viewName c <> "> " <> maybe "" (\t -> "[" <> t <> "] ") deletedText_) ttyGroup :: GroupName -> StyledString -ttyGroup g = styled (colored Blue) $ "#" <> g +ttyGroup g = styled (colored Blue) $ "#" <> viewName g ttyGroup' :: GroupInfo -> StyledString ttyGroup' = ttyGroup . groupName' +viewContactName :: Contact -> Text +viewContactName = viewName . localDisplayName' + +viewGroupName :: GroupInfo -> Text +viewGroupName = viewName . groupName' + +viewMemberName :: GroupMember -> Text +viewMemberName GroupMember {localDisplayName = n} = viewName n + ttyGroups :: [GroupName] -> StyledString ttyGroups [] = "" ttyGroups [g] = ttyGroup g @@ -1774,8 +1783,7 @@ ttyFromGroupDeleted g m deletedText_ = membershipIncognito g <> ttyFrom (fromGroup_ g m <> maybe "" (\t -> "[" <> t <> "] ") deletedText_) fromGroup_ :: GroupInfo -> GroupMember -> Text -fromGroup_ GroupInfo {localDisplayName = g} GroupMember {localDisplayName = m} = - "#" <> g <> " " <> m <> "> " +fromGroup_ g m = "#" <> viewGroupName g <> " " <> viewMemberName m <> "> " ttyFrom :: Text -> StyledString ttyFrom = styled $ colored Yellow @@ -1784,12 +1792,13 @@ ttyTo :: Text -> StyledString ttyTo = styled $ colored Cyan ttyToGroup :: GroupInfo -> StyledString -ttyToGroup g@GroupInfo {localDisplayName = n} = - membershipIncognito g <> ttyTo ("#" <> n <> " ") +ttyToGroup g = membershipIncognito g <> ttyTo ("#" <> viewGroupName g <> " ") ttyToGroupEdited :: GroupInfo -> StyledString -ttyToGroupEdited g@GroupInfo {localDisplayName = n} = - membershipIncognito g <> ttyTo ("#" <> n <> " [edited] ") +ttyToGroupEdited g = membershipIncognito g <> ttyTo ("#" <> viewGroupName g <> " [edited] ") + +viewName :: Text -> Text +viewName s = if T.any isSpace s then "'" <> s <> "'" else s ttyFilePath :: FilePath -> StyledString ttyFilePath = plain diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index 44af70a65e..da6cbd156f 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -8,7 +8,7 @@ import ChatTests.Utils import Control.Concurrent (threadDelay) import Control.Concurrent.Async (concurrently_) import qualified Data.Text as T -import Simplex.Chat.Types (ConnStatus (..), GroupMemberRole (..)) +import Simplex.Chat.Types (ConnStatus (..), GroupMemberRole (..), Profile (..)) import System.Directory (copyFile, createDirectoryIfMissing) import Test.Hspec @@ -17,6 +17,7 @@ chatProfileTests = do describe "user profiles" $ do it "update user profile and notify contacts" testUpdateProfile it "update user profile with image" testUpdateProfileImage + it "use multiword profile names" testMultiWordProfileNames describe "user contact link" $ do it "create and connect via contact link" testUserContactLink it "add contact link to profile" testProfileLink @@ -62,7 +63,7 @@ testUpdateProfile = createGroup3 "team" alice bob cath alice ##> "/p" alice <## "user profile: alice (Alice)" - alice <## "use /p [] to change it" + alice <## "use /p to change it" alice <## "(the updated profile will be sent to all your contacts)" alice ##> "/p alice" concurrentlyN_ @@ -117,6 +118,76 @@ testUpdateProfileImage = bob <## "use @alice2 to send messages" (bob FilePath -> IO () +testMultiWordProfileNames = + testChat3 aliceProfile' bobProfile' cathProfile' $ + \alice bob cath -> do + alice ##> "/c" + inv <- getInvitation alice + bob ##> ("/c " <> inv) + bob <## "confirmation sent!" + concurrently_ + (bob <## "'Alice Jones': contact is connected") + (alice <## "'Bob James': contact is connected") + alice #> "@'Bob James' hi" + bob <# "'Alice Jones'> hi" + alice ##> "/g 'Our Team'" + alice <## "group #'Our Team' is created" + alice <## "to add members use /a 'Our Team' or /create link #'Our Team'" + alice ##> "/a 'Our Team' 'Bob James' admin" + alice <## "invitation to join the group #'Our Team' sent to 'Bob James'" + bob <## "#'Our Team': 'Alice Jones' invites you to join the group as admin" + bob <## "use /j 'Our Team' to accept" + bob ##> "/j 'Our Team'" + bob <## "#'Our Team': you joined the group" + alice <## "#'Our Team': 'Bob James' joined the group" + bob ##> "/c" + inv' <- getInvitation bob + cath ##> ("/c " <> inv') + cath <## "confirmation sent!" + concurrently_ + (cath <## "'Bob James': contact is connected") + (bob <## "'Cath Johnson': contact is connected") + bob ##> "/a 'Our Team' 'Cath Johnson'" + bob <## "invitation to join the group #'Our Team' sent to 'Cath Johnson'" + cath <## "#'Our Team': 'Bob James' invites you to join the group as member" + cath <## "use /j 'Our Team' to accept" + cath ##> "/j 'Our Team'" + concurrentlyN_ + [ bob <## "#'Our Team': 'Cath Johnson' joined the group", + do + cath <## "#'Our Team': you joined the group" + cath <## "#'Our Team': member 'Alice Jones' is connected", + do + alice <## "#'Our Team': 'Bob James' added 'Cath Johnson' to the group (connecting...)" + alice <## "#'Our Team': new member 'Cath Johnson' is connected" + ] + bob #> "#'Our Team' hi" + alice <# "#'Our Team' 'Bob James'> hi" + cath <# "#'Our Team' 'Bob James'> hi" + alice `send` "@'Cath Johnson' hello" + alice <## "member #'Our Team' 'Cath Johnson' does not have direct connection, creating" + alice <## "contact for member #'Our Team' 'Cath Johnson' is created" + alice <## "sent invitation to connect directly to member #'Our Team' 'Cath Johnson'" + alice <# "@'Cath Johnson' hello" + cath <## "#'Our Team' 'Alice Jones' is creating direct contact 'Alice Jones' with you" + cath <# "'Alice Jones'> hello" + cath <## "'Alice Jones': contact is connected" + alice <## "'Cath Johnson': contact is connected" + cath ##> "/p 'Cath J'" + cath <## "user profile is changed to 'Cath J' (your 2 contacts are notified)" + alice <## "contact 'Cath Johnson' changed to 'Cath J'" + alice <## "use @'Cath J' to send messages" + bob <## "contact 'Cath Johnson' changed to 'Cath J'" + bob <## "use @'Cath J' to send messages" + alice #> "@'Cath J' hi" + cath <# "'Alice Jones'> hi" + where + aliceProfile' = baseProfile {displayName = "Alice Jones"} + bobProfile' = baseProfile {displayName = "Bob James"} + cathProfile' = baseProfile {displayName = "Cath Johnson"} + baseProfile = Profile {displayName = "", fullName = "", image = Nothing, contactLink = Nothing, preferences = defaultPrefs} + testUserContactLink :: HasCallStack => FilePath -> IO () testUserContactLink = testChat3 aliceProfile bobProfile cathProfile $ diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index c120d661ff..6831cf3190 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -435,7 +435,7 @@ lastItemId cc = do showActiveUser :: HasCallStack => TestCC -> String -> Expectation showActiveUser cc name = do cc <## ("user profile: " <> name) - cc <## "use /p [] to change it" + cc <## "use /p to change it" cc <## "(the updated profile will be sent to all your contacts)" connectUsers :: HasCallStack => TestCC -> TestCC -> IO () diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs index 0b965250b4..69c2207ff6 100644 --- a/tests/MobileTests.hs +++ b/tests/MobileTests.hs @@ -61,6 +61,8 @@ mobileTests = do it "utf8 name 1" $ testFileEncryptionCApi "тест" it "utf8 name 2" $ testFileEncryptionCApi "👍" it "no exception on missing file" testMissingFileEncryptionCApi + describe "validate name" $ do + it "should convert invalid name to a valid name" testValidNameCApi noActiveUser :: LB.ByteString #if defined(darwin_HOST_OS) && defined(swiftJSON) @@ -266,6 +268,14 @@ testMissingFileEncryptionCApi tmp = do err' <- peekCAString =<< cChatDecryptFile cToPath cKey cNonce cToPath' err' `shouldContain` toPath +testValidNameCApi :: FilePath -> IO () +testValidNameCApi _ = do + let goodName = "Джон Доу 👍" + cName1 <- cChatValidName =<< newCString goodName + peekCString cName1 `shouldReturn` goodName + cName2 <- cChatValidName =<< newCString " @'Джон' Доу 👍 " + peekCString cName2 `shouldReturn` goodName + jDecode :: FromJSON a => String -> IO (Maybe a) jDecode = pure . J.decode . LB.pack diff --git a/tests/Test.hs b/tests/Test.hs index 455d5459c7..cf60a70138 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -12,6 +12,7 @@ import SchemaDump import Test.Hspec import UnliftIO.Temporary (withTempDirectory) import ViewTests +import ValidNames import WebRTCTests main :: IO () @@ -23,6 +24,7 @@ main = do describe "SimpleX chat view" viewTests describe "SimpleX chat protocol" protocolTests describe "WebRTC encryption" webRTCTests + describe "Valid names" validNameTests around testBracket $ do describe "Mobile API Tests" mobileTests describe "SimpleX chat client" chatTests diff --git a/tests/ValidNames.hs b/tests/ValidNames.hs new file mode 100644 index 0000000000..40cda01431 --- /dev/null +++ b/tests/ValidNames.hs @@ -0,0 +1,27 @@ +module ValidNames where + +import Simplex.Chat +import Test.Hspec + +validNameTests :: Spec +validNameTests = describe "valid chat names" $ do + it "should keep valid and fix invalid names" testMkValidName + +testMkValidName :: IO () +testMkValidName = do + mkValidName "alice" `shouldBe` "alice" + mkValidName "алиса" `shouldBe` "алиса" + mkValidName "John Doe" `shouldBe` "John Doe" + mkValidName "J.Doe" `shouldBe` "J.Doe" + mkValidName "J. Doe" `shouldBe` "J. Doe" + mkValidName "J..Doe" `shouldBe` "J.Doe" + mkValidName "J ..Doe" `shouldBe` "J Doe" + mkValidName "J . . Doe" `shouldBe` "J Doe" + mkValidName "@alice" `shouldBe` "alice" + mkValidName "#alice" `shouldBe` "alice" + mkValidName " alice" `shouldBe` "alice" + mkValidName "alice " `shouldBe` "alice" + mkValidName "John Doe" `shouldBe` "John Doe" + mkValidName "'John Doe'" `shouldBe` "John Doe" + mkValidName "\"John Doe\"" `shouldBe` "John Doe" + mkValidName "`John Doe`" `shouldBe` "John Doe"