core: initial group member role when joining via link (#1975)

* core: initial group member role when joining via link

* fix tests

* set role when joining group via link, enable observer test

* show group link when role changes

* amend test

* check role is member or observer when creating a link

simplex-chat.cabal

@@ -84,6 +84,7 @@ library
       Simplex.Chat.Migrations.M20230118_recreate_smp_servers
       Simplex.Chat.Migrations.M20230129_drop_chat_items_group_idx
       Simplex.Chat.Migrations.M20230206_item_deleted_by_group_member_id
+      Simplex.Chat.Migrations.M20230303_group_link_role
       Simplex.Chat.Mobile
       Simplex.Chat.Mobile.WebRTC
       Simplex.Chat.Options

src/Simplex/Chat.hs

@@ -1191,25 +1191,36 @@ processChatCommand = \case
     CRGroupProfile user <$> withStore (\db -> getGroupInfoByName db user gName)
   UpdateGroupDescription gName description ->
     updateGroupProfileByName gName $ \p -> p {description}
-  APICreateGroupLink groupId -> withUser $ \user -> withChatLock "createGroupLink" $ do
+  APICreateGroupLink groupId mRole -> withUser $ \user -> withChatLock "createGroupLink" $ do
     gInfo <- withStore $ \db -> getGroupInfo db user groupId
     assertUserGroupRole gInfo GRAdmin
+    when (mRole > GRMember) $ throwChatError $ CEGroupMemberInitialRole gInfo mRole
     groupLinkId <- GroupLinkId <$> (asks idsDrg >>= liftIO . (`randomBytes` 16))
     let crClientData = encodeJSON $ CRDataGroup groupLinkId
     (connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact $ Just crClientData
-    withStore $ \db -> createGroupLink db user gInfo connId cReq groupLinkId
+    withStore $ \db -> createGroupLink db user gInfo connId cReq groupLinkId mRole
-    pure $ CRGroupLinkCreated user gInfo cReq
+    pure $ CRGroupLinkCreated user gInfo cReq mRole
+  APIGroupLinkMemberRole groupId mRole' -> withUser $ \user -> withChatLock "groupLinkMemberRole " $ do
+    gInfo <- withStore $ \db -> getGroupInfo db user groupId
+    (groupLinkId, groupLink, mRole) <- withStore $ \db -> getGroupLink db user gInfo
+    assertUserGroupRole gInfo GRAdmin
+    when (mRole' > GRMember) $ throwChatError $ CEGroupMemberInitialRole gInfo mRole'
+    when (mRole' /= mRole) $ withStore' $ \db -> setGroupLinkMemberRole db user groupLinkId mRole'
+    pure $ CRGroupLink user gInfo groupLink mRole'
   APIDeleteGroupLink groupId -> withUser $ \user -> withChatLock "deleteGroupLink" $ do
     gInfo <- withStore $ \db -> getGroupInfo db user groupId
     deleteGroupLink' user gInfo
     pure $ CRGroupLinkDeleted user gInfo
   APIGetGroupLink groupId -> withUser $ \user -> do
     gInfo <- withStore $ \db -> getGroupInfo db user groupId
-    groupLink <- withStore $ \db -> getGroupLink db user gInfo
+    (_, groupLink, mRole) <- withStore $ \db -> getGroupLink db user gInfo
-    pure $ CRGroupLink user gInfo groupLink
+    pure $ CRGroupLink user gInfo groupLink mRole
-  CreateGroupLink gName -> withUser $ \user -> do
+  CreateGroupLink gName mRole -> withUser $ \user -> do
     groupId <- withStore $ \db -> getGroupIdByName db user gName
-    processChatCommand $ APICreateGroupLink groupId
+    processChatCommand $ APICreateGroupLink groupId mRole
+  GroupLinkMemberRole gName mRole -> withUser $ \user -> do
+    groupId <- withStore $ \db -> getGroupIdByName db user gName
+    processChatCommand $ APIGroupLinkMemberRole groupId mRole
   DeleteGroupLink gName -> withUser $ \user -> do
     groupId <- withStore $ \db -> getGroupIdByName db user gName
     processChatCommand $ APIDeleteGroupLink groupId
@@ -2213,7 +2224,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
               forM_ groupLinkId $ \_ -> probeMatchingContacts ct $ contactConnIncognito ct
               forM_ viaUserContactLink $ \userContactLinkId ->
                 withStore' (\db -> getUserContactLinkById db userId userContactLinkId) >>= \case
-                  Just (UserContactLink {autoAccept = Just AutoAccept {autoReply = mc_}}, groupId_) -> do
+                  Just (UserContactLink {autoAccept = Just AutoAccept {autoReply = mc_}}, groupId_, gLinkMemRole) -> do
                     forM_ mc_ $ \mc -> do
                       (msg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing))
                       ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc)
@@ -2221,7 +2232,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
                     forM_ groupId_ $ \groupId -> do
                       gVar <- asks idsDrg
                       groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation
-                      withStore $ \db -> createNewContactMemberAsync db gVar user groupId ct GRMember groupConnIds
+                      withStore $ \db -> createNewContactMemberAsync db gVar user groupId ct gLinkMemRole groupConnIds
                   _ -> pure ()
             Just (gInfo@GroupInfo {membership}, m@GroupMember {activeConn}) ->
               when (maybe False ((== ConnReady) . connStatus) activeConn) $ do
@@ -2578,7 +2589,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
             CORContact contact -> toView $ CRContactRequestAlreadyAccepted user contact
             CORRequest cReq@UserContactRequest {localDisplayName} -> do
               withStore' (\db -> getUserContactLinkById db userId userContactLinkId) >>= \case
-                Just (UserContactLink {autoAccept}, groupId_) ->
+                Just (UserContactLink {autoAccept}, groupId_, _) ->
                   case autoAccept of
                     Just AutoAccept {acceptIncognito} -> case groupId_ of
                       Nothing -> do
@@ -4045,7 +4056,7 @@ chatCommandP =
       ("/help" <|> "/h") $> ChatHelp HSMain,
       ("/group " <|> "/g ") *> char_ '#' *> (NewGroup <$> groupProfile),
       "/_group " *> (APINewGroup <$> A.decimal <* A.space <*> jsonP),
-      ("/add " <|> "/a ") *> char_ '#' *> (AddMember <$> displayName <* A.space <* char_ '@' <*> displayName <*> memberRole),
+      ("/add " <|> "/a ") *> char_ '#' *> (AddMember <$> displayName <* A.space <* char_ '@' <*> displayName <*> (memberRole <|> pure GRAdmin)),
       ("/join " <|> "/j ") *> char_ '#' *> (JoinGroup <$> displayName),
       ("/member role " <|> "/mr ") *> char_ '#' *> (MemberRole <$> displayName <* A.space <* char_ '@' <*> displayName <*> memberRole),
       ("/remove " <|> "/rm ") *> char_ '#' *> (RemoveMember <$> displayName <* A.space <* char_ '@' <*> displayName),
@@ -4060,10 +4071,12 @@ chatCommandP =
       ("/group_profile " <|> "/gp ") *> char_ '#' *> (UpdateGroupNames <$> displayName <* A.space <*> groupProfile),
       ("/group_profile " <|> "/gp ") *> char_ '#' *> (ShowGroupProfile <$> displayName),
       "/group_descr " *> char_ '#' *> (UpdateGroupDescription <$> displayName <*> optional (A.space *> msgTextP)),
-      "/_create link #" *> (APICreateGroupLink <$> A.decimal),
+      "/_create link #" *> (APICreateGroupLink <$> A.decimal <*> (memberRole <|> pure GRMember)),
+      "/_set link role #" *> (APIGroupLinkMemberRole <$> A.decimal <*> memberRole),
       "/_delete link #" *> (APIDeleteGroupLink <$> A.decimal),
       "/_get link #" *> (APIGetGroupLink <$> A.decimal),
-      "/create link #" *> (CreateGroupLink <$> displayName),
+      "/create link #" *> (CreateGroupLink <$> displayName <*> (memberRole <|> pure GRMember)),
+      "/set link role #" *> (GroupLinkMemberRole <$> displayName <*> memberRole),
       "/delete link #" *> (DeleteGroupLink <$> displayName),
       "/show link #" *> (ShowGroupLink <$> displayName),
       (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <*> pure Nothing <*> quotedMsg <*> msgTextP),
@@ -4173,8 +4186,7 @@ chatCommandP =
         [ " owner" $> GROwner,
           " admin" $> GRAdmin,
           " member" $> GRMember,
-          -- " observer" $> GRObserver,
+          " observer" $> GRObserver
-          pure GRAdmin
         ]
     chatNameP = ChatName <$> chatTypeP <*> displayName
     chatNameP' = ChatName <$> (chatTypeP <|> pure CTDirect) <*> displayName

src/Simplex/Chat/Controller.hs

@@ -237,7 +237,8 @@ data ChatCommand
   | APILeaveGroup GroupId
   | APIListMembers GroupId
   | APIUpdateGroupProfile GroupId GroupProfile
-  | APICreateGroupLink GroupId
+  | APICreateGroupLink GroupId GroupMemberRole
+  | APIGroupLinkMemberRole GroupId GroupMemberRole
   | APIDeleteGroupLink GroupId
   | APIGetGroupLink GroupId
   | APIGetUserSMPServers UserId
@@ -317,7 +318,8 @@ data ChatCommand
   | UpdateGroupNames GroupName GroupProfile
   | ShowGroupProfile GroupName
   | UpdateGroupDescription GroupName (Maybe Text)
-  | CreateGroupLink GroupName
+  | CreateGroupLink GroupName GroupMemberRole
+  | GroupLinkMemberRole GroupName GroupMemberRole
   | DeleteGroupLink GroupName
   | ShowGroupLink GroupName
   | SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, quotedMsg :: Text, message :: Text}
@@ -455,8 +457,8 @@ data ChatResponse
   | CRGroupDeleted {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
   | CRGroupUpdated {user :: User, fromGroup :: GroupInfo, toGroup :: GroupInfo, member_ :: Maybe GroupMember}
   | CRGroupProfile {user :: User, groupInfo :: GroupInfo}
-  | CRGroupLinkCreated {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact}
+  | CRGroupLinkCreated {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact, memberRole :: GroupMemberRole}
-  | CRGroupLink {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact}
+  | CRGroupLink {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact, memberRole :: GroupMemberRole}
   | CRGroupLinkDeleted {user :: User, groupInfo :: GroupInfo}
   | CRAcceptingGroupJoinRequest {user :: User, groupInfo :: GroupInfo, contact :: Contact}
   | CRMemberSubError {user :: User, groupInfo :: GroupInfo, member :: GroupMember, chatError :: ChatError}
@@ -685,6 +687,7 @@ data ChatErrorType
   | CEContactDisabled {contact :: Contact}
   | CEConnectionDisabled {connection :: Connection}
   | CEGroupUserRole {groupInfo :: GroupInfo, requiredRole :: GroupMemberRole}
+  | CEGroupMemberInitialRole {groupInfo :: GroupInfo, initialRole :: GroupMemberRole}
   | CEContactIncognitoCantInvite
   | CEGroupIncognitoCantInvite
   | CEGroupContactRole {contactName :: ContactName}

src/Simplex/Chat/Help.hs

@@ -132,7 +132,12 @@ groupsHelpInfo =
       indent <> highlight "/group_descr <group> [<descr>]     " <> " - update/remove group description",
       indent <> highlight "/groups                            " <> " - list groups",
       indent <> highlight "#<group> <message>                 " <> " - send message to group",
-      indent <> highlight "/create link #<group>              " <> " - create public group link",
+      "",
+      green "Public group links:",
+      indent <> highlight "/create link #<group> [role]       " <> " - create public group link (with optional role, default: member)",
+      indent <> highlight "/set link role #<group> role       " <> " - change role assigned to the users joining via the link (member/observer)",
+      indent <> highlight "/show link #<group>                " <> " - show public group link and initial member role",
+      indent <> highlight "/delete link #<group>              " <> " - delete link to join the group (does NOT delete any members)",
       "",
       green "Mute group messages:",
       indent <> highlight "/mute #<group>                     " <> " - do not show contact's messages",

src/Simplex/Chat/Migrations/M20230303_group_link_role.hs

@@ -0,0 +1,12 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20230303_group_link_role where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20230303_group_link_role :: Query
+m20230303_group_link_role =
+  [sql|
+ALTER TABLE user_contact_links ADD COLUMN group_link_member_role TEXT NULL; -- member or observer
+|]

src/Simplex/Chat/Migrations/chat_schema.sql

@@ -282,6 +282,7 @@ CREATE TABLE user_contact_links(
   group_id INTEGER REFERENCES groups ON DELETE CASCADE,
   auto_accept_incognito INTEGER DEFAULT 0 CHECK(auto_accept_incognito NOT NULL),
   group_link_id BLOB,
+  group_link_member_role TEXT NULL,
   UNIQUE(user_id, local_display_name)
 );
 CREATE TABLE contact_requests(

src/Simplex/Chat/Store.hs

@@ -75,6 +75,7 @@ module Simplex.Chat.Store
     deleteGroupLink,
     getGroupLink,
     getGroupLinkId,
+    setGroupLinkMemberRole,
     createOrUpdateContactRequest,
     getContactRequest',
     getContactRequest,
@@ -341,6 +342,7 @@ import Simplex.Chat.Migrations.M20230117_fkey_indexes
 import Simplex.Chat.Migrations.M20230118_recreate_smp_servers
 import Simplex.Chat.Migrations.M20230129_drop_chat_items_group_idx
 import Simplex.Chat.Migrations.M20230206_item_deleted_by_group_member_id
+import Simplex.Chat.Migrations.M20230303_group_link_role
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
 import Simplex.Chat.Util (week)
@@ -406,7 +408,8 @@ schemaMigrations =
     ("20230117_fkey_indexes", m20230117_fkey_indexes),
     ("20230118_recreate_smp_servers", m20230118_recreate_smp_servers),
     ("20230129_drop_chat_items_group_idx", m20230129_drop_chat_items_group_idx),
-    ("20230206_item_deleted_by_group_member_id", m20230206_item_deleted_by_group_member_id)
+    ("20230206_item_deleted_by_group_member_id", m20230206_item_deleted_by_group_member_id),
+    ("20230303_group_link_role", m20230303_group_link_role)
   ]
 
 -- | The list of migrations in ascending order by date
@@ -1086,13 +1089,13 @@ getUserAddress db User {userId} =
       |]
       (Only userId)
 
-getUserContactLinkById :: DB.Connection -> UserId -> Int64 -> IO (Maybe (UserContactLink, Maybe GroupId))
+getUserContactLinkById :: DB.Connection -> UserId -> Int64 -> IO (Maybe (UserContactLink, Maybe GroupId, GroupMemberRole))
 getUserContactLinkById db userId userContactLinkId =
-  maybeFirstRow (\(ucl :. Only groupId_) -> (toUserContactLink ucl, groupId_)) $
+  maybeFirstRow (\(ucl :. (groupId_, mRole_)) -> (toUserContactLink ucl, groupId_, fromMaybe GRMember mRole_)) $
     DB.query
       db
       [sql|
-        SELECT conn_req_contact, auto_accept, auto_accept_incognito, auto_reply_msg_content, group_id
+        SELECT conn_req_contact, auto_accept, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role
         FROM user_contact_links
         WHERE user_id = ?
           AND user_contact_link_id = ?
@@ -1117,14 +1120,14 @@ updateUserAddressAutoAccept db user@User {userId} autoAccept = do
       Just AutoAccept {acceptIncognito, autoReply} -> (True, acceptIncognito, autoReply)
       _ -> (False, False, Nothing)
 
-createGroupLink :: DB.Connection -> User -> GroupInfo -> ConnId -> ConnReqContact -> GroupLinkId -> ExceptT StoreError IO ()
+createGroupLink :: DB.Connection -> User -> GroupInfo -> ConnId -> ConnReqContact -> GroupLinkId -> GroupMemberRole -> ExceptT StoreError IO ()
-createGroupLink db User {userId} groupInfo@GroupInfo {groupId, localDisplayName} agentConnId cReq groupLinkId =
+createGroupLink db User {userId} groupInfo@GroupInfo {groupId, localDisplayName} agentConnId cReq groupLinkId memberRole =
   checkConstraint (SEDuplicateGroupLink groupInfo) . liftIO $ do
     currentTs <- getCurrentTime
     DB.execute
       db
-      "INSERT INTO user_contact_links (user_id, group_id, group_link_id, local_display_name, conn_req_contact, auto_accept, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
+      "INSERT INTO user_contact_links (user_id, group_id, group_link_id, local_display_name, conn_req_contact, group_link_member_role, auto_accept, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
-      (userId, groupId, groupLinkId, "group_link_" <> localDisplayName, cReq, True, currentTs, currentTs)
+      (userId, groupId, groupLinkId, "group_link_" <> localDisplayName, cReq, memberRole, True, currentTs, currentTs)
     userContactLinkId <- insertedRowId db
     void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId Nothing Nothing Nothing 0 currentTs
 
@@ -1182,16 +1185,22 @@ deleteGroupLink db User {userId} GroupInfo {groupId} = do
     (userId, groupId)
   DB.execute db "DELETE FROM user_contact_links WHERE user_id = ? AND group_id = ?" (userId, groupId)
 
-getGroupLink :: DB.Connection -> User -> GroupInfo -> ExceptT StoreError IO ConnReqContact
+getGroupLink :: DB.Connection -> User -> GroupInfo -> ExceptT StoreError IO (Int64, ConnReqContact, GroupMemberRole)
 getGroupLink db User {userId} gInfo@GroupInfo {groupId} =
-  ExceptT . firstRow fromOnly (SEGroupLinkNotFound gInfo) $
+  ExceptT . firstRow groupLink (SEGroupLinkNotFound gInfo) $
-    DB.query db "SELECT conn_req_contact FROM user_contact_links WHERE user_id = ? AND group_id = ? LIMIT 1" (userId, groupId)
+    DB.query db "SELECT user_contact_link_id, conn_req_contact, group_link_member_role FROM user_contact_links WHERE user_id = ? AND group_id = ? LIMIT 1" (userId, groupId)
+  where
+    groupLink (linkId, cReq, mRole_) = (linkId, cReq, fromMaybe GRMember mRole_)
 
 getGroupLinkId :: DB.Connection -> User -> GroupInfo -> IO (Maybe GroupLinkId)
 getGroupLinkId db User {userId} GroupInfo {groupId} =
   fmap join . maybeFirstRow fromOnly $
     DB.query db "SELECT group_link_id FROM user_contact_links WHERE user_id = ? AND group_id = ? LIMIT 1" (userId, groupId)
 
+setGroupLinkMemberRole :: DB.Connection -> User -> Int64 -> GroupMemberRole -> IO ()
+setGroupLinkMemberRole db User {userId} userContactLinkId memberRole =
+  DB.execute db "UPDATE user_contact_links SET group_link_member_role = ? WHERE user_id = ? AND user_contact_link_id = ?" (memberRole, userId, userContactLinkId)
+
 createOrUpdateContactRequest :: DB.Connection -> User -> Int64 -> InvitationId -> Profile -> Maybe XContactId -> ExceptT StoreError IO ContactOrRequest
 createOrUpdateContactRequest db user@User {userId} userContactLinkId invId Profile {displayName, fullName, image, preferences} xContactId_ =
   liftIO (maybeM getContact' xContactId_) >>= \case

src/Simplex/Chat/View.hs

@@ -186,8 +186,8 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
   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"]
   CRGroupUpdated u g g' m -> ttyUser u $ viewGroupUpdated g g' m
   CRGroupProfile u g -> ttyUser u $ viewGroupProfile g
-  CRGroupLinkCreated u g cReq -> ttyUser u $ groupLink_ "Group link is created!" g cReq
+  CRGroupLinkCreated u g cReq mRole -> ttyUser u $ groupLink_ "Group link is created!" g cReq mRole
-  CRGroupLink u g cReq -> ttyUser u $ groupLink_ "Group link:" g cReq
+  CRGroupLink u g cReq mRole -> ttyUser u $ groupLink_ "Group link:" g cReq mRole
   CRGroupLinkDeleted u g -> ttyUser u $ viewGroupLinkDeleted g
   CRAcceptingGroupJoinRequest _ g c -> [ttyFullContact c <> ": accepting request to join group " <> ttyGroup' g <> "..."]
   CRMemberSubError u g m e -> ttyUser u [ttyGroup' g <> " member " <> ttyMember m <> " error: " <> sShow e]
@@ -541,13 +541,13 @@ autoAcceptStatus_ = \case
     maybe [] ((["auto reply:"] <>) . ttyMsgContent) autoReply
   _ -> ["auto_accept off"]
 
-groupLink_ :: StyledString -> GroupInfo -> ConnReqContact -> [StyledString]
+groupLink_ :: StyledString -> GroupInfo -> ConnReqContact -> GroupMemberRole -> [StyledString]
-groupLink_ intro g cReq =
+groupLink_ intro g cReq mRole =
   [ intro,
     "",
     (plain . strEncode) cReq,
     "",
-    "Anybody can connect to you and join group with: " <> highlight' "/c <group_link_above>",
+    "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)"
   ]
@@ -1225,6 +1225,7 @@ viewChatError logLevel = \case
       (: []) . (ttyGroup' g <>) $ case role of
         GRAuthor -> ": you don't have permission to send messages"
         _ -> ": 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"]
     CEGroupContactRole c -> ["contact " <> ttyContact c <> " has insufficient permissions for this group action"]

tests/ChatTests/Groups.hs

@@ -46,6 +46,7 @@ chatGroupTests = do
     it "create group link, join via group link - incognito membership" testGroupLinkIncognitoMembership
     it "unused host contact is deleted after all groups with it are deleted" testGroupLinkUnusedHostContactDeleted
     it "leaving groups with unused host contacts deletes incognito profiles" testGroupLinkIncognitoUnusedHostContactsDeleted
+    it "group link member role" testGroupLinkMemberRole
 
 testGroup :: HasCallStack => SpecWith FilePath
 testGroup = versionTestMatrix3 runTestGroup
@@ -127,28 +128,27 @@ testGroupShared alice bob cath checkMessages = do
   alice <## "bob (Bob)"
   alice <## "cath (Catherine)"
   -- test observer role
-  -- to be enabled once the role is enabled in parser
+  alice ##> "/mr team bob observer"
-  -- alice ##> "/mr team bob observer"
+  concurrentlyN_
-  -- concurrentlyN_
+    [ alice <## "#team: you changed the role of bob from admin to observer",
-  --   [ alice <## "#team: you changed the role of bob from admin to observer",
+      bob <## "#team: alice changed your role from admin to observer",
-  --     bob <## "#team: alice changed your role from admin to observer",
+      cath <## "#team: alice changed the role of bob from admin to observer"
-  --     cath <## "#team: alice changed the role of bob from admin to observer"
+    ]
-  --   ]
+  bob ##> "#team hello"
-  -- bob ##> "#team hello"
+  bob <## "#team: you don't have permission to send messages"
-  -- bob <## "#team: you don't have permission to send messages to this group"
+  bob ##> "/rm team cath"
-  -- bob ##> "/rm team cath"
+  bob <## "#team: you have insufficient permissions for this action, the required role is admin"
-  -- bob <## "#team: you have insufficient permissions for this action, the required role is admin"
+  cath #> "#team hello"
-  -- cath #> "#team hello"
+  concurrentlyN_
-  -- concurrentlyN_
+    [ alice <# "#team cath> hello",
-  --   [ alice <# "#team cath> hello",
+      bob <# "#team cath> hello"
-  --     bob <# "#team cath> hello"
+    ]
-  --   ]
+  alice ##> "/mr team bob admin"
-  -- alice ##> "/mr team bob admin"
+  concurrentlyN_
-  -- concurrentlyN_
+    [ alice <## "#team: you changed the role of bob from observer to admin",
-  --   [ alice <## "#team: you changed the role of bob from observer to admin",
+      bob <## "#team: alice changed your role from observer to admin",
-  --     bob <## "#team: alice changed your role from observer to admin",
+      cath <## "#team: alice changed the role of bob from observer to admin"
-  --     cath <## "#team: alice changed the role of bob from observer to admin"
+    ]
-  --   ]
   -- remove member
   bob ##> "/rm team cath"
   concurrentlyN_
@@ -1423,14 +1423,14 @@ testGroupLink =
       alice ##> "/show link #team"
       alice <## "no group link, to create: /create link #team"
       alice ##> "/create link #team"
-      _ <- getGroupLink alice "team" True
+      _ <- getGroupLink alice "team" GRMember True
       alice ##> "/delete link #team"
       alice <## "Group link is deleted - joined members will remain connected."
       alice <## "To create a new group link use /create link #team"
       alice ##> "/create link #team"
-      gLink <- getGroupLink alice "team" True
+      gLink <- getGroupLink alice "team" GRMember True
       alice ##> "/show link #team"
-      _ <- getGroupLink alice "team" False
+      _ <- getGroupLink alice "team" GRMember False
       alice ##> "/create link #team"
       alice <## "you already have link for this group, to show: /show link #team"
       bob ##> ("/c " <> gLink)
@@ -1522,7 +1522,7 @@ testGroupLinkDeleteGroupRejoin =
       alice <## "group #team is created"
       alice <## "to add members use /a team <name> or /create link #team"
       alice ##> "/create link #team"
-      gLink <- getGroupLink alice "team" True
+      gLink <- getGroupLink alice "team" GRMember True
       bob ##> ("/c " <> gLink)
       bob <## "connection request sent!"
       alice <## "bob (Bob): accepting request to join group #team..."
@@ -1578,7 +1578,7 @@ testGroupLinkContactUsed =
       alice <## "group #team is created"
       alice <## "to add members use /a team <name> or /create link #team"
       alice ##> "/create link #team"
-      gLink <- getGroupLink alice "team" True
+      gLink <- getGroupLink alice "team" GRMember True
       bob ##> ("/c " <> gLink)
       bob <## "connection request sent!"
       alice <## "bob (Bob): accepting request to join group #team..."
@@ -1638,7 +1638,7 @@ testGroupLinkIncognitoMembership =
         (bob <## ("#team: you joined the group incognito as " <> bobIncognito))
       -- bob creates group link, cath joins
       bob ##> "/create link #team"
-      gLink <- getGroupLink bob "team" True
+      gLink <- getGroupLink bob "team" GRMember True
       cath ##> ("/c " <> gLink)
       cath <## "connection request sent!"
       bob <## "cath (Catherine): accepting request to join group #team..."
@@ -1729,7 +1729,7 @@ testGroupLinkUnusedHostContactDeleted =
       alice <## "group #team is created"
       alice <## "to add members use /a team <name> or /create link #team"
       alice ##> "/create link #team"
-      gLinkTeam <- getGroupLink alice "team" True
+      gLinkTeam <- getGroupLink alice "team" GRMember True
       bob ##> ("/c " <> gLinkTeam)
       bob <## "connection request sent!"
       alice <## "bob (Bob): accepting request to join group #team..."
@@ -1747,7 +1747,7 @@ testGroupLinkUnusedHostContactDeleted =
       alice <## "group #club is created"
       alice <## "to add members use /a club <name> or /create link #club"
       alice ##> "/create link #club"
-      gLinkClub <- getGroupLink alice "club" True
+      gLinkClub <- getGroupLink alice "club" GRMember True
       bob ##> ("/c " <> gLinkClub)
       bob <## "connection request sent!"
       alice <## "bob_1 (Bob): accepting request to join group #club..."
@@ -1822,7 +1822,7 @@ testGroupLinkIncognitoUnusedHostContactsDeleted =
       alice <## ("group #" <> group <> " is created")
       alice <## ("to add members use /a " <> group <> " <name> or /create link #" <> group)
       alice ##> ("/create link #" <> group)
-      gLinkTeam <- getGroupLink alice group True
+      gLinkTeam <- getGroupLink alice group GRMember True
       bob ##> ("/c " <> gLinkTeam)
       bobIncognito <- getTermLine bob
       bob <## "connection request sent incognito!"
@@ -1850,3 +1850,69 @@ testGroupLinkIncognitoUnusedHostContactsDeleted =
         ]
       bob ##> ("/d #" <> group)
       bob <## ("#" <> group <> ": you deleted the group")
+
+testGroupLinkMemberRole :: HasCallStack => FilePath -> IO ()
+testGroupLinkMemberRole =
+  testChat3 aliceProfile bobProfile cathProfile $
+    \alice bob cath -> do
+      alice ##> "/g team"
+      alice <## "group #team is created"
+      alice <## "to add members use /a team <name> or /create link #team"
+      alice ##> "/create link #team admin"
+      alice <## "#team: initial role for group member cannot be admin, use member or observer"
+      alice ##> "/create link #team observer"
+      gLink <- getGroupLink alice "team" GRObserver True
+      bob ##> ("/c " <> gLink)
+      bob <## "connection request sent!"
+      alice <## "bob (Bob): accepting request to join group #team..."
+      concurrentlyN_
+        [ do
+            alice <## "bob (Bob): contact is connected"
+            alice <## "bob invited to group #team via your group link"
+            alice <## "#team: bob joined the group",
+          do
+            bob <## "alice (Alice): contact is connected"
+            bob <## "#team: you joined the group"
+        ]
+      alice ##> "/set link role #team admin"
+      alice <## "#team: initial role for group member cannot be admin, use member or observer"
+      alice ##> "/set link role #team member"
+      _ <- getGroupLink alice "team" GRMember False
+      cath ##> ("/c " <> gLink)
+      cath <## "connection request sent!"
+      alice <## "cath (Catherine): accepting request to join group #team..."
+      -- if contact existed it is merged
+      concurrentlyN_
+        [ alice
+            <### [ "cath (Catherine): contact is connected",
+                   EndsWith "invited to group #team via your group link",
+                   EndsWith "joined the group"
+                 ],
+          cath
+            <### [ "alice (Alice): contact is connected",
+                   "#team: you joined the group",
+                   "#team: member bob (Bob) is connected"
+                 ],
+          do
+            bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
+            bob <## "#team: new member cath is connected"
+        ]
+      alice #> "#team hello"
+      concurrently_
+        (bob <# "#team alice> hello")
+        (cath <# "#team alice> hello")
+      cath #> "#team hello too"
+      concurrently_
+        (alice <# "#team cath> hello too")
+        (bob <# "#team cath> hello too")
+      bob ##> "#team hey"
+      bob <## "#team: you don't have permission to send messages"
+      alice ##> "/mr #team bob member"
+      alice <## "#team: you changed the role of bob from observer to member"
+      concurrently_
+        (bob <## "#team: alice changed your role from observer to member")
+        (cath <## "#team: alice changed the role of bob from observer to member")
+      bob #> "#team hey now"
+      concurrently_
+        (alice <# "#team bob> hey now")
+        (cath <# "#team bob> hey now")

tests/ChatTests/Utils.hs

@@ -323,13 +323,13 @@ getContactLink cc created = do
   cc <## "to delete it: /da (accepted contacts will remain connected)"
   pure link
 
-getGroupLink :: HasCallStack => TestCC -> String -> Bool -> IO String
+getGroupLink :: HasCallStack => TestCC -> String -> GroupMemberRole -> Bool -> IO String
-getGroupLink cc gName created = do
+getGroupLink cc gName mRole created = do
   cc <## if created then "Group link is created!" else "Group link:"
   cc <## ""
   link <- getTermLine cc
   cc <## ""
-  cc <## "Anybody can connect to you and join group with: /c <group_link_above>"
+  cc <## ("Anybody can connect to you and join group as " <> B.unpack (strEncode mRole) <> " with: /c <group_link_above>")
   cc <## ("to show it again: /show link #" <> gName)
   cc <## ("to delete it: /delete link #" <> gName <> " (joined members will remain connected to you)")
   pure link