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
2025-06-29 04:39:53 +00:00 · 2023-03-06 09:51:42 +00:00 · 2023-03-06 09:51:42 +00:00 · 7d49209f79
commit 7d49209f79
parent b2e285c2c7
10 changed files with 180 additions and 70 deletions
--- a/simplex-chat.cabal
+++ b/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
--- a/src/Simplex/Chat.hs
+++ b/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
-    pure $ CRGroupLinkCreated user gInfo cReq
+    withStore $ \db -> createGroupLink db user gInfo connId cReq groupLinkId mRole
+    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
-    pure $ CRGroupLink user gInfo groupLink
-  CreateGroupLink gName -> withUser $ \user -> do
+    (_, groupLink, mRole) <- withStore $ \db -> getGroupLink db user gInfo
+    pure $ CRGroupLink user gInfo groupLink mRole
+  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,
-          pure GRAdmin
+          " observer" $> GRObserver
        ]
    chatNameP = ChatName <$> chatTypeP <*> displayName
    chatNameP' = ChatName <$> (chatTypeP <|> pure CTDirect) <*> displayName
--- a/src/Simplex/Chat/Controller.hs
+++ b/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}
-  | CRGroupLink {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact}
+  | CRGroupLinkCreated {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact, memberRole :: GroupMemberRole}
+  | 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}
--- a/src/Simplex/Chat/Help.hs
+++ b/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",
--- a/src/Simplex/Chat/Migrations/M20230303_group_link_role.hs
+++ b/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
+|]
--- a/src/Simplex/Chat/Migrations/chat_schema.sql
+++ b/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(
--- a/src/Simplex/Chat/Store.hs
+++ b/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 User {userId} groupInfo@GroupInfo {groupId, localDisplayName} agentConnId cReq groupLinkId =
+createGroupLink :: DB.Connection -> User -> GroupInfo -> ConnId -> ConnReqContact -> GroupLinkId -> GroupMemberRole -> ExceptT StoreError IO ()
+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 (?,?,?,?,?,?,?,?)"
-      (userId, groupId, groupLinkId, "group_link_" <> localDisplayName, cReq, True, currentTs, currentTs)
+      "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, 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) $
-    DB.query db "SELECT conn_req_contact FROM user_contact_links WHERE user_id = ? AND group_id = ? LIMIT 1" (userId, groupId)
+  ExceptT . firstRow groupLink (SEGroupLinkNotFound gInfo) $
+    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
--- a/src/Simplex/Chat/View.hs
+++ b/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
-  CRGroupLink u g cReq -> ttyUser u $ groupLink_ "Group link:" g cReq
+  CRGroupLinkCreated u g cReq mRole -> ttyUser u $ groupLink_ "Group link is created!" g cReq mRole
+  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_ intro g cReq =
+groupLink_ :: StyledString -> GroupInfo -> ConnReqContact -> GroupMemberRole -> [StyledString]
+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"]
--- a/tests/ChatTests/Groups.hs
+++ b/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"
-  -- concurrentlyN_
-  --   [ alice <## "#team: you changed the role of bob 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"
-  --   ]
-  -- bob ##> "#team hello"
-  -- bob <## "#team: you don't have permission to send messages to this group"
-  -- bob ##> "/rm team cath"
-  -- bob <## "#team: you have insufficient permissions for this action, the required role is admin"
-  -- cath #> "#team hello"
-  -- concurrentlyN_
-  --   [ alice <# "#team cath> hello",
-  --     bob <# "#team cath> hello"
-  --   ]
-  -- alice ##> "/mr team bob admin"
-  -- concurrentlyN_
-  --   [ alice <## "#team: you changed the role of bob 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"
-  --   ]
+  alice ##> "/mr team bob observer"
+  concurrentlyN_
+    [ alice <## "#team: you changed the role of bob 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"
+    ]
+  bob ##> "#team hello"
+  bob <## "#team: you don't have permission to send messages"
+  bob ##> "/rm team cath"
+  bob <## "#team: you have insufficient permissions for this action, the required role is admin"
+  cath #> "#team hello"
+  concurrentlyN_
+    [ alice <# "#team cath> hello",
+      bob <# "#team cath> hello"
+    ]
+  alice ##> "/mr team bob admin"
+  concurrentlyN_
+    [ alice <## "#team: you changed the role of bob 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"
+    ]
  -- 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")
--- a/tests/ChatTests/Utils.hs
+++ b/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 cc gName created = do
+getGroupLink :: HasCallStack => TestCC -> String -> GroupMemberRole -> Bool -> IO String
+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