dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-06-04 21:12:05 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: protocol/commands to change member role (#1159)

Browse Source 
* core: protocol/commands to change member role

* change member roles

* add test

* correction

Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>

* add member profile to group member role events

* resend invitation when invited member role changes

* test role change with invitation, fix

* add delays to tests

* add test delay

Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>
This commit is contained in:
Evgeny Poberezkin
2022-10-03 09:00:47 +01:00
committed by GitHub
parent 841afa1e80
commit 58f6b168e6
9 changed files with 240 additions and 67 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Controller.hs
+2
View File
@@ -302,6 +302,8 @@ data ChatResponse
| CRUserJoinedGroup {groupInfo :: GroupInfo, hostMember :: GroupMember}
| CRJoinedGroupMember {groupInfo :: GroupInfo, member :: GroupMember}
| CRJoinedGroupMemberConnecting {groupInfo :: GroupInfo, hostMember :: GroupMember, member :: GroupMember}
| CRMemberRole {groupInfo :: GroupInfo, byMember :: GroupMember, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole}
| CRMemberRoleUser {groupInfo :: GroupInfo, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole}
| CRConnectedToGroupMember {groupInfo :: GroupInfo, member :: GroupMember}
| CRDeletedMember {groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember}
| CRDeletedMemberUser {groupInfo :: GroupInfo, member :: GroupMember}
src/Simplex/Chat/Messages.hs
+9 -1
View File
@@ -505,6 +505,8 @@ rcvGroupEventToText = \case
RGEMemberAdded _ p -> "added " <> profileToText p
RGEMemberConnected -> "connected"
RGEMemberLeft -> "left"
RGEMemberRole _ p r -> "role of " <> profileToText p <> ": " <> safeDecodeUtf8 (strEncode r)
RGEUserRole r -> "your role: " <> safeDecodeUtf8 (strEncode r)
RGEMemberDeleted _ p -> "removed " <> profileToText p
RGEUserDeleted -> "removed you"
RGEGroupDeleted -> "deleted group"
@@ -512,6 +514,8 @@ rcvGroupEventToText = \case
sndGroupEventToText :: SndGroupEvent -> Text
sndGroupEventToText = \case
SGEMemberRole _ p r -> "role of " <> profileToText p <> ": " <> safeDecodeUtf8 (strEncode r)
SGEUserRole r -> "your role " <> safeDecodeUtf8 (strEncode r)
SGEMemberDeleted _ p -> "removed " <> profileToText p
SGEUserLeft -> "left"
SGEGroupUpdated _ -> "group profile updated"
@@ -544,6 +548,8 @@ data RcvGroupEvent
= RGEMemberAdded {groupMemberId :: GroupMemberId, profile :: Profile} -- CRJoinedGroupMemberConnecting
| RGEMemberConnected -- CRUserJoinedGroup, CRJoinedGroupMember, CRConnectedToGroupMember
| RGEMemberLeft -- CRLeftMember
| RGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole}
| RGEUserRole {role :: GroupMemberRole}
| RGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRDeletedMember
| RGEUserDeleted -- CRDeletedMemberUser
| RGEGroupDeleted -- CRGroupDeleted
@@ -567,7 +573,9 @@ instance ToJSON DBRcvGroupEvent where
toEncoding (RGE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "RGE") v
data SndGroupEvent
= SGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRUserDeletedMember
= SGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole}
| SGEUserRole {role :: GroupMemberRole}
| SGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRUserDeletedMember
| SGEUserLeft -- CRLeftMemberUser
| SGEGroupUpdated {groupProfile :: GroupProfile} -- CRGroupUpdated
deriving (Show, Generic)
src/Simplex/Chat/Protocol.hs
+7
View File
@@ -131,6 +131,7 @@ data ChatMsgEvent
| XGrpMemInv MemberId IntroInvitation
| XGrpMemFwd MemberInfo IntroInvitation
| XGrpMemInfo MemberId Profile
| XGrpMemRole MemberId GroupMemberRole
| XGrpMemCon MemberId -- TODO not implemented
| XGrpMemConAll MemberId -- TODO not implemented
| XGrpMemDel MemberId
@@ -312,6 +313,7 @@ data CMEventTag
| XGrpMemInv_
| XGrpMemFwd_
| XGrpMemInfo_
| XGrpMemRole_
| XGrpMemCon_
| XGrpMemConAll_
| XGrpMemDel_
@@ -349,6 +351,7 @@ instance StrEncoding CMEventTag where
XGrpMemInv_ -> "x.grp.mem.inv"
XGrpMemFwd_ -> "x.grp.mem.fwd"
XGrpMemInfo_ -> "x.grp.mem.info"
XGrpMemRole_ -> "x.grp.mem.role"
XGrpMemCon_ -> "x.grp.mem.con"
XGrpMemConAll_ -> "x.grp.mem.con.all"
XGrpMemDel_ -> "x.grp.mem.del"
@@ -383,6 +386,7 @@ instance StrEncoding CMEventTag where
"x.grp.mem.inv" -> Right XGrpMemInv_
"x.grp.mem.fwd" -> Right XGrpMemFwd_
"x.grp.mem.info" -> Right XGrpMemInfo_
"x.grp.mem.role" -> Right XGrpMemRole_
"x.grp.mem.con" -> Right XGrpMemCon_
"x.grp.mem.con.all" -> Right XGrpMemConAll_
"x.grp.mem.del" -> Right XGrpMemDel_
@@ -420,6 +424,7 @@ toCMEventTag = \case
XGrpMemInv _ _ -> XGrpMemInv_
XGrpMemFwd _ _ -> XGrpMemFwd_
XGrpMemInfo _ _ -> XGrpMemInfo_
XGrpMemRole _ _ -> XGrpMemRole_
XGrpMemCon _ -> XGrpMemCon_
XGrpMemConAll _ -> XGrpMemConAll_
XGrpMemDel _ -> XGrpMemDel_
@@ -486,6 +491,7 @@ appToChatMessage AppMessage {msgId, event, params} = do
XGrpMemInv_ -> XGrpMemInv <$> p "memberId" <*> p "memberIntro"
XGrpMemFwd_ -> XGrpMemFwd <$> p "memberInfo" <*> p "memberIntro"
XGrpMemInfo_ -> XGrpMemInfo <$> p "memberId" <*> p "profile"
XGrpMemRole_ -> XGrpMemRole <$> p "memberId" <*> p "role"
XGrpMemCon_ -> XGrpMemCon <$> p "memberId"
XGrpMemConAll_ -> XGrpMemConAll <$> p "memberId"
XGrpMemDel_ -> XGrpMemDel <$> p "memberId"
@@ -528,6 +534,7 @@ chatToAppMessage ChatMessage {msgId, chatMsgEvent} = AppMessage {msgId, event, p
XGrpMemInv memId memIntro -> o ["memberId" .= memId, "memberIntro" .= memIntro]
XGrpMemFwd memInfo memIntro -> o ["memberInfo" .= memInfo, "memberIntro" .= memIntro]
XGrpMemInfo memId profile -> o ["memberId" .= memId, "profile" .= profile]
XGrpMemRole memId role -> o ["memberId" .= memId, "role" .= role]
XGrpMemCon memId -> o ["memberId" .= memId]
XGrpMemConAll memId -> o ["memberId" .= memId]
XGrpMemDel memId -> o ["memberId" .= memId]
src/Simplex/Chat/Store.hs
+14 -2
View File
@@ -89,6 +89,7 @@ module Simplex.Chat.Store
createNewGroupMember,
deleteGroupMember,
deleteGroupMemberConnection,
updateGroupMemberRole,
createIntroductions,
updateIntroStatus,
saveIntroInvitation,
@@ -1412,8 +1413,15 @@ createGroupInvitation :: DB.Connection -> User -> Contact -> GroupInvitation ->
createGroupInvitation db user@User {userId} contact@Contact {contactId, activeConn = Connection {customUserProfileId}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do
liftIO getInvitationGroupId_ >>= \case
Nothing -> createGroupInvitation_
-- TODO treat the case that the invitation details could've changed
Just gId -> getGroupInfo db user gId
Just gId -> do
gInfo@GroupInfo {membership, groupProfile = p'} <- getGroupInfo db user gId
let GroupMember {groupMemberId, memberId, memberRole} = membership
MemberIdRole {memberId = memberId', memberRole = memberRole'} = invitedMember
liftIO . when (memberId /= memberId' || memberRole /= memberRole') $
DB.execute db "UPDATE group_members SET member_id = ?, member_role = ? WHERE group_member_id = ?" (memberId', memberRole', groupMemberId)
if p' == groupProfile
then pure gInfo
else updateGroupProfile db user gInfo groupProfile
where
getInvitationGroupId_ :: IO (Maybe Int64)
getInvitationGroupId_ =
@@ -1783,6 +1791,10 @@ deleteGroupMemberConnection :: DB.Connection -> User -> GroupMember -> IO ()
deleteGroupMemberConnection db User {userId} GroupMember {groupMemberId} =
DB.execute db "DELETE FROM connections WHERE user_id = ? AND group_member_id = ?" (userId, groupMemberId)
updateGroupMemberRole :: DB.Connection -> User -> GroupMember -> GroupMemberRole -> IO ()
updateGroupMemberRole db User {userId} GroupMember {groupMemberId} memRole =
DB.execute db "UPDATE group_members SET member_role = ? WHERE user_id = ? AND group_member_id = ?" (memRole, userId, groupMemberId)
createIntroductions :: DB.Connection -> [GroupMember] -> GroupMember -> IO [GroupMemberIntro]
createIntroductions db members toMember = do
let reMembers = filter (\m -> memberCurrent m && groupMemberId' m /= groupMemberId' toMember) members
src/Simplex/Chat/View.hs
+23
View File
@@ -149,6 +149,8 @@ responseToView testView = \case
CRHostDisconnected p h -> [plain $ "disconnected from " <> viewHostEvent p h]
CRJoinedGroupMemberConnecting g host m -> [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"]
CRConnectedToGroupMember g m -> [ttyGroup' g <> ": " <> connectedMember m <> " is connected"]
CRMemberRole g by m r r' -> viewMemberRoleChanged g by m r r'
CRMemberRoleUser g m r r' -> viewMemberRoleUserChanged g m r r'
CRDeletedMemberUser g by -> [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group"] <> groupPreserved g
CRDeletedMember g by m -> [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group"]
CRLeftMember g m -> [ttyGroup' g <> ": " <> ttyMember m <> " left the group"]
@@ -478,6 +480,27 @@ connectedMember m = case memberCategory m of
GCPostMember -> "new member " <> ttyMember m -- without fullName as as it was shown in joinedGroupMemberConnecting
_ -> "member " <> ttyMember m -- these case is not used
viewMemberRoleChanged :: GroupInfo -> GroupMember -> GroupMember -> GroupMemberRole -> GroupMemberRole -> [StyledString]
viewMemberRoleChanged g@GroupInfo {membership} by m r r'
| r == r' = [ttyGroup' g <> ": member role did not change"]
| groupMemberId' membership == memId = view "your role"
| groupMemberId' by == memId = view "the role"
| otherwise = view $ "the role of " <> ttyMember m
where
memId = groupMemberId' m
view s = [ttyGroup' g <> ": " <> ttyMember by <> " changed " <> s <> " from " <> showRole r <> " to " <> showRole r']
viewMemberRoleUserChanged :: GroupInfo -> GroupMember -> GroupMemberRole -> GroupMemberRole -> [StyledString]
viewMemberRoleUserChanged g@GroupInfo {membership} m r r'
| r == r' = [ttyGroup' g <> ": member role did not change"]
| groupMemberId' membership == groupMemberId' m = view "your role"
| otherwise = view $ "the role of " <> ttyMember m
where
view s = [ttyGroup' g <> ": you changed " <> s <> " from " <> showRole r <> " to " <> showRole r']
showRole :: GroupMemberRole -> StyledString
showRole = plain . strEncode
viewGroupMembers :: Group -> [StyledString]
viewGroupMembers (Group GroupInfo {membership} members) = map groupMember . filter (not . removedOrLeft) $ membership : members
where