android-apps-mirrors/SimpleX-Chat
0
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2025-06-28 12:19:54 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

core: store welcome and request message IDs, ios: fix sending request without messages, trim sent messages (#6009)

Browse source 
* core: store welcome and request message IDs, ios: fix sending request without messages, trim sent messages

* remove comments

* rename, fix tests

* simplexmq

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
This commit is contained in:
Evgeny 2025-06-25 16:59:32 +01:00 • committed by GitHub
parent 6c06200b14
commit c0b704f846
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
21 changed files with 238 additions and 175 deletions
Download patch file Download diff file Expand all files Collapse all files

18
apps/ios/Shared/Model/AppAPITypes.swift
View file

@ -124,8 +124,8 @@ enum ChatCommand: ChatCmdProtocol {
case apiPrepareGroup(userId: Int64, connLink: CreatedConnLink, groupShortLinkData: GroupShortLinkData)
case apiChangePreparedContactUser(contactId: Int64, newUserId: Int64)
case apiChangePreparedGroupUser(groupId: Int64, newUserId: Int64)
case apiConnectPreparedContact(contactId: Int64, incognito: Bool, msg: MsgContent)
case apiConnectPreparedGroup(groupId: Int64, incognito: Bool)
case apiConnectPreparedContact(contactId: Int64, incognito: Bool, msg: MsgContent?)
case apiConnectPreparedGroup(groupId: Int64, incognito: Bool, msg: MsgContent?)
case apiConnect(userId: Int64, incognito: Bool, connLink: CreatedConnLink)
case apiConnectContactViaAddress(userId: Int64, incognito: Bool, contactId: Int64)
case apiDeleteChat(type: ChatType, id: Int64, chatDeleteMode: ChatDeleteMode)
@ -324,8 +324,8 @@ enum ChatCommand: ChatCmdProtocol {
case let .apiPrepareGroup(userId, connLink, groupShortLinkData): return "/_prepare group \(userId) \(connLink.connFullLink) \(connLink.connShortLink ?? "") \(encodeJSON(groupShortLinkData))"
case let .apiChangePreparedContactUser(contactId, newUserId): return "/_set contact user @\(contactId) \(newUserId)"
case let .apiChangePreparedGroupUser(groupId, newUserId): return "/_set group user #\(groupId) \(newUserId)"
case let .apiConnectPreparedContact(contactId, incognito, mc): return "/_connect contact @\(contactId) incognito=\(onOff(incognito)) \(mc.cmdString)"
case let .apiConnectPreparedGroup(groupId, incognito): return "/_connect group #\(groupId) incognito=\(onOff(incognito))"
case let .apiConnectPreparedContact(contactId, incognito, mc): return "/_connect contact @\(contactId) incognito=\(onOff(incognito))\(maybeContent(mc))"
case let .apiConnectPreparedGroup(groupId, incognito, mc): return "/_connect group #\(groupId) incognito=\(onOff(incognito))\(maybeContent(mc))"
case let .apiConnect(userId, incognito, connLink): return "/_connect \(userId) incognito=\(onOff(incognito)) \(connLink.connFullLink) \(connLink.connShortLink ?? "")"
case let .apiConnectContactViaAddress(userId, incognito, contactId): return "/_connect contact \(userId) incognito=\(onOff(incognito)) \(contactId)"
case let .apiDeleteChat(type, id, chatDeleteMode): return "/_delete \(ref(type, id, scope: nil)) \(chatDeleteMode.cmdString)"
@ -621,6 +621,16 @@ enum ChatCommand: ChatCmdProtocol {
private func maybePwd(_ pwd: String?) -> String {
pwd == "" || pwd == nil ? "" : " " + encodeJSON(pwd)
}
private func maybeContent(_ mc: MsgContent?) -> String {
if case let .text(s) = mc, s.isEmpty {
""
} else if let mc {
" " + mc.cmdString
} else {
""
}
}
}
// ChatResponse is split to three enums to reduce stack size used when parsing it, parsing large enums is very inefficient.

6
apps/ios/Shared/Model/SimpleXAPI.swift
View file

@ -1027,14 +1027,14 @@ func apiChangePreparedGroupUser(groupId: Int64, newUserId: Int64) async throws -
throw r.unexpected
}
func apiConnectPreparedContact(contactId: Int64, incognito: Bool, msg: MsgContent) async throws -> Contact {
func apiConnectPreparedContact(contactId: Int64, incognito: Bool, msg: MsgContent?) async throws -> Contact {
let r: ChatResponse1 = try await chatSendCmd(.apiConnectPreparedContact(contactId: contactId, incognito: incognito, msg: msg))
if case let .startedConnectionToContact(_, contact) = r { return contact }
throw r.unexpected
}
func apiConnectPreparedGroup(groupId: Int64, incognito: Bool) async throws -> GroupInfo {
let r: ChatResponse1 = try await chatSendCmd(.apiConnectPreparedGroup(groupId: groupId, incognito: incognito))
func apiConnectPreparedGroup(groupId: Int64, incognito: Bool, msg: MsgContent?) async throws -> GroupInfo {
let r: ChatResponse1 = try await chatSendCmd(.apiConnectPreparedGroup(groupId: groupId, incognito: incognito, msg: msg))
if case let .startedConnectionToGroup(_, groupInfo) = r { return groupInfo }
throw r.unexpected
}

47
apps/ios/Shared/Views/Chat/ComposeMessage/ComposeView.swift
View file

@ -166,7 +166,7 @@ struct ComposeState {
case let .mediaPreviews(media): return !media.isEmpty
case .voicePreview: return voiceMessageRecordingState == .finished
case .filePreview: return true
default: return !message.isEmpty || forwarding || liveMessage != nil || submittingValidReport
default: return !whitespaceOnly || forwarding || liveMessage != nil || submittingValidReport
}
}
@ -247,7 +247,11 @@ struct ComposeState {
}
var empty: Bool {
message == "" && noPreview
whitespaceOnly && noPreview
}
var whitespaceOnly: Bool {
message.allSatisfy { $0.isWhitespace }
}
}
@ -431,7 +435,7 @@ struct ComposeView: View {
placeholder: NSLocalizedString("Add message", comment: "placeholder for sending contact request"),
sendToConnect: sendConnectPreparedContactRequest
)
if composeState.message.isEmpty {
if composeState.whitespaceOnly {
Button(action: sendConnectPreparedContactRequest) {
HStack {
Text("Connect").fontWeight(.medium)
@ -633,7 +637,7 @@ struct ComposeView: View {
chatModel.removeLiveDummy()
},
sendToConnect: sendToConnect,
hideSendButton: chat.chatInfo.nextConnect && chat.chatInfo.contact?.nextSendGrpInv != true && composeState.message.isEmpty,
hideSendButton: chat.chatInfo.nextConnect && chat.chatInfo.contact?.nextSendGrpInv != true && composeState.whitespaceOnly,
voiceMessageAllowed: chat.chatInfo.featureEnabled(.voice),
disableSendButton: disableSendButton,
showEnableVoiceMessagesAlert: chat.chatInfo.showEnableVoiceMessagesAlert,
@ -690,11 +694,14 @@ struct ComposeView: View {
private func sendMemberContactInvitation() {
Task {
do {
let mc = checkLinkPreview()
let contact = try await apiSendMemberContactInvitation(chat.chatInfo.apiId, mc)
await MainActor.run {
self.chatModel.updateContact(contact)
clearState()
if let mc = connectCheckLinkPreview() {
let contact = try await apiSendMemberContactInvitation(chat.chatInfo.apiId, mc)
await MainActor.run {
self.chatModel.updateContact(contact)
clearState()
}
} else {
AlertManager.shared.showAlertMsg(title: "Empty message!")
}
} catch {
logger.error("ChatView.sendMemberContactInvitation error: \(error.localizedDescription)")
@ -706,15 +713,16 @@ struct ComposeView: View {
// TODO [short links] different messages for business
private func sendConnectPreparedContactRequest() {
hideKeyboard()
let empty = composeState.whitespaceOnly
AlertManager.shared.showAlert(Alert(
title: Text("Send contact request?"),
message: Text("You will be able to send messages **only after your request is accepted**."),
primaryButton: .default(
Text(composeState.message.isEmpty ? "Send request without message" : "Send request"),
Text(empty ? "Send request without message" : "Send request"),
action: sendConnectPreparedContact
),
secondaryButton:
composeState.message.isEmpty
empty
? .cancel(Text("Add message")) { keyboardVisible = true }
: .cancel()
))
@ -723,7 +731,7 @@ struct ComposeView: View {
private func sendConnectPreparedContact() {
Task {
do {
let mc = checkLinkPreview()
let mc = connectCheckLinkPreview()
let contact = try await apiConnectPreparedContact(contactId: chat.chatInfo.apiId, incognito: incognitoGroupDefault.get(), msg: mc)
await MainActor.run {
self.chatModel.updateContact(contact)
@ -739,7 +747,8 @@ struct ComposeView: View {
private func connectPreparedGroup() {
Task {
do {
let groupInfo = try await apiConnectPreparedGroup(groupId: chat.chatInfo.apiId, incognito: incognitoGroupDefault.get())
let mc = connectCheckLinkPreview()
let groupInfo = try await apiConnectPreparedGroup(groupId: chat.chatInfo.apiId, incognito: incognitoGroupDefault.get(), msg: mc)
await MainActor.run {
self.chatModel.updateGroup(groupInfo)
clearState()
@ -751,8 +760,18 @@ struct ComposeView: View {
}
}
@inline(__always)
private func connectCheckLinkPreview() -> MsgContent? {
let msgText = composeState.message.trimmingCharacters(in: .whitespacesAndNewlines)
return msgText.isEmpty ? nil : checkLinkPreview_(msgText)
}
@inline(__always)
private func checkLinkPreview() -> MsgContent {
let msgText = composeState.message
checkLinkPreview_(composeState.message.trimmingCharacters(in: .whitespacesAndNewlines))
}
private func checkLinkPreview_(_ msgText: String) -> MsgContent {
switch (composeState.preview) {
case let .linkPreview(linkPreview: linkPreview):
if let parsedMsg = parseSimpleXMarkdown(msgText),

1
apps/ios/SimpleXChat/ChatTypes.swift
View file

@ -4204,6 +4204,7 @@ public enum MsgContent: Equatable, Hashable {
}
}
@inline(__always)
public var cmdString: String {
"json \(encodeJSON(self))"
}

2
cabal.project
View file

@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
source-repository-package
type: git
location: https://github.com/simplex-chat/simplexmq.git
tag: af34e80729ea24769d0b707824a4d840f70273cc
tag: 976bd3a389aaded78b4285541e6dddd6b2766149
source-repository-package
type: git

2
scripts/nix/sha256map.nix
View file

@ -1,5 +1,5 @@
{
"https://github.com/simplex-chat/simplexmq.git"."af34e80729ea24769d0b707824a4d840f70273cc" = "0pbkpinm1bwna9f5ix8kimg15fppsqyawn2pijl3xxyjhv0vgwdq";
"https://github.com/simplex-chat/simplexmq.git"."976bd3a389aaded78b4285541e6dddd6b2766149" = "06mijsfnb9q9wa0lj49a24ajnw45qash7sc9ah95cd517bj6rnki";
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
"https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
"https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";

4
src/Simplex/Chat/Controller.hs
View file

@ -455,8 +455,8 @@ data ChatCommand
| APIChangePreparedContactUser ContactId UserId
| APIChangePreparedGroupUser GroupId UserId
| APIConnectPreparedContact {contactId :: ContactId, incognito :: IncognitoEnabled, msgContent_ :: Maybe MsgContent}
| APIConnectPreparedGroup GroupId IncognitoEnabled
| APIConnect UserId IncognitoEnabled (Maybe ACreatedConnLink) (Maybe MsgContent)
| APIConnectPreparedGroup GroupId IncognitoEnabled (Maybe MsgContent)
| APIConnect UserId IncognitoEnabled (Maybe ACreatedConnLink)
| Connect IncognitoEnabled (Maybe AConnectionLink)
| APIConnectContactViaAddress UserId IncognitoEnabled ContactId
| ConnectSimplex IncognitoEnabled -- UserId (not used in UI)

77
src/Simplex/Chat/Library/Commands.hs
View file

@ -1737,38 +1737,39 @@ processChatCommand' vr = \case
uncurry (CRConnectionPlan user) <$> connectPlan user cLink
APIPrepareContact userId accLink contactSLinkData -> withUserId userId $ \user -> do
let ContactShortLinkData {profile, message, business} = contactSLinkData
welcomeSharedMsgId <- forM message $ \_ -> getSharedMsgId
case accLink of
ACCL SCMContact ccLink
| business -> do
let Profile {preferences} = profile
groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs preferences
groupProfile = businessGroupProfile profile groupPreferences
(gInfo, hostMember) <- withStore $ \db -> createPreparedGroup db vr user groupProfile True ccLink
(gInfo, hostMember) <- withStore $ \db -> createPreparedGroup db vr user groupProfile True ccLink welcomeSharedMsgId
let cd = CDGroupRcv gInfo Nothing hostMember
createItem content = createInternalItemForChat user cd True content Nothing
createItem sharedMsgId content = createChatItem user cd True content sharedMsgId Nothing
cInfo = GroupChat gInfo Nothing
void $ createGroupFeatureItems_ user cd True CIRcvGroupFeature gInfo
aci <- mapM (createItem . CIRcvMsgContent . MCText) message
aci <- mapM (createItem welcomeSharedMsgId . CIRcvMsgContent . MCText) message
let chat = case aci of
Just (AChatItem SCTGroup dir _ ci) -> Chat cInfo [CChatItem dir ci] emptyChatStats {unreadCount = 1, minUnreadItemId = chatItemId' ci}
_ -> Chat cInfo [] emptyChatStats
pure $ CRNewPreparedChat user $ AChat SCTGroup chat
ACCL _ (CCLink cReq _) -> do
ct <- withStore $ \db -> createPreparedContact db user profile accLink
let createItem content = createInternalItemForChat user (CDDirectRcv ct) False content Nothing
ct <- withStore $ \db -> createPreparedContact db user profile accLink welcomeSharedMsgId
let createItem sharedMsgId content = createChatItem user (CDDirectRcv ct) False content sharedMsgId Nothing
cInfo = DirectChat ct
void $ createItem $ CIRcvDirectE2EEInfo $ E2EInfo $ connRequestPQEncryption cReq
void $ createItem Nothing $ CIRcvDirectE2EEInfo $ E2EInfo $ connRequestPQEncryption cReq
void $ createFeatureEnabledItems_ user ct
aci <- mapM (createItem . CIRcvMsgContent . MCText) message
aci <- mapM (createItem welcomeSharedMsgId . CIRcvMsgContent . MCText) message
let chat = case aci of
Just (AChatItem SCTDirect dir _ ci) -> Chat cInfo [CChatItem dir ci] emptyChatStats {unreadCount = 1, minUnreadItemId = chatItemId' ci}
_ -> Chat cInfo [] emptyChatStats
pure $ CRNewPreparedChat user $ AChat SCTDirect chat
APIPrepareGroup userId ccLink groupSLinkData -> withUserId userId $ \user -> do
let GroupShortLinkData {groupProfile = gp@GroupProfile {description}} = groupSLinkData
(gInfo, hostMember) <- withStore $ \db -> createPreparedGroup db vr user gp False ccLink
(gInfo, hostMember) <- withStore $ \db -> createPreparedGroup db vr user gp False ccLink Nothing
let cd = CDGroupRcv gInfo Nothing hostMember
createItem content = createInternalItemForChat user cd True content Nothing
createItem content = createChatItem user cd True content Nothing Nothing
cInfo = GroupChat gInfo Nothing
void $ createGroupFeatureItems_ user cd True CIRcvGroupFeature gInfo
aci <- mapM (createItem . CIRcvMsgContent . MCText) description
@ -1785,8 +1786,7 @@ processChatCommand' vr = \case
pure $ CRContactUserChanged user ct newUser ct'
APIChangePreparedGroupUser groupId newUserId -> withUser $ \user -> do
(gInfo, hostMember) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user groupId <*> getHostMember db vr user groupId
let GroupInfo {connLinkToConnect} = gInfo
when (isNothing connLinkToConnect) $ throwCmdError "group doesn't have link to connect"
when (isNothing $ preparedGroup gInfo) $ throwCmdError "group doesn't have link to connect"
when (isJust $ memberConn hostMember) $ throwCmdError "host member already has connection"
newUser <- privateGetUser newUserId
gInfo' <- withFastStore $ \db -> updatePreparedGroupUser db vr user gInfo hostMember newUser
@ -1807,33 +1807,34 @@ processChatCommand' vr = \case
toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct') ci]
pure $ CRStartedConnectionToContact user ct' customUserProfile
cr -> pure cr
Just PreparedContact {connLinkToConnect = ACCL SCMContact ccLink} ->
connectViaContact user incognito ccLink msgContent_ (Just $ ACCGContact contactId) >>= \case
Just PreparedContact {connLinkToConnect = ACCL SCMContact ccLink, welcomeSharedMsgId} -> do
msg_ <- forM msgContent_ $ \mc -> (,mc) <$> getSharedMsgId
connectViaContact user incognito ccLink welcomeSharedMsgId msg_ (Just $ ACCGContact contactId) >>= \case
CRSentInvitation {customUserProfile} -> do
-- get updated contact with connection
ct' <- withFastStore $ \db -> getContact db vr user contactId
forM_ msgContent_ $ \mc ->
createInternalChatItem user (CDDirectSnd ct') (CISndMsgContent mc) Nothing
forM_ msg_ $ \(sharedMsgId, mc) -> do
ci <- createChatItem user (CDDirectSnd ct') False (CISndMsgContent mc) (Just sharedMsgId) Nothing
toView $ CEvtNewChatItems user [ci]
pure $ CRStartedConnectionToContact user ct' customUserProfile
cr -> pure cr
APIConnectPreparedGroup groupId incognito -> withUser $ \user -> do
APIConnectPreparedGroup groupId incognito msgContent_ -> withUser $ \user -> do
(gInfo, hostMember) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user groupId <*> getHostMember db vr user groupId
let GroupInfo {connLinkToConnect} = gInfo
case connLinkToConnect of
case preparedGroup gInfo of
Nothing -> throwCmdError "group doesn't have link to connect"
Just ccLink ->
connectViaContact user incognito ccLink Nothing (Just $ ACCGGroup gInfo (groupMemberId' hostMember)) >>= \case
Just PreparedGroup {connLinkToConnect} ->
-- TODO [short links] store request message with shared message ID
connectViaContact user incognito connLinkToConnect Nothing Nothing (Just $ ACCGGroup gInfo (groupMemberId' hostMember)) >>= \case
CRSentInvitation {customUserProfile} -> do
-- get updated group info (connLinkStartedConnection and incognito membership)
gInfo' <- withFastStore $ \db -> getGroupInfo db vr user groupId
pure $ CRStartedConnectionToGroup user gInfo' customUserProfile
cr -> pure cr
APIConnect userId incognito (Just (ACCL SCMInvitation ccLink)) mc_ -> withUserId userId $ \user -> do
when (isJust mc_) $ throwChatError CEConnReqMessageProhibited
APIConnect userId incognito (Just (ACCL SCMInvitation ccLink)) -> withUserId userId $ \user ->
connectViaInvitation user incognito ccLink Nothing
APIConnect userId incognito (Just (ACCL SCMContact ccLink)) mc_ -> withUserId userId $ \user ->
connectViaContact user incognito ccLink mc_ Nothing
APIConnect _ _ Nothing _ -> throwChatError CEInvalidConnReq
APIConnect userId incognito (Just (ACCL SCMContact ccLink)) -> withUserId userId $ \user ->
connectViaContact user incognito ccLink Nothing Nothing Nothing
APIConnect _ _ Nothing -> throwChatError CEInvalidConnReq
Connect incognito (Just cLink@(ACL m cLink')) -> withUser $ \user -> do
(ccLink, plan) <- connectPlan user cLink `catchChatError` \e -> case cLink' of CLFull cReq -> pure (ACCL m (CCLink cReq Nothing), CPInvitationLink (ILPOk Nothing)); _ -> throwError e
connectWithPlan user incognito ccLink plan
@ -2904,8 +2905,8 @@ processChatCommand' vr = \case
( CRInvitationUri crData {crScheme = SSSimplex} e2e,
CRInvitationUri crData {crScheme = simplexChat} e2e
)
connectViaContact :: User -> IncognitoEnabled -> CreatedLinkContact -> Maybe MsgContent -> Maybe AttachConnToContactOrGroup -> CM ChatResponse
connectViaContact user@User {userId} incognito (CCLink cReq@(CRContactUri ConnReqUriData {crClientData}) sLnk) mc_ attachConnTo_ = withInvitationLock "connectViaContact" (strEncode cReq) $ do
connectViaContact :: User -> IncognitoEnabled -> CreatedLinkContact -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> Maybe AttachConnToContactOrGroup -> CM ChatResponse
connectViaContact user@User {userId} incognito (CCLink cReq@(CRContactUri ConnReqUriData {crClientData}) sLnk) welcomeSharedMsgId msg_ attachConnTo_ = withInvitationLock "connectViaContact" (strEncode cReq) $ do
let groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli
cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
case groupLinkId of
@ -2919,7 +2920,7 @@ processChatCommand' vr = \case
connect' Nothing cReqHash xContactId False
-- group link
Just gLinkId -> do
when (isJust mc_) $ throwChatError CEConnReqMessageProhibited
when (isJust msg_) $ throwChatError CEConnReqMessageProhibited
withFastStore' (\db -> getConnReqContactXContactId db vr user cReqHash) >>= \case
(Just _contact, _) -> procCmd $ do
-- allow repeat contact request
@ -2938,7 +2939,7 @@ processChatCommand' vr = \case
subMode <- chatReadVar subscriptionMode
let sLnk' = serverShortLink <$> sLnk
conn@PendingContactConnection {pccConnId} <- withFastStore' $ \db -> createConnReqConnection db userId connId cReqHash sLnk' attachConnTo_ xContactId incognitoProfile groupLinkId subMode chatV pqSup
joinContact user pccConnId connId cReq incognitoProfile xContactId mc_ inGroup pqSup chatV
joinContact user pccConnId connId cReq incognitoProfile xContactId welcomeSharedMsgId msg_ inGroup pqSup chatV
pure $ CRSentInvitation user conn incognitoProfile
connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> CreatedLinkContact -> CM ChatResponse
connectContactViaAddress user incognito ct (CCLink cReq shortLink) =
@ -2951,7 +2952,7 @@ processChatCommand' vr = \case
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
subMode <- chatReadVar subscriptionMode
(pccConnId, ct') <- withFastStore $ \db -> createAddressContactConnection db vr user ct connId cReqHash shortLink newXContactId incognitoProfile subMode chatV pqSup
joinContact user pccConnId connId cReq incognitoProfile newXContactId Nothing False pqSup chatV
joinContact user pccConnId connId cReq incognitoProfile newXContactId Nothing Nothing False pqSup chatV
pure $ CRSentInvitationToContact user ct' incognitoProfile
prepareContact :: User -> ConnReqContact -> PQSupport -> CM (ConnId, VersionChat)
prepareContact user cReq pqSup = do
@ -2964,11 +2965,11 @@ processChatCommand' vr = \case
let chatV = agentToChatVersion agentV
connId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup
pure (connId, chatV)
joinContact :: User -> Int64 -> ConnId -> ConnReqContact -> Maybe Profile -> XContactId -> Maybe MsgContent -> Bool -> PQSupport -> VersionChat -> CM ()
joinContact user pccConnId connId cReq incognitoProfile xContactId mc_ inGroup pqSup chatV = do
joinContact :: User -> Int64 -> ConnId -> ConnReqContact -> Maybe Profile -> XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> Bool -> PQSupport -> VersionChat -> CM ()
joinContact user pccConnId connId cReq incognitoProfile xContactId welcomeSharedMsgId msg_ inGroup pqSup chatV = do
let profileToSend = userProfileToSend user incognitoProfile Nothing inGroup
-- TODO [short links] send welcome and sent sharedMsg Ids
dm <- encodeConnInfoPQ pqSup chatV (XContact profileToSend (Just xContactId) Nothing ((SharedMsgId "\1\2\3\4",) <$> mc_))
dm <- encodeConnInfoPQ pqSup chatV (XContact profileToSend (Just xContactId) welcomeSharedMsgId msg_)
subMode <- chatReadVar subscriptionMode
joinPreparedAgentConnection user pccConnId connId cReq dm pqSup subMode
joinPreparedAgentConnection :: User -> Int64 -> ConnId -> ConnectionRequestUri m -> ByteString -> PQSupport -> SubscriptionMode -> CM ()
@ -3361,7 +3362,7 @@ processChatCommand' vr = \case
case plan of
CPContactAddress (CAPContactViaAddress Contact {contactId}) ->
processChatCommand $ APIConnectContactViaAddress userId incognito contactId
_ -> processChatCommand $ APIConnect userId incognito (Just ccLink) Nothing
_ -> processChatCommand $ APIConnect userId incognito (Just ccLink)
| otherwise = pure $ CRConnectionPlan user ccLink plan
invitationRequestPlan :: User -> ConnReqInvitation -> Maybe ContactShortLinkData -> CM ConnectionPlan
invitationRequestPlan user cReq contactSLinkData_ = do
@ -3805,6 +3806,10 @@ processChatCommand' vr = \case
ChatRef CTDirect cId _ -> a $ SRDirect cId
ChatRef CTGroup gId scope -> a $ SRGroup gId scope
_ -> throwCmdError "not supported"
getSharedMsgId :: CM SharedMsgId
getSharedMsgId = do
gVar <- asks random
liftIO $ SharedMsgId <$> encodedRandomBytes gVar 12
protocolServers :: UserProtocol p => SProtocolType p -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]) -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
protocolServers p (operators, smpServers, xftpServers) = case p of
@ -4472,9 +4477,9 @@ chatCommandP =
"/_set contact user @" *> (APIChangePreparedContactUser <$> A.decimal <* A.space <*> A.decimal),
"/_set group user #" *> (APIChangePreparedGroupUser <$> A.decimal <* A.space <*> A.decimal),
"/_connect contact @" *> (APIConnectPreparedContact <$> A.decimal <*> incognitoOnOffP <*> optional (A.space *> msgContentP)),
"/_connect group #" *> (APIConnectPreparedGroup <$> A.decimal <*> incognitoOnOffP),
"/_connect group #" *> (APIConnectPreparedGroup <$> A.decimal <*> incognitoOnOffP <*> optional (A.space *> msgContentP)),
"/_connect " *> (APIAddContact <$> A.decimal <*> incognitoOnOffP),
"/_connect " *> (APIConnect <$> A.decimal <*> incognitoOnOffP <* A.space <*> connLinkP_ <*> optional (A.space *> msgContentP)),
"/_connect " *> (APIConnect <$> A.decimal <*> incognitoOnOffP <* A.space <*> connLinkP_),
"/_set incognito :" *> (APISetConnectionIncognito <$> A.decimal <* A.space <*> onOffP),
"/_set conn user :" *> (APIChangeConnectionUser <$> A.decimal <* A.space <*> A.decimal),
("/connect" <|> "/c") *> (AddContact <$> incognitoP),

42
src/Simplex/Chat/Library/Internal.hs
View file

@ -2289,7 +2289,7 @@ createFeatureEnabledItems_ :: User -> Contact -> CM [AChatItem]
createFeatureEnabledItems_ user ct@Contact {mergedPreferences} =
forM allChatFeatures $ \(ACF f) -> do
let state = featureState $ getContactUserPreference f mergedPreferences
createInternalItemForChat user (CDDirectRcv ct) False (uncurry (CIRcvChatFeature $ chatFeature f) state) Nothing
createChatItem user (CDDirectRcv ct) False (uncurry (CIRcvChatFeature $ chatFeature f) state) Nothing Nothing
createFeatureItems ::
MsgDirectionI d =>
@ -2315,19 +2315,19 @@ createContactsFeatureItems ::
CM' ()
createContactsFeatureItems user cts chatDir ciFeature ciOffer getPref = do
let dirsCIContents = map contactChangedFeatures cts
(errs, acis) <- partitionEithers <$> createInternalItemsForChats user Nothing dirsCIContents
(errs, acis) <- partitionEithers <$> createChatItems user Nothing dirsCIContents
unless (null errs) $ toView' $ CEvtChatErrors errs
toView' $ CEvtNewChatItems user acis
where
contactChangedFeatures :: (Contact, Contact) -> (ChatDirection 'CTDirect d, ShowGroupAsSender, [CIContent d])
contactChangedFeatures :: (Contact, Contact) -> (ChatDirection 'CTDirect d, ShowGroupAsSender, [(CIContent d, Maybe SharedMsgId)])
contactChangedFeatures (Contact {mergedPreferences = cups}, ct'@Contact {mergedPreferences = cups'}) = do
let contents = mapMaybe (\(ACF f) -> featureCIContent_ f) allChatFeatures
(chatDir ct', False, contents)
where
featureCIContent_ :: forall f. FeatureI f => SChatFeature f -> Maybe (CIContent d)
featureCIContent_ :: forall f. FeatureI f => SChatFeature f -> Maybe (CIContent d, Maybe SharedMsgId)
featureCIContent_ f
| state /= state' = Just $ fContent ciFeature state'
| prefState /= prefState' = Just $ fContent ciOffer prefState'
| state /= state' = Just (fContent ciFeature state', Nothing)
| prefState /= prefState' = Just (fContent ciOffer prefState', Nothing)
| otherwise = Nothing
where
fContent :: FeatureContent a d -> (a, Maybe Int) -> CIContent d
@ -2360,50 +2360,52 @@ createGroupFeatureItems_ user cd showGroupAsSender ciContent GroupInfo {fullGrou
forM allGroupFeatures $ \(AGF f) -> do
let p = getGroupPreference f fullGroupPreferences
(_, param, role) = groupFeatureState p
createInternalItemForChat user cd showGroupAsSender (ciContent (toGroupFeature f) (toGroupPreference p) param role) Nothing
createChatItem user cd showGroupAsSender (ciContent (toGroupFeature f) (toGroupPreference p) param role) Nothing Nothing
createInternalChatItem :: (ChatTypeI c, MsgDirectionI d) => User -> ChatDirection c d -> CIContent d -> Maybe UTCTime -> CM ()
createInternalChatItem user cd content itemTs_ = do
ci <- createInternalItemForChat user cd False content itemTs_
ci <- createChatItem user cd False content Nothing itemTs_
toView $ CEvtNewChatItems user [ci]
createInternalItemForChat :: (ChatTypeI c, MsgDirectionI d) => User -> ChatDirection c d -> ShowGroupAsSender -> CIContent d -> Maybe UTCTime -> CM AChatItem
createInternalItemForChat user cd showGroupAsSender content itemTs_ =
lift (createInternalItemsForChats user itemTs_ [(cd, showGroupAsSender, [content])]) >>= \case
createChatItem :: (ChatTypeI c, MsgDirectionI d) => User -> ChatDirection c d -> ShowGroupAsSender -> CIContent d -> Maybe SharedMsgId -> Maybe UTCTime -> CM AChatItem
createChatItem user cd showGroupAsSender content sharedMsgId itemTs_ =
lift (createChatItems user itemTs_ [(cd, showGroupAsSender, [(content, sharedMsgId)])]) >>= \case
[Right ci] -> pure ci
[Left e] -> throwError e
rs -> throwChatError $ CEInternalError $ "createInternalChatItem: expected 1 result, got " <> show (length rs)
createInternalItemsForChats ::
-- Supports items with shared msg ID that are created for all conversation parties, but were not communicated via the usual messages.
-- This includes address welcome message and contact request message.
createChatItems ::
forall c d.
(ChatTypeI c, MsgDirectionI d) =>
User ->
Maybe UTCTime ->
[(ChatDirection c d, ShowGroupAsSender, [CIContent d])] ->
[(ChatDirection c d, ShowGroupAsSender, [(CIContent d, Maybe SharedMsgId)])] ->
CM' [Either ChatError AChatItem]
createInternalItemsForChats user itemTs_ dirsCIContents = do
createChatItems user itemTs_ dirsCIContents = do
createdAt <- liftIO getCurrentTime
let itemTs = fromMaybe createdAt itemTs_
vr <- chatVersionRange'
void . withStoreBatch' $ \db -> map (updateChat db vr createdAt) dirsCIContents
withStoreBatch' $ \db -> concatMap (createACIs db itemTs createdAt) dirsCIContents
where
updateChat :: DB.Connection -> VersionRangeChat -> UTCTime -> (ChatDirection c d, ShowGroupAsSender, [CIContent d]) -> IO ()
updateChat :: DB.Connection -> VersionRangeChat -> UTCTime -> (ChatDirection c d, ShowGroupAsSender, [(CIContent d, Maybe SharedMsgId)]) -> IO ()
updateChat db vr createdAt (cd, _, contents)
| any ciRequiresAttention contents || contactChatDeleted cd = void $ updateChatTsStats db vr user cd createdAt memberChatStats
| any (ciRequiresAttention . fst) contents || contactChatDeleted cd = void $ updateChatTsStats db vr user cd createdAt memberChatStats
| otherwise = pure ()
where
memberChatStats :: Maybe (Int, MemberAttention, Int)
memberChatStats = case cd of
CDGroupRcv _g (Just scope) m -> do
let unread = length $ filter ciRequiresAttention contents
let unread = length $ filter (ciRequiresAttention . fst) contents
in Just (unread, memberAttentionChange unread itemTs_ m scope, 0)
_ -> Nothing
createACIs :: DB.Connection -> UTCTime -> UTCTime -> (ChatDirection c d, ShowGroupAsSender, [CIContent d]) -> [IO AChatItem]
createACIs :: DB.Connection -> UTCTime -> UTCTime -> (ChatDirection c d, ShowGroupAsSender, [(CIContent d, Maybe SharedMsgId)]) -> [IO AChatItem]
createACIs db itemTs createdAt (cd, showGroupAsSender, contents) = map createACI contents
where
createACI content = do
ciId <- createNewChatItemNoMsg db user cd showGroupAsSender content itemTs createdAt
createACI (content, sharedMsgId) = do
ciId <- createNewChatItemNoMsg db user cd showGroupAsSender content sharedMsgId itemTs createdAt
let ci = mkChatItem cd showGroupAsSender ciId content Nothing Nothing Nothing Nothing Nothing False False itemTs Nothing createdAt
pure $ AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci

3
src/Simplex/Chat/Library/Subscriber.hs
View file

@ -1252,7 +1252,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
-- Do not created e2e item on repeat request
if newRequest
then do
let createItem content = createInternalItemForChat user (CDDirectRcv ct) False content Nothing
-- TODO [short links] save sharedMsgId instead of the last Nothing
let createItem content = createChatItem user (CDDirectRcv ct) False content Nothing Nothing
void $ createItem $ CIRcvDirectE2EEInfo $ E2EInfo $ Just $ CR.pqSupportToEnc $ reqPQSup
void $ createFeatureEnabledItems_ user ct
-- TODO [short links] save sharedMsgId

19
src/Simplex/Chat/Protocol.hs
View file

@ -54,7 +54,6 @@ import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Messaging.Agent.Protocol (VersionSMPA, pqdrSMPAgentVersion)
import Simplex.Messaging.Agent.Store.DB (fromTextField_)
import qualified Simplex.Messaging.Agent.Store.DB as DB
import Simplex.Messaging.Compression (Compressed, compress1, decompress1)
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
@ -235,24 +234,6 @@ instance StrEncoding AppMessageBinary where
let msgId = if B.null msgId' then Nothing else Just (SharedMsgId msgId')
pure AppMessageBinary {tag, msgId, body}
newtype SharedMsgId = SharedMsgId ByteString
deriving (Eq, Show)
deriving newtype (FromField)
instance ToField SharedMsgId where toField (SharedMsgId m) = toField $ DB.Binary m
instance StrEncoding SharedMsgId where
strEncode (SharedMsgId m) = strEncode m
strDecode s = SharedMsgId <$> strDecode s
strP = SharedMsgId <$> strP
instance FromJSON SharedMsgId where
parseJSON = strParseJSON "SharedMsgId"
instance ToJSON SharedMsgId where
toJSON = strToJSON
toEncoding = strToJEncoding
data MsgScope
= MSMember {memberId :: MemberId} -- Admins can use any member id; members can use only their own id
deriving (Eq, Show)

8
src/Simplex/Chat/Store/Connections.hs
View file

@ -112,7 +112,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
[sql|
SELECT
c.contact_profile_id, c.local_display_name, c.via_group, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, c.contact_used, c.contact_status, c.enable_ntfs, c.send_rcpts, c.favorite,
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.conn_full_link_to_connect, c.conn_short_link_to_connect, c.contact_request_id,
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.conn_full_link_to_connect, c.conn_short_link_to_connect, c.welcome_shared_msg_id, c.contact_request_id,
c.contact_group_member_id, c.contact_grp_inv_sent, c.ui_themes, c.chat_deleted, c.custom_data, c.chat_item_ttl
FROM contacts c
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
@ -120,12 +120,12 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
|]
(userId, contactId)
toContact' :: Int64 -> Connection -> [ChatTagId] -> ContactRow' -> Contact
toContact' contactId conn chatTags ((profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (connFullLink, connShortLink, contactRequestId, contactGroupMemberId, BI contactGrpInvSent, uiThemes, BI chatDeleted, customData, chatItemTTL)) =
toContact' contactId conn chatTags ((profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent, uiThemes, BI chatDeleted, customData, chatItemTTL)) =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
activeConn = Just conn
preparedContact = toPreparedContact connFullLink connShortLink
preparedContact = toPreparedContact preparedContactRow
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, preparedContact, contactRequestId, contactGroupMemberId, contactGrpInvSent, chatTags, chatItemTTL, uiThemes, chatDeleted, customData}
getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember_ groupMemberId c = do
@ -140,7 +140,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection, g.welcome_shared_msg_id,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
-- GroupInfo {membership}

15
src/Simplex/Chat/Store/Direct.hs
View file

@ -223,7 +223,7 @@ getContactByConnReqHash db vr 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.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.contact_request_id,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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.contact_conn_initiated, c.local_alias,
@ -263,10 +263,11 @@ createIncognitoProfile db User {userId} p = do
createdAt <- getCurrentTime
createIncognitoProfile_ db userId createdAt p
createPreparedContact :: DB.Connection -> User -> Profile -> ACreatedConnLink -> ExceptT StoreError IO Contact
createPreparedContact db user@User {userId} p@Profile {preferences} connLinkToConnect@(ACCL m _) = do
createPreparedContact :: DB.Connection -> User -> Profile -> ACreatedConnLink -> Maybe SharedMsgId -> ExceptT StoreError IO Contact
createPreparedContact db user@User {userId} p@Profile {preferences} connLinkToConnect@(ACCL m _) welcomeSharedMsgId = do
currentTs <- liftIO getCurrentTime
(localDisplayName, contactId, profileId) <- createContact_ db userId p (Just connLinkToConnect) "" Nothing currentTs
let prepared = Just (connLinkToConnect, welcomeSharedMsgId)
(localDisplayName, contactId, profileId) <- createContact_ db userId p prepared "" Nothing currentTs
let profile = toLocalProfile profileId p ""
userPreferences = emptyChatPrefs
mergedPreferences = contactUserPreferences user userPreferences preferences False
@ -285,7 +286,7 @@ createPreparedContact db user@User {userId} p@Profile {preferences} connLinkToCo
createdAt = currentTs,
updatedAt = currentTs,
chatTs = Just currentTs,
preparedContact = Just $ PreparedContact connLinkToConnect $ connMode m,
preparedContact = Just $ PreparedContact connLinkToConnect (connMode m) welcomeSharedMsgId,
contactRequestId = Nothing,
contactGroupMemberId = Nothing,
contactGrpInvSent = False,
@ -825,7 +826,7 @@ getAcceptedContactByXContactId db vr user@User {userId} xContactId = 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.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.contact_request_id,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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.contact_conn_initiated, c.local_alias,
@ -1011,7 +1012,7 @@ getContact_ db vr user@User {userId} contactId deleted = 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.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.contact_request_id,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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.contact_conn_initiated, c.local_alias,

27
src/Simplex/Chat/Store/Groups.hs
View file

@ -353,8 +353,7 @@ createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = Exc
updatedAt = currentTs,
chatTs = Just currentTs,
userMemberProfileSentAt = Just currentTs,
connLinkToConnect = Nothing,
connLinkStartedConnection = False,
preparedGroup = Nothing,
chatTags = [],
chatItemTTL = Nothing,
uiThemes = Nothing,
@ -426,8 +425,7 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ
updatedAt = currentTs,
chatTs = Just currentTs,
userMemberProfileSentAt = Just currentTs,
connLinkToConnect = Nothing,
connLinkStartedConnection = False,
preparedGroup = Nothing,
chatTags = [],
chatItemTTL = Nothing,
uiThemes = Nothing,
@ -525,10 +523,11 @@ deleteContactCardKeepConn db connId Contact {contactId, profile = LocalProfile {
DB.execute db "DELETE FROM contacts WHERE contact_id = ?" (Only contactId)
DB.execute db "DELETE FROM contact_profiles WHERE contact_profile_id = ?" (Only profileId)
createPreparedGroup :: DB.Connection -> VersionRangeChat -> User -> GroupProfile -> Bool -> CreatedLinkContact -> ExceptT StoreError IO (GroupInfo, GroupMember)
createPreparedGroup db vr user@User {userId, userContactId} groupProfile business connLinkToConnect = do
createPreparedGroup :: DB.Connection -> VersionRangeChat -> User -> GroupProfile -> Bool -> CreatedLinkContact -> Maybe SharedMsgId -> ExceptT StoreError IO (GroupInfo, GroupMember)
createPreparedGroup db vr user@User {userId, userContactId} groupProfile business connLinkToConnect welcomeSharedMsgId = do
currentTs <- liftIO getCurrentTime
(groupId, groupLDN) <- createGroup_ db userId groupProfile (Just connLinkToConnect) Nothing currentTs
let prepared = Just (connLinkToConnect, welcomeSharedMsgId)
(groupId, groupLDN) <- createGroup_ db userId groupProfile prepared Nothing currentTs
hostMemberId <- insertHost_ currentTs groupId groupLDN
let userMember = MemberIdRole (MemberId $ encodeUtf8 groupLDN <> "_user_unknown_id") GRMember
membership <- createContactMemberInv_ db user groupId (Just hostMemberId) user userMember GCUserMember GSMemUnknown IBUnknown Nothing currentTs vr
@ -750,8 +749,8 @@ createGroupViaLink'
)
insertedRowId db
createGroup_ :: DB.Connection -> UserId -> GroupProfile -> Maybe CreatedLinkContact -> Maybe BusinessChatInfo -> UTCTime -> ExceptT StoreError IO (GroupId, Text)
createGroup_ db userId groupProfile connLinkToConnect business currentTs = ExceptT $ do
createGroup_ :: DB.Connection -> UserId -> GroupProfile -> Maybe (CreatedLinkContact, Maybe SharedMsgId) -> Maybe BusinessChatInfo -> UTCTime -> ExceptT StoreError IO (GroupId, Text)
createGroup_ db userId groupProfile prepared business currentTs = ExceptT $ do
let GroupProfile {displayName, fullName, description, image, groupPreferences, memberAdmission} = groupProfile
withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do
liftIO $ do
@ -765,11 +764,11 @@ createGroup_ db userId groupProfile connLinkToConnect business currentTs = Excep
[sql|
INSERT INTO groups
(group_profile_id, local_display_name, user_id, enable_ntfs,
created_at, updated_at, chat_ts, user_member_profile_sent_at, conn_full_link_to_connect, conn_short_link_to_connect,
created_at, updated_at, chat_ts, user_member_profile_sent_at, conn_full_link_to_connect, conn_short_link_to_connect, welcome_shared_msg_id,
business_chat, business_member_id, customer_member_id)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
((profileId, localDisplayName, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. connLinkToConnectRow' connLinkToConnect :. businessChatInfoRow business)
((profileId, localDisplayName, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. toPreparedGroupRow prepared :. businessChatInfoRow business)
groupId <- insertedRowId db
pure (groupId, localDisplayName)
@ -938,7 +937,7 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = do
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection, g.welcome_shared_msg_id,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction,
@ -1818,7 +1817,7 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = do
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection, g.welcome_shared_msg_id,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
-- GroupInfo {membership}

6
src/Simplex/Chat/Store/Messages.hs
View file

@ -527,9 +527,9 @@ createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forw
CDGroupRcv GroupInfo {membership = GroupMember {memberId = userMemberId}} _ _ ->
(Just $ Just userMemberId == memberId, memberId)
createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> ShowGroupAsSender -> CIContent d -> UTCTime -> UTCTime -> IO ChatItemId
createNewChatItemNoMsg db user chatDirection showGroupAsSender ciContent itemTs =
createNewChatItem_ db user chatDirection showGroupAsSender Nothing Nothing ciContent quoteRow Nothing Nothing False False itemTs Nothing
createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> ShowGroupAsSender -> CIContent d -> Maybe SharedMsgId -> UTCTime -> UTCTime -> IO ChatItemId
createNewChatItemNoMsg db user chatDirection showGroupAsSender ciContent sharedMsgId_ itemTs =
createNewChatItem_ db user chatDirection showGroupAsSender Nothing sharedMsgId_ ciContent quoteRow Nothing Nothing False False itemTs Nothing
where
quoteRow :: NewQuoteRow
quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing)

4
src/Simplex/Chat/Store/SQLite/Migrations/M20250526_short_links.hs
View file

@ -10,6 +10,7 @@ m20250526_short_links =
[sql|
ALTER TABLE contacts ADD COLUMN conn_full_link_to_connect BLOB;
ALTER TABLE contacts ADD COLUMN conn_short_link_to_connect BLOB;
ALTER TABLE contacts ADD COLUMN welcome_shared_msg_id BLOB;
ALTER TABLE contacts ADD COLUMN contact_request_id INTEGER REFERENCES contact_requests ON DELETE SET NULL;
CREATE INDEX idx_contacts_contact_request_id ON contacts(contact_request_id);
@ -20,6 +21,7 @@ ALTER TABLE user_contact_links ADD COLUMN address_welcome_message TEXT;
ALTER TABLE groups ADD COLUMN conn_full_link_to_connect BLOB;
ALTER TABLE groups ADD COLUMN conn_short_link_to_connect BLOB;
ALTER TABLE groups ADD COLUMN conn_link_started_connection INTEGER NOT NULL DEFAULT 0;
ALTER TABLE groups ADD COLUMN welcome_shared_msg_id BLOB;
ALTER TABLE chat_items ADD COLUMN show_group_as_sender INTEGER NOT NULL DEFAULT 0;
|]
@ -29,6 +31,7 @@ down_m20250526_short_links =
[sql|
ALTER TABLE contacts DROP COLUMN conn_full_link_to_connect;
ALTER TABLE contacts DROP COLUMN conn_short_link_to_connect;
ALTER TABLE contacts DROP COLUMN welcome_shared_msg_id;
DROP INDEX idx_contacts_contact_request_id;
ALTER TABLE contacts DROP COLUMN contact_request_id;
@ -39,6 +42,7 @@ ALTER TABLE user_contact_links DROP COLUMN address_welcome_message;
ALTER TABLE groups DROP COLUMN conn_full_link_to_connect;
ALTER TABLE groups DROP COLUMN conn_short_link_to_connect;
ALTER TABLE groups DROP COLUMN conn_link_started_connection;
ALTER TABLE groups DROP COLUMN welcome_shared_msg_id;
ALTER TABLE chat_items DROP COLUMN show_group_as_sender;
|]

24
src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt
View file

@ -55,7 +55,7 @@ Query:
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection, g.welcome_shared_msg_id,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
-- GroupInfo {membership}
@ -361,7 +361,7 @@ Plan:
Query:
SELECT
c.contact_profile_id, c.local_display_name, c.via_group, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, c.contact_used, c.contact_status, c.enable_ntfs, c.send_rcpts, c.favorite,
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.conn_full_link_to_connect, c.conn_short_link_to_connect, c.contact_request_id,
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.conn_full_link_to_connect, c.conn_short_link_to_connect, c.welcome_shared_msg_id, c.contact_request_id,
c.contact_group_member_id, c.contact_grp_inv_sent, c.ui_themes, c.chat_deleted, c.custom_data, c.chat_item_ttl
FROM contacts c
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
@ -761,9 +761,9 @@ Plan:
Query:
INSERT INTO groups
(group_profile_id, local_display_name, user_id, enable_ntfs,
created_at, updated_at, chat_ts, user_member_profile_sent_at, conn_full_link_to_connect, conn_short_link_to_connect,
created_at, updated_at, chat_ts, user_member_profile_sent_at, conn_full_link_to_connect, conn_short_link_to_connect, welcome_shared_msg_id,
business_chat, business_member_id, customer_member_id)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
@ -894,7 +894,7 @@ Query:
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.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.contact_request_id,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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.contact_conn_initiated, c.local_alias,
@ -917,7 +917,7 @@ Query:
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.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.contact_request_id,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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.contact_conn_initiated, c.local_alias,
@ -942,7 +942,7 @@ Query:
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection, g.welcome_shared_msg_id,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
-- GroupInfo {membership}
@ -992,7 +992,7 @@ Query:
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection, g.welcome_shared_msg_id,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction,
@ -1501,7 +1501,7 @@ Query:
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.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.contact_request_id,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
-- 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.contact_conn_initiated, c.local_alias,
@ -4715,7 +4715,7 @@ Query:
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection, g.welcome_shared_msg_id,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
-- GroupMember - membership
@ -4741,7 +4741,7 @@ Query:
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection, g.welcome_shared_msg_id,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
-- GroupMember - membership
@ -5655,7 +5655,7 @@ Query: INSERT INTO contacts (contact_profile_id, local_display_name, user_id, is
Plan:
SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?)
Query: INSERT INTO contacts (contact_profile_id, local_display_name, user_id, via_group, created_at, updated_at, chat_ts, contact_used, conn_full_link_to_connect, conn_short_link_to_connect) VALUES (?,?,?,?,?,?,?,?,?,?)
Query: INSERT INTO contacts (contact_profile_id, local_display_name, user_id, via_group, created_at, updated_at, chat_ts, contact_used, conn_full_link_to_connect, conn_short_link_to_connect, welcome_shared_msg_id) VALUES (?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?)

4
src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql
View file

@ -81,6 +81,7 @@ CREATE TABLE contacts(
chat_item_ttl INTEGER,
conn_full_link_to_connect BLOB,
conn_short_link_to_connect BLOB,
welcome_shared_msg_id BLOB,
contact_request_id INTEGER REFERENCES contact_requests ON DELETE SET NULL,
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
@ -141,7 +142,8 @@ CREATE TABLE groups(
members_require_attention INTEGER NOT NULL DEFAULT 0,
conn_full_link_to_connect BLOB,
conn_short_link_to_connect BLOB,
conn_link_started_connection INTEGER NOT NULL DEFAULT 0, -- received
conn_link_started_connection INTEGER NOT NULL DEFAULT 0,
welcome_shared_msg_id BLOB, -- received
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE

65
src/Simplex/Chat/Store/Shared.hs
View file

@ -32,7 +32,6 @@ import qualified Data.Text as T
import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Data.Type.Equality
import Simplex.Chat.Messages
import Simplex.Chat.Protocol
import Simplex.Chat.Remote.Types
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
@ -382,8 +381,8 @@ createContact db User {userId} profile = do
currentTs <- liftIO getCurrentTime
void $ createContact_ db userId profile Nothing "" Nothing currentTs
createContact_ :: DB.Connection -> UserId -> Profile -> Maybe ACreatedConnLink -> LocalAlias -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO (Text, ContactId, ProfileId)
createContact_ db userId Profile {displayName, fullName, image, contactLink, preferences} connLinkToConnect localAlias viaGroup currentTs =
createContact_ :: DB.Connection -> UserId -> Profile -> Maybe (ACreatedConnLink, Maybe SharedMsgId) -> LocalAlias -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO (Text, ContactId, ProfileId)
createContact_ db userId Profile {displayName, fullName, image, contactLink, preferences} prepared localAlias viaGroup currentTs =
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
DB.execute
db
@ -392,25 +391,25 @@ createContact_ db userId Profile {displayName, fullName, image, contactLink, pre
profileId <- insertedRowId db
DB.execute
db
"INSERT INTO contacts (contact_profile_id, local_display_name, user_id, via_group, created_at, updated_at, chat_ts, contact_used, conn_full_link_to_connect, conn_short_link_to_connect) VALUES (?,?,?,?,?,?,?,?,?,?)"
((profileId, ldn, userId, viaGroup, currentTs, currentTs, currentTs, BI True) :. connLinkToConnectRow connLinkToConnect)
"INSERT INTO contacts (contact_profile_id, local_display_name, user_id, via_group, created_at, updated_at, chat_ts, contact_used, conn_full_link_to_connect, conn_short_link_to_connect, welcome_shared_msg_id) VALUES (?,?,?,?,?,?,?,?,?,?,?)"
((profileId, ldn, userId, viaGroup, currentTs, currentTs, currentTs, BI True) :. toPreparedContactRow prepared)
contactId <- insertedRowId db
pure $ Right (ldn, contactId, profileId)
type AConnLinkToConnectRow = (Maybe AConnectionRequestUri, Maybe AConnShortLink)
type NewPreparedContactRow = (Maybe AConnectionRequestUri, Maybe AConnShortLink, Maybe SharedMsgId)
connLinkToConnectRow :: Maybe ACreatedConnLink -> AConnLinkToConnectRow
connLinkToConnectRow = \case
Just (ACCL m (CCLink fullLink shortLink)) -> (Just (ACR m fullLink), ACSL m <$> shortLink)
Nothing -> (Nothing, Nothing)
toPreparedContactRow :: Maybe (ACreatedConnLink, Maybe SharedMsgId) -> NewPreparedContactRow
toPreparedContactRow = \case
Just (ACCL m (CCLink fullLink shortLink), welcomeSharedMsgId) -> (Just (ACR m fullLink), ACSL m <$> shortLink, welcomeSharedMsgId)
Nothing -> (Nothing, Nothing, Nothing)
type ConnLinkToConnectRow m = (Maybe (ConnectionRequestUri m), Maybe (ConnShortLink m))
type NewPreparedGroupRow m = (Maybe (ConnectionRequestUri m), Maybe (ConnShortLink m), Maybe SharedMsgId)
connLinkToConnectRow' :: Maybe (CreatedConnLink m) -> ConnLinkToConnectRow m
connLinkToConnectRow' = \case
Just (CCLink fullLink shortLink) -> (Just fullLink, shortLink)
Nothing -> (Nothing, Nothing)
{-# INLINE connLinkToConnectRow' #-}
toPreparedGroupRow :: Maybe (CreatedConnLink m, Maybe SharedMsgId) -> NewPreparedGroupRow m
toPreparedGroupRow = \case
Just (CCLink fullLink shortLink, welcomeSharedMsgId) -> (Just fullLink, shortLink, welcomeSharedMsgId)
Nothing -> (Nothing, Nothing, Nothing)
{-# INLINE toPreparedGroupRow #-}
deleteUnusedIncognitoProfileById_ :: DB.Connection -> User -> ProfileId -> IO ()
deleteUnusedIncognitoProfileById_ db User {userId} profileId =
@ -430,23 +429,25 @@ deleteUnusedIncognitoProfileById_ db User {userId} profileId =
|]
(userId, profileId, userId, profileId, userId, profileId)
type ContactRow' = (ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnLinkContact, LocalAlias, BoolInt, ContactStatus) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) :. (Maybe AConnectionRequestUri, Maybe AConnShortLink, Maybe Int64, Maybe GroupMemberId, BoolInt, Maybe UIThemeEntityOverrides, BoolInt, Maybe CustomData, Maybe Int64)
type PreparedContactRow = (Maybe AConnectionRequestUri, Maybe AConnShortLink, Maybe SharedMsgId)
type ContactRow' = (ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnLinkContact, LocalAlias, BoolInt, ContactStatus) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) :. PreparedContactRow :. (Maybe Int64, Maybe GroupMemberId, BoolInt, Maybe UIThemeEntityOverrides, BoolInt, Maybe CustomData, Maybe Int64)
type ContactRow = Only ContactId :. ContactRow'
toContact :: VersionRangeChat -> User -> [ChatTagId] -> ContactRow :. MaybeConnectionRow -> Contact
toContact vr user chatTags ((Only contactId :. (profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (connFullLink, connShortLink, contactRequestId, contactGroupMemberId, BI contactGrpInvSent, uiThemes, BI chatDeleted, customData, chatItemTTL)) :. connRow) =
toContact vr user chatTags ((Only contactId :. (profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent, uiThemes, BI chatDeleted, customData, chatItemTTL)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
activeConn = toMaybeConnection vr connRow
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
incognito = maybe False connIncognito activeConn
mergedPreferences = contactUserPreferences user userPreferences preferences incognito
preparedContact = toPreparedContact connFullLink connShortLink
preparedContact = toPreparedContact preparedContactRow
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, preparedContact, contactRequestId, contactGroupMemberId, contactGrpInvSent, chatTags, chatItemTTL, uiThemes, chatDeleted, customData}
toPreparedContact :: Maybe AConnectionRequestUri -> Maybe AConnShortLink -> Maybe PreparedContact
toPreparedContact connFullLink connShortLink =
(\cl@(ACCL m _) -> PreparedContact cl $ connMode m) <$> toACreatedConnLink_ connFullLink connShortLink
toPreparedContact :: PreparedContactRow -> Maybe PreparedContact
toPreparedContact (connFullLink, connShortLink, welcomeSharedMsgId) =
(\cl@(ACCL m _) -> PreparedContact cl (connMode m) welcomeSharedMsgId) <$> toACreatedConnLink_ connFullLink connShortLink
toACreatedConnLink_ :: Maybe AConnectionRequestUri -> Maybe AConnShortLink -> Maybe ACreatedConnLink
toACreatedConnLink_ Nothing _ = Nothing
@ -601,23 +602,29 @@ safeDeleteLDN db User {userId} localDisplayName = do
|]
(userId, localDisplayName, userId)
type PreparedGroupRow = (Maybe ConnReqContact, Maybe ShortLinkContact, BoolInt, Maybe SharedMsgId)
type BusinessChatInfoRow = (Maybe BusinessChatType, Maybe MemberId, Maybe MemberId)
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Text, Maybe Text, Maybe ImageData, Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. (Maybe ConnReqContact, Maybe ShortLinkContact, BoolInt) :. BusinessChatInfoRow :. (Maybe UIThemeEntityOverrides, Maybe CustomData, Maybe Int64, Int) :. GroupMemberRow
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Text, Maybe Text, Maybe ImageData, Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. PreparedGroupRow :. BusinessChatInfoRow :. (Maybe UIThemeEntityOverrides, Maybe CustomData, Maybe Int64, Int) :. GroupMemberRow
type GroupMemberRow = (Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnLinkContact, LocalAlias, Maybe Preferences) :. (UTCTime, UTCTime) :. (Maybe UTCTime, Int64, Int64, Int64, Maybe UTCTime)
toGroupInfo :: VersionRangeChat -> Int64 -> [ChatTagId] -> GroupInfoRow -> GroupInfo
toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, localAlias, description, image, enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. (connFullLink, connShortLink, BI connLinkStartedConnection) :. businessRow :. (uiThemes, customData, chatItemTTL, membersRequireAttention) :. userMemberRow) =
toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, localAlias, description, image, enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (uiThemes, customData, chatItemTTL, membersRequireAttention) :. userMemberRow) =
let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
fullGroupPreferences = mergeGroupPreferences groupPreferences
groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences, memberAdmission}
businessChat = toBusinessChatInfo businessRow
connLinkToConnect = case (connFullLink, connShortLink) of
(Nothing, _) -> Nothing
(Just fullLink, shortLink_) -> Just $ CCLink fullLink shortLink_
in GroupInfo {groupId, localDisplayName, groupProfile, localAlias, businessChat, fullGroupPreferences, membership, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, connLinkToConnect, connLinkStartedConnection, chatTags, chatItemTTL, uiThemes, customData, membersRequireAttention}
preparedGroup = toPreparedGroup preparedGroupRow
in GroupInfo {groupId, localDisplayName, groupProfile, localAlias, businessChat, fullGroupPreferences, membership, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, preparedGroup, chatTags, chatItemTTL, uiThemes, customData, membersRequireAttention}
toPreparedGroup :: PreparedGroupRow -> Maybe PreparedGroup
toPreparedGroup = \case
(Just fullLink, shortLink_, BI connLinkStartedConnection, welcomeSharedMsgId) ->
Just PreparedGroup {connLinkToConnect = CCLink fullLink shortLink_, connLinkStartedConnection, welcomeSharedMsgId}
_ -> Nothing
toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, BI showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences) :. (createdAt, updatedAt) :. (supportChatTs_, supportChatUnread, supportChatMemberAttention, supportChatMentions, supportChatLastMsgFromMemberTs)) =
@ -651,7 +658,7 @@ groupInfoQuery =
g.group_id, g.local_display_name, gp.display_name, gp.full_name, g.local_alias, gp.description, gp.image,
g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, gp.member_admission,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection,
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_started_connection, g.welcome_shared_msg_id,
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention,
-- GroupMember - membership

36
src/Simplex/Chat/Types.hs
View file

@ -203,9 +203,31 @@ data Contact = Contact
contactRequestId' :: Contact -> Maybe Int64
contactRequestId' Contact {contactRequestId} = contactRequestId
data PreparedContact = PreparedContact {connLinkToConnect :: ACreatedConnLink, uiConnLinkType :: ConnectionMode}
data PreparedContact = PreparedContact
{ connLinkToConnect :: ACreatedConnLink,
uiConnLinkType :: ConnectionMode,
welcomeSharedMsgId :: Maybe SharedMsgId
}
deriving (Eq, Show)
newtype SharedMsgId = SharedMsgId ByteString
deriving (Eq, Show)
deriving newtype (FromField)
instance ToField SharedMsgId where toField (SharedMsgId m) = toField $ Binary m
instance StrEncoding SharedMsgId where
strEncode (SharedMsgId m) = strEncode m
strDecode s = SharedMsgId <$> strDecode s
strP = SharedMsgId <$> strP
instance FromJSON SharedMsgId where
parseJSON = strParseJSON "SharedMsgId"
instance ToJSON SharedMsgId where
toJSON = strToJSON
toEncoding = strToJEncoding
newtype CustomData = CustomData J.Object
deriving (Eq, Show)
@ -432,8 +454,7 @@ data GroupInfo = GroupInfo
updatedAt :: UTCTime,
chatTs :: Maybe UTCTime,
userMemberProfileSentAt :: Maybe UTCTime,
connLinkToConnect :: Maybe CreatedLinkContact,
connLinkStartedConnection :: Bool,
preparedGroup :: Maybe PreparedGroup,
chatTags :: [ChatTagId],
chatItemTTL :: Maybe Int64,
uiThemes :: Maybe UIThemeEntityOverrides,
@ -460,6 +481,13 @@ instance FromField BusinessChatType where fromField = fromTextField_ textDecode
instance ToField BusinessChatType where toField = toField . textEncode
data PreparedGroup = PreparedGroup
{ connLinkToConnect :: CreatedLinkContact,
connLinkStartedConnection :: Bool,
welcomeSharedMsgId :: Maybe SharedMsgId -- it is stored only for business chats, and only if welcome message is specified
}
deriving (Eq, Show)
groupName' :: GroupInfo -> GroupName
groupName' GroupInfo {localDisplayName = g} = g
@ -1938,6 +1966,8 @@ $(JQ.deriveJSON (enumJSON $ dropPrefix "BC") ''BusinessChatType)
$(JQ.deriveJSON defaultJSON ''BusinessChatInfo)
$(JQ.deriveJSON defaultJSON ''PreparedGroup)
$(JQ.deriveJSON defaultJSON ''GroupInfo)
$(JQ.deriveJSON defaultJSON ''Group)

3
tests/MessageBatching.hs
View file

@ -17,7 +17,8 @@ import Data.Text.Encoding (encodeUtf8)
import Simplex.Chat.Messages.Batch
import Simplex.Chat.Controller (ChatError (..), ChatErrorType (..))
import Simplex.Chat.Messages (SndMessage (..))
import Simplex.Chat.Protocol (SharedMsgId (..), maxEncodedMsgLength)
import Simplex.Chat.Protocol (maxEncodedMsgLength)
import Simplex.Chat.Types (SharedMsgId (..))
import Test.Hspec
batchingTests :: Spec