core: create new group with incognito membership (#3277)

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} ->
+  NewGroup incognito gProfile -> withUser $ \User {userId} ->
-    processChatCommand $ APINewGroup userId gProfile
+    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" <|> "/g") *> (NewGroup <$> incognitoP <* A.space <* char_ '#' <*> groupProfile),
-      "/_group " *> (APINewGroup <$> A.decimal <* A.space <*> jsonP),
+      "/_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),

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
+  | APINewGroup UserId IncognitoEnabled GroupProfile
-  | NewGroup GroupProfile
+  | NewGroup IncognitoEnabled GroupProfile
   | AddMember GroupName ContactName GroupMemberRole
   | JoinGroup GroupName
   | MemberRole GroupName ContactName GroupMemberRole

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

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.Connection -> TVar ChaChaDRG -> User -> GroupProfile -> Maybe Profile -> ExceptT StoreError IO GroupInfo
-createNewGroup db gVar user@User {userId} groupProfile = ExceptT $ do
+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}
 

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

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 :: GroupInfo -> Bool -> [StyledString]
-viewGroupCreated g =
+viewGroupCreated g testView =
-  [ "group " <> ttyFullGroup g <> " is created",
+  case incognitoMembershipProfile g of
-    "to add members use " <> highlight ("/a " <> viewGroupName g <> " <name>") <> " or " <> highlight ("/create link #" <> viewGroupName g)
+    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 <> " <name>") <> " 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"]

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 $

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_