core: backend for group invitations UI (status, db, updates) (#815)

This commit is contained in:
JRoberts
2022-07-15 17:49:29 +04:00
committed by GitHub
parent 8e15460bdc
commit eb89eec5b5
10 changed files with 160 additions and 66 deletions
+25 -11
View File
@@ -672,27 +672,30 @@ processChatCommand = \case
APIAddMember groupId contactId memRole -> withUser $ \user@User {userId} -> withChatLock $ do
-- TODO for large groups: no need to load all members to determine if contact is a member
(group, contact) <- withStore $ \db -> (,) <$> getGroup db user groupId <*> getContact db userId contactId
let Group gInfo@GroupInfo {localDisplayName = gName, groupProfile, membership} members = group
let Group gInfo@GroupInfo {localDisplayName, groupProfile, membership} members = group
GroupMember {memberRole = userRole, memberId = userMemberId} = membership
Contact {localDisplayName = cName} = contact
when (userRole < GRAdmin || userRole < memRole) $ throwChatError CEGroupUserRole
when (memberStatus membership == GSMemInvited) $ throwChatError (CEGroupNotJoined gInfo)
unless (memberActive membership) $ throwChatError CEGroupMemberNotActive
let sendInvitation memberId cReq = do
void . sendDirectContactMessage contact $
XGrpInv $ GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile
setActive $ ActiveG gName
let sendInvitation groupMemberId memberId cReq = do
let groupInv = GroupInvitation (MemberIdRole userMemberId userRole) (MemberIdRole memberId memRole) cReq groupProfile
msg <- sendDirectContactMessage contact $ XGrpInv groupInv
let content = CISndGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole
ci <- saveSndChatItem user (CDDirectSnd contact) msg content Nothing Nothing
toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat contact) ci
setActive $ ActiveG localDisplayName
pure $ CRSentGroupInvitation gInfo contact
case contactMember contact members of
Nothing -> do
gVar <- asks idsDrg
(agentConnId, cReq) <- withAgent (`createConnection` SCMInvitation)
GroupMember {memberId} <- withStore $ \db -> createContactMember db gVar user groupId contact memRole agentConnId cReq
sendInvitation memberId cReq
GroupMember {memberId, groupMemberId} <- withStore $ \db -> createContactMember db gVar user groupId contact memRole agentConnId cReq
sendInvitation groupMemberId memberId cReq
Just GroupMember {groupMemberId, memberId, memberStatus}
| memberStatus == GSMemInvited ->
withStore' (\db -> getMemberInvitation db user groupMemberId) >>= \case
Just cReq -> sendInvitation memberId cReq
Just cReq -> sendInvitation groupMemberId memberId cReq
Nothing -> throwChatError $ CEGroupCantResendInvitation gInfo cName
| otherwise -> throwChatError $ CEGroupDuplicateMember cName
APIJoinGroup groupId -> withUser $ \user@User {userId} -> do
@@ -703,11 +706,20 @@ processChatCommand = \case
createMemberConnection db userId fromMember agentConnId
updateGroupMemberStatus db userId fromMember GSMemAccepted
updateGroupMemberStatus db userId (membership g) GSMemAccepted
updateCIGroupInvitationStatus user
pure $ CRUserAcceptedGroupSent g
where
updateCIGroupInvitationStatus user@User {userId} = do
AChatItem _ _ cInfo ChatItem {content, meta = CIMeta {itemId}} <- withStore $ \db -> getChatItemByGroupId db user groupId
case (cInfo, content) of
(DirectChat ct, CIRcvGroupInvitation ciGroupInv memRole) -> do
let aciContent = ACIContent SMDRcv $ CIRcvGroupInvitation ciGroupInv {status = CIGISAccepted} memRole
updateDirectChatItemView userId ct itemId aciContent Nothing
_ -> pure () -- prohibited
APIMemberRole _groupId _groupMemberId _memRole -> throwChatError $ CECommandError "unsupported"
APIRemoveMember groupId memberId -> withUser $ \user@User {userId} -> do
Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user groupId
case find ((== memberId) . groupMemberId) members of
case find ((== memberId) . groupMemberId') members of
Nothing -> throwChatError CEGroupMemberNotFound
Just m@GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus} -> do
let userRole = memberRole (membership :: GroupMember)
@@ -1714,10 +1726,12 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
when (fromRole < GRAdmin || fromRole < memRole) $ throwChatError (CEGroupContactRole c)
when (fromMemId == memId) $ throwChatError CEGroupDuplicateMemberId
GroupInfo {groupId, localDisplayName, groupProfile} <- withStore $ \db -> createGroupInvitation db user ct inv
let content = CIGroupInvitation (CIGroupInfo {groupId, localDisplayName, groupProfile}) memRole
gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership = GroupMember {groupMemberId}} <- withStore $ \db -> createGroupInvitation db user ct inv
let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole
ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta content Nothing
withStore' $ \db -> setGroupInvitationChatItemId db user groupId (chatItemId' ci)
toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
toView $ CRReceivedGroupInvitation gInfo ct memRole
showToast ("#" <> localDisplayName <> " " <> c <> "> ") "invited you to join the group"
checkIntegrityCreateItem :: forall c. ChatTypeI c => ChatDirection c 'MDRcv -> MsgMeta -> m ()