From f915eb2a20f6ab98b07dbc4e5fb7863c49a413ad Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Mon, 6 Mar 2023 09:51:42 +0000 Subject: [PATCH] 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 | 1 + src/Simplex/Chat.hs | 42 ++++-- src/Simplex/Chat/Controller.hs | 11 +- src/Simplex/Chat/Help.hs | 7 +- .../Migrations/M20230303_group_link_role.hs | 12 ++ src/Simplex/Chat/Migrations/chat_schema.sql | 1 + src/Simplex/Chat/Store.hs | 31 +++-- src/Simplex/Chat/View.hs | 11 +- tests/ChatTests/Groups.hs | 128 +++++++++++++----- tests/ChatTests/Utils.hs | 6 +- 10 files changed, 180 insertions(+), 70 deletions(-) create mode 100644 src/Simplex/Chat/Migrations/M20230303_group_link_role.hs diff --git a/simplex-chat.cabal b/simplex-chat.cabal index b7d7df91e..a599084ae 100644 --- 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 diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index a2c951642..6f93b314d 100644 --- 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 diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 67a905045..85511660f 100644 --- 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} diff --git a/src/Simplex/Chat/Help.hs b/src/Simplex/Chat/Help.hs index 486e9c711..7334b32a8 100644 --- a/src/Simplex/Chat/Help.hs +++ b/src/Simplex/Chat/Help.hs @@ -132,7 +132,12 @@ groupsHelpInfo = indent <> highlight "/group_descr [] " <> " - update/remove group description", indent <> highlight "/groups " <> " - list groups", indent <> highlight "# " <> " - send message to group", - indent <> highlight "/create link # " <> " - create public group link", + "", + green "Public group links:", + indent <> highlight "/create link # [role] " <> " - create public group link (with optional role, default: member)", + indent <> highlight "/set link role # role " <> " - change role assigned to the users joining via the link (member/observer)", + indent <> highlight "/show link # " <> " - show public group link and initial member role", + indent <> highlight "/delete link # " <> " - delete link to join the group (does NOT delete any members)", "", green "Mute group messages:", indent <> highlight "/mute # " <> " - do not show contact's messages", diff --git a/src/Simplex/Chat/Migrations/M20230303_group_link_role.hs b/src/Simplex/Chat/Migrations/M20230303_group_link_role.hs new file mode 100644 index 000000000..ae67e7d77 --- /dev/null +++ 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 +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index f5de4e6fb..5562bce7d 100644 --- 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( diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 19fb15106..cbd733ac0 100644 --- 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 diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index c135e59fb..b76fa97e7 100644 --- 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 ", + "Anybody can connect to you and join group as " <> showRole mRole <> " with: " <> highlight' "/c ", "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"] diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index b09cd2a0e..5b9048a62 100644 --- 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 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 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 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 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 <> " 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 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") diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index 47ebcafd1..ae2999054 100644 --- 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 " + cc <## ("Anybody can connect to you and join group as " <> B.unpack (strEncode mRole) <> " with: /c ") cc <## ("to show it again: /show link #" <> gName) cc <## ("to delete it: /delete link #" <> gName <> " (joined members will remain connected to you)") pure link