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

core: member acceptance

Browse Source
This commit is contained in:
Evgeny Poberezkin
2025-02-27 12:09:43 +00:00
parent b482d4d812
commit c684c6f495
10 changed files with 80 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Controller.hs
+1
View File
@@ -366,6 +366,7 @@ data ChatCommand
| ApiGetConnNtfMessages {connIds :: NonEmpty AgentConnId}
| APIAddMember GroupId ContactId GroupMemberRole
| APIJoinGroup {groupId :: GroupId, enableNtfs :: MsgFilter}
| APIAcceptMember GroupId GroupMemberId GroupMemberRole
| APIMemberRole GroupId GroupMemberId GroupMemberRole
| APIBlockMemberForAll GroupId GroupMemberId Bool
| APIRemoveMember GroupId GroupMemberId
src/Simplex/Chat/Library/Commands.hs
+5 -1
View File
@@ -1127,7 +1127,7 @@ processChatCommand' vr = \case
(user@User {userId}, cReq) <- withFastStore $ \db -> getContactRequest' db connReqId
(ct, conn@Connection {connId}, sqSecured) <- acceptContactRequest user cReq incognito
ucl <- withFastStore $ \db -> getUserContactLinkById db userId userContactLinkId
let contactUsed = (\(_, groupId_, _) -> isNothing groupId_) ucl
let contactUsed = (\(_, gLinkInfo_) -> isNothing gLinkInfo_) ucl
ct' <- withStore' $ \db -> do
deleteContactRequestRec db user cReq
updateContactAccepted db user ct contactUsed
@@ -2023,6 +2023,10 @@ processChatCommand' vr = \case
updateCIGroupInvitationStatus user g CIGISAccepted `catchChatError` (toView . CRChatError (Just user))
pure $ CRUserAcceptedGroupSent user g {membership = membership {memberStatus = GSMemAccepted}} Nothing
Nothing -> throwChatError $ CEContactNotActive ct
APIAcceptMember groupId gmId memRole -> withUser $ \user -> do
-- Group gInfo@GroupInfo {membership} members <- withFastStore $ \db -> getGroup db vr user groupId
-- pure $ CRJoinedGroupMember user gInfo m {memberStatus = GSMemConnected} -- GSMemApproved?
ok user
APIMemberRole groupId memberId memRole -> withUser $ \user -> do
Group gInfo@GroupInfo {membership} members <- withFastStore $ \db -> getGroup db vr user groupId
if memberId == groupMemberId' membership
src/Simplex/Chat/Library/Internal.hs
+2
View File
@@ -841,6 +841,7 @@ acceptGroupJoinRequestAsync
fromMemberName = displayName,
invitedMember = MemberIdRole memberId gLinkMemRole,
groupProfile,
acceptance = Nothing, -- TODO [knocking]
business = businessChat,
groupSize = Just currentMemCount
}
@@ -900,6 +901,7 @@ acceptBusinessJoinRequestAsync
fromMemberName = displayName,
invitedMember = MemberIdRole memberId GRMember,
groupProfile = businessGroupProfile userProfile groupPreferences,
acceptance = Nothing, -- TODO [knocking]
-- This refers to the "title member" that defines the group name and profile.
-- This coincides with fromMember to be current user when accepting the connecting user,
-- but it will be different when inviting somebody else.
src/Simplex/Chat/Library/Subscriber.hs
+8 -6
View File
@@ -592,9 +592,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
withStore' $ \db -> resetContactConnInitiated db user conn'
forM_ viaUserContactLink $ \userContactLinkId -> do
ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId
let (UserContactLink {autoAccept}, groupId_, gLinkMemRole) = ucl
let (UserContactLink {autoAccept}, gli_) = ucl
when (connChatVersion < batchSend2Version) $ sendAutoReply ct' autoAccept
forM_ groupId_ $ \groupId -> do
forM_ gli_ $ \GroupLinkInfo {groupId, memberRole = gLinkMemRole, acceptance = _acceptance} -> do -- TODO
groupInfo <- withStore $ \db -> getGroupInfo db vr user groupId
subMode <- chatReadVar subscriptionMode
groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode
@@ -658,7 +658,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
toView $ CRContactSndReady user ct
forM_ viaUserContactLink $ \userContactLinkId -> do
ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId
let (UserContactLink {autoAccept}, _, _) = ucl
let (UserContactLink {autoAccept}, _) = ucl
when (connChatVersion >= batchSend2Version) $ sendAutoReply ct autoAccept
QCONT ->
void $ continueSending connEntity conn
@@ -782,6 +782,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
withAgent $ \a -> toggleConnectionNtfs a (aConnId conn) $ chatHasNtfs chatSettings
case memberCategory m of
GCHostMember -> do
-- TODO [knocking] here it will communicate whether user is approved as member as status of membership
toView $ CRUserJoinedGroup user gInfo {membership = membership {memberStatus = GSMemConnected}} m {memberStatus = GSMemConnected}
let cd = CDGroupRcv gInfo m
createInternalChatItem user cd (CIRcvGroupE2EEInfo E2EInfo {pqEnabled = PQEncOff}) Nothing
@@ -793,6 +794,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
expectHistory = groupFeatureAllowed SGFHistory gInfo && m `supportsVersion` groupHistoryIncludeWelcomeVersion
GCInviteeMember -> do
memberConnectedChatItem gInfo m
-- TODO [knocking] here it will communicate whether member needs to be approved as member status
toView $ CRJoinedGroupMember user gInfo m {memberStatus = GSMemConnected}
let Connection {viaUserContactLink} = conn
when (isJust viaUserContactLink && isNothing (memberContactId m)) sendXGrpLinkMem
@@ -1300,7 +1302,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
CORGroup gInfo -> toView $ CRBusinessRequestAlreadyAccepted user gInfo
CORRequest cReq -> do
ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId
let (UserContactLink {connReqContact, autoAccept}, groupId_, gLinkMemRole) = ucl
let (UserContactLink {connReqContact, autoAccept}, gLinkInfo_) = ucl
isSimplexTeam = sameConnReqContact connReqContact adminContactReq
v = maxVersion chatVRange
case autoAccept of
@@ -1313,13 +1315,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
else do
gInfo <- acceptBusinessJoinRequestAsync user cReq
toView $ CRAcceptingBusinessRequest user gInfo
| otherwise -> case groupId_ of
| otherwise -> case gLinkInfo_ of
Nothing -> do
-- [incognito] generate profile to send, create connection with incognito profile
incognitoProfile <- if acceptIncognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
ct <- acceptContactRequestAsync user cReq incognitoProfile reqPQSup
toView $ CRAcceptingContactRequest user ct
Just groupId -> do
Just GroupLinkInfo {groupId, memberRole = gLinkMemRole, acceptance = _acceptance} -> do
gInfo <- withStore $ \db -> getGroupInfo db vr user groupId
cfg <- asks config
case rejectionReason cfg of
src/Simplex/Chat/Protocol.hs
+7
View File
@@ -331,6 +331,7 @@ data ChatMsgEvent (e :: MsgEncoding) where
XGrpInv :: GroupInvitation -> ChatMsgEvent 'Json
XGrpAcpt :: MemberId -> ChatMsgEvent 'Json
XGrpLinkInv :: GroupLinkInvitation -> ChatMsgEvent 'Json
XGrpLinkAcpt :: MemberId -> ChatMsgEvent 'Json
XGrpLinkReject :: GroupLinkRejection -> ChatMsgEvent 'Json
XGrpLinkMem :: Profile -> ChatMsgEvent 'Json
XGrpMemNew :: MemberInfo -> ChatMsgEvent 'Json
@@ -821,6 +822,7 @@ data CMEventTag (e :: MsgEncoding) where
XGrpInv_ :: CMEventTag 'Json
XGrpAcpt_ :: CMEventTag 'Json
XGrpLinkInv_ :: CMEventTag 'Json
XGrpLinkAcpt_ :: CMEventTag 'Json
XGrpLinkReject_ :: CMEventTag 'Json
XGrpLinkMem_ :: CMEventTag 'Json
XGrpMemNew_ :: CMEventTag 'Json
@@ -873,6 +875,7 @@ instance MsgEncodingI e => StrEncoding (CMEventTag e) where
XGrpInv_ -> "x.grp.inv"
XGrpAcpt_ -> "x.grp.acpt"
XGrpLinkInv_ -> "x.grp.link.inv"
XGrpLinkAcpt_ -> "x.grp.link.acpt"
XGrpLinkReject_ -> "x.grp.link.reject"
XGrpLinkMem_ -> "x.grp.link.mem"
XGrpMemNew_ -> "x.grp.mem.new"
@@ -926,6 +929,7 @@ instance StrEncoding ACMEventTag where
"x.grp.inv" -> XGrpInv_
"x.grp.acpt" -> XGrpAcpt_
"x.grp.link.inv" -> XGrpLinkInv_
"x.grp.link.acpt" -> XGrpLinkAcpt_
"x.grp.link.reject" -> XGrpLinkReject_
"x.grp.link.mem" -> XGrpLinkMem_
"x.grp.mem.new" -> XGrpMemNew_
@@ -975,6 +979,7 @@ toCMEventTag msg = case msg of
XGrpInv _ -> XGrpInv_
XGrpAcpt _ -> XGrpAcpt_
XGrpLinkInv _ -> XGrpLinkInv_
XGrpLinkAcpt _ -> XGrpLinkAcpt_
XGrpLinkReject _ -> XGrpLinkReject_
XGrpLinkMem _ -> XGrpLinkMem_
XGrpMemNew _ -> XGrpMemNew_
@@ -1077,6 +1082,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
XGrpInv_ -> XGrpInv <$> p "groupInvitation"
XGrpAcpt_ -> XGrpAcpt <$> p "memberId"
XGrpLinkInv_ -> XGrpLinkInv <$> p "groupLinkInvitation"
XGrpLinkAcpt_ -> XGrpLinkAcpt <$> p "memberId"
XGrpLinkReject_ -> XGrpLinkReject <$> p "groupLinkRejection"
XGrpLinkMem_ -> XGrpLinkMem <$> p "profile"
XGrpMemNew_ -> XGrpMemNew <$> p "memberInfo"
@@ -1140,6 +1146,7 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @
XGrpInv groupInv -> o ["groupInvitation" .= groupInv]
XGrpAcpt memId -> o ["memberId" .= memId]
XGrpLinkInv groupLinkInv -> o ["groupLinkInvitation" .= groupLinkInv]
XGrpLinkAcpt memId -> o ["memberId" .= memId]
XGrpLinkReject groupLinkRjct -> o ["groupLinkRejection" .= groupLinkRjct]
XGrpLinkMem profile -> o ["profile" .= profile]
XGrpMemNew memInfo -> o ["memberInfo" .= memInfo]
src/Simplex/Chat/Store/Profiles.hs
+22 -6
View File
@@ -18,6 +18,7 @@ module Simplex.Chat.Store.Profiles
( AutoAccept (..),
UserMsgReceiptSettings (..),
UserContactLink (..),
GroupLinkInfo (..),
createUserRecord,
createUserRecordAt,
getUsersInfo,
@@ -77,7 +78,10 @@ where
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.Aeson.TH as J
import qualified Data.Attoparsec.ByteString.Char8 as A
import qualified Data.ByteString.Char8 as B
import Data.Functor (($>))
import Data.Int (Int64)
import Data.List.NonEmpty (NonEmpty)
@@ -100,15 +104,15 @@ import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Env.SQLite (ServerRoles (..))
import Simplex.Messaging.Agent.Protocol (ACorrId, ConnId, UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow)
import Simplex.Messaging.Agent.Store.DB (BoolInt (..))
import Simplex.Messaging.Agent.Store.DB (BoolInt (..), FromField (..), ToField (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
import qualified Simplex.Messaging.Crypto as C
import qualified Simplex.Messaging.Crypto.Ratchet as CR
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON)
import Simplex.Messaging.Parsers (blobFieldDecoder, defaultJSON)
import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI (..), SProtocolType (..), SubscriptionMode)
import Simplex.Messaging.Transport.Client (TransportHost)
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8)
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..), Query, (:.) (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
@@ -453,6 +457,13 @@ data UserContactLink = UserContactLink
}
deriving (Show)
data GroupLinkInfo = GroupLinkInfo
{ groupId :: GroupId,
acceptance :: GroupAcceptance,
memberRole :: GroupMemberRole
}
deriving (Show)
data AutoAccept = AutoAccept
{ businessAddress :: Bool, -- possibly, it can be wrapped together with acceptIncognito, or AutoAccept made sum type
acceptIncognito :: IncognitoEnabled,
@@ -481,18 +492,23 @@ getUserAddress db User {userId} =
|]
(Only userId)
getUserContactLinkById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO (UserContactLink, Maybe GroupId, GroupMemberRole)
getUserContactLinkById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO (UserContactLink, Maybe GroupLinkInfo)
getUserContactLinkById db userId userContactLinkId =
ExceptT . firstRow (\(ucl :. (groupId_, mRole_)) -> (toUserContactLink ucl, groupId_, fromMaybe GRMember mRole_)) SEUserContactLinkNotFound $
ExceptT . firstRow (\(ucl :. gli) -> (toUserContactLink ucl, toGroupLinkInfo gli)) SEUserContactLinkNotFound $
DB.query
db
[sql|
SELECT conn_req_contact, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role
SELECT conn_req_contact, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role, group_link_auto_accept
FROM user_contact_links
WHERE user_id = ?
AND user_contact_link_id = ?
|]
(userId, userContactLinkId)
where
toGroupLinkInfo :: (Maybe GroupId, Maybe GroupAcceptance, Maybe GroupMemberRole) -> Maybe GroupLinkInfo
toGroupLinkInfo (groupId_, acceptance_, mRole_) =
(\groupId -> GroupLinkInfo {groupId, acceptance = fromMaybe GAAuto acceptance_, memberRole = fromMaybe GRMember mRole_})
<$> groupId_
getUserContactLinkByConnReq :: DB.Connection -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe UserContactLink)
getUserContactLinkByConnReq db User {userId} (cReqSchema1, cReqSchema2) =
src/Simplex/Chat/Store/SQLite/Migrations.hs
+3 -1
View File
@@ -128,6 +128,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20250122_chat_items_include_in_hist
import Simplex.Chat.Store.SQLite.Migrations.M20250126_mentions
import Simplex.Chat.Store.SQLite.Migrations.M20250129_delete_unused_contacts
import Simplex.Chat.Store.SQLite.Migrations.M20250130_indexes
import Simplex.Chat.Store.SQLite.Migrations.M20250227_member_acceptance
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@@ -255,7 +256,8 @@ schemaMigrations =
("20250122_chat_items_include_in_history", m20250122_chat_items_include_in_history, Just down_m20250122_chat_items_include_in_history),
("20250126_mentions", m20250126_mentions, Just down_m20250126_mentions),
("20250129_delete_unused_contacts", m20250129_delete_unused_contacts, Just down_m20250129_delete_unused_contacts),
("20250130_indexes", m20250130_indexes, Just down_m20250130_indexes)
("20250130_indexes", m20250130_indexes, Just down_m20250130_indexes),
("20250227_member_acceptance", m20250227_member_acceptance, Just down_m20250227_member_acceptance)
]
-- | The list of migrations in ascending order by date
src/Simplex/Chat/Types.hs
+7
View File
@@ -668,6 +668,7 @@ data GroupLinkInvitation = GroupLinkInvitation
fromMemberName :: ContactName,
invitedMember :: MemberIdRole,
groupProfile :: GroupProfile,
acceptance :: Maybe GroupAcceptance,
business :: Maybe BusinessChatInfo,
groupSize :: Maybe Int
}
@@ -1001,6 +1002,7 @@ data GroupMemberStatus
| GSMemIntroInvited -- member is sent to or received from intro invitation
| GSMemAccepted -- member accepted invitation (only User and Invitee)
| GSMemAnnounced -- host announced (x.grp.mem.new) a member (Invitee and PostMember) to the group - at this point this member can send messages and invite other members (if they have sufficient permissions)
| GSMemPendingApproval -- member is connected to host but pending host approval before connecting to other members ("knocking")
| GSMemConnected -- member created the group connection with the inviting member
| GSMemComplete -- host confirmed (x.grp.mem.all) that a member (User, Invitee and PostMember) created group connections with all previous members
| GSMemCreator -- user member that created the group (only GCUserMember)
@@ -1029,6 +1031,7 @@ memberActive m = case memberStatus m of
GSMemIntroInvited -> False
GSMemAccepted -> False
GSMemAnnounced -> False
GSMemPendingApproval -> True -- TODO [knocking] ?
GSMemConnected -> True
GSMemComplete -> True
GSMemCreator -> True
@@ -1049,6 +1052,7 @@ memberCurrent' = \case
GSMemIntroInvited -> True
GSMemAccepted -> True
GSMemAnnounced -> True
GSMemPendingApproval -> True
GSMemConnected -> True
GSMemComplete -> True
GSMemCreator -> True
@@ -1065,6 +1069,7 @@ memberRemoved m = case memberStatus m of
GSMemIntroInvited -> False
GSMemAccepted -> False
GSMemAnnounced -> False
GSMemPendingApproval -> False
GSMemConnected -> False
GSMemComplete -> False
GSMemCreator -> False
@@ -1081,6 +1086,7 @@ instance TextEncoding GroupMemberStatus where
"intro-inv" -> Just GSMemIntroInvited
"accepted" -> Just GSMemAccepted
"announced" -> Just GSMemAnnounced
"pending" -> Just GSMemPendingApproval
"connected" -> Just GSMemConnected
"complete" -> Just GSMemComplete
"creator" -> Just GSMemCreator
@@ -1096,6 +1102,7 @@ instance TextEncoding GroupMemberStatus where
GSMemIntroInvited -> "intro-inv"
GSMemAccepted -> "accepted"
GSMemAnnounced -> "announced"
GSMemPendingApproval -> "pending"
GSMemConnected -> "connected"
GSMemComplete -> "complete"
GSMemCreator -> "creator"
src/Simplex/Chat/Types/Shared.hs
+23
View File
@@ -48,3 +48,26 @@ instance FromJSON GroupMemberRole where
instance ToJSON GroupMemberRole where
toJSON = strToJSON
toEncoding = strToJEncoding
data GroupAcceptance = GAAuto | GAManual deriving (Eq, Show)
instance FromField GroupAcceptance where fromField = blobFieldDecoder strDecode
instance ToField GroupAcceptance where toField = toField . strEncode
instance StrEncoding GroupAcceptance where
strEncode = \case
GAAuto -> "auto"
GAManual -> "manual"
strDecode = \case
"auto" -> Right GAAuto
"manual" -> Right GAManual
r -> Left $ "bad GroupAcceptance " <> B.unpack r
strP = strDecode <$?> A.takeByteString
instance FromJSON GroupAcceptance where
parseJSON = strParseJSON "GroupAcceptance"
instance ToJSON GroupAcceptance where
toJSON = strToJSON
toEncoding = strToJEncoding