From d474cae70559eaec11a9867bb1348bedb41abe2a Mon Sep 17 00:00:00 2001 From: Stanislav Dmitrenko <7953703+avently@users.noreply.github.com> Date: Sun, 24 Dec 2023 07:15:31 +0800 Subject: [PATCH 01/10] ios: saving and sharing items menu item (#3581) * ios: saving and sharing items menu item * refactor --------- Co-authored-by: Avently Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> --- apps/ios/Shared/Views/Chat/ChatView.swift | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/apps/ios/Shared/Views/Chat/ChatView.swift b/apps/ios/Shared/Views/Chat/ChatView.swift index 4fb93ffe2..6e2c0c155 100644 --- a/apps/ios/Shared/Views/Chat/ChatView.swift +++ b/apps/ios/Shared/Views/Chat/ChatView.swift @@ -723,9 +723,14 @@ struct ChatView: View { if ci.meta.itemDeleted == nil && !ci.isLiveDummy && !live { menu.append(replyUIAction(ci)) } - menu.append(shareUIAction(ci)) - menu.append(copyUIAction(ci)) - if let fileSource = getLoadedFileSource(ci.file) { + let fileSource = getLoadedFileSource(ci.file) + let fileExists = if let fs = fileSource, FileManager.default.fileExists(atPath: getAppFilePath(fs.filePath).path) { true } else { false } + let copyAndShareAllowed = !ci.content.text.isEmpty || (ci.content.msgContent?.isImage == true && fileExists) + if copyAndShareAllowed { + menu.append(shareUIAction(ci)) + menu.append(copyUIAction(ci)) + } + if let fileSource = fileSource, fileExists { if case .image = ci.content.msgContent, let image = getLoadedImage(ci.file) { if image.imageData != nil { menu.append(saveFileAction(fileSource)) From 700f6fa6639a511abbefef634df821ac5751e22c Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Sun, 24 Dec 2023 15:13:34 +0400 Subject: [PATCH 02/10] core, docs: drop message views if they exist, remove mentions in docs (#3589) * core, docs: drop message views if they exist, remove mentions in docs * fix migration --- docs/ANDROID.md | 13 ++- docs/CLI.md | 34 ------ docs/SQL.md | 60 ---------- docs/lang/cs/ANDROID.md | 13 ++- docs/lang/cs/CLI.md | 34 ------ docs/lang/cs/SQL.md | 59 ---------- docs/lang/fr/ANDROID.md | 13 ++- docs/lang/fr/CLI.md | 34 ------ docs/lang/fr/SQL.md | 59 ---------- scripts/message_views.sql | 110 ------------------ .../M20231215_recreate_msg_deliveries.hs | 7 ++ website/src/_data/docs_sidebar.json | 1 - 12 files changed, 43 insertions(+), 394 deletions(-) delete mode 100644 docs/SQL.md delete mode 100644 docs/lang/cs/SQL.md delete mode 100644 docs/lang/fr/SQL.md delete mode 100644 scripts/message_views.sql diff --git a/docs/ANDROID.md b/docs/ANDROID.md index 55e6ef976..fa8921c82 100644 --- a/docs/ANDROID.md +++ b/docs/ANDROID.md @@ -20,6 +20,7 @@ If you want to view what's stored inside SimpleX data directory you need to have - your device connected via USB or Wi-Fi to the computer. ## The process: + - open SimpleX, go to `Database passphrase & export`, enable `App data backup`. This will make other steps working - _optional_: if you want to view database contents, change database passphrase from random to yours. To do this, stop a chat in `Database passphrase & export` screen, open `Database passphrase`, enter new passphrase and confirm it, then update it. Do not forget it, otherwise you'll lose all your data in case passphrase will be asked again later - open a terminal emulator (Windows CMD/Powershell will not work) and change directory to the one you want to use for storing the backup: @@ -43,4 +44,14 @@ Now the backed-up files will be inside `./apps/chat.simplex.app/`. Please, note, that if you use a modern version of SimpleX, the databases will be encrypted, and you'll not be able to view contents of them without using `sqlcipher` application and without knowing decryption passphrase (you need to change it to yours from randomly generated in the app firstly). -Please, follow [SQL.md](./SQL.md) guide for more info of how to decrypt your databases and to make queries to them. +## Decrypting databases + +In order to view database data you need to decrypt it first. Install `sqlcipher` using your favorite package manager and run the following commands in the directory with databases: +```bash +sqlcipher files_chat.db +pragma key="youDecryptionPassphrase"; +# Ensure it works fine +select * from users; +``` + +If you see `Parse error: no such table: users`, make sure you entered correct passphrase, and you have changed passphrase from random in Android app (if you got this database from Android device, of course). diff --git a/docs/CLI.md b/docs/CLI.md index f781f8574..baf79bb3b 100644 --- a/docs/CLI.md +++ b/docs/CLI.md @@ -243,37 +243,3 @@ User address is "long-term" in a sense that it is a multiple-use connection link Use `/help address` for other commands. ![simplex-chat](../images/user-addresses.gif) - -### Access chat history - -SimpleX chat stores all your contacts and conversations in a local SQLite database, making it private and portable by design, owned and controlled by user. - -You can view and search your chat history by querying your database. Run the below script to create message views in your database. - -```sh -curl -o- https://raw.githubusercontent.com/simplex-chat/simplex-chat/stable/scripts/message_views.sql | sqlite3 ~/.simplex/simplex_v1_chat.db -``` - -Open SQLite Command Line Shell: - -```sh -sqlite3 ~/.simplex/simplex_v1_chat.db -``` - -See [Message queries](./SQL.md) for examples. - -> **Please note:** SQLite foreign key constraints are disabled by default, and must be **[enabled separately for each database connection](https://sqlite.org/foreignkeys.html#fk_enable)**. The latter can be achieved by running `PRAGMA foreign_keys = ON;` command on an open database connection. By running data altering queries without enabling foreign keys prior to that, you may risk putting your database in an inconsistent state. - -**Convenience queries** - -Get all messages from today (`chat_dt` is in UTC): - -```sql -select * from all_messages_plain where date(chat_dt) > date('now', '-1 day') order by chat_dt; -``` - -Get overnight messages in the morning: - -```sql -select * from all_messages_plain where chat_dt > datetime('now', '-15 hours') order by chat_dt; -``` diff --git a/docs/SQL.md b/docs/SQL.md deleted file mode 100644 index d5b469050..000000000 --- a/docs/SQL.md +++ /dev/null @@ -1,60 +0,0 @@ ---- -title: Accessing messages in the database -revision: 31.01.2023 ---- - -| Updated 31.01.2023 | Languages: EN, [FR](/docs/lang/fr/SQL.md), [CZ](/docs/lang/cs/SQL.md) | - -# Accessing messages in the database - -## Decrypting databases - -In order to view database data you need to decrypt it first. Install `sqlcipher` using your favorite package manager and run the following commands in the directory with databases: -```bash -sqlcipher files_chat.db -pragma key="youDecryptionPassphrase"; -# Ensure it works fine -select * from users; -``` - -If you see `Parse error: no such table: users`, make sure you entered correct passphrase, and you have changed passphrase from random in Android app (if you got this database from Android device, of course). - -## SQL queries - -You can run queries against `direct_messages`, `group_messages` and `all_messages` (or their simpler alternatives `direct_messages_plain`, `group_messages_plain` and `all_messages_plain`), for example: - -```sql --- you can put these or your preferred settings into ~/.sqliterc --- to persist across sqlite3 client sessions -.mode column -.headers on -.nullvalue NULL - --- simple views into direct, group and all_messages --- with user's messages deduplicated for group and all_messages; --- only 'x.msg.new' ("new message") chat events - filters out service events; --- msg_sent is 0 for received, 1 for sent -select * from direct_messages_plain; -select * from group_messages_plain; -select * from all_messages_plain; - --- query other details of your chat history with regular SQL, for example: --- files you offered for sending -select * from direct_messages where msg_sent = 1 and chat_msg_event = 'x.file'; --- everything catherine sent related to cats -select * from direct_messages where msg_sent = 0 and contact = 'catherine' and msg_body like '%cats%'; --- all correspondence with alice in #team -select * from group_messages where group_name = 'team' and contact = 'alice'; - --- aggregate your chat data -select contact_or_group, num_messages from ( - select - contact as contact_or_group, count(1) as num_messages - from direct_messages_plain group by contact - union - select - group_name as contact_or_group, count(1) as num_messages - from group_messages_plain group by group_name -) -order by num_messages desc; -``` diff --git a/docs/lang/cs/ANDROID.md b/docs/lang/cs/ANDROID.md index 38dd105bb..4edfc3018 100644 --- a/docs/lang/cs/ANDROID.md +++ b/docs/lang/cs/ANDROID.md @@ -19,6 +19,7 @@ Pokud chcete zobrazit, co je uloženo v datovém adresáři SimpleX, musíte mí - zařízení připojené přes USB nebo Wi-Fi k počítači. ## Postup: + - Otevřete SimpleX, přejděte na `Databáze passphrase & export`, povolte `Zálohování dat aplikace`. Tím se zprovozní další kroky - _Volitelné_: pokud chcete zobrazit obsah databáze, změňte přístupovou frázi databáze z náhodné na svou. Chcete-li to provést, zastavte chat na obrazovce `Database passphrase & export`, otevřete `Database passphrase`, zadejte novou passphrase a potvrďte ji, poté ji aktualizujte. Nezapomeňte ji, jinak přijdete o všechna svá data v případě, že bude passphrase později znovu požadována. - otevřete emulátor terminálu (Windows CMD/Powershell nebude fungovat) a změňte adresář na ten, který chcete použít pro uložení zálohy: @@ -42,4 +43,14 @@ Nyní budou zálohované soubory uvnitř `./apps/chat.simplex.app/`. Upozorňujeme, že pokud používáte moderní verzi SimpleX, budou databáze zašifrované a jejich obsah nebudete moci zobrazit bez použití aplikace `sqlcipher` a bez znalosti dešifrovací fráze (musíte ji nejprve změnit na svou z náhodně vygenerovaných v aplikaci). -Další informace o tom, jak dešifrovat databáze a provádět dotazy do nich, najdete v příručce [SQL.md](./SQL.md). +## Dešifrování databází + +Chcete-li zobrazit data v databázi, musíte je nejprve dešifrovat. Nainstalujte `sqlcipher` pomocí svého oblíbeného správce balíčků a v adresáři s databázemi spusťte následující příkazy: +```bash +sqlcipher files_chat.db +pragma key="youDecryptionPassphrase"; +# Ujistěte se, že vše funguje správně +select * from users; +``` + +Pokud se zobrazí `Parse error: no such table: users`, ujistěte se, že jste zadali správnou přístupovou frázi a že jste ji v aplikaci pro Android změnili z náhodné (pokud jste tuto databázi získali ze zařízení s Androidem, samozřejmě). diff --git a/docs/lang/cs/CLI.md b/docs/lang/cs/CLI.md index 731e23666..aa5a2ba28 100644 --- a/docs/lang/cs/CLI.md +++ b/docs/lang/cs/CLI.md @@ -220,37 +220,3 @@ Uživatelská adresa je "dlouhodobá" v tom smyslu, že se jedná o odkaz pro v Pro ostatní příkazy použijte `/help address`. ![simplex-chat](/images/user-addresses.gif) - -### Přístup k historii chatu - -SimpleX chat ukládá všechny vaše kontakty a konverzace do místní databáze SQLite, takže jsou soukromé a přenosné, vlastněné a kontrolované uživatelem. - -Historii chatu můžete zobrazit a prohledávat dotazem do databáze. Spusťte níže uvedený skript pro vytvoření zobrazení zpráv ve vaší databázi. - -```sh -curl -o- https://raw.githubusercontent.com/simplex-chat/simplex-chat/stable/scripts/message_views.sql | sqlite3 ~/.simplex/simplex_v1_chat.db -``` - -Otevřete SQLite Command Line Shell: - -```sh -sqlite3 ~/.simplex/simplex_v1_chat.db -``` - -Příklady viz [Message queries](./SQL.md). - -> **Upozornění:** Omezení cizích klíčů SQLite jsou ve výchozím nastavení vypnuta a musí být **[povolena pro každé připojení k databázi zvlášť](https://sqlite.org/foreignkeys.html#fk_enable)**. Toho lze dosáhnout spuštěním příkazu `PRAGMA foreign_keys = ON;` na otevřeném databázovém připojení. Spouštěním dotazů měnících data bez předchozího povolení cizích klíčů můžete riskovat, že se databáze dostane do nekonzistentního stavu. - -**Pohodlné dotazy** - -Získat všechny zprávy z dnešního dne (`chat_dt` je v UTC): - -```sql -select * from all_messages_plain where date(chat_dt) > date('now', '-1 day') order by chat_dt; -``` - -Získejte ranní noční zprávy: - -```sql -select * from all_messages_plain where chat_dt > datetime('now', '-15 hours') order by chat_dt; -``` diff --git a/docs/lang/cs/SQL.md b/docs/lang/cs/SQL.md deleted file mode 100644 index 71ef0007c..000000000 --- a/docs/lang/cs/SQL.md +++ /dev/null @@ -1,59 +0,0 @@ ---- -title: Přístup ke zprávám v databázi -revision: 31.01.2023 ---- -| Aktualizováno 31.01.2023 | Jazyky: CZ, [EN](/docs/SQL.md), [FR](/docs/lang/fr/SQL.md) | - -# Přístup ke zprávám v databázi - -## Dešifrování databází - -Chcete-li zobrazit data v databázi, musíte je nejprve dešifrovat. Nainstalujte `sqlcipher` pomocí svého oblíbeného správce balíčků a v adresáři s databázemi spusťte následující příkazy: -```bash -sqlcipher files_chat.db -pragma key="youDecryptionPassphrase"; -# Ujistěte se, že vše funguje správně -select * from users; -``` - -Pokud se zobrazí `Parse error: no such table: users`, ujistěte se, že jste zadali správnou přístupovou frázi a že jste ji v aplikaci pro Android změnili z náhodné (pokud jste tuto databázi získali ze zařízení s Androidem, samozřejmě). - -## SQL dotazy - -Můžete spouštět dotazy proti `direct_messages`, `group_messages` a `all_messages` (nebo jejich jednodušším alternativám `direct_messages_plain`, `group_messages_plain` a `all_messages_plain`), např: - -```sql --- tato nebo vámi preferovaná nastavení můžete vložit do souboru ~/.sqliterc --- aby přetrvaly napříč relacemi klienta sqlite3 -.mode column -.headers on -.nullvalue NULL - --- jednoduché pohledy na direct, group a all_messages --- s deduplikací uživatelských zpráv pro group a all_messages; --- pouze události chatu 'x.msg.new' ("nová zpráva") - filtruje události služby; --- msg_sent je 0 pro přijaté, 1 pro odeslané -select * from direct_messages_plain; -select * from group_messages_plain; -select * from all_messages_plain; - --- dotaz na další podrobnosti historie chatu pomocí běžného SQL, například: --- soubory, které jste nabídli k odeslání -select * from direct_messages where msg_sent = 1 and chat_msg_event = 'x.file'; --- vše, co catherine poslala v souvislosti s kočkami -select * from direct_messages where msg_sent = 0 and contact = 'catherine' and msg_body like '%cats%'; --- veškerá korespondence s alice v #teamu -select * from group_messages where group_name = 'team' and contact = 'alice'; - --- shrňte data z chatu -select contact_or_group, num_messages from ( - select - contact as contact_or_group, count(1) as num_messages - from direct_messages_plain group by contact - union - select - group_name as contact_or_group, count(1) as num_messages - from group_messages_plain group by group_name -) -order by num_messages desc; -``` diff --git a/docs/lang/fr/ANDROID.md b/docs/lang/fr/ANDROID.md index 905af5015..0f710542a 100644 --- a/docs/lang/fr/ANDROID.md +++ b/docs/lang/fr/ANDROID.md @@ -19,6 +19,7 @@ Si vous voulez voir ce qui est stocké dans le répertoire de données de Simple - votre appareil connecté via USB ou Wi-Fi à l'ordinateur. ## La procédure : + - Ouvrez SimpleX, allez dans `Phrase secrète et exportation de la base de données`, activez `Sauvegarde des données de l'app`. Cela permettra aux autres étapes de fonctionner - optionnel_ : si vous voulez voir le contenu de la base de données, changez la phrase secrète de la base de données aléatoire pour la vôtre. Pour ce faire, arrêtez le chat dans le menu "Phrase secrète et exportation de la base de données", ouvrez "Phrase secrète de la base de données", entrez la nouvelle phrase secrète et confirmez-la, puis mettez-la à jour. Ne l'oubliez pas, sinon vous perdrez toutes vos données au cas où la phrase d'authentification vous serait redemandée plus tard. - ouvrez un émulateur de terminal (Windows CMD/Powershell ne fonctionnera pas) et changez de répertoire pour celui que vous voulez utiliser pour stocker la sauvegarde : @@ -42,4 +43,14 @@ Maintenant les fichiers sauvegardés seront dans `./apps/chat.simplex.app/`. Veuillez noter que si vous utilisez une version récente de SimpleX, les bases de données seront chiffrées, et vous ne pourrez pas en voir le contenu sans utiliser l'application `sqlcipher` et sans connaître la phrase secrète de déchiffrement (vous devez d'abord la changer pour la vôtre à partir de celle qui est générée aléatoirement dans l'application). -Veuillez suivre le guide [SQL.md](/SQL.md) pour plus d'informations sur la manière de déchiffrer vos bases de données et d'y effectuer des requêtes. +## Déchiffrer les bases de données + +Afin de visualiser les données de la base de données, vous devez d'abord les déchiffrer. Installez `sqlcipher` en utilisant votre gestionnaire de paquets préféré et exécutez les commandes suivantes dans le répertoire contenant les bases de données : +```bash +sqlcipher files_chat.db +pragma key="youDecryptionPassphrase"; +# S'assurer qu'il fonctionne bien +select * from users; +``` + +Si vous voyez `Parse error : no such table : users`, assurez-vous que vous avez entré la bonne phrase secrète, et que vous avez changé la phrase secrète au hasard dans l'application Android (si vous avez obtenu cette base de données à partir d'un appareil Android, bien sûr). diff --git a/docs/lang/fr/CLI.md b/docs/lang/fr/CLI.md index 2c4a88e2d..6fe9c86d7 100644 --- a/docs/lang/fr/CLI.md +++ b/docs/lang/fr/CLI.md @@ -222,37 +222,3 @@ L'adresse de l'utilisateur est "à long terme" dans le sens où il s'agit d'un l Utilisez `/help address` pour les autres commandes. ![simplex-chat](/images/user-addresses.gif) - -### Accéder à l'historique des chats - -SimpleX chat stocke tous vos contacts et conversations dans une base de données SQLite locale, ce qui la rend privée et portable par définition, appartenant et contrôlée par l'utilisateur. - -Vous pouvez visualiser et rechercher votre historique de chat en interrogeant votre base de données. Exécutez le script ci-dessous pour créer des aperçus de messages dans votre base de données. - -```sh -curl -o- https://raw.githubusercontent.com/simplex-chat/simplex-chat/stable/scripts/message_views.sql | sqlite3 ~/.simplex/simplex_v1_chat.db -``` - -Ouvrir un terminal de commande SQLite : - -```sh -sqlite3 ~/.simplex/simplex_v1_chat.db -``` - -Voir les [requêtes de message](./SQL.md) à titre d'exemple. - -> **Veuillez noter :** Les contraintes de clé étrangère SQLite sont désactivées par défaut, et doivent être **[activé séparément pour chaque connexion de base de données](https://sqlite.org/foreignkeys.html#fk_enable)**. Cette dernière peut être réalisée en exécutant la commande `PRAGMA foreign_keys = ON;` sur une connexion de base de données ouverte. En exécutant des requêtes modifiant les données sans activer les clés étrangères au préalable, vous risquez de mettre votre base de données dans un état inconsistant. - -**Requêtes de commodité** - -Pour recevoir tous les messages du jour (`chat_dt` est en UTC) : - -```sql -select * from all_messages_plain where date(chat_dt) > date('now', '-1 day') order by chat_dt; -``` - -Pour recevoir les messages de la nuit dans la matinée : - -```sql -select * from all_messages_plain where chat_dt > datetime('now', '-15 hours') order by chat_dt; -``` diff --git a/docs/lang/fr/SQL.md b/docs/lang/fr/SQL.md deleted file mode 100644 index d141153d6..000000000 --- a/docs/lang/fr/SQL.md +++ /dev/null @@ -1,59 +0,0 @@ ---- -title: Accès aux messages de la base de données -revision: 31.01.2023 ---- -| 31.01.2023 | FR, [EN](/docs/SQL.md), [CZ](/docs/lang/cs/SQL.md) | - -# Accès aux messages de la base de données - -## Déchiffrer les bases de données - -Afin de visualiser les données de la base de données, vous devez d'abord les déchiffrer. Installez `sqlcipher` en utilisant votre gestionnaire de paquets préféré et exécutez les commandes suivantes dans le répertoire contenant les bases de données : -```bash -sqlcipher files_chat.db -pragma key="youDecryptionPassphrase"; -# S'assurer qu'il fonctionne bien -select * from users; -``` - -Si vous voyez `Parse error : no such table : users`, assurez-vous que vous avez entré la bonne phrase secrète, et que vous avez changé la phrase secrète au hasard dans l'application Android (si vous avez obtenu cette base de données à partir d'un appareil Android, bien sûr). - -# Requêtes SQL - -Vous pouvez exécuter des requêtes `direct_messages`, `group_messages` et `all_messages` (ou leurs alternatives plus simples `direct_messages_plain`, `group_messages_plain` et `all_messages_plain`), par exemple : - -```sql --- vous pouvez mettre ces paramètres ou ceux que vous préférez dans ~/.sqliterc --- pour maintenir les sessions du client sqlite3 -.mode column -.headers on -.nullvalue NULL - --- vues simples pour direct, group et all_messages --- avec les messages de l'utilisateur dédupliqués pour group et all_messages ; --- seuls les événements de chat "x.msg.new" ("nouveau message") - filtre les événements de service ; --- msg_sent est 0 pour reçu, 1 pour envoyé -select * from direct_messages_plain; -select * from group_messages_plain; -select * from all_messages_plain; - --- demander d'autres détails de votre historique de chat avec le SQL régulier, par exemple : --- les fichiers que vous avez soumis pour l'envoi -select * from direct_messages where msg_sent = 1 and chat_msg_event = 'x.file'; --- tout ce que Catherine a envoyé lié aux chats -select * from direct_messages where msg_sent = 0 and contact = 'catherine' and msg_body like '%cats%'; --- toute correspondance avec alice dans #team -select * from group_messages where group_name = 'team' and contact = 'alice'; - --- regrouper vos données de chat -select contact_or_group, num_messages from ( - select - contact as contact_or_group, count(1) as num_messages - from direct_messages_plain group by contact - union - select - group_name as contact_or_group, count(1) as num_messages - from group_messages_plain group by group_name -) -order by num_messages desc; -``` diff --git a/scripts/message_views.sql b/scripts/message_views.sql deleted file mode 100644 index e0c90145c..000000000 --- a/scripts/message_views.sql +++ /dev/null @@ -1,110 +0,0 @@ -CREATE VIEW direct_messages AS -SELECT - ct.local_display_name AS contact, - m.message_id AS message_id, - m.msg_sent AS msg_sent, - m.chat_msg_event AS chat_msg_event, - m.msg_body AS msg_body, - md.msg_delivery_id AS delivery_id, - datetime(md.chat_ts) AS chat_dt, - md.agent_msg_meta AS msg_meta, - mde.delivery_status AS delivery_status, - datetime(mde.created_at) AS delivery_status_dt -FROM messages m -JOIN msg_deliveries md ON md.message_id = m.message_id -JOIN ( - SELECT msg_delivery_id, MAX(created_at) MaxDate - FROM msg_delivery_events - GROUP BY msg_delivery_id -) MaxDates ON MaxDates.msg_delivery_id = md.msg_delivery_id -JOIN msg_delivery_events mde ON mde.msg_delivery_id = MaxDates.msg_delivery_id - AND mde.created_at = MaxDates.MaxDate -JOIN connections c ON c.connection_id = md.connection_id -JOIN contacts ct ON ct.contact_id = c.contact_id -ORDER BY chat_dt DESC; - -CREATE VIEW direct_messages_plain AS -SELECT - dm.contact AS contact, - dm.msg_sent AS msg_sent, - dm.msg_body AS msg_body, - dm.chat_dt AS chat_dt -FROM direct_messages dm -WHERE dm.chat_msg_event = 'x.msg.new'; - -CREATE VIEW group_messages AS -SELECT - g.local_display_name AS group_name, - gm.local_display_name AS contact, - m.message_id AS message_id, - m.msg_sent AS msg_sent, - m.chat_msg_event AS chat_msg_event, - m.msg_body AS msg_body, - md.msg_delivery_id AS delivery_id, - datetime(md.chat_ts) AS chat_dt, - md.agent_msg_meta AS msg_meta, - mde.delivery_status AS delivery_status, - datetime(mde.created_at) AS delivery_status_dt -FROM messages m -JOIN msg_deliveries md ON md.message_id = m.message_id -JOIN ( - SELECT msg_delivery_id, MAX(created_at) MaxDate - FROM msg_delivery_events - GROUP BY msg_delivery_id -) MaxDates ON MaxDates.msg_delivery_id = md.msg_delivery_id -JOIN msg_delivery_events mde ON mde.msg_delivery_id = MaxDates.msg_delivery_id - AND mde.created_at = MaxDates.MaxDate -JOIN connections c ON c.connection_id = md.connection_id -JOIN group_members gm ON gm.group_member_id = c.group_member_id -JOIN groups g ON g.group_id = gm.group_id -ORDER BY chat_dt DESC; - -CREATE VIEW group_messages_plain AS -SELECT - gm.group_name AS group_name, - (CASE WHEN gm.msg_sent = 0 THEN gm.contact ELSE gm.group_name END) AS contact, - gm.msg_sent AS msg_sent, - gm.msg_body AS msg_body, - gm.chat_dt AS chat_dt -FROM group_messages gm -JOIN ( - SELECT message_id, MIN(delivery_id) MinDeliveryId - FROM group_messages - GROUP BY message_id -) Deduplicated ON Deduplicated.message_id = gm.message_id - AND Deduplicated.MinDeliveryId = gm.delivery_id -WHERE gm.chat_msg_event = 'x.msg.new'; - -CREATE VIEW all_messages ( - group_name, - contact, - message_id, - msg_sent, - chat_msg_event, - msg_body, - delivery_id, - chat_dt, - msg_meta, - delivery_status, - delivery_status_dt -) AS - SELECT * FROM ( - SELECT NULL AS group_name, * FROM direct_messages - UNION - SELECT * FROM group_messages - ) - ORDER BY chat_dt DESC; - -CREATE VIEW all_messages_plain ( - group_name, - contact, - msg_sent, - msg_body, - chat_dt -) AS - SELECT * FROM ( - SELECT NULL AS group_name, * FROM direct_messages_plain - UNION - SELECT * FROM group_messages_plain - ) - ORDER BY chat_dt DESC; diff --git a/src/Simplex/Chat/Migrations/M20231215_recreate_msg_deliveries.hs b/src/Simplex/Chat/Migrations/M20231215_recreate_msg_deliveries.hs index a87dc3d38..4b39606d8 100644 --- a/src/Simplex/Chat/Migrations/M20231215_recreate_msg_deliveries.hs +++ b/src/Simplex/Chat/Migrations/M20231215_recreate_msg_deliveries.hs @@ -8,6 +8,13 @@ import Database.SQLite.Simple.QQ (sql) m20231215_recreate_msg_deliveries :: Query m20231215_recreate_msg_deliveries = [sql| +DROP VIEW IF EXISTS direct_messages; +DROP VIEW IF EXISTS direct_messages_plain; +DROP VIEW IF EXISTS group_messages; +DROP VIEW IF EXISTS group_messages_plain; +DROP VIEW IF EXISTS all_messages; +DROP VIEW IF EXISTS all_messages_plain; + DROP INDEX msg_delivery_events_msg_delivery_id; DROP TABLE msg_delivery_events; diff --git a/website/src/_data/docs_sidebar.json b/website/src/_data/docs_sidebar.json index fcd980121..857684661 100644 --- a/website/src/_data/docs_sidebar.json +++ b/website/src/_data/docs_sidebar.json @@ -21,7 +21,6 @@ "DIRECTORY.md", "ANDROID.md", "CLI.md", - "SQL.md", "CONTRIBUTING.md", "SERVER.md", "TRANSLATIONS.md", From 5a6670998cf3e06a987b07fd6e00bef9c39d3423 Mon Sep 17 00:00:00 2001 From: Stanislav Dmitrenko <7953703+avently@users.noreply.github.com> Date: Sun, 24 Dec 2023 19:22:00 +0700 Subject: [PATCH 03/10] android, desktop: loading prev messages better (#3585) * android, desktop: loading prev messages better * better * better --------- Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> --- .../simplex/common/views/chat/ChatView.kt | 56 +++++++++++-------- 1 file changed, 32 insertions(+), 24 deletions(-) diff --git a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt index ebec780df..0e2a7c168 100644 --- a/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt +++ b/apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/chat/ChatView.kt @@ -220,8 +220,9 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId: } } }, - loadPrevMessages = { cInfo -> - val c = chatModel.getChat(cInfo.id) + loadPrevMessages = { + if (chatModel.chatId.value != activeChat.value?.id) return@ChatLayout + val c = chatModel.getChat(chatModel.chatId.value ?: return@ChatLayout) val firstId = chatModel.chatItems.firstOrNull()?.id if (c != null && firstId != null) { withApi { @@ -440,7 +441,8 @@ fun ChatView(chatId: String, chatModel: ChatModel, onComposed: suspend (chatId: changeNtfsState = { enabled, currentValue -> toggleNotifications(chat, enabled, chatModel, currentValue) }, onSearchValueChanged = { value -> if (searchText.value == value) return@ChatLayout - val c = chatModel.getChat(chat.chatInfo.id) ?: return@ChatLayout + if (chatModel.chatId.value != activeChat.value?.id) return@ChatLayout + val c = chatModel.getChat(chatModel.chatId.value ?: return@ChatLayout) ?: return@ChatLayout withApi { apiFindMessages(c, chatModel, value) searchText.value = value @@ -467,7 +469,7 @@ fun ChatLayout( back: () -> Unit, info: () -> Unit, showMemberInfo: (GroupInfo, GroupMember) -> Unit, - loadPrevMessages: (ChatInfo) -> Unit, + loadPrevMessages: () -> Unit, deleteMessage: (Long, CIDeleteMode) -> Unit, deleteMessages: (List) -> Unit, receiveFile: (Long, Boolean) -> Unit, @@ -790,7 +792,7 @@ fun BoxWithConstraintsScope.ChatItemsList( useLinkPreviews: Boolean, linkMode: SimplexLinkMode, showMemberInfo: (GroupInfo, GroupMember) -> Unit, - loadPrevMessages: (ChatInfo) -> Unit, + loadPrevMessages: () -> Unit, deleteMessage: (Long, CIDeleteMode) -> Unit, deleteMessages: (List) -> Unit, receiveFile: (Long, Boolean) -> Unit, @@ -828,9 +830,7 @@ fun BoxWithConstraintsScope.ChatItemsList( } } - PreloadItems(listState, ChatPagination.UNTIL_PRELOAD_COUNT, chat, chatItems) { c -> - loadPrevMessages(c.chatInfo) - } + PreloadItems(listState, ChatPagination.UNTIL_PRELOAD_COUNT, loadPrevMessages) Spacer(Modifier.size(8.dp)) val reversedChatItems by remember { derivedStateOf { chatItems.reversed().toList() } } @@ -1150,24 +1150,32 @@ fun BoxWithConstraintsScope.FloatingButtons( fun PreloadItems( listState: LazyListState, remaining: Int = 10, - chat: Chat, - items: List<*>, - onLoadMore: (chat: Chat) -> Unit, + onLoadMore: () -> Unit, ) { - LaunchedEffect(listState, chat, items) { - snapshotFlow { listState.layoutInfo } - .map { - val totalItemsNumber = it.totalItemsCount - val lastVisibleItemIndex = (it.visibleItemsInfo.lastOrNull()?.index ?: 0) + 1 - if (lastVisibleItemIndex > (totalItemsNumber - remaining) && totalItemsNumber >= ChatPagination.INITIAL_COUNT) - totalItemsNumber - else - 0 + // Prevent situation when initial load and load more happens one after another after selecting a chat with long scroll position from previous selection + val allowLoad = remember { mutableStateOf(false) } + LaunchedEffect(Unit) { + snapshotFlow { chatModel.chatId.value } + .filterNotNull() + .collect { + allowLoad.value = listState.layoutInfo.totalItemsCount == listState.layoutInfo.visibleItemsInfo.size + delay(500) + allowLoad.value = true } - .distinctUntilChanged() + } + KeyChangeEffect(allowLoad.value) { + snapshotFlow { + val lInfo = listState.layoutInfo + val totalItemsNumber = lInfo.totalItemsCount + val lastVisibleItemIndex = (lInfo.visibleItemsInfo.lastOrNull()?.index ?: 0) + 1 + if (allowLoad.value && lastVisibleItemIndex > (totalItemsNumber - remaining) && totalItemsNumber >= ChatPagination.INITIAL_COUNT) + totalItemsNumber + ChatPagination.PRELOAD_COUNT + else + 0 + } .filter { it > 0 } .collect { - onLoadMore(chat) + onLoadMore() } } } @@ -1439,7 +1447,7 @@ fun PreviewChatLayout() { back = {}, info = {}, showMemberInfo = { _, _ -> }, - loadPrevMessages = { _ -> }, + loadPrevMessages = {}, deleteMessage = { _, _ -> }, deleteMessages = { _ -> }, receiveFile = { _, _ -> }, @@ -1512,7 +1520,7 @@ fun PreviewGroupChatLayout() { back = {}, info = {}, showMemberInfo = { _, _ -> }, - loadPrevMessages = { _ -> }, + loadPrevMessages = {}, deleteMessage = { _, _ -> }, deleteMessages = {}, receiveFile = { _, _ -> }, From af22348bf81dd8cb43a7863dd6535ddce8bacea3 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Sun, 24 Dec 2023 13:27:51 +0000 Subject: [PATCH 04/10] core: use version from config, add tests (#3588) * core: use version from config, add tests * comment * refactor --- src/Simplex/Chat.hs | 295 ++++++++++++++------------ src/Simplex/Chat/Protocol.hs | 4 + src/Simplex/Chat/Remote/Protocol.hs | 1 - src/Simplex/Chat/Store/Connections.hs | 25 +-- src/Simplex/Chat/Store/Files.hs | 25 +-- src/Simplex/Chat/Store/Groups.hs | 115 +++++----- src/Simplex/Chat/Store/Messages.hs | 45 ++-- tests/ChatClient.hs | 35 ++- tests/ChatTests/Groups.hs | 49 +++-- tests/ChatTests/Utils.hs | 22 +- 10 files changed, 348 insertions(+), 268 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index a8b1284b9..9e3994173 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -276,28 +276,28 @@ newChatController logFilePath = logFile, contactMergeEnabled } - where - configServers :: DefaultAgentServers - configServers = - let smp' = fromMaybe (defaultServers.smp) (nonEmpty smpServers) - xftp' = fromMaybe (defaultServers.xftp) (nonEmpty xftpServers) - in defaultServers {smp = smp', xftp = xftp', netCfg = networkConfig} - agentServers :: ChatConfig -> IO InitialAgentServers - agentServers config@ChatConfig {defaultServers = defServers@DefaultAgentServers {ntf, netCfg}} = do - users <- withTransaction chatStore getUsers - smp' <- getUserServers users SPSMP - xftp' <- getUserServers users SPXFTP - pure InitialAgentServers {smp = smp', xftp = xftp', ntf, netCfg} - where - getUserServers :: forall p. (ProtocolTypeI p, UserProtocol p) => [User] -> SProtocolType p -> IO (Map UserId (NonEmpty (ProtoServerWithAuth p))) - getUserServers users protocol = case users of - [] -> pure $ M.fromList [(1, cfgServers protocol defServers)] - _ -> M.fromList <$> initialServers - where - initialServers :: IO [(UserId, NonEmpty (ProtoServerWithAuth p))] - initialServers = mapM (\u -> (aUserId u,) <$> userServers u) users - userServers :: User -> IO (NonEmpty (ProtoServerWithAuth p)) - userServers user' = activeAgentServers config protocol <$> withTransaction chatStore (`getProtocolServers` user') + where + configServers :: DefaultAgentServers + configServers = + let smp' = fromMaybe (defaultServers.smp) (nonEmpty smpServers) + xftp' = fromMaybe (defaultServers.xftp) (nonEmpty xftpServers) + in defaultServers {smp = smp', xftp = xftp', netCfg = networkConfig} + agentServers :: ChatConfig -> IO InitialAgentServers + agentServers config@ChatConfig {defaultServers = defServers@DefaultAgentServers {ntf, netCfg}} = do + users <- withTransaction chatStore getUsers + smp' <- getUserServers users SPSMP + xftp' <- getUserServers users SPXFTP + pure InitialAgentServers {smp = smp', xftp = xftp', ntf, netCfg} + where + getUserServers :: forall p. (ProtocolTypeI p, UserProtocol p) => [User] -> SProtocolType p -> IO (Map UserId (NonEmpty (ProtoServerWithAuth p))) + getUserServers users protocol = case users of + [] -> pure $ M.fromList [(1, cfgServers protocol defServers)] + _ -> M.fromList <$> initialServers + where + initialServers :: IO [(UserId, NonEmpty (ProtoServerWithAuth p))] + initialServers = mapM (\u -> (aUserId u,) <$> userServers u) users + userServers :: User -> IO (NonEmpty (ProtoServerWithAuth p)) + userServers user' = activeAgentServers config protocol <$> withTransaction chatStore (`getProtocolServers` user') activeAgentServers :: UserProtocol p => ChatConfig -> SProtocolType p -> [ServerCfg p] -> NonEmpty (ProtoServerWithAuth p) activeAgentServers ChatConfig {defaultServers} p = @@ -356,11 +356,12 @@ startChatController subConns enableExpireCIs startXFTPWorkers = do subscribeUsers :: forall m. ChatMonad' m => Bool -> [User] -> m () subscribeUsers onlyNeeded users = do let (us, us') = partition activeUser users - subscribe us - subscribe us' + vr <- chatVersionRange + subscribe vr us + subscribe vr us' where - subscribe :: [User] -> m () - subscribe = mapM_ $ runExceptT . subscribeUserConnections onlyNeeded Agent.subscribeConnections + subscribe :: VersionRange -> [User] -> m () + subscribe vr = mapM_ $ runExceptT . subscribeUserConnections vr onlyNeeded Agent.subscribeConnections startFilesToReceive :: forall m. ChatMonad' m => [User] -> m () startFilesToReceive users = do @@ -437,7 +438,11 @@ parseChatCommand = A.parseOnly chatCommandP . B.dropWhileEnd isSpace -- | Chat API commands interpreted in context of a local zone processChatCommand :: forall m. ChatMonad m => ChatCommand -> m ChatResponse -processChatCommand = \case +processChatCommand cmd = chatVersionRange >>= (`processChatCommand'` cmd) +{-# INLINE processChatCommand #-} + +processChatCommand' :: forall m. ChatMonad m => VersionRange -> ChatCommand -> m ChatResponse +processChatCommand' vr = \case ShowActiveUser -> withUser' $ pure . CRActiveUser CreateActiveUser NewUser {profile, sameServers, pastTimestamp} -> do forM_ profile $ \Profile {displayName} -> checkValidName displayName @@ -607,7 +612,7 @@ processChatCommand = \case . M.assocs <$> withConnection st (readTVarIO . DB.slow) APIGetChats {userId, pendingConnections, pagination, query} -> withUserId' userId $ \user -> do - (errs, previews) <- partitionEithers <$> withStore' (\db -> getChatPreviews db user pendingConnections pagination query) + (errs, previews) <- partitionEithers <$> withStore' (\db -> getChatPreviews db vr user pendingConnections pagination query) unless (null errs) $ toView $ CRChatErrors (Just user) (map ChatErrorStore errs) pure $ CRApiChats user previews APIGetChat (ChatRef cType cId) pagination search -> withUser $ \user -> case cType of @@ -616,16 +621,16 @@ processChatCommand = \case directChat <- withStore (\db -> getDirectChat db user cId pagination search) pure $ CRApiChat user (AChat SCTDirect directChat) CTGroup -> do - groupChat <- withStore (\db -> getGroupChat db user cId pagination search) + groupChat <- withStore (\db -> getGroupChat db vr user cId pagination search) pure $ CRApiChat user (AChat SCTGroup groupChat) CTContactRequest -> pure $ chatCmdError (Just user) "not implemented" CTContactConnection -> pure $ chatCmdError (Just user) "not supported" APIGetChatItems pagination search -> withUser $ \user -> do - chatItems <- withStore $ \db -> getAllChatItems db user pagination search + chatItems <- withStore $ \db -> getAllChatItems db vr user pagination search pure $ CRChatItems user Nothing chatItems APIGetChatItemInfo chatRef itemId -> withUser $ \user -> do (aci@(AChatItem cType dir _ ci), versions) <- withStore $ \db -> - (,) <$> getAChatItem db user chatRef itemId <*> liftIO (getChatItemVersions db itemId) + (,) <$> getAChatItem db vr user chatRef itemId <*> liftIO (getChatItemVersions db itemId) let itemVersions = if null versions then maybeToList $ mkItemVersion ci else versions memberDeliveryStatuses <- case (cType, dir) of (SCTGroup, SMDSnd) -> do @@ -699,7 +704,7 @@ processChatCommand = \case quoteData ChatItem {content = CIRcvMsgContent qmc} = pure (qmc, CIQDirectRcv, False) quoteData _ = throwChatError CEInvalidQuote CTGroup -> do - g@(Group gInfo _) <- withStore $ \db -> getGroup db user chatId + g@(Group gInfo _) <- withStore $ \db -> getGroup db vr user chatId assertUserGroupRole gInfo GRAuthor send g where @@ -804,7 +809,7 @@ processChatCommand = \case _ -> throwChatError CEInvalidChatItemUpdate CChatItem SMDRcv _ -> throwChatError CEInvalidChatItemUpdate CTGroup -> do - Group gInfo@GroupInfo {groupId} ms <- withStore $ \db -> getGroup db user chatId + Group gInfo@GroupInfo {groupId} ms <- withStore $ \db -> getGroup db vr user chatId assertUserGroupRole gInfo GRAuthor cci <- withStore $ \db -> getGroupCIWithReactions db user gInfo itemId case cci of @@ -840,7 +845,7 @@ processChatCommand = \case else markDirectCIDeleted user ct ci msgId True =<< liftIO getCurrentTime (CIDMBroadcast, _, _, _) -> throwChatError CEInvalidChatItemDelete CTGroup -> do - Group gInfo ms <- withStore $ \db -> getGroup db user chatId + Group gInfo ms <- withStore $ \db -> getGroup db vr user chatId CChatItem msgDir ci@ChatItem {meta = CIMeta {itemSharedMsgId, editable}} <- withStore $ \db -> getGroupChatItem db user chatId itemId case (mode, msgDir, itemSharedMsgId, editable) of (CIDMInternal, _, _, _) -> deleteGroupCI user gInfo ci True False Nothing =<< liftIO getCurrentTime @@ -852,7 +857,7 @@ processChatCommand = \case CTContactRequest -> pure $ chatCmdError (Just user) "not supported" CTContactConnection -> pure $ chatCmdError (Just user) "not supported" APIDeleteMemberChatItem gId mId itemId -> withUser $ \user -> withChatLock "deleteChatItem" $ do - Group gInfo@GroupInfo {membership} ms <- withStore $ \db -> getGroup db user gId + Group gInfo@GroupInfo {membership} ms <- withStore $ \db -> getGroup db vr user gId CChatItem _ ci@ChatItem {chatDir, meta = CIMeta {itemSharedMsgId}} <- withStore $ \db -> getGroupChatItem db user gId itemId case (chatDir, itemSharedMsgId) of (CIGroupRcv GroupMember {groupMemberId, memberRole, memberId}, Just itemSharedMId) -> do @@ -881,7 +886,7 @@ processChatCommand = \case pure $ CRChatItemReaction user add r _ -> throwChatError $ CECommandError "reaction not possible - no shared item ID" CTGroup -> - withStore (\db -> (,) <$> getGroup db user chatId <*> getGroupChatItem db user chatId itemId) >>= \case + withStore (\db -> (,) <$> getGroup db vr user chatId <*> getGroupChatItem db user chatId itemId) >>= \case (Group g@GroupInfo {membership} ms, CChatItem md ci@ChatItem {meta = CIMeta {itemSharedMsgId = Just itemSharedMId}}) -> do unless (groupFeatureAllowed SGFReactions g) $ throwChatError (CECommandError $ "feature not allowed " <> T.unpack (chatFeatureNameText CFReactions)) @@ -940,7 +945,7 @@ processChatCommand = \case ok user CTGroup -> do withStore $ \db -> do - Group {groupInfo} <- getGroup db user chatId + Group {groupInfo} <- getGroup db vr user chatId liftIO $ updateGroupUnreadChat db user groupInfo unreadChat ok user _ -> pure $ chatCmdError (Just user) "not supported" @@ -965,7 +970,7 @@ processChatCommand = \case withStore' $ \db -> deletePendingContactConnection db userId chatId pure $ CRContactConnectionDeleted user conn CTGroup -> do - Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user chatId + Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db vr user chatId let isOwner = membership.memberRole == GROwner canDelete = isOwner || not (memberCurrent membership) unless canDelete $ throwChatError $ CEGroupUserRole gInfo GROwner @@ -1008,7 +1013,7 @@ processChatCommand = \case withStore' $ \db -> deleteContactCIs db user ct pure $ CRChatCleared user (AChatInfo SCTDirect $ DirectChat ct) CTGroup -> do - gInfo <- withStore $ \db -> getGroupInfo db user chatId + gInfo <- withStore $ \db -> getGroupInfo db vr user chatId filesInfo <- withStore' $ \db -> getGroupFileInfo db user gInfo deleteFilesAndConns user filesInfo withStore' $ \db -> deleteGroupCIs db user gInfo @@ -1152,7 +1157,7 @@ processChatCommand = \case user_ <- withStore' (`getUserByAConnId` agentConnId) connEntity_ <- pure user_ $>>= \user -> - withStore (\db -> Just <$> getConnectionEntity db user agentConnId) `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing) + withStore (\db -> Just <$> getConnectionEntity db vr user agentConnId) `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing) pure CRNtfMessages {user_, connEntity_, msgTs = msgTs', ntfMessages = map ntfMsgInfo msgs} APIGetUserProtoServers userId (AProtocolType p) -> withUserId userId $ \user -> withServerProtocol p $ do ChatConfig {defaultServers} <- asks config @@ -1215,7 +1220,7 @@ processChatCommand = \case ok user CTGroup -> do ms <- withStore $ \db -> do - Group _ ms <- getGroup db user chatId + Group _ ms <- getGroup db vr user chatId liftIO $ updateGroupSettings db user chatId chatSettings pure ms forM_ (filter memberActive ms) $ \m -> forM_ (memberConnId m) $ \connId -> @@ -1240,10 +1245,10 @@ processChatCommand = \case connectionStats <- mapM (withAgent . flip getConnectionServers) (contactConnId ct) pure $ CRContactInfo user ct connectionStats (fmap fromLocalProfile incognitoProfile) APIGroupInfo gId -> withUser $ \user -> do - (g, s) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> liftIO (getGroupSummary db user gId) + (g, s) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> liftIO (getGroupSummary db user gId) pure $ CRGroupInfo user g s APIGroupMemberInfo gId gMemberId -> withUser $ \user -> do - (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId + (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db user gId gMemberId connectionStats <- mapM (withAgent . flip getConnectionServers) (memberConnId m) pure $ CRGroupMemberInfo user g m connectionStats APISwitchContact contactId -> withUser $ \user -> do @@ -1254,7 +1259,7 @@ processChatCommand = \case pure $ CRContactSwitchStarted user ct connectionStats Nothing -> throwChatError $ CEContactNotActive ct APISwitchGroupMember gId gMemberId -> withUser $ \user -> do - (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId + (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db user gId gMemberId case memberConnId m of Just connId -> do connectionStats <- withAgent (\a -> switchConnectionAsync a "" connId) @@ -1268,7 +1273,7 @@ processChatCommand = \case pure $ CRContactSwitchAborted user ct connectionStats Nothing -> throwChatError $ CEContactNotActive ct APIAbortSwitchGroupMember gId gMemberId -> withUser $ \user -> do - (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId + (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db user gId gMemberId case memberConnId m of Just connId -> do connectionStats <- withAgent $ \a -> abortConnectionSwitch a connId @@ -1283,7 +1288,7 @@ processChatCommand = \case pure $ CRContactRatchetSyncStarted user ct cStats Nothing -> throwChatError $ CEContactNotActive ct APISyncGroupMemberRatchet gId gMemberId force -> withUser $ \user -> withChatLock "syncGroupMemberRatchet" $ do - (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId + (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db user gId gMemberId case memberConnId m of Just connId -> do cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a connId force @@ -1305,7 +1310,7 @@ processChatCommand = \case pure $ CRContactCode user ct' code Nothing -> throwChatError $ CEContactNotActive ct APIGetGroupMemberCode gId gMemberId -> withUser $ \user -> do - (g, m@GroupMember {activeConn}) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId + (g, m@GroupMember {activeConn}) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db user gId gMemberId case activeConn of Just conn@Connection {connId} -> do code <- getConnectionCode $ aConnId conn @@ -1487,7 +1492,7 @@ processChatCommand = \case let chatRef = ChatRef CTDirect ctId processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage Nothing Nothing mc Left _ -> - withStore' (\db -> runExceptT $ getActiveMembersByName db user name) >>= \case + withStore' (\db -> runExceptT $ getActiveMembersByName db vr user name) >>= \case Right [(gInfo, member)] -> do let GroupInfo {localDisplayName = gName} = gInfo GroupMember {localDisplayName = mName} = member @@ -1507,7 +1512,7 @@ processChatCommand = \case let mc = MCText msg case memberContactId m of Nothing -> do - gInfo <- withStore $ \db -> getGroupInfo db user gId + gInfo <- withStore $ \db -> getGroupInfo db vr user gId toView $ CRNoMemberContactCreating user gInfo m processChatCommand (APICreateMemberContact gId mId) >>= \case cr@(CRNewMemberContact _ Contact {contactId} _ _) -> do @@ -1567,13 +1572,13 @@ processChatCommand = \case gVar <- asks random -- [incognito] generate incognito profile for group membership incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing - groupInfo <- withStore $ \db -> createNewGroup db gVar user gProfile incognitoProfile + groupInfo <- withStore $ \db -> createNewGroup db vr gVar user gProfile incognitoProfile pure $ CRGroupCreated user groupInfo NewGroup incognito gProfile -> withUser $ \User {userId} -> processChatCommand $ APINewGroup userId incognito gProfile APIAddMember groupId contactId memRole -> withUser $ \user -> withChatLock "addMember" $ do -- TODO for large groups: no need to load all members to determine if contact is a member - (group, contact) <- withStore $ \db -> (,) <$> getGroup db user groupId <*> getContact db user contactId + (group, contact) <- withStore $ \db -> (,) <$> getGroup db vr user groupId <*> getContact db user contactId assertDirectAllowed user MDSnd contact XGrpInv_ let Group gInfo members = group Contact {localDisplayName = cName} = contact @@ -1603,7 +1608,7 @@ processChatCommand = \case APIJoinGroup groupId -> withUser $ \user@User {userId} -> do withChatLock "joinGroup" . procCmd $ do (invitation, ct) <- withStore $ \db -> do - inv@ReceivedGroupInvitation {fromMember} <- getGroupInvitation db user groupId + inv@ReceivedGroupInvitation {fromMember} <- getGroupInvitation db vr user groupId (inv,) <$> getContactViaMember db user fromMember let ReceivedGroupInvitation {fromMember, connRequest, groupInfo = g@GroupInfo {membership}} = invitation Contact {activeConn} = ct @@ -1621,14 +1626,14 @@ processChatCommand = \case Nothing -> throwChatError $ CEContactNotActive ct where updateCIGroupInvitationStatus user = do - AChatItem _ _ cInfo ChatItem {content, meta = CIMeta {itemId}} <- withStore $ \db -> getChatItemByGroupId db user groupId + AChatItem _ _ cInfo ChatItem {content, meta = CIMeta {itemId}} <- withStore $ \db -> getChatItemByGroupId db vr user groupId case (cInfo, content) of (DirectChat ct, CIRcvGroupInvitation ciGroupInv memRole) -> do let aciContent = ACIContent SMDRcv $ CIRcvGroupInvitation ciGroupInv {status = CIGISAccepted} memRole updateDirectChatItemView user ct itemId aciContent False Nothing _ -> pure () -- prohibited APIMemberRole groupId memberId memRole -> withUser $ \user -> do - Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user groupId + Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db vr user groupId if memberId == groupMemberId' membership then changeMemberRole user gInfo members membership $ SGEUserRole memRole else case find ((== memberId) . groupMemberId') members of @@ -1652,7 +1657,7 @@ processChatCommand = \case toView $ CRNewChatItem user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci) pure CRMemberRoleUser {user, groupInfo = gInfo, member = m {memberRole = memRole}, fromRole = mRole, toRole = memRole} APIRemoveMember groupId memberId -> withUser $ \user -> do - Group gInfo members <- withStore $ \db -> getGroup db user groupId + Group gInfo members <- withStore $ \db -> getGroup db vr user groupId case find ((== memberId) . groupMemberId') members of Nothing -> throwChatError CEGroupMemberNotFound Just m@GroupMember {memberId = mId, memberRole = mRole, memberStatus = mStatus, memberProfile} -> do @@ -1671,7 +1676,7 @@ processChatCommand = \case deleteOrUpdateMemberRecord user m pure $ CRUserDeletedMember user gInfo m {memberStatus = GSMemRemoved} APILeaveGroup groupId -> withUser $ \user@User {userId} -> do - Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user groupId + Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db vr user groupId withChatLock "leaveGroup" . procCmd $ do (msg, _) <- sendGroupMessage user gInfo members XGrpLeave ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft) @@ -1683,7 +1688,7 @@ processChatCommand = \case withStore' $ \db -> updateGroupMemberStatus db userId membership GSMemLeft pure $ CRLeftMemberUser user gInfo {membership = membership {memberStatus = GSMemLeft}} APIListMembers groupId -> withUser $ \user -> - CRGroupMembers user <$> withStore (\db -> getGroup db user groupId) + CRGroupMembers user <$> withStore (\db -> getGroup db vr user groupId) AddMember gName cName memRole -> withUser $ \user -> do (groupId, contactId) <- withStore $ \db -> (,) <$> getGroupIdByName db user gName <*> getContactIdByName db user cName processChatCommand $ APIAddMember groupId contactId memRole @@ -1705,23 +1710,23 @@ processChatCommand = \case groupId <- withStore $ \db -> getGroupIdByName db user gName processChatCommand $ APIListMembers groupId APIListGroups userId contactId_ search_ -> withUserId userId $ \user -> - CRGroupsList user <$> withStore' (\db -> getUserGroupsWithSummary db user contactId_ search_) + CRGroupsList user <$> withStore' (\db -> getUserGroupsWithSummary db vr user contactId_ search_) ListGroups cName_ search_ -> withUser $ \user@User {userId} -> do ct_ <- forM cName_ $ \cName -> withStore $ \db -> getContactByName db user cName processChatCommand $ APIListGroups userId (contactId' <$> ct_) search_ APIUpdateGroupProfile groupId p' -> withUser $ \user -> do - g <- withStore $ \db -> getGroup db user groupId + g <- withStore $ \db -> getGroup db vr user groupId runUpdateGroupProfile user g p' UpdateGroupNames gName GroupProfile {displayName, fullName} -> updateGroupProfileByName gName $ \p -> p {displayName, fullName} ShowGroupProfile gName -> withUser $ \user -> - CRGroupProfile user <$> withStore (\db -> getGroupInfoByName db user gName) + CRGroupProfile user <$> withStore (\db -> getGroupInfoByName db vr user gName) UpdateGroupDescription gName description -> updateGroupProfileByName gName $ \p -> p {description} ShowGroupDescription gName -> withUser $ \user -> - CRGroupDescription user <$> withStore (\db -> getGroupInfoByName db user gName) + CRGroupDescription user <$> withStore (\db -> getGroupInfoByName db vr user gName) APICreateGroupLink groupId mRole -> withUser $ \user -> withChatLock "createGroupLink" $ do - gInfo <- withStore $ \db -> getGroupInfo db user groupId + gInfo <- withStore $ \db -> getGroupInfo db vr user groupId assertUserGroupRole gInfo GRAdmin when (mRole > GRMember) $ throwChatError $ CEGroupMemberInitialRole gInfo mRole groupLinkId <- GroupLinkId <$> drgRandomBytes 16 @@ -1731,22 +1736,22 @@ processChatCommand = \case withStore $ \db -> createGroupLink db user gInfo connId cReq groupLinkId mRole subMode pure $ CRGroupLinkCreated user gInfo cReq mRole APIGroupLinkMemberRole groupId mRole' -> withUser $ \user -> withChatLock "groupLinkMemberRole " $ do - gInfo <- withStore $ \db -> getGroupInfo db user groupId + gInfo <- withStore $ \db -> getGroupInfo db vr user groupId (groupLinkId, groupLink, mRole) <- withStore $ \db -> getGroupLink db user gInfo assertUserGroupRole gInfo GRAdmin when (mRole' > GRMember) $ throwChatError $ CEGroupMemberInitialRole gInfo mRole' when (mRole' /= mRole) $ withStore' $ \db -> setGroupLinkMemberRole db user groupLinkId mRole' pure $ CRGroupLink user gInfo groupLink mRole' APIDeleteGroupLink groupId -> withUser $ \user -> withChatLock "deleteGroupLink" $ do - gInfo <- withStore $ \db -> getGroupInfo db user groupId + gInfo <- withStore $ \db -> getGroupInfo db vr user groupId deleteGroupLink' user gInfo pure $ CRGroupLinkDeleted user gInfo APIGetGroupLink groupId -> withUser $ \user -> do - gInfo <- withStore $ \db -> getGroupInfo db user groupId + gInfo <- withStore $ \db -> getGroupInfo db vr user groupId (_, groupLink, mRole) <- withStore $ \db -> getGroupLink db user gInfo pure $ CRGroupLink user gInfo groupLink mRole APICreateMemberContact gId gMemberId -> withUser $ \user -> do - (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId + (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db user gId gMemberId assertUserGroupRole g GRAuthor unless (groupFeatureAllowed SGFDirectMessages g) $ throwChatError $ CECommandError "direct messages not allowed" case memberConn m of @@ -1762,7 +1767,7 @@ processChatCommand = \case pure $ CRNewMemberContact user ct g m _ -> throwChatError CEGroupMemberNotActive APISendMemberContactInvitation contactId msgContent_ -> withUser $ \user -> do - (g, m, ct, cReq) <- withStore $ \db -> getMemberContact db user contactId + (g, m, ct, cReq) <- withStore $ \db -> getMemberContact db vr user contactId when (contactGrpInvSent ct) $ throwChatError $ CECommandError "x.grp.direct.inv already sent" case memberConn m of Just mConn -> do @@ -1794,7 +1799,7 @@ processChatCommand = \case processChatCommand . APISendMessage (ChatRef CTGroup groupId) False Nothing $ ComposedMessage Nothing (Just quotedItemId) mc LastChats count_ -> withUser' $ \user -> do let count = fromMaybe 5000 count_ - (errs, previews) <- partitionEithers <$> withStore' (\db -> getChatPreviews db user False (PTLast count) clqNoFilters) + (errs, previews) <- partitionEithers <$> withStore' (\db -> getChatPreviews db vr user False (PTLast count) clqNoFilters) unless (null errs) $ toView $ CRChatErrors (Just user) (map ChatErrorStore errs) pure $ CRChats previews LastMessages (Just chatName) count search -> withUser $ \user -> do @@ -1802,22 +1807,22 @@ processChatCommand = \case chatResp <- processChatCommand $ APIGetChat chatRef (CPLast count) search pure $ CRChatItems user (Just chatName) (aChatItems . chat $ chatResp) LastMessages Nothing count search -> withUser $ \user -> do - chatItems <- withStore $ \db -> getAllChatItems db user (CPLast count) search + chatItems <- withStore $ \db -> getAllChatItems db vr user (CPLast count) search pure $ CRChatItems user Nothing chatItems LastChatItemId (Just chatName) index -> withUser $ \user -> do chatRef <- getChatRef user chatName chatResp <- processChatCommand (APIGetChat chatRef (CPLast $ index + 1) Nothing) pure $ CRChatItemId user (fmap aChatItemId . listToMaybe . aChatItems . chat $ chatResp) LastChatItemId Nothing index -> withUser $ \user -> do - chatItems <- withStore $ \db -> getAllChatItems db user (CPLast $ index + 1) Nothing + chatItems <- withStore $ \db -> getAllChatItems db vr user (CPLast $ index + 1) Nothing pure $ CRChatItemId user (fmap aChatItemId . listToMaybe $ chatItems) ShowChatItem (Just itemId) -> withUser $ \user -> do chatItem <- withStore $ \db -> do chatRef <- getChatRefViaItemId db user itemId - getAChatItem db user chatRef itemId + getAChatItem db vr user chatRef itemId pure $ CRChatItems user Nothing ((: []) chatItem) ShowChatItem Nothing -> withUser $ \user -> do - chatItems <- withStore $ \db -> getAllChatItems db user (CPLast 1) Nothing + chatItems <- withStore $ \db -> getAllChatItems db vr user (CPLast 1) Nothing pure $ CRChatItems user Nothing chatItems ShowChatItemInfo chatName msg -> withUser $ \user -> do chatRef <- getChatRef user chatName @@ -1867,10 +1872,10 @@ processChatCommand = \case contact <- withStore $ \db -> getContact db user contactId void . sendDirectContactMessage contact $ XFileCancel sharedMsgId ChatRef CTGroup groupId -> do - Group gInfo ms <- withStore $ \db -> getGroup db user groupId + Group gInfo ms <- withStore $ \db -> getGroup db vr user groupId void . sendGroupMessage user gInfo ms $ XFileCancel sharedMsgId _ -> throwChatError $ CEFileInternal "invalid chat ref for file transfer" - ci <- withStore $ \db -> getChatItemByFileId db user fileId + ci <- withStore $ \db -> getChatItemByFileId db vr user fileId pure $ CRSndFileCancelled user ci ftm fts where fileCancelledOrCompleteSMP SndFileTransfer {fileStatus = s} = @@ -1881,7 +1886,7 @@ processChatCommand = \case | otherwise -> case xftpRcvFile of Nothing -> do cancelRcvFileTransfer user ftr >>= mapM_ (deleteAgentConnectionAsync user) - ci <- withStore $ \db -> getChatItemByFileId db user fileId + ci <- withStore $ \db -> getChatItemByFileId db vr user fileId pure $ CRRcvFileCancelled user ci ftr Just XFTPRcvFile {agentRcvFileId} -> do forM_ (liveRcvFileTransferPath ftr) $ \filePath -> do @@ -1894,10 +1899,10 @@ processChatCommand = \case updateCIFileStatus db user fileId CIFSRcvInvitation updateRcvFileStatus db fileId FSNew updateRcvFileAgentId db fileId Nothing - getChatItemByFileId db user fileId + getChatItemByFileId db vr user fileId pure $ CRRcvFileCancelled user ci ftr FileStatus fileId -> withUser $ \user -> do - ci@(AChatItem _ _ _ ChatItem {file}) <- withStore $ \db -> getChatItemByFileId db user fileId + ci@(AChatItem _ _ _ ChatItem {file}) <- withStore $ \db -> getChatItemByFileId db vr user fileId case file of Just CIFile {fileProtocol = FPXFTP} -> pure $ CRFileTransferStatusXFTP user ci @@ -2199,7 +2204,7 @@ processChatCommand = \case updateGroupProfileByName :: GroupName -> (GroupProfile -> GroupProfile) -> m ChatResponse updateGroupProfileByName gName update = withUser $ \user -> do g@(Group GroupInfo {groupProfile = p} _) <- withStore $ \db -> - getGroupIdByName db user gName >>= getGroup db user + getGroupIdByName db user gName >>= getGroup db vr user runUpdateGroupProfile user g $ update p withCurrentCall :: ContactId -> (User -> Contact -> Call -> m (Maybe Call)) -> m ChatResponse withCurrentCall ctId action = do @@ -2314,15 +2319,16 @@ processChatCommand = \case ctId <- getContactIdByName db user name Contact {chatSettings} <- getContact db user ctId pure (ctId, chatSettings) - CTGroup -> withStore $ \db -> do - gId <- getGroupIdByName db user name - GroupInfo {chatSettings} <- getGroupInfo db user gId - pure (gId, chatSettings) + CTGroup -> + withStore $ \db -> do + gId <- getGroupIdByName db user name + GroupInfo {chatSettings} <- getGroupInfo db vr user gId + pure (gId, chatSettings) _ -> throwChatError $ CECommandError "not supported" processChatCommand $ APISetChatSettings (ChatRef cType chatId) $ updateSettings chatSettings connectPlan :: User -> AConnectionRequestUri -> m ConnectionPlan connectPlan user (ACR SCMInvitation cReq) = do - withStore' (\db -> getConnectionEntityByConnReq db user cReqSchemas) >>= \case + withStore' (\db -> getConnectionEntityByConnReq db vr user cReqSchemas) >>= \case Nothing -> pure $ CPInvitationLink ILPOk Just (RcvDirectMsgConnection conn ct_) -> do let Connection {connStatus, contactConnInitiated} = conn @@ -2351,7 +2357,7 @@ processChatCommand = \case withStore' (\db -> getUserContactLinkByConnReq db user cReqSchemas) >>= \case Just _ -> pure $ CPContactAddress CAPOwnLink Nothing -> - withStore' (\db -> getContactConnEntityByConnReqHash db user cReqHashes) >>= \case + withStore' (\db -> getContactConnEntityByConnReqHash db vr user cReqHashes) >>= \case Nothing -> withStore' (\db -> getContactWithoutConnViaAddress db user cReqSchemas) >>= \case Nothing -> pure $ CPContactAddress CAPOk @@ -2364,11 +2370,11 @@ processChatCommand = \case Just _ -> throwChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection" -- group link Just _ -> - withStore' (\db -> getGroupInfoByUserContactLinkConnReq db user cReqSchemas) >>= \case + withStore' (\db -> getGroupInfoByUserContactLinkConnReq db vr user cReqSchemas) >>= \case Just g -> pure $ CPGroupLink (GLPOwnLink g) Nothing -> do - connEnt_ <- withStore' $ \db -> getContactConnEntityByConnReqHash db user cReqHashes - gInfo_ <- withStore' $ \db -> getGroupInfoByGroupLinkHash db user cReqHashes + connEnt_ <- withStore' $ \db -> getContactConnEntityByConnReqHash db vr user cReqHashes + gInfo_ <- withStore' $ \db -> getGroupInfoByGroupLinkHash db vr user cReqHashes case (gInfo_, connEnt_) of (Nothing, Nothing) -> pure $ CPGroupLink GLPOk (Nothing, Just (RcvDirectMsgConnection _conn Nothing)) -> pure $ CPGroupLink GLPConnectingConfirmReconnect @@ -2598,6 +2604,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI unless (fileStatus == RFSNew) $ case fileStatus of RFSCancelled _ -> throwChatError $ CEFileCancelled fName _ -> throwChatError $ CEFileAlreadyReceiving fName + vr <- chatVersionRange case (xftpRcvFile, fileConnReq) of -- direct file protocol (Nothing, Just connReq) -> do @@ -2605,14 +2612,14 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI dm <- directMessage $ XFileAcpt fName connIds <- joinAgentConnectionAsync user True connReq dm subMode filePath <- getRcvFilePath fileId filePath_ fName True - withStoreCtx (Just "acceptFileReceive, acceptRcvFileTransfer") $ \db -> acceptRcvFileTransfer db user fileId connIds ConnJoined filePath subMode + withStoreCtx (Just "acceptFileReceive, acceptRcvFileTransfer") $ \db -> acceptRcvFileTransfer db vr user fileId connIds ConnJoined filePath subMode -- XFTP (Just XFTPRcvFile {}, _) -> do filePath <- getRcvFilePath fileId filePath_ fName False (ci, rfd) <- withStoreCtx (Just "acceptFileReceive, xftpAcceptRcvFT ...") $ \db -> do -- marking file as accepted and reading description in the same transaction -- to prevent race condition with appending description - ci <- xftpAcceptRcvFT db user fileId filePath + ci <- xftpAcceptRcvFT db vr user fileId filePath rfd <- getRcvFileDescrByRcvFileId db fileId pure (ci, rfd) receiveViaCompleteFD user fileId rfd cryptoArgs @@ -2636,10 +2643,11 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI acceptFile cmdFunction send = do filePath <- getRcvFilePath fileId filePath_ fName True inline <- receiveInline + vr <- chatVersionRange if | inline -> do -- accepting inline - ci <- withStoreCtx (Just "acceptFile, acceptRcvInlineFT") $ \db -> acceptRcvInlineFT db user fileId filePath + ci <- withStoreCtx (Just "acceptFile, acceptRcvInlineFT") $ \db -> acceptRcvInlineFT db vr user fileId filePath sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId send $ XFileAcptInv sharedMsgId Nothing fName pure ci @@ -2648,7 +2656,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI -- accepting via a new connection subMode <- chatReadVar subscriptionMode connIds <- createAgentConnectionAsync user cmdFunction True SCMInvitation subMode - withStoreCtx (Just "acceptFile, acceptRcvFileTransfer") $ \db -> acceptRcvFileTransfer db user fileId connIds ConnNew filePath subMode + withStoreCtx (Just "acceptFile, acceptRcvFileTransfer") $ \db -> acceptRcvFileTransfer db vr user fileId connIds ConnNew filePath subMode receiveInline :: m Bool receiveInline = do ChatConfig {fileChunkSize, inlineFiles = InlineFilesConfig {receiveChunks, offerChunks}} <- asks config @@ -2669,10 +2677,11 @@ receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete} startReceivingFile :: ChatMonad m => User -> FileTransferId -> m () startReceivingFile user fileId = do + vr <- chatVersionRange ci <- withStoreCtx (Just "startReceivingFile, updateRcvFileStatus ...") $ \db -> do liftIO $ updateRcvFileStatus db fileId FSConnected liftIO $ updateCIFileStatus db user fileId $ CIFSRcvTransfer 0 1 - getChatItemByFileId db user fileId + getChatItemByFileId db vr user fileId toView $ CRRcvFileStart user ci getRcvFilePath :: forall m. ChatMonad m => FileTransferId -> Maybe FilePath -> String -> Bool -> m FilePath @@ -2788,14 +2797,14 @@ agentSubscriber = do type AgentBatchSubscribe m = AgentClient -> [ConnId] -> ExceptT AgentErrorType m (Map ConnId (Either AgentErrorType ())) -subscribeUserConnections :: forall m. ChatMonad m => Bool -> AgentBatchSubscribe m -> User -> m () -subscribeUserConnections onlyNeeded agentBatchSubscribe user@User {userId} = do +subscribeUserConnections :: forall m. ChatMonad m => VersionRange -> Bool -> AgentBatchSubscribe m -> User -> m () +subscribeUserConnections vr onlyNeeded agentBatchSubscribe user@User {userId} = do -- get user connections ce <- asks $ subscriptionEvents . config (conns, cts, ucs, gs, ms, sfts, rfts, pcs) <- if onlyNeeded then do - (conns, entities) <- withStore' getConnectionsToSubscribe + (conns, entities) <- withStore' (`getConnectionsToSubscribe` vr) let (cts, ucs, ms, sfts, rfts, pcs) = foldl' addEntity (M.empty, M.empty, M.empty, M.empty, M.empty, M.empty) entities pure (conns, cts, ucs, [], ms, sfts, rfts, pcs) else do @@ -2845,7 +2854,7 @@ subscribeUserConnections onlyNeeded agentBatchSubscribe user@User {userId} = do getContactConns :: m ([ConnId], Map ConnId Contact) getContactConns = do cts <- withStore_ ("subscribeUserConnections " <> show userId <> ", getUserContacts") getUserContacts - let connIds = catMaybes $ map contactConnId (filter contactActive cts) + let connIds = mapMaybe contactConnId (filter contactActive cts) pure (connIds, M.fromList $ zip connIds cts) getUserContactLinkConns :: m ([ConnId], Map ConnId UserContact) getUserContactLinkConns = do @@ -2854,7 +2863,7 @@ subscribeUserConnections onlyNeeded agentBatchSubscribe user@User {userId} = do pure (connIds, M.fromList $ zip connIds ucs) getGroupMemberConns :: m ([Group], [ConnId], Map ConnId GroupMember) getGroupMemberConns = do - gs <- withStore_ ("subscribeUserConnections " <> show userId <> ", getUserGroups") getUserGroups + gs <- withStore_ ("subscribeUserConnections " <> show userId <> ", getUserGroups") (`getUserGroups` vr) let mPairs = concatMap (\(Group _ ms) -> mapMaybe (\m -> (,m) <$> memberConnId m) (filter (not . memberRemoved) ms)) gs pure (gs, map fst mPairs, M.fromList mPairs) getSndFileTransferConns :: m ([ConnId], Map ConnId SndFileTransfer) @@ -3029,12 +3038,13 @@ deleteTimedItem user (ChatRef cType chatId, itemId) deleteAt = do ts <- liftIO getCurrentTime liftIO $ threadDelay' $ diffToMicroseconds $ diffUTCTime deleteAt ts waitChatStarted + vr <- chatVersionRange case cType of CTDirect -> do (ct, CChatItem _ ci) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId deleteDirectCI user ct ci True True >>= toView CTGroup -> do - (gInfo, CChatItem _ ci) <- withStore $ \db -> (,) <$> getGroupInfo db user chatId <*> getGroupChatItem db user chatId itemId + (gInfo, CChatItem _ ci) <- withStore $ \db -> (,) <$> getGroupInfo db vr user chatId <*> getGroupChatItem db user chatId itemId deletedTs <- liftIO getCurrentTime deleteGroupCI user gInfo ci True True Nothing deletedTs >>= toView _ -> toView . CRChatError (Just user) . ChatError $ CEInternalError "bad deleteTimedItem cType" @@ -3049,12 +3059,13 @@ startUpdatedTimedItemThread user chatRef ci ci' = expireChatItems :: forall m. ChatMonad m => User -> Int64 -> Bool -> m () expireChatItems user@User {userId} ttl sync = do currentTs <- liftIO getCurrentTime + vr <- chatVersionRange let expirationDate = addUTCTime (-1 * fromIntegral ttl) currentTs -- this is to keep group messages created during last 12 hours even if they're expired according to item_ts createdAtCutoff = addUTCTime (-43200 :: NominalDiffTime) currentTs contacts <- withStoreCtx' (Just "expireChatItems, getUserContacts") (`getUserContacts` user) loop contacts $ processContact expirationDate - groups <- withStoreCtx' (Just "expireChatItems, getUserGroupDetails") (\db -> getUserGroupDetails db user Nothing Nothing) + groups <- withStoreCtx' (Just "expireChatItems, getUserGroupDetails") (\db -> getUserGroupDetails db vr user Nothing Nothing) loop groups $ processGroup expirationDate createdAtCutoff where loop :: [a] -> (a -> m ()) -> m () @@ -3088,9 +3099,10 @@ processAgentMessage _ connId (DEL_RCVQ srv qId err_) = toView $ CRAgentRcvQueueDeleted (AgentConnId connId) srv (AgentQueueId qId) err_ processAgentMessage _ connId DEL_CONN = toView $ CRAgentConnDeleted (AgentConnId connId) -processAgentMessage corrId connId msg = +processAgentMessage corrId connId msg = do + vr <- chatVersionRange withStore' (`getUserByAConnId` AgentConnId connId) >>= \case - Just user -> processAgentMessageConn user corrId connId msg `catchChatError` (toView . CRChatError (Just user)) + Just user -> processAgentMessageConn vr user corrId connId msg `catchChatError` (toView . CRChatError (Just user)) _ -> throwChatError $ CENoConnectionUser (AgentConnId connId) processAgentMessageNoConn :: forall m. ChatMonad m => ACommand 'Agent 'AENone -> m () @@ -3127,17 +3139,18 @@ processAgentMsgSndFile _corrId aFileId msg = (ft@FileTransferMeta {fileId, cancelled}, sfts) <- withStore $ \db -> do fileId <- getXFTPSndFileDBId db user $ AgentSndFileId aFileId getSndFileTransfer db user fileId + vr <- chatVersionRange unless cancelled $ case msg of SFPROG sndProgress sndTotal -> do let status = CIFSSndTransfer {sndProgress, sndTotal} ci <- withStore $ \db -> do liftIO $ updateCIFileStatus db user fileId status - getChatItemByFileId db user fileId + getChatItemByFileId db vr user fileId toView $ CRSndFileProgressXFTP user ci ft sndProgress sndTotal SFDONE sndDescr rfds -> do withStore' $ \db -> setSndFTPrivateSndDescr db user fileId (fileDescrText sndDescr) ci@(AChatItem _ d cInfo _ci@ChatItem {meta = CIMeta {itemSharedMsgId = msgId_, itemDeleted}}) <- - withStore $ \db -> getChatItemByFileId db user fileId + withStore $ \db -> getChatItemByFileId db vr user fileId case (msgId_, itemDeleted) of (Just sharedMsgId, Nothing) -> do when (length rfds < length sfts) $ throwChatError $ CEInternalError "not enough XFTP file descriptions to send" @@ -3157,7 +3170,7 @@ processAgentMsgSndFile _corrId aFileId msg = forM_ rfdsMemberFTs $ \mt -> sendToMember mt `catchChatError` (toView . CRChatError (Just user)) ci' <- withStore $ \db -> do liftIO $ updateCIFileStatus db user fileId CIFSSndComplete - getChatItemByFileId db user fileId + getChatItemByFileId db vr user fileId withAgent (`xftpDeleteSndFileInternal` aFileId) toView $ CRSndFileCompleteXFTP user ci' ft where @@ -3181,7 +3194,7 @@ processAgentMsgSndFile _corrId aFileId msg = | otherwise -> do ci <- withStore $ \db -> do liftIO $ updateFileCancelled db user fileId CIFSSndError - getChatItemByFileId db user fileId + getChatItemByFileId db vr user fileId withAgent (`xftpDeleteSndFileInternal` aFileId) toView $ CRSndFileError user ci where @@ -3228,12 +3241,13 @@ processAgentMsgRcvFile _corrId aFileId msg = ft@RcvFileTransfer {fileId} <- withStore $ \db -> do fileId <- getXFTPRcvFileDBId db $ AgentRcvFileId aFileId getRcvFileTransfer db user fileId + vr <- chatVersionRange unless (rcvFileCompleteOrCancelled ft) $ case msg of RFPROG rcvProgress rcvTotal -> do let status = CIFSRcvTransfer {rcvProgress, rcvTotal} ci <- withStore $ \db -> do liftIO $ updateCIFileStatus db user fileId status - getChatItemByFileId db user fileId + getChatItemByFileId db vr user fileId toView $ CRRcvFileProgressXFTP user ci rcvProgress rcvTotal RFDONE xftpPath -> case liveRcvFileTransferPath ft of @@ -3245,7 +3259,7 @@ processAgentMsgRcvFile _corrId aFileId msg = liftIO $ do updateRcvFileStatus db fileId FSComplete updateCIFileStatus db user fileId CIFSRcvComplete - getChatItemByFileId db user fileId + getChatItemByFileId db vr user fileId agentXFTPDeleteRcvFile aFileId fileId toView $ CRRcvFileComplete user ci RFERR e @@ -3254,13 +3268,13 @@ processAgentMsgRcvFile _corrId aFileId msg = | otherwise -> do ci <- withStore $ \db -> do liftIO $ updateFileCancelled db user fileId CIFSRcvError - getChatItemByFileId db user fileId + getChatItemByFileId db vr user fileId agentXFTPDeleteRcvFile aFileId fileId toView $ CRRcvFileError user ci e -processAgentMessageConn :: forall m. ChatMonad m => User -> ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> m () -processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do - entity <- withStore (\db -> getConnectionEntity db user $ AgentConnId agentConnId) >>= updateConnStatus +processAgentMessageConn :: forall m. ChatMonad m => VersionRange -> User -> ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> m () +processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = do + entity <- withStore (\db -> getConnectionEntity db vr user $ AgentConnId agentConnId) >>= updateConnStatus case agentMessage of END -> case entity of RcvDirectMsgConnection _ (Just ct) -> toView $ CRContactAnotherClient user ct @@ -3406,7 +3420,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do XOk -> pure () _ -> messageError "INFO for existing contact must have x.grp.mem.info, x.info or x.ok" CON -> - withStore' (\db -> getViaGroupMember db user ct) >>= \case + withStore' (\db -> getViaGroupMember db vr user ct) >>= \case Nothing -> do -- [incognito] print incognito profile used for this contact incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) @@ -3427,7 +3441,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) toView $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci) forM_ groupId_ $ \groupId -> do - groupInfo <- withStore $ \db -> getGroupInfo db user groupId + groupInfo <- withStore $ \db -> getGroupInfo db vr user groupId subMode <- chatReadVar subscriptionMode groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode gVar <- asks random @@ -3595,7 +3609,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do profileToSend = profileToSendOnAccept user profileMode void $ sendDirectMessage conn (XGrpLinkMem profileToSend) (GroupId groupId) sendIntroductions members = do - intros <- withStore' $ \db -> createIntroductions db members m + intros <- withStore' $ \db -> createIntroductions db (maxVersion vr) members m shuffledIntros <- liftIO $ shuffleIntros intros if isCompatibleRange (memberChatVRange' m) batchSendVRange then do @@ -3885,7 +3899,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do CON -> do ci <- withStore $ \db -> do liftIO $ updateSndFileStatus db ft FSConnected - updateDirectCIFileStatus db user fileId $ CIFSSndTransfer 0 1 + updateDirectCIFileStatus db vr user fileId $ CIFSSndTransfer 0 1 toView $ CRSndFileStart user ci ft sendFileChunk user ft SENT msgId -> do @@ -3899,7 +3913,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do getChatRefByFileId db user fileId >>= \case ChatRef CTDirect _ -> liftIO $ updateFileCancelled db user fileId CIFSSndCancelled _ -> pure () - getChatItemByFileId db user fileId + getChatItemByFileId db vr user fileId toView $ CRSndFileRcvCancelled user ci ft _ -> throwChatError $ CEFileSend fileId err MSG meta _ _ -> withAckMessage' agentConnId conn meta $ pure () @@ -3965,7 +3979,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do FileChunkCancel -> unless (rcvFileCompleteOrCancelled ft) $ do cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user) - ci <- withStore $ \db -> getChatItemByFileId db user fileId + ci <- withStore $ \db -> getChatItemByFileId db vr user fileId toView $ CRRcvFileSndCancelled user ci ft FileChunk {chunkNo, chunkBytes = chunk} -> do case integrity of @@ -3988,7 +4002,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do updateRcvFileStatus db fileId FSComplete updateCIFileStatus db user fileId CIFSRcvComplete deleteRcvFileChunks db ft - getChatItemByFileId db user fileId + getChatItemByFileId db vr user fileId toView $ CRRcvFileComplete user ci forM_ conn_ $ \conn -> deleteAgentConnectionAsync user (aConnId conn) RcvChunkDuplicate -> ack $ pure () @@ -4031,7 +4045,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do ct <- acceptContactRequestAsync user cReq incognitoProfile True toView $ CRAcceptingContactRequest user ct Just groupId -> do - gInfo <- withStore $ \db -> getGroupInfo db user groupId + gInfo <- withStore $ \db -> getGroupInfo db vr user groupId let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo if isCompatibleRange chatVRange groupLinkNoContactVRange then do @@ -4524,14 +4538,14 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do ft <- withStore (\db -> getRcvFileTransfer db user fileId) unless (rcvFileCompleteOrCancelled ft) $ do cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user) - ci <- withStore $ \db -> getChatItemByFileId db user fileId + ci <- withStore $ \db -> getChatItemByFileId db vr user fileId toView $ CRRcvFileSndCancelled user ci ft xFileAcptInv :: Contact -> SharedMsgId -> Maybe ConnReqInvitation -> String -> MsgMeta -> m () xFileAcptInv ct sharedMsgId fileConnReq_ fName msgMeta = do checkIntegrityCreateItem (CDDirectRcv ct) msgMeta fileId <- withStore $ \db -> getDirectFileIdBySharedMsgId db user ct sharedMsgId - (AChatItem _ _ _ ci) <- withStore $ \db -> getChatItemByFileId db user fileId + (AChatItem _ _ _ ci) <- withStore $ \db -> getChatItemByFileId db vr user fileId assertSMPAcceptNotProhibited ci ft@FileTransferMeta {fileName, fileSize, fileInline, cancelled} <- withStore (\db -> getFileTransferMeta db user fileId) -- [async agent commands] no continuation needed, but command should be asynchronous for stability @@ -4546,7 +4560,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do -- receiving inline _ -> do event <- withStore $ \db -> do - ci' <- updateDirectCIFileStatus db user fileId $ CIFSSndTransfer 0 1 + ci' <- updateDirectCIFileStatus db vr user fileId $ CIFSSndTransfer 0 1 sft <- createSndDirectInlineFT db ct ft pure $ CRSndFileStart user ci' sft toView event @@ -4574,7 +4588,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do ci@(AChatItem _ _ _ ChatItem {file}) <- withStore $ \db -> do liftIO $ updateSndFileStatus db sft FSComplete liftIO $ deleteSndFileChunks db sft - updateDirectCIFileStatus db user fileId CIFSSndComplete + updateDirectCIFileStatus db vr user fileId CIFSSndComplete case file of Just CIFile {fileProtocol = FPXFTP} -> do ft <- withStore $ \db -> getFileTransferMeta db user fileId @@ -4619,7 +4633,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do ft <- withStore (\db -> getRcvFileTransfer db user fileId) unless (rcvFileCompleteOrCancelled ft) $ do cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user) - ci <- withStore $ \db -> getChatItemByFileId db user fileId + ci <- withStore $ \db -> getChatItemByFileId db vr user fileId toView $ CRRcvFileSndCancelled user ci ft else messageError "x.file.cancel: group member attempted to cancel file of another member" -- shouldn't happen now that query includes group member id (SMDSnd, _) -> messageError "x.file.cancel: group member attempted invalid file cancel" @@ -4627,7 +4641,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do xFileAcptInvGroup :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe ConnReqInvitation -> String -> m () xFileAcptInvGroup GroupInfo {groupId} m@GroupMember {activeConn} sharedMsgId fileConnReq_ fName = do fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId - (AChatItem _ _ _ ci) <- withStore $ \db -> getChatItemByFileId db user fileId + (AChatItem _ _ _ ci) <- withStore $ \db -> getChatItemByFileId db vr user fileId assertSMPAcceptNotProhibited ci -- TODO check that it's not already accepted ft@FileTransferMeta {fileName, fileSize, fileInline, cancelled} <- withStore (\db -> getFileTransferMeta db user fileId) @@ -4643,7 +4657,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do (_, Just conn) -> do -- receiving inline event <- withStore $ \db -> do - ci' <- updateDirectCIFileStatus db user fileId $ CIFSSndTransfer 0 1 + ci' <- updateDirectCIFileStatus db vr user fileId $ CIFSSndTransfer 0 1 sft <- liftIO $ createSndGroupInlineFT db m conn ft pure $ CRSndFileStart user ci' sft toView event @@ -4667,7 +4681,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do when (fromRole < GRAdmin || fromRole < memRole) $ throwChatError (CEGroupContactRole c) when (fromMemId == memId) $ throwChatError CEGroupDuplicateMemberId -- [incognito] if direct connection with host is incognito, create membership using the same incognito profile - (gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership = membership@GroupMember {groupMemberId, memberId}}, hostId) <- withStore $ \db -> createGroupInvitation db user ct inv customUserProfileId + (gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership = membership@GroupMember {groupMemberId, memberId}}, hostId) <- + withStore $ \db -> createGroupInvitation db vr user ct inv customUserProfileId if sameGroupLinkId groupLinkId groupLinkId' then do subMode <- chatReadVar subscriptionMode @@ -5018,14 +5033,14 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do 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 + g <- withStore $ \db -> getGroupInfo db vr 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 + g <- withStore $ \db -> getGroupInfo db vr user groupId toView $ CRContactAndMemberAssociated user c2 g m1 c2' pure c2' @@ -5040,7 +5055,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do toView $ CRContactConnecting user ct pure conn' XGrpLinkInv glInv -> do - (gInfo, host) <- withStore $ \db -> createGroupInvitedViaLink db user conn' glInv + (gInfo, host) <- withStore $ \db -> createGroupInvitedViaLink db vr user conn' glInv toView $ CRGroupLinkConnecting user gInfo host pure conn' -- TODO show/log error, other events in SMP confirmation @@ -5440,14 +5455,15 @@ parseChatMessage conn s = do sendFileChunk :: ChatMonad m => User -> SndFileTransfer -> m () sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentConnId acId} = - unless (fileStatus == FSComplete || fileStatus == FSCancelled) $ + unless (fileStatus == FSComplete || fileStatus == FSCancelled) $ do + vr <- chatVersionRange withStore' (`createSndFileChunk` ft) >>= \case Just chunkNo -> sendFileChunkNo ft chunkNo Nothing -> do ci <- withStore $ \db -> do liftIO $ updateSndFileStatus db ft FSComplete liftIO $ deleteSndFileChunks db ft - updateDirectCIFileStatus db user fileId CIFSSndComplete + updateDirectCIFileStatus db vr user fileId CIFSSndComplete toView $ CRSndFileComplete user ci ft closeFileHandle fileId sndFiles deleteAgentConnectionAsync user acId @@ -5612,8 +5628,8 @@ sendDirectMessage conn chatMsgEvent connOrGroupId = do createSndMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> ConnOrGroupId -> m SndMessage createSndMessage chatMsgEvent connOrGroupId = do gVar <- asks random - ChatConfig {chatVRange} <- asks config - withStore $ \db -> createNewSndMessage db gVar connOrGroupId chatMsgEvent (encodeMessage chatVRange) + vr <- chatVersionRange + withStore $ \db -> createNewSndMessage db gVar connOrGroupId chatMsgEvent (encodeMessage vr) where encodeMessage chatVRange sharedMsgId = encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent} @@ -5639,8 +5655,8 @@ sendGroupMemberMessages user conn@Connection {connId} events groupId = do createSndMessages :: m [Either ChatError SndMessage] createSndMessages = do gVar <- asks random - ChatConfig {chatVRange} <- asks config - withStoreBatch $ \db -> map (createMsg db gVar chatVRange) (toList events) + vr <- chatVersionRange + withStoreBatch $ \db -> map (createMsg db gVar vr) (toList events) createMsg db gVar chatVRange evnt = do r <- runExceptT $ createNewSndMessage db gVar (GroupId groupId) evnt (encodeMessage chatVRange evnt) pure $ first ChatErrorStore r @@ -5649,7 +5665,7 @@ sendGroupMemberMessages user conn@Connection {connId} events groupId = do directMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> m ByteString directMessage chatMsgEvent = do - ChatConfig {chatVRange} <- asks config + chatVRange <- chatVersionRange let r = encodeChatMessage ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent} case r of ECMEncoded encodedBody -> pure . LB.toStrict $ encodedBody @@ -6102,6 +6118,11 @@ waitChatStarted = do agentStarted <- asks agentAsync atomically $ readTVar agentStarted >>= \a -> unless (isJust a) retry +chatVersionRange :: ChatMonad' m => m VersionRange +chatVersionRange = do + ChatConfig {chatVRange} <- asks config + pure chatVRange + chatCommandP :: Parser ChatCommand chatCommandP = choice diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 5cda18c29..a0df9f986 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -52,9 +52,13 @@ import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, fstTo import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>)) import Simplex.Messaging.Version hiding (version) +-- This should not be used directly in code, instead use `maxVersion chatVRange` from ChatConfig. +-- This indirection is needed for backward/forward compatibility testing. +-- Testing with real app versions is still needed, as tests use the current code with different version ranges, not the old code. currentChatVersion :: Version currentChatVersion = 5 +-- This should not be used directly in code, instead use `chatVRange` from ChatConfig (see comment above) supportedChatVRange :: VersionRange supportedChatVRange = mkVersionRange 1 currentChatVersion diff --git a/src/Simplex/Chat/Remote/Protocol.hs b/src/Simplex/Chat/Remote/Protocol.hs index b8ff84709..7b3d70ff9 100644 --- a/src/Simplex/Chat/Remote/Protocol.hs +++ b/src/Simplex/Chat/Remote/Protocol.hs @@ -38,7 +38,6 @@ import Simplex.Chat.Controller import Simplex.Chat.Remote.Transport import Simplex.Chat.Remote.Types import Simplex.FileTransfer.Description (FileDigest (..)) -import Simplex.Messaging.Agent.Client (agentDRG) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..)) import Simplex.Messaging.Crypto.Lazy (LazyByteString) diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index a72b23886..580120b2a 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -35,9 +35,10 @@ import Simplex.Messaging.Agent.Protocol (ConnId) import Simplex.Messaging.Agent.Store.SQLite (firstRow, firstRow', maybeFirstRow) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import Simplex.Messaging.Util (eitherToMaybe) +import Simplex.Messaging.Version (VersionRange) -getConnectionEntity :: DB.Connection -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity -getConnectionEntity db user@User {userId, userContactId} agentConnId = do +getConnectionEntity :: DB.Connection -> VersionRange -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity +getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do c@Connection {connType, entityId} <- getConnection_ case entityId of Nothing -> @@ -115,7 +116,7 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do (groupMemberId, userId, userContactId) toGroupAndMember :: Connection -> GroupInfoRow :. GroupMemberRow -> (GroupInfo, GroupMember) toGroupAndMember c (groupInfoRow :. memberRow) = - let groupInfo = toGroupInfo userContactId groupInfoRow + let groupInfo = toGroupInfo vr userContactId groupInfoRow member = toGroupMember userContactId memberRow in (groupInfo, (member :: GroupMember) {activeConn = Just c}) getConnSndFileTransfer_ :: Int64 -> Connection -> ExceptT StoreError IO SndFileTransfer @@ -154,19 +155,19 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do userContact_ [(cReq, groupId)] = Right UserContact {userContactLinkId, connReqContact = cReq, groupId} userContact_ _ = Left SEUserContactLinkNotFound -getConnectionEntityByConnReq :: DB.Connection -> User -> (ConnReqInvitation, ConnReqInvitation) -> IO (Maybe ConnectionEntity) -getConnectionEntityByConnReq db user@User {userId} (cReqSchema1, cReqSchema2) = do +getConnectionEntityByConnReq :: DB.Connection -> VersionRange -> User -> (ConnReqInvitation, ConnReqInvitation) -> IO (Maybe ConnectionEntity) +getConnectionEntityByConnReq db vr user@User {userId} (cReqSchema1, cReqSchema2) = do connId_ <- maybeFirstRow fromOnly $ DB.query db "SELECT agent_conn_id FROM connections WHERE user_id = ? AND conn_req_inv IN (?,?) LIMIT 1" (userId, cReqSchema1, cReqSchema2) - maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db user) connId_ + maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db vr user) connId_ -- search connection for connection plan: -- multiple connections can have same via_contact_uri_hash if request was repeated; -- this function searches for latest connection with contact so that "known contact" plan would be chosen; -- deleted connections are filtered out to allow re-connecting via same contact address -getContactConnEntityByConnReqHash :: DB.Connection -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe ConnectionEntity) -getContactConnEntityByConnReqHash db user@User {userId} (cReqHash1, cReqHash2) = do +getContactConnEntityByConnReqHash :: DB.Connection -> VersionRange -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe ConnectionEntity) +getContactConnEntityByConnReqHash db vr user@User {userId} (cReqHash1, cReqHash2) = do connId_ <- maybeFirstRow fromOnly $ DB.query @@ -183,14 +184,14 @@ getContactConnEntityByConnReqHash db user@User {userId} (cReqHash1, cReqHash2) = ) |] (userId, cReqHash1, cReqHash2, ConnDeleted) - maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db user) connId_ + maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db vr user) connId_ -getConnectionsToSubscribe :: DB.Connection -> IO ([ConnId], [ConnectionEntity]) -getConnectionsToSubscribe db = do +getConnectionsToSubscribe :: DB.Connection -> VersionRange -> IO ([ConnId], [ConnectionEntity]) +getConnectionsToSubscribe db vr = do aConnIds <- map fromOnly <$> DB.query_ db "SELECT agent_conn_id FROM connections where to_subscribe = 1" entities <- forM aConnIds $ \acId -> do getUserByAConnId db acId >>= \case - Just user -> eitherToMaybe <$> runExceptT (getConnectionEntity db user acId) + Just user -> eitherToMaybe <$> runExceptT (getConnectionEntity db vr user acId) Nothing -> pure Nothing unsetConnectionToSubscribe db let connIds = map (\(AgentConnId connId) -> connId) aConnIds diff --git a/src/Simplex/Chat/Store/Files.hs b/src/Simplex/Chat/Store/Files.hs index b92dbc3e3..4d419c572 100644 --- a/src/Simplex/Chat/Store/Files.hs +++ b/src/Simplex/Chat/Store/Files.hs @@ -107,6 +107,7 @@ import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) import qualified Simplex.Messaging.Crypto.File as CF import Simplex.Messaging.Protocol (SubscriptionMode (..)) +import Simplex.Messaging.Version (VersionRange) getLiveSndFileTransfers :: DB.Connection -> User -> IO [SndFileTransfer] getLiveSndFileTransfers db User {userId} = do @@ -677,8 +678,8 @@ getRcvFileTransfer_ db userId fileId = do _ -> pure Nothing cancelled = fromMaybe False cancelled_ -acceptRcvFileTransfer :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> ConnStatus -> FilePath -> SubscriptionMode -> ExceptT StoreError IO AChatItem -acceptRcvFileTransfer db user@User {userId} fileId (cmdId, acId) connStatus filePath subMode = ExceptT $ do +acceptRcvFileTransfer :: DB.Connection -> VersionRange -> User -> Int64 -> (CommandId, ConnId) -> ConnStatus -> FilePath -> SubscriptionMode -> ExceptT StoreError IO AChatItem +acceptRcvFileTransfer db vr user@User {userId} fileId (cmdId, acId) connStatus filePath subMode = ExceptT $ do currentTs <- getCurrentTime acceptRcvFT_ db user fileId filePath Nothing currentTs DB.execute @@ -687,7 +688,7 @@ acceptRcvFileTransfer db user@User {userId} fileId (cmdId, acId) connStatus file (acId, connStatus, ConnRcvFile, fileId, userId, currentTs, currentTs, subMode == SMOnlyCreate) connId <- insertedRowId db setCommandConnId db user cmdId connId - runExceptT $ getChatItemByFileId db user fileId + runExceptT $ getChatItemByFileId db vr user fileId getContactByFileId :: DB.Connection -> User -> FileTransferId -> ExceptT StoreError IO Contact getContactByFileId db user@User {userId} fileId = do @@ -698,19 +699,19 @@ getContactByFileId db user@User {userId} fileId = do ExceptT . firstRow fromOnly (SEContactNotFoundByFileId fileId) $ DB.query db "SELECT contact_id FROM files WHERE user_id = ? AND file_id = ?" (userId, fileId) -acceptRcvInlineFT :: DB.Connection -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem -acceptRcvInlineFT db user fileId filePath = do +acceptRcvInlineFT :: DB.Connection -> VersionRange -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem +acceptRcvInlineFT db vr user fileId filePath = do liftIO $ acceptRcvFT_ db user fileId filePath (Just IFMOffer) =<< getCurrentTime - getChatItemByFileId db user fileId + getChatItemByFileId db vr user fileId startRcvInlineFT :: DB.Connection -> User -> RcvFileTransfer -> FilePath -> Maybe InlineFileMode -> IO () startRcvInlineFT db user RcvFileTransfer {fileId} filePath rcvFileInline = acceptRcvFT_ db user fileId filePath rcvFileInline =<< getCurrentTime -xftpAcceptRcvFT :: DB.Connection -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem -xftpAcceptRcvFT db user fileId filePath = do +xftpAcceptRcvFT :: DB.Connection -> VersionRange -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem +xftpAcceptRcvFT db vr user fileId filePath = do liftIO $ acceptRcvFT_ db user fileId filePath Nothing =<< getCurrentTime - getChatItemByFileId db user fileId + getChatItemByFileId db vr user fileId acceptRcvFT_ :: DB.Connection -> User -> FileTransferId -> FilePath -> Maybe InlineFileMode -> UTCTime -> IO () acceptRcvFT_ db User {userId} fileId filePath rcvFileInline currentTs = do @@ -930,9 +931,9 @@ getLocalCryptoFile db userId fileId sent = FileTransferMeta {filePath, xftpSndFile} <- getFileTransferMeta_ db userId fileId pure $ CryptoFile filePath $ xftpSndFile >>= \f -> f.cryptoArgs -updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem -updateDirectCIFileStatus db user fileId fileStatus = do - aci@(AChatItem cType d cInfo ci) <- getChatItemByFileId db user fileId +updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> VersionRange -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem +updateDirectCIFileStatus db vr user fileId fileStatus = do + aci@(AChatItem cType d cInfo ci) <- getChatItemByFileId db vr user fileId case (cType, testEquality d $ msgDirection @d) of (SCTDirect, Just Refl) -> do liftIO $ updateCIFileStatus db user fileId fileStatus diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 746d7df12..206662636 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -128,7 +128,7 @@ import Data.Time.Clock (UTCTime (..), getCurrentTime) import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), (:.) (..)) import Database.SQLite.Simple.QQ (sql) import Simplex.Chat.Messages -import Simplex.Chat.Protocol (currentChatVersion, groupForwardVRange, supportedChatVRange) +import Simplex.Chat.Protocol (groupForwardVRange) import Simplex.Chat.Store.Direct import Simplex.Chat.Store.Shared import Simplex.Chat.Types @@ -148,9 +148,9 @@ type GroupMemberRow = ((Int64, Int64, MemberId, Version, Version, GroupMemberRol type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe Version, Maybe Version, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences)) -toGroupInfo :: Int64 -> GroupInfoRow -> GroupInfo -toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs) :. userMemberRow) = - let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = JVersionRange supportedChatVRange} +toGroupInfo :: VersionRange -> Int64 -> GroupInfoRow -> GroupInfo +toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs) :. userMemberRow) = + let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = JVersionRange vr} chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} fullGroupPreferences = mergeGroupPreferences groupPreferences groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences} @@ -252,8 +252,8 @@ setGroupLinkMemberRole :: DB.Connection -> User -> Int64 -> GroupMemberRole -> I setGroupLinkMemberRole db User {userId} userContactLinkId memberRole = DB.execute db "UPDATE user_contact_links SET group_link_member_role = ? WHERE user_id = ? AND user_contact_link_id = ?" (memberRole, userId, userContactLinkId) -getGroupAndMember :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO (GroupInfo, GroupMember) -getGroupAndMember db User {userId, userContactId} groupMemberId = +getGroupAndMember :: DB.Connection -> User -> Int64 -> VersionRange -> ExceptT StoreError IO (GroupInfo, GroupMember) +getGroupAndMember db User {userId, userContactId} groupMemberId vr = ExceptT . firstRow toGroupAndMember (SEInternalError "referenced group member not found") $ DB.query db @@ -289,13 +289,13 @@ getGroupAndMember db User {userId, userContactId} groupMemberId = where toGroupAndMember :: (GroupInfoRow :. GroupMemberRow :. MaybeConnectionRow) -> (GroupInfo, GroupMember) toGroupAndMember (groupInfoRow :. memberRow :. connRow) = - let groupInfo = toGroupInfo userContactId groupInfoRow + let groupInfo = toGroupInfo vr userContactId groupInfoRow member = toGroupMember userContactId memberRow in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection connRow}) -- | creates completely new group with a single member - the current user -createNewGroup :: DB.Connection -> TVar ChaChaDRG -> User -> GroupProfile -> Maybe Profile -> ExceptT StoreError IO GroupInfo -createNewGroup db gVar user@User {userId} groupProfile incognitoProfile = ExceptT $ do +createNewGroup :: DB.Connection -> VersionRange -> TVar ChaChaDRG -> User -> GroupProfile -> Maybe Profile -> ExceptT StoreError IO GroupInfo +createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = ExceptT $ do let GroupProfile {displayName, fullName, description, image, groupPreferences} = groupProfile fullGroupPreferences = mergeGroupPreferences groupPreferences currentTs <- getCurrentTime @@ -313,18 +313,18 @@ createNewGroup db gVar user@User {userId} groupProfile incognitoProfile = Except (ldn, userId, profileId, True, currentTs, currentTs, currentTs) insertedRowId db memberId <- liftIO $ encodedRandomBytes gVar 12 - membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser customUserProfileId currentTs supportedChatVRange + membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser customUserProfileId currentTs vr let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False} pure GroupInfo {groupId, localDisplayName = ldn, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = Nothing, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs} -- | creates a new group record for the group the current user was invited to, or returns an existing one -createGroupInvitation :: DB.Connection -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId) -createGroupInvitation _ _ Contact {localDisplayName, activeConn = Nothing} _ _ = throwError $ SEContactNotReady localDisplayName -createGroupInvitation db user@User {userId} contact@Contact {contactId, activeConn = Just hostConn@Connection {customUserProfileId}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do +createGroupInvitation :: DB.Connection -> VersionRange -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId) +createGroupInvitation _ _ _ Contact {localDisplayName, activeConn = Nothing} _ _ = throwError $ SEContactNotReady localDisplayName +createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activeConn = Just hostConn@Connection {customUserProfileId}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do liftIO getInvitationGroupId_ >>= \case Nothing -> createGroupInvitation_ Just gId -> do - gInfo@GroupInfo {membership, groupProfile = p'} <- getGroupInfo db user gId + gInfo@GroupInfo {membership, groupProfile = p'} <- getGroupInfo db vr user gId hostId <- getHostMemberId_ db user gId let GroupMember {groupMemberId, memberId, memberRole} = membership MemberIdRole {memberId = memberId', memberRole = memberRole'} = invitedMember @@ -360,7 +360,7 @@ createGroupInvitation db user@User {userId} contact@Contact {contactId, activeCo insertedRowId db let JVersionRange hostVRange = hostConn.peerChatVRange GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs hostVRange - membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs supportedChatVRange + membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs vr let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False} pure (GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = customUserProfileId, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs}, groupMemberId) @@ -431,9 +431,10 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe ) pure $ Right incognitoLdn -createGroupInvitedViaLink :: DB.Connection -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember) +createGroupInvitedViaLink :: DB.Connection -> VersionRange -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember) createGroupInvitedViaLink db + vr user@User {userId, userContactId} Connection {connId, customUserProfileId} GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile} = do @@ -442,9 +443,9 @@ createGroupInvitedViaLink hostMemberId <- insertHost_ currentTs groupId liftIO $ DB.execute db "UPDATE connections SET conn_type = ?, group_member_id = ?, updated_at = ? WHERE connection_id = ?" (ConnMember, hostMemberId, currentTs, connId) -- using IBUnknown since host is created without contact - void $ createContactMemberInv_ db user groupId (Just hostMemberId) user invitedMember GCUserMember GSMemAccepted IBUnknown customUserProfileId currentTs supportedChatVRange + void $ createContactMemberInv_ db user groupId (Just hostMemberId) user invitedMember GCUserMember GSMemAccepted IBUnknown customUserProfileId currentTs vr liftIO $ setViaGroupLinkHash db groupId connId - (,) <$> getGroupInfo db user groupId <*> getGroupMemberById db user hostMemberId + (,) <$> getGroupInfo db vr user groupId <*> getGroupMemberById db user hostMemberId where insertGroup_ currentTs = ExceptT $ do let GroupProfile {displayName, fullName, description, image, groupPreferences} = groupProfile @@ -497,9 +498,9 @@ setGroupInvitationChatItemId db User {userId} groupId chatItemId = do -- TODO return the last connection that is ready, not any last connection -- requires updating connection status -getGroup :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO Group -getGroup db user groupId = do - gInfo <- getGroupInfo db user groupId +getGroup :: DB.Connection -> VersionRange -> User -> GroupId -> ExceptT StoreError IO Group +getGroup db vr user groupId = do + gInfo <- getGroupInfo db vr user groupId members <- liftIO $ getGroupMembers db user gInfo pure $ Group gInfo members @@ -552,14 +553,14 @@ deleteGroupProfile_ db userId groupId = |] (userId, groupId) -getUserGroups :: DB.Connection -> User -> IO [Group] -getUserGroups db user@User {userId} = do +getUserGroups :: DB.Connection -> VersionRange -> User -> IO [Group] +getUserGroups db vr user@User {userId} = do groupIds <- map fromOnly <$> DB.query db "SELECT group_id FROM groups WHERE user_id = ?" (Only userId) - rights <$> mapM (runExceptT . getGroup db user) groupIds + rights <$> mapM (runExceptT . getGroup db vr user) groupIds -getUserGroupDetails :: DB.Connection -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfo] -getUserGroupDetails db User {userId, userContactId} _contactId_ search_ = - map (toGroupInfo userContactId) +getUserGroupDetails :: DB.Connection -> VersionRange -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfo] +getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = + map (toGroupInfo vr userContactId) <$> DB.query db [sql| @@ -577,9 +578,9 @@ getUserGroupDetails db User {userId, userContactId} _contactId_ search_ = where search = fromMaybe "" search_ -getUserGroupsWithSummary :: DB.Connection -> User -> Maybe ContactId -> Maybe String -> IO [(GroupInfo, GroupSummary)] -getUserGroupsWithSummary db user _contactId_ search_ = - getUserGroupDetails db user _contactId_ search_ +getUserGroupsWithSummary :: DB.Connection -> VersionRange -> User -> Maybe ContactId -> Maybe String -> IO [(GroupInfo, GroupSummary)] +getUserGroupsWithSummary db vr user _contactId_ search_ = + getUserGroupDetails db vr user _contactId_ search_ >>= mapM (\g@GroupInfo {groupId} -> (g,) <$> getGroupSummary db user groupId) -- the statuses on non-current members should match memberCurrent' function @@ -620,10 +621,10 @@ checkContactHasGroups :: DB.Connection -> User -> Contact -> IO (Maybe GroupId) checkContactHasGroups db User {userId} Contact {contactId} = maybeFirstRow fromOnly $ DB.query db "SELECT group_id FROM group_members WHERE user_id = ? AND contact_id = ? LIMIT 1" (userId, contactId) -getGroupInfoByName :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO GroupInfo -getGroupInfoByName db user gName = do +getGroupInfoByName :: DB.Connection -> VersionRange -> User -> GroupName -> ExceptT StoreError IO GroupInfo +getGroupInfoByName db vr user gName = do gId <- getGroupIdByName db user gName - getGroupInfo db user gId + getGroupInfo db vr user gId groupMemberQuery :: Query groupMemberQuery = @@ -709,11 +710,11 @@ getGroupCurrentMembersCount db User {userId} GroupInfo {groupId} = do (groupId, userId) pure $ length $ filter memberCurrent' statuses -getGroupInvitation :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation -getGroupInvitation db user groupId = +getGroupInvitation :: DB.Connection -> VersionRange -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation +getGroupInvitation db vr user groupId = getConnRec_ user >>= \case Just connRequest -> do - groupInfo@GroupInfo {membership} <- getGroupInfo db user groupId + groupInfo@GroupInfo {membership} <- getGroupInfo db vr user groupId when (memberStatus membership /= GSMemInvited) $ throwError SEGroupAlreadyJoined hostId <- getHostMemberId_ db user groupId fromMember <- getGroupMember db user groupId hostId @@ -1005,8 +1006,8 @@ updateGroupMemberRole :: DB.Connection -> User -> GroupMember -> GroupMemberRole updateGroupMemberRole db User {userId} GroupMember {groupMemberId} memRole = DB.execute db "UPDATE group_members SET member_role = ? WHERE user_id = ? AND group_member_id = ?" (memRole, userId, groupMemberId) -createIntroductions :: DB.Connection -> [GroupMember] -> GroupMember -> IO [GroupMemberIntro] -createIntroductions db members toMember = do +createIntroductions :: DB.Connection -> Version -> [GroupMember] -> GroupMember -> IO [GroupMemberIntro] +createIntroductions db chatV members toMember = do let reMembers = filter (\m -> memberCurrent m && groupMemberId' m /= groupMemberId' toMember) members if null reMembers then pure [] @@ -1023,7 +1024,7 @@ createIntroductions db members toMember = do (re_group_member_id, to_group_member_id, intro_status, intro_chat_protocol_version, created_at, updated_at) VALUES (?,?,?,?,?,?) |] - (groupMemberId' reMember, groupMemberId' toMember, GMIntroPending, currentChatVersion, ts, ts) + (groupMemberId' reMember, groupMemberId' toMember, GMIntroPending, chatV, ts, ts) introId <- insertedRowId db pure GroupMemberIntro {introId, reMember, toMember, introStatus = GMIntroPending, introInvitation = Nothing} @@ -1201,8 +1202,8 @@ createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> VersionRange -> Maybe Int64 -> Int -> UTCTime -> SubscriptionMode -> IO Connection createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange viaContact = createConnection_ db userId ConnMember (Just groupMemberId) agentConnId peerChatVRange viaContact Nothing Nothing -getViaGroupMember :: DB.Connection -> User -> Contact -> IO (Maybe (GroupInfo, GroupMember)) -getViaGroupMember db User {userId, userContactId} Contact {contactId} = +getViaGroupMember :: DB.Connection -> VersionRange -> User -> Contact -> IO (Maybe (GroupInfo, GroupMember)) +getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = maybeFirstRow toGroupAndMember $ DB.query db @@ -1239,7 +1240,7 @@ getViaGroupMember db User {userId, userContactId} Contact {contactId} = where toGroupAndMember :: (GroupInfoRow :. GroupMemberRow :. MaybeConnectionRow) -> (GroupInfo, GroupMember) toGroupAndMember (groupInfoRow :. memberRow :. connRow) = - let groupInfo = toGroupInfo userContactId groupInfoRow + let groupInfo = toGroupInfo vr userContactId groupInfoRow member = toGroupMember userContactId memberRow in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection connRow}) @@ -1294,9 +1295,9 @@ updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, grou (ldn, currentTs, userId, groupId) DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId) -getGroupInfo :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO GroupInfo -getGroupInfo db User {userId, userContactId} groupId = - ExceptT . firstRow (toGroupInfo userContactId) (SEGroupNotFound groupId) $ +getGroupInfo :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO GroupInfo +getGroupInfo db vr User {userId, userContactId} groupId = + ExceptT . firstRow (toGroupInfo vr userContactId) (SEGroupNotFound groupId) $ DB.query db [sql| @@ -1315,8 +1316,8 @@ getGroupInfo db User {userId, userContactId} groupId = |] (groupId, userId, userContactId) -getGroupInfoByUserContactLinkConnReq :: DB.Connection -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe GroupInfo) -getGroupInfoByUserContactLinkConnReq db user@User {userId} (cReqSchema1, cReqSchema2) = do +getGroupInfoByUserContactLinkConnReq :: DB.Connection -> VersionRange -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe GroupInfo) +getGroupInfoByUserContactLinkConnReq db vr user@User {userId} (cReqSchema1, cReqSchema2) = do groupId_ <- maybeFirstRow fromOnly $ DB.query @@ -1327,10 +1328,10 @@ getGroupInfoByUserContactLinkConnReq db user@User {userId} (cReqSchema1, cReqSch WHERE user_id = ? AND conn_req_contact IN (?,?) |] (userId, cReqSchema1, cReqSchema2) - maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db user) groupId_ + maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db vr user) groupId_ -getGroupInfoByGroupLinkHash :: DB.Connection -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe GroupInfo) -getGroupInfoByGroupLinkHash db user@User {userId, userContactId} (groupLinkHash1, groupLinkHash2) = do +getGroupInfoByGroupLinkHash :: DB.Connection -> VersionRange -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe GroupInfo) +getGroupInfoByGroupLinkHash db vr user@User {userId, userContactId} (groupLinkHash1, groupLinkHash2) = do groupId_ <- maybeFirstRow fromOnly $ DB.query @@ -1344,7 +1345,7 @@ getGroupInfoByGroupLinkHash db user@User {userId, userContactId} (groupLinkHash1 LIMIT 1 |] (userId, groupLinkHash1, groupLinkHash2, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted) - maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db user) groupId_ + maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db vr user) groupId_ getGroupIdByName :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO GroupId getGroupIdByName db User {userId} gName = @@ -1356,8 +1357,8 @@ getGroupMemberIdByName db User {userId} groupId groupMemberName = ExceptT . firstRow fromOnly (SEGroupMemberNameNotFound groupId groupMemberName) $ DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND local_display_name = ?" (userId, groupId, groupMemberName) -getActiveMembersByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO [(GroupInfo, GroupMember)] -getActiveMembersByName db user@User {userId} groupMemberName = do +getActiveMembersByName :: DB.Connection -> VersionRange -> User -> ContactName -> ExceptT StoreError IO [(GroupInfo, GroupMember)] +getActiveMembersByName db vr user@User {userId} groupMemberName = do groupMemberIds :: [(GroupId, GroupMemberId)] <- liftIO $ DB.query @@ -1370,7 +1371,7 @@ getActiveMembersByName db user@User {userId} groupMemberName = do |] (userId, groupMemberName, GSMemConnected, GSMemComplete, GCUserMember) possibleMembers <- forM groupMemberIds $ \(groupId, groupMemberId) -> do - groupInfo <- getGroupInfo db user groupId + groupInfo <- getGroupInfo db vr user groupId groupMember <- getGroupMember db user groupId groupMemberId pure (groupInfo, groupMember) pure $ sortOn (Down . ts . fst) possibleMembers @@ -1827,15 +1828,15 @@ createMemberContact mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False} -getMemberContact :: DB.Connection -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation) -getMemberContact db user contactId = do +getMemberContact :: DB.Connection -> VersionRange -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation) +getMemberContact db vr user contactId = do ct <- getContact db user contactId let Contact {contactGroupMemberId, activeConn} = ct case (activeConn, contactGroupMemberId) of (Just Connection {connId}, Just groupMemberId) -> do cReq <- getConnReqInv db connId m@GroupMember {groupId} <- getGroupMemberById db user groupMemberId - g <- getGroupInfo db user groupId + g <- getGroupInfo db vr user groupId pure (g, m, ct, cReq) _ -> throwError $ SEMemberContactGroupMemberNotFound contactId diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 5b19c3c70..fc840849a 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -134,6 +134,7 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) import Simplex.Messaging.Util (eitherToMaybe) +import Simplex.Messaging.Version (VersionRange) import UnliftIO.STM deleteContactCIs :: DB.Connection -> User -> Contact -> IO () @@ -461,8 +462,8 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe ciQuoteGroup [] = ciQuote Nothing $ CIQGroupRcv Nothing ciQuoteGroup ((Only itemId :. memberRow) : _) = ciQuote itemId . CIQGroupRcv . Just $ toGroupMember userContactId memberRow -getChatPreviews :: DB.Connection -> User -> Bool -> PaginationByTime -> ChatListQuery -> IO [Either StoreError AChat] -getChatPreviews db user withPCC pagination query = do +getChatPreviews :: DB.Connection -> VersionRange -> User -> Bool -> PaginationByTime -> ChatListQuery -> IO [Either StoreError AChat] +getChatPreviews db vr user withPCC pagination query = do directChats <- findDirectChatPreviews_ db user pagination query groupChats <- findGroupChatPreviews_ db user pagination query cReqChats <- getContactRequestChatPreviews_ db user pagination query @@ -483,7 +484,7 @@ getChatPreviews db user withPCC pagination query = do getChatPreview :: AChatPreviewData -> ExceptT StoreError IO AChat getChatPreview (ACPD cType cpd) = case cType of SCTDirect -> getDirectChatPreview_ db user cpd - SCTGroup -> getGroupChatPreview_ db user cpd + SCTGroup -> getGroupChatPreview_ db vr user cpd SCTContactRequest -> let (ContactRequestPD _ chat) = cpd in pure chat SCTContactConnection -> let (ContactConnectionPD _ chat) = cpd in pure chat @@ -688,9 +689,9 @@ findGroupChatPreviews_ db User {userId} pagination clq = ) ([":user_id" := userId, ":rcv_new" := CISRcvNew, ":search" := search] <> pagParams) -getGroupChatPreview_ :: DB.Connection -> User -> ChatPreviewData 'CTGroup -> ExceptT StoreError IO AChat -getGroupChatPreview_ db user (GroupChatPD _ groupId lastItemId_ stats) = do - groupInfo <- getGroupInfo db user groupId +getGroupChatPreview_ :: DB.Connection -> VersionRange -> User -> ChatPreviewData 'CTGroup -> ExceptT StoreError IO AChat +getGroupChatPreview_ db vr user (GroupChatPD _ groupId lastItemId_ stats) = do + groupInfo <- getGroupInfo db vr user groupId lastItem <- case lastItemId_ of Just lastItemId -> (: []) <$> getGroupChatItem db user groupId lastItemId Nothing -> pure [] @@ -874,10 +875,10 @@ getDirectChatBefore_ db User {userId} ct@Contact {contactId} beforeChatItemId co |] (userId, contactId, search, beforeChatItemId, count) -getGroupChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTGroup) -getGroupChat db user groupId pagination search_ = do +getGroupChat :: DB.Connection -> VersionRange -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTGroup) +getGroupChat db vr user groupId pagination search_ = do let search = fromMaybe "" search_ - g <- getGroupInfo db user groupId + g <- getGroupInfo db vr user groupId case pagination of CPLast count -> getGroupChatLast_ db user g count search CPAfter afterId count -> getGroupChatAfter_ db user g afterId count search @@ -1185,19 +1186,19 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, ciTimed :: Maybe CITimed ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt} -getAllChatItems :: DB.Connection -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem] -getAllChatItems db user@User {userId} pagination search_ = do +getAllChatItems :: DB.Connection -> VersionRange -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem] +getAllChatItems db vr user@User {userId} pagination search_ = do itemRefs <- rights . map toChatItemRef <$> case pagination of CPLast count -> liftIO $ getAllChatItemsLast_ count CPAfter afterId count -> liftIO . getAllChatItemsAfter_ afterId count . aChatItemTs =<< getAChatItem_ afterId CPBefore beforeId count -> liftIO . getAllChatItemsBefore_ beforeId count . aChatItemTs =<< getAChatItem_ beforeId - mapM (uncurry (getAChatItem db user) >=> liftIO . getACIReactions db) itemRefs + mapM (uncurry (getAChatItem db vr user) >=> liftIO . getACIReactions db) itemRefs where search = fromMaybe "" search_ getAChatItem_ itemId = do chatRef <- getChatRefViaItemId db user itemId - getAChatItem db user chatRef itemId + getAChatItem db vr user chatRef itemId getAllChatItemsLast_ count = reverse <$> DB.query @@ -1713,8 +1714,8 @@ getGroupChatItemIdByText' db User {userId} groupId msg = |] (userId, groupId, msg <> "%") -getChatItemByFileId :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO AChatItem -getChatItemByFileId db user@User {userId} fileId = do +getChatItemByFileId :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO AChatItem +getChatItemByFileId db vr user@User {userId} fileId = do (chatRef, itemId) <- ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByFileId fileId) $ DB.query @@ -1727,10 +1728,10 @@ getChatItemByFileId db user@User {userId} fileId = do LIMIT 1 |] (userId, fileId) - getAChatItem db user chatRef itemId + getAChatItem db vr user chatRef itemId -getChatItemByGroupId :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO AChatItem -getChatItemByGroupId db user@User {userId} groupId = do +getChatItemByGroupId :: DB.Connection -> VersionRange -> User -> GroupId -> ExceptT StoreError IO AChatItem +getChatItemByGroupId db vr user@User {userId} groupId = do (chatRef, itemId) <- ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByGroupId groupId) $ DB.query @@ -1743,7 +1744,7 @@ getChatItemByGroupId db user@User {userId} groupId = do LIMIT 1 |] (userId, groupId) - getAChatItem db user chatRef itemId + getAChatItem db vr user chatRef itemId getChatRefViaItemId :: DB.Connection -> User -> ChatItemId -> ExceptT StoreError IO ChatRef getChatRefViaItemId db User {userId} itemId = do @@ -1755,14 +1756,14 @@ getChatRefViaItemId db User {userId} itemId = do (Nothing, Just groupId) -> Right $ ChatRef CTGroup groupId (_, _) -> Left $ SEBadChatItem itemId -getAChatItem :: DB.Connection -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem -getAChatItem db user chatRef itemId = case chatRef of +getAChatItem :: DB.Connection -> VersionRange -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem +getAChatItem db vr user chatRef itemId = case chatRef of ChatRef CTDirect contactId -> do ct <- getContact db user contactId (CChatItem msgDir ci) <- getDirectChatItem db user contactId itemId pure $ AChatItem SCTDirect msgDir (DirectChat ct) ci ChatRef CTGroup groupId -> do - gInfo <- getGroupInfo db user groupId + gInfo <- getGroupInfo db vr user groupId (CChatItem msgDir ci) <- getGroupChatItem db user groupId itemId pure $ AChatItem SCTGroup msgDir (GroupChat gInfo) ci _ -> throwError $ SEChatItemNotFound itemId diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 044d95eaa..c390d20ab 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -128,16 +128,43 @@ testCfg = xftpFileConfig = Nothing } +testAgentCfgVPrev :: AgentConfig +testAgentCfgVPrev = + testAgentCfg + { smpAgentVRange = prevRange $ smpAgentVRange testAgentCfg, + smpClientVRange = prevRange $ smpClientVRange testAgentCfg, + e2eEncryptVRange = prevRange $ e2eEncryptVRange testAgentCfg, + smpCfg = (smpCfg testAgentCfg) {serverVRange = prevRange $ serverVRange $ smpCfg testAgentCfg} + } + testAgentCfgV1 :: AgentConfig testAgentCfgV1 = testAgentCfg - { smpClientVRange = mkVersionRange 1 1, - smpAgentVRange = mkVersionRange 1 1, - smpCfg = (smpCfg testAgentCfg) {serverVRange = mkVersionRange 1 1} + { smpClientVRange = v1Range, + smpAgentVRange = v1Range, + e2eEncryptVRange = v1Range, + smpCfg = (smpCfg testAgentCfg) {serverVRange = v1Range} + } + +testCfgVPrev :: ChatConfig +testCfgVPrev = + testCfg + { chatVRange = prevRange $ chatVRange testCfg, + agentConfig = testAgentCfgVPrev } testCfgV1 :: ChatConfig -testCfgV1 = testCfg {agentConfig = testAgentCfgV1} +testCfgV1 = + testCfg + { chatVRange = v1Range, + agentConfig = testAgentCfgV1 + } + +prevRange :: VersionRange -> VersionRange +prevRange vr = vr {maxVersion = maxVersion vr - 1} + +v1Range :: VersionRange +v1Range = mkVersionRange 1 1 testCfgCreateGroupDirect :: ChatConfig testCfgCreateGroupDirect = diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index fa5b4a9ef..15ed2fbf1 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -24,8 +24,9 @@ import Test.Hspec chatGroupTests :: SpecWith FilePath chatGroupTests = do describe "chat groups" $ do - it "add contacts, create group and send/receive messages" testGroup - it "add contacts, create group and send/receive messages, check messages" testGroupCheckMessages + describe "add contacts, create group and send/receive messages" testGroupMatrix + it "v1: add contacts, create group and send/receive messages" testGroup + it "v1: add contacts, create group and send/receive messages, check messages" testGroupCheckMessages it "create group with incognito membership" testNewGroupIncognito it "create and join group with 4 members" testGroup2 it "create and delete group" testGroupDelete @@ -146,15 +147,19 @@ chatGroupTests = do testGroup :: HasCallStack => FilePath -> IO () testGroup = testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $ - \alice bob cath -> testGroupShared alice bob cath False + \alice bob cath -> testGroupShared alice bob cath False True testGroupCheckMessages :: HasCallStack => FilePath -> IO () testGroupCheckMessages = testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $ - \alice bob cath -> testGroupShared alice bob cath True + \alice bob cath -> testGroupShared alice bob cath True True -testGroupShared :: HasCallStack => TestCC -> TestCC -> TestCC -> Bool -> IO () -testGroupShared alice bob cath checkMessages = do +testGroupMatrix :: SpecWith FilePath +testGroupMatrix = + versionTestMatrix3 $ \alice bob cath -> testGroupShared alice bob cath False False + +testGroupShared :: HasCallStack => TestCC -> TestCC -> TestCC -> Bool -> Bool -> IO () +testGroupShared alice bob cath checkMessages directConnections = do connectUsers alice bob connectUsers alice cath alice ##> "/g team" @@ -206,7 +211,8 @@ testGroupShared alice bob cath checkMessages = do (alice <# "#team cath> hey team") (bob <# "#team cath> hey team") msgItem2 <- lastItemId alice - bob <##> cath + when directConnections $ + bob <##> cath when checkMessages $ getReadChats msgItem1 msgItem2 -- list groups alice ##> "/gs" @@ -263,17 +269,34 @@ testGroupShared alice bob cath checkMessages = do (cath "#team hello" cath <## "you are no longer a member of the group" - bob <##> cath + when directConnections $ + bob <##> cath -- delete contact alice ##> "/d bob" alice <## "bob: contact is deleted" bob <## "alice (Alice) deleted contact with you" alice `send` "@bob hey" - alice - <### [ "@bob hey", - "member #team bob does not have direct connection, creating", - "peer chat protocol version range incompatible" - ] + if directConnections + then + alice + <### [ "@bob hey", + "member #team bob does not have direct connection, creating", + "peer chat protocol version range incompatible" + ] + else do + alice + <### [ WithTime "@bob hey", + "member #team bob does not have direct connection, creating", + "contact for member #team bob is created", + "sent invitation to connect directly to member #team bob", + "bob (Bob): contact is connected" + ] + bob + <### [ "#team alice is creating direct contact alice with you", + WithTime "alice> hey", + "alice: security code changed", + "alice (Alice): contact is connected" + ] when checkMessages $ threadDelay 1000000 alice #> "#team checking connection" bob <# "#team alice> checking connection" diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index 1fc00d913..65fa3bc4c 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -69,20 +69,22 @@ ifCI xrun run d t = do versionTestMatrix2 :: (HasCallStack => TestCC -> TestCC -> IO ()) -> SpecWith FilePath versionTestMatrix2 runTest = do - it "v2" $ testChat2 aliceProfile bobProfile runTest + it "current" $ testChat2 aliceProfile bobProfile runTest + it "prev" $ testChatCfg2 testCfgVPrev aliceProfile bobProfile runTest + it "prev to curr" $ runTestCfg2 testCfg testCfgVPrev runTest + it "curr to prev" $ runTestCfg2 testCfgVPrev testCfg runTest it "v1" $ testChatCfg2 testCfgV1 aliceProfile bobProfile runTest it "v1 to v2" $ runTestCfg2 testCfg testCfgV1 runTest it "v2 to v1" $ runTestCfg2 testCfgV1 testCfg runTest --- versionTestMatrix3 :: (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> SpecWith FilePath --- versionTestMatrix3 runTest = do --- it "v2" $ testChat3 aliceProfile bobProfile cathProfile runTest - --- it "v1" $ testChatCfg3 testCfgV1 aliceProfile bobProfile cathProfile runTest --- it "v1 to v2" $ runTestCfg3 testCfg testCfgV1 testCfgV1 runTest --- it "v2+v1 to v2" $ runTestCfg3 testCfg testCfg testCfgV1 runTest --- it "v2 to v1" $ runTestCfg3 testCfgV1 testCfg testCfg runTest --- it "v2+v1 to v1" $ runTestCfg3 testCfgV1 testCfg testCfgV1 runTest +versionTestMatrix3 :: (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> SpecWith FilePath +versionTestMatrix3 runTest = do + it "current" $ testChat3 aliceProfile bobProfile cathProfile runTest + it "prev" $ testChatCfg3 testCfgVPrev aliceProfile bobProfile cathProfile runTest + it "prev to curr" $ runTestCfg3 testCfg testCfgVPrev testCfgVPrev runTest + it "curr+prev to curr" $ runTestCfg3 testCfg testCfg testCfgVPrev runTest + it "curr to prev" $ runTestCfg3 testCfgVPrev testCfg testCfg runTest + it "curr+prev to prev" $ runTestCfg3 testCfgVPrev testCfg testCfgVPrev runTest inlineCfg :: Integer -> ChatConfig inlineCfg n = testCfg {inlineFiles = defaultInlineFilesConfig {sendChunks = 0, offerChunks = n, receiveChunks = n}} From 5b90d92ca2c611166669db00a851d227b172c230 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Sun, 24 Dec 2023 14:20:07 +0000 Subject: [PATCH 05/10] core: add group tests --- tests/ChatTests/Groups.hs | 65 ++++++++++++++++++++++++++++++++++++--- 1 file changed, 61 insertions(+), 4 deletions(-) diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 868631024..28152e8f7 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -2619,8 +2619,8 @@ testPlanGroupLinkLeaveRejoin = testGroupLinkNoContact :: HasCallStack => FilePath -> IO () testGroupLinkNoContact = - testChat2 aliceProfile bobProfile $ - \alice bob -> do + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do alice ##> "/g team" alice <## "group #team is created" alice <## "to add members use /a team or /create link #team" @@ -2649,10 +2649,32 @@ testGroupLinkNoContact = bob #> "#team hi there" alice <# "#team bob> hi there" + cath ##> ("/c " <> gLink) + cath <## "connection request sent!" + concurrentlyN_ + [ do + alice <## "cath (Catherine): accepting request to join group #team..." + alice <## "#team: cath joined the group", + do + cath <## "#team: joining the group..." + cath <## "#team: you joined the group" + cath <## "#team: member bob (Bob) is connected", + do + bob <## "#team: alice added cath (Catherine) to the group (connecting...)" + bob <## "#team: new member cath is connected" + ] + cath #> "#team hey" + alice <# "#team cath> hey" + bob <# "#team cath> hey" + + bob #> "#team hi cath" + alice <# "#team bob> hi cath" + cath <# "#team bob> hi cath" + testGroupLinkNoContactMemberRole :: HasCallStack => FilePath -> IO () testGroupLinkNoContactMemberRole = - testChat2 aliceProfile bobProfile $ - \alice bob -> do + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do alice ##> "/g team" alice <## "group #team is created" alice <## "to add members use /a team or /create link #team" @@ -2692,6 +2714,41 @@ testGroupLinkNoContactMemberRole = bob #> "#team hey now" alice <# "#team bob> hey now" + cath ##> ("/c " <> gLink) + cath <## "connection request sent!" + concurrentlyN_ + [ do + alice <## "cath (Catherine): accepting request to join group #team..." + alice <## "#team: cath joined the group", + do + cath <## "#team: joining the group..." + cath <## "#team: you joined the group" + cath <## "#team: member bob (Bob) is connected", + do + bob <## "#team: alice added cath (Catherine) to the group (connecting...)" + bob <## "#team: new member cath is connected" + ] + bob #> "#team hi cath" + alice <# "#team bob> hi cath" + cath <# "#team bob> hi cath" + + cath ##> "#team hey" + cath <## "#team: you don't have permission to send messages" + + alice ##> "/mr #team cath admin" + alice <## "#team: you changed the role of cath from observer to admin" + cath <## "#team: alice changed your role from observer to admin" + bob <## "#team: alice changed the role of cath from observer to admin" + + cath #> "#team hey" + alice <# "#team cath> hey" + bob <# "#team cath> hey" + + cath ##> "/mr #team bob admin" + cath <## "#team: you changed the role of bob from member to admin" + bob <## "#team: cath changed your role from member to admin" + alice <## "#team: cath changed the role of bob from member to admin" + testGroupLinkNoContactHostIncognito :: HasCallStack => FilePath -> IO () testGroupLinkNoContactHostIncognito = testChat2 aliceProfile bobProfile $ From bb4293eb5eca47857178df36339a68f49d8759d2 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Sun, 24 Dec 2023 20:23:09 +0400 Subject: [PATCH 06/10] fix tests --- tests/ChatTests/Groups.hs | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 6513f20ac..57ad05e28 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -2692,14 +2692,18 @@ testGroupLinkNoContact = [ do alice <## "cath (Catherine): accepting request to join group #team..." alice <## "#team: cath joined the group", - do - cath <## "#team: joining the group..." - cath <## "#team: you joined the group" - cath <## "#team: member bob (Bob) is connected", + cath + <### [ "#team: joining the group...", + "#team: you joined the group", + WithTime "#team alice> hello [>>]", + WithTime "#team bob> hi there [>>]", + "#team: member bob (Bob) is connected" + ], do bob <## "#team: alice added cath (Catherine) to the group (connecting...)" bob <## "#team: new member cath is connected" ] + cath #> "#team hey" alice <# "#team cath> hey" bob <# "#team cath> hey" @@ -2757,10 +2761,12 @@ testGroupLinkNoContactMemberRole = [ do alice <## "cath (Catherine): accepting request to join group #team..." alice <## "#team: cath joined the group", - do - cath <## "#team: joining the group..." - cath <## "#team: you joined the group" - cath <## "#team: member bob (Bob) is connected", + cath + <### [ "#team: joining the group...", + "#team: you joined the group", + WithTime "#team bob> hey now [>>]", + "#team: member bob (Bob) is connected" + ], do bob <## "#team: alice added cath (Catherine) to the group (connecting...)" bob <## "#team: new member cath is connected" From e086719f27727ca99427af6e4838de409c87e18b Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Sun, 24 Dec 2023 20:44:30 +0400 Subject: [PATCH 07/10] core: add to tests --- tests/ChatTests/Groups.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 57ad05e28..232c80714 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -4378,6 +4378,16 @@ testGroupHistoryPreferenceOff = r' <- chat <$> getTermLine dan r' `shouldNotContain` [(0, "hello")] r' `shouldNotContain` [(0, "hey!")] + + -- message delivery works + alice #> "#team 1" + [bob, cath, dan] *<# "#team alice> 1" + bob #> "#team 2" + [alice, cath, dan] *<# "#team bob> 2" + cath #> "#team 3" + [alice, bob, dan] *<# "#team cath> 3" + dan #> "#team 4" + [alice, bob, cath] *<# "#team dan> 4" where aliceAddedDan :: HasCallStack => TestCC -> IO () aliceAddedDan cc = do From 5798efcf719056ebfca670f5b7662a71195b2d60 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Sun, 24 Dec 2023 20:55:03 +0400 Subject: [PATCH 08/10] code: modify test --- tests/ChatTests/Groups.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 232c80714..3ba400420 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -2661,6 +2661,11 @@ testGroupLinkNoContact = alice ##> "/g team" alice <## "group #team is created" alice <## "to add members use /a team or /create link #team" + + alice ##> "/set history #team off" + alice <## "updated group preferences:" + alice <## "Recent history: off" + alice ##> "/create link #team" gLink <- getGroupLink alice "team" GRMember True bob ##> ("/c " <> gLink) @@ -2692,13 +2697,10 @@ testGroupLinkNoContact = [ do alice <## "cath (Catherine): accepting request to join group #team..." alice <## "#team: cath joined the group", - cath - <### [ "#team: joining the group...", - "#team: you joined the group", - WithTime "#team alice> hello [>>]", - WithTime "#team bob> hi there [>>]", - "#team: member bob (Bob) is connected" - ], + do + cath <## "#team: joining the group..." + cath <## "#team: you joined the group" + cath <## "#team: member bob (Bob) is connected", do bob <## "#team: alice added cath (Catherine) to the group (connecting...)" bob <## "#team: new member cath is connected" From 37d033c7a5f7b4bc8dd563b68a91df53a9bc244a Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Mon, 25 Dec 2023 11:03:02 +0400 Subject: [PATCH 09/10] core: test group members connect in group when they were previously connected as contacts (#3595) --- tests/ChatTests/Groups.hs | 165 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 165 insertions(+) diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 3ba400420..76bc520aa 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -70,6 +70,8 @@ chatGroupTests = do it "re-join existing group after leaving" testPlanGroupLinkLeaveRejoin describe "group links without contact" $ do it "join via group link without creating contact" testGroupLinkNoContact + it "invitees were previously connected as contacts" testGroupLinkNoContactInviteesWereConnected + it "all members were previously connected as contacts" testGroupLinkNoContactAllMembersWereConnected it "group link member role" testGroupLinkNoContactMemberRole it "host incognito" testGroupLinkNoContactHostIncognito it "invitee incognito" testGroupLinkNoContactInviteeIncognito @@ -2714,6 +2716,169 @@ testGroupLinkNoContact = alice <# "#team bob> hi cath" cath <# "#team bob> hi cath" +testGroupLinkNoContactInviteesWereConnected :: HasCallStack => FilePath -> IO () +testGroupLinkNoContactInviteesWereConnected = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + connectUsers bob cath + bob <##> cath + + alice ##> "/g team" + alice <## "group #team is created" + alice <## "to add members use /a team or /create link #team" + + alice ##> "/set history #team off" + alice <## "updated group preferences:" + alice <## "Recent history: off" + + alice ##> "/create link #team" + gLink <- getGroupLink alice "team" GRMember True + bob ##> ("/c " <> gLink) + bob <## "connection request sent!" + alice <## "bob (Bob): accepting request to join group #team..." + concurrentlyN_ + [ alice <## "#team: bob joined the group", + do + bob <## "#team: joining the group..." + bob <## "#team: you joined the group" + ] + + threadDelay 100000 + alice #$> ("/_get chat #1 count=100", chat, [(0, "invited via your group link"), (0, "connected")]) + + alice @@@ [("#team", "connected")] + bob @@@ [("#team", "connected"), ("@cath", "hey")] + alice ##> "/contacts" + bob ##> "/contacts" + bob <## "cath (Catherine)" + + alice #> "#team hello" + bob <# "#team alice> hello" + bob #> "#team hi there" + alice <# "#team bob> hi there" + + cath ##> ("/c " <> gLink) + cath <## "connection request sent!" + concurrentlyN_ + [ do + alice <## "cath (Catherine): accepting request to join group #team..." + alice <## "#team: cath joined the group", + cath + <### [ "#team: joining the group...", + "#team: you joined the group", + "#team: member bob_1 (Bob) is connected", + "contact and member are merged: bob, #team bob_1", + "use @bob to send messages" + ], + bob + <### [ "#team: alice added cath_1 (Catherine) to the group (connecting...)", + "#team: new member cath_1 is connected", + "contact and member are merged: cath, #team cath_1", + "use @cath to send messages" + ] + ] + + -- message delivery works + bob <##> cath + + alice #> "#team 1" + [bob, cath] *<# "#team alice> 1" + bob #> "#team 2" + [alice, cath] *<# "#team bob> 2" + cath #> "#team 3" + [alice, bob] *<# "#team cath> 3" + +testGroupLinkNoContactAllMembersWereConnected :: HasCallStack => FilePath -> IO () +testGroupLinkNoContactAllMembersWereConnected = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + connectUsers alice bob + alice <##> bob + connectUsers alice cath + alice <##> cath + connectUsers bob cath + bob <##> cath + + alice ##> "/g team" + alice <## "group #team is created" + alice <## "to add members use /a team or /create link #team" + + alice ##> "/set history #team off" + alice <## "updated group preferences:" + alice <## "Recent history: off" + + alice ##> "/create link #team" + gLink <- getGroupLink alice "team" GRMember True + bob ##> ("/c " <> gLink) + bob <## "connection request sent!" + alice <## "bob_1 (Bob): accepting request to join group #team..." + concurrentlyN_ + [ do + alice <## "#team: bob_1 joined the group" + alice <## "contact and member are merged: bob, #team bob_1" + alice <## "use @bob to send messages", + do + bob <## "#team: joining the group..." + bob <## "#team: you joined the group" + bob <## "contact and member are merged: alice, #team alice_1" + bob <## "use @alice to send messages" + ] + + threadDelay 100000 + alice #$> ("/_get chat #1 count=100", chat, [(0, "invited via your group link"), (0, "connected")]) + + alice @@@ [("#team", "connected"), ("@bob", "hey"), ("@cath", "hey")] + bob @@@ [("#team", "connected"), ("@alice", "hey"), ("@cath", "hey")] + alice ##> "/contacts" + alice <## "bob (Bob)" + alice <## "cath (Catherine)" + bob ##> "/contacts" + bob <## "alice (Alice)" + bob <## "cath (Catherine)" + + alice #> "#team hello" + bob <# "#team alice> hello" + bob #> "#team hi there" + alice <# "#team bob> hi there" + + cath ##> ("/c " <> gLink) + cath <## "connection request sent!" + concurrentlyN_ + [ alice + <### [ "cath_1 (Catherine): accepting request to join group #team...", + "#team: cath_1 joined the group", + "contact and member are merged: cath, #team cath_1", + "use @cath to send messages" + ], + cath + <### [ "#team: joining the group...", + "#team: you joined the group", + "#team: member bob_1 (Bob) is connected", + "contact and member are merged: bob, #team bob_1", + "use @bob to send messages", + "contact and member are merged: alice, #team alice_1", + "use @alice to send messages" + ], + bob + <### [ "#team: alice added cath_1 (Catherine) to the group (connecting...)", + "#team: new member cath_1 is connected", + "contact and member are merged: cath, #team cath_1", + "use @cath to send messages" + ] + ] + + -- message delivery works + alice <##> bob + alice <##> cath + bob <##> cath + + alice #> "#team 1" + [bob, cath] *<# "#team alice> 1" + bob #> "#team 2" + [alice, cath] *<# "#team bob> 2" + cath #> "#team 3" + [alice, bob] *<# "#team cath> 3" + testGroupLinkNoContactMemberRole :: HasCallStack => FilePath -> IO () testGroupLinkNoContactMemberRole = testChat3 aliceProfile bobProfile cathProfile $ From 9ac99ec2d902fd5fa68bed1fe304b4a54c9a43db Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Tue, 26 Dec 2023 19:53:58 +0000 Subject: [PATCH 10/10] core: update simplexmq (mark failed work items to continue processing) (#3600) * core: update simplexmq (mark failed work items to continue processing) WIP * simplexmq --- cabal.project | 2 +- scripts/nix/sha256map.nix | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index 3ca7452fb..78f21ccaf 100644 --- a/cabal.project +++ b/cabal.project @@ -14,7 +14,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 1e15d56e92c0549c7ba6a60d2c9d557b2949b0ff + tag: 577e3cf14d3c1e6cb6a45b987ca934ed793dac26 source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 62823e837..c0028e8f1 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."1e15d56e92c0549c7ba6a60d2c9d557b2949b0ff" = "1miy6452py1hbf5d1z1zq3krx8b1fncix8xvzgpxxyfw8qq0gw4b"; + "https://github.com/simplex-chat/simplexmq.git"."577e3cf14d3c1e6cb6a45b987ca934ed793dac26" = "1dgx4qb2ha3mp1jj5h7ff3pd4bzyjxm1jh36pnz0psp1z23m3s19"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d"; "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";