diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index c92842a7b3..68c967bc92 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -2119,7 +2119,7 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM processGroupInvitation :: Contact -> GroupInvitation -> RcvMessage -> MsgMeta -> m () processGroupInvitation ct@Contact {localDisplayName = c, activeConn = Connection {customUserProfileId}} inv@GroupInvitation {fromMember = (MemberIdRole fromMemId fromRole), invitedMember = (MemberIdRole memId memRole)} msg msgMeta = do checkIntegrityCreateItem (CDDirectRcv ct) msgMeta - when (fromRole < GRAdmin || fromRole < memRole) $ throwChatError (CEGroupContactRole c) + when (fromRole < GRMember || fromRole < memRole) $ throwChatError (CEGroupContactRole c) when (fromMemId == memId) $ throwChatError CEGroupDuplicateMemberId -- [incognito] if direct connection with host is incognito, create membership using the same incognito profile gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership = GroupMember {groupMemberId}} <- withStore $ \db -> createGroupInvitation db user ct inv customUserProfileId @@ -2289,7 +2289,8 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM _ -> pure () xGrpMemNew :: GroupInfo -> GroupMember -> MemberInfo -> RcvMessage -> MsgMeta -> m () - xGrpMemNew gInfo m memInfo@(MemberInfo memId _ memberProfile) msg msgMeta = do + xGrpMemNew gInfo m memInfo@(MemberInfo memId memRole memberProfile) msg msgMeta = do + checkHostRole m memRole members <- withStore' $ \db -> getGroupMembers db user gInfo unless (sameMemberId memId $ membership gInfo) $ if isMember memId gInfo members @@ -2301,13 +2302,14 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM toView $ CRJoinedGroupMemberConnecting gInfo m newMember xGrpMemIntro :: GroupInfo -> GroupMember -> MemberInfo -> m () - xGrpMemIntro gInfo@GroupInfo {membership, chatSettings = ChatSettings {enableNtfs}} m memInfo@(MemberInfo memId _ _) = do + xGrpMemIntro gInfo@GroupInfo {membership, chatSettings = ChatSettings {enableNtfs}} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ _) = do case memberCategory m of GCHostMember -> do members <- withStore' $ \db -> getGroupMembers db user gInfo if isMember memId gInfo members then messageWarning "x.grp.mem.intro ignored: member already exists" else do + when (memberRole < GRMember) $ throwChatError (CEGroupContactRole c) -- [async agent commands] commands should be asynchronous, continuation is to send XGrpMemInv - have to remember one has completed and process on second groupConnIds <- createAgentConnectionAsync user enableNtfs SCMInvitation directConnIds <- createAgentConnectionAsync user enableNtfs SCMInvitation @@ -2336,7 +2338,8 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM _ -> messageError "x.grp.mem.inv can be only sent by invitee member" xGrpMemFwd :: GroupInfo -> GroupMember -> MemberInfo -> IntroInvitation -> m () - xGrpMemFwd gInfo@GroupInfo {membership, chatSettings = ChatSettings {enableNtfs}} m memInfo@(MemberInfo memId _ _) introInv@IntroInvitation {groupConnReq, directConnReq} = do + xGrpMemFwd gInfo@GroupInfo {membership, chatSettings = ChatSettings {enableNtfs}} m memInfo@(MemberInfo memId memRole _) introInv@IntroInvitation {groupConnReq, directConnReq} = do + checkHostRole m memRole members <- withStore' $ \db -> getGroupMembers db user gInfo toMember <- case find (sameMemberId memId) members of -- TODO if the missed messages are correctly sent as soon as there is connection before anything else is sent @@ -2354,6 +2357,10 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM let customUserProfileId = if memberIncognito membership then Just (localProfileId $ memberProfile membership) else Nothing withStore' $ \db -> createIntroToMemberContact db user m toMember groupConnIds directConnIds customUserProfileId + checkHostRole :: GroupMember -> GroupMemberRole -> m () + checkHostRole GroupMember {memberRole, localDisplayName} memRole = + when (memberRole < GRMember || memberRole < memRole) $ throwChatError (CEGroupContactRole localDisplayName) + xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> RcvMessage -> MsgMeta -> m () xGrpMemDel gInfo@GroupInfo {membership} m memId msg msgMeta = do members <- withStore' $ \db -> getGroupMembers db user gInfo @@ -2934,10 +2941,13 @@ chatCommandP = filePath = T.unpack . safeDecodeUtf8 <$> A.takeByteString searchP = T.unpack . safeDecodeUtf8 <$> (" search=" *> A.takeByteString) memberRole = - (" owner" $> GROwner) - <|> (" admin" $> GRAdmin) - <|> (" member" $> GRMember) - <|> pure GRAdmin + A.choice + [ " owner" $> GROwner, + " admin" $> GRAdmin, + " member" $> GRMember, + -- " author" $> GRAuthor, + pure GRAdmin + ] chatNameP = ChatName <$> chatTypeP <*> displayName chatNameP' = ChatName <$> (chatTypeP <|> pure CTDirect) <*> displayName chatRefP = ChatRef <$> chatTypeP <*> A.decimal diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 7f21fe97b7..8d635ac34f 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -420,7 +420,11 @@ fromInvitedBy userCtId = \case IBContact ctId -> Just ctId IBUser -> Just userCtId -data GroupMemberRole = GRMember | GRAdmin | GROwner +data GroupMemberRole + = GRAuthor -- can send messages to all group members + | GRMember -- + add new members with role Member and below + | GRAdmin -- + change member roles (excl. Owners), add Admins, remove members (excl. Owners) + | GROwner -- + delete and change group information, add/remove/change roles for Owners deriving (Eq, Show, Ord) instance FromField GroupMemberRole where fromField = fromBlobField_ strDecode @@ -432,10 +436,12 @@ instance StrEncoding GroupMemberRole where GROwner -> "owner" GRAdmin -> "admin" GRMember -> "member" + GRAuthor -> "author" strDecode = \case "owner" -> Right GROwner "admin" -> Right GRAdmin "member" -> Right GRMember + "author" -> Right GRAuthor r -> Left $ "bad GroupMemberRole " <> B.unpack r strP = strDecode <$?> A.takeByteString diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 75dc6fad02..55b67df6fc 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -2382,7 +2382,7 @@ testSetConnectionAlias = testChat2 aliceProfile bobProfile $ \alice bob -> do alice ##> "/c" inv <- getInvitation alice - alice @@@ [(":1","")] + alice @@@ [(":1", "")] alice ##> "/_set alias :1 friend" alice <## "connection 1 alias updated: friend" bob ##> ("/c " <> inv) @@ -2390,7 +2390,7 @@ testSetConnectionAlias = testChat2 aliceProfile bobProfile $ concurrently_ (alice <## ("bob (Bob): contact is connected")) (bob <## ("alice (Alice): contact is connected")) - alice @@@ [("@bob","")] + alice @@@ [("@bob", "")] alice ##> "/cs" alice <## "bob (Bob) (alias: friend)"