core: author role, allow member to add new members on the receiving end (#1149)

* core: author role, allow member to add new members on the receiving end

* remove unused name

* remove author role from parser

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

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
 

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)"