core: api to create contacts with group members (#3053)
* core: api to create contacts with group members * implementation * fix contact replace, more tests * comment * rename fields * fix * fix * test group is still incognito * fix * replace connection instead of contact * fix * check version * style, names --------- Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
spaced4ndy
GitHub
parent
8178e8183e
commit
0e5b16498a
@ -111,6 +111,7 @@ library
|
||||
Simplex.Chat.Migrations.M20230827_file_encryption
|
||||
Simplex.Chat.Migrations.M20230829_connections_chat_vrange
|
||||
Simplex.Chat.Migrations.M20230903_connections_to_subscribe
|
||||
Simplex.Chat.Migrations.M20230913_member_contacts
|
||||
Simplex.Chat.Mobile
|
||||
Simplex.Chat.Mobile.File
|
||||
Simplex.Chat.Mobile.Shared
|
||||
|
||||
@ -1588,6 +1588,39 @@ processChatCommand = \case
|
||||
gInfo <- withStore $ \db -> getGroupInfo db user groupId
|
||||
(_, groupLink, mRole) <- withStore $ \db -> getGroupLink db user gInfo
|
||||
pure $ CRGroupLink user gInfo groupLink mRole
|
||||
APICreateMemberContact gId gMemberId -> withUser $ \user -> do
|
||||
(g, m) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId
|
||||
assertUserGroupRole g GRAuthor
|
||||
unless (groupFeatureAllowed SGFDirectMessages g) $ throwChatError $ CECommandError "direct messages not allowed"
|
||||
case memberConn m of
|
||||
Just mConn@Connection {peerChatVRange} -> do
|
||||
unless (isCompatibleRange (fromJVersionRange peerChatVRange) xGrpDirectInvVRange) $ throwChatError CEPeerChatVRangeIncompatible
|
||||
when (isJust $ memberContactId m) $ throwChatError $ CECommandError "member contact already exists"
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
(connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing subMode
|
||||
-- [incognito] reuse membership incognito profile
|
||||
ct <- withStore' $ \db -> createMemberContact db user connId cReq g m mConn subMode
|
||||
pure $ CRNewMemberContact user ct g m
|
||||
_ -> throwChatError CEGroupMemberNotActive
|
||||
APISendMemberContactInvitation contactId msgContent_ -> withUser $ \user -> do
|
||||
(g, m, ct, cReq) <- withStore $ \db -> getMemberContact db user contactId
|
||||
when (contactGrpInvSent ct) $ throwChatError $ CECommandError "x.grp.direct.inv already sent"
|
||||
case memberConn m of
|
||||
Just mConn -> do
|
||||
let msg = XGrpDirectInv cReq msgContent_
|
||||
(sndMsg, _) <- sendDirectMessage mConn msg (GroupId $ groupId (g :: GroupInfo))
|
||||
withStore' $ \db -> setContactGrpInvSent db ct True
|
||||
let ct' = ct {contactGrpInvSent = True}
|
||||
forM_ msgContent_ $ \mc -> do
|
||||
ci <- saveSndChatItem user (CDDirectSnd ct') sndMsg (CISndMsgContent mc)
|
||||
toView $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct') ci)
|
||||
pure $ CRNewMemberContactSentInv user ct' g m
|
||||
_ -> throwChatError CEGroupMemberNotActive
|
||||
CreateMemberContact gName mName -> withMemberName gName mName APICreateMemberContact
|
||||
SendMemberContactInvitation cName msg_ -> withUser $ \user -> do
|
||||
contactId <- withStore $ \db -> getContactIdByName db user cName
|
||||
let mc = MCText <$> msg_
|
||||
processChatCommand $ APISendMemberContactInvitation contactId mc
|
||||
CreateGroupLink gName mRole -> withUser $ \user -> do
|
||||
groupId <- withStore $ \db -> getGroupIdByName db user gName
|
||||
processChatCommand $ APICreateGroupLink groupId mRole
|
||||
@ -2980,16 +3013,19 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
withAckMessage' agentConnId conn msgMeta $
|
||||
directMsgReceived ct conn msgMeta msgRcpt
|
||||
CONF confId _ connInfo -> do
|
||||
-- confirming direct connection with a member
|
||||
ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo
|
||||
conn' <- updatePeerChatVRange conn chatVRange
|
||||
case chatMsgEvent of
|
||||
-- confirming direct connection with a member
|
||||
XGrpMemInfo _memId _memProfile -> do
|
||||
-- TODO check member ID
|
||||
-- TODO update member profile
|
||||
-- [async agent commands] no continuation needed, but command should be asynchronous for stability
|
||||
allowAgentConnectionAsync user conn' confId XOk
|
||||
_ -> messageError "CONF from member must have x.grp.mem.info"
|
||||
XOk -> do
|
||||
allowAgentConnectionAsync user conn' confId XOk
|
||||
void $ withStore' $ \db -> resetMemberContactFields db ct
|
||||
_ -> messageError "CONF for existing contact must have x.grp.mem.info or x.ok"
|
||||
INFO connInfo -> do
|
||||
ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo
|
||||
_conn' <- updatePeerChatVRange conn chatVRange
|
||||
@ -3231,6 +3267,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
XGrpLeave -> xGrpLeave gInfo m' msg msgMeta
|
||||
XGrpDel -> xGrpDel gInfo m' msg msgMeta
|
||||
XGrpInfo p' -> xGrpInfo gInfo m' p' msg msgMeta
|
||||
XGrpDirectInv connReq mContent_ -> canSend m' $ xGrpDirectInv gInfo m' conn' connReq mContent_ msg msgMeta
|
||||
BFileChunk sharedMsgId chunk -> bFileChunkGroup gInfo sharedMsgId chunk msgMeta
|
||||
_ -> messageError $ "unsupported message: " <> T.pack (show event)
|
||||
currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo
|
||||
@ -4489,6 +4526,50 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
groupMsgToView g' m ci msgMeta
|
||||
createGroupFeatureChangedItems user cd CIRcvGroupFeature g g'
|
||||
|
||||
xGrpDirectInv :: GroupInfo -> GroupMember -> Connection -> ConnReqInvitation -> Maybe MsgContent -> RcvMessage -> MsgMeta -> m ()
|
||||
xGrpDirectInv g m mConn connReq mContent_ msg msgMeta = do
|
||||
unless (groupFeatureAllowed SGFDirectMessages g) $ messageError "x.grp.direct.inv: direct messages not allowed"
|
||||
let GroupMember {memberContactId} = m
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
case memberContactId of
|
||||
Nothing -> createNewContact subMode
|
||||
Just mContactId -> do
|
||||
mCt <- withStore $ \db -> getContact db user mContactId
|
||||
let Contact {activeConn = Connection {connId}, contactGrpInvSent} = mCt
|
||||
if contactGrpInvSent
|
||||
then do
|
||||
ownConnReq <- withStore $ \db -> getConnReqInv db connId
|
||||
-- in case both members sent x.grp.direct.inv before receiving other's for processing,
|
||||
-- only the one who received greater connReq joins, the other creates items and waits for confirmation
|
||||
if strEncode connReq > strEncode ownConnReq
|
||||
then joinExistingContact subMode mCt
|
||||
else createItems mCt m
|
||||
else joinExistingContact subMode mCt
|
||||
where
|
||||
joinExistingContact subMode mCt = do
|
||||
connIds <- joinConn subMode
|
||||
mCt' <- withStore' $ \db -> updateMemberContactInvited db user connIds g mConn mCt subMode
|
||||
createItems mCt' m
|
||||
securityCodeChanged mCt'
|
||||
createNewContact subMode = do
|
||||
connIds <- joinConn subMode
|
||||
-- [incognito] reuse membership incognito profile
|
||||
(mCt', m') <- withStore' $ \db -> createMemberContactInvited db user connIds g m mConn subMode
|
||||
createItems mCt' m'
|
||||
joinConn subMode = do
|
||||
dm <- directMessage XOk
|
||||
joinAgentConnectionAsync user True connReq dm subMode
|
||||
createItems mCt' m' = do
|
||||
checkIntegrityCreateItem (CDGroupRcv g m') msgMeta
|
||||
createInternalChatItem user (CDGroupRcv g m') (CIRcvGroupEvent RGEMemberCreatedContact) Nothing
|
||||
toView $ CRNewMemberContactReceivedInv user mCt' g m'
|
||||
forM_ mContent_ $ \mc -> do
|
||||
ci <- saveRcvChatItem user (CDDirectRcv mCt') msg msgMeta (CIRcvMsgContent mc)
|
||||
toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat mCt') ci)
|
||||
securityCodeChanged ct = do
|
||||
toView $ CRContactVerificationReset user ct
|
||||
createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent RCEVerificationCodeReset) Nothing
|
||||
|
||||
directMsgReceived :: Contact -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m ()
|
||||
directMsgReceived ct conn@Connection {connId} msgMeta msgRcpts = do
|
||||
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
|
||||
@ -5337,6 +5418,10 @@ chatCommandP =
|
||||
"/set link role #" *> (GroupLinkMemberRole <$> displayName <*> memberRole),
|
||||
"/delete link #" *> (DeleteGroupLink <$> displayName),
|
||||
"/show link #" *> (ShowGroupLink <$> displayName),
|
||||
"/_create member contact #" *> (APICreateMemberContact <$> A.decimal <* A.space <*> A.decimal),
|
||||
"/_invite member contact @" *> (APISendMemberContactInvitation <$> A.decimal <*> optional (A.space *> msgContentP)),
|
||||
"/contact member #" *> (CreateMemberContact <$> displayName <* A.space <*> displayName),
|
||||
"/invite member contact @" *> (SendMemberContactInvitation <$> displayName <*> optional (A.space *> msgTextP)),
|
||||
(">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <*> pure Nothing <*> quotedMsg <*> msgTextP),
|
||||
(">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* char_ '@' <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> msgTextP),
|
||||
"/_contacts " *> (APIListContacts <$> A.decimal),
|
||||
|
||||
@ -282,6 +282,10 @@ data ChatCommand
|
||||
| APIGroupLinkMemberRole GroupId GroupMemberRole
|
||||
| APIDeleteGroupLink GroupId
|
||||
| APIGetGroupLink GroupId
|
||||
| APICreateMemberContact GroupId GroupMemberId
|
||||
| APISendMemberContactInvitation {contactId :: ContactId, msgContent_ :: Maybe MsgContent}
|
||||
| CreateMemberContact GroupName ContactName
|
||||
| SendMemberContactInvitation {contactName :: ContactName, message_ :: Maybe Text}
|
||||
| APIGetUserProtoServers UserId AProtocolType
|
||||
| GetUserProtoServers AProtocolType
|
||||
| APISetUserProtoServers UserId AProtoServersConfig
|
||||
@ -553,6 +557,9 @@ data ChatResponse
|
||||
| CRGroupLink {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact, memberRole :: GroupMemberRole}
|
||||
| CRGroupLinkDeleted {user :: User, groupInfo :: GroupInfo}
|
||||
| CRAcceptingGroupJoinRequest {user :: User, groupInfo :: GroupInfo, contact :: Contact}
|
||||
| CRNewMemberContact {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRNewMemberContactSentInv {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRNewMemberContactReceivedInv {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRMemberSubError {user :: User, groupInfo :: GroupInfo, member :: GroupMember, chatError :: ChatError}
|
||||
| CRMemberSubSummary {user :: User, memberSubscriptions :: [MemberSubStatus]}
|
||||
| CRGroupSubscribed {user :: User, groupInfo :: GroupInfo}
|
||||
@ -927,6 +934,7 @@ data ChatErrorType
|
||||
| CEAgentCommandError {message :: String}
|
||||
| CEInvalidFileDescription {message :: String}
|
||||
| CEConnectionIncognitoChangeProhibited
|
||||
| CEPeerChatVRangeIncompatible
|
||||
| CEInternalError {message :: String}
|
||||
| CEException {message :: String}
|
||||
deriving (Show, Exception, Generic)
|
||||
|
||||
@ -190,6 +190,7 @@ ciRequiresAttention content = case msgDirection @d of
|
||||
RGEGroupDeleted -> True
|
||||
RGEGroupUpdated _ -> False
|
||||
RGEInvitedViaGroupLink -> False
|
||||
RGEMemberCreatedContact -> False
|
||||
CIRcvConnEvent _ -> True
|
||||
CIRcvChatFeature {} -> False
|
||||
CIRcvChatPreference {} -> False
|
||||
@ -213,6 +214,7 @@ data RcvGroupEvent
|
||||
-- but being RcvGroupEvent allows them to be assigned to the respective member (and so enable "send direct message")
|
||||
-- and be created as unread without adding / working around new status for sent items
|
||||
| RGEInvitedViaGroupLink -- CRSentGroupInvitationViaLink
|
||||
| RGEMemberCreatedContact -- CRNewMemberContactReceivedInv
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance FromJSON RcvGroupEvent where
|
||||
@ -378,6 +380,7 @@ rcvGroupEventToText = \case
|
||||
RGEGroupDeleted -> "deleted group"
|
||||
RGEGroupUpdated _ -> "group profile updated"
|
||||
RGEInvitedViaGroupLink -> "invited via your group link"
|
||||
RGEMemberCreatedContact -> "started direct connection with you"
|
||||
|
||||
sndGroupEventToText :: SndGroupEvent -> Text
|
||||
sndGroupEventToText = \case
|
||||
|
||||
27
src/Simplex/Chat/Migrations/M20230913_member_contacts.hs
Normal file
27
src/Simplex/Chat/Migrations/M20230913_member_contacts.hs
Normal file
@ -0,0 +1,27 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20230913_member_contacts where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20230913_member_contacts :: Query
|
||||
m20230913_member_contacts =
|
||||
[sql|
|
||||
ALTER TABLE contacts ADD COLUMN contact_group_member_id INTEGER
|
||||
REFERENCES group_members(group_member_id) ON DELETE SET NULL;
|
||||
|
||||
CREATE INDEX idx_contacts_contact_group_member_id ON contacts(contact_group_member_id);
|
||||
|
||||
ALTER TABLE contacts ADD COLUMN contact_grp_inv_sent INTEGER NOT NULL DEFAULT 0;
|
||||
|]
|
||||
|
||||
down_m20230913_member_contacts :: Query
|
||||
down_m20230913_member_contacts =
|
||||
[sql|
|
||||
ALTER TABLE contacts DROP COLUMN contact_grp_inv_sent;
|
||||
|
||||
DROP INDEX idx_contacts_contact_group_member_id;
|
||||
|
||||
ALTER TABLE contacts DROP COLUMN contact_group_member_id;
|
||||
|]
|
||||
@ -68,6 +68,9 @@ CREATE TABLE contacts(
|
||||
deleted INTEGER NOT NULL DEFAULT 0,
|
||||
favorite INTEGER NOT NULL DEFAULT 0,
|
||||
send_rcpts INTEGER,
|
||||
contact_group_member_id INTEGER
|
||||
REFERENCES group_members(group_member_id) ON DELETE SET NULL,
|
||||
contact_grp_inv_sent INTEGER NOT NULL DEFAULT 0,
|
||||
FOREIGN KEY(user_id, local_display_name)
|
||||
REFERENCES display_names(user_id, local_display_name)
|
||||
ON DELETE CASCADE
|
||||
@ -713,3 +716,6 @@ CREATE INDEX idx_chat_items_user_id_item_status ON chat_items(
|
||||
item_status
|
||||
);
|
||||
CREATE INDEX idx_connections_to_subscribe ON connections(to_subscribe);
|
||||
CREATE INDEX idx_contacts_contact_group_member_id ON contacts(
|
||||
contact_group_member_id
|
||||
);
|
||||
|
||||
@ -58,6 +58,10 @@ supportedChatVRange = mkVersionRange 1 currentChatVersion
|
||||
groupNoDirectVRange :: VersionRange
|
||||
groupNoDirectVRange = mkVersionRange 2 currentChatVersion
|
||||
|
||||
-- version range that supports establishing direct connection via x.grp.direct.inv with a group member
|
||||
xGrpDirectInvVRange :: VersionRange
|
||||
xGrpDirectInvVRange = mkVersionRange 2 currentChatVersion
|
||||
|
||||
data ConnectionEntity
|
||||
= RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact}
|
||||
| RcvGroupMsgConnection {entityConnection :: Connection, groupInfo :: GroupInfo, groupMember :: GroupMember}
|
||||
@ -223,6 +227,7 @@ data ChatMsgEvent (e :: MsgEncoding) where
|
||||
XGrpLeave :: ChatMsgEvent 'Json
|
||||
XGrpDel :: ChatMsgEvent 'Json
|
||||
XGrpInfo :: GroupProfile -> ChatMsgEvent 'Json
|
||||
XGrpDirectInv :: ConnReqInvitation -> Maybe MsgContent -> ChatMsgEvent 'Json
|
||||
XInfoProbe :: Probe -> ChatMsgEvent 'Json
|
||||
XInfoProbeCheck :: ProbeHash -> ChatMsgEvent 'Json
|
||||
XInfoProbeOk :: Probe -> ChatMsgEvent 'Json
|
||||
@ -557,6 +562,7 @@ data CMEventTag (e :: MsgEncoding) where
|
||||
XGrpLeave_ :: CMEventTag 'Json
|
||||
XGrpDel_ :: CMEventTag 'Json
|
||||
XGrpInfo_ :: CMEventTag 'Json
|
||||
XGrpDirectInv_ :: CMEventTag 'Json
|
||||
XInfoProbe_ :: CMEventTag 'Json
|
||||
XInfoProbeCheck_ :: CMEventTag 'Json
|
||||
XInfoProbeOk_ :: CMEventTag 'Json
|
||||
@ -602,6 +608,7 @@ instance MsgEncodingI e => StrEncoding (CMEventTag e) where
|
||||
XGrpLeave_ -> "x.grp.leave"
|
||||
XGrpDel_ -> "x.grp.del"
|
||||
XGrpInfo_ -> "x.grp.info"
|
||||
XGrpDirectInv_ -> "x.grp.direct.inv"
|
||||
XInfoProbe_ -> "x.info.probe"
|
||||
XInfoProbeCheck_ -> "x.info.probe.check"
|
||||
XInfoProbeOk_ -> "x.info.probe.ok"
|
||||
@ -648,6 +655,7 @@ instance StrEncoding ACMEventTag where
|
||||
"x.grp.leave" -> XGrpLeave_
|
||||
"x.grp.del" -> XGrpDel_
|
||||
"x.grp.info" -> XGrpInfo_
|
||||
"x.grp.direct.inv" -> XGrpDirectInv_
|
||||
"x.info.probe" -> XInfoProbe_
|
||||
"x.info.probe.check" -> XInfoProbeCheck_
|
||||
"x.info.probe.ok" -> XInfoProbeOk_
|
||||
@ -690,6 +698,7 @@ toCMEventTag msg = case msg of
|
||||
XGrpLeave -> XGrpLeave_
|
||||
XGrpDel -> XGrpDel_
|
||||
XGrpInfo _ -> XGrpInfo_
|
||||
XGrpDirectInv _ _ -> XGrpDirectInv_
|
||||
XInfoProbe _ -> XInfoProbe_
|
||||
XInfoProbeCheck _ -> XInfoProbeCheck_
|
||||
XInfoProbeOk _ -> XInfoProbeOk_
|
||||
@ -785,6 +794,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
|
||||
XGrpLeave_ -> pure XGrpLeave
|
||||
XGrpDel_ -> pure XGrpDel
|
||||
XGrpInfo_ -> XGrpInfo <$> p "groupProfile"
|
||||
XGrpDirectInv_ -> XGrpDirectInv <$> p "connReq" <*> opt "content"
|
||||
XInfoProbe_ -> XInfoProbe <$> p "probe"
|
||||
XInfoProbeCheck_ -> XInfoProbeCheck <$> p "probeHash"
|
||||
XInfoProbeOk_ -> XInfoProbeOk <$> p "probe"
|
||||
@ -841,6 +851,7 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @
|
||||
XGrpLeave -> JM.empty
|
||||
XGrpDel -> JM.empty
|
||||
XGrpInfo p -> o ["groupProfile" .= p]
|
||||
XGrpDirectInv connReq content -> o $ ("content" .=? content) ["connReq" .= connReq]
|
||||
XInfoProbe probe -> o ["probe" .= probe]
|
||||
XInfoProbeCheck probeHash -> o ["probeHash" .= probeHash]
|
||||
XInfoProbeOk probe -> o ["probe" .= probe]
|
||||
|
||||
@ -69,18 +69,18 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
|
||||
[sql|
|
||||
SELECT
|
||||
c.contact_profile_id, c.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, c.via_group, c.contact_used, c.enable_ntfs, c.send_rcpts, c.favorite,
|
||||
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts
|
||||
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.contact_group_member_id, c.contact_grp_inv_sent
|
||||
FROM contacts c
|
||||
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
|
||||
WHERE c.user_id = ? AND c.contact_id = ? AND c.deleted = 0
|
||||
|]
|
||||
(userId, contactId)
|
||||
toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime)] -> Either StoreError Contact
|
||||
toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs)] =
|
||||
toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)] -> Either StoreError Contact
|
||||
toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)] =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
|
||||
in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs}
|
||||
in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent}
|
||||
toContact' _ _ _ = Left $ SEInternalError "referenced contact not found"
|
||||
getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
|
||||
getGroupAndMember_ groupMemberId c = ExceptT $ do
|
||||
|
||||
@ -142,7 +142,7 @@ getConnReqContactXContactId db user@User {userId} cReqHash = do
|
||||
SELECT
|
||||
-- Contact
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts,
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
|
||||
@ -200,7 +200,7 @@ createDirectContact db user@User {userId} activeConn@Connection {connId, localAl
|
||||
let profile = toLocalProfile profileId p localAlias
|
||||
userPreferences = emptyChatPrefs
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
|
||||
pure $ Contact {contactId, localDisplayName, profile, activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt, updatedAt = createdAt, chatTs = Just createdAt}
|
||||
pure $ Contact {contactId, localDisplayName, profile, activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False}
|
||||
|
||||
deleteContactConnectionsAndFiles :: DB.Connection -> UserId -> Contact -> IO ()
|
||||
deleteContactConnectionsAndFiles db userId Contact {contactId} = do
|
||||
@ -458,7 +458,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers
|
||||
SELECT
|
||||
-- Contact
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts,
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
|
||||
@ -603,7 +603,7 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}
|
||||
contactId <- insertedRowId db
|
||||
activeConn <- createConnection_ db userId ConnContact (Just contactId) agentConnId cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode
|
||||
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
|
||||
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt}
|
||||
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False}
|
||||
|
||||
getContactIdByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Int64
|
||||
getContactIdByName db User {userId} cName =
|
||||
@ -622,7 +622,7 @@ getContact_ db user@User {userId} contactId deleted =
|
||||
SELECT
|
||||
-- Contact
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts,
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
|
||||
|
||||
@ -84,6 +84,12 @@ module Simplex.Chat.Store.Groups
|
||||
getXGrpMemIntroContDirect,
|
||||
getXGrpMemIntroContGroup,
|
||||
getHostConnId,
|
||||
createMemberContact,
|
||||
getMemberContact,
|
||||
setContactGrpInvSent,
|
||||
createMemberContactInvited,
|
||||
updateMemberContactInvited,
|
||||
resetMemberContactFields,
|
||||
)
|
||||
where
|
||||
|
||||
@ -105,7 +111,7 @@ import Simplex.Messaging.Agent.Protocol (ConnId, UserId)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Protocol (SubscriptionMode)
|
||||
import Simplex.Messaging.Protocol (SubscriptionMode (..))
|
||||
import Simplex.Messaging.Util (eitherToMaybe)
|
||||
import Simplex.Messaging.Version
|
||||
import UnliftIO.STM
|
||||
@ -687,7 +693,7 @@ getContactViaMember db user@User {userId} GroupMember {groupMemberId} =
|
||||
SELECT
|
||||
-- Contact
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts,
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
|
||||
@ -1031,7 +1037,7 @@ getViaGroupContact db user@User {userId} GroupMember {groupMemberId} =
|
||||
[sql|
|
||||
SELECT
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, ct.via_group, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
p.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts,
|
||||
p.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
|
||||
c.peer_chat_min_version, c.peer_chat_max_version
|
||||
@ -1048,13 +1054,13 @@ getViaGroupContact db user@User {userId} GroupMember {groupMemberId} =
|
||||
|]
|
||||
(userId, groupMemberId)
|
||||
where
|
||||
toContact' :: ((ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime)) :. ConnectionRow -> Contact
|
||||
toContact' (((contactId, profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs)) :. connRow) =
|
||||
toContact' :: ((ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)) :. ConnectionRow -> Contact
|
||||
toContact' (((contactId, profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
|
||||
activeConn = toConnection connRow
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
|
||||
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs}
|
||||
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent}
|
||||
|
||||
updateGroupProfile :: DB.Connection -> User -> GroupInfo -> GroupProfile -> ExceptT StoreError IO GroupInfo
|
||||
updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName}} p'@GroupProfile {displayName = newName, fullName, description, image, groupPreferences}
|
||||
@ -1356,3 +1362,156 @@ getHostConnId db user@User {userId} groupId = do
|
||||
hostMemberId <- getHostMemberId_ db user groupId
|
||||
ExceptT . firstRow fromOnly (SEConnectionNotFoundByMemberId hostMemberId) $
|
||||
DB.query db "SELECT connection_id FROM connections WHERE user_id = ? AND group_member_id = ?" (userId, hostMemberId)
|
||||
|
||||
createMemberContact :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> GroupInfo -> GroupMember -> Connection -> SubscriptionMode -> IO Contact
|
||||
createMemberContact
|
||||
db
|
||||
user@User {userId, profile = LocalProfile {preferences}}
|
||||
acId
|
||||
cReq
|
||||
GroupInfo {membership = membership@GroupMember {memberProfile = membershipProfile}}
|
||||
GroupMember {groupMemberId, localDisplayName, memberProfile, memberContactProfileId}
|
||||
Connection {connLevel, peerChatVRange = peerChatVRange@(JVersionRange (VersionRange minV maxV))}
|
||||
subMode = do
|
||||
currentTs <- getCurrentTime
|
||||
let incognitoProfile = if memberIncognito membership then Just membershipProfile else Nothing
|
||||
customUserProfileId = localProfileId <$> incognitoProfile
|
||||
userPreferences = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO contacts (
|
||||
user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, contact_used,
|
||||
contact_group_member_id, contact_grp_inv_sent, created_at, updated_at, chat_ts
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (userId, localDisplayName, memberContactProfileId, True, userPreferences, True)
|
||||
:. (groupMemberId, False, currentTs, currentTs, currentTs)
|
||||
)
|
||||
contactId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE group_members SET contact_id = ?, updated_at = ? WHERE group_member_id = ?"
|
||||
(contactId, currentTs, groupMemberId)
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO connections (
|
||||
user_id, agent_conn_id, conn_req_inv, conn_level, conn_status, conn_type, contact_id, custom_user_profile_id,
|
||||
peer_chat_min_version, peer_chat_max_version, created_at, updated_at, to_subscribe
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (userId, acId, cReq, connLevel, ConnNew, ConnContact, contactId, customUserProfileId)
|
||||
:. (minV, maxV, currentTs, currentTs, subMode == SMOnlyCreate)
|
||||
)
|
||||
connId <- insertedRowId db
|
||||
let ctConn = Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType = ConnContact, entityId = Just contactId, viaContact = Nothing, viaUserContactLink = Nothing, viaGroupLink = False, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
|
||||
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = ctConn, viaGroup = Nothing, contactUsed = True, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False}
|
||||
|
||||
getMemberContact :: DB.Connection -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
|
||||
getMemberContact db user contactId = do
|
||||
ct <- getContact db user contactId
|
||||
let Contact {contactGroupMemberId, activeConn = Connection {connId}} = ct
|
||||
cReq <- getConnReqInv db connId
|
||||
case contactGroupMemberId of
|
||||
Just groupMemberId -> do
|
||||
m@GroupMember {groupId} <- getGroupMemberById db user groupMemberId
|
||||
g <- getGroupInfo db user groupId
|
||||
pure (g, m, ct, cReq)
|
||||
_ ->
|
||||
throwError $ SEMemberContactGroupMemberNotFound contactId
|
||||
|
||||
setContactGrpInvSent :: DB.Connection -> Contact -> Bool -> IO ()
|
||||
setContactGrpInvSent db Contact {contactId} xGrpDirectInvSent = do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE contacts SET contact_grp_inv_sent = ?, updated_at = ? WHERE contact_id = ?"
|
||||
(xGrpDirectInvSent, currentTs, contactId)
|
||||
|
||||
createMemberContactInvited :: DB.Connection -> User -> (CommandId, ConnId) -> GroupInfo -> GroupMember -> Connection -> SubscriptionMode -> IO (Contact, GroupMember)
|
||||
createMemberContactInvited
|
||||
db
|
||||
user@User {userId, profile = LocalProfile {preferences}}
|
||||
connIds
|
||||
gInfo@GroupInfo {membership = membership@GroupMember {memberProfile = membershipProfile}}
|
||||
m@GroupMember {groupMemberId, localDisplayName = memberLDN, memberProfile, memberContactProfileId}
|
||||
mConn
|
||||
subMode = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
let incognitoProfile = if memberIncognito membership then Just membershipProfile else Nothing
|
||||
userPreferences = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences
|
||||
contactId <- createContactUpdateMember currentTs userPreferences
|
||||
ctConn <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode
|
||||
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
|
||||
mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = ctConn, viaGroup = Nothing, contactUsed = True, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False}
|
||||
m' = m {memberContactId = Just contactId}
|
||||
pure (mCt', m')
|
||||
where
|
||||
createContactUpdateMember :: UTCTime -> Preferences -> IO ContactId
|
||||
createContactUpdateMember currentTs userPreferences = do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO contacts (
|
||||
user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, contact_used,
|
||||
created_at, updated_at, chat_ts
|
||||
) VALUES (?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (userId, memberLDN, memberContactProfileId, True, userPreferences, True)
|
||||
:. (currentTs, currentTs, currentTs)
|
||||
)
|
||||
contactId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE group_members SET contact_id = ?, updated_at = ? WHERE group_member_id = ?"
|
||||
(contactId, currentTs, groupMemberId)
|
||||
pure contactId
|
||||
|
||||
updateMemberContactInvited :: DB.Connection -> User -> (CommandId, ConnId) -> GroupInfo -> Connection -> Contact -> SubscriptionMode -> IO Contact
|
||||
updateMemberContactInvited db user connIds gInfo mConn ct@Contact {contactId, activeConn = oldContactConn} subMode = do
|
||||
updateConnectionStatus db oldContactConn ConnDeleted
|
||||
activeConn <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode
|
||||
ct' <- resetMemberContactFields db ct
|
||||
pure (ct' :: Contact) {activeConn}
|
||||
|
||||
resetMemberContactFields :: DB.Connection -> Contact -> IO Contact
|
||||
resetMemberContactFields db ct@Contact {contactId} = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE contacts
|
||||
SET contact_group_member_id = NULL, contact_grp_inv_sent = 0, updated_at = ?
|
||||
WHERE contact_id = ?
|
||||
|]
|
||||
(currentTs, contactId)
|
||||
pure ct {contactGroupMemberId = Nothing, contactGrpInvSent = False, updatedAt = currentTs}
|
||||
|
||||
createMemberContactConn_ :: DB.Connection -> User -> (CommandId, ConnId) -> GroupInfo -> Connection -> ContactId -> SubscriptionMode -> IO Connection
|
||||
createMemberContactConn_
|
||||
db
|
||||
user@User {userId}
|
||||
(cmdId, acId)
|
||||
GroupInfo {membership = membership@GroupMember {memberProfile = membershipProfile}}
|
||||
_memberConn@Connection {connLevel, peerChatVRange = peerChatVRange@(JVersionRange (VersionRange minV maxV))}
|
||||
contactId
|
||||
subMode = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
let incognitoProfile = if memberIncognito membership then Just membershipProfile else Nothing
|
||||
customUserProfileId = localProfileId <$> incognitoProfile
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO connections (
|
||||
user_id, agent_conn_id, conn_level, conn_status, conn_type, contact_id, custom_user_profile_id,
|
||||
peer_chat_min_version, peer_chat_max_version, created_at, updated_at, to_subscribe
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (userId, acId, connLevel, ConnNew, ConnContact, contactId, customUserProfileId)
|
||||
:. (minV, maxV, currentTs, currentTs, subMode == SMOnlyCreate)
|
||||
)
|
||||
connId <- insertedRowId db
|
||||
setCommandConnId db user cmdId connId
|
||||
pure Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType = ConnContact, entityId = Just contactId, viaContact = Nothing, viaUserContactLink = Nothing, viaGroupLink = False, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}
|
||||
|
||||
@ -475,7 +475,7 @@ getDirectChatPreviews_ db user@User {userId} = do
|
||||
SELECT
|
||||
-- Contact
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts,
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
|
||||
|
||||
@ -79,6 +79,7 @@ import Simplex.Chat.Migrations.M20230814_indexes
|
||||
import Simplex.Chat.Migrations.M20230827_file_encryption
|
||||
import Simplex.Chat.Migrations.M20230829_connections_chat_vrange
|
||||
import Simplex.Chat.Migrations.M20230903_connections_to_subscribe
|
||||
import Simplex.Chat.Migrations.M20230913_member_contacts
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@ -157,7 +158,8 @@ schemaMigrations =
|
||||
("20230814_indexes", m20230814_indexes, Just down_m20230814_indexes),
|
||||
("20230827_file_encryption", m20230827_file_encryption, Just down_m20230827_file_encryption),
|
||||
("20230829_connections_chat_vrange", m20230829_connections_chat_vrange, Just down_m20230829_connections_chat_vrange),
|
||||
("20230903_connections_to_subscribe", m20230903_connections_to_subscribe, Just down_m20230903_connections_to_subscribe)
|
||||
("20230903_connections_to_subscribe", m20230903_connections_to_subscribe, Just down_m20230903_connections_to_subscribe),
|
||||
("20230913_member_contacts", m20230913_member_contacts, Just down_m20230913_member_contacts)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@ -63,6 +63,7 @@ data StoreError
|
||||
| SEGroupMemberNameNotFound {groupId :: GroupId, groupMemberName :: ContactName}
|
||||
| SEGroupMemberNotFound {groupMemberId :: GroupMemberId}
|
||||
| SEGroupMemberNotFoundByMemberId {memberId :: MemberId}
|
||||
| SEMemberContactGroupMemberNotFound {contactId :: ContactId}
|
||||
| SEGroupWithoutUser
|
||||
| SEDuplicateGroupMember
|
||||
| SEGroupAlreadyJoined
|
||||
@ -239,24 +240,24 @@ deleteUnusedIncognitoProfileById_ db User {userId} profileId =
|
||||
|]
|
||||
[":user_id" := userId, ":profile_id" := profileId]
|
||||
|
||||
type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime)
|
||||
type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)
|
||||
|
||||
toContact :: User -> ContactRow :. ConnectionRow -> Contact
|
||||
toContact user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs)) :. connRow) =
|
||||
toContact user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
|
||||
activeConn = toConnection connRow
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
|
||||
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs}
|
||||
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent}
|
||||
|
||||
toContactOrError :: User -> ContactRow :. MaybeConnectionRow -> Either StoreError Contact
|
||||
toContactOrError user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs)) :. connRow) =
|
||||
toContactOrError user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
|
||||
in case toMaybeConnection connRow of
|
||||
Just activeConn ->
|
||||
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
|
||||
in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs}
|
||||
in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent}
|
||||
_ -> Left $ SEContactNotReady localDisplayName
|
||||
|
||||
getProfileById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalProfile
|
||||
@ -304,6 +305,14 @@ toPendingContactConnection :: (Int64, ConnId, ConnStatus, Maybe ByteString, Mayb
|
||||
toPendingContactConnection (pccConnId, acId, pccConnStatus, connReqHash, viaUserContactLink, groupLinkId, customUserProfileId, connReqInv, localAlias, createdAt, updatedAt) =
|
||||
PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = isJust connReqHash, viaUserContactLink, groupLinkId, customUserProfileId, connReqInv, localAlias, createdAt, updatedAt}
|
||||
|
||||
getConnReqInv :: DB.Connection -> Int64 -> ExceptT StoreError IO ConnReqInvitation
|
||||
getConnReqInv db connId =
|
||||
ExceptT . firstRow fromOnly (SEConnectionNotFoundById connId) $
|
||||
DB.query
|
||||
db
|
||||
"SELECT conn_req_inv FROM connections WHERE connection_id = ?"
|
||||
(Only connId)
|
||||
|
||||
-- | Saves unique local display name based on passed displayName, suffixed with _N if required.
|
||||
-- This function should be called inside transaction.
|
||||
withLocalDisplayName :: forall a. DB.Connection -> UserId -> Text -> (Text -> IO (Either StoreError a)) -> IO (Either StoreError a)
|
||||
|
||||
@ -172,7 +172,9 @@ data Contact = Contact
|
||||
mergedPreferences :: ContactUserPreferences,
|
||||
createdAt :: UTCTime,
|
||||
updatedAt :: UTCTime,
|
||||
chatTs :: Maybe UTCTime
|
||||
chatTs :: Maybe UTCTime,
|
||||
contactGroupMemberId :: Maybe GroupMemberId,
|
||||
contactGrpInvSent :: Bool
|
||||
}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
|
||||
@ -230,6 +230,9 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
|
||||
CRGroupLink u g cReq mRole -> ttyUser u $ groupLink_ "Group link:" g cReq mRole
|
||||
CRGroupLinkDeleted u g -> ttyUser u $ viewGroupLinkDeleted g
|
||||
CRAcceptingGroupJoinRequest _ g c -> [ttyFullContact c <> ": accepting request to join group " <> ttyGroup' g <> "..."]
|
||||
CRNewMemberContact u Contact {localDisplayName = c} g m -> ttyUser u ["contact for member " <> ttyGroup' g <> " " <> ttyMember m <> " prepared, use " <> highlight ("/invite member contact @" <> c <> " <message>") <> " to send invitation"]
|
||||
CRNewMemberContactSentInv u _ct g m -> ttyUser u ["sent invitation to connect directly to member " <> ttyGroup' g <> " " <> ttyMember m]
|
||||
CRNewMemberContactReceivedInv u ct g m -> ttyUser u [ttyGroup' g <> " " <> ttyMember m <> " is creating direct contact " <> ttyContact' ct <> " with you"]
|
||||
CRMemberSubError u g m e -> ttyUser u [ttyGroup' g <> " member " <> ttyMember m <> " error: " <> sShow e]
|
||||
CRMemberSubSummary u summary -> ttyUser u $ viewErrorsSummary (filter (isJust . memberError) summary) " group member errors"
|
||||
CRGroupSubscribed u g -> ttyUser u $ viewGroupSubscribed g
|
||||
@ -1597,6 +1600,7 @@ viewChatError logLevel = \case
|
||||
CEAgentCommandError e -> ["agent command error: " <> plain e]
|
||||
CEInvalidFileDescription e -> ["invalid file description: " <> plain e]
|
||||
CEConnectionIncognitoChangeProhibited -> ["incognito mode change prohibited"]
|
||||
CEPeerChatVRangeIncompatible -> ["peer chat protocol version range incompatible"]
|
||||
CEInternalError e -> ["internal chat error: " <> plain e]
|
||||
CEException e -> ["exception: " <> plain e]
|
||||
-- e -> ["chat error: " <> sShow e]
|
||||
|
||||
@ -259,7 +259,7 @@ getTermLine cc =
|
||||
Just s -> do
|
||||
-- remove condition to always echo virtual terminal
|
||||
when (printOutput cc) $ do
|
||||
-- when True $ do
|
||||
-- when True $ do
|
||||
name <- userName cc
|
||||
putStrLn $ name <> ": " <> s
|
||||
pure s
|
||||
|
||||
@ -81,6 +81,13 @@ chatGroupTests = do
|
||||
testNoDirect4 _1 _0 _1 False False False -- False False True
|
||||
testNoDirect4 _1 _1 _0 False False False
|
||||
testNoDirect4 _1 _1 _1 False False False
|
||||
describe "create member contact" $ do
|
||||
it "create contact with group member with invitation message" testMemberContactMessage
|
||||
it "create contact with group member without invitation message" testMemberContactNoMessage
|
||||
it "prohibited to create contact with group member if it already exists" testMemberContactProhibitedContactExists
|
||||
it "prohibited to repeat sending x.grp.direct.inv" testMemberContactProhibitedRepeatInv
|
||||
it "invited member replaces member contact reference if it already exists" testMemberContactInvitedConnectionReplaced
|
||||
it "share incognito profile" testMemberContactIncognito
|
||||
where
|
||||
_0 = supportedChatVRange -- don't create direct connections
|
||||
_1 = groupCreateDirectVRange
|
||||
@ -2686,3 +2693,269 @@ testNoGroupDirectConns4Members hostVRange mem2VRange mem3VRange mem4VRange noCon
|
||||
cc1 <## ("no contact " <> name2)
|
||||
cc2 ##> ("@" <> name1 <> " hi")
|
||||
cc2 <## ("no contact " <> name1)
|
||||
|
||||
testMemberContactMessage :: HasCallStack => FilePath -> IO ()
|
||||
testMemberContactMessage =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
|
||||
-- TODO here and in following tests there would be no direct contacts initially, after "no direct conns" functionality is uncommented
|
||||
alice ##> "/d bob"
|
||||
alice <## "bob: contact is deleted"
|
||||
bob ##> "/d alice"
|
||||
bob <## "alice: contact is deleted"
|
||||
|
||||
alice ##> "/contact member #team bob"
|
||||
alice <## "contact for member #team bob prepared, use /invite member contact @bob <message> to send invitation"
|
||||
|
||||
alice ##> "/invite member contact @bob hi"
|
||||
alice
|
||||
<### [ "sent invitation to connect directly to member #team bob",
|
||||
WithTime "@bob hi"
|
||||
]
|
||||
bob
|
||||
<### [ "#team alice is creating direct contact alice with you",
|
||||
WithTime "alice> hi"
|
||||
]
|
||||
concurrently_
|
||||
(alice <## "bob (Bob): contact is connected")
|
||||
(bob <## "alice (Alice): contact is connected")
|
||||
|
||||
bob #$> ("/_get chat #1 count=1", chat, [(0, "started direct connection with you")])
|
||||
alice <##> bob
|
||||
|
||||
testMemberContactNoMessage :: HasCallStack => FilePath -> IO ()
|
||||
testMemberContactNoMessage =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
|
||||
alice ##> "/d bob"
|
||||
alice <## "bob: contact is deleted"
|
||||
bob ##> "/d alice"
|
||||
bob <## "alice: contact is deleted"
|
||||
|
||||
alice ##> "/contact member #team bob"
|
||||
alice <## "contact for member #team bob prepared, use /invite member contact @bob <message> to send invitation"
|
||||
|
||||
alice ##> "/invite member contact @bob"
|
||||
alice <## "sent invitation to connect directly to member #team bob"
|
||||
bob <## "#team alice is creating direct contact alice with you"
|
||||
concurrently_
|
||||
(alice <## "bob (Bob): contact is connected")
|
||||
(bob <## "alice (Alice): contact is connected")
|
||||
|
||||
bob #$> ("/_get chat #1 count=1", chat, [(0, "started direct connection with you")])
|
||||
alice <##> bob
|
||||
|
||||
testMemberContactProhibitedContactExists :: HasCallStack => FilePath -> IO ()
|
||||
testMemberContactProhibitedContactExists =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
|
||||
alice ##> "/contact member #team bob"
|
||||
alice <## "bad chat command: member contact already exists"
|
||||
|
||||
testMemberContactProhibitedRepeatInv :: HasCallStack => FilePath -> IO ()
|
||||
testMemberContactProhibitedRepeatInv =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
|
||||
alice ##> "/d bob"
|
||||
alice <## "bob: contact is deleted"
|
||||
bob ##> "/d alice"
|
||||
bob <## "alice: contact is deleted"
|
||||
|
||||
alice ##> "/contact member #team bob"
|
||||
alice <## "contact for member #team bob prepared, use /invite member contact @bob <message> to send invitation"
|
||||
|
||||
alice ##> "/invite member contact @bob hi"
|
||||
alice
|
||||
<### [ "sent invitation to connect directly to member #team bob",
|
||||
WithTime "@bob hi"
|
||||
]
|
||||
alice ##> "/invite member contact @bob hey"
|
||||
alice <## "bad chat command: x.grp.direct.inv already sent"
|
||||
bob
|
||||
<### [ "#team alice is creating direct contact alice with you",
|
||||
WithTime "alice> hi"
|
||||
]
|
||||
concurrently_
|
||||
(alice <## "bob (Bob): contact is connected")
|
||||
(bob <## "alice (Alice): contact is connected")
|
||||
|
||||
alice <##> bob
|
||||
|
||||
testMemberContactInvitedConnectionReplaced :: HasCallStack => FilePath -> IO ()
|
||||
testMemberContactInvitedConnectionReplaced tmp = do
|
||||
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
withNewTestChat tmp "bob" bobProfile $ \bob -> do
|
||||
withNewTestChat tmp "cath" cathProfile $ \cath -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
|
||||
alice ##> "/d bob"
|
||||
alice <## "bob: contact is deleted"
|
||||
|
||||
alice ##> "/contact member #team bob"
|
||||
alice <## "contact for member #team bob prepared, use /invite member contact @bob <message> to send invitation"
|
||||
|
||||
alice ##> "/invite member contact @bob hi"
|
||||
alice
|
||||
<### [ "sent invitation to connect directly to member #team bob",
|
||||
WithTime "@bob hi"
|
||||
]
|
||||
bob
|
||||
<### [ "#team alice is creating direct contact alice with you",
|
||||
WithTime "alice> hi",
|
||||
"alice: security code changed"
|
||||
]
|
||||
concurrently_
|
||||
(alice <## "bob (Bob): contact is connected")
|
||||
(bob <## "alice (Alice): contact is connected")
|
||||
|
||||
bob #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "received invitation to join group team as admin"), (0, "hi"), (0, "security code changed")] <> chatFeatures)
|
||||
|
||||
withTestChat tmp "bob" $ \bob -> do
|
||||
subscriptions bob
|
||||
|
||||
checkConnectionsWork alice bob
|
||||
|
||||
withTestChat tmp "alice" $ \alice -> do
|
||||
subscriptions alice
|
||||
|
||||
withTestChat tmp "bob" $ \bob -> do
|
||||
subscriptions bob
|
||||
|
||||
checkConnectionsWork alice bob
|
||||
|
||||
withTestChat tmp "cath" $ \cath -> do
|
||||
subscriptions cath
|
||||
|
||||
-- group messages work
|
||||
alice #> "#team hello"
|
||||
concurrently_
|
||||
(bob <# "#team alice> hello")
|
||||
(cath <# "#team alice> hello")
|
||||
bob #> "#team hi there"
|
||||
concurrently_
|
||||
(alice <# "#team bob> hi there")
|
||||
(cath <# "#team bob> hi there")
|
||||
cath #> "#team hey team"
|
||||
concurrently_
|
||||
(alice <# "#team cath> hey team")
|
||||
(bob <# "#team cath> hey team")
|
||||
where
|
||||
subscriptions cc = do
|
||||
cc <## "2 contacts connected (use /cs for the list)"
|
||||
cc <## "#team: connected to server(s)"
|
||||
checkConnectionsWork alice bob = do
|
||||
alice <##> bob
|
||||
alice @@@ [("@bob", "hey"), ("@cath", "sent invitation to join group team as admin"), ("#team", "connected")]
|
||||
bob @@@ [("@alice", "hey"), ("#team", "started direct connection with you")]
|
||||
|
||||
testMemberContactIncognito :: HasCallStack => FilePath -> IO ()
|
||||
testMemberContactIncognito =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
-- create group, bob joins incognito
|
||||
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 i " <> gLink)
|
||||
bobIncognito <- getTermLine bob
|
||||
bob <## "connection request sent incognito!"
|
||||
alice <## (bobIncognito <> ": accepting request to join group #team...")
|
||||
_ <- getTermLine bob
|
||||
concurrentlyN_
|
||||
[ do
|
||||
alice <## (bobIncognito <> ": contact is connected")
|
||||
alice <## (bobIncognito <> " invited to group #team via your group link")
|
||||
alice <## ("#team: " <> bobIncognito <> " joined the group"),
|
||||
do
|
||||
bob <## ("alice (Alice): contact is connected, your incognito profile for this contact is " <> bobIncognito)
|
||||
bob <## "use /i alice to print out this incognito profile again"
|
||||
bob <## ("#team: you joined the group incognito as " <> bobIncognito)
|
||||
]
|
||||
-- cath joins incognito
|
||||
cath ##> ("/c i " <> gLink)
|
||||
cathIncognito <- getTermLine cath
|
||||
cath <## "connection request sent incognito!"
|
||||
alice <## (cathIncognito <> ": accepting request to join group #team...")
|
||||
_ <- getTermLine cath
|
||||
concurrentlyN_
|
||||
[ do
|
||||
alice <## (cathIncognito <> ": contact is connected")
|
||||
alice <## (cathIncognito <> " invited to group #team via your group link")
|
||||
alice <## ("#team: " <> cathIncognito <> " joined the group"),
|
||||
do
|
||||
cath <## ("alice (Alice): contact is connected, your incognito profile for this contact is " <> cathIncognito)
|
||||
cath <## "use /i alice to print out this incognito profile again"
|
||||
cath <## ("#team: you joined the group incognito as " <> cathIncognito)
|
||||
cath <## ("#team: member " <> bobIncognito <> " is connected"),
|
||||
do
|
||||
bob <## ("#team: alice added " <> cathIncognito <> " to the group (connecting...)")
|
||||
bob <## ("#team: new member " <> cathIncognito <> " is connected")
|
||||
]
|
||||
|
||||
alice `hasContactProfiles` ["alice", T.pack bobIncognito, T.pack cathIncognito]
|
||||
bob `hasContactProfiles` ["bob", "alice", T.pack bobIncognito, T.pack cathIncognito]
|
||||
cath `hasContactProfiles` ["cath", "alice", T.pack bobIncognito, T.pack cathIncognito]
|
||||
|
||||
-- bob creates member contact with cath - both share incognito profile
|
||||
bob ##> ("/d " <> cathIncognito)
|
||||
bob <## (cathIncognito <> ": contact is deleted")
|
||||
cath ##> ("/d " <> bobIncognito)
|
||||
cath <## (bobIncognito <> ": contact is deleted")
|
||||
|
||||
bob ##> ("/contact member #team " <> cathIncognito)
|
||||
bob <## ("contact for member #team " <> cathIncognito <> " prepared, use /invite member contact @" <> cathIncognito <> " <message> to send invitation")
|
||||
|
||||
bob ##> ("/invite member contact @" <> cathIncognito <> " hi")
|
||||
bob
|
||||
<### [ ConsoleString ("sent invitation to connect directly to member #team " <> cathIncognito),
|
||||
WithTime ("i @" <> cathIncognito <> " hi")
|
||||
]
|
||||
cath
|
||||
<### [ ConsoleString ("#team " <> bobIncognito <> " is creating direct contact " <> bobIncognito <> " with you"),
|
||||
WithTime ("i " <> bobIncognito <> "> hi")
|
||||
]
|
||||
_ <- getTermLine bob
|
||||
_ <- getTermLine cath
|
||||
concurrentlyN_
|
||||
[ do
|
||||
bob <## (cathIncognito <> ": contact is connected, your incognito profile for this contact is " <> bobIncognito)
|
||||
bob <## ("use /i " <> cathIncognito <> " to print out this incognito profile again"),
|
||||
do
|
||||
cath <## (bobIncognito <> ": contact is connected, your incognito profile for this contact is " <> cathIncognito)
|
||||
cath <## ("use /i " <> bobIncognito <> " to print out this incognito profile again")
|
||||
]
|
||||
|
||||
bob `hasContactProfiles` ["bob", "alice", T.pack bobIncognito, T.pack cathIncognito]
|
||||
cath `hasContactProfiles` ["cath", "alice", T.pack bobIncognito, T.pack cathIncognito]
|
||||
|
||||
bob ?#> ("@" <> cathIncognito <> " hi, I'm incognito")
|
||||
cath ?<# (bobIncognito <> "> hi, I'm incognito")
|
||||
cath ?#> ("@" <> bobIncognito <> " hey, me too")
|
||||
bob ?<# (cathIncognito <> "> hey, me too")
|
||||
|
||||
-- members still use incognito profile for group
|
||||
alice #> "#team hello"
|
||||
concurrentlyN_
|
||||
[ bob ?<# "#team alice> hello",
|
||||
cath ?<# "#team alice> hello"
|
||||
]
|
||||
bob ?#> "#team hi there"
|
||||
concurrentlyN_
|
||||
[ alice <# ("#team " <> bobIncognito <> "> hi there"),
|
||||
cath ?<# ("#team " <> bobIncognito <> "> hi there")
|
||||
]
|
||||
cath ?#> "#team hey"
|
||||
concurrentlyN_
|
||||
[ alice <# ("#team " <> cathIncognito <> "> hey"),
|
||||
bob ?<# ("#team " <> cathIncognito <> "> hey")
|
||||
]
|
||||
|
||||
@ -270,6 +270,12 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||
it "x.grp.del" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.del\",\"params\":{}}"
|
||||
==# XGrpDel
|
||||
it "x.grp.direct.inv" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.direct.inv\",\"params\":{\"connReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\", \"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
|
||||
#==# XGrpDirectInv testConnReq (Just $ MCText "hello")
|
||||
it "x.grp.direct.inv without content" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.direct.inv\",\"params\":{\"connReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}"
|
||||
#==# XGrpDirectInv testConnReq Nothing
|
||||
it "x.info.probe" $
|
||||
"{\"v\":\"1\",\"event\":\"x.info.probe\",\"params\":{\"probe\":\"AQIDBA==\"}}"
|
||||
#==# XInfoProbe (Probe "\1\2\3\4")
|
||||
|
||||
Loading…
Reference in New Issue
Block a user