mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
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
+87
-2
@@ -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
|
||||
|
||||
@@ -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]
|
||||
|
||||
Reference in New Issue
Block a user