Merge branch 'master' into master-ghc8107
This commit is contained in:
Evgeny Poberezkin
commit
74d186af16
33
.github/workflows/build.yml
vendored
33
.github/workflows/build.yml
vendored
@ -293,4 +293,37 @@ jobs:
|
||||
body: |
|
||||
${{ steps.windows_build.outputs.bin_hash }}
|
||||
|
||||
- name: Windows build desktop
|
||||
id: windows_desktop_build
|
||||
if: startsWith(github.ref, 'refs/tags/v') && matrix.os == 'windows-latest'
|
||||
env:
|
||||
SIMPLEX_CI_REPO_URL: ${{ secrets.SIMPLEX_CI_REPO_URL }}
|
||||
shell: bash
|
||||
run: |
|
||||
scripts/desktop/build-lib-windows.sh
|
||||
cd apps/multiplatform
|
||||
./gradlew packageMsi
|
||||
path=$(echo $PWD/release/main/msi/*imple*.msi | sed 's#/\([a-z]\)#\1:#' | sed 's#/#\\#g')
|
||||
echo "package_path=$path" >> $GITHUB_OUTPUT
|
||||
echo "package_hash=$(echo SHA2-512\(${{ matrix.desktop_asset_name }}\)= $(openssl sha512 $path | cut -d' ' -f 2))" >> $GITHUB_OUTPUT
|
||||
|
||||
- name: Windows upload desktop package to release
|
||||
if: startsWith(github.ref, 'refs/tags/v') && matrix.os == 'windows-latest'
|
||||
uses: svenstaro/upload-release-action@v2
|
||||
with:
|
||||
repo_token: ${{ secrets.GITHUB_TOKEN }}
|
||||
file: ${{ steps.windows_desktop_build.outputs.package_path }}
|
||||
asset_name: ${{ matrix.desktop_asset_name }}
|
||||
tag: ${{ github.ref }}
|
||||
|
||||
- name: Windows update desktop package hash
|
||||
if: startsWith(github.ref, 'refs/tags/v') && matrix.os == 'windows-latest'
|
||||
uses: softprops/action-gh-release@v1
|
||||
env:
|
||||
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
|
||||
with:
|
||||
append_body: true
|
||||
body: |
|
||||
${{ steps.windows_desktop_build.outputs.package_hash }}
|
||||
|
||||
# Windows /
|
||||
|
||||
@ -114,11 +114,11 @@
|
||||
5CC1C99527A6CF7F000D9FF6 /* ShareSheet.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CC1C99427A6CF7F000D9FF6 /* ShareSheet.swift */; };
|
||||
5CC2C0FC2809BF11000C35E3 /* Localizable.strings in Resources */ = {isa = PBXBuildFile; fileRef = 5CC2C0FA2809BF11000C35E3 /* Localizable.strings */; };
|
||||
5CC2C0FF2809BF11000C35E3 /* SimpleX--iOS--InfoPlist.strings in Resources */ = {isa = PBXBuildFile; fileRef = 5CC2C0FD2809BF11000C35E3 /* SimpleX--iOS--InfoPlist.strings */; };
|
||||
5CC7398D2AC9D168009470A9 /* libHSsimplex-chat-5.4.0.0-EcKpK3v0NXRK7pgDye4kqp-ghc8.10.7.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC739882AC9D168009470A9 /* libHSsimplex-chat-5.4.0.0-EcKpK3v0NXRK7pgDye4kqp-ghc8.10.7.a */; };
|
||||
5CC7398E2AC9D168009470A9 /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC739892AC9D168009470A9 /* libgmp.a */; };
|
||||
5CC7398F2AC9D168009470A9 /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC7398A2AC9D168009470A9 /* libffi.a */; };
|
||||
5CC739902AC9D168009470A9 /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC7398B2AC9D168009470A9 /* libgmpxx.a */; };
|
||||
5CC739912AC9D168009470A9 /* libHSsimplex-chat-5.4.0.0-EcKpK3v0NXRK7pgDye4kqp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC7398C2AC9D168009470A9 /* libHSsimplex-chat-5.4.0.0-EcKpK3v0NXRK7pgDye4kqp.a */; };
|
||||
5CC739972AD44E2E009470A9 /* libgmp.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC739922AD44E2E009470A9 /* libgmp.a */; };
|
||||
5CC739982AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F-ghc8.10.7.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC739932AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F-ghc8.10.7.a */; };
|
||||
5CC739992AD44E2E009470A9 /* libffi.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC739942AD44E2E009470A9 /* libffi.a */; };
|
||||
5CC7399A2AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC739952AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F.a */; };
|
||||
5CC7399B2AD44E2E009470A9 /* libgmpxx.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 5CC739962AD44E2E009470A9 /* libgmpxx.a */; };
|
||||
5CC868F329EB540C0017BBFD /* CIRcvDecryptionError.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CC868F229EB540C0017BBFD /* CIRcvDecryptionError.swift */; };
|
||||
5CCB939C297EFCB100399E78 /* NavStackCompat.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CCB939B297EFCB100399E78 /* NavStackCompat.swift */; };
|
||||
5CCD403427A5F6DF00368C90 /* AddContactView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CCD403327A5F6DF00368C90 /* AddContactView.swift */; };
|
||||
@ -395,11 +395,11 @@
|
||||
5CC1C99427A6CF7F000D9FF6 /* ShareSheet.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ShareSheet.swift; sourceTree = "<group>"; };
|
||||
5CC2C0FB2809BF11000C35E3 /* ru */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = ru; path = ru.lproj/Localizable.strings; sourceTree = "<group>"; };
|
||||
5CC2C0FE2809BF11000C35E3 /* ru */ = {isa = PBXFileReference; lastKnownFileType = text.plist.strings; name = ru; path = "ru.lproj/SimpleX--iOS--InfoPlist.strings"; sourceTree = "<group>"; };
|
||||
5CC739882AC9D168009470A9 /* libHSsimplex-chat-5.4.0.0-EcKpK3v0NXRK7pgDye4kqp-ghc8.10.7.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.0-EcKpK3v0NXRK7pgDye4kqp-ghc8.10.7.a"; sourceTree = "<group>"; };
|
||||
5CC739892AC9D168009470A9 /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = "<group>"; };
|
||||
5CC7398A2AC9D168009470A9 /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = "<group>"; };
|
||||
5CC7398B2AC9D168009470A9 /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = "<group>"; };
|
||||
5CC7398C2AC9D168009470A9 /* libHSsimplex-chat-5.4.0.0-EcKpK3v0NXRK7pgDye4kqp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.0-EcKpK3v0NXRK7pgDye4kqp.a"; sourceTree = "<group>"; };
|
||||
5CC739922AD44E2E009470A9 /* libgmp.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmp.a; sourceTree = "<group>"; };
|
||||
5CC739932AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F-ghc8.10.7.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F-ghc8.10.7.a"; sourceTree = "<group>"; };
|
||||
5CC739942AD44E2E009470A9 /* libffi.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libffi.a; sourceTree = "<group>"; };
|
||||
5CC739952AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = "libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F.a"; sourceTree = "<group>"; };
|
||||
5CC739962AD44E2E009470A9 /* libgmpxx.a */ = {isa = PBXFileReference; lastKnownFileType = archive.ar; path = libgmpxx.a; sourceTree = "<group>"; };
|
||||
5CC868F229EB540C0017BBFD /* CIRcvDecryptionError.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = CIRcvDecryptionError.swift; sourceTree = "<group>"; };
|
||||
5CCB939B297EFCB100399E78 /* NavStackCompat.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = NavStackCompat.swift; sourceTree = "<group>"; };
|
||||
5CCD403327A5F6DF00368C90 /* AddContactView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = AddContactView.swift; sourceTree = "<group>"; };
|
||||
@ -507,13 +507,13 @@
|
||||
isa = PBXFrameworksBuildPhase;
|
||||
buildActionMask = 2147483647;
|
||||
files = (
|
||||
5CC739902AC9D168009470A9 /* libgmpxx.a in Frameworks */,
|
||||
5CC739982AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F-ghc8.10.7.a in Frameworks */,
|
||||
5CE2BA93284534B000EC33A6 /* libiconv.tbd in Frameworks */,
|
||||
5CC7398D2AC9D168009470A9 /* libHSsimplex-chat-5.4.0.0-EcKpK3v0NXRK7pgDye4kqp-ghc8.10.7.a in Frameworks */,
|
||||
5CC7398E2AC9D168009470A9 /* libgmp.a in Frameworks */,
|
||||
5CC739912AC9D168009470A9 /* libHSsimplex-chat-5.4.0.0-EcKpK3v0NXRK7pgDye4kqp.a in Frameworks */,
|
||||
5CC7398F2AC9D168009470A9 /* libffi.a in Frameworks */,
|
||||
5CC739972AD44E2E009470A9 /* libgmp.a in Frameworks */,
|
||||
5CC7399A2AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F.a in Frameworks */,
|
||||
5CC739992AD44E2E009470A9 /* libffi.a in Frameworks */,
|
||||
5CE2BA94284534BB00EC33A6 /* libz.tbd in Frameworks */,
|
||||
5CC7399B2AD44E2E009470A9 /* libgmpxx.a in Frameworks */,
|
||||
);
|
||||
runOnlyForDeploymentPostprocessing = 0;
|
||||
};
|
||||
@ -574,11 +574,11 @@
|
||||
5C764E5C279C70B7000C6508 /* Libraries */ = {
|
||||
isa = PBXGroup;
|
||||
children = (
|
||||
5CC7398A2AC9D168009470A9 /* libffi.a */,
|
||||
5CC739892AC9D168009470A9 /* libgmp.a */,
|
||||
5CC7398B2AC9D168009470A9 /* libgmpxx.a */,
|
||||
5CC739882AC9D168009470A9 /* libHSsimplex-chat-5.4.0.0-EcKpK3v0NXRK7pgDye4kqp-ghc8.10.7.a */,
|
||||
5CC7398C2AC9D168009470A9 /* libHSsimplex-chat-5.4.0.0-EcKpK3v0NXRK7pgDye4kqp.a */,
|
||||
5CC739942AD44E2E009470A9 /* libffi.a */,
|
||||
5CC739922AD44E2E009470A9 /* libgmp.a */,
|
||||
5CC739962AD44E2E009470A9 /* libgmpxx.a */,
|
||||
5CC739932AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F-ghc8.10.7.a */,
|
||||
5CC739952AD44E2E009470A9 /* libHSsimplex-chat-5.4.0.0-JjDpmMNHLrsHjXbdowMF4F.a */,
|
||||
);
|
||||
path = Libraries;
|
||||
sourceTree = "<group>";
|
||||
|
||||
@ -132,8 +132,11 @@ public func chatResponse(_ s: String) -> ChatResponse {
|
||||
var type: String?
|
||||
var json: String?
|
||||
if let j = try? JSONSerialization.jsonObject(with: d) as? NSDictionary {
|
||||
if let jResp = j["resp"] as? NSDictionary, jResp.count == 1 {
|
||||
if let jResp = j["resp"] as? NSDictionary, jResp.count == 1 || jResp.count == 2 {
|
||||
type = jResp.allKeys[0] as? String
|
||||
if jResp.count == 2 && type == "_owsf" {
|
||||
type = jResp.allKeys[1] as? String
|
||||
}
|
||||
if type == "apiChats" {
|
||||
if let jApiChats = jResp["apiChats"] as? NSDictionary,
|
||||
let user: UserRef = try? decodeObject(jApiChats["user"] as Any),
|
||||
|
||||
99
docs/rfcs/2023-09-29-merge-scenarios.md
Normal file
99
docs/rfcs/2023-09-29-merge-scenarios.md
Normal file
@ -0,0 +1,99 @@
|
||||
# Merge scenarios
|
||||
|
||||
## Problem
|
||||
|
||||
Chat client allows multiple contact and group members records referring to the same "identity" be disassociated from one another. In some cases initially there is knowledge about the fact, and in some other cases it could be established via probe mechanism.
|
||||
|
||||
There are cases already addressing this problem:
|
||||
- Contact merge or contact and group member merge (depending on creation of direct connection between members) when new member joins group, via probe mechanism.
|
||||
- Contact merge when connecting via group link.
|
||||
- Contact and group member association when sending direct message to a new contact.
|
||||
- Existing / deleted contact being preserved when receiving invitation direct message (XGrpDirectInv) from a group member.
|
||||
- Repeat contact requests to the already connected contact being prohibited; repeat contact requests being squashed on the receiving side (XContactId mechanism).
|
||||
|
||||
Cases ignoring this problem:
|
||||
- Duplicate contacts on repeat connections via invitation links.
|
||||
- Duplicate contacts on repeat connection via contact request, when the existing contact was not created via a contact request to the same address (it could be created via any other means - via invitation link, via request to an old address, via group member).
|
||||
- Contact and group member records (possibly for many groups) not being merged when contact connects and group member records already exist.
|
||||
- Group member records in different groups not being merged if contact doesn't exist.
|
||||
- Duplicate contacts, or contact and group member records not being merged when connecting via contact address present in contact/group member profile.
|
||||
|
||||
This problem is a direct consequence of lack of user identity in the platform, and in some cases we even consider it a feature. For example, duplicate contacts via repeat connections can be used for having conversation scopes. Though in general it seems to bring more confusion. It also limits some interactions, such as sending direct message to group members, or viewing a list of groups contact is member of (not implemented).
|
||||
|
||||
On the other hand, solving all these cases reduces the privacy of the main profile, since the client cooperates with other probing clients blindly. To keep this property, we can add an opt-out "Merge contacts" client setting which would affect existing and new probe mechanisms. (It would act as an Incognito mode currently does - launch probes w/t launching probe hashes, and never confirm received probes) We can also ignore it, since this can be worked around via Incognito profiles or multiple user profiles.
|
||||
|
||||
There is one more problem that could be addressed in the same scope - repeat group join via group link fails if the contact with host wasn't deleted. This happens due to group links re-using contact address machinery together with prohibiting repeat connections. This could be treated in a similar way to how it is treated for contact addresses: instead of simply prohibiting repeat connection, if group exists, it would be opened; if group doesn't exist, client would send host a request to re-invite them.
|
||||
|
||||
## Solution
|
||||
|
||||
### Duplicate contacts on repeat connections via invitation links
|
||||
|
||||
Can be solved by probing contacts.
|
||||
|
||||
Check connection with oneself and ask for confirmation.
|
||||
|
||||
### Duplicate contacts on repeat connection via contact request
|
||||
|
||||
Can be solved by probing contacts.
|
||||
|
||||
Special case - records can be directly associated w/t probing when address is known in a contact / group member profile, see below.
|
||||
|
||||
### Contact and group member records not merged when contact connects and group member records already exist
|
||||
|
||||
Can be solved by probing group members.
|
||||
|
||||
Send probe hashes to all viable group members? Or should group member records already have been merged between each other? (see below)
|
||||
|
||||
In all cases above - who should initiate probing? It doesn't matter much, but possibly the contact that started connection.
|
||||
|
||||
### Group member records in different groups not being merged if contact doesn't exist
|
||||
|
||||
Currently multiple group members share the same "identity" by being associated to the same contact. However, it is allowed to have a group member record not associated contact. It can happen if group member's associated contact is deleted, or, with the latest changes that enable skipping creation of direct connections between group members, it could never exist in the first place.
|
||||
|
||||
Can be solved by probing group members, merge could be done in one of the following ways:
|
||||
- Have surrogate contact records always associated to group member records, not available for use as regular contacts and using group member connections for probing.
|
||||
- Merge on the level of contact profiles.
|
||||
|
||||
The latter seems more straightforward.
|
||||
|
||||
Some more factors to consider:
|
||||
- Group member record may have both associated contact to probe via, and matching group member records in other groups.
|
||||
- Matching group member records in other groups may have associated contact records, which in turn may have associated contact records different from contact record associated to group member in question.
|
||||
- Client to which probes are sent may have contact record deleted, but have group member connection - in this case merge would be possible only if probe is sent to group member.
|
||||
- Member connections shouldn't be merged, because generally they're established via hosts, and hosts of different groups may have had different level of trust.
|
||||
|
||||
Probably the solution is to:
|
||||
- send probe to associated contact if it exists (implemented currently)
|
||||
- if associated contact doesn't exist send probe to group member (not implemented?)
|
||||
- send probe hashes to all matching contacts (implemented)
|
||||
- send probe hashes to all matching group members in other groups that don't have associated contact records (not implemented)
|
||||
- merge all contacts that confirmed (currently only the first confirming contact is merged)
|
||||
- merge all group members that confirmed (not implemented, merge profiles?)
|
||||
|
||||
Check: if both group member and associated confirm probe, will they be properly merged?
|
||||
|
||||
### Connecting via profile address
|
||||
|
||||
Having contact address in profile is not proof that it belongs that user (malicious client can put arbitrary address in profile), so it shouldn't be used to directly associate contact or group member records.
|
||||
|
||||
When connecting via contact address, having it associated with a contact record can be used as a sufficient condition to send probe hash, even if profile doesn't match. (index on contact_profiles.contact_link, lookup contact by contact_profile_id)
|
||||
|
||||
To consider:
|
||||
|
||||
Currently group member address is shown even if direct messages are prohibited in group. There're two reasons this preference is usually enabled in a group:
|
||||
- to prevent abuse (in public groups),
|
||||
- to prevent members from direct communication.
|
||||
|
||||
Member address being shown regardless of this preference undermines the second use case.
|
||||
|
||||
### Repeat group join via group link
|
||||
|
||||
**If group still exists:**
|
||||
|
||||
Open group.
|
||||
|
||||
How to check for group existence? Currently we save group_link_id on host contact's connection. It may have been deleted by the time of repeated connection via group link. Probably we should also save group_link_id or even the full contact address on the group record itself.
|
||||
|
||||
**If group doesn't exist:**
|
||||
|
||||
For group links allow repeat contact request even if host contact exists (unlike for regular contact requests).
|
||||
92
docs/rfcs/2023-10-05-contact-merge-improvement.md
Normal file
92
docs/rfcs/2023-10-05-contact-merge-improvement.md
Normal file
@ -0,0 +1,92 @@
|
||||
# Contact merge issues, eradication, improvement
|
||||
|
||||
## Problem
|
||||
|
||||
Contact merge (see mergeContactRecords) keeps connections of both contacts by assigning both connections to the merged contact.
|
||||
|
||||
When contact is read, last ready connection is selected as contact's active connection (see, for example, getContact - connections are ordered by connection_id in descending order). This may lead to contacts reading different connections, and as a result message delivery failing. Consider following scenarios:
|
||||
- connection IDs may be in different order for each side, if one of sides inserted connection in gap of IDs after an older (different) connection was deleted. If contacts consider different connections as active for each other, they would subscribe to and send to different connections, completely destabilizing delivery.
|
||||
- XInfoProbeOk may never be delivered due to server error or processed due to client error. In this case probe sender has 2 separate contacts and user may still use old contact for sending; other side now has a single merged contact record with the latest connection as active - if they restart or resubscribe they would stop receiving messages from the old connection. Perhaps it's less of an issue because that second side would at least send to a new connection which first side (probe sender) considers active for a separate contact, and would receive messages to that new contact. Also if they're establishing a second contact-pair, they may be more likely to use this new contact-pair anyway.
|
||||
|
||||
## Solution ideas
|
||||
|
||||
### Don't merge contacts
|
||||
|
||||
Still merge members and contacts.
|
||||
|
||||
Pros:
|
||||
- no risk of destabilizing existing conversation.
|
||||
- eventually (paired with a migration for legacy merged contacts) contact reading queries may be simplified to read a single connection, as well several chat logic flows accounting for multiple contact connections.
|
||||
- direct connection not being replaced with a new connection established via group (in case of "send direct message" feature, or pre 5.3 in case of direct connections established in group).
|
||||
- connection verification status not being reset (same + duplicate direct connections).
|
||||
- feature of having separate parallel conversations with same contact is kept.
|
||||
- easy to implement:
|
||||
- in probeMatchingContactsAndMembers only match members (getMatchingMembers), don't match contacts (remove getMatchingContacts).
|
||||
- in probeMatch prohibit merging contacts (cgm1 is COMContact, cgm2 is COMContact case; also member with associated contact case).
|
||||
- in xInfoProbeOk - same.
|
||||
|
||||
Cons:
|
||||
- "split identity" of contacts - though in many cases it's status quo without latest change (https://github.com/simplex-chat/simplex-chat/pull/3173). It may be not a big enough issue to justify risking connection stability.
|
||||
- members may be matched to arbitrary contacts - need to consider consequences more thoroughly. Though at least they should match to same contact-pair on both sides. "Send direct message" member contacts will not be matched to existing contacts, though going forward with contact-member merge working it shouldn't be an issue until contact is deleted on one of sides.
|
||||
- group link host not being merged - member knowing host as a contact would have him as a separate contact now. Perhaps we could rework group link protocol to avoid contact creation - new connection would already be created for host-invitee group connection, with some new connection entity "pending group member" created on both sides (starting with next protocol version support on both sides). This member would then be merged to the existing contact. This would be the most expensive part of this change, if we choose not to ignore it.
|
||||
|
||||
### Improve contact merge protocol
|
||||
|
||||
- instead of relying on ordering when selecting active contact connection, add flag active_contact_conn, set it on mergeContactRecords:
|
||||
|
||||
~~verified connection >~~ direct connection > newer connection
|
||||
|
||||
we can't set to verified connection because it's not necessarily symmetric
|
||||
|
||||
~~direct connection >~~ newer connection
|
||||
|
||||
for backwards compatibility we can't set to direct - other side may still set to newer. Unless we bump protocol version and choose based on that.
|
||||
|
||||
choose "newer" connection based on created_at instead of connection_id - it should be more likely to have the same order.
|
||||
|
||||
- initial probe sender to send new message XInfoProbeComplete after processing XInfoProbeOk to signal that old connection is good to delete.
|
||||
|
||||
- probe receiver to keep subscribing to both connections until they receive XInfoProbeComplete.
|
||||
|
||||
- negotiate connection to use - shared connection id?
|
||||
|
||||
```
|
||||
Alice Bob
|
||||
2 contacts | | 2 contacts
|
||||
2 connections | | 2 connections
|
||||
| XInfoProbe |
|
||||
|------------------------>|
|
||||
| XInfoProbeCheck |
|
||||
|------------------------>|
|
||||
| | match probe and hash;
|
||||
| | merge contacts
|
||||
| | 1 contact
|
||||
| | 2 connections
|
||||
| | (1 active, subscribe to both)
|
||||
| XInfoProbeOk |
|
||||
|<------------------------|
|
||||
merge contacts | |
|
||||
1 contact | |
|
||||
1 connection | |
|
||||
(delete non active) | |
|
||||
| XInfoProbeComplete |
|
||||
|------------------------>|
|
||||
| | 1 contact
|
||||
| | 1 connection
|
||||
| | (delete non active)
|
||||
* *
|
||||
```
|
||||
|
||||
Pros:
|
||||
- contact merge is already implemented.
|
||||
- maintains contact "identity".
|
||||
- members are matched to a single contact.
|
||||
- no need to rework group links.
|
||||
|
||||
Cons:
|
||||
- more complex logic - more prone to error.
|
||||
- likely still risks destabilizing connection.
|
||||
- continue to maintain and add new chat logic flows accounting for multiple connections (for instance, subscription).
|
||||
- newer connection replace verified and/or direct connections. These new connections are still possible to establish via indirect and unverified group connection ("send direct message").
|
||||
- removes "parallel conversations" feature. It's not a hard loss though.
|
||||
- existing contacts with aliases still not to be merged - to be implemented. Not a con, but a special case for contact merge.
|
||||
@ -1,5 +1,5 @@
|
||||
name: simplex-chat
|
||||
version: 5.4.0.0
|
||||
version: 5.4.0.1
|
||||
#synopsis:
|
||||
#description:
|
||||
homepage: https://github.com/simplex-chat/simplex-chat#readme
|
||||
|
||||
@ -5,7 +5,7 @@ cabal-version: 1.12
|
||||
-- see: https://github.com/sol/hpack
|
||||
|
||||
name: simplex-chat
|
||||
version: 5.4.0.0
|
||||
version: 5.4.0.1
|
||||
category: Web, System, Services, Cryptography
|
||||
homepage: https://github.com/simplex-chat/simplex-chat#readme
|
||||
author: simplex.chat
|
||||
@ -114,6 +114,7 @@ library
|
||||
Simplex.Chat.Migrations.M20230913_member_contacts
|
||||
Simplex.Chat.Migrations.M20230914_member_probes
|
||||
Simplex.Chat.Migrations.M20230926_contact_status
|
||||
Simplex.Chat.Migrations.M20231002_conn_initiated
|
||||
Simplex.Chat.Mobile
|
||||
Simplex.Chat.Mobile.File
|
||||
Simplex.Chat.Mobile.Shared
|
||||
|
||||
@ -208,7 +208,8 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
|
||||
showLiveItems <- newTVarIO False
|
||||
userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg
|
||||
tempDirectory <- newTVarIO tempDir
|
||||
pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, subscriptionMode, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems, userXFTPFileConfig, tempDirectory, logFilePath = logFile}
|
||||
contactMergeEnabled <- newTVarIO True
|
||||
pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, subscriptionMode, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems, userXFTPFileConfig, tempDirectory, logFilePath = logFile, contactMergeEnabled}
|
||||
where
|
||||
configServers :: DefaultAgentServers
|
||||
configServers =
|
||||
@ -485,6 +486,9 @@ processChatCommand = \case
|
||||
APISetXFTPConfig cfg -> do
|
||||
asks userXFTPFileConfig >>= atomically . (`writeTVar` cfg)
|
||||
ok_
|
||||
SetContactMergeEnabled onOff -> do
|
||||
asks contactMergeEnabled >>= atomically . (`writeTVar` onOff)
|
||||
ok_
|
||||
APIExportArchive cfg -> checkChatStopped $ exportArchive cfg >> ok_
|
||||
ExportArchive -> do
|
||||
ts <- liftIO getCurrentTime
|
||||
@ -2659,6 +2663,7 @@ cleanupManager = do
|
||||
forM_ us $ cleanupUser interval stepDelay
|
||||
forM_ us' $ cleanupUser interval stepDelay
|
||||
cleanupMessages `catchChatError` (toView . CRChatError Nothing)
|
||||
cleanupProbes `catchChatError` (toView . CRChatError Nothing)
|
||||
liftIO $ threadDelay' $ diffToMicroseconds interval
|
||||
where
|
||||
runWithoutInitialDelay cleanupInterval = flip catchChatError (toView . CRChatError Nothing) $ do
|
||||
@ -2686,6 +2691,10 @@ cleanupManager = do
|
||||
ts <- liftIO getCurrentTime
|
||||
let cutoffTs = addUTCTime (- (30 * nominalDay)) ts
|
||||
withStoreCtx' (Just "cleanupManager, deleteOldMessages") (`deleteOldMessages` cutoffTs)
|
||||
cleanupProbes = do
|
||||
ts <- liftIO getCurrentTime
|
||||
let cutoffTs = addUTCTime (- (14 * nominalDay)) ts
|
||||
withStore' (`deleteOldProbes` cutoffTs)
|
||||
|
||||
startProximateTimedItemThread :: ChatMonad m => User -> (ChatRef, ChatItemId) -> UTCTime -> m ()
|
||||
startProximateTimedItemThread user itemRef deleteAt = do
|
||||
@ -2968,7 +2977,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
_ -> Nothing
|
||||
|
||||
processDirectMessage :: ACommand 'Agent e -> ConnectionEntity -> Connection -> Maybe Contact -> m ()
|
||||
processDirectMessage agentMsg connEntity conn@Connection {connId, peerChatVRange, viaUserContactLink, groupLinkId, customUserProfileId, connectionCode} = \case
|
||||
processDirectMessage agentMsg connEntity conn@Connection {connId, peerChatVRange, viaUserContactLink, customUserProfileId, connectionCode} = \case
|
||||
Nothing -> case agentMsg of
|
||||
CONF confId _ connInfo -> do
|
||||
-- [incognito] send saved profile
|
||||
@ -3032,9 +3041,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
XInfo p -> xInfo ct' p
|
||||
XDirectDel -> xDirectDel ct' msg msgMeta
|
||||
XGrpInv gInv -> processGroupInvitation ct' gInv msg msgMeta
|
||||
XInfoProbe probe -> xInfoProbe (CGMContact ct') probe
|
||||
XInfoProbeCheck probeHash -> xInfoProbeCheck ct' probeHash
|
||||
XInfoProbeOk probe -> xInfoProbeOk ct' probe
|
||||
XInfoProbe probe -> xInfoProbe (COMContact ct') probe
|
||||
XInfoProbeCheck probeHash -> xInfoProbeCheck (COMContact ct') probeHash
|
||||
XInfoProbeOk probe -> xInfoProbeOk (COMContact ct') probe
|
||||
XCallInv callId invitation -> xCallInv ct' callId invitation msg msgMeta
|
||||
XCallOffer callId offer -> xCallOffer ct' callId offer msg msgMeta
|
||||
XCallAnswer callId answer -> xCallAnswer ct' callId answer msg msgMeta
|
||||
@ -3087,7 +3096,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
whenUserNtfs user $ do
|
||||
setActive $ ActiveC c
|
||||
showToast (c <> "> ") "connected"
|
||||
forM_ groupLinkId $ \_ -> probeMatchingContacts ct $ contactConnIncognito ct
|
||||
when (contactConnInitiated conn) $ do
|
||||
let Connection {groupLinkId} = conn
|
||||
doProbeContacts = isJust groupLinkId
|
||||
probeMatchingContactsAndMembers ct (contactConnIncognito ct) doProbeContacts
|
||||
withStore' $ \db -> resetContactConnInitiated db user conn
|
||||
forM_ viaUserContactLink $ \userContactLinkId ->
|
||||
withStore' (\db -> getUserContactLinkById db userId userContactLinkId) >>= \case
|
||||
Just (UserContactLink {autoAccept = Just AutoAccept {autoReply = mc_}}, groupId_, gLinkMemRole) -> do
|
||||
@ -3105,7 +3118,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
when (maybe False ((== ConnReady) . connStatus) activeConn) $ do
|
||||
notifyMemberConnected gInfo m $ Just ct
|
||||
let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo
|
||||
when (memberCategory m == GCPreMember) $ probeMatchingContacts ct connectedIncognito
|
||||
when (memberCategory m == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito True
|
||||
SENT msgId -> do
|
||||
sentMsgDeliveryEvent conn msgId
|
||||
checkSndInlineFTComplete conn msgId
|
||||
@ -3123,8 +3136,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
withStore' $ \db -> setConnectionVerified db user connId Nothing
|
||||
let ct' = ct {activeConn = conn {connectionCode = Nothing}} :: Contact
|
||||
ratchetSyncEventItem ct'
|
||||
toView $ CRContactVerificationReset user ct'
|
||||
createInternalChatItem user (CDDirectRcv ct') (CIRcvConnEvent RCEVerificationCodeReset) Nothing
|
||||
securityCodeChanged ct'
|
||||
_ -> ratchetSyncEventItem ct
|
||||
where
|
||||
processErr cryptoErr = do
|
||||
@ -3273,12 +3285,12 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
Nothing -> do
|
||||
notifyMemberConnected gInfo m Nothing
|
||||
let connectedIncognito = memberIncognito membership
|
||||
when (memberCategory m == GCPreMember) $ probeMatchingMemberContact gInfo m connectedIncognito
|
||||
when (memberCategory m == GCPreMember) $ probeMatchingMemberContact m connectedIncognito
|
||||
Just ct@Contact {activeConn = Connection {connStatus}} ->
|
||||
when (connStatus == ConnReady) $ do
|
||||
notifyMemberConnected gInfo m $ Just ct
|
||||
let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo
|
||||
when (memberCategory m == GCPreMember) $ probeMatchingContacts ct connectedIncognito
|
||||
when (memberCategory m == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito True
|
||||
MSG msgMeta _msgFlags msgBody -> do
|
||||
cmdId <- createAckCmd conn
|
||||
withAckMessage agentConnId cmdId msgMeta $ do
|
||||
@ -3306,9 +3318,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
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
|
||||
XInfoProbe probe -> xInfoProbe (CGMGroupMember gInfo m') probe
|
||||
-- XInfoProbeCheck -- TODO merge members?
|
||||
-- XInfoProbeOk -- TODO merge members?
|
||||
XInfoProbe probe -> xInfoProbe (COMGroupMember m') probe
|
||||
XInfoProbeCheck probeHash -> xInfoProbeCheck (COMGroupMember m') probeHash
|
||||
XInfoProbeOk probe -> xInfoProbeOk (COMGroupMember m') probe
|
||||
BFileChunk sharedMsgId chunk -> bFileChunkGroup gInfo sharedMsgId chunk msgMeta
|
||||
_ -> messageError $ "unsupported message: " <> T.pack (show event)
|
||||
currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo
|
||||
@ -3670,45 +3682,58 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
setActive $ ActiveG g
|
||||
showToast ("#" <> g) $ "member " <> c <> " is connected"
|
||||
|
||||
probeMatchingContacts :: Contact -> IncognitoEnabled -> m ()
|
||||
probeMatchingContacts ct connectedIncognito = do
|
||||
probeMatchingContactsAndMembers :: Contact -> IncognitoEnabled -> Bool -> m ()
|
||||
probeMatchingContactsAndMembers ct connectedIncognito doProbeContacts = do
|
||||
gVar <- asks idsDrg
|
||||
if connectedIncognito
|
||||
then sendProbe . Probe =<< liftIO (encodedRandomBytes gVar 32)
|
||||
else do
|
||||
(probe, probeId) <- withStore $ \db -> createSentProbe db gVar userId (CGMContact ct)
|
||||
contactMerge <- readTVarIO =<< asks contactMergeEnabled
|
||||
if contactMerge && not connectedIncognito
|
||||
then do
|
||||
(probe, probeId) <- withStore $ \db -> createSentProbe db gVar userId (COMContact ct)
|
||||
-- ! when making changes to probe-and-merge mechanism,
|
||||
-- ! test scenario in which recipient receives probe after probe hashes (not covered in tests):
|
||||
-- sendProbe -> sendProbeHashes (currently)
|
||||
-- sendProbeHashes -> sendProbe (reversed - change order in code, may add delay)
|
||||
sendProbe probe
|
||||
cs <- withStore' $ \db -> getMatchingContacts db user ct
|
||||
sendProbeHashes cs probe probeId
|
||||
cs <- if doProbeContacts
|
||||
then map COMContact <$> withStore' (\db -> getMatchingContacts db user ct)
|
||||
else pure []
|
||||
ms <- map COMGroupMember <$> withStore' (\db -> getMatchingMembers db user ct)
|
||||
sendProbeHashes (cs <> ms) probe probeId
|
||||
else sendProbe . Probe =<< liftIO (encodedRandomBytes gVar 32)
|
||||
where
|
||||
sendProbe :: Probe -> m ()
|
||||
sendProbe probe = void . sendDirectContactMessage ct $ XInfoProbe probe
|
||||
|
||||
probeMatchingMemberContact :: GroupInfo -> GroupMember -> IncognitoEnabled -> m ()
|
||||
probeMatchingMemberContact _ GroupMember {activeConn = Nothing} _ = pure ()
|
||||
probeMatchingMemberContact g m@GroupMember {groupId, activeConn = Just conn} connectedIncognito = do
|
||||
probeMatchingMemberContact :: GroupMember -> IncognitoEnabled -> m ()
|
||||
probeMatchingMemberContact GroupMember {activeConn = Nothing} _ = pure ()
|
||||
probeMatchingMemberContact m@GroupMember {groupId, activeConn = Just conn} connectedIncognito = do
|
||||
gVar <- asks idsDrg
|
||||
if connectedIncognito
|
||||
then sendProbe . Probe =<< liftIO (encodedRandomBytes gVar 32)
|
||||
else do
|
||||
(probe, probeId) <- withStore $ \db -> createSentProbe db gVar userId $ CGMGroupMember g m
|
||||
contactMerge <- readTVarIO =<< asks contactMergeEnabled
|
||||
if contactMerge && not connectedIncognito
|
||||
then do
|
||||
(probe, probeId) <- withStore $ \db -> createSentProbe db gVar userId $ COMGroupMember m
|
||||
sendProbe probe
|
||||
cs <- withStore' $ \db -> getMatchingMemberContacts db user m
|
||||
cs <- map COMContact <$> withStore' (\db -> getMatchingMemberContacts db user m)
|
||||
sendProbeHashes cs probe probeId
|
||||
else sendProbe . Probe =<< liftIO (encodedRandomBytes gVar 32)
|
||||
where
|
||||
sendProbe :: Probe -> m ()
|
||||
sendProbe probe = void $ sendDirectMessage conn (XInfoProbe probe) (GroupId groupId)
|
||||
|
||||
-- TODO currently we only send probe hashes to contacts
|
||||
sendProbeHashes :: [Contact] -> Probe -> Int64 -> m ()
|
||||
sendProbeHashes cs probe probeId =
|
||||
forM_ cs $ \c -> sendProbeHash c `catchChatError` \_ -> pure ()
|
||||
sendProbeHashes :: [ContactOrMember] -> Probe -> Int64 -> m ()
|
||||
sendProbeHashes cgms probe probeId =
|
||||
forM_ cgms $ \cgm -> sendProbeHash cgm `catchChatError` \_ -> pure ()
|
||||
where
|
||||
probeHash = ProbeHash $ C.sha256Hash (unProbe probe)
|
||||
sendProbeHash :: Contact -> m ()
|
||||
sendProbeHash c = do
|
||||
sendProbeHash :: ContactOrMember -> m ()
|
||||
sendProbeHash cgm@(COMContact c) = do
|
||||
void . sendDirectContactMessage c $ XInfoProbeCheck probeHash
|
||||
withStore' $ \db -> createSentProbeHash db userId probeId $ CGMContact c
|
||||
withStore' $ \db -> createSentProbeHash db userId probeId cgm
|
||||
sendProbeHash (COMGroupMember GroupMember {activeConn = Nothing}) = pure ()
|
||||
sendProbeHash cgm@(COMGroupMember m@GroupMember {groupId, activeConn = Just conn}) =
|
||||
when (memberCurrent m) $ do
|
||||
void $ sendDirectMessage conn (XInfoProbeCheck probeHash) (GroupId groupId)
|
||||
withStore' $ \db -> createSentProbeHash db userId probeId cgm
|
||||
|
||||
messageWarning :: Text -> m ()
|
||||
messageWarning = toView . CRMessageError user "warning"
|
||||
@ -4294,48 +4319,77 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
(_, param) = groupFeatureState p
|
||||
createInternalChatItem user (CDGroupRcv g m) (CIRcvGroupFeature (toGroupFeature f) (toGroupPreference p) param) Nothing
|
||||
|
||||
xInfoProbe :: ContactOrGroupMember -> Probe -> m ()
|
||||
xInfoProbe cgm2 probe =
|
||||
xInfoProbe :: ContactOrMember -> Probe -> m ()
|
||||
xInfoProbe cgm2 probe = do
|
||||
contactMerge <- readTVarIO =<< asks contactMergeEnabled
|
||||
-- [incognito] unless connected incognito
|
||||
unless (contactOrGroupMemberIncognito cgm2) $ do
|
||||
r <- withStore' $ \db -> matchReceivedProbe db user cgm2 probe
|
||||
forM_ r $ \case
|
||||
CGMContact c1 -> probeMatch c1 cgm2 probe
|
||||
CGMGroupMember _ _ -> messageWarning "xInfoProbe ignored: matched member (no probe hashes sent to members)"
|
||||
when (contactMerge && not (contactOrMemberIncognito cgm2)) $ do
|
||||
cgm1s <- withStore' $ \db -> matchReceivedProbe db user cgm2 probe
|
||||
let cgm1s' = filter (not . contactOrMemberIncognito) cgm1s
|
||||
probeMatches cgm1s' cgm2
|
||||
where
|
||||
probeMatches :: [ContactOrMember] -> ContactOrMember -> m ()
|
||||
probeMatches [] _ = pure ()
|
||||
probeMatches (cgm1' : cgm1s') cgm2' = do
|
||||
cgm2''_ <- probeMatch cgm1' cgm2' probe `catchChatError` \_ -> pure (Just cgm2')
|
||||
let cgm2'' = fromMaybe cgm2' cgm2''_
|
||||
probeMatches cgm1s' cgm2''
|
||||
|
||||
-- TODO currently we send probe hashes only to contacts
|
||||
xInfoProbeCheck :: Contact -> ProbeHash -> m ()
|
||||
xInfoProbeCheck c1 probeHash =
|
||||
xInfoProbeCheck :: ContactOrMember -> ProbeHash -> m ()
|
||||
xInfoProbeCheck cgm1 probeHash = do
|
||||
contactMerge <- readTVarIO =<< asks contactMergeEnabled
|
||||
-- [incognito] unless connected incognito
|
||||
unless (contactConnIncognito c1) $ do
|
||||
r <- withStore' $ \db -> matchReceivedProbeHash db user (CGMContact c1) probeHash
|
||||
forM_ r . uncurry $ probeMatch c1
|
||||
when (contactMerge && not (contactOrMemberIncognito cgm1)) $ do
|
||||
cgm2Probe_ <- withStore' $ \db -> matchReceivedProbeHash db user cgm1 probeHash
|
||||
forM_ cgm2Probe_ $ \(cgm2, probe) ->
|
||||
unless (contactOrMemberIncognito cgm2) $
|
||||
void $ probeMatch cgm1 cgm2 probe
|
||||
|
||||
probeMatch :: Contact -> ContactOrGroupMember -> Probe -> m ()
|
||||
probeMatch c1@Contact {contactId = cId1, profile = p1} cgm2 probe =
|
||||
probeMatch :: ContactOrMember -> ContactOrMember -> Probe -> m (Maybe ContactOrMember)
|
||||
probeMatch cgm1 cgm2 probe =
|
||||
case cgm1 of
|
||||
COMContact c1@Contact {contactId = cId1, profile = p1} ->
|
||||
case cgm2 of
|
||||
CGMContact c2@Contact {contactId = cId2, profile = p2}
|
||||
COMContact c2@Contact {contactId = cId2, profile = p2}
|
||||
| cId1 /= cId2 && profilesMatch p1 p2 -> do
|
||||
void . sendDirectContactMessage c1 $ XInfoProbeOk probe
|
||||
mergeContacts c1 c2
|
||||
| otherwise -> messageWarning "probeMatch ignored: profiles don't match or same contact id"
|
||||
CGMGroupMember g m2@GroupMember {memberProfile = p2, memberContactId}
|
||||
COMContact <$$> mergeContacts c1 c2
|
||||
| otherwise -> messageWarning "probeMatch ignored: profiles don't match or same contact id" >> pure Nothing
|
||||
COMGroupMember m2@GroupMember {memberProfile = p2, memberContactId}
|
||||
| isNothing memberContactId && profilesMatch p1 p2 -> do
|
||||
void . sendDirectContactMessage c1 $ XInfoProbeOk probe
|
||||
connectContactToMember c1 g m2
|
||||
| otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact"
|
||||
COMContact <$$> associateMemberAndContact c1 m2
|
||||
| otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact" >> pure Nothing
|
||||
COMGroupMember GroupMember {activeConn = Nothing} -> pure Nothing
|
||||
COMGroupMember m1@GroupMember {groupId, memberProfile = p1, memberContactId, activeConn = Just conn} ->
|
||||
case cgm2 of
|
||||
COMContact c2@Contact {profile = p2}
|
||||
| memberCurrent m1 && isNothing memberContactId && profilesMatch p1 p2 -> do
|
||||
void $ sendDirectMessage conn (XInfoProbeOk probe) (GroupId groupId)
|
||||
COMContact <$$> associateMemberAndContact c2 m1
|
||||
| otherwise -> messageWarning "probeMatch ignored: profiles don't match or member already has contact or member not current" >> pure Nothing
|
||||
COMGroupMember _ -> messageWarning "probeMatch ignored: members are not matched with members" >> pure Nothing
|
||||
|
||||
-- TODO currently we send probe hashes only to contacts
|
||||
xInfoProbeOk :: Contact -> Probe -> m ()
|
||||
xInfoProbeOk c1@Contact {contactId = cId1} probe =
|
||||
withStore' (\db -> matchSentProbe db user (CGMContact c1) probe) >>= \case
|
||||
Just (CGMContact c2@Contact {contactId = cId2})
|
||||
| cId1 /= cId2 -> mergeContacts c1 c2
|
||||
xInfoProbeOk :: ContactOrMember -> Probe -> m ()
|
||||
xInfoProbeOk cgm1 probe = do
|
||||
cgm2 <- withStore' $ \db -> matchSentProbe db user cgm1 probe
|
||||
case cgm1 of
|
||||
COMContact c1@Contact {contactId = cId1} ->
|
||||
case cgm2 of
|
||||
Just (COMContact c2@Contact {contactId = cId2})
|
||||
| cId1 /= cId2 -> void $ mergeContacts c1 c2
|
||||
| otherwise -> messageWarning "xInfoProbeOk ignored: same contact id"
|
||||
Just (CGMGroupMember g m2@GroupMember {memberContactId})
|
||||
| isNothing memberContactId -> connectContactToMember c1 g m2
|
||||
Just (COMGroupMember m2@GroupMember {memberContactId})
|
||||
| isNothing memberContactId -> void $ associateMemberAndContact c1 m2
|
||||
| otherwise -> messageWarning "xInfoProbeOk ignored: member already has contact"
|
||||
_ -> pure ()
|
||||
COMGroupMember m1@GroupMember {memberContactId} ->
|
||||
case cgm2 of
|
||||
Just (COMContact c2)
|
||||
| isNothing memberContactId -> void $ associateMemberAndContact c2 m1
|
||||
| otherwise -> messageWarning "xInfoProbeOk ignored: member already has contact"
|
||||
Just (COMGroupMember _) -> messageWarning "xInfoProbeOk ignored: members are not matched with members"
|
||||
_ -> pure ()
|
||||
|
||||
-- to party accepting call
|
||||
xCallInv :: Contact -> CallId -> CallInvitation -> RcvMessage -> MsgMeta -> m ()
|
||||
@ -4442,15 +4496,67 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
msgCallStateError eventName Call {callState} =
|
||||
messageError $ eventName <> ": wrong call state " <> T.pack (show $ callStateTag callState)
|
||||
|
||||
mergeContacts :: Contact -> Contact -> m ()
|
||||
mergeContacts :: Contact -> Contact -> m (Maybe Contact)
|
||||
mergeContacts c1 c2 = do
|
||||
withStore' $ \db -> mergeContactRecords db userId c1 c2
|
||||
toView $ CRContactsMerged user c1 c2
|
||||
let Contact {localDisplayName = cLDN1, profile = LocalProfile {displayName}} = c1
|
||||
Contact {localDisplayName = cLDN2} = c2
|
||||
case (suffixOrd displayName cLDN1, suffixOrd displayName cLDN2) of
|
||||
(Just cOrd1, Just cOrd2)
|
||||
| cOrd1 < cOrd2 -> merge c1 c2
|
||||
| cOrd2 < cOrd1 -> merge c2 c1
|
||||
| otherwise -> pure Nothing
|
||||
_ -> pure Nothing
|
||||
where
|
||||
merge c1' c2' = do
|
||||
c2'' <- withStore $ \db -> mergeContactRecords db user c1' c2'
|
||||
toView $ CRContactsMerged user c1' c2' c2''
|
||||
when (directOrUsed c2'') $ showSecurityCodeChanged c2''
|
||||
pure $ Just c2''
|
||||
where
|
||||
showSecurityCodeChanged mergedCt = do
|
||||
let sc1_ = contactSecurityCode c1'
|
||||
sc2_ = contactSecurityCode c2'
|
||||
scMerged_ = contactSecurityCode mergedCt
|
||||
case (sc1_, sc2_) of
|
||||
(Just sc1, Nothing)
|
||||
| scMerged_ /= Just sc1 -> securityCodeChanged mergedCt
|
||||
| otherwise -> pure ()
|
||||
(Nothing, Just sc2)
|
||||
| scMerged_ /= Just sc2 -> securityCodeChanged mergedCt
|
||||
| otherwise -> pure ()
|
||||
_ -> pure ()
|
||||
|
||||
connectContactToMember :: Contact -> GroupInfo -> GroupMember -> m ()
|
||||
connectContactToMember c1 g m2 = do
|
||||
withStore' $ \db -> updateMemberContact db user c1 m2
|
||||
toView $ CRMemberContactConnected user c1 g m2
|
||||
associateMemberAndContact :: Contact -> GroupMember -> m (Maybe Contact)
|
||||
associateMemberAndContact c m = do
|
||||
let Contact {localDisplayName = cLDN, profile = LocalProfile {displayName}} = c
|
||||
GroupMember {localDisplayName = mLDN} = m
|
||||
case (suffixOrd displayName cLDN, suffixOrd displayName mLDN) of
|
||||
(Just cOrd, Just mOrd)
|
||||
| cOrd < mOrd -> Just <$> associateMemberWithContact c m
|
||||
| mOrd < cOrd -> Just <$> associateContactWithMember m c
|
||||
| otherwise -> pure Nothing
|
||||
_ -> pure Nothing
|
||||
|
||||
suffixOrd :: ContactName -> ContactName -> Maybe Int
|
||||
suffixOrd displayName localDisplayName
|
||||
| localDisplayName == displayName = Just 0
|
||||
| otherwise = case T.stripPrefix (displayName <> "_") localDisplayName of
|
||||
Just suffix -> readMaybe $ T.unpack suffix
|
||||
Nothing -> Nothing
|
||||
|
||||
associateMemberWithContact :: Contact -> GroupMember -> m Contact
|
||||
associateMemberWithContact c1 m2@GroupMember {groupId} = do
|
||||
withStore' $ \db -> associateMemberWithContactRecord db user c1 m2
|
||||
g <- withStore $ \db -> getGroupInfo db user groupId
|
||||
toView $ CRContactAndMemberAssociated user c1 g m2 c1
|
||||
pure c1
|
||||
|
||||
associateContactWithMember :: GroupMember -> Contact -> m Contact
|
||||
associateContactWithMember m1@GroupMember {groupId} c2 = do
|
||||
c2' <- withStore $ \db -> associateContactWithMemberRecord db user m1 c2
|
||||
g <- withStore $ \db -> getGroupInfo db user groupId
|
||||
toView $ CRContactAndMemberAssociated user c2 g m1 c2'
|
||||
pure c2'
|
||||
|
||||
saveConnInfo :: Connection -> ConnInfo -> m Connection
|
||||
saveConnInfo activeConn connInfo = do
|
||||
@ -4674,6 +4780,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
|
||||
forM_ mContent_ $ \mc -> do
|
||||
ci <- saveRcvChatItem user (CDDirectRcv mCt') msg msgMeta (CIRcvMsgContent mc)
|
||||
toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat mCt') ci)
|
||||
|
||||
securityCodeChanged :: Contact -> m ()
|
||||
securityCodeChanged ct = do
|
||||
toView $ CRContactVerificationReset user ct
|
||||
createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent RCEVerificationCodeReset) Nothing
|
||||
@ -5379,6 +5487,7 @@ chatCommandP =
|
||||
("/_files_folder " <|> "/files_folder ") *> (SetFilesFolder <$> filePath),
|
||||
"/_xftp " *> (APISetXFTPConfig <$> ("on " *> (Just <$> jsonP) <|> ("off" $> Nothing))),
|
||||
"/xftp " *> (APISetXFTPConfig <$> ("on" *> (Just <$> xftpCfgP) <|> ("off" $> Nothing))),
|
||||
"/contact_merge " *> (SetContactMergeEnabled <$> onOffP),
|
||||
"/_db export " *> (APIExportArchive <$> jsonP),
|
||||
"/db export" $> ExportArchive,
|
||||
"/_db import " *> (APIImportArchive <$> jsonP),
|
||||
|
||||
@ -191,7 +191,8 @@ data ChatController = ChatController
|
||||
showLiveItems :: TVar Bool,
|
||||
userXFTPFileConfig :: TVar (Maybe XFTPFileConfig),
|
||||
tempDirectory :: TVar (Maybe FilePath),
|
||||
logFilePath :: Maybe FilePath
|
||||
logFilePath :: Maybe FilePath,
|
||||
contactMergeEnabled :: TVar Bool
|
||||
}
|
||||
|
||||
data HelpSection = HSMain | HSFiles | HSGroups | HSContacts | HSMyAddress | HSIncognito | HSMarkdown | HSMessages | HSSettings | HSDatabase
|
||||
@ -230,6 +231,7 @@ data ChatCommand
|
||||
| SetTempFolder FilePath
|
||||
| SetFilesFolder FilePath
|
||||
| APISetXFTPConfig (Maybe XFTPFileConfig)
|
||||
| SetContactMergeEnabled Bool
|
||||
| APIExportArchive ArchiveConfig
|
||||
| ExportArchive
|
||||
| APIImportArchive ArchiveConfig
|
||||
@ -490,7 +492,7 @@ data ChatResponse
|
||||
| CRSentConfirmation {user :: User}
|
||||
| CRSentInvitation {user :: User, customUserProfile :: Maybe Profile}
|
||||
| CRContactUpdated {user :: User, fromContact :: Contact, toContact :: Contact}
|
||||
| CRContactsMerged {user :: User, intoContact :: Contact, mergedContact :: Contact}
|
||||
| CRContactsMerged {user :: User, intoContact :: Contact, mergedContact :: Contact, updatedContact :: Contact}
|
||||
| CRContactDeleted {user :: User, contact :: Contact}
|
||||
| CRContactDeletedByContact {user :: User, contact :: Contact}
|
||||
| CRChatCleared {user :: User, chatInfo :: AChatInfo}
|
||||
@ -562,7 +564,7 @@ data ChatResponse
|
||||
| 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}
|
||||
| CRMemberContactConnected {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRContactAndMemberAssociated {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember, updatedContact :: Contact}
|
||||
| CRMemberSubError {user :: User, groupInfo :: GroupInfo, member :: GroupMember, chatError :: ChatError}
|
||||
| CRMemberSubSummary {user :: User, memberSubscriptions :: [MemberSubStatus]}
|
||||
| CRGroupSubscribed {user :: User, groupInfo :: GroupInfo}
|
||||
|
||||
28
src/Simplex/Chat/Migrations/M20231002_conn_initiated.hs
Normal file
28
src/Simplex/Chat/Migrations/M20231002_conn_initiated.hs
Normal file
@ -0,0 +1,28 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20231002_conn_initiated where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20231002_conn_initiated :: Query
|
||||
m20231002_conn_initiated =
|
||||
[sql|
|
||||
ALTER TABLE connections ADD COLUMN contact_conn_initiated INTEGER NOT NULL DEFAULT 0;
|
||||
|
||||
UPDATE connections SET conn_req_inv = NULL WHERE conn_status IN ('ready', 'deleted');
|
||||
|
||||
CREATE INDEX idx_sent_probes_created_at ON sent_probes(created_at);
|
||||
CREATE INDEX idx_sent_probe_hashes_created_at ON sent_probe_hashes(created_at);
|
||||
CREATE INDEX idx_received_probes_created_at ON received_probes(created_at);
|
||||
|]
|
||||
|
||||
down_m20231002_conn_initiated :: Query
|
||||
down_m20231002_conn_initiated =
|
||||
[sql|
|
||||
DROP INDEX idx_sent_probes_created_at;
|
||||
DROP INDEX idx_sent_probe_hashes_created_at;
|
||||
DROP INDEX idx_received_probes_created_at;
|
||||
|
||||
ALTER TABLE connections DROP COLUMN contact_conn_initiated;
|
||||
|]
|
||||
@ -264,6 +264,7 @@ CREATE TABLE connections(
|
||||
peer_chat_min_version INTEGER NOT NULL DEFAULT 1,
|
||||
peer_chat_max_version INTEGER NOT NULL DEFAULT 1,
|
||||
to_subscribe INTEGER DEFAULT 0 NOT NULL,
|
||||
contact_conn_initiated INTEGER NOT NULL DEFAULT 0,
|
||||
FOREIGN KEY(snd_file_id, connection_id)
|
||||
REFERENCES snd_files(file_id, connection_id)
|
||||
ON DELETE CASCADE
|
||||
@ -732,3 +733,6 @@ CREATE INDEX idx_received_probes_user_id ON received_probes(user_id);
|
||||
CREATE INDEX idx_received_probes_contact_id ON received_probes(contact_id);
|
||||
CREATE INDEX idx_received_probes_probe ON received_probes(probe);
|
||||
CREATE INDEX idx_received_probes_probe_hash ON received_probes(probe_hash);
|
||||
CREATE INDEX idx_sent_probes_created_at ON sent_probes(created_at);
|
||||
CREATE INDEX idx_sent_probe_hashes_created_at ON sent_probe_hashes(created_at);
|
||||
CREATE INDEX idx_received_probes_created_at ON received_probes(created_at);
|
||||
|
||||
@ -3,11 +3,12 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Simplex.Chat.Mobile where
|
||||
|
||||
import Control.Concurrent.STM
|
||||
import Control.Exception (catch)
|
||||
import Control.Exception (catch, SomeException)
|
||||
import Control.Monad.Except
|
||||
import Control.Monad.Reader
|
||||
import Data.Aeson (ToJSON (..))
|
||||
@ -40,8 +41,9 @@ import Simplex.Chat.Options
|
||||
import Simplex.Chat.Store
|
||||
import Simplex.Chat.Store.Profiles
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Messaging.Agent.Client (agentClientStore)
|
||||
import Simplex.Messaging.Agent.Env.SQLite (createAgentStore)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), MigrationError)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), MigrationError, closeSQLiteStore)
|
||||
import Simplex.Messaging.Client (defaultNetworkConfig)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding.String
|
||||
@ -53,6 +55,8 @@ import System.Timeout (timeout)
|
||||
|
||||
foreign export ccall "chat_migrate_init" cChatMigrateInit :: CString -> CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString
|
||||
|
||||
foreign export ccall "chat_close_store" cChatCloseStore :: StablePtr ChatController -> IO CString
|
||||
|
||||
foreign export ccall "chat_send_cmd" cChatSendCmd :: StablePtr ChatController -> CString -> IO CJSONString
|
||||
|
||||
foreign export ccall "chat_recv_msg" cChatRecvMsg :: StablePtr ChatController -> IO CJSONString
|
||||
@ -97,6 +101,9 @@ cChatMigrateInit fp key conf ctrl = do
|
||||
Left e -> pure e
|
||||
newCStringFromLazyBS $ J.encode r
|
||||
|
||||
cChatCloseStore :: StablePtr ChatController -> IO CString
|
||||
cChatCloseStore cPtr = deRefStablePtr cPtr >>= chatCloseStore >>= newCAString
|
||||
|
||||
-- | send command to chat (same syntax as in terminal for now)
|
||||
cChatSendCmd :: StablePtr ChatController -> CString -> IO CJSONString
|
||||
cChatSendCmd cPtr cCmd = do
|
||||
@ -201,6 +208,14 @@ chatMigrateInit dbFilePrefix dbKey confirm = runExceptT $ do
|
||||
_ -> dbError e
|
||||
dbError e = Left . DBMErrorSQL dbFile $ show e
|
||||
|
||||
chatCloseStore :: ChatController -> IO String
|
||||
chatCloseStore ChatController {chatStore, smpAgent} = handleErr $ do
|
||||
closeSQLiteStore chatStore
|
||||
closeSQLiteStore $ agentClientStore smpAgent
|
||||
|
||||
handleErr :: IO () -> IO String
|
||||
handleErr a = (a $> "") `catch` (pure . show @SomeException)
|
||||
|
||||
chatSendCmd :: ChatController -> ByteString -> IO JSONByteString
|
||||
chatSendCmd cc s = J.encode . APIResponse Nothing <$> runReaderT (execChatCommand s) cc
|
||||
|
||||
|
||||
@ -55,7 +55,7 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
|
||||
db
|
||||
[sql|
|
||||
SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, custom_user_profile_id,
|
||||
conn_status, conn_type, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at, security_code, security_code_verified_at, auth_err_counter,
|
||||
conn_status, conn_type, contact_conn_initiated, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at, security_code, security_code_verified_at, auth_err_counter,
|
||||
peer_chat_min_version, peer_chat_max_version
|
||||
FROM connections
|
||||
WHERE user_id = ? AND agent_conn_id = ?
|
||||
|
||||
@ -59,6 +59,7 @@ module Simplex.Chat.Store.Direct
|
||||
updateConnectionStatus,
|
||||
updateContactSettings,
|
||||
setConnConnReqInv,
|
||||
resetContactConnInitiated,
|
||||
)
|
||||
where
|
||||
|
||||
@ -121,11 +122,11 @@ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile grou
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO connections (
|
||||
user_id, agent_conn_id, conn_status, conn_type,
|
||||
user_id, agent_conn_id, conn_status, conn_type, contact_conn_initiated,
|
||||
via_contact_uri_hash, xcontact_id, custom_user_profile_id, via_group_link, group_link_id, created_at, updated_at, to_subscribe
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
((userId, acId, pccConnStatus, ConnContact, cReqHash, xContactId) :. (customUserProfileId, isJust groupLinkId, groupLinkId, createdAt, createdAt, subMode == SMOnlyCreate))
|
||||
((userId, acId, pccConnStatus, ConnContact, True, cReqHash, xContactId) :. (customUserProfileId, isJust groupLinkId, groupLinkId, createdAt, createdAt, subMode == SMOnlyCreate))
|
||||
pccConnId <- insertedRowId db
|
||||
pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = True, viaUserContactLink = Nothing, groupLinkId, customUserProfileId, connReqInv = Nothing, localAlias = "", createdAt, updatedAt = createdAt}
|
||||
|
||||
@ -146,14 +147,14 @@ getConnReqContactXContactId db user@User {userId} cReqHash = do
|
||||
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.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.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,
|
||||
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
|
||||
FROM contacts ct
|
||||
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
|
||||
JOIN connections c ON c.contact_id = ct.contact_id
|
||||
WHERE ct.user_id = ? AND c.via_contact_uri_hash = ? AND ct.deleted = 0
|
||||
ORDER BY c.connection_id DESC
|
||||
ORDER BY c.created_at DESC
|
||||
LIMIT 1
|
||||
|]
|
||||
(userId, cReqHash)
|
||||
@ -169,13 +170,14 @@ createDirectConnection :: DB.Connection -> User -> ConnId -> ConnReqInvitation -
|
||||
createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile subMode = do
|
||||
createdAt <- getCurrentTime
|
||||
customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile
|
||||
let contactConnInitiated = pccConnStatus == ConnNew
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO connections
|
||||
(user_id, agent_conn_id, conn_req_inv, conn_status, conn_type, custom_user_profile_id, created_at, updated_at, to_subscribe) VALUES (?,?,?,?,?,?,?,?,?)
|
||||
(user_id, agent_conn_id, conn_req_inv, conn_status, conn_type, contact_conn_initiated, custom_user_profile_id, created_at, updated_at, to_subscribe) VALUES (?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
(userId, acId, cReq, pccConnStatus, ConnContact, customUserProfileId, createdAt, createdAt, subMode == SMOnlyCreate)
|
||||
(userId, acId, cReq, pccConnStatus, ConnContact, contactConnInitiated, customUserProfileId, createdAt, createdAt, subMode == SMOnlyCreate)
|
||||
pccConnId <- insertedRowId db
|
||||
pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = False, viaUserContactLink = Nothing, groupLinkId = Nothing, customUserProfileId, connReqInv = Just cReq, localAlias = "", createdAt, updatedAt = createdAt}
|
||||
|
||||
@ -503,14 +505,14 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers
|
||||
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.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.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,
|
||||
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
|
||||
FROM contacts ct
|
||||
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
|
||||
LEFT JOIN connections c ON c.contact_id = ct.contact_id
|
||||
WHERE ct.user_id = ? AND ct.xcontact_id = ? AND ct.deleted = 0
|
||||
ORDER BY c.connection_id DESC
|
||||
ORDER BY c.created_at DESC
|
||||
LIMIT 1
|
||||
|]
|
||||
(userId, xContactId)
|
||||
@ -667,7 +669,7 @@ getContact_ db user@User {userId} contactId deleted =
|
||||
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.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.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,
|
||||
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
|
||||
FROM contacts ct
|
||||
@ -679,10 +681,11 @@ getContact_ db user@User {userId} contactId deleted =
|
||||
SELECT cc_connection_id FROM (
|
||||
SELECT
|
||||
cc.connection_id AS cc_connection_id,
|
||||
cc.created_at AS cc_created_at,
|
||||
(CASE WHEN cc.conn_status = ? OR cc.conn_status = ? THEN 1 ELSE 0 END) AS cc_conn_status_ord
|
||||
FROM connections cc
|
||||
WHERE cc.user_id = ct.user_id AND cc.contact_id = ct.contact_id
|
||||
ORDER BY cc_conn_status_ord DESC, cc_connection_id DESC
|
||||
ORDER BY cc_conn_status_ord DESC, cc_created_at DESC
|
||||
LIMIT 1
|
||||
)
|
||||
)
|
||||
@ -717,7 +720,7 @@ getContactConnections db userId Contact {contactId} =
|
||||
db
|
||||
[sql|
|
||||
SELECT 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.conn_status, c.conn_type, c.contact_conn_initiated, 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
|
||||
FROM connections c
|
||||
JOIN contacts ct ON ct.contact_id = c.contact_id
|
||||
@ -734,7 +737,7 @@ getConnectionById db User {userId} connId = ExceptT $ do
|
||||
db
|
||||
[sql|
|
||||
SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, custom_user_profile_id,
|
||||
conn_status, conn_type, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at, security_code, security_code_verified_at, auth_err_counter,
|
||||
conn_status, conn_type, contact_conn_initiated, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at, security_code, security_code_verified_at, auth_err_counter,
|
||||
peer_chat_min_version, peer_chat_max_version
|
||||
FROM connections
|
||||
WHERE user_id = ? AND connection_id = ?
|
||||
@ -768,6 +771,10 @@ getConnectionsContacts db agentConnIds = do
|
||||
updateConnectionStatus :: DB.Connection -> Connection -> ConnStatus -> IO ()
|
||||
updateConnectionStatus db Connection {connId} connStatus = do
|
||||
currentTs <- getCurrentTime
|
||||
if connStatus == ConnReady
|
||||
then
|
||||
DB.execute db "UPDATE connections SET conn_status = ?, updated_at = ?, conn_req_inv = NULL WHERE connection_id = ?" (connStatus, currentTs, connId)
|
||||
else
|
||||
DB.execute db "UPDATE connections SET conn_status = ?, updated_at = ? WHERE connection_id = ?" (connStatus, currentTs, connId)
|
||||
|
||||
updateContactSettings :: DB.Connection -> User -> Int64 -> ChatSettings -> IO ()
|
||||
@ -785,3 +792,16 @@ setConnConnReqInv db User {userId} connId connReq = do
|
||||
WHERE user_id = ? AND connection_id = ?
|
||||
|]
|
||||
(connReq, updatedAt, userId, connId)
|
||||
|
||||
resetContactConnInitiated :: DB.Connection -> User -> Connection -> IO ()
|
||||
resetContactConnInitiated db User {userId} Connection {connId} = do
|
||||
updatedAt <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE connections
|
||||
SET contact_conn_initiated = 0, updated_at = ?
|
||||
WHERE user_id = ? AND connection_id = ?
|
||||
|]
|
||||
(updatedAt, userId, connId)
|
||||
|
||||
|
||||
@ -74,6 +74,7 @@ module Simplex.Chat.Store.Groups
|
||||
getViaGroupMember,
|
||||
getViaGroupContact,
|
||||
getMatchingContacts,
|
||||
getMatchingMembers,
|
||||
getMatchingMemberContacts,
|
||||
createSentProbe,
|
||||
createSentProbeHash,
|
||||
@ -81,7 +82,9 @@ module Simplex.Chat.Store.Groups
|
||||
matchReceivedProbeHash,
|
||||
matchSentProbe,
|
||||
mergeContactRecords,
|
||||
updateMemberContact,
|
||||
associateMemberWithContactRecord,
|
||||
associateContactWithMemberRecord,
|
||||
deleteOldProbes,
|
||||
updateGroupSettings,
|
||||
getXGrpMemIntroContDirect,
|
||||
getXGrpMemIntroContGroup,
|
||||
@ -99,8 +102,8 @@ import Control.Monad.Except
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import Data.Either (rights)
|
||||
import Data.Int (Int64)
|
||||
import Data.List (sortOn)
|
||||
import Data.Maybe (fromMaybe, isNothing)
|
||||
import Data.List (partition, sortOn)
|
||||
import Data.Maybe (fromMaybe, isNothing, catMaybes, isJust)
|
||||
import Data.Ord (Down (..))
|
||||
import Data.Text (Text)
|
||||
import Data.Time.Clock (UTCTime (..), getCurrentTime)
|
||||
@ -164,7 +167,7 @@ getGroupLinkConnection db User {userId} groupInfo@GroupInfo {groupId} =
|
||||
db
|
||||
[sql|
|
||||
SELECT 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.conn_status, c.conn_type, c.contact_conn_initiated, 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
|
||||
FROM connections c
|
||||
JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id
|
||||
@ -246,7 +249,7 @@ getGroupAndMember db User {userId, userContactId} groupMemberId =
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
|
||||
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
|
||||
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.conn_status, c.conn_type, c.contact_conn_initiated, 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
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
@ -539,7 +542,7 @@ groupMemberQuery =
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
|
||||
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
|
||||
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.conn_status, c.conn_type, c.contact_conn_initiated, 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
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
@ -687,31 +690,21 @@ createNewContactMemberAsync db gVar user@User {userId, userContactId} groupId Co
|
||||
)
|
||||
|
||||
getContactViaMember :: DB.Connection -> User -> GroupMember -> ExceptT StoreError IO Contact
|
||||
getContactViaMember db user@User {userId} GroupMember {groupMemberId} =
|
||||
getContactViaMember db user@User {userId} GroupMember {groupMemberId} = do
|
||||
contactId <-
|
||||
ExceptT $
|
||||
firstRow (toContact user) (SEContactNotFoundByMemberId groupMemberId) $
|
||||
firstRow fromOnly (SEContactNotFoundByMemberId groupMemberId) $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
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.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,
|
||||
c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM contacts ct
|
||||
JOIN contact_profiles cp ON cp.contact_profile_id = ct.contact_profile_id
|
||||
JOIN connections c ON c.connection_id = (
|
||||
SELECT max(cc.connection_id)
|
||||
FROM connections cc
|
||||
where cc.contact_id = ct.contact_id
|
||||
)
|
||||
JOIN group_members m ON m.contact_id = ct.contact_id
|
||||
WHERE ct.user_id = ? AND m.group_member_id = ? AND ct.deleted = 0
|
||||
SELECT ct.contact_id
|
||||
FROM group_members m
|
||||
JOIN contacts ct ON ct.contact_id = m.contact_id
|
||||
WHERE m.user_id = ? AND m.group_member_id = ? AND ct.deleted = 0
|
||||
LIMIT 1
|
||||
|]
|
||||
(userId, groupMemberId)
|
||||
getContact db user contactId
|
||||
|
||||
setNewContactMemberConnRequest :: DB.Connection -> User -> GroupMember -> ConnReqInvitation -> IO ()
|
||||
setNewContactMemberConnRequest db User {userId} GroupMember {groupMemberId} connRequest = do
|
||||
@ -1008,7 +1001,7 @@ getViaGroupMember db User {userId, userContactId} Contact {contactId} =
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
|
||||
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
|
||||
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.conn_status, c.conn_type, c.contact_conn_initiated, 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
|
||||
FROM group_members m
|
||||
JOIN contacts ct ON ct.contact_id = m.contact_id
|
||||
@ -1033,37 +1026,21 @@ getViaGroupMember db User {userId, userContactId} Contact {contactId} =
|
||||
in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection connRow})
|
||||
|
||||
getViaGroupContact :: DB.Connection -> User -> GroupMember -> IO (Maybe Contact)
|
||||
getViaGroupContact db user@User {userId} GroupMember {groupMemberId} =
|
||||
maybeFirstRow toContact' $
|
||||
getViaGroupContact db user@User {userId} GroupMember {groupMemberId} = do
|
||||
contactId_ <-
|
||||
maybeFirstRow fromOnly $
|
||||
DB.query
|
||||
db
|
||||
[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.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
||||
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
|
||||
FROM contacts ct
|
||||
JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id
|
||||
JOIN connections c ON c.connection_id = (
|
||||
SELECT max(cc.connection_id)
|
||||
FROM connections cc
|
||||
where cc.contact_id = ct.contact_id
|
||||
)
|
||||
JOIN groups g ON g.group_id = ct.via_group
|
||||
JOIN group_members m ON m.group_id = g.group_id AND m.contact_id = ct.contact_id
|
||||
WHERE ct.user_id = ? AND m.group_member_id = ? AND ct.deleted = 0
|
||||
SELECT ct.contact_id
|
||||
FROM group_members m
|
||||
JOIN groups g ON g.group_id = m.group_id
|
||||
JOIN contacts ct ON ct.contact_id = m.contact_id AND ct.via_group = g.group_id
|
||||
WHERE m.user_id = ? AND m.group_member_id = ? AND ct.deleted = 0
|
||||
LIMIT 1
|
||||
|]
|
||||
(userId, groupMemberId)
|
||||
where
|
||||
toContact' :: ((ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool, ContactStatus) :. (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, contactStatus) :. (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, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent}
|
||||
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db user) contactId_
|
||||
|
||||
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}
|
||||
@ -1171,13 +1148,32 @@ getMatchingContacts db user@User {userId} Contact {contactId, profile = LocalPro
|
||||
AND p.display_name = ? AND p.full_name = ?
|
||||
|]
|
||||
|
||||
getMatchingMembers :: DB.Connection -> User -> Contact -> IO [GroupMember]
|
||||
getMatchingMembers db user@User {userId} Contact {profile = LocalProfile {displayName, fullName, image}} = do
|
||||
memberIds <-
|
||||
map fromOnly <$> case image of
|
||||
Just img -> DB.query db (q <> " AND p.image = ?") (userId, GCUserMember, displayName, fullName, img)
|
||||
Nothing -> DB.query db (q <> " AND p.image is NULL") (userId, GCUserMember, displayName, fullName)
|
||||
filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db user) memberIds
|
||||
where
|
||||
-- only match with members without associated contact
|
||||
q =
|
||||
[sql|
|
||||
SELECT m.group_member_id
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
WHERE m.user_id = ? AND m.contact_id IS NULL
|
||||
AND m.member_category != ?
|
||||
AND p.display_name = ? AND p.full_name = ?
|
||||
|]
|
||||
|
||||
getMatchingMemberContacts :: DB.Connection -> User -> GroupMember -> IO [Contact]
|
||||
getMatchingMemberContacts _ _ GroupMember {memberContactId = Just _} = pure []
|
||||
getMatchingMemberContacts db user@User {userId} GroupMember {memberProfile = LocalProfile {displayName, fullName, image}} = do
|
||||
contactIds <-
|
||||
map fromOnly <$> case image of
|
||||
Just img -> DB.query db (q <> " AND p.image = ?") (userId, displayName, fullName, img)
|
||||
Nothing -> DB.query db (q <> " AND p.image is NULL") (userId, displayName, fullName)
|
||||
Just img -> DB.query db (q <> " AND p.image = ?") (userId, CSActive, displayName, fullName, img)
|
||||
Nothing -> DB.query db (q <> " AND p.image is NULL") (userId, CSActive, displayName, fullName)
|
||||
rights <$> mapM (runExceptT . getContact db user) contactIds
|
||||
where
|
||||
q =
|
||||
@ -1186,35 +1182,34 @@ getMatchingMemberContacts db user@User {userId} GroupMember {memberProfile = Loc
|
||||
FROM contacts ct
|
||||
JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id
|
||||
WHERE ct.user_id = ?
|
||||
AND ct.deleted = 0
|
||||
AND ct.contact_status = ? AND ct.deleted = 0
|
||||
AND p.display_name = ? AND p.full_name = ?
|
||||
|]
|
||||
|
||||
createSentProbe :: DB.Connection -> TVar ChaChaDRG -> UserId -> ContactOrGroupMember -> ExceptT StoreError IO (Probe, Int64)
|
||||
createSentProbe :: DB.Connection -> TVar ChaChaDRG -> UserId -> ContactOrMember -> ExceptT StoreError IO (Probe, Int64)
|
||||
createSentProbe db gVar userId to =
|
||||
createWithRandomBytes 32 gVar $ \probe -> do
|
||||
currentTs <- getCurrentTime
|
||||
let (ctId, gmId) = contactOrGroupMemberIds to
|
||||
let (ctId, gmId) = contactOrMemberIds to
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO sent_probes (contact_id, group_member_id, probe, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
|
||||
(ctId, gmId, probe, userId, currentTs, currentTs)
|
||||
(Probe probe,) <$> insertedRowId db
|
||||
|
||||
createSentProbeHash :: DB.Connection -> UserId -> Int64 -> ContactOrGroupMember -> IO ()
|
||||
createSentProbeHash :: DB.Connection -> UserId -> Int64 -> ContactOrMember -> IO ()
|
||||
createSentProbeHash db userId probeId to = do
|
||||
currentTs <- getCurrentTime
|
||||
let (ctId, gmId) = contactOrGroupMemberIds to
|
||||
let (ctId, gmId) = contactOrMemberIds to
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO sent_probe_hashes (sent_probe_id, contact_id, group_member_id, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
|
||||
(probeId, ctId, gmId, userId, currentTs, currentTs)
|
||||
|
||||
matchReceivedProbe :: DB.Connection -> User -> ContactOrGroupMember -> Probe -> IO (Maybe ContactOrGroupMember)
|
||||
matchReceivedProbe :: DB.Connection -> User -> ContactOrMember -> Probe -> IO [ContactOrMember]
|
||||
matchReceivedProbe db user@User {userId} from (Probe probe) = do
|
||||
let probeHash = C.sha256Hash probe
|
||||
cgmIds <-
|
||||
maybeFirstRow id $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
@ -1227,14 +1222,23 @@ matchReceivedProbe db user@User {userId} from (Probe probe) = do
|
||||
|]
|
||||
(userId, probeHash)
|
||||
currentTs <- getCurrentTime
|
||||
let (ctId, gmId) = contactOrGroupMemberIds from
|
||||
let (ctId, gmId) = contactOrMemberIds from
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO received_probes (contact_id, group_member_id, probe, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
|
||||
(ctId, gmId, probe, probeHash, userId, currentTs, currentTs)
|
||||
pure cgmIds $>>= getContactOrGroupMember_ db user
|
||||
let cgmIds' = filterFirstContactId cgmIds
|
||||
catMaybes <$> mapM (getContactOrMember_ db user) cgmIds'
|
||||
where
|
||||
filterFirstContactId :: [(Maybe ContactId, Maybe GroupId, Maybe GroupMemberId)] -> [(Maybe ContactId, Maybe GroupId, Maybe GroupMemberId)]
|
||||
filterFirstContactId cgmIds = do
|
||||
let (ctIds, memIds) = partition (\(ctId, _, _) -> isJust ctId) cgmIds
|
||||
ctIds' = case ctIds of
|
||||
[] -> []
|
||||
(x : _) -> [x]
|
||||
ctIds' <> memIds
|
||||
|
||||
matchReceivedProbeHash :: DB.Connection -> User -> ContactOrGroupMember -> ProbeHash -> IO (Maybe (ContactOrGroupMember, Probe))
|
||||
matchReceivedProbeHash :: DB.Connection -> User -> ContactOrMember -> ProbeHash -> IO (Maybe (ContactOrMember, Probe))
|
||||
matchReceivedProbeHash db user@User {userId} from (ProbeHash probeHash) = do
|
||||
probeIds <-
|
||||
maybeFirstRow id $
|
||||
@ -1250,18 +1254,18 @@ matchReceivedProbeHash db user@User {userId} from (ProbeHash probeHash) = do
|
||||
|]
|
||||
(userId, probeHash)
|
||||
currentTs <- getCurrentTime
|
||||
let (ctId, gmId) = contactOrGroupMemberIds from
|
||||
let (ctId, gmId) = contactOrMemberIds from
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO received_probes (contact_id, group_member_id, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
|
||||
(ctId, gmId, probeHash, userId, currentTs, currentTs)
|
||||
pure probeIds $>>= \(Only probe :. cgmIds) -> (,Probe probe) <$$> getContactOrGroupMember_ db user cgmIds
|
||||
pure probeIds $>>= \(Only probe :. cgmIds) -> (,Probe probe) <$$> getContactOrMember_ db user cgmIds
|
||||
|
||||
matchSentProbe :: DB.Connection -> User -> ContactOrGroupMember -> Probe -> IO (Maybe ContactOrGroupMember)
|
||||
matchSentProbe db user@User {userId} _from (Probe probe) =
|
||||
cgmIds $>>= getContactOrGroupMember_ db user
|
||||
matchSentProbe :: DB.Connection -> User -> ContactOrMember -> Probe -> IO (Maybe ContactOrMember)
|
||||
matchSentProbe db user@User {userId} _from (Probe probe) = do
|
||||
cgmIds $>>= getContactOrMember_ db user
|
||||
where
|
||||
(ctId, gmId) = contactOrGroupMemberIds _from
|
||||
(ctId, gmId) = contactOrMemberIds _from
|
||||
cgmIds =
|
||||
maybeFirstRow id $
|
||||
DB.query
|
||||
@ -1278,20 +1282,22 @@ matchSentProbe db user@User {userId} _from (Probe probe) =
|
||||
|]
|
||||
(userId, probe, ctId, gmId)
|
||||
|
||||
getContactOrGroupMember_ :: DB.Connection -> User -> (Maybe ContactId, Maybe GroupId, Maybe GroupMemberId) -> IO (Maybe ContactOrGroupMember)
|
||||
getContactOrGroupMember_ db user ids =
|
||||
getContactOrMember_ :: DB.Connection -> User -> (Maybe ContactId, Maybe GroupId, Maybe GroupMemberId) -> IO (Maybe ContactOrMember)
|
||||
getContactOrMember_ db user ids =
|
||||
fmap eitherToMaybe . runExceptT $ case ids of
|
||||
(Just ctId, _, _) -> CGMContact <$> getContact db user ctId
|
||||
(_, Just gId, Just gmId) -> CGMGroupMember <$> getGroupInfo db user gId <*> getGroupMember db user gId gmId
|
||||
(Just ctId, _, _) -> COMContact <$> getContact db user ctId
|
||||
(_, Just gId, Just gmId) -> COMGroupMember <$> getGroupMember db user gId gmId
|
||||
_ -> throwError $ SEInternalError ""
|
||||
|
||||
mergeContactRecords :: DB.Connection -> UserId -> Contact -> Contact -> IO ()
|
||||
mergeContactRecords db userId ct1 ct2 = do
|
||||
let (toCt, fromCt) = toFromContacts ct1 ct2
|
||||
Contact {contactId = toContactId} = toCt
|
||||
Contact {contactId = fromContactId, localDisplayName} = fromCt
|
||||
-- if requested merge direction is overruled (toFromContacts), keepLDN is kept
|
||||
mergeContactRecords :: DB.Connection -> User -> Contact -> Contact -> ExceptT StoreError IO Contact
|
||||
mergeContactRecords db user@User {userId} to@Contact {localDisplayName = keepLDN} from = do
|
||||
let (toCt, fromCt) = toFromContacts to from
|
||||
Contact {contactId = toContactId, localDisplayName = toLDN} = toCt
|
||||
Contact {contactId = fromContactId, localDisplayName = fromLDN} = fromCt
|
||||
liftIO $ do
|
||||
currentTs <- getCurrentTime
|
||||
-- TODO next query fixes incorrect unused contacts deletion; consider more thorough fix
|
||||
-- next query fixes incorrect unused contacts deletion
|
||||
when (contactDirect toCt && not (contactUsed toCt)) $
|
||||
DB.execute
|
||||
db
|
||||
@ -1331,7 +1337,17 @@ mergeContactRecords db userId ct1 ct2 = do
|
||||
]
|
||||
deleteContactProfile_ db userId fromContactId
|
||||
DB.execute db "DELETE FROM contacts WHERE contact_id = ? AND user_id = ?" (fromContactId, userId)
|
||||
deleteUnusedDisplayName_ db userId localDisplayName
|
||||
deleteUnusedDisplayName_ db userId fromLDN
|
||||
when (keepLDN /= toLDN && keepLDN == fromLDN) $
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE display_names
|
||||
SET local_display_name = ?, updated_at = ?
|
||||
WHERE user_id = ? AND local_display_name = ?
|
||||
|]
|
||||
(keepLDN, currentTs, userId, toLDN)
|
||||
getContact db user toContactId
|
||||
where
|
||||
toFromContacts :: Contact -> Contact -> (Contact, Contact)
|
||||
toFromContacts c1 c2
|
||||
@ -1344,14 +1360,12 @@ mergeContactRecords db userId ct1 ct2 = do
|
||||
d2 = directOrUsed c2
|
||||
ctCreatedAt Contact {createdAt} = createdAt
|
||||
|
||||
updateMemberContact :: DB.Connection -> User -> Contact -> GroupMember -> IO ()
|
||||
updateMemberContact
|
||||
associateMemberWithContactRecord :: DB.Connection -> User -> Contact -> GroupMember -> IO ()
|
||||
associateMemberWithContactRecord
|
||||
db
|
||||
User {userId}
|
||||
Contact {contactId, localDisplayName, profile = LocalProfile {profileId}}
|
||||
GroupMember {groupId, groupMemberId, localDisplayName = memLDN, memberProfile = LocalProfile {profileId = memProfileId}} = do
|
||||
-- TODO possibly, we should update profiles and local_display_names of all members linked to the same remote user,
|
||||
-- once we decide on how we identify it, either based on shared contact_profile_id or on local_display_name
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
@ -1364,6 +1378,34 @@ updateMemberContact
|
||||
when (memProfileId /= profileId) $ deleteUnusedProfile_ db userId memProfileId
|
||||
when (memLDN /= localDisplayName) $ deleteUnusedDisplayName_ db userId memLDN
|
||||
|
||||
associateContactWithMemberRecord :: DB.Connection -> User -> GroupMember -> Contact -> ExceptT StoreError IO Contact
|
||||
associateContactWithMemberRecord
|
||||
db
|
||||
user@User {userId}
|
||||
GroupMember {groupId, groupMemberId, localDisplayName = memLDN, memberProfile = LocalProfile {profileId = memProfileId}}
|
||||
Contact {contactId, localDisplayName, profile = LocalProfile {profileId}} = do
|
||||
liftIO $ do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE group_members
|
||||
SET contact_id = ?, updated_at = ?
|
||||
WHERE user_id = ? AND group_id = ? AND group_member_id = ?
|
||||
|]
|
||||
(contactId, currentTs, userId, groupId, groupMemberId)
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE contacts
|
||||
SET local_display_name = ?, contact_profile_id = ?, updated_at = ?
|
||||
WHERE user_id = ? AND contact_id = ?
|
||||
|]
|
||||
(memLDN, memProfileId, currentTs, userId, contactId)
|
||||
when (profileId /= memProfileId) $ deleteUnusedProfile_ db userId profileId
|
||||
when (localDisplayName /= memLDN) $ deleteUnusedDisplayName_ db userId localDisplayName
|
||||
getContact db user contactId
|
||||
|
||||
deleteUnusedDisplayName_ :: DB.Connection -> UserId -> ContactName -> IO ()
|
||||
deleteUnusedDisplayName_ db userId localDisplayName =
|
||||
DB.executeNamed
|
||||
@ -1402,6 +1444,12 @@ deleteUnusedDisplayName_ db userId localDisplayName =
|
||||
|]
|
||||
[":user_id" := userId, ":local_display_name" := localDisplayName]
|
||||
|
||||
deleteOldProbes :: DB.Connection -> UTCTime -> IO ()
|
||||
deleteOldProbes db createdAtCutoff = do
|
||||
DB.execute db "DELETE FROM sent_probes WHERE created_at <= ?" (Only createdAtCutoff)
|
||||
DB.execute db "DELETE FROM sent_probe_hashes WHERE created_at <= ?" (Only createdAtCutoff)
|
||||
DB.execute db "DELETE FROM received_probes WHERE created_at <= ?" (Only createdAtCutoff)
|
||||
|
||||
updateGroupSettings :: DB.Connection -> User -> Int64 -> ChatSettings -> IO ()
|
||||
updateGroupSettings db User {userId} groupId ChatSettings {enableNtfs, sendRcpts, favorite} =
|
||||
DB.execute db "UPDATE groups SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND group_id = ?" (enableNtfs, sendRcpts, favorite, userId, groupId)
|
||||
@ -1506,15 +1554,15 @@ createMemberContact
|
||||
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,
|
||||
user_id, agent_conn_id, conn_req_inv, conn_level, conn_status, conn_type, contact_conn_initiated, contact_id, custom_user_profile_id,
|
||||
peer_chat_min_version, peer_chat_max_version, created_at, updated_at, to_subscribe
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (userId, acId, cReq, connLevel, ConnNew, ConnContact, contactId, customUserProfileId)
|
||||
( (userId, acId, cReq, connLevel, ConnNew, ConnContact, True, 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}
|
||||
let ctConn = Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType = ConnContact, contactConnInitiated = True, 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, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False}
|
||||
|
||||
@ -1617,9 +1665,9 @@ createMemberContactConn_
|
||||
peer_chat_min_version, peer_chat_max_version, created_at, updated_at, to_subscribe
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (userId, acId, connLevel, ConnNew, ConnContact, contactId, customUserProfileId)
|
||||
( (userId, acId, connLevel, ConnJoined, 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}
|
||||
pure Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType = ConnContact, contactConnInitiated = False, entityId = Just contactId, viaContact = Nothing, viaUserContactLink = Nothing, viaGroupLink = False, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnJoined, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}
|
||||
|
||||
@ -477,7 +477,7 @@ getDirectChatPreviews_ db user@User {userId} = do
|
||||
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.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.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,
|
||||
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,
|
||||
-- ChatStats
|
||||
@ -513,10 +513,11 @@ getDirectChatPreviews_ db user@User {userId} = do
|
||||
SELECT cc_connection_id FROM (
|
||||
SELECT
|
||||
cc.connection_id AS cc_connection_id,
|
||||
cc.created_at AS cc_created_at,
|
||||
(CASE WHEN cc.conn_status = ? OR cc.conn_status = ? THEN 1 ELSE 0 END) AS cc_conn_status_ord
|
||||
FROM connections cc
|
||||
WHERE cc.user_id = ct.user_id AND cc.contact_id = ct.contact_id
|
||||
ORDER BY cc_conn_status_ord DESC, cc_connection_id DESC
|
||||
ORDER BY cc_conn_status_ord DESC, cc_created_at DESC
|
||||
LIMIT 1
|
||||
)
|
||||
)
|
||||
|
||||
@ -82,6 +82,7 @@ import Simplex.Chat.Migrations.M20230903_connections_to_subscribe
|
||||
import Simplex.Chat.Migrations.M20230913_member_contacts
|
||||
import Simplex.Chat.Migrations.M20230914_member_probes
|
||||
import Simplex.Chat.Migrations.M20230926_contact_status
|
||||
import Simplex.Chat.Migrations.M20231002_conn_initiated
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@ -163,7 +164,8 @@ schemaMigrations =
|
||||
("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),
|
||||
("20230914_member_probes", m20230914_member_probes, Just down_m20230914_member_probes),
|
||||
("20230926_contact_status", m20230926_contact_status, Just down_m20230926_contact_status)
|
||||
("20230926_contact_status", m20230926_contact_status, Just down_m20230926_contact_status),
|
||||
("20231002_conn_initiated", m20231002_conn_initiated, Just down_m20231002_conn_initiated)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@ -316,7 +316,7 @@ getUserAddressConnections db User {userId} = do
|
||||
db
|
||||
[sql|
|
||||
SELECT 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.conn_status, c.conn_type, c.contact_conn_initiated, 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
|
||||
FROM connections c
|
||||
JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id
|
||||
@ -331,7 +331,7 @@ getUserContactLinks db User {userId} =
|
||||
db
|
||||
[sql|
|
||||
SELECT 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.conn_status, c.conn_type, c.contact_conn_initiated, 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,
|
||||
uc.user_contact_link_id, uc.conn_req_contact, uc.group_id
|
||||
FROM connections c
|
||||
|
||||
@ -137,16 +137,16 @@ toFileInfo (fileId, fileStatus, filePath) = CIFileInfo {fileId, fileStatus, file
|
||||
|
||||
type EntityIdsRow = (Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64)
|
||||
|
||||
type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, Bool, Maybe GroupLinkId, Maybe Int64, ConnStatus, ConnType, LocalAlias) :. EntityIdsRow :. (UTCTime, Maybe Text, Maybe UTCTime, Int, Version, Version)
|
||||
type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, Bool, Maybe GroupLinkId, Maybe Int64, ConnStatus, ConnType, Bool, LocalAlias) :. EntityIdsRow :. (UTCTime, Maybe Text, Maybe UTCTime, Int, Version, Version)
|
||||
|
||||
type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe Int64, Maybe Bool, Maybe GroupLinkId, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe LocalAlias) :. EntityIdsRow :. (Maybe UTCTime, Maybe Text, Maybe UTCTime, Maybe Int, Maybe Version, Maybe Version)
|
||||
type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe Int64, Maybe Bool, Maybe GroupLinkId, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Bool, Maybe LocalAlias) :. EntityIdsRow :. (Maybe UTCTime, Maybe Text, Maybe UTCTime, Maybe Int, Maybe Version, Maybe Version)
|
||||
|
||||
toConnection :: ConnectionRow -> Connection
|
||||
toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, authErrCounter, minVer, maxVer)) =
|
||||
toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, authErrCounter, minVer, maxVer)) =
|
||||
let entityId = entityId_ connType
|
||||
connectionCode = SecurityCode <$> code_ <*> verifiedAt_
|
||||
peerChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
|
||||
in Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, localAlias, entityId, connectionCode, authErrCounter, createdAt}
|
||||
in Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias, entityId, connectionCode, authErrCounter, createdAt}
|
||||
where
|
||||
entityId_ :: ConnType -> Maybe Int64
|
||||
entityId_ ConnContact = contactId
|
||||
@ -156,8 +156,8 @@ toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroup
|
||||
entityId_ ConnUserContact = userContactLinkId
|
||||
|
||||
toMaybeConnection :: MaybeConnectionRow -> Maybe Connection
|
||||
toMaybeConnection ((Just connId, Just agentConnId, Just connLevel, viaContact, viaUserContactLink, Just viaGroupLink, groupLinkId, customUserProfileId, Just connStatus, Just connType, Just localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (Just createdAt, code_, verifiedAt_, Just authErrCounter, Just minVer, Just maxVer)) =
|
||||
Just $ toConnection ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, authErrCounter, minVer, maxVer))
|
||||
toMaybeConnection ((Just connId, Just agentConnId, Just connLevel, viaContact, viaUserContactLink, Just viaGroupLink, groupLinkId, customUserProfileId, Just connStatus, Just connType, Just contactConnInitiated, Just localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (Just createdAt, code_, verifiedAt_, Just authErrCounter, Just minVer, Just maxVer)) =
|
||||
Just $ toConnection ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, authErrCounter, minVer, maxVer))
|
||||
toMaybeConnection _ = Nothing
|
||||
|
||||
createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> VersionRange -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> SubscriptionMode -> IO Connection
|
||||
@ -179,7 +179,7 @@ createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange
|
||||
:. (minV, maxV, subMode == SMOnlyCreate)
|
||||
)
|
||||
connId <- insertedRowId db
|
||||
pure Connection {connId, agentConnId = AgentConnId acId, peerChatVRange = JVersionRange peerChatVRange, connType, entityId, viaContact, viaUserContactLink, viaGroupLink, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}
|
||||
pure Connection {connId, agentConnId = AgentConnId acId, peerChatVRange = JVersionRange peerChatVRange, connType, contactConnInitiated = False, entityId, viaContact, viaUserContactLink, viaGroupLink, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}
|
||||
where
|
||||
ent ct = if connType == ct then entityId else Nothing
|
||||
|
||||
|
||||
@ -242,18 +242,18 @@ data ContactRef = ContactRef
|
||||
|
||||
instance ToJSON ContactRef where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
data ContactOrGroupMember = CGMContact Contact | CGMGroupMember GroupInfo GroupMember
|
||||
data ContactOrMember = COMContact Contact | COMGroupMember GroupMember
|
||||
deriving (Show)
|
||||
|
||||
contactOrGroupMemberIds :: ContactOrGroupMember -> (Maybe ContactId, Maybe GroupMemberId)
|
||||
contactOrGroupMemberIds = \case
|
||||
CGMContact Contact {contactId} -> (Just contactId, Nothing)
|
||||
CGMGroupMember _ GroupMember {groupMemberId} -> (Nothing, Just groupMemberId)
|
||||
contactOrMemberIds :: ContactOrMember -> (Maybe ContactId, Maybe GroupMemberId)
|
||||
contactOrMemberIds = \case
|
||||
COMContact Contact {contactId} -> (Just contactId, Nothing)
|
||||
COMGroupMember GroupMember {groupMemberId} -> (Nothing, Just groupMemberId)
|
||||
|
||||
contactOrGroupMemberIncognito :: ContactOrGroupMember -> IncognitoEnabled
|
||||
contactOrGroupMemberIncognito = \case
|
||||
CGMContact ct -> contactConnIncognito ct
|
||||
CGMGroupMember _ m -> memberIncognito m
|
||||
contactOrMemberIncognito :: ContactOrMember -> IncognitoEnabled
|
||||
contactOrMemberIncognito = \case
|
||||
COMContact ct -> contactConnIncognito ct
|
||||
COMGroupMember m -> memberIncognito m
|
||||
|
||||
data UserContact = UserContact
|
||||
{ userContactLinkId :: Int64,
|
||||
@ -1233,6 +1233,7 @@ data Connection = Connection
|
||||
customUserProfileId :: Maybe Int64,
|
||||
connType :: ConnType,
|
||||
connStatus :: ConnStatus,
|
||||
contactConnInitiated :: Bool,
|
||||
localAlias :: Text,
|
||||
entityId :: Maybe Int64, -- contact, group member, file ID or user contact ID
|
||||
connectionCode :: Maybe SecurityCode,
|
||||
|
||||
@ -174,7 +174,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
|
||||
CRContactAliasUpdated u c -> ttyUser u $ viewContactAliasUpdated c
|
||||
CRConnectionAliasUpdated u c -> ttyUser u $ viewConnectionAliasUpdated c
|
||||
CRContactUpdated {user = u, fromContact = c, toContact = c'} -> ttyUser u $ viewContactUpdated c c' <> viewContactPrefsUpdated u c c'
|
||||
CRContactsMerged u intoCt mergedCt -> ttyUser u $ viewContactsMerged intoCt mergedCt
|
||||
CRContactsMerged u intoCt mergedCt ct' -> ttyUser u $ viewContactsMerged intoCt mergedCt ct'
|
||||
CRReceivedContactRequest u UserContactRequest {localDisplayName = c, profile} -> ttyUser u $ viewReceivedContactRequest c profile
|
||||
CRRcvFileStart u ci -> ttyUser u $ receivingFile_' "started" ci
|
||||
CRRcvFileComplete u ci -> ttyUser u $ receivingFile_' "completed" ci
|
||||
@ -235,7 +235,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
|
||||
CRNewMemberContact u _ g m -> ttyUser u ["contact for member " <> ttyGroup' g <> " " <> ttyMember m <> " is created"]
|
||||
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"]
|
||||
CRMemberContactConnected u ct g m -> ttyUser u ["member " <> ttyGroup' g <> " " <> ttyMember m <> " is merged into " <> ttyContact' ct]
|
||||
CRContactAndMemberAssociated u ct g m ct' -> ttyUser u $ viewContactAndMemberAssociated ct g m ct'
|
||||
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
|
||||
@ -886,10 +886,16 @@ groupInvitation' g@GroupInfo {localDisplayName = ldn, groupProfile = GroupProfil
|
||||
Just mp -> " to join as " <> incognitoProfile' (fromLocalProfile mp) <> ", "
|
||||
Nothing -> " to join, "
|
||||
|
||||
viewContactsMerged :: Contact -> Contact -> [StyledString]
|
||||
viewContactsMerged c1 c2 =
|
||||
viewContactsMerged :: Contact -> Contact -> Contact -> [StyledString]
|
||||
viewContactsMerged c1 c2 ct' =
|
||||
[ "contact " <> ttyContact' c2 <> " is merged into " <> ttyContact' c1,
|
||||
"use " <> ttyToContact' c1 <> highlight' "<message>" <> " to send messages"
|
||||
"use " <> ttyToContact' ct' <> highlight' "<message>" <> " to send messages"
|
||||
]
|
||||
|
||||
viewContactAndMemberAssociated :: Contact -> GroupInfo -> GroupMember -> Contact -> [StyledString]
|
||||
viewContactAndMemberAssociated ct g m ct' =
|
||||
[ "contact and member are merged: " <> ttyContact' ct <> ", " <> ttyGroup' g <> " " <> ttyMember m,
|
||||
"use " <> ttyToContact' ct' <> highlight' "<message>" <> " to send messages"
|
||||
]
|
||||
|
||||
viewUserProfile :: Profile -> [StyledString]
|
||||
|
||||
@ -29,7 +29,8 @@ import Test.Hspec
|
||||
chatDirectTests :: SpecWith FilePath
|
||||
chatDirectTests = do
|
||||
describe "direct messages" $ do
|
||||
describe "add contact and send/receive message" testAddContact
|
||||
describe "add contact and send/receive messages" testAddContact
|
||||
it "clear chat with contact" testContactClear
|
||||
it "deleting contact deletes profile" testDeleteContactDeletesProfile
|
||||
it "unused contact is deleted silently" testDeleteUnusedContactSilent
|
||||
it "direct message quoted replies" testDirectMessageQuotedReply
|
||||
@ -40,6 +41,9 @@ chatDirectTests = do
|
||||
it "direct timed message" testDirectTimedMessage
|
||||
it "repeat AUTH errors disable contact" testRepeatAuthErrorsDisableContact
|
||||
it "should send multiline message" testMultilineMessage
|
||||
describe "duplicate contacts" $ do
|
||||
it "duplicate contacts are separate (contacts don't merge)" testDuplicateContactsSeparate
|
||||
it "new contact is separate with multiple duplicate contacts (contacts don't merge)" testDuplicateContactsMultipleSeparate
|
||||
describe "SMP servers" $ do
|
||||
it "get and set SMP servers" testGetSetSMPServers
|
||||
it "test SMP server connection" testTestSMPServerConnection
|
||||
@ -140,35 +144,6 @@ testAddContact = versionTestMatrix2 runTestAddContact
|
||||
bob #> "@alice how are you?"
|
||||
alice <# "bob> how are you?"
|
||||
chatsManyMessages alice bob
|
||||
-- test adding the same contact one more time - local name will be different
|
||||
alice ##> "/c"
|
||||
inv' <- getInvitation alice
|
||||
bob ##> ("/c " <> inv')
|
||||
bob <## "confirmation sent!"
|
||||
concurrently_
|
||||
(bob <## "alice_1 (Alice): contact is connected")
|
||||
(alice <## "bob_1 (Bob): contact is connected")
|
||||
alice #> "@bob_1 hello"
|
||||
bob <# "alice_1> hello"
|
||||
bob #> "@alice_1 hi"
|
||||
alice <# "bob_1> hi"
|
||||
alice @@@ [("@bob_1", "hi"), ("@bob", "how are you?")]
|
||||
bob @@@ [("@alice_1", "hi"), ("@alice", "how are you?")]
|
||||
-- test deleting contact
|
||||
alice ##> "/d bob_1"
|
||||
alice <## "bob_1: contact is deleted"
|
||||
bob <## "alice_1 (Alice) deleted contact with you"
|
||||
alice ##> "@bob_1 hey"
|
||||
alice <## "no contact bob_1"
|
||||
alice @@@ [("@bob", "how are you?")]
|
||||
alice `hasContactProfiles` ["alice", "bob"]
|
||||
bob @@@ [("@alice_1", "contact deleted"), ("@alice", "how are you?")]
|
||||
bob `hasContactProfiles` ["alice", "alice", "bob"]
|
||||
-- test clearing chat
|
||||
alice #$> ("/clear bob", id, "bob: all messages are removed locally ONLY")
|
||||
alice #$> ("/_get chat @2 count=100", chat, [])
|
||||
bob #$> ("/clear alice", id, "alice: all messages are removed locally ONLY")
|
||||
bob #$> ("/_get chat @2 count=100", chat, [])
|
||||
chatsEmpty alice bob = do
|
||||
alice @@@ [("@bob", lastChatFeature)]
|
||||
alice #$> ("/_get chat @2 count=100", chat, chatFeatures)
|
||||
@ -195,6 +170,84 @@ testAddContact = versionTestMatrix2 runTestAddContact
|
||||
alice #$> ("/_read chat @2", id, "ok")
|
||||
bob #$> ("/_read chat @2", id, "ok")
|
||||
|
||||
testDuplicateContactsSeparate :: HasCallStack => FilePath -> IO ()
|
||||
testDuplicateContactsSeparate =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
connectUsers alice bob
|
||||
alice <##> bob
|
||||
|
||||
alice ##> "/c"
|
||||
inv' <- getInvitation alice
|
||||
bob ##> ("/c " <> inv')
|
||||
bob <## "confirmation sent!"
|
||||
concurrently_
|
||||
(alice <## "bob_1 (Bob): contact is connected")
|
||||
(bob <## "alice_1 (Alice): contact is connected")
|
||||
|
||||
alice <##> bob
|
||||
alice #> "@bob_1 1"
|
||||
bob <# "alice_1> 1"
|
||||
bob #> "@alice_1 2"
|
||||
alice <# "bob_1> 2"
|
||||
|
||||
alice @@@ [("@bob", "hey"), ("@bob_1", "2")]
|
||||
alice `hasContactProfiles` ["alice", "bob", "bob"]
|
||||
bob @@@ [("@alice", "hey"), ("@alice_1", "2")]
|
||||
bob `hasContactProfiles` ["bob", "alice", "alice"]
|
||||
|
||||
testDuplicateContactsMultipleSeparate :: HasCallStack => FilePath -> IO ()
|
||||
testDuplicateContactsMultipleSeparate =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
connectUsers alice bob
|
||||
alice <##> bob
|
||||
|
||||
alice ##> "/c"
|
||||
inv' <- getInvitation alice
|
||||
bob ##> ("/c " <> inv')
|
||||
bob <## "confirmation sent!"
|
||||
concurrently_
|
||||
(alice <## "bob_1 (Bob): contact is connected")
|
||||
(bob <## "alice_1 (Alice): contact is connected")
|
||||
|
||||
alice ##> "/c"
|
||||
inv'' <- getInvitation alice
|
||||
bob ##> ("/c " <> inv'')
|
||||
bob <## "confirmation sent!"
|
||||
concurrently_
|
||||
(alice <## "bob_2 (Bob): contact is connected")
|
||||
(bob <## "alice_2 (Alice): contact is connected")
|
||||
|
||||
alice <##> bob
|
||||
alice #> "@bob_1 1"
|
||||
bob <# "alice_1> 1"
|
||||
bob #> "@alice_1 2"
|
||||
alice <# "bob_1> 2"
|
||||
alice #> "@bob_2 3"
|
||||
bob <# "alice_2> 3"
|
||||
bob #> "@alice_2 4"
|
||||
alice <# "bob_2> 4"
|
||||
|
||||
alice ##> "/contacts"
|
||||
alice <### ["bob (Bob)", "bob_1 (Bob)", "bob_2 (Bob)"]
|
||||
bob ##> "/contacts"
|
||||
bob <### ["alice (Alice)", "alice_1 (Alice)", "alice_2 (Alice)"]
|
||||
alice `hasContactProfiles` ["alice", "bob", "bob", "bob"]
|
||||
bob `hasContactProfiles` ["bob", "alice", "alice", "alice"]
|
||||
|
||||
testContactClear :: HasCallStack => FilePath -> IO ()
|
||||
testContactClear =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
\alice bob -> do
|
||||
connectUsers alice bob
|
||||
alice <##> bob
|
||||
threadDelay 500000
|
||||
alice #$> ("/clear bob", id, "bob: all messages are removed locally ONLY")
|
||||
alice #$> ("/_get chat @2 count=100", chat, [])
|
||||
bob #$> ("/clear alice", id, "alice: all messages are removed locally ONLY")
|
||||
bob #$> ("/_get chat @2 count=100", chat, [])
|
||||
|
||||
testDeleteContactDeletesProfile :: HasCallStack => FilePath -> IO ()
|
||||
testDeleteContactDeletesProfile =
|
||||
testChat2 aliceProfile bobProfile $
|
||||
@ -2104,7 +2157,7 @@ testMsgDecryptError tmp =
|
||||
withTestChat tmp "bob" $ \bob -> do
|
||||
bob <## "1 contacts connected (use /cs for the list)"
|
||||
alice #> "@bob hello again"
|
||||
bob <# "alice> skipped message ID 9..11"
|
||||
bob <# "alice> skipped message ID 10..12"
|
||||
bob <# "alice> hello again"
|
||||
bob #> "@alice received!"
|
||||
alice <# "bob> received!"
|
||||
|
||||
@ -73,7 +73,11 @@ chatGroupTests = do
|
||||
testNoDirect _1 _0 False
|
||||
testNoDirect _1 _1 False
|
||||
it "members have different local display names in different groups" testNoDirectDifferentLDNs
|
||||
it "member should connect to contact when profile match" testConnectMemberToContact
|
||||
describe "merge members and contacts" $ do
|
||||
it "new member should merge with existing contact" testMergeMemberExistingContact
|
||||
it "new contact should merge with existing member" testMergeContactExistingMember
|
||||
it "new contact should merge with multiple existing members" testMergeContactMultipleMembers
|
||||
it "new group link host contact should merge with single existing contact out of multiple" testMergeGroupLinkHostMultipleContacts
|
||||
describe "create member contact" $ do
|
||||
it "create contact with group member with invitation message" testMemberContactMessage
|
||||
it "create contact with group member without invitation message" testMemberContactNoMessage
|
||||
@ -2734,8 +2738,8 @@ testNoDirectDifferentLDNs =
|
||||
bob <# ("#" <> gName <> " " <> cathLDN <> "> hey")
|
||||
]
|
||||
|
||||
testConnectMemberToContact :: HasCallStack => FilePath -> IO ()
|
||||
testConnectMemberToContact =
|
||||
testMergeMemberExistingContact :: HasCallStack => FilePath -> IO ()
|
||||
testMergeMemberExistingContact =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
connectUsers alice bob
|
||||
@ -2750,13 +2754,15 @@ testConnectMemberToContact =
|
||||
[ do
|
||||
alice <## "#team: you joined the group"
|
||||
alice <## "#team: member cath_1 (Catherine) is connected"
|
||||
alice <## "member #team cath_1 is merged into cath",
|
||||
alice <## "contact and member are merged: cath, #team cath_1"
|
||||
alice <## "use @cath <message> to send messages",
|
||||
do
|
||||
bob <## "#team: alice joined the group",
|
||||
do
|
||||
cath <## "#team: bob added alice_1 (Alice) to the group (connecting...)"
|
||||
cath <## "#team: new member alice_1 is connected"
|
||||
cath <## "member #team alice_1 is merged into alice"
|
||||
cath <## "contact and member are merged: alice, #team alice_1"
|
||||
cath <## "use @alice <message> to send messages"
|
||||
]
|
||||
alice <##> cath
|
||||
alice #> "#team hello"
|
||||
@ -2779,6 +2785,124 @@ testConnectMemberToContact =
|
||||
alice `hasContactProfiles` ["alice", "bob", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "alice", "bob"]
|
||||
|
||||
testMergeContactExistingMember :: HasCallStack => FilePath -> IO ()
|
||||
testMergeContactExistingMember =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
|
||||
bob ##> "/c"
|
||||
inv' <- getInvitation bob
|
||||
cath ##> ("/c " <> inv')
|
||||
cath <## "confirmation sent!"
|
||||
concurrentlyN_
|
||||
[ bob
|
||||
<### [ "cath_1 (Catherine): contact is connected",
|
||||
"contact and member are merged: cath_1, #team cath",
|
||||
"use @cath <message> to send messages"
|
||||
],
|
||||
cath
|
||||
<### [ "bob_1 (Bob): contact is connected",
|
||||
"contact and member are merged: bob_1, #team bob",
|
||||
"use @bob <message> to send messages"
|
||||
]
|
||||
]
|
||||
bob <##> cath
|
||||
|
||||
bob ##> "/contacts"
|
||||
bob <### ["alice (Alice)", "cath (Catherine)"]
|
||||
cath ##> "/contacts"
|
||||
cath <### ["alice (Alice)", "bob (Bob)"]
|
||||
bob `hasContactProfiles` ["alice", "bob", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "alice", "bob"]
|
||||
|
||||
testMergeContactMultipleMembers :: HasCallStack => FilePath -> IO ()
|
||||
testMergeContactMultipleMembers =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
\alice bob cath -> do
|
||||
create2Groups3 "team" "club" alice bob cath
|
||||
|
||||
bob `hasContactProfiles` ["alice", "bob", "cath", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "alice", "bob", "bob"]
|
||||
|
||||
bob ##> "/c"
|
||||
inv' <- getInvitation bob
|
||||
cath ##> ("/c " <> inv')
|
||||
cath <## "confirmation sent!"
|
||||
concurrentlyN_
|
||||
[ bob
|
||||
<### [ "cath_2 (Catherine): contact is connected",
|
||||
StartsWith "contact and member are merged: cath",
|
||||
StartsWith "use @cath",
|
||||
StartsWith "contact and member are merged: cath",
|
||||
StartsWith "use @cath"
|
||||
],
|
||||
cath
|
||||
<### [ "bob_2 (Bob): contact is connected",
|
||||
StartsWith "contact and member are merged: bob",
|
||||
StartsWith "use @bob",
|
||||
StartsWith "contact and member are merged: bob",
|
||||
StartsWith "use @bob"
|
||||
]
|
||||
]
|
||||
bob <##> cath
|
||||
|
||||
bob ##> "/contacts"
|
||||
bob <### ["alice (Alice)", "cath (Catherine)"]
|
||||
cath ##> "/contacts"
|
||||
cath <### ["alice (Alice)", "bob (Bob)"]
|
||||
bob `hasContactProfiles` ["alice", "bob", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "alice", "bob"]
|
||||
|
||||
testMergeGroupLinkHostMultipleContacts :: HasCallStack => FilePath -> IO ()
|
||||
testMergeGroupLinkHostMultipleContacts =
|
||||
testChat2 bobProfile cathProfile $
|
||||
\bob cath -> do
|
||||
connectUsers bob cath
|
||||
|
||||
bob ##> "/c"
|
||||
inv' <- getInvitation bob
|
||||
cath ##> ("/c " <> inv')
|
||||
cath <## "confirmation sent!"
|
||||
concurrently_
|
||||
(bob <## "cath_1 (Catherine): contact is connected")
|
||||
(cath <## "bob_1 (Bob): contact is connected")
|
||||
|
||||
bob `hasContactProfiles` ["bob", "cath", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "bob", "bob"]
|
||||
|
||||
bob ##> "/g party"
|
||||
bob <## "group #party is created"
|
||||
bob <## "to add members use /a party <name> or /create link #party"
|
||||
bob ##> "/create link #party"
|
||||
gLink <- getGroupLink bob "party" GRMember True
|
||||
cath ##> ("/c " <> gLink)
|
||||
cath <## "connection request sent!"
|
||||
bob <## "cath_2 (Catherine): accepting request to join group #party..."
|
||||
concurrentlyN_
|
||||
[ bob
|
||||
<### [ "cath_2 (Catherine): contact is connected",
|
||||
EndsWith "invited to group #party via your group link",
|
||||
EndsWith "joined the group",
|
||||
StartsWith "contact cath_2 is merged into cath",
|
||||
StartsWith "use @cath"
|
||||
],
|
||||
cath
|
||||
<### [ "bob_2 (Bob): contact is connected",
|
||||
"#party: you joined the group",
|
||||
StartsWith "contact bob_2 is merged into bob",
|
||||
StartsWith "use @bob"
|
||||
]
|
||||
]
|
||||
bob <##> cath
|
||||
|
||||
bob ##> "/contacts"
|
||||
bob <### ["cath (Catherine)", "cath_1 (Catherine)"]
|
||||
cath ##> "/contacts"
|
||||
cath <### ["bob (Bob)", "bob_1 (Bob)"]
|
||||
bob `hasContactProfiles` ["bob", "cath", "cath"]
|
||||
cath `hasContactProfiles` ["cath", "bob", "bob"]
|
||||
|
||||
testMemberContactMessage :: HasCallStack => FilePath -> IO ()
|
||||
testMemberContactMessage =
|
||||
testChat3 aliceProfile bobProfile cathProfile $
|
||||
|
||||
@ -277,7 +277,7 @@ cc <##.. ls = do
|
||||
unless prefix $ print ("expected to start from one of: " <> show ls, ", got: " <> l)
|
||||
prefix `shouldBe` True
|
||||
|
||||
data ConsoleResponse = ConsoleString String | WithTime String | EndsWith String
|
||||
data ConsoleResponse = ConsoleString String | WithTime String | EndsWith String | StartsWith String
|
||||
deriving (Show)
|
||||
|
||||
instance IsString ConsoleResponse where fromString = ConsoleString
|
||||
@ -287,7 +287,7 @@ getInAnyOrder :: HasCallStack => (String -> String) -> TestCC -> [ConsoleRespons
|
||||
getInAnyOrder _ _ [] = pure ()
|
||||
getInAnyOrder f cc ls = do
|
||||
line <- f <$> getTermLine cc
|
||||
let rest = filter (not . expected line) ls
|
||||
let rest = filterFirst (expected line) ls
|
||||
if length rest < length ls
|
||||
then getInAnyOrder f cc rest
|
||||
else error $ "unexpected output: " <> line
|
||||
@ -297,6 +297,12 @@ getInAnyOrder f cc ls = do
|
||||
ConsoleString s -> l == s
|
||||
WithTime s -> dropTime_ l == Just s
|
||||
EndsWith s -> s `isSuffixOf` l
|
||||
StartsWith s -> s `isPrefixOf` l
|
||||
filterFirst :: (a -> Bool) -> [a] -> [a]
|
||||
filterFirst _ [] = []
|
||||
filterFirst p (x:xs)
|
||||
| p x = xs
|
||||
| otherwise = x : filterFirst p xs
|
||||
|
||||
(<###) :: HasCallStack => TestCC -> [ConsoleResponse] -> Expectation
|
||||
(<###) = getInAnyOrder id
|
||||
@ -456,8 +462,11 @@ showName (TestCC ChatController {currentUser} _ _ _ _ _) = do
|
||||
pure . T.unpack $ localDisplayName <> optionalFullName localDisplayName fullName
|
||||
|
||||
createGroup2 :: HasCallStack => String -> TestCC -> TestCC -> IO ()
|
||||
createGroup2 gName cc1 cc2 = do
|
||||
connectUsers cc1 cc2
|
||||
createGroup2 gName cc1 cc2 = createGroup2' gName cc1 cc2 True
|
||||
|
||||
createGroup2' :: HasCallStack => String -> TestCC -> TestCC -> Bool -> IO ()
|
||||
createGroup2' gName cc1 cc2 doConnectUsers = do
|
||||
when doConnectUsers $ connectUsers cc1 cc2
|
||||
name2 <- userName cc2
|
||||
cc1 ##> ("/g " <> gName)
|
||||
cc1 <## ("group #" <> gName <> " is created")
|
||||
@ -488,6 +497,24 @@ createGroup3 gName cc1 cc2 cc3 = do
|
||||
cc2 <## ("#" <> gName <> ": new member " <> name3 <> " is connected")
|
||||
]
|
||||
|
||||
create2Groups3 :: HasCallStack => String -> String -> TestCC -> TestCC -> TestCC -> IO ()
|
||||
create2Groups3 gName1 gName2 cc1 cc2 cc3 = do
|
||||
createGroup3 gName1 cc1 cc2 cc3
|
||||
createGroup2' gName2 cc1 cc2 False
|
||||
name1 <- userName cc1
|
||||
name3 <- userName cc3
|
||||
addMember gName2 cc1 cc3 GRAdmin
|
||||
cc3 ##> ("/j " <> gName2)
|
||||
concurrentlyN_
|
||||
[ cc1 <## ("#" <> gName2 <> ": " <> name3 <> " joined the group"),
|
||||
do
|
||||
cc3 <## ("#" <> gName2 <> ": you joined the group")
|
||||
cc3 <##. ("#" <> gName2 <> ": member "), -- "#gName2: member sName2 is connected"
|
||||
do
|
||||
cc2 <##. ("#" <> gName2 <> ": " <> name1 <> " added ") -- "#gName2: name1 added sName3 to the group (connecting...)"
|
||||
cc2 <##. ("#" <> gName2 <> ": new member ") -- "#gName2: new member name3 is connected"
|
||||
]
|
||||
|
||||
addMember :: HasCallStack => String -> TestCC -> TestCC -> GroupMemberRole -> IO ()
|
||||
addMember gName = fullAddMember gName ""
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user