diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index c4b34666d..c70c842c0 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1510,13 +1510,15 @@ processChatCommand = \case chatRef <- getChatRef user chatName chatItemId <- getChatItemIdByText user chatRef msg processChatCommand $ APIChatItemReaction chatRef chatItemId add reaction - APINewGroup userId gProfile@GroupProfile {displayName} -> withUserId userId $ \user -> do + APINewGroup userId incognito gProfile@GroupProfile {displayName} -> withUserId userId $ \user -> do checkValidName displayName gVar <- asks idsDrg - groupInfo <- withStore $ \db -> createNewGroup db gVar user gProfile + -- [incognito] generate incognito profile for group membership + incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing + groupInfo <- withStore $ \db -> createNewGroup db gVar user gProfile incognitoProfile pure $ CRGroupCreated user groupInfo - NewGroup gProfile -> withUser $ \User {userId} -> - processChatCommand $ APINewGroup userId gProfile + NewGroup incognito gProfile -> withUser $ \User {userId} -> + processChatCommand $ APINewGroup userId incognito gProfile APIAddMember groupId contactId memRole -> withUser $ \user -> withChatLock "addMember" $ do -- TODO for large groups: no need to load all members to determine if contact is a member (group, contact) <- withStore $ \db -> (,) <$> getGroup db user groupId <*> getContact db user contactId @@ -5714,8 +5716,8 @@ chatCommandP = ("/help settings" <|> "/hs") $> ChatHelp HSSettings, ("/help db" <|> "/hd") $> ChatHelp HSDatabase, ("/help" <|> "/h") $> ChatHelp HSMain, - ("/group " <|> "/g ") *> char_ '#' *> (NewGroup <$> groupProfile), - "/_group " *> (APINewGroup <$> A.decimal <* A.space <*> jsonP), + ("/group" <|> "/g") *> (NewGroup <$> incognitoP <* A.space <* char_ '#' <*> groupProfile), + "/_group " *> (APINewGroup <$> A.decimal <*> incognitoOnOffP <* A.space <*> jsonP), ("/add " <|> "/a ") *> char_ '#' *> (AddMember <$> displayName <* A.space <* char_ '@' <*> displayName <*> (memberRole <|> pure GRMember)), ("/join " <|> "/j ") *> char_ '#' *> (JoinGroup <$> displayName), ("/member role " <|> "/mr ") *> char_ '#' *> (MemberRole <$> displayName <* A.space <* char_ '@' <*> displayName <*> memberRole), diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index d8851ad87..74501ad1e 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -363,8 +363,8 @@ data ChatCommand | EditMessage {chatName :: ChatName, editedMsg :: Text, message :: Text} | UpdateLiveMessage {chatName :: ChatName, chatItemId :: ChatItemId, liveMessage :: Bool, message :: Text} | ReactToMessage {add :: Bool, reaction :: MsgReaction, chatName :: ChatName, reactToMessage :: Text} - | APINewGroup UserId GroupProfile - | NewGroup GroupProfile + | APINewGroup UserId IncognitoEnabled GroupProfile + | NewGroup IncognitoEnabled GroupProfile | AddMember GroupName ContactName GroupMemberRole | JoinGroup GroupName | MemberRole GroupName ContactName GroupMemberRole diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index 563cc337e..477361acd 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -193,17 +193,6 @@ createIncognitoProfile db User {userId} p = do createdAt <- getCurrentTime createIncognitoProfile_ db userId createdAt p -createIncognitoProfile_ :: DB.Connection -> UserId -> UTCTime -> Profile -> IO Int64 -createIncognitoProfile_ db userId createdAt Profile {displayName, fullName, image} = do - DB.execute - db - [sql| - INSERT INTO contact_profiles (display_name, full_name, image, user_id, incognito, created_at, updated_at) - VALUES (?,?,?,?,?,?,?) - |] - (displayName, fullName, image, userId, Just True, createdAt, createdAt) - insertedRowId db - createDirectContact :: DB.Connection -> User -> Connection -> Profile -> ExceptT StoreError IO Contact createDirectContact db user@User {userId} activeConn@Connection {connId, localAlias} p@Profile {preferences} = do createdAt <- liftIO getCurrentTime diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 76d68cc6b..0b296b17e 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -283,11 +283,12 @@ getGroupAndMember db User {userId, userContactId} groupMemberId = in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection connRow}) -- | creates completely new group with a single member - the current user -createNewGroup :: DB.Connection -> TVar ChaChaDRG -> User -> GroupProfile -> ExceptT StoreError IO GroupInfo -createNewGroup db gVar user@User {userId} groupProfile = ExceptT $ do +createNewGroup :: DB.Connection -> TVar ChaChaDRG -> User -> GroupProfile -> Maybe Profile -> ExceptT StoreError IO GroupInfo +createNewGroup db gVar user@User {userId} groupProfile incognitoProfile = ExceptT $ do let GroupProfile {displayName, fullName, description, image, groupPreferences} = groupProfile fullGroupPreferences = mergeGroupPreferences groupPreferences currentTs <- getCurrentTime + customUserProfileId <- mapM (createIncognitoProfile_ db userId currentTs) incognitoProfile withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do groupId <- liftIO $ do DB.execute @@ -301,7 +302,7 @@ createNewGroup db gVar user@User {userId} groupProfile = ExceptT $ do (ldn, userId, profileId, True, currentTs, currentTs, currentTs) insertedRowId db memberId <- liftIO $ encodedRandomBytes gVar 12 - membership <- createContactMemberInv_ db user groupId user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser Nothing currentTs + membership <- createContactMemberInv_ db user groupId user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser customUserProfileId currentTs let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False} pure GroupInfo {groupId, localDisplayName = ldn, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = Nothing, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs} diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 2a90b54d7..2ad447aa8 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -184,6 +184,17 @@ createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange where ent ct = if connType == ct then entityId else Nothing +createIncognitoProfile_ :: DB.Connection -> UserId -> UTCTime -> Profile -> IO Int64 +createIncognitoProfile_ db userId createdAt Profile {displayName, fullName, image} = do + DB.execute + db + [sql| + INSERT INTO contact_profiles (display_name, full_name, image, user_id, incognito, created_at, updated_at) + VALUES (?,?,?,?,?,?,?) + |] + (displayName, fullName, image, userId, Just True, createdAt, createdAt) + insertedRowId db + setPeerChatVRange :: DB.Connection -> Int64 -> VersionRange -> IO () setPeerChatVRange db connId (VersionRange minVer maxVer) = DB.execute diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 07cbec601..7f1e1f5c7 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -132,7 +132,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView CRUserContactLink u UserContactLink {connReqContact, autoAccept} -> ttyUser u $ connReqContact_ "Your chat address:" connReqContact <> autoAcceptStatus_ autoAccept CRUserContactLinkUpdated u UserContactLink {autoAccept} -> ttyUser u $ autoAcceptStatus_ autoAccept CRContactRequestRejected u UserContactRequest {localDisplayName = c} -> ttyUser u [ttyContact c <> ": contact request rejected"] - CRGroupCreated u g -> ttyUser u $ viewGroupCreated g + CRGroupCreated u g -> ttyUser u $ viewGroupCreated g testView CRGroupMembers u g -> ttyUser u $ viewGroupMembers g CRGroupsList u gs -> ttyUser u $ viewGroupsList gs CRSentGroupInvitation u g c _ -> @@ -792,11 +792,22 @@ viewReceivedContactRequest c Profile {fullName} = "to reject: " <> highlight ("/rc " <> viewName c) <> " (the sender will NOT be notified)" ] -viewGroupCreated :: GroupInfo -> [StyledString] -viewGroupCreated g = - [ "group " <> ttyFullGroup g <> " is created", - "to add members use " <> highlight ("/a " <> viewGroupName g <> " ") <> " or " <> highlight ("/create link #" <> viewGroupName g) - ] +viewGroupCreated :: GroupInfo -> Bool -> [StyledString] +viewGroupCreated g testView = + case incognitoMembershipProfile g of + Just localProfile + | testView -> incognitoProfile' profile : message + | otherwise -> message + where + profile = fromLocalProfile localProfile + message = + [ "group " <> ttyFullGroup g <> " is created, your incognito profile for this group is " <> incognitoProfile' profile, + "to add members use " <> highlight ("/create link #" <> viewGroupName g) + ] + Nothing -> + [ "group " <> ttyFullGroup g <> " is created", + "to add members use " <> highlight ("/a " <> viewGroupName g <> " ") <> " or " <> highlight ("/create link #" <> viewGroupName g) + ] viewCannotResendInvitation :: GroupInfo -> ContactName -> [StyledString] viewCannotResendInvitation g c = @@ -1672,7 +1683,7 @@ viewChatError logLevel = \case _ -> ": you have insufficient permissions for this action, the required role is " <> plain (strEncode role) CEGroupMemberInitialRole g role -> [ttyGroup' g <> ": initial role for group member cannot be " <> plain (strEncode role) <> ", use member or observer"] 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"] + CEGroupIncognitoCantInvite -> ["you are using an incognito profile for this group - 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 #" <> viewGroupName g)] CEGroupMemberNotActive -> ["your group connection is not active yet, try later"] diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 7a8b1368b..97b749106 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -23,6 +23,7 @@ chatGroupTests = do describe "chat groups" $ do it "add contacts, create group and send/receive messages" testGroup it "add contacts, create group and send/receive messages, check messages" testGroupCheckMessages + it "create group with incognito membership" testNewGroupIncognito it "create and join group with 4 members" testGroup2 it "create and delete group" testGroupDelete it "create group with the same displayName" testGroupSameName @@ -277,6 +278,56 @@ testGroupShared alice bob cath checkMessages = do alice #$> ("/_unread chat #1 on", id, "ok") alice #$> ("/_unread chat #1 off", id, "ok") +testNewGroupIncognito :: HasCallStack => FilePath -> IO () +testNewGroupIncognito = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + connectUsers alice bob + + -- alice creates group with incognito membership + alice ##> "/g i team" + aliceIncognito <- getTermLine alice + alice <## ("group #team is created, your incognito profile for this group is " <> aliceIncognito) + alice <## "to add members use /create link #team" + + -- alice invites bob + alice ##> "/a team bob" + alice <## "you are using an incognito profile for this group - prohibited to invite contacts" + + alice ##> "/create link #team" + gLink <- getGroupLink alice "team" GRMember True + bob ##> ("/c " <> gLink) + bob <## "connection request sent!" + alice <## "bob_1 (Bob): accepting request to join group #team..." + _ <- getTermLine alice + concurrentlyN_ + [ do + alice <## ("bob_1 (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognito) + alice <## "use /i bob_1 to print out this incognito profile again" + alice <## "bob_1 invited to group #team via your group link" + alice <## "#team: bob_1 joined the group", + do + bob <## (aliceIncognito <> ": contact is connected") + bob <## "#team: you joined the group" + ] + + alice <##> bob + + alice ?#> "@bob_1 hi, I'm incognito" + bob <# (aliceIncognito <> "> hi, I'm incognito") + bob #> ("@" <> aliceIncognito <> " hey, I'm bob") + alice ?<# "bob_1> hey, I'm bob" + + alice ?#> "#team hello" + bob <# ("#team " <> aliceIncognito <> "> hello") + bob #> "#team hi there" + alice ?<# "#team bob_1> hi there" + + alice ##> "/gs" + alice <## "i #team (2 members)" + bob ##> "/gs" + bob <## "#team (2 members)" + testGroup2 :: HasCallStack => FilePath -> IO () testGroup2 = testChatCfg4 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile danProfile $ diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index 68b925342..d806290d6 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -1085,7 +1085,7 @@ testJoinGroupIncognito = ] -- cath cannot invite to the group because her membership is incognito cath ##> "/a secret_club dan" - cath <## "you've connected to this group using an incognito profile - prohibited to invite contacts" + cath <## "you are using an incognito profile for this group - prohibited to invite contacts" -- alice invites dan alice ##> "/a secret_club dan admin" concurrentlyN_