mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-03-14 09:45:42 +00:00
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
This commit is contained in:
Evgeny Poberezkin
GitHub
parent
da2a94578a
commit
38be27271f
10 changed files with 237 additions and 82 deletions
|
|
@ -456,6 +456,7 @@ test-suite simplex-chat-test
|
|||
MobileTests
|
||||
ProtocolTests
|
||||
SchemaDump
|
||||
ValidNames
|
||||
ViewTests
|
||||
WebRTCTests
|
||||
Broadcast.Bot
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -882,6 +882,7 @@ data ChatErrorType
|
|||
| CEEmptyUserPassword {userId :: UserId}
|
||||
| CEUserAlreadyHidden {userId :: UserId}
|
||||
| CEUserNotHidden {userId :: UserId}
|
||||
| CEInvalidDisplayName {displayName :: Text, validName :: Text}
|
||||
| CEChatNotStarted
|
||||
| CEChatNotStopped
|
||||
| CEChatStoreChanged
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 <> " <your message>")
|
||||
Just (g, m) -> ", use " <> highlight ("@#" <> viewGroupName g <> " " <> viewMemberName m <> " <your message>")
|
||||
_ -> ""
|
||||
|
||||
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 <group_link_above>",
|
||||
"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 <> " <name>") <> " or " <> highlight ("/create link #" <> n)
|
||||
"to add members use " <> highlight ("/a " <> viewGroupName g <> " <name>") <> " 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' "<message>" <> " to send messages"
|
||||
viewContactsMerged c1 c2 =
|
||||
[ "contact " <> ttyContact' c2 <> " is merged into " <> ttyContact' c1,
|
||||
"use " <> ttyToContact' c1 <> highlight' "<message>" <> " to send messages"
|
||||
]
|
||||
|
||||
viewUserProfile :: Profile -> [StyledString]
|
||||
viewUserProfile Profile {displayName, fullName} =
|
||||
[ "user profile: " <> ttyFullName displayName fullName,
|
||||
"use " <> highlight' "/p <display name> [<full name>]" <> " to change it",
|
||||
"use " <> highlight' "/p <display name>" <> " 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 <> " <code from your contact>")
|
||||
viewContactCode ct = viewSecurityCode (ttyContact' ct) ("/verify " <> viewContactName ct <> " <code from your contact>")
|
||||
|
||||
viewGroupMemberCode :: GroupInfo -> GroupMember -> Text -> Bool -> [StyledString]
|
||||
viewGroupMemberCode g m@GroupMember {localDisplayName = n} = viewSecurityCode (ttyGroup' g <> " " <> ttyMember m) ("/verify #" <> groupName' g <> " " <> n <> " <code from your contact>")
|
||||
viewGroupMemberCode g m = viewSecurityCode (ttyGroup' g <> " " <> ttyMember m) ("/verify #" <> viewGroupName g <> " " <> viewMemberName m <> " <code from your contact>")
|
||||
|
||||
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
|
||||
|
|
|
|||
|
|
@ -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 <display name> [<full name>] to change it"
|
||||
alice <## "use /p <display name> 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 <message> to send messages"
|
||||
(bob </)
|
||||
|
||||
testMultiWordProfileNames :: HasCallStack => 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' <name> 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' <message> to send messages"
|
||||
bob <## "contact 'Cath Johnson' changed to 'Cath J'"
|
||||
bob <## "use @'Cath J' <message> 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 $
|
||||
|
|
|
|||
|
|
@ -435,7 +435,7 @@ lastItemId cc = do
|
|||
showActiveUser :: HasCallStack => TestCC -> String -> Expectation
|
||||
showActiveUser cc name = do
|
||||
cc <## ("user profile: " <> name)
|
||||
cc <## "use /p <display name> [<full name>] to change it"
|
||||
cc <## "use /p <display name> to change it"
|
||||
cc <## "(the updated profile will be sent to all your contacts)"
|
||||
|
||||
connectUsers :: HasCallStack => TestCC -> TestCC -> IO ()
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
27
tests/ValidNames.hs
Normal file
27
tests/ValidNames.hs
Normal file
|
|
@ -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"
|
||||
Loading…
Add table
Reference in a new issue