mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-08-28 14:14:09 +00:00
core: chat relays announce new members to owners (with keys); forward x.grp.mem.restrict; sign and verify x.grp.leave and x.info (member profile update) (#6690)
This commit is contained in:
@@ -863,7 +863,7 @@ data ChatEvent
|
||||
| CEvtConnectedToGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember, memberContact :: Maybe Contact}
|
||||
| CEvtDeletedMember {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember, withMessages :: Bool, msgSigned :: Bool}
|
||||
| CEvtDeletedMemberUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember, withMessages :: Bool, msgSigned :: Bool}
|
||||
| CEvtLeftMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CEvtLeftMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember, msgSigned :: Bool}
|
||||
| CEvtUnknownMemberCreated {user :: User, groupInfo :: GroupInfo, forwardedByMember :: GroupMember, member :: GroupMember}
|
||||
| CEvtUnknownMemberBlocked {user :: User, groupInfo :: GroupInfo, blockedByMember :: GroupMember, member :: GroupMember}
|
||||
| CEvtUnknownMemberAnnounced {user :: User, groupInfo :: GroupInfo, announcingMember :: GroupMember, unknownMember :: GroupMember, announcedMember :: GroupMember}
|
||||
|
||||
@@ -766,7 +766,7 @@ processChatCommand vr nm = \case
|
||||
assertUserGroupRole gInfo GRObserver -- can still delete messages sent earlier
|
||||
let msgIds = itemsMsgIds items
|
||||
events = L.nonEmpty $ map (\msgId -> XMsgDel msgId Nothing $ toMsgScope gInfo <$> chatScopeInfo) msgIds
|
||||
mapM_ (sendGroupMessages user gInfo Nothing recipients) events
|
||||
mapM_ (sendGroupMessages user gInfo Nothing False recipients) events
|
||||
-- TODO delGroupChatItems sends deletion events too. Are they needed?
|
||||
delGroupChatItems user gInfo chatScopeInfo items False
|
||||
pure $ CRChatItemsDeleted user deletions True False
|
||||
@@ -2000,17 +2000,18 @@ processChatCommand vr nm = \case
|
||||
Just sl -> pure sl
|
||||
Nothing -> throwChatError $ CEException "failed to retrieve relays: no short link"
|
||||
(FixedLinkData {linkConnReq = mainCReq@(CRContactUri crData), linkEntityId, rootKey}, ContactLinkData _ UserContactData {owners, relays}) <- getShortLinkConnReq nm user sLnk
|
||||
-- Set group link info and incognito profile once before connecting to relays
|
||||
-- Prepare group record once before connecting to relays (updatePreparedRelayedGroup):
|
||||
-- set group link info and incognito profile, generate and store membership keys
|
||||
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
|
||||
let cReqHash = contactCReqHash $ CRContactUri crData {crScheme = SSSimplex}
|
||||
gInfo' <- withFastStore $ \db -> setPreparedGroupLinkInfo db vr user gInfo mainCReq cReqHash incognitoProfile
|
||||
forM_ linkEntityId $ \sharedGroupId -> do
|
||||
gVar <- asks random
|
||||
(_, memberPrivKey) <- liftIO $ atomically $ C.generateKeyPair gVar
|
||||
withFastStore' $ \db -> updateGroupMemberKeys db groupId sharedGroupId rootKey memberPrivKey (groupMemberId' $ membership gInfo')
|
||||
-- Pre-emptively create owner member with trusted key from link data
|
||||
forM_ owners $ \OwnerAuth {ownerId, ownerKey} ->
|
||||
withFastStore $ \db -> createLinkOwnerMember db vr user gInfo' (MemberId ownerId) ownerKey
|
||||
gVar <- asks random
|
||||
(_, memberPrivKey) <- liftIO $ atomically $ C.generateKeyPair gVar
|
||||
gInfo' <- withFastStore $ \db -> do
|
||||
gInfo' <- updatePreparedRelayedGroup db vr user gInfo mainCReq cReqHash incognitoProfile linkEntityId rootKey memberPrivKey
|
||||
-- Pre-emptively create owner members with trusted keys from link data
|
||||
forM_ owners $ \OwnerAuth {ownerId, ownerKey} ->
|
||||
void $ createLinkOwnerMember db vr user gInfo' (MemberId ownerId) ownerKey
|
||||
pure gInfo'
|
||||
rs <- mapConcurrently (connectToRelay gInfo') relays
|
||||
let relayFailed = \case (_, _, Left _) -> True; _ -> False
|
||||
(failed, succeeded) = partition relayFailed rs
|
||||
@@ -2576,7 +2577,7 @@ processChatCommand vr nm = \case
|
||||
Just memsToChange' -> do
|
||||
let events = L.map (\GroupMember {memberId} -> XGrpMemRole memberId newRole) memsToChange'
|
||||
recipients = filter memberCurrent members
|
||||
(msgs_, _gsr) <- sendGroupMessages user gInfo Nothing recipients events
|
||||
(msgs_, _gsr) <- sendGroupMessages user gInfo Nothing False recipients events
|
||||
let signed = any (either (const False) (isJust . signedMsg_)) msgs_
|
||||
itemsData = zipWith (fmap . sndItemData) memsToChange (L.toList msgs_)
|
||||
cis_ <- saveSndChatItems user (CDGroupSnd gInfo Nothing) False itemsData Nothing False
|
||||
@@ -2705,7 +2706,7 @@ processChatCommand vr nm = \case
|
||||
Just memsToDelete' -> do
|
||||
let chatScope = toChatScope <$> chatScopeInfo
|
||||
events = L.map (\GroupMember {memberId} -> XGrpMemDel memberId withMessages) memsToDelete'
|
||||
(msgs_, _gsr) <- sendGroupMessages user gInfo chatScope recipients events
|
||||
(msgs_, _gsr) <- sendGroupMessages user gInfo chatScope False recipients events
|
||||
let signed = any (either (const False) (isJust . signedMsg_)) msgs_
|
||||
itemsData_ = zipWith (fmap . sndItemData) memsToDelete (L.toList msgs_)
|
||||
skipUnwantedItem = \case
|
||||
@@ -3423,8 +3424,9 @@ processChatCommand vr nm = \case
|
||||
chatEvent <- case gInfo_ of
|
||||
Just (Just gInfo) | useRelays' gInfo -> do
|
||||
let GroupInfo {membership = GroupMember {memberId}} = gInfo
|
||||
(memberPubKey, _memberPrivKey) <- atomically $ C.generateKeyPair g
|
||||
-- TODO [member keys] store memberPrivKey in groups.member_priv_key, memberPubKey in group_members.member_pub_key
|
||||
memberPubKey <- case groupKeys gInfo of
|
||||
Just GroupKeys {memberPrivKey} -> pure $ C.publicKey memberPrivKey
|
||||
Nothing -> throwChatError $ CEInternalError "no group keys for channel membership"
|
||||
pure $ XMember profileToSend memberId (MemberKey memberPubKey)
|
||||
_ -> pure $ XContact profileToSend (Just xContactId) welcomeSharedMsgId msg_
|
||||
dm <- encodeConnInfoPQ pqSup chatV chatEvent
|
||||
@@ -4095,7 +4097,7 @@ processChatCommand vr nm = \case
|
||||
(fInvs_, ciFiles_) <- L.unzip <$> setupSndFileTransfers (length recipients)
|
||||
timed_ <- sndGroupCITimed live gInfo itemTTL
|
||||
(chatMsgEvents, quotedItems_) <- L.unzip <$> prepareMsgs (L.zip cmrs fInvs_) timed_
|
||||
(msgs_, gsr) <- sendGroupMessages user gInfo Nothing recipients chatMsgEvents
|
||||
(msgs_, gsr) <- sendGroupMessages user gInfo Nothing showGroupAsSender recipients chatMsgEvents
|
||||
let itemsData = prepareSndItemsData (L.toList cmrs) (L.toList ciFiles_) (L.toList quotedItems_) (L.toList msgs_)
|
||||
cis_ <- saveSndChatItems user (CDGroupSnd gInfo chatScopeInfo) showGroupAsSender itemsData timed_ live
|
||||
when (length cis_ /= length cmrs) $ logError "sendGroupContentMessages: cmrs and cis_ length mismatch"
|
||||
|
||||
@@ -923,7 +923,7 @@ acceptContactRequestAsync
|
||||
liftIO $ setCommandConnId db user cmdId connId
|
||||
getContact db vr user contactId
|
||||
|
||||
acceptGroupJoinRequestAsync :: User -> Int64 -> GroupInfo -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> CM GroupMember
|
||||
acceptGroupJoinRequestAsync :: User -> Int64 -> GroupInfo -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> Maybe MemberKey -> CM GroupMember
|
||||
acceptGroupJoinRequestAsync
|
||||
user
|
||||
uclId
|
||||
@@ -936,11 +936,12 @@ acceptGroupJoinRequestAsync
|
||||
welcomeMsgId_
|
||||
gAccepted
|
||||
gLinkMemRole
|
||||
incognitoProfile = do
|
||||
incognitoProfile
|
||||
memberKey_ = do
|
||||
gVar <- asks random
|
||||
let initialStatus = acceptanceToStatus (memberAdmission groupProfile) gAccepted
|
||||
(groupMemberId, memberId) <- withStore $ \db ->
|
||||
createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ cReqMemberId_ welcomeMsgId_ gLinkMemRole initialStatus
|
||||
createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ cReqMemberId_ welcomeMsgId_ gLinkMemRole initialStatus memberKey_
|
||||
let currentMemCount = fromIntegral $ currentMembers $ groupSummary gInfo
|
||||
let Profile {displayName} = userProfileInGroup user gInfo (fromIncognitoProfile <$> incognitoProfile)
|
||||
GroupMember {memberRole = userRole, memberId = userMemberId} = membership
|
||||
@@ -975,7 +976,7 @@ acceptGroupJoinSendRejectAsync
|
||||
rejectionReason = do
|
||||
gVar <- asks random
|
||||
(groupMemberId, memberId) <- withStore $ \db ->
|
||||
createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ Nothing Nothing GRObserver GSMemRejected
|
||||
createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ Nothing Nothing GRObserver GSMemRejected Nothing
|
||||
let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
|
||||
msg =
|
||||
XGrpLinkReject $
|
||||
@@ -1133,19 +1134,17 @@ memberIntroEvt gInfo reMember =
|
||||
mRestrictions = memberRestrictions reMember
|
||||
in XGrpMemIntro mInfo mRestrictions
|
||||
|
||||
-- Used in groups with relays to introduce moderators and above to a new member.
|
||||
-- Member is not introduced to anybody:
|
||||
-- - in channels member will be prohibited to send, so it doesn't matter;
|
||||
-- - if member does send, recipients will create unknown member record;
|
||||
-- - later - to do member profile request protocol.
|
||||
-- Used in groups with relays to introduce moderators and above to a new member,
|
||||
-- and to announce the new member to moderators and above.
|
||||
-- This doesn't create introduction records in db, compared to above methods.
|
||||
introduceModerators :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
|
||||
introduceModerators _ _ _ GroupMember {activeConn = Nothing} = throwChatError $ CEInternalError "member connection not active"
|
||||
introduceModerators vr user gInfo GroupMember {activeConn = Just conn} = do
|
||||
introduceInChannel :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
|
||||
introduceInChannel _ _ _ GroupMember {activeConn = Nothing} = throwChatError $ CEInternalError "member connection not active"
|
||||
introduceInChannel vr user gInfo subscriber@GroupMember {activeConn = Just conn} = do
|
||||
modMs <- withStore' $ \db -> getGroupModerators db vr user gInfo
|
||||
let events = map (memberIntroEvt gInfo) modMs
|
||||
forM_ (L.nonEmpty events) $ \events' ->
|
||||
sendGroupMemberMessages user gInfo conn events'
|
||||
void $ sendGroupMessage' user gInfo modMs $ XGrpMemNew (memberInfo gInfo subscriber) Nothing
|
||||
let introEvts = map (memberIntroEvt gInfo) modMs
|
||||
forM_ (L.nonEmpty introEvts) $ \introEvts' ->
|
||||
sendGroupMemberMessages user gInfo conn introEvts'
|
||||
|
||||
userProfileInGroup :: User -> GroupInfo -> Maybe Profile -> Profile
|
||||
userProfileInGroup user = userProfileInGroup' user . groupFeatureUserAllowed SGFSimplexLinks
|
||||
@@ -1996,7 +1995,7 @@ deliverMessagesB msgReqs = do
|
||||
|
||||
sendGroupMessage :: MsgEncodingI e => User -> GroupInfo -> Maybe GroupChatScope -> [GroupMember] -> ChatMsgEvent e -> CM SndMessage
|
||||
sendGroupMessage user gInfo gcScope members chatMsgEvent = do
|
||||
sendGroupMessages user gInfo gcScope members (chatMsgEvent :| []) >>= \case
|
||||
sendGroupMessages user gInfo gcScope False members (chatMsgEvent :| []) >>= \case
|
||||
((Right msg) :| [], _) -> pure msg
|
||||
_ -> throwChatError $ CEInternalError "sendGroupMessage: expected 1 message"
|
||||
|
||||
@@ -2006,8 +2005,8 @@ sendGroupMessage' user gInfo members chatMsgEvent =
|
||||
((Right msg) :| [], _) -> pure msg
|
||||
_ -> throwChatError $ CEInternalError "sendGroupMessage': expected 1 message"
|
||||
|
||||
sendGroupMessages :: MsgEncodingI e => User -> GroupInfo -> Maybe GroupChatScope -> [GroupMember] -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult)
|
||||
sendGroupMessages user gInfo scope members events = do
|
||||
sendGroupMessages :: MsgEncodingI e => User -> GroupInfo -> Maybe GroupChatScope -> ShowGroupAsSender -> [GroupMember] -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult)
|
||||
sendGroupMessages user gInfo scope asGroup members events = do
|
||||
-- TODO [knocking] send current profile to pending member after approval?
|
||||
when shouldSendProfileUpdate $
|
||||
sendProfileUpdate `catchAllErrors` eToView
|
||||
@@ -2016,6 +2015,7 @@ sendGroupMessages user gInfo scope members events = do
|
||||
User {profile = p, userMemberProfileUpdatedAt} = user
|
||||
GroupInfo {userMemberProfileSentAt} = gInfo
|
||||
shouldSendProfileUpdate
|
||||
| asGroup = False
|
||||
| isJust scope = False -- why not sending profile updates to scopes?
|
||||
| incognitoMembership gInfo = False
|
||||
| otherwise =
|
||||
|
||||
@@ -853,7 +853,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
when (connChatVersion < batchSend2Version) $ getAutoReplyMsg >>= mapM_ (\mc -> sendGroupAutoReply mc Nothing)
|
||||
if useRelays' gInfo''
|
||||
then do
|
||||
introduceModerators vr user gInfo'' m'
|
||||
introduceInChannel vr user gInfo'' m'
|
||||
when (groupFeatureAllowed SGFHistory gInfo'') $ sendHistory user gInfo'' m'
|
||||
else case mStatus of
|
||||
GSMemPendingApproval -> pure ()
|
||||
@@ -941,8 +941,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
pure newDeliveryTasks
|
||||
processEvent :: forall e. MsgEncodingI e => GroupInfo -> GroupMember -> VerifiedMsg e -> CM (Maybe NewMessageDeliveryTask)
|
||||
processEvent gInfo' m' verifiedMsg = do
|
||||
let chatMsg = verifiedChatMsg verifiedMsg
|
||||
(m'', conn', msg@RcvMessage {msgId, msgSigned, chatMsgEvent = ACME _ event}) <- saveGroupRcvMsg user groupId m' conn msgMeta verifiedMsg
|
||||
(m'', conn', msg@RcvMessage {msgId, chatMsgEvent = ACME _ event}) <- saveGroupRcvMsg user groupId m' conn msgMeta verifiedMsg
|
||||
let ctx js = DeliveryTaskContext js False
|
||||
checkSendAsGroup :: Maybe Bool -> CM (Maybe DeliveryTaskContext) -> CM (Maybe DeliveryTaskContext)
|
||||
checkSendAsGroup asGroup_ a
|
||||
@@ -968,7 +967,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
XFile fInv -> Nothing <$ processGroupFileInvitation' gInfo' m'' fInv msg brokerTs
|
||||
XFileCancel sharedMsgId -> xFileCancelGroup gInfo' (Just m'') sharedMsgId
|
||||
XFileAcptInv sharedMsgId fileConnReq_ fName -> Nothing <$ xFileAcptInvGroup gInfo' m'' sharedMsgId fileConnReq_ fName
|
||||
XInfo p -> fmap ctx <$> xInfoMember gInfo' m'' p brokerTs
|
||||
XInfo p -> fmap ctx <$> xInfoMember gInfo' m'' p msg brokerTs
|
||||
XGrpLinkMem p memberKey -> Nothing <$ xGrpLinkMem gInfo' m'' conn' p memberKey
|
||||
XGrpLinkAcpt acceptance role memberId -> Nothing <$ xGrpLinkAcpt gInfo' m'' acceptance role memberId msg brokerTs
|
||||
XGrpMemNew memInfo msgScope -> fmap ctx <$> xGrpMemNew gInfo' m'' memInfo msgScope msg brokerTs
|
||||
@@ -984,7 +983,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
XGrpLeave -> fmap ctx <$> xGrpLeave gInfo' m'' msg brokerTs
|
||||
XGrpDel -> Just (DeliveryTaskContext (DJSGroup {jobSpec = DJRelayRemoved}) False) <$ xGrpDel gInfo' m'' msg brokerTs
|
||||
XGrpInfo p' -> fmap ctx <$> xGrpInfo gInfo' m'' p' msg brokerTs
|
||||
XGrpPrefs ps' -> fmap ctx <$> xGrpPrefs msgSigned gInfo' m'' ps'
|
||||
XGrpPrefs ps' -> fmap ctx <$> xGrpPrefs gInfo' m'' ps' msg
|
||||
-- TODO [knocking] why don't we forward these messages?
|
||||
XGrpDirectInv connReq mContent_ msgScope -> memberCanSend (Just m'') msgScope $ Nothing <$ xGrpDirectInv gInfo' m'' conn' connReq mContent_ msg brokerTs
|
||||
XGrpMsgForward fwd msg' -> Nothing <$ xGrpMsgForward gInfo' Nothing m'' fwd (ParsedMsg Nothing Nothing msg') brokerTs
|
||||
@@ -1107,9 +1106,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
let GroupMember {memberId = membershipMemId} = membership
|
||||
incognitoProfile = fromLocalProfile <$> incognitoMembershipProfile gInfo
|
||||
profileToSend = userProfileInGroup user gInfo incognitoProfile
|
||||
g <- asks random
|
||||
(memberPubKey, _memberPrivKey) <- atomically $ C.generateKeyPair g
|
||||
-- TODO [member keys] store memberPrivKey in groups.member_priv_key, memberPubKey in group_members.member_pub_key
|
||||
memberPubKey <- case groupKeys gInfo of
|
||||
Just GroupKeys {memberPrivKey} -> pure $ C.publicKey memberPrivKey
|
||||
Nothing -> throwChatError $ CEInternalError "no group keys for channel membership"
|
||||
dm <- encodeConnInfo $ XMember profileToSend membershipMemId (MemberKey memberPubKey)
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
void $ joinAgentConnectionAsync user (Just conn) True cReq dm subMode
|
||||
@@ -1418,7 +1417,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
messageError "processContactConnMessage: chat version range incompatible for accepting group join request"
|
||||
| otherwise -> do
|
||||
let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
|
||||
mem <- acceptGroupJoinRequestAsync user uclId gInfo invId chatVRange p xContactId_ Nothing welcomeMsgId_ acceptance useRole profileMode
|
||||
mem <- acceptGroupJoinRequestAsync user uclId gInfo invId chatVRange p xContactId_ Nothing welcomeMsgId_ acceptance useRole profileMode Nothing
|
||||
(gInfo', mem', scopeInfo) <- mkGroupChatScope gInfo mem
|
||||
createInternalChatItem user (CDGroupRcv gInfo' scopeInfo mem') (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
|
||||
toView $ CEvtAcceptingGroupJoinRequestMember user gInfo' mem'
|
||||
@@ -1435,18 +1434,22 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
-- TODO [relays] owner, relays: TBC how to communicate member rejection rules from owner to relays
|
||||
-- TODO [relays] relay: TBC communicate rejection when memberId already exists (currently checked in createJoiningMember)
|
||||
memberJoinRequestViaRelay :: InvitationId -> VersionRangeChat -> Profile -> MemberId -> MemberKey -> CM ()
|
||||
memberJoinRequestViaRelay invId chatVRange p joiningMemberId _joiningMemberKey = do -- TODO [member keys] store memberKey in group_members.member_pub_key
|
||||
memberJoinRequestViaRelay invId chatVRange p joiningMemberId joiningMemberKey = do
|
||||
(_ucl, gLinkInfo_) <- withStore $ \db -> getUserContactLinkById db userId uclId
|
||||
case gLinkInfo_ of
|
||||
Just GroupLinkInfo {groupId, memberRole = gLinkMemRole} -> do
|
||||
gInfo <- withStore $ \db -> getGroupInfo db vr user groupId
|
||||
mem <- acceptGroupJoinRequestAsync user uclId gInfo invId chatVRange p Nothing (Just joiningMemberId) Nothing GAAccepted gLinkMemRole Nothing
|
||||
mem <- acceptGroupJoinRequestAsync user uclId gInfo invId chatVRange p Nothing (Just joiningMemberId) Nothing GAAccepted gLinkMemRole Nothing (Just joiningMemberKey)
|
||||
(gInfo', mem', scopeInfo) <- mkGroupChatScope gInfo mem
|
||||
createInternalChatItem user (CDGroupRcv gInfo' scopeInfo mem') (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
|
||||
toView $ CEvtAcceptingGroupJoinRequestMember user gInfo' mem'
|
||||
Nothing ->
|
||||
messageError "memberJoinRequestViaRelay: no group link info for relay link"
|
||||
|
||||
muteEventInChannel :: GroupInfo -> GroupMember -> Bool
|
||||
muteEventInChannel gInfo@GroupInfo {membership} m =
|
||||
useRelays' gInfo && memberRole' membership < GRModerator && not (isRelay membership) && memberRole' m < GRModerator
|
||||
|
||||
memberCanSend :: Maybe GroupMember -> Maybe MsgScope -> CM (Maybe DeliveryTaskContext) -> CM (Maybe DeliveryTaskContext)
|
||||
memberCanSend Nothing _ a = a -- channel message - was previously checked and allowed by relay
|
||||
memberCanSend (Just m@GroupMember {memberRole}) msgScope a = case msgScope of
|
||||
@@ -2394,9 +2397,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
Profile {displayName = n, fullName = fn, shortDescr = sd, image = i, contactLink = cl} = p
|
||||
Profile {displayName = n', fullName = fn', shortDescr = sd', image = i', contactLink = cl'} = p'
|
||||
|
||||
xInfoMember :: GroupInfo -> GroupMember -> Profile -> UTCTime -> CM (Maybe DeliveryJobScope)
|
||||
xInfoMember gInfo m p' brokerTs = do
|
||||
void $ processMemberProfileUpdate gInfo m p' True (Just brokerTs)
|
||||
xInfoMember :: GroupInfo -> GroupMember -> Profile -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope)
|
||||
xInfoMember gInfo m p' msg brokerTs = do
|
||||
void $ processMemberProfileUpdate gInfo m p' (Just (msg, brokerTs))
|
||||
pure $ memberEventDeliveryScope m
|
||||
|
||||
xGrpLinkMem :: GroupInfo -> GroupMember -> Connection -> Profile -> Maybe MemberKey -> CM ()
|
||||
@@ -2404,7 +2407,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
xGrpLinkMemReceived <- withStore $ \db -> getXGrpLinkMemReceived db groupMemberId
|
||||
if (viaGroupLink || isJust businessChat) && isNothing (memberContactId m) && memberCategory == GCHostMember && not xGrpLinkMemReceived
|
||||
then do
|
||||
m' <- processMemberProfileUpdate gInfo m p' False Nothing
|
||||
m' <- processMemberProfileUpdate gInfo m p' Nothing
|
||||
withStore' $ \db -> setXGrpLinkMemReceived db groupMemberId True memberKey_
|
||||
let connectedIncognito = memberIncognito membership
|
||||
probeMatchingMemberContact m' connectedIncognito
|
||||
@@ -2468,24 +2471,26 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
where
|
||||
expectHistory = groupFeatureAllowed SGFHistory gInfo && m `supportsVersion` groupHistoryIncludeWelcomeVersion
|
||||
|
||||
processMemberProfileUpdate :: GroupInfo -> GroupMember -> Profile -> Bool -> Maybe UTCTime -> CM GroupMember
|
||||
processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId} p' createItems itemTs_
|
||||
processMemberProfileUpdate :: GroupInfo -> GroupMember -> Profile -> Maybe (RcvMessage, UTCTime) -> CM GroupMember
|
||||
processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId} p' msgTs_
|
||||
| redactedMemberProfile allowSimplexLinks (fromLocalProfile p) /= redactedMemberProfile allowSimplexLinks p' = do
|
||||
updateBusinessChatProfile gInfo
|
||||
case memberContactId of
|
||||
Nothing -> do
|
||||
m' <- withStore $ \db -> updateMemberProfile db user m p'
|
||||
createProfileUpdatedItem m'
|
||||
toView $ CEvtGroupMemberUpdated user gInfo m m'
|
||||
unless (muteEventInChannel gInfo m') $ do
|
||||
forM_ msgTs_ $ createProfileUpdatedItem m'
|
||||
toView $ CEvtGroupMemberUpdated user gInfo m m'
|
||||
pure m'
|
||||
Just mContactId -> do
|
||||
mCt <- withStore $ \db -> getContact db vr user mContactId
|
||||
if canUpdateProfile mCt
|
||||
then do
|
||||
(m', ct') <- withStore $ \db -> updateContactMemberProfile db user m mCt p'
|
||||
createProfileUpdatedItem m'
|
||||
toView $ CEvtGroupMemberUpdated user gInfo m m'
|
||||
toView $ CEvtContactUpdated user mCt ct'
|
||||
unless (muteEventInChannel gInfo m') $ do
|
||||
forM_ msgTs_ $ createProfileUpdatedItem m'
|
||||
toView $ CEvtGroupMemberUpdated user gInfo m m'
|
||||
toView $ CEvtContactUpdated user mCt ct'
|
||||
pure m'
|
||||
else pure m
|
||||
where
|
||||
@@ -2506,11 +2511,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
isMainBusinessMember BusinessChatInfo {chatType, businessId, customerId} GroupMember {memberId} = case chatType of
|
||||
BCBusiness -> businessId == memberId
|
||||
BCCustomer -> customerId == memberId
|
||||
createProfileUpdatedItem m' =
|
||||
when createItems $ do
|
||||
(gInfo', m'', scopeInfo) <- mkGroupChatScope gInfo m'
|
||||
let ciContent = CIRcvGroupEvent $ RGEMemberProfileUpdated (fromLocalProfile p) p'
|
||||
createInternalChatItem user (CDGroupRcv gInfo' scopeInfo m'') ciContent itemTs_
|
||||
createProfileUpdatedItem m' (msg, brokerTs) = do
|
||||
(gInfo', m'', scopeInfo) <- mkGroupChatScope gInfo m'
|
||||
let ciContent = CIRcvGroupEvent $ RGEMemberProfileUpdated (fromLocalProfile p) p'
|
||||
cd = CDGroupRcv gInfo' scopeInfo m''
|
||||
(ci, cInfo) <- saveRcvChatItemNoParse user cd msg brokerTs ciContent
|
||||
groupMsgToView cInfo ci
|
||||
|
||||
xInfoProbe :: ContactOrMember -> Probe -> CM ()
|
||||
xInfoProbe cgm2 probe = do
|
||||
@@ -2746,7 +2752,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
|
||||
xGrpMemNew :: GroupInfo -> GroupMember -> MemberInfo -> Maybe MsgScope -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope)
|
||||
xGrpMemNew gInfo m memInfo@(MemberInfo memId memRole _ _ _) msgScope_ msg brokerTs = do
|
||||
checkHostRole m memRole
|
||||
unless (useRelays' gInfo && isRelay m) $ checkHostRole m memRole
|
||||
if sameMemberId memId (membership gInfo)
|
||||
then pure Nothing
|
||||
else do
|
||||
@@ -2762,7 +2768,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
toView $ CEvtUnknownMemberAnnounced user gInfo' m unknownMember updatedMember
|
||||
memberAnnouncedToView updatedMember gInfo'
|
||||
pure $ deliveryJobScope updatedMember
|
||||
Right _ -> messageError "x.grp.mem.new error: member already exists" $> Nothing
|
||||
Right _
|
||||
| useRelays' gInfo -> logInfo "x.grp.mem.new: member already created via another relay" $> Nothing
|
||||
| otherwise -> messageError "x.grp.mem.new error: member already exists" $> Nothing
|
||||
Left _ -> do
|
||||
(newMember, gInfo') <- withStore $ \db -> do
|
||||
newMember <- createNewGroupMember db user gInfo m memInfo GCPostMember initialStatus
|
||||
@@ -2804,7 +2812,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case
|
||||
Right existingMember
|
||||
| useRelays' gInfo ->
|
||||
void $ withStore $ \db -> updateIntroducedMember db vr user existingMember memInfo
|
||||
void $ withStore $ \db -> updatePreparedChannelMember db vr user existingMember memInfo
|
||||
| otherwise ->
|
||||
messageError "x.grp.mem.intro ignored: member already exists"
|
||||
Left _
|
||||
@@ -2914,22 +2922,24 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
| membershipMemId == memId = pure Nothing -- ignore - XGrpMemRestrict can be sent to restricted member for efficiency
|
||||
| otherwise = do
|
||||
unknownRole <- unknownMemberRole gInfo
|
||||
(bm, unknown) <- withStore $ \db -> getCreateUnknownGMByMemberId db vr user gInfo memId "" unknownRole
|
||||
let GroupMember {groupMemberId = bmId, memberRole, blockedByAdmin, memberProfile = bmp} = bm
|
||||
if
|
||||
| blockedByAdmin == mrsBlocked restriction -> pure Nothing
|
||||
| senderRole < GRModerator || senderRole < memberRole ->
|
||||
messageError "x.grp.mem.restrict with insufficient member permissions" $> Nothing
|
||||
| otherwise -> do
|
||||
bm' <- setMemberBlocked bm
|
||||
toggleNtf bm' (not blocked)
|
||||
let ciContent = CIRcvGroupEvent $ RGEMemberBlocked bmId (fromLocalProfile bmp) blocked
|
||||
(gInfo', m', scopeInfo) <- mkGroupChatScope gInfo m
|
||||
(ci, cInfo) <- saveRcvChatItemNoParse user (CDGroupRcv gInfo' scopeInfo m') msg brokerTs ciContent
|
||||
when unknown $ toView $ CEvtUnknownMemberBlocked user gInfo m bm'
|
||||
groupMsgToView cInfo ci
|
||||
toView CEvtMemberBlockedForAll {user, groupInfo = gInfo', byMember = m', member = bm', blocked, msgSigned}
|
||||
pure $ memberEventDeliveryScope bm
|
||||
withStore (\db -> getCreateUnknownGMByMemberId db vr user gInfo memId "" unknownRole True) >>= \case
|
||||
Nothing -> messageError "x.grp.mem.restrict: no member" $> Nothing -- shouldn't happen
|
||||
Just (bm, unknown) -> do
|
||||
let GroupMember {groupMemberId = bmId, memberRole, blockedByAdmin, memberProfile = bmp} = bm
|
||||
if
|
||||
| blockedByAdmin == mrsBlocked restriction -> pure Nothing
|
||||
| senderRole < GRModerator || senderRole < memberRole ->
|
||||
messageError "x.grp.mem.restrict with insufficient member permissions" $> Nothing
|
||||
| otherwise -> do
|
||||
bm' <- setMemberBlocked bm
|
||||
toggleNtf bm' (not blocked)
|
||||
let ciContent = CIRcvGroupEvent $ RGEMemberBlocked bmId (fromLocalProfile bmp) blocked
|
||||
(gInfo', m', scopeInfo) <- mkGroupChatScope gInfo m
|
||||
(ci, cInfo) <- saveRcvChatItemNoParse user (CDGroupRcv gInfo' scopeInfo m') msg brokerTs ciContent
|
||||
when unknown $ toView $ CEvtUnknownMemberBlocked user gInfo m bm'
|
||||
groupMsgToView cInfo ci
|
||||
toView CEvtMemberBlockedForAll {user, groupInfo = gInfo', byMember = m', member = bm', blocked, msgSigned}
|
||||
pure $ memberEventDeliveryScope bm
|
||||
where
|
||||
setMemberBlocked bm = withStore' $ \db -> updateGroupMemberBlocked db user gInfo restriction bm
|
||||
blocked = mrsBlocked restriction
|
||||
@@ -3016,14 +3026,15 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
| otherwise = pure GRAuthor
|
||||
|
||||
xGrpLeave :: GroupInfo -> GroupMember -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope)
|
||||
xGrpLeave gInfo m msg brokerTs = do
|
||||
xGrpLeave gInfo m msg@RcvMessage {msgSigned} brokerTs = do
|
||||
deleteMemberConnection m
|
||||
-- member record is not deleted to allow creation of "member left" chat item
|
||||
gInfo' <- updateMemberRecordDeleted user gInfo m GSMemLeft
|
||||
(gInfo'', m', scopeInfo) <- mkGroupChatScope gInfo' m
|
||||
(ci, cInfo) <- saveRcvChatItemNoParse user (CDGroupRcv gInfo'' scopeInfo m') msg brokerTs (CIRcvGroupEvent RGEMemberLeft)
|
||||
groupMsgToView cInfo ci
|
||||
toView $ CEvtLeftMember user gInfo'' m' {memberStatus = GSMemLeft}
|
||||
unless (muteEventInChannel gInfo' m) $ do
|
||||
(gInfo'', m', scopeInfo) <- mkGroupChatScope gInfo' m
|
||||
(ci, cInfo) <- saveRcvChatItemNoParse user (CDGroupRcv gInfo'' scopeInfo m') msg brokerTs (CIRcvGroupEvent RGEMemberLeft)
|
||||
groupMsgToView cInfo ci
|
||||
toView $ CEvtLeftMember user gInfo'' m' {memberStatus = GSMemLeft} msgSigned
|
||||
pure $ memberEventDeliveryScope m
|
||||
|
||||
xGrpDel :: GroupInfo -> GroupMember -> RcvMessage -> UTCTime -> CM ()
|
||||
@@ -3056,8 +3067,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
Just _ -> updateGroupPrefs_ msgSigned g m $ fromMaybe defaultBusinessGroupPrefs $ groupPreferences p'
|
||||
pure $ Just DJSGroup {jobSpec = DJDeliveryJob {includePending = True}}
|
||||
|
||||
xGrpPrefs :: Bool -> GroupInfo -> GroupMember -> GroupPreferences -> CM (Maybe DeliveryJobScope)
|
||||
xGrpPrefs msgSigned g m@GroupMember {memberRole} ps'
|
||||
xGrpPrefs :: GroupInfo -> GroupMember -> GroupPreferences -> RcvMessage -> CM (Maybe DeliveryJobScope)
|
||||
xGrpPrefs g m@GroupMember {memberRole} ps' RcvMessage {msgSigned}
|
||||
| memberRole < GROwner = messageError "x.grp.prefs with insufficient member permissions" $> Nothing
|
||||
| otherwise = updateGroupPrefs_ msgSigned g m ps' $> Just DJSGroup {jobSpec = DJDeliveryJob {includePending = True}}
|
||||
|
||||
@@ -3165,17 +3176,20 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
case fwdSender of
|
||||
FwdMember memberId memberName -> do
|
||||
unknownRole <- unknownMemberRole gInfo
|
||||
(author, unknown) <- withStore $ \db -> getCreateUnknownGMByMemberId db vr user gInfo memberId memberName unknownRole
|
||||
when unknown $ toView $ CEvtUnknownMemberCreated user gInfo m author
|
||||
void $ withVerifiedMsg gInfo scopeInfo author parsedMsg msgTs $
|
||||
(`processForwardedMsg` Just author)
|
||||
let allowCreate = toCMEventTag chatMsgEvent /= XGrpLeave_
|
||||
withStore (\db -> getCreateUnknownGMByMemberId db vr user gInfo memberId memberName unknownRole allowCreate) >>= \case
|
||||
Just (author, unknown) -> do
|
||||
when unknown $ toView $ CEvtUnknownMemberCreated user gInfo m author
|
||||
void $ withVerifiedMsg gInfo scopeInfo author parsedMsg msgTs $
|
||||
(`processForwardedMsg` Just author)
|
||||
Nothing -> pure ()
|
||||
FwdChannel -> processForwardedMsg (VMUnsigned chatMsg) Nothing
|
||||
where
|
||||
-- ! see isForwardedGroupMsg: forwarded group events should include msgId to be deduplicated
|
||||
processForwardedMsg :: VerifiedMsg 'Json -> Maybe GroupMember -> CM ()
|
||||
processForwardedMsg verifiedMsg author_ = do
|
||||
rcvMsg_ <- saveGroupFwdRcvMsg user gInfo m author_ verifiedMsg brokerTs
|
||||
forM_ rcvMsg_ $ \rcvMsg@RcvMessage {msgSigned, chatMsgEvent = ACME _ event} -> case event of
|
||||
forM_ rcvMsg_ $ \rcvMsg@RcvMessage {chatMsgEvent = ACME _ event} -> case event of
|
||||
XMsgNew mc ->
|
||||
void $ memberCanSend author_ scope $ newGroupContentMessage gInfo author_ mc rcvMsg msgTs True
|
||||
where
|
||||
@@ -3187,14 +3201,15 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
XMsgDel sharedMsgId memId scope_ -> void $ groupMessageDelete gInfo author_ sharedMsgId memId scope_ rcvMsg msgTs
|
||||
XMsgReact sharedMsgId memId scope_ reaction add -> withAuthor XMsgReact_ $ \author -> void $ groupMsgReaction gInfo author sharedMsgId memId scope_ reaction add rcvMsg msgTs
|
||||
XFileCancel sharedMsgId -> void $ xFileCancelGroup gInfo author_ sharedMsgId
|
||||
XInfo p -> withAuthor XInfo_ $ \author -> void $ xInfoMember gInfo author p msgTs
|
||||
XInfo p -> withAuthor XInfo_ $ \author -> void $ xInfoMember gInfo author p rcvMsg msgTs
|
||||
XGrpMemNew memInfo msgScope -> withAuthor XGrpMemNew_ $ \author -> void $ xGrpMemNew gInfo author memInfo msgScope rcvMsg msgTs
|
||||
XGrpMemRole memId memRole -> withAuthor XGrpMemRole_ $ \author -> void $ xGrpMemRole gInfo author memId memRole rcvMsg msgTs
|
||||
XGrpMemRestrict memId memRestrictions -> withAuthor XGrpMemRestrict_ $ \author -> void $ xGrpMemRestrict gInfo author memId memRestrictions rcvMsg msgTs
|
||||
XGrpMemDel memId withMessages -> withAuthor XGrpMemDel_ $ \author -> void $ xGrpMemDel gInfo author memId withMessages verifiedMsg rcvMsg msgTs True
|
||||
XGrpLeave -> withAuthor XGrpLeave_ $ \author -> void $ xGrpLeave gInfo author rcvMsg msgTs
|
||||
XGrpDel -> withAuthor XGrpDel_ $ \author -> void $ xGrpDel gInfo author rcvMsg msgTs
|
||||
XGrpInfo p' -> withAuthor XGrpInfo_ $ \author -> void $ xGrpInfo gInfo author p' rcvMsg msgTs
|
||||
XGrpPrefs ps' -> withAuthor XGrpPrefs_ $ \author -> void $ xGrpPrefs msgSigned gInfo author ps'
|
||||
XGrpPrefs ps' -> withAuthor XGrpPrefs_ $ \author -> void $ xGrpPrefs gInfo author ps' rcvMsg
|
||||
_ -> messageError $ "x.grp.msg.forward: unsupported forwarded event " <> T.pack (show $ toCMEventTag event)
|
||||
where
|
||||
withAuthor :: CMEventTag e -> (GroupMember -> CM ()) -> CM ()
|
||||
@@ -3203,7 +3218,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
Nothing -> messageError $ "x.grp.msg.forward: event " <> tshow tag <> " requires author"
|
||||
|
||||
withVerifiedMsg :: MsgEncodingI e => GroupInfo -> Maybe GroupChatScopeInfo -> GroupMember -> ParsedMsg e -> UTCTime -> (VerifiedMsg e -> CM a) -> CM (Maybe a)
|
||||
withVerifiedMsg gInfo scopeInfo member (ParsedMsg _ signedMsg_ chatMsg@ChatMessage {chatMsgEvent}) ts action
|
||||
withVerifiedMsg gInfo@GroupInfo {membership} scopeInfo member (ParsedMsg _ signedMsg_ chatMsg@ChatMessage {chatMsgEvent}) ts action
|
||||
| verified = Just <$> action verifiedMsg
|
||||
| otherwise = do
|
||||
createInternalChatItem user (CDGroupRcv gInfo scopeInfo member) (CIRcvGroupEvent RGEMsgBadSignature) (Just ts)
|
||||
@@ -3219,10 +3234,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
CBGroup | Just GroupKeys {groupRootKey} <- groupKeys gInfo ->
|
||||
let prefix = smpEncode chatBinding <> smpEncode (groupRootPubKey groupRootKey, memberId)
|
||||
in all (\(MsgSignature KRMember sig) -> C.verify (C.APublicVerifyKey C.SEd25519 pubKey) sig (prefix <> signedBody)) signatures
|
||||
_ -> False
|
||||
| otherwise -> signatureOptional
|
||||
_ -> signatureOptional
|
||||
| otherwise -> signatureOptional || unverifiedAllowed membership member tag
|
||||
Nothing -> signatureOptional
|
||||
signatureOptional = not (useRelays' gInfo && requiresSignature (toCMEventTag chatMsgEvent))
|
||||
where
|
||||
tag = toCMEventTag chatMsgEvent
|
||||
signatureOptional = not (useRelays' gInfo) || not (requiresSignature tag)
|
||||
|
||||
directMsgReceived :: Contact -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> CM ()
|
||||
directMsgReceived ct conn@Connection {connId} msgMeta msgRcpts = do
|
||||
|
||||
@@ -38,7 +38,7 @@ import Data.Either (fromRight)
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe (fromMaybe, isJust)
|
||||
import Data.Maybe (fromMaybe, isJust, isNothing)
|
||||
import Data.String
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
@@ -1191,7 +1191,7 @@ hasDeliveryReceipt = \case
|
||||
XCallInv_ -> True
|
||||
_ -> False
|
||||
|
||||
-- | Admin events that must have a valid signature in relay groups.
|
||||
-- | Events that must have a valid signature in relay groups.
|
||||
requiresSignature :: CMEventTag e -> Bool
|
||||
requiresSignature = \case
|
||||
XGrpDel_ -> True
|
||||
@@ -1200,8 +1200,28 @@ requiresSignature = \case
|
||||
XGrpMemDel_ -> True
|
||||
XGrpMemRole_ -> True
|
||||
XGrpMemRestrict_ -> True
|
||||
XGrpLeave_ -> True
|
||||
XInfo_ -> True
|
||||
_ -> False
|
||||
|
||||
-- TODO [relays] relay: vectors tracking which members received which other member profiles/keys.
|
||||
-- TODO - don't forward XGrpLeave/XInfo to members who haven't seen sender's profile/key.
|
||||
-- TODO - unverifiedAllowed is a temporary workaround postponing targeted event forwarding.
|
||||
|
||||
-- Allow signed but unverified XGrpLeave/XInfo between subscribers when sender's key is unknown.
|
||||
-- Owner keys are always known, so subscribers are required to verify from owners.
|
||||
-- Likewise, subscriber keys are always known to owners, so owners are required to verify from subscribers.
|
||||
unverifiedAllowed :: GroupMember -> GroupMember -> CMEventTag e -> Bool
|
||||
unverifiedAllowed membership member = \case
|
||||
XGrpLeave_ -> membersNoKey
|
||||
XInfo_ -> membersNoKey
|
||||
_ -> False
|
||||
where
|
||||
membersNoKey =
|
||||
memberRole' membership < GRModerator
|
||||
&& memberRole' member < GRModerator
|
||||
&& isNothing (memberPubKey member)
|
||||
|
||||
appBinaryToCM :: AppMessageBinary -> Either String (ChatMessage 'Binary)
|
||||
appBinaryToCM AppMessageBinary {msgId, tag, body} = do
|
||||
eventTag <- strDecode $ B.singleton tag
|
||||
|
||||
@@ -179,7 +179,7 @@ createConnReqConnection db userId acId preparedEntity_ cReq cReqHash sLnk xConta
|
||||
)
|
||||
connId <- insertedRowId db
|
||||
case preparedEntity_ of
|
||||
-- For relay groups, setPreparedGroupLinkInfo is called before the relay loop
|
||||
-- For relay groups, setPreparedGroupLinkInfo_ is called via updatePreparedRelayedGroup before the relay loop
|
||||
Just (PCEGroup gInfo _) | not (useRelays' gInfo) ->
|
||||
setPreparedGroupLinkInfo_ db gInfo cReq cReqHash customUserProfileId currentTs
|
||||
_ -> pure ()
|
||||
|
||||
@@ -100,6 +100,7 @@ module Simplex.Chat.Store.Groups
|
||||
getMemberInvitation,
|
||||
createMemberConnection,
|
||||
createMemberConnectionAsync,
|
||||
updatePreparedRelayedGroup,
|
||||
updateGroupMemberKeys,
|
||||
updateRelayGroupKeys,
|
||||
updateGroupMemberStatus,
|
||||
@@ -151,7 +152,7 @@ module Simplex.Chat.Store.Groups
|
||||
setXGrpLinkMemReceived,
|
||||
createNewUnknownGroupMember,
|
||||
createLinkOwnerMember,
|
||||
updateIntroducedMember,
|
||||
updatePreparedChannelMember,
|
||||
updateUnknownMemberAnnounced,
|
||||
updateUserMemberProfileSentAt,
|
||||
setGroupCustomData,
|
||||
@@ -1090,14 +1091,16 @@ getGroupMemberByMemberId db vr user GroupInfo {groupId} memberId =
|
||||
(groupMemberQuery <> " WHERE m.group_id = ? AND m.member_id = ?")
|
||||
(groupId, memberId)
|
||||
|
||||
getCreateUnknownGMByMemberId :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> MemberId -> ContactName -> GroupMemberRole -> ExceptT StoreError IO (GroupMember, Bool)
|
||||
getCreateUnknownGMByMemberId db vr user gInfo memberId memberName unknownMemberRole = do
|
||||
getCreateUnknownGMByMemberId :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> MemberId -> ContactName -> GroupMemberRole -> Bool -> ExceptT StoreError IO (Maybe (GroupMember, Bool))
|
||||
getCreateUnknownGMByMemberId db vr user gInfo memberId memberName unknownMemberRole allowCreate = do
|
||||
liftIO (runExceptT $ getGroupMemberByMemberId db vr user gInfo memberId) >>= \case
|
||||
Right m -> pure (m, False)
|
||||
Left (SEGroupMemberNotFoundByMemberId _) -> do
|
||||
let name = if T.null memberName then nameFromMemberId memberId else memberName
|
||||
m <- createNewUnknownGroupMember db vr user gInfo memberId name unknownMemberRole
|
||||
pure (m, True)
|
||||
Right m -> pure $ Just (m, False)
|
||||
Left (SEGroupMemberNotFoundByMemberId _)
|
||||
| allowCreate -> do
|
||||
let name = if T.null memberName then nameFromMemberId memberId else memberName
|
||||
m <- createNewUnknownGroupMember db vr user gInfo memberId name unknownMemberRole
|
||||
pure $ Just (m, True)
|
||||
| otherwise -> pure Nothing
|
||||
Left e -> throwError e
|
||||
|
||||
getScopeMemberIdViaMemberId :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberId -> ExceptT StoreError IO GroupMemberId
|
||||
@@ -1522,7 +1525,7 @@ createNewContactMemberAsync db gVar user@User {userId, userContactId} GroupInfo
|
||||
:. (minV, maxV)
|
||||
)
|
||||
|
||||
createJoiningMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupMemberRole -> GroupMemberStatus -> ExceptT StoreError IO (GroupMemberId, MemberId)
|
||||
createJoiningMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupMemberRole -> GroupMemberStatus -> Maybe MemberKey -> ExceptT StoreError IO (GroupMemberId, MemberId)
|
||||
createJoiningMember
|
||||
db
|
||||
gVar
|
||||
@@ -1534,7 +1537,8 @@ createJoiningMember
|
||||
cReqMemberId_
|
||||
welcomeMsgId_
|
||||
memberRole
|
||||
memberStatus = do
|
||||
memberStatus
|
||||
memberKey_ = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
|
||||
liftIO $
|
||||
@@ -1561,6 +1565,7 @@ createJoiningMember
|
||||
checkMemberNotExists memberId = do
|
||||
exists <- liftIO $ fromOnly . head <$> DB.query db "SELECT EXISTS (SELECT 1 FROM group_members WHERE group_id = ? AND member_id = ?)" (groupId, memberId)
|
||||
when exists $ throwError SEDuplicateMemberId
|
||||
memberPubKey_ = (\(MemberKey k) -> k) <$> memberKey_
|
||||
insertMember_ ldn profileId memberId currentTs = do
|
||||
indexInGroup <- getUpdateNextIndexInGroup_ db groupId
|
||||
liftIO $
|
||||
@@ -1569,12 +1574,12 @@ createJoiningMember
|
||||
[sql|
|
||||
INSERT INTO group_members
|
||||
( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
|
||||
user_id, local_display_name, contact_id, contact_profile_id, member_xcontact_id, member_welcome_shared_msg_id, created_at, updated_at,
|
||||
user_id, local_display_name, contact_id, contact_profile_id, member_pub_key, member_xcontact_id, member_welcome_shared_msg_id, created_at, updated_at,
|
||||
peer_chat_min_version, peer_chat_max_version)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (groupId, indexInGroup, memberId, memberRole, GCInviteeMember, memberStatus, Binary B.empty, fromInvitedBy userContactId IBUser, groupMemberId' membership)
|
||||
:. (userId, ldn, Nothing :: (Maybe Int64), profileId, cReqXContactId_, welcomeMsgId_, currentTs, currentTs)
|
||||
:. (userId, ldn, Nothing :: (Maybe Int64), profileId, memberPubKey_, cReqXContactId_, welcomeMsgId_, currentTs, currentTs)
|
||||
:. (minV, maxV)
|
||||
)
|
||||
|
||||
@@ -1698,13 +1703,27 @@ createMemberConnectionAsync db user@User {userId} groupMemberId (cmdId, agentCon
|
||||
Connection {connId} <- createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange Nothing 0 currentTs subMode
|
||||
setCommandConnId db user cmdId connId
|
||||
|
||||
updateGroupMemberKeys :: DB.Connection -> GroupId -> ByteString -> C.PublicKeyEd25519 -> C.PrivateKeyEd25519 -> GroupMemberId -> IO ()
|
||||
updateGroupMemberKeys db groupId sharedGroupId rootPubKey memberPrivKey membershipGMId = do
|
||||
-- Set group link info, incognito profile, membership keys before connecting to relays.
|
||||
-- This is called once before connecting to relays, unlike createConnReqConnection -> setPreparedGroupLinkInfo_,
|
||||
-- which is used in single-connection flows.
|
||||
updatePreparedRelayedGroup ::
|
||||
DB.Connection -> VersionRangeChat -> User -> GroupInfo -> ConnReqContact -> ConnReqUriHash -> Maybe Profile ->
|
||||
Maybe ByteString -> C.PublicKeyEd25519 -> C.PrivateKeyEd25519 ->
|
||||
ExceptT StoreError IO GroupInfo
|
||||
updatePreparedRelayedGroup db vr user@User {userId} gInfo cReq cReqHash incognitoProfile linkEntityId rootPubKey memberPrivKey = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
customUserProfileId <- liftIO $ mapM (createIncognitoProfile_ db userId currentTs) incognitoProfile
|
||||
liftIO $ setPreparedGroupLinkInfo_ db gInfo cReq cReqHash customUserProfileId currentTs
|
||||
liftIO $ updateGroupMemberKeys db (groupId' gInfo) linkEntityId rootPubKey memberPrivKey (groupMemberId' $ membership gInfo)
|
||||
getGroupInfo db vr user (groupId' gInfo)
|
||||
|
||||
updateGroupMemberKeys :: DB.Connection -> GroupId -> Maybe ByteString -> C.PublicKeyEd25519 -> C.PrivateKeyEd25519 -> GroupMemberId -> IO ()
|
||||
updateGroupMemberKeys db groupId linkEntityId rootPubKey memberPrivKey membershipGMId = do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE groups SET shared_group_id = ?, root_pub_key = ?, member_priv_key = ?, updated_at = ? WHERE group_id = ?"
|
||||
(Binary sharedGroupId, rootPubKey, memberPrivKey, currentTs, groupId)
|
||||
(Binary <$> linkEntityId, rootPubKey, memberPrivKey, currentTs, groupId)
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE group_members SET member_pub_key = ?, updated_at = ? WHERE group_member_id = ?"
|
||||
@@ -2851,8 +2870,11 @@ createLinkOwnerMember db vr user@User {userId, userContactId} GroupInfo {groupId
|
||||
where
|
||||
VersionRange minV maxV = vr
|
||||
|
||||
updateIntroducedMember :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> MemberInfo -> ExceptT StoreError IO GroupMember
|
||||
updateIntroducedMember db vr user@User {userId} member@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile} = do
|
||||
-- member_pub_key is not updated here — introduced members are owners
|
||||
-- whose keys are loaded from link data (trusted out-of-band).
|
||||
-- Updating from an in-band message would allow a compromised relay to substitute keys.
|
||||
updatePreparedChannelMember :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> MemberInfo -> ExceptT StoreError IO GroupMember
|
||||
updatePreparedChannelMember db vr user@User {userId} member@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile} = do
|
||||
_ <- updateMemberProfile db user member profile
|
||||
currentTs <- liftIO getCurrentTime
|
||||
liftIO $
|
||||
@@ -2873,7 +2895,7 @@ updateIntroducedMember db vr user@User {userId} member@GroupMember {groupMemberI
|
||||
VersionRange minV maxV = maybe memberChatVRange fromChatVRange v
|
||||
|
||||
updateUnknownMemberAnnounced :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> GroupMember -> MemberInfo -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
|
||||
updateUnknownMemberAnnounced db vr user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile} status = do
|
||||
updateUnknownMemberAnnounced db vr user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile, memberKey} status = do
|
||||
_ <- updateMemberProfile db user unknownMember profile
|
||||
currentTs <- liftIO getCurrentTime
|
||||
liftIO $
|
||||
@@ -2887,15 +2909,17 @@ updateUnknownMemberAnnounced db vr user@User {userId} invitingMember unknownMemb
|
||||
invited_by_group_member_id = ?,
|
||||
peer_chat_min_version = ?,
|
||||
peer_chat_max_version = ?,
|
||||
member_pub_key = ?,
|
||||
updated_at = ?
|
||||
WHERE user_id = ? AND group_member_id = ?
|
||||
|]
|
||||
( (memberRole, GCPostMember, status, groupMemberId' invitingMember)
|
||||
:. (minV, maxV, currentTs, userId, groupMemberId)
|
||||
:. (minV, maxV, memberPubKey_, currentTs, userId, groupMemberId)
|
||||
)
|
||||
getGroupMemberById db vr user groupMemberId
|
||||
where
|
||||
VersionRange minV maxV = maybe memberChatVRange fromChatVRange v
|
||||
memberPubKey_ = (\(MemberKey k) -> k) <$> memberKey
|
||||
|
||||
updateUserMemberProfileSentAt :: DB.Connection -> User -> GroupInfo -> UTCTime -> IO ()
|
||||
updateUserMemberProfileSentAt db User {userId} GroupInfo {groupId} sentTs =
|
||||
|
||||
@@ -273,16 +273,6 @@ Query:
|
||||
Plan:
|
||||
SEARCH connections USING PRIMARY KEY (conn_id=?)
|
||||
|
||||
Query:
|
||||
SELECT user_id FROM users u
|
||||
WHERE u.deleted = ?
|
||||
AND NOT EXISTS (SELECT c.conn_id FROM connections c WHERE c.user_id = u.user_id)
|
||||
|
||||
Plan:
|
||||
SCAN u
|
||||
CORRELATED SCALAR SUBQUERY 1
|
||||
SEARCH c USING COVERING INDEX idx_connections_user (user_id=?)
|
||||
|
||||
Query:
|
||||
SELECT user_id FROM users u
|
||||
WHERE u.user_id = ?
|
||||
@@ -535,54 +525,6 @@ Query:
|
||||
Plan:
|
||||
SEARCH conn_confirmations USING COVERING INDEX idx_conn_confirmations_conn_id (conn_id=?)
|
||||
|
||||
Query:
|
||||
DELETE FROM encrypted_rcv_message_hashes
|
||||
WHERE encrypted_rcv_message_hash_id IN (
|
||||
SELECT encrypted_rcv_message_hash_id
|
||||
FROM encrypted_rcv_message_hashes
|
||||
WHERE created_at < ?
|
||||
ORDER BY created_at ASC
|
||||
LIMIT ?
|
||||
)
|
||||
|
||||
Plan:
|
||||
SEARCH encrypted_rcv_message_hashes USING INTEGER PRIMARY KEY (rowid=?)
|
||||
LIST SUBQUERY 1
|
||||
SEARCH encrypted_rcv_message_hashes USING COVERING INDEX idx_encrypted_rcv_message_hashes_created_at (created_at<?)
|
||||
|
||||
Query:
|
||||
DELETE FROM messages
|
||||
WHERE (conn_id, internal_id) IN (
|
||||
SELECT conn_id, internal_id
|
||||
FROM messages
|
||||
WHERE internal_ts < ? AND internal_snd_id IS NOT NULL
|
||||
ORDER BY internal_ts ASC
|
||||
LIMIT ?
|
||||
)
|
||||
|
||||
Plan:
|
||||
SEARCH messages USING COVERING INDEX idx_messages_conn_id (conn_id=? AND internal_id=?)
|
||||
LIST SUBQUERY 1
|
||||
SEARCH messages USING INDEX idx_messages_internal_ts (internal_ts<?)
|
||||
SEARCH snd_message_deliveries USING COVERING INDEX idx_snd_message_deliveries_conn_id_internal_id (conn_id=? AND internal_id=?)
|
||||
SEARCH snd_messages USING COVERING INDEX idx_snd_messages_conn_id_internal_id (conn_id=? AND internal_id=?)
|
||||
SEARCH rcv_messages USING COVERING INDEX idx_rcv_messages_conn_id_internal_id (conn_id=? AND internal_id=?)
|
||||
|
||||
Query:
|
||||
DELETE FROM processed_ratchet_key_hashes
|
||||
WHERE processed_ratchet_key_hash_id IN (
|
||||
SELECT processed_ratchet_key_hash_id
|
||||
FROM processed_ratchet_key_hashes
|
||||
WHERE created_at < ?
|
||||
ORDER BY created_at ASC
|
||||
LIMIT ?
|
||||
)
|
||||
|
||||
Plan:
|
||||
SEARCH processed_ratchet_key_hashes USING INTEGER PRIMARY KEY (rowid=?)
|
||||
LIST SUBQUERY 1
|
||||
SEARCH processed_ratchet_key_hashes USING COVERING INDEX idx_processed_ratchet_key_hashes_created_at (created_at<?)
|
||||
|
||||
Query:
|
||||
INSERT INTO connections
|
||||
(user_id, conn_id, conn_mode, smp_agent_version, enable_ntfs, pq_support, duplex_handshake) VALUES (?,?,?,?,?,?,?)
|
||||
@@ -707,30 +649,6 @@ Query:
|
||||
|
||||
Plan:
|
||||
|
||||
Query:
|
||||
SELECT rcv_file_id, rcv_file_entity_id, prefix_path
|
||||
FROM rcv_files
|
||||
WHERE created_at < ?
|
||||
|
||||
Plan:
|
||||
SCAN rcv_files
|
||||
|
||||
Query:
|
||||
SELECT rcv_file_id, rcv_file_entity_id, prefix_path
|
||||
FROM rcv_files
|
||||
WHERE deleted = 1
|
||||
|
||||
Plan:
|
||||
SCAN rcv_files
|
||||
|
||||
Query:
|
||||
SELECT rcv_file_id, rcv_file_entity_id, tmp_path
|
||||
FROM rcv_files
|
||||
WHERE status IN (?,?) AND tmp_path IS NOT NULL
|
||||
|
||||
Plan:
|
||||
SEARCH rcv_files USING INDEX idx_rcv_files_status_created_at (status=?)
|
||||
|
||||
Query:
|
||||
SELECT rcv_replica_id, rcv_replica_key
|
||||
FROM snd_file_chunk_replica_recipients
|
||||
@@ -739,30 +657,6 @@ Query:
|
||||
Plan:
|
||||
SEARCH snd_file_chunk_replica_recipients USING INDEX idx_snd_file_chunk_replica_recipients_snd_file_chunk_replica_id (snd_file_chunk_replica_id=?)
|
||||
|
||||
Query:
|
||||
SELECT snd_file_id, snd_file_entity_id, prefix_path
|
||||
FROM snd_files
|
||||
WHERE created_at < ?
|
||||
|
||||
Plan:
|
||||
SCAN snd_files
|
||||
|
||||
Query:
|
||||
SELECT snd_file_id, snd_file_entity_id, prefix_path
|
||||
FROM snd_files
|
||||
WHERE deleted = 1
|
||||
|
||||
Plan:
|
||||
SCAN snd_files
|
||||
|
||||
Query:
|
||||
SELECT snd_file_id, snd_file_entity_id, prefix_path
|
||||
FROM snd_files
|
||||
WHERE status IN (?,?) AND prefix_path IS NOT NULL
|
||||
|
||||
Plan:
|
||||
SEARCH snd_files USING INDEX idx_snd_files_status_created_at (status=?)
|
||||
|
||||
Query:
|
||||
UPDATE conn_confirmations
|
||||
SET accepted = 1,
|
||||
@@ -1054,10 +948,6 @@ SEARCH messages USING COVERING INDEX idx_messages_conn_id (conn_id=?)
|
||||
SEARCH snd_queues USING COVERING INDEX idx_snd_queue_id (conn_id=?)
|
||||
SEARCH rcv_queues USING COVERING INDEX idx_rcv_queue_id (conn_id=?)
|
||||
|
||||
Query: DELETE FROM deleted_snd_chunk_replicas WHERE created_at < ?
|
||||
Plan:
|
||||
SEARCH deleted_snd_chunk_replicas USING COVERING INDEX idx_deleted_snd_chunk_replicas_pending (created_at<?)
|
||||
|
||||
Query: DELETE FROM deleted_snd_chunk_replicas WHERE deleted_snd_chunk_replica_id = ?
|
||||
Plan:
|
||||
SEARCH deleted_snd_chunk_replicas USING INTEGER PRIMARY KEY (rowid=?)
|
||||
@@ -1077,10 +967,6 @@ Query: DELETE FROM ntf_subscriptions WHERE conn_id = ?
|
||||
Plan:
|
||||
SEARCH ntf_subscriptions USING PRIMARY KEY (conn_id=?)
|
||||
|
||||
Query: DELETE FROM ntf_tokens_to_delete WHERE created_at < ?
|
||||
Plan:
|
||||
SCAN ntf_tokens_to_delete
|
||||
|
||||
Query: DELETE FROM ratchets WHERE conn_id = ?
|
||||
Plan:
|
||||
SEARCH ratchets USING PRIMARY KEY (conn_id=?)
|
||||
@@ -1199,14 +1085,6 @@ Query: SELECT conn_id FROM connections WHERE deleted = 0
|
||||
Plan:
|
||||
SCAN connections
|
||||
|
||||
Query: SELECT conn_id FROM connections WHERE deleted = ?
|
||||
Plan:
|
||||
SCAN connections
|
||||
|
||||
Query: SELECT conn_id FROM connections WHERE deleted_at_wait_delivery IS NOT NULL
|
||||
Plan:
|
||||
SCAN connections
|
||||
|
||||
Query: SELECT conn_id FROM connections WHERE user_id = ?
|
||||
Plan:
|
||||
SEARCH connections USING COVERING INDEX idx_connections_user (user_id=?)
|
||||
|
||||
@@ -349,9 +349,9 @@ SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (conta
|
||||
Query:
|
||||
INSERT INTO group_members
|
||||
( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
|
||||
user_id, local_display_name, contact_id, contact_profile_id, member_xcontact_id, member_welcome_shared_msg_id, created_at, updated_at,
|
||||
user_id, local_display_name, contact_id, contact_profile_id, member_pub_key, member_xcontact_id, member_welcome_shared_msg_id, created_at, updated_at,
|
||||
peer_chat_min_version, peer_chat_max_version)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|
||||
Plan:
|
||||
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
|
||||
@@ -6659,6 +6659,10 @@ Query: SELECT member_relations_vector FROM group_members WHERE group_member_id =
|
||||
Plan:
|
||||
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query: SELECT member_status FROM group_members WHERE local_display_name = ?
|
||||
Plan:
|
||||
SCAN group_members
|
||||
|
||||
Query: SELECT member_xcontact_id, member_welcome_shared_msg_id FROM group_members WHERE user_id = ? AND group_id = ? AND group_member_id = ?
|
||||
Plan:
|
||||
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
@@ -861,16 +861,6 @@ getGroupInfo db vr User {userId, userContactId} groupId = ExceptT $ do
|
||||
(groupInfoQuery <> " WHERE g.group_id = ? AND g.user_id = ? AND mu.contact_id = ?")
|
||||
(groupId, userId, userContactId)
|
||||
|
||||
-- Set group link info and optionally incognito profile before connecting to relays.
|
||||
-- This is called once before connecting to relays, unlike createConnReqConnection -> setPreparedGroupLinkInfo_,
|
||||
-- which is used in single-connection flows.
|
||||
setPreparedGroupLinkInfo :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> ConnReqContact -> ConnReqUriHash -> Maybe Profile -> ExceptT StoreError IO GroupInfo
|
||||
setPreparedGroupLinkInfo db vr user@User {userId} gInfo@GroupInfo {groupId} cReq cReqHash incognitoProfile = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
customUserProfileId <- liftIO $ mapM (createIncognitoProfile_ db userId currentTs) incognitoProfile
|
||||
liftIO $ setPreparedGroupLinkInfo_ db gInfo cReq cReqHash customUserProfileId currentTs
|
||||
getGroupInfo db vr user groupId
|
||||
|
||||
setPreparedGroupLinkInfo_ :: DB.Connection -> GroupInfo -> ConnReqContact -> ConnReqUriHash -> Maybe Int64 -> UTCTime -> IO ()
|
||||
setPreparedGroupLinkInfo_ db GroupInfo {groupId, membership} cReq cReqHash customUserProfileId currentTs = do
|
||||
DB.execute
|
||||
|
||||
@@ -476,7 +476,7 @@ chatEventToView hu ChatConfig {logLevel, showReactions, showReceipts, testView}
|
||||
CEvtMemberBlockedForAll u g by m blocked signed -> ttyUser u $ viewMemberBlockedForAll g by m blocked signed
|
||||
CEvtDeletedMemberUser u g by wm signed -> ttyUser u $ [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group" <> withMessages wm <> signedStr signed] <> groupPreserved g
|
||||
CEvtDeletedMember u g by m wm signed -> ttyUser u [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group" <> withMessages wm <> signedStr signed]
|
||||
CEvtLeftMember u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " left the group"]
|
||||
CEvtLeftMember u g m signed -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " left the group" <> signedStr signed]
|
||||
CEvtGroupDeleted u g m signed -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group" <> signedStr signed, "use " <> highlight ("/d #" <> viewGroupName g) <> " to delete the local copy of the group"]
|
||||
CEvtGroupUpdated u g g' m signed -> ttyUser u $ viewGroupUpdated g g' m signed
|
||||
CEvtAcceptingGroupJoinRequestMember _ g m -> [ttyFullMember m <> ": accepting request to join group " <> ttyGroup' g <> "..."]
|
||||
@@ -1276,7 +1276,8 @@ viewJoinedGroupMemberConnecting g@GroupInfo {groupId} host m@GroupMember {groupM
|
||||
[ (ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting and pending review...), ")
|
||||
<> ("use " <> highlight ("/_accept member #" <> show groupId <> " " <> show groupMemberId <> " <role>") <> " to accept member")
|
||||
]
|
||||
_ -> [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"]
|
||||
_ | useRelays' g -> [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group"]
|
||||
| otherwise -> [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"]
|
||||
|
||||
viewConnectedToGroupMember :: GroupInfo -> GroupMember -> [StyledString]
|
||||
viewConnectedToGroupMember g@GroupInfo {groupId} m@GroupMember {groupMemberId, memberStatus} = case memberStatus of
|
||||
|
||||
Reference in New Issue
Block a user