mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-03-14 09:45:42 +00:00
core: communicate group join rejection (#5661)
This commit is contained in:
spaced4ndy
Evgeny Poberezkin
parent
511ff1d35c
commit
f701ffa4e0
11 changed files with 246 additions and 57 deletions
|
|
@ -844,6 +844,12 @@ data ChatResponse
|
|||
| CRAppSettings {appSettings :: AppSettings}
|
||||
| CRTimedAction {action :: String, durationMilliseconds :: Int64}
|
||||
| CRCustomChatResponse {user_ :: Maybe User, response :: Text}
|
||||
| CRTerminalEvent TerminalEvent
|
||||
deriving (Show)
|
||||
|
||||
data TerminalEvent
|
||||
= TEGroupLinkRejected {user :: User, groupInfo :: GroupInfo, groupRejectionReason :: GroupRejectionReason}
|
||||
| TERejectingGroupJoinRequestMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember, groupRejectionReason :: GroupRejectionReason}
|
||||
deriving (Show)
|
||||
|
||||
data DeletedRcvQueue = DeletedRcvQueue
|
||||
|
|
@ -1491,6 +1497,10 @@ chatCmdError user = CRChatCmdError user . ChatError . CECommandError
|
|||
throwChatError :: ChatErrorType -> CM a
|
||||
throwChatError = throwError . ChatError
|
||||
|
||||
toViewTE :: TerminalEvent -> CM ()
|
||||
toViewTE = toView . CRTerminalEvent
|
||||
{-# INLINE toViewTE #-}
|
||||
|
||||
-- | Emit local events.
|
||||
toView :: ChatResponse -> CM ()
|
||||
toView = lift . toView'
|
||||
|
|
@ -1630,6 +1640,8 @@ $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RCSR") ''RemoteCtrlStopReason)
|
|||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "RHSR") ''RemoteHostStopReason)
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "TE") ''TerminalEvent)
|
||||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CR") ''ChatResponse)
|
||||
|
||||
$(JQ.deriveFromJSON defaultJSON ''ArchiveConfig)
|
||||
|
|
|
|||
|
|
@ -2621,7 +2621,7 @@ processChatCommand' vr = \case
|
|||
contactMember :: Contact -> [GroupMember] -> Maybe GroupMember
|
||||
contactMember Contact {contactId} =
|
||||
find $ \GroupMember {memberContactId = cId, memberStatus = s} ->
|
||||
cId == Just contactId && s /= GSMemRemoved && s /= GSMemLeft
|
||||
cId == Just contactId && s /= GSMemRejected && s /= GSMemRemoved && s /= GSMemLeft
|
||||
checkSndFile :: CryptoFile -> CM Integer
|
||||
checkSndFile (CryptoFile f cfArgs) = do
|
||||
fsFilePath <- lift $ toFSFilePath f
|
||||
|
|
@ -2969,6 +2969,7 @@ processChatCommand' vr = \case
|
|||
(Just gInfo, _) -> groupPlan gInfo
|
||||
where
|
||||
groupPlan gInfo@GroupInfo {membership}
|
||||
| memberStatus membership == GSMemRejected = pure $ CPGroupLink (GLPKnown gInfo)
|
||||
| not (memberActive membership) && not (memberRemoved membership) =
|
||||
pure $ CPGroupLink (GLPConnectingProhibit $ Just gInfo)
|
||||
| memberActive membership = pure $ CPGroupLink (GLPKnown gInfo)
|
||||
|
|
|
|||
|
|
@ -218,10 +218,11 @@ prepareGroupMsg db user g@GroupInfo {membership} mc mentions quotedItemId_ itemF
|
|||
|
||||
updatedMentionNames :: MsgContent -> Maybe MarkdownList -> Map MemberName CIMention -> (MsgContent, Maybe MarkdownList, Map MemberName CIMention)
|
||||
updatedMentionNames mc ft_ mentions = case ft_ of
|
||||
Just ft | not (null ft) && not (null mentions) && not (all sameName $ M.assocs mentions) ->
|
||||
let (mentions', ft') = mapAccumL update M.empty ft
|
||||
text = T.concat $ map markdownText ft'
|
||||
in (mc {text} :: MsgContent, Just ft', mentions')
|
||||
Just ft
|
||||
| not (null ft) && not (null mentions) && not (all sameName $ M.assocs mentions) ->
|
||||
let (mentions', ft') = mapAccumL update M.empty ft
|
||||
text = T.concat $ map markdownText ft'
|
||||
in (mc {text} :: MsgContent, Just ft', mentions')
|
||||
_ -> (mc, ft_, mentions)
|
||||
where
|
||||
sameName (name, CIMention {memberRef}) = case memberRef of
|
||||
|
|
@ -261,9 +262,10 @@ getCIMentions db user GroupInfo {groupId} ft_ mentions = case ft_ of
|
|||
|
||||
getRcvCIMentions :: DB.Connection -> User -> GroupInfo -> Maybe MarkdownList -> Map MemberName MsgMention -> IO (Map MemberName CIMention)
|
||||
getRcvCIMentions db user GroupInfo {groupId} ft_ mentions = case ft_ of
|
||||
Just ft | not (null ft) && not (null mentions) ->
|
||||
let mentions' = uniqueMsgMentions maxRcvMentions mentions $ mentionedNames ft
|
||||
in mapM (getMentionedMemberByMemberId db user groupId) mentions'
|
||||
Just ft
|
||||
| not (null ft) && not (null mentions) ->
|
||||
let mentions' = uniqueMsgMentions maxRcvMentions mentions $ mentionedNames ft
|
||||
in mapM (getMentionedMemberByMemberId db user groupId) mentions'
|
||||
_ -> pure M.empty
|
||||
|
||||
-- prevent "invisible" and repeated-with-different-name mentions
|
||||
|
|
@ -274,8 +276,9 @@ uniqueMsgMentions maxMentions mentions = go M.empty S.empty 0
|
|||
go acc seen n (name : rest)
|
||||
| n >= maxMentions = acc
|
||||
| otherwise = case M.lookup name mentions of
|
||||
Just mm@MsgMention {memberId} | S.notMember memberId seen ->
|
||||
go (M.insert name mm acc) (S.insert memberId seen) (n + 1) rest
|
||||
Just mm@MsgMention {memberId}
|
||||
| S.notMember memberId seen ->
|
||||
go (M.insert name mm acc) (S.insert memberId seen) (n + 1) rest
|
||||
_ -> go acc seen n rest
|
||||
|
||||
getMessageMentions :: DB.Connection -> User -> GroupId -> Text -> IO (Map MemberName GroupMemberId)
|
||||
|
|
@ -827,7 +830,7 @@ acceptGroupJoinRequestAsync
|
|||
gVar <- asks random
|
||||
(groupMemberId, memberId) <- withStore $ \db -> do
|
||||
liftIO $ deleteContactRequestRec db user ucr
|
||||
createAcceptedMember db gVar user gInfo ucr gLinkMemRole
|
||||
createJoiningMember db gVar user gInfo ucr gLinkMemRole GSMemAccepted
|
||||
currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo
|
||||
let Profile {displayName} = profileToSendOnAccept user incognitoProfile True
|
||||
GroupMember {memberRole = userRole, memberId = userMemberId} = membership
|
||||
|
|
@ -846,7 +849,34 @@ acceptGroupJoinRequestAsync
|
|||
let chatV = vr `peerConnChatVersion` cReqChatVRange
|
||||
connIds <- agentAcceptContactAsync user True invId msg subMode PQSupportOff chatV
|
||||
withStore $ \db -> do
|
||||
liftIO $ createAcceptedMemberConnection db user connIds chatV ucr groupMemberId subMode
|
||||
liftIO $ createJoiningMemberConnection db user connIds chatV ucr groupMemberId subMode
|
||||
getGroupMemberById db vr user groupMemberId
|
||||
|
||||
acceptGroupJoinSendRejectAsync :: User -> GroupInfo -> UserContactRequest -> GroupRejectionReason -> CM GroupMember
|
||||
acceptGroupJoinSendRejectAsync
|
||||
user
|
||||
gInfo@GroupInfo {groupProfile, membership}
|
||||
ucr@UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange}
|
||||
rejectionReason = do
|
||||
gVar <- asks random
|
||||
(groupMemberId, memberId) <- withStore $ \db -> do
|
||||
liftIO $ deleteContactRequestRec db user ucr
|
||||
createJoiningMember db gVar user gInfo ucr GRObserver GSMemRejected
|
||||
let GroupMember {memberRole = userRole, memberId = userMemberId} = membership
|
||||
msg =
|
||||
XGrpLinkReject $
|
||||
GroupLinkRejection
|
||||
{ fromMember = MemberIdRole userMemberId userRole,
|
||||
invitedMember = MemberIdRole memberId GRObserver,
|
||||
groupProfile,
|
||||
rejectionReason
|
||||
}
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
vr <- chatVersionRange
|
||||
let chatV = vr `peerConnChatVersion` cReqChatVRange
|
||||
connIds <- agentAcceptContactAsync user False invId msg subMode PQSupportOff chatV
|
||||
withStore $ \db -> do
|
||||
liftIO $ createJoiningMemberConnection db user connIds chatV ucr groupMemberId subMode
|
||||
getGroupMemberById db vr user groupMemberId
|
||||
|
||||
acceptBusinessJoinRequestAsync :: User -> UserContactRequest -> CM GroupInfo
|
||||
|
|
@ -879,7 +909,7 @@ acceptBusinessJoinRequestAsync
|
|||
subMode <- chatReadVar subscriptionMode
|
||||
let chatV = vr `peerConnChatVersion` cReqChatVRange
|
||||
connIds <- agentAcceptContactAsync user True invId msg subMode PQSupportOff chatV
|
||||
withStore' $ \db -> createAcceptedMemberConnection db user connIds chatV ucr groupMemberId subMode
|
||||
withStore' $ \db -> createJoiningMemberConnection db user connIds chatV ucr groupMemberId subMode
|
||||
let cd = CDGroupSnd gInfo
|
||||
createInternalChatItem user cd (CISndGroupE2EEInfo E2EInfo {pqEnabled = PQEncOff}) Nothing
|
||||
createGroupFeatureItems user cd CISndGroupFeature gInfo
|
||||
|
|
@ -1514,7 +1544,7 @@ sendGroupMessages_ _user gInfo@GroupInfo {groupId} members events = do
|
|||
(subtract 1 <$> memIdx_,) $ snd $ foldr' addBody (lastRef, memIdsReqs) mbs
|
||||
where
|
||||
addBody :: Either ChatError a -> (Int, ([GroupMemberId], [Either ChatError ChatMsgReq])) -> (Int, ([GroupMemberId], [Either ChatError ChatMsgReq]))
|
||||
addBody mb (i, (memIds, reqs)) =
|
||||
addBody mb (i, (memIds, reqs)) =
|
||||
let req = (conn,msgFlags,) . mkMb memIdx_ i <$> mb
|
||||
in (i - 1, (groupMemberId : memIds, req : reqs))
|
||||
sndMessageMBR :: Maybe Int -> Int -> SndMessage -> (ValueOrRef MsgBody, [MessageId])
|
||||
|
|
@ -1542,10 +1572,10 @@ sendGroupMessages_ _user gInfo@GroupInfo {groupId} members events = do
|
|||
data MemberSendAction = MSASend Connection | MSASendBatched Connection | MSAPending | MSAForwarded
|
||||
|
||||
memberSendAction :: GroupInfo -> NonEmpty (ChatMsgEvent e) -> [GroupMember] -> GroupMember -> Maybe MemberSendAction
|
||||
memberSendAction gInfo events members m@GroupMember {memberRole} = case memberConn m of
|
||||
memberSendAction gInfo events members m@GroupMember {memberRole, memberStatus} = case memberConn m of
|
||||
Nothing -> pendingOrForwarded
|
||||
Just conn@Connection {connStatus}
|
||||
| connDisabled conn || connStatus == ConnDeleted -> Nothing
|
||||
| connDisabled conn || connStatus == ConnDeleted || memberStatus == GSMemRejected -> Nothing
|
||||
| connInactive conn -> Just MSAPending
|
||||
| connStatus == ConnSndReady || connStatus == ConnReady -> sendBatchedOrSeparate conn
|
||||
| otherwise -> pendingOrForwarded
|
||||
|
|
|
|||
|
|
@ -22,7 +22,6 @@ import Control.Monad.Except
|
|||
import Control.Monad.IO.Unlift
|
||||
import Control.Monad.Reader
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.ByteString.Base64 as B64
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.Either (lefts, partitionEithers, rights)
|
||||
|
|
@ -764,11 +763,16 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
-- TODO update member profile
|
||||
pure ()
|
||||
| otherwise -> messageError "x.grp.mem.info: memberId is different from expected"
|
||||
XInfo _ -> pure () -- sent when connecting via group link
|
||||
-- sent when connecting via group link
|
||||
XInfo _ ->
|
||||
-- TODO [group rejection] Keep rejected member record and connection for ability to start dialogue.
|
||||
when (memberStatus m == GSMemRejected) $ do
|
||||
deleteMemberConnection' user m True
|
||||
withStore' $ \db -> deleteGroupMember db user m
|
||||
XOk -> pure ()
|
||||
_ -> messageError "INFO from member must have x.grp.mem.info, x.info or x.ok"
|
||||
pure ()
|
||||
CON _pqEnc -> do
|
||||
CON _pqEnc -> unless (memberStatus m == GSMemRejected) $ do
|
||||
withStore' $ \db -> do
|
||||
updateGroupMemberStatus db userId m GSMemConnected
|
||||
unless (memberActive membership) $
|
||||
|
|
@ -1291,8 +1295,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
where
|
||||
profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> CM ()
|
||||
profileContactRequest invId chatVRange p@Profile {displayName, image} xContactId_ reqPQSup = do
|
||||
cfg <- asks config
|
||||
withAllowedName cfg $ withStore (\db -> createOrUpdateContactRequest db vr user userContactLinkId invId chatVRange p xContactId_ reqPQSup) >>= \case
|
||||
withStore (\db -> createOrUpdateContactRequest db vr user userContactLinkId invId chatVRange p xContactId_ reqPQSup) >>= \case
|
||||
CORContact contact -> toView $ CRContactRequestAlreadyAccepted user contact
|
||||
CORGroup gInfo -> toView $ CRBusinessRequestAlreadyAccepted user gInfo
|
||||
CORRequest cReq -> do
|
||||
|
|
@ -1318,19 +1321,29 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
toView $ CRAcceptingContactRequest user ct
|
||||
Just groupId -> do
|
||||
gInfo <- withStore $ \db -> getGroupInfo db vr user groupId
|
||||
let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
|
||||
if v >= groupFastLinkJoinVersion
|
||||
then do
|
||||
let useRole = userMemberRole gLinkMemRole $ acceptAsObserver cfg
|
||||
mem <- acceptGroupJoinRequestAsync user gInfo cReq useRole profileMode
|
||||
createInternalChatItem user (CDGroupRcv gInfo mem) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
|
||||
toView $ CRAcceptingGroupJoinRequestMember user gInfo mem
|
||||
else messageError "processUserContactRequest: chat version range incompatible for accepting group join request"
|
||||
cfg <- asks config
|
||||
case rejectionReason cfg of
|
||||
Nothing
|
||||
| v < groupFastLinkJoinVersion ->
|
||||
messageError "processUserContactRequest: chat version range incompatible for accepting group join request"
|
||||
| otherwise -> do
|
||||
let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
|
||||
useRole = userMemberRole gLinkMemRole $ acceptAsObserver cfg
|
||||
mem <- acceptGroupJoinRequestAsync user gInfo cReq useRole profileMode
|
||||
createInternalChatItem user (CDGroupRcv gInfo mem) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
|
||||
toView $ CRAcceptingGroupJoinRequestMember user gInfo mem
|
||||
Just rjctReason
|
||||
| v < groupJoinRejectVersion ->
|
||||
messageWarning $ "processUserContactRequest (group " <> groupName' gInfo <> "): joining of " <> displayName <> " is blocked"
|
||||
| otherwise -> do
|
||||
mem <- acceptGroupJoinSendRejectAsync user gInfo cReq rjctReason
|
||||
toViewTE $ TERejectingGroupJoinRequestMember user gInfo mem rjctReason
|
||||
_ -> toView $ CRReceivedContactRequest user cReq
|
||||
where
|
||||
withAllowedName ChatConfig {profileNameLimit, allowedProfileName} action
|
||||
| T.length displayName <= profileNameLimit && maybe True ($ displayName) allowedProfileName = action
|
||||
| otherwise = liftIO $ putStrLn $ "Joining of " <> T.unpack displayName <> " is blocked" -- TODO send response, maybe event to UI?
|
||||
rejectionReason ChatConfig {profileNameLimit, allowedProfileName}
|
||||
| T.length displayName > profileNameLimit = Just GRRLongName
|
||||
| maybe False (\f -> not $ f displayName) allowedProfileName = Just GRRBlockedName
|
||||
| otherwise = Nothing
|
||||
userMemberRole linkRole = \case
|
||||
Just AOAll -> GRObserver
|
||||
Just AONameOnly | noImage -> GRObserver
|
||||
|
|
@ -2475,6 +2488,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
(gInfo, host) <- withStore $ \db -> createGroupInvitedViaLink db vr user conn' glInv
|
||||
toView $ CRGroupLinkConnecting user gInfo host
|
||||
pure (conn', True)
|
||||
XGrpLinkReject glRjct@GroupLinkRejection {rejectionReason} -> do
|
||||
(gInfo, host) <- withStore $ \db -> createGroupRejectedViaLink db vr user conn' glRjct
|
||||
toView $ CRGroupLinkConnecting user gInfo host
|
||||
toViewTE $ TEGroupLinkRejected user gInfo rejectionReason
|
||||
pure (conn', True)
|
||||
-- TODO show/log error, other events in SMP confirmation
|
||||
_ -> pure (conn', False)
|
||||
|
||||
|
|
@ -2828,7 +2846,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
|||
|
||||
createUnknownMember :: GroupInfo -> MemberId -> CM GroupMember
|
||||
createUnknownMember gInfo memberId = do
|
||||
let name = T.take 7 . safeDecodeUtf8 . B64.encode . unMemberId $ memberId
|
||||
let name = nameFromMemberId memberId
|
||||
withStore $ \db -> createNewUnknownGroupMember db vr user gInfo memberId name
|
||||
|
||||
directMsgReceived :: Contact -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> CM ()
|
||||
|
|
|
|||
|
|
@ -74,12 +74,13 @@ import Simplex.Messaging.Version hiding (version)
|
|||
-- 10 - business chats (2024-11-29)
|
||||
-- 11 - fix profile update in business chats (2024-12-05)
|
||||
-- 12 - support sending and receiving content reports (2025-01-03)
|
||||
-- 14 - support sending and receiving group join rejection (2025-02-24)
|
||||
|
||||
-- This should not be used directly in code, instead use `maxVersion chatVRange` from ChatConfig.
|
||||
-- This indirection is needed for backward/forward compatibility testing.
|
||||
-- Testing with real app versions is still needed, as tests use the current code with different version ranges, not the old code.
|
||||
currentChatVersion :: VersionChat
|
||||
currentChatVersion = VersionChat 12
|
||||
currentChatVersion = VersionChat 14
|
||||
|
||||
-- This should not be used directly in code, instead use `chatVRange` from ChatConfig (see comment above)
|
||||
supportedChatVRange :: VersionRangeChat
|
||||
|
|
@ -130,6 +131,10 @@ businessChatPrefsVersion = VersionChat 11
|
|||
contentReportsVersion :: VersionChat
|
||||
contentReportsVersion = VersionChat 12
|
||||
|
||||
-- support sending and receiving group join rejection (XGrpLinkReject)
|
||||
groupJoinRejectVersion :: VersionChat
|
||||
groupJoinRejectVersion = VersionChat 14
|
||||
|
||||
agentToChatVersion :: VersionSMPA -> VersionChat
|
||||
agentToChatVersion v
|
||||
| v < pqdrSMPAgentVersion = initialChatVersion
|
||||
|
|
@ -326,7 +331,7 @@ data ChatMsgEvent (e :: MsgEncoding) where
|
|||
XGrpInv :: GroupInvitation -> ChatMsgEvent 'Json
|
||||
XGrpAcpt :: MemberId -> ChatMsgEvent 'Json
|
||||
XGrpLinkInv :: GroupLinkInvitation -> ChatMsgEvent 'Json
|
||||
-- XGrpLinkReject :: GroupProfile -> RejectionReason -> ChatMsgEvent 'Json
|
||||
XGrpLinkReject :: GroupLinkRejection -> ChatMsgEvent 'Json
|
||||
XGrpLinkMem :: Profile -> ChatMsgEvent 'Json
|
||||
XGrpMemNew :: MemberInfo -> ChatMsgEvent 'Json
|
||||
XGrpMemIntro :: MemberInfo -> Maybe MemberRestrictions -> ChatMsgEvent 'Json
|
||||
|
|
@ -816,6 +821,7 @@ data CMEventTag (e :: MsgEncoding) where
|
|||
XGrpInv_ :: CMEventTag 'Json
|
||||
XGrpAcpt_ :: CMEventTag 'Json
|
||||
XGrpLinkInv_ :: CMEventTag 'Json
|
||||
XGrpLinkReject_ :: CMEventTag 'Json
|
||||
XGrpLinkMem_ :: CMEventTag 'Json
|
||||
XGrpMemNew_ :: CMEventTag 'Json
|
||||
XGrpMemIntro_ :: CMEventTag 'Json
|
||||
|
|
@ -867,6 +873,7 @@ instance MsgEncodingI e => StrEncoding (CMEventTag e) where
|
|||
XGrpInv_ -> "x.grp.inv"
|
||||
XGrpAcpt_ -> "x.grp.acpt"
|
||||
XGrpLinkInv_ -> "x.grp.link.inv"
|
||||
XGrpLinkReject_ -> "x.grp.link.reject"
|
||||
XGrpLinkMem_ -> "x.grp.link.mem"
|
||||
XGrpMemNew_ -> "x.grp.mem.new"
|
||||
XGrpMemIntro_ -> "x.grp.mem.intro"
|
||||
|
|
@ -919,6 +926,7 @@ instance StrEncoding ACMEventTag where
|
|||
"x.grp.inv" -> XGrpInv_
|
||||
"x.grp.acpt" -> XGrpAcpt_
|
||||
"x.grp.link.inv" -> XGrpLinkInv_
|
||||
"x.grp.link.reject" -> XGrpLinkReject_
|
||||
"x.grp.link.mem" -> XGrpLinkMem_
|
||||
"x.grp.mem.new" -> XGrpMemNew_
|
||||
"x.grp.mem.intro" -> XGrpMemIntro_
|
||||
|
|
@ -967,6 +975,7 @@ toCMEventTag msg = case msg of
|
|||
XGrpInv _ -> XGrpInv_
|
||||
XGrpAcpt _ -> XGrpAcpt_
|
||||
XGrpLinkInv _ -> XGrpLinkInv_
|
||||
XGrpLinkReject _ -> XGrpLinkReject_
|
||||
XGrpLinkMem _ -> XGrpLinkMem_
|
||||
XGrpMemNew _ -> XGrpMemNew_
|
||||
XGrpMemIntro _ _ -> XGrpMemIntro_
|
||||
|
|
@ -1068,6 +1077,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
|
|||
XGrpInv_ -> XGrpInv <$> p "groupInvitation"
|
||||
XGrpAcpt_ -> XGrpAcpt <$> p "memberId"
|
||||
XGrpLinkInv_ -> XGrpLinkInv <$> p "groupLinkInvitation"
|
||||
XGrpLinkReject_ -> XGrpLinkReject <$> p "groupLinkRejection"
|
||||
XGrpLinkMem_ -> XGrpLinkMem <$> p "profile"
|
||||
XGrpMemNew_ -> XGrpMemNew <$> p "memberInfo"
|
||||
XGrpMemIntro_ -> XGrpMemIntro <$> p "memberInfo" <*> opt "memberRestrictions"
|
||||
|
|
@ -1130,6 +1140,7 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @
|
|||
XGrpInv groupInv -> o ["groupInvitation" .= groupInv]
|
||||
XGrpAcpt memId -> o ["memberId" .= memId]
|
||||
XGrpLinkInv groupLinkInv -> o ["groupLinkInvitation" .= groupLinkInv]
|
||||
XGrpLinkReject groupLinkRjct -> o ["groupLinkRejection" .= groupLinkRjct]
|
||||
XGrpLinkMem profile -> o ["profile" .= profile]
|
||||
XGrpMemNew memInfo -> o ["memberInfo" .= memInfo]
|
||||
XGrpMemIntro memInfo memRestrictions -> o $ ("memberRestrictions" .=? memRestrictions) ["memberInfo" .= memInfo]
|
||||
|
|
|
|||
|
|
@ -33,6 +33,7 @@ module Simplex.Chat.Store.Groups
|
|||
createGroupInvitation,
|
||||
deleteContactCardKeepConn,
|
||||
createGroupInvitedViaLink,
|
||||
createGroupRejectedViaLink,
|
||||
setViaGroupLinkHash,
|
||||
setGroupInvitationChatItemId,
|
||||
getGroup,
|
||||
|
|
@ -67,8 +68,8 @@ module Simplex.Chat.Store.Groups
|
|||
getGroupInvitation,
|
||||
createNewContactMember,
|
||||
createNewContactMemberAsync,
|
||||
createAcceptedMember,
|
||||
createAcceptedMemberConnection,
|
||||
createJoiningMember,
|
||||
createJoiningMemberConnection,
|
||||
createBusinessRequestGroup,
|
||||
getContactViaMember,
|
||||
setNewContactMemberConnRequest,
|
||||
|
|
@ -519,18 +520,33 @@ deleteContactCardKeepConn db connId Contact {contactId, profile = LocalProfile {
|
|||
DB.execute db "DELETE FROM contact_profiles WHERE contact_profile_id = ?" (Only profileId)
|
||||
|
||||
createGroupInvitedViaLink :: DB.Connection -> VersionRangeChat -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
|
||||
createGroupInvitedViaLink
|
||||
createGroupInvitedViaLink db vr user conn GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, business} = do
|
||||
let fromMemberProfile = profileFromName fromMemberName
|
||||
createGroupViaLink' db vr user conn fromMember fromMemberProfile invitedMember groupProfile business GSMemAccepted
|
||||
|
||||
createGroupRejectedViaLink :: DB.Connection -> VersionRangeChat -> User -> Connection -> GroupLinkRejection -> ExceptT StoreError IO (GroupInfo, GroupMember)
|
||||
createGroupRejectedViaLink db vr user conn GroupLinkRejection {fromMember = fromMember@MemberIdRole {memberId}, invitedMember, groupProfile} = do
|
||||
let fromMemberProfile = profileFromName $ nameFromMemberId memberId
|
||||
createGroupViaLink' db vr user conn fromMember fromMemberProfile invitedMember groupProfile Nothing GSMemRejected
|
||||
|
||||
createGroupViaLink' :: DB.Connection -> VersionRangeChat -> User -> Connection -> MemberIdRole -> Profile -> MemberIdRole -> GroupProfile -> Maybe BusinessChatInfo -> GroupMemberStatus -> ExceptT StoreError IO (GroupInfo, GroupMember)
|
||||
createGroupViaLink'
|
||||
db
|
||||
vr
|
||||
user@User {userId, userContactId}
|
||||
Connection {connId, customUserProfileId}
|
||||
GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, business} = do
|
||||
fromMember
|
||||
fromMemberProfile
|
||||
invitedMember
|
||||
groupProfile
|
||||
business
|
||||
memStatus = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
groupId <- insertGroup_ currentTs
|
||||
hostMemberId <- insertHost_ currentTs groupId
|
||||
liftIO $ DB.execute db "UPDATE connections SET conn_type = ?, group_member_id = ?, updated_at = ? WHERE connection_id = ?" (ConnMember, hostMemberId, currentTs, connId)
|
||||
-- using IBUnknown since host is created without contact
|
||||
void $ createContactMemberInv_ db user groupId (Just hostMemberId) user invitedMember GCUserMember GSMemAccepted IBUnknown customUserProfileId currentTs vr
|
||||
void $ createContactMemberInv_ db user groupId (Just hostMemberId) user invitedMember GCUserMember memStatus IBUnknown customUserProfileId currentTs vr
|
||||
liftIO $ setViaGroupLinkHash db groupId connId
|
||||
(,) <$> getGroupInfo db vr user groupId <*> getGroupMemberById db vr user hostMemberId
|
||||
where
|
||||
|
|
@ -554,7 +570,6 @@ createGroupInvitedViaLink
|
|||
((profileId, localDisplayName, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. businessChatInfoRow business)
|
||||
insertedRowId db
|
||||
insertHost_ currentTs groupId = do
|
||||
let fromMemberProfile = profileFromName fromMemberName
|
||||
(localDisplayName, profileId) <- createNewMemberProfile_ db user fromMemberProfile currentTs
|
||||
let MemberIdRole {memberId, memberRole} = fromMember
|
||||
liftIO $ do
|
||||
|
|
@ -566,7 +581,7 @@ createGroupInvitedViaLink
|
|||
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (groupId, memberId, memberRole, GCHostMember, GSMemAccepted, fromInvitedBy userContactId IBUnknown)
|
||||
( (groupId, memberId, memberRole, GCHostMember, memStatus, fromInvitedBy userContactId IBUnknown)
|
||||
:. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, currentTs, currentTs)
|
||||
)
|
||||
insertedRowId db
|
||||
|
|
@ -783,9 +798,9 @@ getGroupSummary db User {userId} groupId = do
|
|||
JOIN group_members m USING (group_id)
|
||||
WHERE g.user_id = ?
|
||||
AND g.group_id = ?
|
||||
AND m.member_status NOT IN (?,?,?,?)
|
||||
AND m.member_status NOT IN (?,?,?,?,?)
|
||||
|]
|
||||
(userId, groupId, GSMemRemoved, GSMemLeft, GSMemUnknown, GSMemInvited)
|
||||
(userId, groupId, GSMemRejected, GSMemRemoved, GSMemLeft, GSMemUnknown, GSMemInvited)
|
||||
pure GroupSummary {currentMembers = fromMaybe 0 currentMembers_}
|
||||
|
||||
getContactGroupPreferences :: DB.Connection -> User -> Contact -> IO [(GroupMemberRole, FullGroupPreferences)]
|
||||
|
|
@ -1026,14 +1041,15 @@ createNewContactMemberAsync db gVar user@User {userId, userContactId} GroupInfo
|
|||
:. (minV, maxV)
|
||||
)
|
||||
|
||||
createAcceptedMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> UserContactRequest -> GroupMemberRole -> ExceptT StoreError IO (GroupMemberId, MemberId)
|
||||
createAcceptedMember
|
||||
createJoiningMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> UserContactRequest -> GroupMemberRole -> GroupMemberStatus -> ExceptT StoreError IO (GroupMemberId, MemberId)
|
||||
createJoiningMember
|
||||
db
|
||||
gVar
|
||||
User {userId, userContactId}
|
||||
GroupInfo {groupId, membership}
|
||||
UserContactRequest {cReqChatVRange, localDisplayName, profileId}
|
||||
memberRole =
|
||||
memberRole
|
||||
memberStatus =
|
||||
createWithRandomId gVar $ \memId -> do
|
||||
createdAt <- liftIO getCurrentTime
|
||||
insertMember_ (MemberId memId) createdAt
|
||||
|
|
@ -1051,13 +1067,13 @@ createAcceptedMember
|
|||
peer_chat_min_version, peer_chat_max_version)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (groupId, memberId, memberRole, GCInviteeMember, GSMemAccepted, fromInvitedBy userContactId IBUser, groupMemberId' membership)
|
||||
( (groupId, memberId, memberRole, GCInviteeMember, memberStatus, fromInvitedBy userContactId IBUser, groupMemberId' membership)
|
||||
:. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, createdAt, createdAt)
|
||||
:. (minV, maxV)
|
||||
)
|
||||
|
||||
createAcceptedMemberConnection :: DB.Connection -> User -> (CommandId, ConnId) -> VersionChat -> UserContactRequest -> GroupMemberId -> SubscriptionMode -> IO ()
|
||||
createAcceptedMemberConnection
|
||||
createJoiningMemberConnection :: DB.Connection -> User -> (CommandId, ConnId) -> VersionChat -> UserContactRequest -> GroupMemberId -> SubscriptionMode -> IO ()
|
||||
createJoiningMemberConnection
|
||||
db
|
||||
user@User {userId}
|
||||
(cmdId, agentConnId)
|
||||
|
|
|
|||
|
|
@ -1012,7 +1012,7 @@ Query:
|
|||
JOIN group_members m USING (group_id)
|
||||
WHERE g.user_id = ?
|
||||
AND g.group_id = ?
|
||||
AND m.member_status NOT IN (?,?,?,?)
|
||||
AND m.member_status NOT IN (?,?,?,?,?)
|
||||
|
||||
Plan:
|
||||
SEARCH g USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
|
@ -5025,6 +5025,15 @@ SEARCH commands USING COVERING INDEX idx_commands_connection_id (connection_id=?
|
|||
SEARCH messages USING COVERING INDEX idx_messages_connection_id (connection_id=?)
|
||||
SEARCH snd_files USING COVERING INDEX idx_snd_files_connection_id (connection_id=?)
|
||||
|
||||
Query: DELETE FROM contact_profiles WHERE user_id = ? AND contact_profile_id = ?
|
||||
Plan:
|
||||
SEARCH contact_profiles USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH contact_requests USING COVERING INDEX idx_contact_requests_contact_profile_id (contact_profile_id=?)
|
||||
SEARCH connections USING COVERING INDEX idx_connections_custom_user_profile_id (custom_user_profile_id=?)
|
||||
SEARCH group_members USING COVERING INDEX idx_group_members_member_profile_id (member_profile_id=?)
|
||||
SEARCH group_members USING COVERING INDEX idx_group_members_contact_profile_id (contact_profile_id=?)
|
||||
SEARCH contacts USING COVERING INDEX idx_contacts_contact_profile_id (contact_profile_id=?)
|
||||
|
||||
Query: DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?
|
||||
Plan:
|
||||
SEARCH contact_requests USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
|
@ -5496,6 +5505,10 @@ Query: SELECT count(1) FROM chat_items WHERE chat_item_id > ?
|
|||
Plan:
|
||||
SEARCH chat_items USING INTEGER PRIMARY KEY (rowid>?)
|
||||
|
||||
Query: SELECT count(1) FROM group_members
|
||||
Plan:
|
||||
SCAN group_members USING COVERING INDEX idx_group_members_invited_by_group_member_id
|
||||
|
||||
Query: SELECT count(1) FROM pending_group_messages
|
||||
Plan:
|
||||
SCAN pending_group_messages USING COVERING INDEX idx_pending_group_messages_group_member_id
|
||||
|
|
@ -5532,6 +5545,10 @@ Query: SELECT group_id FROM user_contact_links WHERE user_id = ? AND user_contac
|
|||
Plan:
|
||||
SEARCH user_contact_links USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query: SELECT group_member_id FROM group_members WHERE user_id = ? AND contact_profile_id = ? AND group_member_id != ? LIMIT 1
|
||||
Plan:
|
||||
SEARCH group_members USING INDEX idx_group_members_user_id (user_id=?)
|
||||
|
||||
Query: SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND local_display_name = ?
|
||||
Plan:
|
||||
SEARCH group_members USING INDEX idx_group_members_group_id (user_id=? AND group_id=?)
|
||||
|
|
|
|||
|
|
@ -26,14 +26,17 @@
|
|||
|
||||
module Simplex.Chat.Types where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
import Crypto.Number.Serialize (os2ip)
|
||||
import Data.Aeson (FromJSON (..), ToJSON (..))
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Aeson.Encoding as JE
|
||||
import qualified Data.Aeson.TH as JQ
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||
import qualified Data.ByteString.Base64 as B64
|
||||
import Data.ByteString.Char8 (ByteString, pack, unpack)
|
||||
import qualified Data.ByteString.Lazy as LB
|
||||
import Data.Functor (($>))
|
||||
import Data.Int (Int64)
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Text (Text)
|
||||
|
|
@ -670,6 +673,41 @@ data GroupLinkInvitation = GroupLinkInvitation
|
|||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data GroupLinkRejection = GroupLinkRejection
|
||||
{ fromMember :: MemberIdRole,
|
||||
invitedMember :: MemberIdRole,
|
||||
groupProfile :: GroupProfile,
|
||||
rejectionReason :: GroupRejectionReason
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data GroupRejectionReason
|
||||
= GRRLongName
|
||||
| GRRBlockedName
|
||||
| GRRUnknown {text :: Text}
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance FromField GroupRejectionReason where fromField = blobFieldDecoder strDecode
|
||||
|
||||
instance ToField GroupRejectionReason where toField = toField . strEncode
|
||||
|
||||
instance StrEncoding GroupRejectionReason where
|
||||
strEncode = \case
|
||||
GRRLongName -> "long_name"
|
||||
GRRBlockedName -> "blocked_name"
|
||||
GRRUnknown text -> encodeUtf8 text
|
||||
strP =
|
||||
"long_name" $> GRRLongName
|
||||
<|> "blocked_name" $> GRRBlockedName
|
||||
<|> GRRUnknown . safeDecodeUtf8 <$> A.takeByteString
|
||||
|
||||
instance FromJSON GroupRejectionReason where
|
||||
parseJSON = strParseJSON "GroupRejectionReason"
|
||||
|
||||
instance ToJSON GroupRejectionReason where
|
||||
toJSON = strToJSON
|
||||
toEncoding = strToJEncoding
|
||||
|
||||
data MemberIdRole = MemberIdRole
|
||||
{ memberId :: MemberId,
|
||||
memberRole :: GroupMemberRole
|
||||
|
|
@ -862,6 +900,9 @@ instance ToJSON MemberId where
|
|||
toJSON = strToJSON
|
||||
toEncoding = strToJEncoding
|
||||
|
||||
nameFromMemberId :: MemberId -> ContactName
|
||||
nameFromMemberId = T.take 7 . safeDecodeUtf8 . B64.encode . unMemberId
|
||||
|
||||
data InvitedBy = IBContact {byContactId :: Int64} | IBUser | IBUnknown
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
|
@ -950,7 +991,8 @@ instance TextEncoding GroupMemberCategory where
|
|||
GCPostMember -> "post"
|
||||
|
||||
data GroupMemberStatus
|
||||
= GSMemRemoved -- member who was removed from the group
|
||||
= GSMemRejected -- joining member who was rejected by the host, or host that rejected the join
|
||||
| GSMemRemoved -- member who was removed from the group
|
||||
| GSMemLeft -- member who left the group
|
||||
| GSMemGroupDeleted -- user member of the deleted group
|
||||
| GSMemUnknown -- unknown member, whose message was forwarded by an admin (likely member wasn't introduced due to not being a current member, but message was included in history)
|
||||
|
|
@ -977,6 +1019,7 @@ instance ToJSON GroupMemberStatus where
|
|||
|
||||
memberActive :: GroupMember -> Bool
|
||||
memberActive m = case memberStatus m of
|
||||
GSMemRejected -> False
|
||||
GSMemRemoved -> False
|
||||
GSMemLeft -> False
|
||||
GSMemGroupDeleted -> False
|
||||
|
|
@ -996,6 +1039,7 @@ memberCurrent = memberCurrent' . memberStatus
|
|||
-- update getGroupSummary if this is changed
|
||||
memberCurrent' :: GroupMemberStatus -> Bool
|
||||
memberCurrent' = \case
|
||||
GSMemRejected -> False
|
||||
GSMemRemoved -> False
|
||||
GSMemLeft -> False
|
||||
GSMemGroupDeleted -> False
|
||||
|
|
@ -1011,6 +1055,7 @@ memberCurrent' = \case
|
|||
|
||||
memberRemoved :: GroupMember -> Bool
|
||||
memberRemoved m = case memberStatus m of
|
||||
GSMemRejected -> True
|
||||
GSMemRemoved -> True
|
||||
GSMemLeft -> True
|
||||
GSMemGroupDeleted -> True
|
||||
|
|
@ -1026,6 +1071,7 @@ memberRemoved m = case memberStatus m of
|
|||
|
||||
instance TextEncoding GroupMemberStatus where
|
||||
textDecode = \case
|
||||
"rejected" -> Just GSMemRejected
|
||||
"removed" -> Just GSMemRemoved
|
||||
"left" -> Just GSMemLeft
|
||||
"deleted" -> Just GSMemGroupDeleted
|
||||
|
|
@ -1040,6 +1086,7 @@ instance TextEncoding GroupMemberStatus where
|
|||
"creator" -> Just GSMemCreator
|
||||
_ -> Nothing
|
||||
textEncode = \case
|
||||
GSMemRejected -> "rejected"
|
||||
GSMemRemoved -> "removed"
|
||||
GSMemLeft -> "left"
|
||||
GSMemGroupDeleted -> "deleted"
|
||||
|
|
@ -1793,6 +1840,8 @@ $(JQ.deriveJSON defaultJSON ''GroupInvitation)
|
|||
|
||||
$(JQ.deriveJSON defaultJSON ''GroupLinkInvitation)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''GroupLinkRejection)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''IntroInvitation)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''MemberRestrictions)
|
||||
|
|
|
|||
|
|
@ -444,6 +444,9 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
|
|||
CRAppSettings as -> ["app settings: " <> viewJSON as]
|
||||
CRTimedAction _ _ -> []
|
||||
CRCustomChatResponse u r -> ttyUser' u $ map plain $ T.lines r
|
||||
CRTerminalEvent te -> case te of
|
||||
TERejectingGroupJoinRequestMember _ g m reason -> [ttyFullMember m <> ": rejecting request to join group " <> ttyGroup' g <> ", reason: " <> sShow reason]
|
||||
TEGroupLinkRejected u g reason -> ttyUser u [ttyGroup' g <> ": join rejected, reason: " <> sShow reason]
|
||||
where
|
||||
ttyUser :: User -> [StyledString] -> [StyledString]
|
||||
ttyUser user@User {showNtfs, activeUser, viewPwdHash} ss
|
||||
|
|
@ -1128,7 +1131,7 @@ showRole = plain . strEncode
|
|||
viewGroupMembers :: Group -> [StyledString]
|
||||
viewGroupMembers (Group GroupInfo {membership} members) = map groupMember . filter (not . removedOrLeft) $ membership : members
|
||||
where
|
||||
removedOrLeft m = let s = memberStatus m in s == GSMemRemoved || s == GSMemLeft
|
||||
removedOrLeft m = let s = memberStatus m in s == GSMemRejected || s == GSMemRemoved || s == GSMemLeft
|
||||
groupMember m = memIncognito m <> ttyFullMember m <> ": " <> plain (intercalate ", " $ [role m] <> category m <> status m <> muted m)
|
||||
role :: GroupMember -> String
|
||||
role GroupMember {memberRole} = B.unpack $ strEncode memberRole
|
||||
|
|
@ -1138,6 +1141,7 @@ viewGroupMembers (Group GroupInfo {membership} members) = map groupMember . filt
|
|||
GCHostMember -> ["host"]
|
||||
_ -> []
|
||||
status m = case memberStatus m of
|
||||
GSMemRejected -> ["rejected"]
|
||||
GSMemRemoved -> ["removed"]
|
||||
GSMemLeft -> ["left"]
|
||||
GSMemUnknown -> ["status unknown"]
|
||||
|
|
@ -1178,6 +1182,7 @@ viewGroupsList gs = map groupSS $ sortOn (ldn_ . fst) gs
|
|||
s -> membershipIncognito g <> ttyFullGroup g <> viewMemberStatus s <> alias g
|
||||
where
|
||||
viewMemberStatus = \case
|
||||
GSMemRejected -> delete "you are rejected"
|
||||
GSMemRemoved -> delete "you are removed"
|
||||
GSMemLeft -> delete "you left"
|
||||
GSMemGroupDeleted -> delete "group deleted"
|
||||
|
|
|
|||
|
|
@ -98,6 +98,7 @@ chatGroupTests = do
|
|||
it "group link member role" testGroupLinkMemberRole
|
||||
it "host profile received" testGroupLinkHostProfileReceived
|
||||
it "existing contact merged" testGroupLinkExistingContactMerged
|
||||
it "reject member joining via group link - blocked name" testGroupLinkRejectBlockedName
|
||||
describe "group link connection plan" $ do
|
||||
it "ok to connect; known group" testPlanGroupLinkKnown
|
||||
it "own group link" testPlanGroupLinkOwn
|
||||
|
|
@ -2871,6 +2872,35 @@ testGroupLinkExistingContactMerged =
|
|||
bob #> "#team hi there"
|
||||
alice <# "#team bob> hi there"
|
||||
|
||||
testGroupLinkRejectBlockedName :: HasCallStack => TestParams -> IO ()
|
||||
testGroupLinkRejectBlockedName =
|
||||
testChatCfg2 cfg aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
alice ##> "/g team"
|
||||
alice <## "group #team is created"
|
||||
alice <## "to add members use /a team <name> or /create link #team"
|
||||
|
||||
alice ##> "/create link #team"
|
||||
gLink <- getGroupLink alice "team" GRMember True
|
||||
bob ##> ("/c " <> gLink)
|
||||
bob <## "connection request sent!"
|
||||
alice <## "bob (Bob): rejecting request to join group #team, reason: GRRBlockedName"
|
||||
bob <## "#team: joining the group..."
|
||||
bob <## "#team: join rejected, reason: GRRBlockedName"
|
||||
|
||||
threadDelay 100000
|
||||
|
||||
alice `hasContactProfiles` ["alice"]
|
||||
memCount <- withCCTransaction alice $ \db ->
|
||||
DB.query_ db "SELECT count(1) FROM group_members" :: IO [[Int]]
|
||||
memCount `shouldBe` [[1]]
|
||||
|
||||
bob ##> ("/c " <> gLink)
|
||||
bob <## "group link: known group #team"
|
||||
bob <## "use #team <message> to send messages"
|
||||
where
|
||||
cfg = testCfg {allowedProfileName = Just (const False)}
|
||||
|
||||
testPlanGroupLinkKnown :: HasCallStack => TestParams -> IO ()
|
||||
testPlanGroupLinkKnown =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
|
|
|
|||
|
|
@ -133,7 +133,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
|||
"{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
|
||||
##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)))
|
||||
it "x.msg.new chat message with chat version range" $
|
||||
"{\"v\":\"1-12\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
|
||||
"{\"v\":\"1-14\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
|
||||
##==## ChatMessage supportedChatVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)))
|
||||
it "x.msg.new quote" $
|
||||
"{\"v\":\"1\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}}}}"
|
||||
|
|
@ -249,13 +249,13 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
|||
"{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
#==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile}
|
||||
it "x.grp.mem.new with member chat version range" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-12\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-14\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
#==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile}
|
||||
it "x.grp.mem.intro" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
#==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} Nothing
|
||||
it "x.grp.mem.intro with member chat version range" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-12\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-14\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
#==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile} Nothing
|
||||
it "x.grp.mem.intro with member restrictions" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberRestrictions\":{\"restriction\":\"blocked\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
|
|
@ -270,7 +270,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
|||
"{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"directConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-3%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-3%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
#==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Just testConnReq}
|
||||
it "x.grp.mem.fwd with member chat version range and w/t directConnReq" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-3%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-12\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"groupConnReq\":\"simplex:/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-3%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-14\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
#==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Nothing}
|
||||
it "x.grp.mem.info" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.info\",\"params\":{\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}"
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue