Hi!
\nConnect to me via SimpleX Chat
" = "你好!
\n与我联系"; + /* No comment provided by engineer. */ "~strike~" = "\\~删去~"; +/* No comment provided by engineer. */ +"0s" = "0秒"; + /* time interval */ "1 day" = "1天"; @@ -205,9 +223,15 @@ /* No comment provided by engineer. */ "1-time link" = "一次性链接"; +/* No comment provided by engineer. */ +"5 minutes" = "5分钟"; + /* No comment provided by engineer. */ "6" = "6"; +/* No comment provided by engineer. */ +"30 seconds" = "30秒"; + /* notification title */ "A new contact" = "新联系人"; @@ -226,6 +250,9 @@ /* No comment provided by engineer. */ "About SimpleX" = "关于SimpleX"; +/* No comment provided by engineer. */ +"About SimpleX address" = "关于 SimpleX 地址"; + /* No comment provided by engineer. */ "About SimpleX Chat" = "关于SimpleX Chat"; @@ -251,6 +278,9 @@ /* call status */ "accepted call" = "已接受通话"; +/* No comment provided by engineer. */ +"Add address to your profile, so that your contacts can share it with other people. Profile update will be sent to your contacts." = "将地址添加到您的个人资料,以便您的联系人可以与其他人共享。个人资料更新将发送给您的联系人。"; + /* No comment provided by engineer. */ "Add preset servers" = "添加预设服务器"; @@ -269,6 +299,9 @@ /* No comment provided by engineer. */ "Add welcome message" = "添加欢迎信息"; +/* No comment provided by engineer. */ +"Address" = "地址"; + /* member role */ "admin" = "管理员"; @@ -278,9 +311,15 @@ /* No comment provided by engineer. */ "Advanced network settings" = "高级网络设置"; +/* No comment provided by engineer. */ +"All app data is deleted." = "已删除所有应用程序数据。"; + /* No comment provided by engineer. */ "All chats and messages will be deleted - this cannot be undone!" = "所有聊天记录和消息将被删除——这一行为无法撤销!"; +/* No comment provided by engineer. */ +"All data is erased when it is entered." = "所有数据在输入后将被删除。"; + /* No comment provided by engineer. */ "All group members will remain connected." = "所有群组成员将保持连接。"; @@ -290,6 +329,9 @@ /* No comment provided by engineer. */ "All your contacts will remain connected." = "所有联系人会保持连接。"; +/* No comment provided by engineer. */ +"All your contacts will remain connected. Profile update will be sent to your contacts." = "您的所有联系人将保持连接。个人资料更新将发送给您的联系人。"; + /* No comment provided by engineer. */ "Allow" = "允许"; @@ -302,6 +344,12 @@ /* No comment provided by engineer. */ "Allow irreversible message deletion only if your contact allows it to you." = "仅有您的联系人许可后才允许不可撤回消息移除。"; +/* No comment provided by engineer. */ +"Allow message reactions only if your contact allows them." = "只有您的联系人允许时才允许消息回应。"; + +/* No comment provided by engineer. */ +"Allow message reactions." = "允许消息回应。"; + /* No comment provided by engineer. */ "Allow sending direct messages to members." = "允许向成员发送私信。"; @@ -320,6 +368,9 @@ /* No comment provided by engineer. */ "Allow voice messages?" = "允许语音消息?"; +/* No comment provided by engineer. */ +"Allow your contacts adding message reactions." = "允许您的联系人添加消息回应。"; + /* No comment provided by engineer. */ "Allow your contacts to call you." = "允许您的联系人给您打电话。"; @@ -341,6 +392,9 @@ /* No comment provided by engineer. */ "Always use relay" = "一直使用中继"; +/* No comment provided by engineer. */ +"An empty chat profile with the provided name is created, and the app opens as usual." = "已创建一个包含所提供名字的空白聊天资料,应用程序照常打开。"; + /* No comment provided by engineer. */ "Answer call" = "接听来电"; @@ -353,6 +407,9 @@ /* No comment provided by engineer. */ "App passcode" = "应用程序密码"; +/* No comment provided by engineer. */ +"App passcode is replaced with self-destruct passcode." = "应用程序密码被替换为自毁密码。"; + /* No comment provided by engineer. */ "App version" = "应用程序版本"; @@ -392,6 +449,9 @@ /* No comment provided by engineer. */ "Authentication unavailable" = "身份验证不可用"; +/* No comment provided by engineer. */ +"Auto-accept" = "自动接受"; + /* No comment provided by engineer. */ "Auto-accept contact requests" = "自动接受联系人请求"; @@ -413,9 +473,15 @@ /* No comment provided by engineer. */ "Bad message ID" = "错误消息 ID"; +/* No comment provided by engineer. */ +"Better messages" = "更好的消息"; + /* No comment provided by engineer. */ "bold" = "加粗"; +/* No comment provided by engineer. */ +"Both you and your contact can add message reactions." = "您和您的联系人都可以添加消息回应。"; + /* No comment provided by engineer. */ "Both you and your contact can irreversibly delete sent messages." = "您和您的联系人都可以不可逆转地删除已发送的消息。"; @@ -491,6 +557,13 @@ /* No comment provided by engineer. */ "Change role" = "改变角色"; +/* authentication reason */ +"Change self-destruct mode" = "更改自毁模式"; + +/* authentication reason + set passcode view */ +"Change self-destruct passcode" = "更改自毁密码"; + /* chat item text */ "changed address for you" = "为您更改地址"; @@ -627,7 +700,7 @@ "connecting (introduced)" = "连接中(已介绍)"; /* No comment provided by engineer. */ -"connecting (introduction invitation)" = "连接(介绍邀请)"; +"connecting (introduction invitation)" = "连接中(介绍邀请)"; /* call status */ "connecting call" = "连接通话中……"; @@ -698,6 +771,9 @@ /* No comment provided by engineer. */ "Contacts can mark messages for deletion; you will be able to view them." = "联系人可以将信息标记为删除;您将可以查看这些信息。"; +/* No comment provided by engineer. */ +"Continue" = "继续"; + /* chat item action */ "Copy" = "复制"; @@ -707,6 +783,9 @@ /* No comment provided by engineer. */ "Create" = "创建"; +/* No comment provided by engineer. */ +"Create an address to let people connect with you." = "创建一个地址,让人们与您联系。"; + /* server test step */ "Create file" = "创建文件"; @@ -725,6 +804,9 @@ /* No comment provided by engineer. */ "Create secret group" = "创建私密群组"; +/* No comment provided by engineer. */ +"Create SimpleX address" = "创建 SimpleX 地址"; + /* No comment provided by engineer. */ "Create your profile" = "创建您的资料"; @@ -743,6 +825,12 @@ /* No comment provided by engineer. */ "Currently maximum supported file size is %@." = "目前支持的最大文件大小为 %@。"; +/* dropdown time picker choice */ +"custom" = "自定义"; + +/* No comment provided by engineer. */ +"Custom time" = "自定义时间"; + /* No comment provided by engineer. */ "Dark" = "深色"; @@ -764,6 +852,9 @@ /* No comment provided by engineer. */ "Database ID" = "数据库 ID"; +/* copied message info */ +"Database ID: %d" = "数据库 ID:%d"; + /* No comment provided by engineer. */ "Database IDs and Transport isolation option." = "数据库 ID 和传输隔离选项。"; @@ -800,6 +891,9 @@ /* No comment provided by engineer. */ "Database will be migrated when the app restarts" = "应用程序重新启动时将迁移数据库"; +/* time unit */ +"days" = "天"; + /* No comment provided by engineer. */ "Decentralized" = "分散式"; @@ -917,6 +1011,12 @@ /* deleted chat item */ "deleted" = "已删除"; +/* No comment provided by engineer. */ +"Deleted at" = "已删除于"; + +/* copied message info */ +"Deleted at: %@" = "已删除于:%@"; + /* rcv group event chat item */ "deleted group" = "已删除群组"; @@ -956,6 +1056,9 @@ /* authentication reason */ "Disable SimpleX Lock" = "禁用 SimpleX 锁定"; +/* No comment provided by engineer. */ +"Disappearing message" = "限时消息"; + /* chat feature */ "Disappearing messages" = "限时消息"; @@ -965,6 +1068,12 @@ /* No comment provided by engineer. */ "Disappearing messages are prohibited in this group." = "该组禁止限时消息。"; +/* No comment provided by engineer. */ +"Disappears at" = "消失于"; + +/* copied message info */ +"Disappears at: %@" = "消失于:%@"; + /* server test step */ "Disconnect" = "断开连接"; @@ -980,6 +1089,9 @@ /* No comment provided by engineer. */ "Do NOT use SimpleX for emergency calls." = "请勿使用 SimpleX 进行紧急通话。"; +/* No comment provided by engineer. */ +"Don't create address" = "不创建地址"; + /* No comment provided by engineer. */ "Don't show again" = "不再显示"; @@ -995,6 +1107,9 @@ /* integrity error chat item */ "duplicate message" = "重复的消息"; +/* No comment provided by engineer. */ +"Duration" = "时长"; + /* No comment provided by engineer. */ "e2e encrypted" = "端到端加密"; @@ -1022,6 +1137,12 @@ /* No comment provided by engineer. */ "Enable periodic notifications?" = "启用定期通知?"; +/* No comment provided by engineer. */ +"Enable self-destruct" = "启用自毁功能"; + +/* set passcode view */ +"Enable self-destruct passcode" = "启用自毁密码"; + /* authentication reason */ "Enable SimpleX Lock" = "启用 SimpleX 锁定"; @@ -1085,6 +1206,12 @@ /* No comment provided by engineer. */ "Enter server manually" = "手动输入服务器"; +/* placeholder */ +"Enter welcome message…" = "输入欢迎消息……"; + +/* placeholder */ +"Enter welcome message… (optional)" = "输入欢迎消息……(可选)"; + /* No comment provided by engineer. */ "error" = "错误"; @@ -1187,6 +1314,9 @@ /* No comment provided by engineer. */ "Error saving user password" = "保存用户密码时出错"; +/* No comment provided by engineer. */ +"Error sending email" = "发送电邮错误"; + /* No comment provided by engineer. */ "Error sending message" = "发送消息错误"; @@ -1259,6 +1389,9 @@ /* No comment provided by engineer. */ "Files & media" = "文件和媒体"; +/* No comment provided by engineer. */ +"Finally, we have them! 🚀" = "终于我们有它们了! 🚀"; + /* No comment provided by engineer. */ "For console" = "用于控制台"; @@ -1313,6 +1446,9 @@ /* No comment provided by engineer. */ "Group links" = "群组链接"; +/* No comment provided by engineer. */ +"Group members can add message reactions." = "群组成员可以添加信息回应。"; + /* No comment provided by engineer. */ "Group members can irreversibly delete sent messages." = "群组成员可以不可撤回地删除已发送的消息。"; @@ -1376,6 +1512,12 @@ /* No comment provided by engineer. */ "Hide:" = "隐藏:"; +/* copied message info */ +"History" = "历史记录"; + +/* time unit */ +"hours" = "小时"; + /* No comment provided by engineer. */ "How it works" = "工作原理"; @@ -1394,9 +1536,18 @@ /* No comment provided by engineer. */ "ICE servers (one per line)" = "ICE 服务器(每行一个)"; +/* No comment provided by engineer. */ +"If you can't meet in person, show QR code in a video call, or share the link." = "如果您不能亲自见面,可以在视频通话中展示二维码,或分享链接。"; + /* No comment provided by engineer. */ "If you cannot meet in person, you can **scan QR code in the video call**, or your contact can share an invitation link." = "如果您不能亲自见面,您可以**扫描视频通话中的二维码**,或者您的联系人可以分享邀请链接。"; +/* No comment provided by engineer. */ +"If you enter this passcode when opening the app, all app data will be irreversibly removed!" = "如果您在打开应用时输入该密码,所有应用程序数据将被不可撤回地删除!"; + +/* No comment provided by engineer. */ +"If you enter your self-destruct passcode while opening the app:" = "如果您在打开应用程序时输入自毁密码:"; + /* No comment provided by engineer. */ "If you need to use the chat now tap **Do it later** below (you will be offered to migrate the database when you restart the app)." = "如果您现在需要使用聊天,请点击下面的**稍后再做**(当您重新启动应用程序时,系统会提示您迁移数据库)。"; @@ -1472,6 +1623,9 @@ /* connection level description */ "indirect (%d)" = "间接(%d)"; +/* chat item action */ +"Info" = "信息"; + /* No comment provided by engineer. */ "Initial role" = "初始角色"; @@ -1508,6 +1662,9 @@ /* group name */ "invitation to group %@" = "邀请您加入群组 %@"; +/* No comment provided by engineer. */ +"Invite friends" = "邀请朋友"; + /* No comment provided by engineer. */ "Invite members" = "邀请成员"; @@ -1559,6 +1716,9 @@ /* No comment provided by engineer. */ "italic" = "斜体"; +/* No comment provided by engineer. */ +"Japanese interface" = "日语界面"; + /* No comment provided by engineer. */ "Join" = "加入"; @@ -1583,6 +1743,9 @@ /* No comment provided by engineer. */ "Large file!" = "大文件!"; +/* No comment provided by engineer. */ +"Learn more" = "了解更多"; + /* No comment provided by engineer. */ "Leave" = "离开"; @@ -1595,6 +1758,9 @@ /* rcv group event chat item */ "left" = "已离开"; +/* email subject */ +"Let's talk in SimpleX Chat" = "让我们一起在 SimpleX Chat 里聊天"; + /* No comment provided by engineer. */ "Light" = "浅色"; @@ -1679,6 +1845,15 @@ /* No comment provided by engineer. */ "Message draft" = "消息草稿"; +/* chat feature */ +"Message reactions" = "消息回应"; + +/* No comment provided by engineer. */ +"Message reactions are prohibited in this chat." = "该聊天禁用了消息回应。"; + +/* No comment provided by engineer. */ +"Message reactions are prohibited in this group." = "该群组禁用了消息回应。"; + /* notification */ "message received" = "消息已收到"; @@ -1706,6 +1881,9 @@ /* No comment provided by engineer. */ "Migrations: %@" = "迁移:%@"; +/* time unit */ +"minutes" = "分钟"; + /* call status */ "missed call" = "未接来电"; @@ -1715,9 +1893,18 @@ /* moderated chat item */ "moderated" = "已被管理员移除"; +/* No comment provided by engineer. */ +"Moderated at" = "已被管理员移除于"; + +/* copied message info */ +"Moderated at: %@" = "已被管理员移除于:%@"; + /* No comment provided by engineer. */ "moderated by %@" = "由 %@ 审核"; +/* time unit */ +"months" = "月"; + /* No comment provided by engineer. */ "More improvements are coming soon!" = "更多改进即将推出!"; @@ -1757,6 +1944,9 @@ /* No comment provided by engineer. */ "New database archive" = "新数据库存档"; +/* No comment provided by engineer. */ +"New display name" = "新显示名"; + /* No comment provided by engineer. */ "New in %@" = "%@ 的新内容"; @@ -1805,6 +1995,9 @@ /* No comment provided by engineer. */ "No received or sent files" = "未收到或发送文件"; +/* copied message info in history */ +"no text" = "无文本"; + /* No comment provided by engineer. */ "Notifications" = "通知"; @@ -1866,6 +2059,9 @@ /* No comment provided by engineer. */ "Only group owners can enable voice messages." = "只有群主可以启用语音信息。"; +/* No comment provided by engineer. */ +"Only you can add message reactions." = "只有您可以添加消息回应。"; + /* No comment provided by engineer. */ "Only you can irreversibly delete messages (your contact can mark them for deletion)." = "只有您可以不可撤回地删除消息(您的联系人可以将它们标记为删除)。"; @@ -1878,6 +2074,9 @@ /* No comment provided by engineer. */ "Only you can send voice messages." = "只有您可以发送语音消息。"; +/* No comment provided by engineer. */ +"Only your contact can add message reactions." = "只有您的联系人可以添加消息回应。"; + /* No comment provided by engineer. */ "Only your contact can irreversibly delete messages (you can mark them for deletion)." = "只有您的联系人才能不可撤回地删除消息(您可以将它们标记为删除)。"; @@ -1905,6 +2104,9 @@ /* No comment provided by engineer. */ "Open-source protocol and code – anybody can run the servers." = "开源协议和代码——任何人都可以运行服务器。"; +/* No comment provided by engineer. */ +"Opening database…" = "打开数据库中……"; + /* No comment provided by engineer. */ "Opening the link in the browser may reduce connection privacy and security. Untrusted SimpleX links will be red." = "在浏览器中打开链接可能会降低连接的隐私和安全性。SimpleX 上不受信任的链接将显示为红色。"; @@ -2013,6 +2215,9 @@ /* No comment provided by engineer. */ "Preset server address" = "预设服务器地址"; +/* No comment provided by engineer. */ +"Preview" = "预览"; + /* No comment provided by engineer. */ "Privacy & security" = "隐私和安全"; @@ -2031,12 +2236,21 @@ /* No comment provided by engineer. */ "Profile password" = "个人资料密码"; +/* No comment provided by engineer. */ +"Profile update will be sent to your contacts." = "个人资料更新将被发送给您的联系人。"; + /* No comment provided by engineer. */ "Prohibit audio/video calls." = "禁止音频/视频通话。"; /* No comment provided by engineer. */ "Prohibit irreversible message deletion." = "禁止不可撤回消息删除。"; +/* No comment provided by engineer. */ +"Prohibit message reactions." = "禁止消息回应。"; + +/* No comment provided by engineer. */ +"Prohibit messages reactions." = "禁止消息回应。"; + /* No comment provided by engineer. */ "Prohibit sending direct messages to members." = "禁止向成员发送私信。"; @@ -2061,9 +2275,21 @@ /* No comment provided by engineer. */ "Rate the app" = "评价此应用程序"; +/* chat item menu */ +"React..." = "回应……"; + /* No comment provided by engineer. */ "Read" = "已读"; +/* No comment provided by engineer. */ +"Read more" = "阅读更多"; + +/* No comment provided by engineer. */ +"Read more in [User Guide](https://simplex.chat/docs/guide/app-settings.html#your-simplex-contact-address)." = "在 [用户指南](https://simplex.chat/docs/guide/app-settings.html#your-simplex-contact-address) 中阅读更多内容。"; + +/* No comment provided by engineer. */ +"Read more in [User Guide](https://simplex.chat/docs/guide/readme.html#connect-to-friends)." = "在 [用户指南](https://simplex.chat/docs/guide/readme.html#connect-to-friends) 中阅读更多内容。"; + /* No comment provided by engineer. */ "Read more in our [GitHub repository](https://github.com/simplex-chat/simplex-chat#readme)." = "在我们的 [GitHub 仓库](https://github.com/simplex-chat/simplex-chat#readme) 中阅读更多信息。"; @@ -2073,12 +2299,21 @@ /* No comment provided by engineer. */ "received answer…" = "已收到回复……"; +/* No comment provided by engineer. */ +"Received at" = "已收到于"; + +/* copied message info */ +"Received at: %@" = "已收到于:%@"; + /* No comment provided by engineer. */ "received confirmation…" = "已受到确认……"; /* notification */ "Received file event" = "收到文件项目"; +/* message info title */ +"Received message" = "收到的信息"; + /* No comment provided by engineer. */ "Receiving file will be stopped." = "即将停止接收文件。"; @@ -2088,6 +2323,12 @@ /* No comment provided by engineer. */ "Recipients see updates as you type them." = "对方会在您键入时看到更新。"; +/* No comment provided by engineer. */ +"Record updated at" = "记录更新于"; + +/* copied message info */ +"Record updated at: %@" = "记录更新于:%@"; + /* No comment provided by engineer. */ "Reduced battery usage" = "减少电池使用量"; @@ -2202,6 +2443,9 @@ /* No comment provided by engineer. */ "Save archive" = "保存存档"; +/* No comment provided by engineer. */ +"Save auto-accept settings" = "保存自动接受设置"; + /* No comment provided by engineer. */ "Save group profile" = "保存群组资料"; @@ -2223,6 +2467,9 @@ /* No comment provided by engineer. */ "Save servers?" = "保存服务器?"; +/* No comment provided by engineer. */ +"Save settings?" = "保存设置?"; + /* No comment provided by engineer. */ "Save welcome message?" = "保存欢迎信息?"; @@ -2247,6 +2494,9 @@ /* network option */ "sec" = "秒"; +/* time unit */ +"seconds" = "秒"; + /* No comment provided by engineer. */ "secret" = "秘密"; @@ -2259,6 +2509,21 @@ /* No comment provided by engineer. */ "Security code" = "安全码"; +/* No comment provided by engineer. */ +"Select" = "选择"; + +/* No comment provided by engineer. */ +"Self-destruct" = "自毁"; + +/* No comment provided by engineer. */ +"Self-destruct passcode" = "自毁密码"; + +/* No comment provided by engineer. */ +"Self-destruct passcode changed!" = "自毁密码已更改!"; + +/* No comment provided by engineer. */ +"Self-destruct passcode enabled!" = "自毁密码已启用!"; + /* No comment provided by engineer. */ "Send" = "发送"; @@ -2268,6 +2533,9 @@ /* No comment provided by engineer. */ "Send direct message" = "发送私信"; +/* No comment provided by engineer. */ +"Send disappearing message" = "发送限时消息中"; + /* No comment provided by engineer. */ "Send link previews" = "发送链接预览"; @@ -2298,9 +2566,18 @@ /* No comment provided by engineer. */ "Sending via" = "发送通过"; +/* No comment provided by engineer. */ +"Sent at" = "已发送于"; + +/* copied message info */ +"Sent at: %@" = "已发送于:%@"; + /* notification */ "Sent file event" = "已发送文件项目"; +/* message info title */ +"Sent message" = "已发信息"; + /* No comment provided by engineer. */ "Sent messages will be deleted after set time." = "已发送的消息将在设定的时间后被删除。"; @@ -2328,6 +2605,9 @@ /* No comment provided by engineer. */ "Set it instead of system authentication." = "设置它以代替系统身份验证。"; +/* No comment provided by engineer. */ +"Set passcode" = "设置密码"; + /* No comment provided by engineer. */ "Set passphrase to export" = "设置密码来导出"; @@ -2346,12 +2626,21 @@ /* No comment provided by engineer. */ "Share 1-time link" = "分享一次性链接"; +/* No comment provided by engineer. */ +"Share address" = "分享地址"; + +/* No comment provided by engineer. */ +"Share address with contacts?" = "与联系人分享地址?"; + /* No comment provided by engineer. */ "Share link" = "分享链接"; /* No comment provided by engineer. */ "Share one-time invitation link" = "分享一次性邀请链接"; +/* No comment provided by engineer. */ +"Share with contacts" = "与联系人分享"; + /* No comment provided by engineer. */ "Show calls in phone history" = "在电话历史记录中显示通话"; @@ -2364,6 +2653,12 @@ /* No comment provided by engineer. */ "Show:" = "显示:"; +/* No comment provided by engineer. */ +"SimpleX address" = "SimpleX 地址"; + +/* No comment provided by engineer. */ +"SimpleX Address" = "SimpleX 地址"; + /* No comment provided by engineer. */ "SimpleX Chat security was audited by Trail of Bits." = "SimpleX Chat 的安全性 由 Trail of Bits 审核。"; @@ -2439,6 +2734,12 @@ /* No comment provided by engineer. */ "Stop sending file?" = "停止发送文件?"; +/* No comment provided by engineer. */ +"Stop sharing" = "停止分享"; + +/* No comment provided by engineer. */ +"Stop sharing address?" = "停止分享地址?"; + /* authentication reason */ "Stop SimpleX" = "停止 SimpleX"; @@ -2592,6 +2893,9 @@ /* No comment provided by engineer. */ "To ask any questions and to receive updates:" = "要提出任何问题并接收更新,请:"; +/* No comment provided by engineer. */ +"To connect, your contact can scan QR code or use the link in the app." = "您的联系人可以扫描二维码或使用应用程序中的链接来建立连接。"; + /* No comment provided by engineer. */ "To find the profile used for an incognito connection, tap the contact or group name on top of the chat." = "要查找用于隐身聊天连接的资料,点击聊天顶部的联系人或群组名。"; @@ -2655,6 +2959,9 @@ /* No comment provided by engineer. */ "Unhide profile" = "取消隐藏个人资料"; +/* No comment provided by engineer. */ +"Unit" = "单位"; + /* connection info */ "unknown" = "未知"; @@ -2823,6 +3130,9 @@ /* No comment provided by engineer. */ "WebRTC ICE servers" = "WebRTC ICE 服务器"; +/* time unit */ +"weeks" = "周"; + /* No comment provided by engineer. */ "Welcome %@!" = "欢迎%@!"; @@ -2835,6 +3145,9 @@ /* No comment provided by engineer. */ "When available" = "当可用时"; +/* No comment provided by engineer. */ +"When people request to connect, you can accept or reject it." = "当人们请求连接时,您可以接受或拒绝它。"; + /* No comment provided by engineer. */ "When you share an incognito profile with somebody, this profile will be used for the groups they invite you to." = "当您与某人共享隐身聊天资料时,该资料将用于他们邀请您加入的群组。"; @@ -2886,6 +3199,9 @@ /* No comment provided by engineer. */ "You can also connect by clicking the link. If it opens in the browser, click **Open in mobile app** button." = "您也可以通过点击链接进行连接。如果在浏览器中打开,请点击“在移动应用程序中打开”按钮。"; +/* No comment provided by engineer. */ +"You can create it later" = "您可以以后创建它"; + /* No comment provided by engineer. */ "You can hide or mute a user profile - swipe it to the right.\nSimpleX Lock must be enabled." = "您可以隐藏或静音用户个人资料——只需向右滑动。\n必须启用 SimpleX Lock。"; @@ -2898,6 +3214,9 @@ /* No comment provided by engineer. */ "You can share a link or a QR code - anybody will be able to join the group. You won't lose members of the group if you later delete it." = "您可以共享链接或二维码——任何人都可以加入该群组。如果您稍后将其删除,您不会失去该组的成员。"; +/* No comment provided by engineer. */ +"You can share this address with your contacts to let them connect with **%@**." = "您可以与您的联系人分享该地址,让他们与 **%@** 联系。"; + /* No comment provided by engineer. */ "You can share your address as a link or QR code - anybody can connect to you." = "您可以将您的地址作为链接或二维码共享——任何人都可以连接到您。"; @@ -2992,7 +3311,7 @@ "You will stop receiving messages from this group. Chat history will be preserved." = "您将停止接收来自该群组的消息。聊天记录将被保留。"; /* No comment provided by engineer. */ -"You won't lose your contacts if you later delete your address." = "如果您以后删除它,您不会丢失您的联系人。"; +"You won't lose your contacts if you later delete your address." = "如果您以后删除您的地址,您不会丢失您的联系人。"; /* No comment provided by engineer. */ "you: " = "您: "; @@ -3036,6 +3355,12 @@ /* No comment provided by engineer. */ "Your contacts can allow full message deletion." = "您的联系人可以允许完全删除消息。"; +/* No comment provided by engineer. */ +"Your contacts in SimpleX will see it.\nYou can change it in Settings." = "您的 SimpleX 的联系人会看到它。\n您可以在设置中更改它。"; + +/* No comment provided by engineer. */ +"Your contacts will remain connected." = "与您的联系人保持连接。"; + /* No comment provided by engineer. */ "Your current chat database will be DELETED and REPLACED with the imported one." = "您当前的聊天数据库将被删除并替换为导入的数据库。"; From fd2c7c888cd626f804fabbd3ce261fe5501d00ff Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Wed, 24 May 2023 16:14:41 +0400 Subject: [PATCH 7/7] core: stabilize tests (#2500) --- .github/workflows/build.yml | 12 +- apps/simplex-bot-advanced/Main.hs | 1 + apps/simplex-broadcast-bot/Main.hs | 1 + simplex-chat.cabal | 1 + src/Simplex/Chat.hs | 1 + src/Simplex/Chat/Bot.hs | 1 + src/Simplex/Chat/Controller.hs | 1 + src/Simplex/Chat/Messages.hs | 668 +------------------ src/Simplex/Chat/Messages/ChatItemContent.hs | 660 ++++++++++++++++++ src/Simplex/Chat/Store.hs | 22 +- src/Simplex/Chat/Terminal/Input.hs | 3 +- src/Simplex/Chat/View.hs | 1 + tests/ChatClient.hs | 17 +- tests/ChatTests/Direct.hs | 23 +- tests/ChatTests/Files.hs | 70 +- tests/ChatTests/Utils.hs | 19 +- 16 files changed, 787 insertions(+), 714 deletions(-) create mode 100644 src/Simplex/Chat/Messages/ChatItemContent.hs diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 46a38d2f47..5ca8fef810 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -119,12 +119,6 @@ jobs: cabal build --enable-tests echo "::set-output name=bin_path::$(cabal list-bin simplex-chat)" - - name: Unix test - if: matrix.os != 'windows-latest' - timeout-minutes: 30 - shell: bash - run: cabal test --test-show-details=direct - - name: Unix upload binary to release if: startsWith(github.ref, 'refs/tags/v') && matrix.os != 'windows-latest' uses: svenstaro/upload-release-action@v2 @@ -134,6 +128,12 @@ jobs: asset_name: ${{ matrix.asset_name }} tag: ${{ github.ref }} + - name: Unix test + if: matrix.os != 'windows-latest' + timeout-minutes: 30 + shell: bash + run: cabal test --test-show-details=direct + # Unix / # / Windows diff --git a/apps/simplex-bot-advanced/Main.hs b/apps/simplex-bot-advanced/Main.hs index 1a2c06d617..95814a598d 100644 --- a/apps/simplex-bot-advanced/Main.hs +++ b/apps/simplex-bot-advanced/Main.hs @@ -14,6 +14,7 @@ import Simplex.Chat.Bot import Simplex.Chat.Controller import Simplex.Chat.Core import Simplex.Chat.Messages +import Simplex.Chat.Messages.ChatItemContent import Simplex.Chat.Options import Simplex.Chat.Terminal (terminalChatConfig) import Simplex.Chat.Types diff --git a/apps/simplex-broadcast-bot/Main.hs b/apps/simplex-broadcast-bot/Main.hs index d2cd5edd3d..ae8e4f2782 100644 --- a/apps/simplex-broadcast-bot/Main.hs +++ b/apps/simplex-broadcast-bot/Main.hs @@ -16,6 +16,7 @@ import Simplex.Chat.Bot import Simplex.Chat.Controller import Simplex.Chat.Core import Simplex.Chat.Messages +import Simplex.Chat.Messages.ChatItemContent import Simplex.Chat.Options import Simplex.Chat.Protocol (MsgContent (..)) import Simplex.Chat.Terminal (terminalChatConfig) diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 9b92f32d94..2266d35589 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -33,6 +33,7 @@ library Simplex.Chat.Help Simplex.Chat.Markdown Simplex.Chat.Messages + Simplex.Chat.Messages.ChatItemContent Simplex.Chat.Migrations.M20220101_initial Simplex.Chat.Migrations.M20220122_v1_1 Simplex.Chat.Migrations.M20220205_chat_item_status diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 54d7bddbfa..4b6b5d259e 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -54,6 +54,7 @@ import Simplex.Chat.Call import Simplex.Chat.Controller import Simplex.Chat.Markdown import Simplex.Chat.Messages +import Simplex.Chat.Messages.ChatItemContent import Simplex.Chat.Options import Simplex.Chat.ProfileGenerator (generateRandomProfile) import Simplex.Chat.Protocol diff --git a/src/Simplex/Chat/Bot.hs b/src/Simplex/Chat/Bot.hs index ab1340c818..2c837907eb 100644 --- a/src/Simplex/Chat/Bot.hs +++ b/src/Simplex/Chat/Bot.hs @@ -16,6 +16,7 @@ import qualified Data.Text as T import Simplex.Chat.Controller import Simplex.Chat.Core import Simplex.Chat.Messages +import Simplex.Chat.Messages.ChatItemContent import Simplex.Chat.Protocol (MsgContent (..)) import Simplex.Chat.Store import Simplex.Chat.Types (Contact (..), IsContact (..), User (..)) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 618e059d71..0b7ad9db73 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -42,6 +42,7 @@ import qualified Paths_simplex_chat as SC import Simplex.Chat.Call import Simplex.Chat.Markdown (MarkdownList) import Simplex.Chat.Messages +import Simplex.Chat.Messages.ChatItemContent import Simplex.Chat.Protocol import Simplex.Chat.Store (AutoAccept, StoreError, UserContactLink) import Simplex.Chat.Types diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 1e9ec03a59..cb3dc505e9 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -21,7 +21,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as A import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Lazy.Char8 as LB import Data.Int (Int64) -import Data.Maybe (isNothing, isJust) +import Data.Maybe (isJust, isNothing) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeLatin1, encodeUtf8) @@ -29,21 +29,18 @@ import Data.Time.Clock (UTCTime, diffUTCTime, nominalDay) import Data.Time.LocalTime (TimeZone, ZonedTime, utcToZonedTime) import Data.Type.Equality import Data.Typeable (Typeable) -import Data.Word (Word32) -import Database.SQLite.Simple (ResultError (..), SQLData (..)) -import Database.SQLite.Simple.FromField (Field, FromField (..), returnError) -import Database.SQLite.Simple.Internal (Field (..)) -import Database.SQLite.Simple.Ok +import Database.SQLite.Simple.FromField (FromField (..)) import Database.SQLite.Simple.ToField (ToField (..)) import GHC.Generics (Generic) import Simplex.Chat.Markdown +import Simplex.Chat.Messages.ChatItemContent import Simplex.Chat.Protocol import Simplex.Chat.Types -import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgErrorType (..), MsgMeta (..), SwitchPhase (..)) +import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgMeta (..)) import Simplex.Messaging.Encoding.String -import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, fstToLower, singleFieldJSON, sumTypeJSON) +import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, sumTypeJSON) import Simplex.Messaging.Protocol (MsgBody) -import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, tshow, (<$?>)) +import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>)) data ChatType = CTDirect | CTGroup | CTContactRequest | CTContactConnection deriving (Eq, Show, Ord, Generic) @@ -212,6 +209,10 @@ chatItemMember GroupInfo {membership} ChatItem {chatDir} = case chatDir of CIGroupSnd -> membership CIGroupRcv m -> m +ciReactionAllowed :: ChatItem c d -> Bool +ciReactionAllowed ChatItem {meta = CIMeta {itemDeleted = Just _}} = False +ciReactionAllowed ChatItem {content} = isJust $ ciMsgContent content + data CIDeletedState = CIDeletedState { markedDeleted :: Bool, deletedByMember :: Maybe GroupMember @@ -633,11 +634,6 @@ data CIStatus (d :: MsgDirection) where deriving instance Show (CIStatus d) -ciStatusNew :: forall d. MsgDirectionI d => CIStatus d -ciStatusNew = case msgDirection @d of - SMDSnd -> CISSndNew - SMDRcv -> CISRcvNew - instance ToJSON (CIStatus d) where toJSON = J.toJSON . jsonCIStatus toEncoding = J.toEncoding . jsonCIStatus @@ -694,6 +690,16 @@ jsonCIStatus = \case CISRcvNew -> JCISRcvNew CISRcvRead -> JCISRcvRead +ciStatusNew :: forall d. MsgDirectionI d => CIStatus d +ciStatusNew = case msgDirection @d of + SMDSnd -> CISSndNew + SMDRcv -> CISRcvNew + +ciCreateStatus :: forall d. MsgDirectionI d => CIContent d -> CIStatus d +ciCreateStatus content = case msgDirection @d of + SMDSnd -> ciStatusNew + SMDRcv -> if ciRequiresAttention content then ciStatusNew else CISRcvRead + type ChatItemId = Int64 type ChatItemTs = UTCTime @@ -704,573 +710,6 @@ data ChatPagination | CPBefore ChatItemId Int deriving (Show) -data CIDeleteMode = CIDMBroadcast | CIDMInternal - deriving (Show, Generic) - -instance ToJSON CIDeleteMode where - toJSON = J.genericToJSON . enumJSON $ dropPrefix "CIDM" - toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CIDM" - -instance FromJSON CIDeleteMode where - parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CIDM" - -ciDeleteModeToText :: CIDeleteMode -> Text -ciDeleteModeToText = \case - CIDMBroadcast -> "this item is deleted (broadcast)" - CIDMInternal -> "this item is deleted (internal)" - -ciGroupInvitationToText :: CIGroupInvitation -> GroupMemberRole -> Text -ciGroupInvitationToText CIGroupInvitation {groupProfile = GroupProfile {displayName, fullName}} role = - "invitation to join group " <> displayName <> optionalFullName displayName fullName <> " as " <> (decodeLatin1 . strEncode $ role) - -rcvGroupEventToText :: RcvGroupEvent -> Text -rcvGroupEventToText = \case - RGEMemberAdded _ p -> "added " <> profileToText p - RGEMemberConnected -> "connected" - RGEMemberLeft -> "left" - RGEMemberRole _ p r -> "changed role of " <> profileToText p <> " to " <> safeDecodeUtf8 (strEncode r) - RGEUserRole r -> "changed your role to " <> safeDecodeUtf8 (strEncode r) - RGEMemberDeleted _ p -> "removed " <> profileToText p - RGEUserDeleted -> "removed you" - RGEGroupDeleted -> "deleted group" - RGEGroupUpdated _ -> "group profile updated" - RGEInvitedViaGroupLink -> "invited via your group link" - -sndGroupEventToText :: SndGroupEvent -> Text -sndGroupEventToText = \case - SGEMemberRole _ p r -> "changed role of " <> profileToText p <> " to " <> safeDecodeUtf8 (strEncode r) - SGEUserRole r -> "changed role for yourself to " <> safeDecodeUtf8 (strEncode r) - SGEMemberDeleted _ p -> "removed " <> profileToText p - SGEUserLeft -> "left" - SGEGroupUpdated _ -> "group profile updated" - -rcvConnEventToText :: RcvConnEvent -> Text -rcvConnEventToText = \case - RCESwitchQueue phase -> case phase of - SPCompleted -> "changed address for you" - _ -> decodeLatin1 (strEncode phase) <> " changing address for you..." - -sndConnEventToText :: SndConnEvent -> Text -sndConnEventToText = \case - SCESwitchQueue phase m -> case phase of - SPCompleted -> "you changed address" <> forMember m - _ -> decodeLatin1 (strEncode phase) <> " changing address" <> forMember m <> "..." - where - forMember member_ = - maybe "" (\GroupMemberRef {profile = Profile {displayName}} -> " for " <> displayName) member_ - -profileToText :: Profile -> Text -profileToText Profile {displayName, fullName} = displayName <> optionalFullName displayName fullName - --- This type is used both in API and in DB, so we use different JSON encodings for the database and for the API --- ! Nested sum types also have to use different encodings for database and API --- ! to avoid breaking cross-platform compatibility, see RcvGroupEvent and SndGroupEvent -data CIContent (d :: MsgDirection) where - CISndMsgContent :: MsgContent -> CIContent 'MDSnd - CIRcvMsgContent :: MsgContent -> CIContent 'MDRcv - CISndDeleted :: CIDeleteMode -> CIContent 'MDSnd -- legacy - since v4.3.0 item_deleted field is used - CIRcvDeleted :: CIDeleteMode -> CIContent 'MDRcv -- legacy - since v4.3.0 item_deleted field is used - CISndCall :: CICallStatus -> Int -> CIContent 'MDSnd - CIRcvCall :: CICallStatus -> Int -> CIContent 'MDRcv - CIRcvIntegrityError :: MsgErrorType -> CIContent 'MDRcv - CIRcvDecryptionError :: MsgDecryptError -> Word32 -> CIContent 'MDRcv - CIRcvGroupInvitation :: CIGroupInvitation -> GroupMemberRole -> CIContent 'MDRcv - CISndGroupInvitation :: CIGroupInvitation -> GroupMemberRole -> CIContent 'MDSnd - CIRcvGroupEvent :: RcvGroupEvent -> CIContent 'MDRcv - CISndGroupEvent :: SndGroupEvent -> CIContent 'MDSnd - CIRcvConnEvent :: RcvConnEvent -> CIContent 'MDRcv - CISndConnEvent :: SndConnEvent -> CIContent 'MDSnd - CIRcvChatFeature :: ChatFeature -> PrefEnabled -> Maybe Int -> CIContent 'MDRcv - CISndChatFeature :: ChatFeature -> PrefEnabled -> Maybe Int -> CIContent 'MDSnd - CIRcvChatPreference :: ChatFeature -> FeatureAllowed -> Maybe Int -> CIContent 'MDRcv - CISndChatPreference :: ChatFeature -> FeatureAllowed -> Maybe Int -> CIContent 'MDSnd - CIRcvGroupFeature :: GroupFeature -> GroupPreference -> Maybe Int -> CIContent 'MDRcv - CISndGroupFeature :: GroupFeature -> GroupPreference -> Maybe Int -> CIContent 'MDSnd - CIRcvChatFeatureRejected :: ChatFeature -> CIContent 'MDRcv - CIRcvGroupFeatureRejected :: GroupFeature -> CIContent 'MDRcv - CISndModerated :: CIContent 'MDSnd - CIRcvModerated :: CIContent 'MDRcv - CIInvalidJSON :: Text -> CIContent d --- ^ This type is used both in API and in DB, so we use different JSON encodings for the database and for the API --- ! ^ Nested sum types also have to use different encodings for database and API --- ! ^ to avoid breaking cross-platform compatibility, see RcvGroupEvent and SndGroupEvent - -deriving instance Show (CIContent d) - -ciMsgContent :: CIContent d -> Maybe MsgContent -ciMsgContent = \case - CISndMsgContent mc -> Just mc - CIRcvMsgContent mc -> Just mc - _ -> Nothing - -data MsgDecryptError = MDERatchetHeader | MDETooManySkipped - deriving (Eq, Show, Generic) - -instance ToJSON MsgDecryptError where - toJSON = J.genericToJSON . enumJSON $ dropPrefix "MDE" - toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "MDE" - -instance FromJSON MsgDecryptError where - parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "MDE" - -ciReactionAllowed :: ChatItem c d -> Bool -ciReactionAllowed ChatItem {meta = CIMeta {itemDeleted = Just _}} = False -ciReactionAllowed ChatItem {content} = isJust $ ciMsgContent content - -ciRequiresAttention :: forall d. MsgDirectionI d => CIContent d -> Bool -ciRequiresAttention content = case msgDirection @d of - SMDSnd -> True - SMDRcv -> case content of - CIRcvMsgContent _ -> True - CIRcvDeleted _ -> True - CIRcvCall {} -> True - CIRcvIntegrityError _ -> True - CIRcvDecryptionError {} -> True - CIRcvGroupInvitation {} -> True - CIRcvGroupEvent rge -> case rge of - RGEMemberAdded {} -> False - RGEMemberConnected -> False - RGEMemberLeft -> False - RGEMemberRole {} -> False - RGEUserRole _ -> True - RGEMemberDeleted {} -> False - RGEUserDeleted -> True - RGEGroupDeleted -> True - RGEGroupUpdated _ -> False - RGEInvitedViaGroupLink -> False - CIRcvConnEvent _ -> True - CIRcvChatFeature {} -> False - CIRcvChatPreference {} -> False - CIRcvGroupFeature {} -> False - CIRcvChatFeatureRejected _ -> True - CIRcvGroupFeatureRejected _ -> True - CIRcvModerated -> True - CIInvalidJSON _ -> False - -ciCreateStatus :: forall d. MsgDirectionI d => CIContent d -> CIStatus d -ciCreateStatus content = case msgDirection @d of - SMDSnd -> ciStatusNew - SMDRcv -> if ciRequiresAttention content then ciStatusNew else CISRcvRead - -data RcvGroupEvent - = RGEMemberAdded {groupMemberId :: GroupMemberId, profile :: Profile} -- CRJoinedGroupMemberConnecting - | RGEMemberConnected -- CRUserJoinedGroup, CRJoinedGroupMember, CRConnectedToGroupMember - | RGEMemberLeft -- CRLeftMember - | RGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole} - | RGEUserRole {role :: GroupMemberRole} - | RGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRDeletedMember - | RGEUserDeleted -- CRDeletedMemberUser - | RGEGroupDeleted -- CRGroupDeleted - | RGEGroupUpdated {groupProfile :: GroupProfile} -- CRGroupUpdated - -- RGEInvitedViaGroupLink chat items are not received - they're created when sending group invitations, - -- but being RcvGroupEvent allows them to be assigned to the respective member (and so enable "send direct message") - -- and be created as unread without adding / working around new status for sent items - | RGEInvitedViaGroupLink -- CRSentGroupInvitationViaLink - deriving (Show, Generic) - -instance FromJSON RcvGroupEvent where - parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RGE" - -instance ToJSON RcvGroupEvent where - toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RGE" - toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RGE" - -newtype DBRcvGroupEvent = RGE RcvGroupEvent - -instance FromJSON DBRcvGroupEvent where - parseJSON v = RGE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "RGE") v - -instance ToJSON DBRcvGroupEvent where - toJSON (RGE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "RGE") v - toEncoding (RGE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "RGE") v - -data SndGroupEvent - = SGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole} - | SGEUserRole {role :: GroupMemberRole} - | SGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRUserDeletedMember - | SGEUserLeft -- CRLeftMemberUser - | SGEGroupUpdated {groupProfile :: GroupProfile} -- CRGroupUpdated - deriving (Show, Generic) - -instance FromJSON SndGroupEvent where - parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SGE" - -instance ToJSON SndGroupEvent where - toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SGE" - toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SGE" - -newtype DBSndGroupEvent = SGE SndGroupEvent - -instance FromJSON DBSndGroupEvent where - parseJSON v = SGE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "SGE") v - -instance ToJSON DBSndGroupEvent where - toJSON (SGE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "SGE") v - toEncoding (SGE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "SGE") v - -data RcvConnEvent = RCESwitchQueue {phase :: SwitchPhase} - deriving (Show, Generic) - -data SndConnEvent = SCESwitchQueue {phase :: SwitchPhase, member :: Maybe GroupMemberRef} - deriving (Show, Generic) - -instance FromJSON RcvConnEvent where - parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RCE" - -instance ToJSON RcvConnEvent where - toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RCE" - toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RCE" - -newtype DBRcvConnEvent = RCE RcvConnEvent - -instance FromJSON DBRcvConnEvent where - parseJSON v = RCE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "RCE") v - -instance ToJSON DBRcvConnEvent where - toJSON (RCE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "RCE") v - toEncoding (RCE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "RCE") v - -instance FromJSON SndConnEvent where - parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SCE" - -instance ToJSON SndConnEvent where - toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SCE" - toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SCE" - -newtype DBSndConnEvent = SCE SndConnEvent - -instance FromJSON DBSndConnEvent where - parseJSON v = SCE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "SCE") v - -instance ToJSON DBSndConnEvent where - toJSON (SCE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "SCE") v - toEncoding (SCE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "SCE") v - -newtype DBMsgErrorType = DBME MsgErrorType - -instance FromJSON DBMsgErrorType where - parseJSON v = DBME <$> J.genericParseJSON (singleFieldJSON fstToLower) v - -instance ToJSON DBMsgErrorType where - toJSON (DBME v) = J.genericToJSON (singleFieldJSON fstToLower) v - toEncoding (DBME v) = J.genericToEncoding (singleFieldJSON fstToLower) v - -data CIGroupInvitation = CIGroupInvitation - { groupId :: GroupId, - groupMemberId :: GroupMemberId, - localDisplayName :: GroupName, - groupProfile :: GroupProfile, - status :: CIGroupInvitationStatus - } - deriving (Eq, Show, Generic, FromJSON) - -instance ToJSON CIGroupInvitation where - toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} - toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} - -data CIGroupInvitationStatus - = CIGISPending - | CIGISAccepted - | CIGISRejected - | CIGISExpired - deriving (Eq, Show, Generic) - -instance FromJSON CIGroupInvitationStatus where - parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CIGIS" - -instance ToJSON CIGroupInvitationStatus where - toJSON = J.genericToJSON . enumJSON $ dropPrefix "CIGIS" - toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CIGIS" - -ciContentToText :: CIContent d -> Text -ciContentToText = \case - CISndMsgContent mc -> msgContentText mc - CIRcvMsgContent mc -> msgContentText mc - CISndDeleted cidm -> ciDeleteModeToText cidm - CIRcvDeleted cidm -> ciDeleteModeToText cidm - CISndCall status duration -> "outgoing call: " <> ciCallInfoText status duration - CIRcvCall status duration -> "incoming call: " <> ciCallInfoText status duration - CIRcvIntegrityError err -> msgIntegrityError err - CIRcvDecryptionError err n -> msgDecryptErrorText err n - CIRcvGroupInvitation groupInvitation memberRole -> "received " <> ciGroupInvitationToText groupInvitation memberRole - CISndGroupInvitation groupInvitation memberRole -> "sent " <> ciGroupInvitationToText groupInvitation memberRole - CIRcvGroupEvent event -> rcvGroupEventToText event - CISndGroupEvent event -> sndGroupEventToText event - CIRcvConnEvent event -> rcvConnEventToText event - CISndConnEvent event -> sndConnEventToText event - CIRcvChatFeature feature enabled param -> featureStateText feature enabled param - CISndChatFeature feature enabled param -> featureStateText feature enabled param - CIRcvChatPreference feature allowed param -> prefStateText feature allowed param - CISndChatPreference feature allowed param -> "you " <> prefStateText feature allowed param - CIRcvGroupFeature feature pref param -> groupPrefStateText feature pref param - CISndGroupFeature feature pref param -> groupPrefStateText feature pref param - CIRcvChatFeatureRejected feature -> chatFeatureNameText feature <> ": received, prohibited" - CIRcvGroupFeatureRejected feature -> groupFeatureNameText feature <> ": received, prohibited" - CISndModerated -> ciModeratedText - CIRcvModerated -> ciModeratedText - CIInvalidJSON _ -> "invalid content JSON" - -msgIntegrityError :: MsgErrorType -> Text -msgIntegrityError = \case - MsgSkipped fromId toId -> - "skipped message ID " <> tshow fromId - <> if fromId == toId then "" else ".." <> tshow toId - MsgBadId msgId -> "unexpected message ID " <> tshow msgId - MsgBadHash -> "incorrect message hash" - MsgDuplicate -> "duplicate message ID" - -msgDecryptErrorText :: MsgDecryptError -> Word32 -> Text -msgDecryptErrorText err n = - "decryption error, possibly due to the device change (" <> errName <> if n == 1 then ")" else ", " <> tshow n <> " messages)" - where - errName = case err of - MDERatchetHeader -> "header" - MDETooManySkipped -> "too many skipped messages" - -msgDirToModeratedContent_ :: SMsgDirection d -> CIContent d -msgDirToModeratedContent_ = \case - SMDRcv -> CIRcvModerated - SMDSnd -> CISndModerated - -ciModeratedText :: Text -ciModeratedText = "moderated" - --- platform independent -instance MsgDirectionI d => ToField (CIContent d) where - toField = toField . encodeJSON . dbJsonCIContent - --- platform specific -instance MsgDirectionI d => ToJSON (CIContent d) where - toJSON = J.toJSON . jsonCIContent - toEncoding = J.toEncoding . jsonCIContent - -data ACIContent = forall d. MsgDirectionI d => ACIContent (SMsgDirection d) (CIContent d) - -deriving instance Show ACIContent - --- platform independent -dbParseACIContent :: Text -> Either String ACIContent -dbParseACIContent = fmap aciContentDBJSON . J.eitherDecodeStrict' . encodeUtf8 - --- platform specific -instance FromJSON ACIContent where - parseJSON = fmap aciContentJSON . J.parseJSON - --- platform specific -data JSONCIContent - = JCISndMsgContent {msgContent :: MsgContent} - | JCIRcvMsgContent {msgContent :: MsgContent} - | JCISndDeleted {deleteMode :: CIDeleteMode} - | JCIRcvDeleted {deleteMode :: CIDeleteMode} - | JCISndCall {status :: CICallStatus, duration :: Int} -- duration in seconds - | JCIRcvCall {status :: CICallStatus, duration :: Int} - | JCIRcvIntegrityError {msgError :: MsgErrorType} - | JCIRcvDecryptionError {msgDecryptError :: MsgDecryptError, msgCount :: Word32} - | JCIRcvGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole} - | JCISndGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole} - | JCIRcvGroupEvent {rcvGroupEvent :: RcvGroupEvent} - | JCISndGroupEvent {sndGroupEvent :: SndGroupEvent} - | JCIRcvConnEvent {rcvConnEvent :: RcvConnEvent} - | JCISndConnEvent {sndConnEvent :: SndConnEvent} - | JCIRcvChatFeature {feature :: ChatFeature, enabled :: PrefEnabled, param :: Maybe Int} - | JCISndChatFeature {feature :: ChatFeature, enabled :: PrefEnabled, param :: Maybe Int} - | JCIRcvChatPreference {feature :: ChatFeature, allowed :: FeatureAllowed, param :: Maybe Int} - | JCISndChatPreference {feature :: ChatFeature, allowed :: FeatureAllowed, param :: Maybe Int} - | JCIRcvGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int} - | JCISndGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int} - | JCIRcvChatFeatureRejected {feature :: ChatFeature} - | JCIRcvGroupFeatureRejected {groupFeature :: GroupFeature} - | JCISndModerated - | JCIRcvModerated - | JCIInvalidJSON {direction :: MsgDirection, json :: Text} - deriving (Generic) - -instance FromJSON JSONCIContent where - parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCI" - -instance ToJSON JSONCIContent where - toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCI" - toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCI" - -jsonCIContent :: forall d. MsgDirectionI d => CIContent d -> JSONCIContent -jsonCIContent = \case - CISndMsgContent mc -> JCISndMsgContent mc - CIRcvMsgContent mc -> JCIRcvMsgContent mc - CISndDeleted cidm -> JCISndDeleted cidm - CIRcvDeleted cidm -> JCIRcvDeleted cidm - CISndCall status duration -> JCISndCall {status, duration} - CIRcvCall status duration -> JCIRcvCall {status, duration} - CIRcvIntegrityError err -> JCIRcvIntegrityError err - CIRcvDecryptionError err n -> JCIRcvDecryptionError err n - CIRcvGroupInvitation groupInvitation memberRole -> JCIRcvGroupInvitation {groupInvitation, memberRole} - CISndGroupInvitation groupInvitation memberRole -> JCISndGroupInvitation {groupInvitation, memberRole} - CIRcvGroupEvent rcvGroupEvent -> JCIRcvGroupEvent {rcvGroupEvent} - CISndGroupEvent sndGroupEvent -> JCISndGroupEvent {sndGroupEvent} - CIRcvConnEvent rcvConnEvent -> JCIRcvConnEvent {rcvConnEvent} - CISndConnEvent sndConnEvent -> JCISndConnEvent {sndConnEvent} - CIRcvChatFeature feature enabled param -> JCIRcvChatFeature {feature, enabled, param} - CISndChatFeature feature enabled param -> JCISndChatFeature {feature, enabled, param} - CIRcvChatPreference feature allowed param -> JCIRcvChatPreference {feature, allowed, param} - CISndChatPreference feature allowed param -> JCISndChatPreference {feature, allowed, param} - CIRcvGroupFeature groupFeature preference param -> JCIRcvGroupFeature {groupFeature, preference, param} - CISndGroupFeature groupFeature preference param -> JCISndGroupFeature {groupFeature, preference, param} - CIRcvChatFeatureRejected feature -> JCIRcvChatFeatureRejected {feature} - CIRcvGroupFeatureRejected groupFeature -> JCIRcvGroupFeatureRejected {groupFeature} - CISndModerated -> JCISndModerated - CIRcvModerated -> JCISndModerated - CIInvalidJSON json -> JCIInvalidJSON (toMsgDirection $ msgDirection @d) json - -aciContentJSON :: JSONCIContent -> ACIContent -aciContentJSON = \case - JCISndMsgContent mc -> ACIContent SMDSnd $ CISndMsgContent mc - JCIRcvMsgContent mc -> ACIContent SMDRcv $ CIRcvMsgContent mc - JCISndDeleted cidm -> ACIContent SMDSnd $ CISndDeleted cidm - JCIRcvDeleted cidm -> ACIContent SMDRcv $ CIRcvDeleted cidm - JCISndCall {status, duration} -> ACIContent SMDSnd $ CISndCall status duration - JCIRcvCall {status, duration} -> ACIContent SMDRcv $ CIRcvCall status duration - JCIRcvIntegrityError err -> ACIContent SMDRcv $ CIRcvIntegrityError err - JCIRcvDecryptionError err n -> ACIContent SMDRcv $ CIRcvDecryptionError err n - JCIRcvGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDRcv $ CIRcvGroupInvitation groupInvitation memberRole - JCISndGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDSnd $ CISndGroupInvitation groupInvitation memberRole - JCIRcvGroupEvent {rcvGroupEvent} -> ACIContent SMDRcv $ CIRcvGroupEvent rcvGroupEvent - JCISndGroupEvent {sndGroupEvent} -> ACIContent SMDSnd $ CISndGroupEvent sndGroupEvent - JCIRcvConnEvent {rcvConnEvent} -> ACIContent SMDRcv $ CIRcvConnEvent rcvConnEvent - JCISndConnEvent {sndConnEvent} -> ACIContent SMDSnd $ CISndConnEvent sndConnEvent - JCIRcvChatFeature {feature, enabled, param} -> ACIContent SMDRcv $ CIRcvChatFeature feature enabled param - JCISndChatFeature {feature, enabled, param} -> ACIContent SMDSnd $ CISndChatFeature feature enabled param - JCIRcvChatPreference {feature, allowed, param} -> ACIContent SMDRcv $ CIRcvChatPreference feature allowed param - JCISndChatPreference {feature, allowed, param} -> ACIContent SMDSnd $ CISndChatPreference feature allowed param - JCIRcvGroupFeature {groupFeature, preference, param} -> ACIContent SMDRcv $ CIRcvGroupFeature groupFeature preference param - JCISndGroupFeature {groupFeature, preference, param} -> ACIContent SMDSnd $ CISndGroupFeature groupFeature preference param - JCIRcvChatFeatureRejected {feature} -> ACIContent SMDRcv $ CIRcvChatFeatureRejected feature - JCIRcvGroupFeatureRejected {groupFeature} -> ACIContent SMDRcv $ CIRcvGroupFeatureRejected groupFeature - JCISndModerated -> ACIContent SMDSnd CISndModerated - JCIRcvModerated -> ACIContent SMDRcv CIRcvModerated - JCIInvalidJSON dir json -> case fromMsgDirection dir of - AMsgDirection d -> ACIContent d $ CIInvalidJSON json - --- platform independent -data DBJSONCIContent - = DBJCISndMsgContent {msgContent :: MsgContent} - | DBJCIRcvMsgContent {msgContent :: MsgContent} - | DBJCISndDeleted {deleteMode :: CIDeleteMode} - | DBJCIRcvDeleted {deleteMode :: CIDeleteMode} - | DBJCISndCall {status :: CICallStatus, duration :: Int} - | DBJCIRcvCall {status :: CICallStatus, duration :: Int} - | DBJCIRcvIntegrityError {msgError :: DBMsgErrorType} - | DBJCIRcvDecryptionError {msgDecryptError :: MsgDecryptError, msgCount :: Word32} - | DBJCIRcvGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole} - | DBJCISndGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole} - | DBJCIRcvGroupEvent {rcvGroupEvent :: DBRcvGroupEvent} - | DBJCISndGroupEvent {sndGroupEvent :: DBSndGroupEvent} - | DBJCIRcvConnEvent {rcvConnEvent :: DBRcvConnEvent} - | DBJCISndConnEvent {sndConnEvent :: DBSndConnEvent} - | DBJCIRcvChatFeature {feature :: ChatFeature, enabled :: PrefEnabled, param :: Maybe Int} - | DBJCISndChatFeature {feature :: ChatFeature, enabled :: PrefEnabled, param :: Maybe Int} - | DBJCIRcvChatPreference {feature :: ChatFeature, allowed :: FeatureAllowed, param :: Maybe Int} - | DBJCISndChatPreference {feature :: ChatFeature, allowed :: FeatureAllowed, param :: Maybe Int} - | DBJCIRcvGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int} - | DBJCISndGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int} - | DBJCIRcvChatFeatureRejected {feature :: ChatFeature} - | DBJCIRcvGroupFeatureRejected {groupFeature :: GroupFeature} - | DBJCISndModerated - | DBJCIRcvModerated - | DBJCIInvalidJSON {direction :: MsgDirection, json :: Text} - deriving (Generic) - -instance FromJSON DBJSONCIContent where - parseJSON = J.genericParseJSON . singleFieldJSON $ dropPrefix "DBJCI" - -instance ToJSON DBJSONCIContent where - toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "DBJCI" - toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "DBJCI" - -dbJsonCIContent :: forall d. MsgDirectionI d => CIContent d -> DBJSONCIContent -dbJsonCIContent = \case - CISndMsgContent mc -> DBJCISndMsgContent mc - CIRcvMsgContent mc -> DBJCIRcvMsgContent mc - CISndDeleted cidm -> DBJCISndDeleted cidm - CIRcvDeleted cidm -> DBJCIRcvDeleted cidm - CISndCall status duration -> DBJCISndCall {status, duration} - CIRcvCall status duration -> DBJCIRcvCall {status, duration} - CIRcvIntegrityError err -> DBJCIRcvIntegrityError $ DBME err - CIRcvDecryptionError err n -> DBJCIRcvDecryptionError err n - CIRcvGroupInvitation groupInvitation memberRole -> DBJCIRcvGroupInvitation {groupInvitation, memberRole} - CISndGroupInvitation groupInvitation memberRole -> DBJCISndGroupInvitation {groupInvitation, memberRole} - CIRcvGroupEvent rge -> DBJCIRcvGroupEvent $ RGE rge - CISndGroupEvent sge -> DBJCISndGroupEvent $ SGE sge - CIRcvConnEvent rce -> DBJCIRcvConnEvent $ RCE rce - CISndConnEvent sce -> DBJCISndConnEvent $ SCE sce - CIRcvChatFeature feature enabled param -> DBJCIRcvChatFeature {feature, enabled, param} - CISndChatFeature feature enabled param -> DBJCISndChatFeature {feature, enabled, param} - CIRcvChatPreference feature allowed param -> DBJCIRcvChatPreference {feature, allowed, param} - CISndChatPreference feature allowed param -> DBJCISndChatPreference {feature, allowed, param} - CIRcvGroupFeature groupFeature preference param -> DBJCIRcvGroupFeature {groupFeature, preference, param} - CISndGroupFeature groupFeature preference param -> DBJCISndGroupFeature {groupFeature, preference, param} - CIRcvChatFeatureRejected feature -> DBJCIRcvChatFeatureRejected {feature} - CIRcvGroupFeatureRejected groupFeature -> DBJCIRcvGroupFeatureRejected {groupFeature} - CISndModerated -> DBJCISndModerated - CIRcvModerated -> DBJCIRcvModerated - CIInvalidJSON json -> DBJCIInvalidJSON (toMsgDirection $ msgDirection @d) json - -aciContentDBJSON :: DBJSONCIContent -> ACIContent -aciContentDBJSON = \case - DBJCISndMsgContent mc -> ACIContent SMDSnd $ CISndMsgContent mc - DBJCIRcvMsgContent mc -> ACIContent SMDRcv $ CIRcvMsgContent mc - DBJCISndDeleted cidm -> ACIContent SMDSnd $ CISndDeleted cidm - DBJCIRcvDeleted cidm -> ACIContent SMDRcv $ CIRcvDeleted cidm - DBJCISndCall {status, duration} -> ACIContent SMDSnd $ CISndCall status duration - DBJCIRcvCall {status, duration} -> ACIContent SMDRcv $ CIRcvCall status duration - DBJCIRcvIntegrityError (DBME err) -> ACIContent SMDRcv $ CIRcvIntegrityError err - DBJCIRcvDecryptionError err n -> ACIContent SMDRcv $ CIRcvDecryptionError err n - DBJCIRcvGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDRcv $ CIRcvGroupInvitation groupInvitation memberRole - DBJCISndGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDSnd $ CISndGroupInvitation groupInvitation memberRole - DBJCIRcvGroupEvent (RGE rge) -> ACIContent SMDRcv $ CIRcvGroupEvent rge - DBJCISndGroupEvent (SGE sge) -> ACIContent SMDSnd $ CISndGroupEvent sge - DBJCIRcvConnEvent (RCE rce) -> ACIContent SMDRcv $ CIRcvConnEvent rce - DBJCISndConnEvent (SCE sce) -> ACIContent SMDSnd $ CISndConnEvent sce - DBJCIRcvChatFeature {feature, enabled, param} -> ACIContent SMDRcv $ CIRcvChatFeature feature enabled param - DBJCISndChatFeature {feature, enabled, param} -> ACIContent SMDSnd $ CISndChatFeature feature enabled param - DBJCIRcvChatPreference {feature, allowed, param} -> ACIContent SMDRcv $ CIRcvChatPreference feature allowed param - DBJCISndChatPreference {feature, allowed, param} -> ACIContent SMDSnd $ CISndChatPreference feature allowed param - DBJCIRcvGroupFeature {groupFeature, preference, param} -> ACIContent SMDRcv $ CIRcvGroupFeature groupFeature preference param - DBJCISndGroupFeature {groupFeature, preference, param} -> ACIContent SMDSnd $ CISndGroupFeature groupFeature preference param - DBJCIRcvChatFeatureRejected {feature} -> ACIContent SMDRcv $ CIRcvChatFeatureRejected feature - DBJCIRcvGroupFeatureRejected {groupFeature} -> ACIContent SMDRcv $ CIRcvGroupFeatureRejected groupFeature - DBJCISndModerated -> ACIContent SMDSnd CISndModerated - DBJCIRcvModerated -> ACIContent SMDRcv CIRcvModerated - DBJCIInvalidJSON dir json -> case fromMsgDirection dir of - AMsgDirection d -> ACIContent d $ CIInvalidJSON json - -data CICallStatus - = CISCallPending - | CISCallMissed - | CISCallRejected -- only possible for received calls, not on type level - | CISCallAccepted - | CISCallNegotiated - | CISCallProgress - | CISCallEnded - | CISCallError - deriving (Show, Generic) - -instance FromJSON CICallStatus where - parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CISCall" - -instance ToJSON CICallStatus where - toJSON = J.genericToJSON . enumJSON $ dropPrefix "CISCall" - toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CISCall" - -ciCallInfoText :: CICallStatus -> Int -> Text -ciCallInfoText status duration = case status of - CISCallPending -> "calling..." - CISCallMissed -> "missed" - CISCallRejected -> "rejected" - CISCallAccepted -> "accepted" - CISCallNegotiated -> "connecting..." - CISCallProgress -> "in progress " <> durationText duration - CISCallEnded -> "ended " <> durationText duration - CISCallError -> "error" - data SChatType (c :: ChatType) where SCTDirect :: SChatType 'CTDirect SCTGroup :: SChatType 'CTGroup @@ -1323,73 +762,6 @@ type MessageId = Int64 data ConnOrGroupId = ConnectionId Int64 | GroupId Int64 -data MsgDirection = MDRcv | MDSnd - deriving (Eq, Show, Generic) - -instance FromJSON MsgDirection where - parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "MD" - -instance ToJSON MsgDirection where - toJSON = J.genericToJSON . enumJSON $ dropPrefix "MD" - toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "MD" - -instance FromField AMsgDirection where fromField = fromIntField_ $ fmap fromMsgDirection . msgDirectionIntP - -instance ToField MsgDirection where toField = toField . msgDirectionInt - -fromIntField_ :: (Typeable a) => (Int64 -> Maybe a) -> Field -> Ok a -fromIntField_ fromInt = \case - f@(Field (SQLInteger i) _) -> - case fromInt i of - Just x -> Ok x - _ -> returnError ConversionFailed f ("invalid integer: " <> show i) - f -> returnError ConversionFailed f "expecting SQLInteger column type" - -data SMsgDirection (d :: MsgDirection) where - SMDRcv :: SMsgDirection 'MDRcv - SMDSnd :: SMsgDirection 'MDSnd - -deriving instance Show (SMsgDirection d) - -instance TestEquality SMsgDirection where - testEquality SMDRcv SMDRcv = Just Refl - testEquality SMDSnd SMDSnd = Just Refl - testEquality _ _ = Nothing - -instance ToField (SMsgDirection d) where toField = toField . msgDirectionInt . toMsgDirection - -data AMsgDirection = forall d. MsgDirectionI d => AMsgDirection (SMsgDirection d) - -deriving instance Show AMsgDirection - -toMsgDirection :: SMsgDirection d -> MsgDirection -toMsgDirection = \case - SMDRcv -> MDRcv - SMDSnd -> MDSnd - -fromMsgDirection :: MsgDirection -> AMsgDirection -fromMsgDirection = \case - MDRcv -> AMsgDirection SMDRcv - MDSnd -> AMsgDirection SMDSnd - -class MsgDirectionI (d :: MsgDirection) where - msgDirection :: SMsgDirection d - -instance MsgDirectionI 'MDRcv where msgDirection = SMDRcv - -instance MsgDirectionI 'MDSnd where msgDirection = SMDSnd - -msgDirectionInt :: MsgDirection -> Int -msgDirectionInt = \case - MDRcv -> 0 - MDSnd -> 1 - -msgDirectionIntP :: Int64 -> Maybe MsgDirection -msgDirectionIntP = \case - 0 -> Just MDRcv - 1 -> Just MDSnd - _ -> Nothing - data SndMsgDelivery = SndMsgDelivery { connId :: Int64, agentMsgId :: AgentMsgId diff --git a/src/Simplex/Chat/Messages/ChatItemContent.hs b/src/Simplex/Chat/Messages/ChatItemContent.hs new file mode 100644 index 0000000000..f69bd59b55 --- /dev/null +++ b/src/Simplex/Chat/Messages/ChatItemContent.hs @@ -0,0 +1,660 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} + +module Simplex.Chat.Messages.ChatItemContent where + +import Data.Aeson (FromJSON, ToJSON) +import qualified Data.Aeson as J +import Data.Int (Int64) +import Data.Text (Text) +import Data.Text.Encoding (decodeLatin1, encodeUtf8) +import Data.Type.Equality +import Data.Typeable (Typeable) +import Data.Word (Word32) +import Database.SQLite.Simple (ResultError (..), SQLData (..)) +import Database.SQLite.Simple.FromField (Field, FromField (..), returnError) +import Database.SQLite.Simple.Internal (Field (..)) +import Database.SQLite.Simple.Ok +import Database.SQLite.Simple.ToField (ToField (..)) +import GHC.Generics (Generic) +import Simplex.Chat.Protocol +import Simplex.Chat.Types +import Simplex.Messaging.Agent.Protocol (MsgErrorType (..), SwitchPhase (..)) +import Simplex.Messaging.Encoding.String +import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fstToLower, singleFieldJSON, sumTypeJSON) +import Simplex.Messaging.Util (safeDecodeUtf8, tshow) + +data MsgDirection = MDRcv | MDSnd + deriving (Eq, Show, Generic) + +instance FromJSON MsgDirection where + parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "MD" + +instance ToJSON MsgDirection where + toJSON = J.genericToJSON . enumJSON $ dropPrefix "MD" + toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "MD" + +instance FromField AMsgDirection where fromField = fromIntField_ $ fmap fromMsgDirection . msgDirectionIntP + +instance ToField MsgDirection where toField = toField . msgDirectionInt + +fromIntField_ :: (Typeable a) => (Int64 -> Maybe a) -> Field -> Ok a +fromIntField_ fromInt = \case + f@(Field (SQLInteger i) _) -> + case fromInt i of + Just x -> Ok x + _ -> returnError ConversionFailed f ("invalid integer: " <> show i) + f -> returnError ConversionFailed f "expecting SQLInteger column type" + +data SMsgDirection (d :: MsgDirection) where + SMDRcv :: SMsgDirection 'MDRcv + SMDSnd :: SMsgDirection 'MDSnd + +deriving instance Show (SMsgDirection d) + +instance TestEquality SMsgDirection where + testEquality SMDRcv SMDRcv = Just Refl + testEquality SMDSnd SMDSnd = Just Refl + testEquality _ _ = Nothing + +instance ToField (SMsgDirection d) where toField = toField . msgDirectionInt . toMsgDirection + +data AMsgDirection = forall d. MsgDirectionI d => AMsgDirection (SMsgDirection d) + +deriving instance Show AMsgDirection + +toMsgDirection :: SMsgDirection d -> MsgDirection +toMsgDirection = \case + SMDRcv -> MDRcv + SMDSnd -> MDSnd + +fromMsgDirection :: MsgDirection -> AMsgDirection +fromMsgDirection = \case + MDRcv -> AMsgDirection SMDRcv + MDSnd -> AMsgDirection SMDSnd + +class MsgDirectionI (d :: MsgDirection) where + msgDirection :: SMsgDirection d + +instance MsgDirectionI 'MDRcv where msgDirection = SMDRcv + +instance MsgDirectionI 'MDSnd where msgDirection = SMDSnd + +msgDirectionInt :: MsgDirection -> Int +msgDirectionInt = \case + MDRcv -> 0 + MDSnd -> 1 + +msgDirectionIntP :: Int64 -> Maybe MsgDirection +msgDirectionIntP = \case + 0 -> Just MDRcv + 1 -> Just MDSnd + _ -> Nothing + +data CIDeleteMode = CIDMBroadcast | CIDMInternal + deriving (Show, Generic) + +instance ToJSON CIDeleteMode where + toJSON = J.genericToJSON . enumJSON $ dropPrefix "CIDM" + toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CIDM" + +instance FromJSON CIDeleteMode where + parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CIDM" + +ciDeleteModeToText :: CIDeleteMode -> Text +ciDeleteModeToText = \case + CIDMBroadcast -> "this item is deleted (broadcast)" + CIDMInternal -> "this item is deleted (internal)" + +-- This type is used both in API and in DB, so we use different JSON encodings for the database and for the API +-- ! Nested sum types also have to use different encodings for database and API +-- ! to avoid breaking cross-platform compatibility, see RcvGroupEvent and SndGroupEvent +data CIContent (d :: MsgDirection) where + CISndMsgContent :: MsgContent -> CIContent 'MDSnd + CIRcvMsgContent :: MsgContent -> CIContent 'MDRcv + CISndDeleted :: CIDeleteMode -> CIContent 'MDSnd -- legacy - since v4.3.0 item_deleted field is used + CIRcvDeleted :: CIDeleteMode -> CIContent 'MDRcv -- legacy - since v4.3.0 item_deleted field is used + CISndCall :: CICallStatus -> Int -> CIContent 'MDSnd + CIRcvCall :: CICallStatus -> Int -> CIContent 'MDRcv + CIRcvIntegrityError :: MsgErrorType -> CIContent 'MDRcv + CIRcvDecryptionError :: MsgDecryptError -> Word32 -> CIContent 'MDRcv + CIRcvGroupInvitation :: CIGroupInvitation -> GroupMemberRole -> CIContent 'MDRcv + CISndGroupInvitation :: CIGroupInvitation -> GroupMemberRole -> CIContent 'MDSnd + CIRcvGroupEvent :: RcvGroupEvent -> CIContent 'MDRcv + CISndGroupEvent :: SndGroupEvent -> CIContent 'MDSnd + CIRcvConnEvent :: RcvConnEvent -> CIContent 'MDRcv + CISndConnEvent :: SndConnEvent -> CIContent 'MDSnd + CIRcvChatFeature :: ChatFeature -> PrefEnabled -> Maybe Int -> CIContent 'MDRcv + CISndChatFeature :: ChatFeature -> PrefEnabled -> Maybe Int -> CIContent 'MDSnd + CIRcvChatPreference :: ChatFeature -> FeatureAllowed -> Maybe Int -> CIContent 'MDRcv + CISndChatPreference :: ChatFeature -> FeatureAllowed -> Maybe Int -> CIContent 'MDSnd + CIRcvGroupFeature :: GroupFeature -> GroupPreference -> Maybe Int -> CIContent 'MDRcv + CISndGroupFeature :: GroupFeature -> GroupPreference -> Maybe Int -> CIContent 'MDSnd + CIRcvChatFeatureRejected :: ChatFeature -> CIContent 'MDRcv + CIRcvGroupFeatureRejected :: GroupFeature -> CIContent 'MDRcv + CISndModerated :: CIContent 'MDSnd + CIRcvModerated :: CIContent 'MDRcv + CIInvalidJSON :: Text -> CIContent d +-- ^ This type is used both in API and in DB, so we use different JSON encodings for the database and for the API +-- ! ^ Nested sum types also have to use different encodings for database and API +-- ! ^ to avoid breaking cross-platform compatibility, see RcvGroupEvent and SndGroupEvent + +deriving instance Show (CIContent d) + +ciMsgContent :: CIContent d -> Maybe MsgContent +ciMsgContent = \case + CISndMsgContent mc -> Just mc + CIRcvMsgContent mc -> Just mc + _ -> Nothing + +data MsgDecryptError = MDERatchetHeader | MDETooManySkipped + deriving (Eq, Show, Generic) + +instance ToJSON MsgDecryptError where + toJSON = J.genericToJSON . enumJSON $ dropPrefix "MDE" + toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "MDE" + +instance FromJSON MsgDecryptError where + parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "MDE" + +ciRequiresAttention :: forall d. MsgDirectionI d => CIContent d -> Bool +ciRequiresAttention content = case msgDirection @d of + SMDSnd -> True + SMDRcv -> case content of + CIRcvMsgContent _ -> True + CIRcvDeleted _ -> True + CIRcvCall {} -> True + CIRcvIntegrityError _ -> True + CIRcvDecryptionError {} -> True + CIRcvGroupInvitation {} -> True + CIRcvGroupEvent rge -> case rge of + RGEMemberAdded {} -> False + RGEMemberConnected -> False + RGEMemberLeft -> False + RGEMemberRole {} -> False + RGEUserRole _ -> True + RGEMemberDeleted {} -> False + RGEUserDeleted -> True + RGEGroupDeleted -> True + RGEGroupUpdated _ -> False + RGEInvitedViaGroupLink -> False + CIRcvConnEvent _ -> True + CIRcvChatFeature {} -> False + CIRcvChatPreference {} -> False + CIRcvGroupFeature {} -> False + CIRcvChatFeatureRejected _ -> True + CIRcvGroupFeatureRejected _ -> True + CIRcvModerated -> True + CIInvalidJSON _ -> False + +data RcvGroupEvent + = RGEMemberAdded {groupMemberId :: GroupMemberId, profile :: Profile} -- CRJoinedGroupMemberConnecting + | RGEMemberConnected -- CRUserJoinedGroup, CRJoinedGroupMember, CRConnectedToGroupMember + | RGEMemberLeft -- CRLeftMember + | RGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole} + | RGEUserRole {role :: GroupMemberRole} + | RGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRDeletedMember + | RGEUserDeleted -- CRDeletedMemberUser + | RGEGroupDeleted -- CRGroupDeleted + | RGEGroupUpdated {groupProfile :: GroupProfile} -- CRGroupUpdated + -- RGEInvitedViaGroupLink chat items are not received - they're created when sending group invitations, + -- but being RcvGroupEvent allows them to be assigned to the respective member (and so enable "send direct message") + -- and be created as unread without adding / working around new status for sent items + | RGEInvitedViaGroupLink -- CRSentGroupInvitationViaLink + deriving (Show, Generic) + +instance FromJSON RcvGroupEvent where + parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RGE" + +instance ToJSON RcvGroupEvent where + toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RGE" + toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RGE" + +newtype DBRcvGroupEvent = RGE RcvGroupEvent + +instance FromJSON DBRcvGroupEvent where + parseJSON v = RGE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "RGE") v + +instance ToJSON DBRcvGroupEvent where + toJSON (RGE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "RGE") v + toEncoding (RGE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "RGE") v + +data SndGroupEvent + = SGEMemberRole {groupMemberId :: GroupMemberId, profile :: Profile, role :: GroupMemberRole} + | SGEUserRole {role :: GroupMemberRole} + | SGEMemberDeleted {groupMemberId :: GroupMemberId, profile :: Profile} -- CRUserDeletedMember + | SGEUserLeft -- CRLeftMemberUser + | SGEGroupUpdated {groupProfile :: GroupProfile} -- CRGroupUpdated + deriving (Show, Generic) + +instance FromJSON SndGroupEvent where + parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SGE" + +instance ToJSON SndGroupEvent where + toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SGE" + toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SGE" + +newtype DBSndGroupEvent = SGE SndGroupEvent + +instance FromJSON DBSndGroupEvent where + parseJSON v = SGE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "SGE") v + +instance ToJSON DBSndGroupEvent where + toJSON (SGE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "SGE") v + toEncoding (SGE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "SGE") v + +data RcvConnEvent = RCESwitchQueue {phase :: SwitchPhase} + deriving (Show, Generic) + +data SndConnEvent = SCESwitchQueue {phase :: SwitchPhase, member :: Maybe GroupMemberRef} + deriving (Show, Generic) + +instance FromJSON RcvConnEvent where + parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "RCE" + +instance ToJSON RcvConnEvent where + toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "RCE" + toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "RCE" + +newtype DBRcvConnEvent = RCE RcvConnEvent + +instance FromJSON DBRcvConnEvent where + parseJSON v = RCE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "RCE") v + +instance ToJSON DBRcvConnEvent where + toJSON (RCE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "RCE") v + toEncoding (RCE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "RCE") v + +instance FromJSON SndConnEvent where + parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "SCE" + +instance ToJSON SndConnEvent where + toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "SCE" + toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "SCE" + +newtype DBSndConnEvent = SCE SndConnEvent + +instance FromJSON DBSndConnEvent where + parseJSON v = SCE <$> J.genericParseJSON (singleFieldJSON $ dropPrefix "SCE") v + +instance ToJSON DBSndConnEvent where + toJSON (SCE v) = J.genericToJSON (singleFieldJSON $ dropPrefix "SCE") v + toEncoding (SCE v) = J.genericToEncoding (singleFieldJSON $ dropPrefix "SCE") v + +newtype DBMsgErrorType = DBME MsgErrorType + +instance FromJSON DBMsgErrorType where + parseJSON v = DBME <$> J.genericParseJSON (singleFieldJSON fstToLower) v + +instance ToJSON DBMsgErrorType where + toJSON (DBME v) = J.genericToJSON (singleFieldJSON fstToLower) v + toEncoding (DBME v) = J.genericToEncoding (singleFieldJSON fstToLower) v + +data CIGroupInvitation = CIGroupInvitation + { groupId :: GroupId, + groupMemberId :: GroupMemberId, + localDisplayName :: GroupName, + groupProfile :: GroupProfile, + status :: CIGroupInvitationStatus + } + deriving (Eq, Show, Generic, FromJSON) + +instance ToJSON CIGroupInvitation where + toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} + toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} + +data CIGroupInvitationStatus + = CIGISPending + | CIGISAccepted + | CIGISRejected + | CIGISExpired + deriving (Eq, Show, Generic) + +instance FromJSON CIGroupInvitationStatus where + parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CIGIS" + +instance ToJSON CIGroupInvitationStatus where + toJSON = J.genericToJSON . enumJSON $ dropPrefix "CIGIS" + toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CIGIS" + +ciContentToText :: CIContent d -> Text +ciContentToText = \case + CISndMsgContent mc -> msgContentText mc + CIRcvMsgContent mc -> msgContentText mc + CISndDeleted cidm -> ciDeleteModeToText cidm + CIRcvDeleted cidm -> ciDeleteModeToText cidm + CISndCall status duration -> "outgoing call: " <> ciCallInfoText status duration + CIRcvCall status duration -> "incoming call: " <> ciCallInfoText status duration + CIRcvIntegrityError err -> msgIntegrityError err + CIRcvDecryptionError err n -> msgDecryptErrorText err n + CIRcvGroupInvitation groupInvitation memberRole -> "received " <> ciGroupInvitationToText groupInvitation memberRole + CISndGroupInvitation groupInvitation memberRole -> "sent " <> ciGroupInvitationToText groupInvitation memberRole + CIRcvGroupEvent event -> rcvGroupEventToText event + CISndGroupEvent event -> sndGroupEventToText event + CIRcvConnEvent event -> rcvConnEventToText event + CISndConnEvent event -> sndConnEventToText event + CIRcvChatFeature feature enabled param -> featureStateText feature enabled param + CISndChatFeature feature enabled param -> featureStateText feature enabled param + CIRcvChatPreference feature allowed param -> prefStateText feature allowed param + CISndChatPreference feature allowed param -> "you " <> prefStateText feature allowed param + CIRcvGroupFeature feature pref param -> groupPrefStateText feature pref param + CISndGroupFeature feature pref param -> groupPrefStateText feature pref param + CIRcvChatFeatureRejected feature -> chatFeatureNameText feature <> ": received, prohibited" + CIRcvGroupFeatureRejected feature -> groupFeatureNameText feature <> ": received, prohibited" + CISndModerated -> ciModeratedText + CIRcvModerated -> ciModeratedText + CIInvalidJSON _ -> "invalid content JSON" + +ciGroupInvitationToText :: CIGroupInvitation -> GroupMemberRole -> Text +ciGroupInvitationToText CIGroupInvitation {groupProfile = GroupProfile {displayName, fullName}} role = + "invitation to join group " <> displayName <> optionalFullName displayName fullName <> " as " <> (decodeLatin1 . strEncode $ role) + +rcvGroupEventToText :: RcvGroupEvent -> Text +rcvGroupEventToText = \case + RGEMemberAdded _ p -> "added " <> profileToText p + RGEMemberConnected -> "connected" + RGEMemberLeft -> "left" + RGEMemberRole _ p r -> "changed role of " <> profileToText p <> " to " <> safeDecodeUtf8 (strEncode r) + RGEUserRole r -> "changed your role to " <> safeDecodeUtf8 (strEncode r) + RGEMemberDeleted _ p -> "removed " <> profileToText p + RGEUserDeleted -> "removed you" + RGEGroupDeleted -> "deleted group" + RGEGroupUpdated _ -> "group profile updated" + RGEInvitedViaGroupLink -> "invited via your group link" + +sndGroupEventToText :: SndGroupEvent -> Text +sndGroupEventToText = \case + SGEMemberRole _ p r -> "changed role of " <> profileToText p <> " to " <> safeDecodeUtf8 (strEncode r) + SGEUserRole r -> "changed role for yourself to " <> safeDecodeUtf8 (strEncode r) + SGEMemberDeleted _ p -> "removed " <> profileToText p + SGEUserLeft -> "left" + SGEGroupUpdated _ -> "group profile updated" + +rcvConnEventToText :: RcvConnEvent -> Text +rcvConnEventToText = \case + RCESwitchQueue phase -> case phase of + SPCompleted -> "changed address for you" + _ -> decodeLatin1 (strEncode phase) <> " changing address for you..." + +sndConnEventToText :: SndConnEvent -> Text +sndConnEventToText = \case + SCESwitchQueue phase m -> case phase of + SPCompleted -> "you changed address" <> forMember m + _ -> decodeLatin1 (strEncode phase) <> " changing address" <> forMember m <> "..." + where + forMember member_ = + maybe "" (\GroupMemberRef {profile = Profile {displayName}} -> " for " <> displayName) member_ + +profileToText :: Profile -> Text +profileToText Profile {displayName, fullName} = displayName <> optionalFullName displayName fullName + +msgIntegrityError :: MsgErrorType -> Text +msgIntegrityError = \case + MsgSkipped fromId toId -> + "skipped message ID " <> tshow fromId + <> if fromId == toId then "" else ".." <> tshow toId + MsgBadId msgId -> "unexpected message ID " <> tshow msgId + MsgBadHash -> "incorrect message hash" + MsgDuplicate -> "duplicate message ID" + +msgDecryptErrorText :: MsgDecryptError -> Word32 -> Text +msgDecryptErrorText err n = + "decryption error, possibly due to the device change (" <> errName <> if n == 1 then ")" else ", " <> tshow n <> " messages)" + where + errName = case err of + MDERatchetHeader -> "header" + MDETooManySkipped -> "too many skipped messages" + +msgDirToModeratedContent_ :: SMsgDirection d -> CIContent d +msgDirToModeratedContent_ = \case + SMDRcv -> CIRcvModerated + SMDSnd -> CISndModerated + +ciModeratedText :: Text +ciModeratedText = "moderated" + +-- platform independent +instance MsgDirectionI d => ToField (CIContent d) where + toField = toField . encodeJSON . dbJsonCIContent + +-- platform specific +instance MsgDirectionI d => ToJSON (CIContent d) where + toJSON = J.toJSON . jsonCIContent + toEncoding = J.toEncoding . jsonCIContent + +data ACIContent = forall d. MsgDirectionI d => ACIContent (SMsgDirection d) (CIContent d) + +deriving instance Show ACIContent + +-- platform independent +dbParseACIContent :: Text -> Either String ACIContent +dbParseACIContent = fmap aciContentDBJSON . J.eitherDecodeStrict' . encodeUtf8 + +-- platform specific +instance FromJSON ACIContent where + parseJSON = fmap aciContentJSON . J.parseJSON + +-- platform specific +data JSONCIContent + = JCISndMsgContent {msgContent :: MsgContent} + | JCIRcvMsgContent {msgContent :: MsgContent} + | JCISndDeleted {deleteMode :: CIDeleteMode} + | JCIRcvDeleted {deleteMode :: CIDeleteMode} + | JCISndCall {status :: CICallStatus, duration :: Int} -- duration in seconds + | JCIRcvCall {status :: CICallStatus, duration :: Int} + | JCIRcvIntegrityError {msgError :: MsgErrorType} + | JCIRcvDecryptionError {msgDecryptError :: MsgDecryptError, msgCount :: Word32} + | JCIRcvGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole} + | JCISndGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole} + | JCIRcvGroupEvent {rcvGroupEvent :: RcvGroupEvent} + | JCISndGroupEvent {sndGroupEvent :: SndGroupEvent} + | JCIRcvConnEvent {rcvConnEvent :: RcvConnEvent} + | JCISndConnEvent {sndConnEvent :: SndConnEvent} + | JCIRcvChatFeature {feature :: ChatFeature, enabled :: PrefEnabled, param :: Maybe Int} + | JCISndChatFeature {feature :: ChatFeature, enabled :: PrefEnabled, param :: Maybe Int} + | JCIRcvChatPreference {feature :: ChatFeature, allowed :: FeatureAllowed, param :: Maybe Int} + | JCISndChatPreference {feature :: ChatFeature, allowed :: FeatureAllowed, param :: Maybe Int} + | JCIRcvGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int} + | JCISndGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int} + | JCIRcvChatFeatureRejected {feature :: ChatFeature} + | JCIRcvGroupFeatureRejected {groupFeature :: GroupFeature} + | JCISndModerated + | JCIRcvModerated + | JCIInvalidJSON {direction :: MsgDirection, json :: Text} + deriving (Generic) + +instance FromJSON JSONCIContent where + parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "JCI" + +instance ToJSON JSONCIContent where + toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "JCI" + toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "JCI" + +jsonCIContent :: forall d. MsgDirectionI d => CIContent d -> JSONCIContent +jsonCIContent = \case + CISndMsgContent mc -> JCISndMsgContent mc + CIRcvMsgContent mc -> JCIRcvMsgContent mc + CISndDeleted cidm -> JCISndDeleted cidm + CIRcvDeleted cidm -> JCIRcvDeleted cidm + CISndCall status duration -> JCISndCall {status, duration} + CIRcvCall status duration -> JCIRcvCall {status, duration} + CIRcvIntegrityError err -> JCIRcvIntegrityError err + CIRcvDecryptionError err n -> JCIRcvDecryptionError err n + CIRcvGroupInvitation groupInvitation memberRole -> JCIRcvGroupInvitation {groupInvitation, memberRole} + CISndGroupInvitation groupInvitation memberRole -> JCISndGroupInvitation {groupInvitation, memberRole} + CIRcvGroupEvent rcvGroupEvent -> JCIRcvGroupEvent {rcvGroupEvent} + CISndGroupEvent sndGroupEvent -> JCISndGroupEvent {sndGroupEvent} + CIRcvConnEvent rcvConnEvent -> JCIRcvConnEvent {rcvConnEvent} + CISndConnEvent sndConnEvent -> JCISndConnEvent {sndConnEvent} + CIRcvChatFeature feature enabled param -> JCIRcvChatFeature {feature, enabled, param} + CISndChatFeature feature enabled param -> JCISndChatFeature {feature, enabled, param} + CIRcvChatPreference feature allowed param -> JCIRcvChatPreference {feature, allowed, param} + CISndChatPreference feature allowed param -> JCISndChatPreference {feature, allowed, param} + CIRcvGroupFeature groupFeature preference param -> JCIRcvGroupFeature {groupFeature, preference, param} + CISndGroupFeature groupFeature preference param -> JCISndGroupFeature {groupFeature, preference, param} + CIRcvChatFeatureRejected feature -> JCIRcvChatFeatureRejected {feature} + CIRcvGroupFeatureRejected groupFeature -> JCIRcvGroupFeatureRejected {groupFeature} + CISndModerated -> JCISndModerated + CIRcvModerated -> JCISndModerated + CIInvalidJSON json -> JCIInvalidJSON (toMsgDirection $ msgDirection @d) json + +aciContentJSON :: JSONCIContent -> ACIContent +aciContentJSON = \case + JCISndMsgContent mc -> ACIContent SMDSnd $ CISndMsgContent mc + JCIRcvMsgContent mc -> ACIContent SMDRcv $ CIRcvMsgContent mc + JCISndDeleted cidm -> ACIContent SMDSnd $ CISndDeleted cidm + JCIRcvDeleted cidm -> ACIContent SMDRcv $ CIRcvDeleted cidm + JCISndCall {status, duration} -> ACIContent SMDSnd $ CISndCall status duration + JCIRcvCall {status, duration} -> ACIContent SMDRcv $ CIRcvCall status duration + JCIRcvIntegrityError err -> ACIContent SMDRcv $ CIRcvIntegrityError err + JCIRcvDecryptionError err n -> ACIContent SMDRcv $ CIRcvDecryptionError err n + JCIRcvGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDRcv $ CIRcvGroupInvitation groupInvitation memberRole + JCISndGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDSnd $ CISndGroupInvitation groupInvitation memberRole + JCIRcvGroupEvent {rcvGroupEvent} -> ACIContent SMDRcv $ CIRcvGroupEvent rcvGroupEvent + JCISndGroupEvent {sndGroupEvent} -> ACIContent SMDSnd $ CISndGroupEvent sndGroupEvent + JCIRcvConnEvent {rcvConnEvent} -> ACIContent SMDRcv $ CIRcvConnEvent rcvConnEvent + JCISndConnEvent {sndConnEvent} -> ACIContent SMDSnd $ CISndConnEvent sndConnEvent + JCIRcvChatFeature {feature, enabled, param} -> ACIContent SMDRcv $ CIRcvChatFeature feature enabled param + JCISndChatFeature {feature, enabled, param} -> ACIContent SMDSnd $ CISndChatFeature feature enabled param + JCIRcvChatPreference {feature, allowed, param} -> ACIContent SMDRcv $ CIRcvChatPreference feature allowed param + JCISndChatPreference {feature, allowed, param} -> ACIContent SMDSnd $ CISndChatPreference feature allowed param + JCIRcvGroupFeature {groupFeature, preference, param} -> ACIContent SMDRcv $ CIRcvGroupFeature groupFeature preference param + JCISndGroupFeature {groupFeature, preference, param} -> ACIContent SMDSnd $ CISndGroupFeature groupFeature preference param + JCIRcvChatFeatureRejected {feature} -> ACIContent SMDRcv $ CIRcvChatFeatureRejected feature + JCIRcvGroupFeatureRejected {groupFeature} -> ACIContent SMDRcv $ CIRcvGroupFeatureRejected groupFeature + JCISndModerated -> ACIContent SMDSnd CISndModerated + JCIRcvModerated -> ACIContent SMDRcv CIRcvModerated + JCIInvalidJSON dir json -> case fromMsgDirection dir of + AMsgDirection d -> ACIContent d $ CIInvalidJSON json + +-- platform independent +data DBJSONCIContent + = DBJCISndMsgContent {msgContent :: MsgContent} + | DBJCIRcvMsgContent {msgContent :: MsgContent} + | DBJCISndDeleted {deleteMode :: CIDeleteMode} + | DBJCIRcvDeleted {deleteMode :: CIDeleteMode} + | DBJCISndCall {status :: CICallStatus, duration :: Int} + | DBJCIRcvCall {status :: CICallStatus, duration :: Int} + | DBJCIRcvIntegrityError {msgError :: DBMsgErrorType} + | DBJCIRcvDecryptionError {msgDecryptError :: MsgDecryptError, msgCount :: Word32} + | DBJCIRcvGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole} + | DBJCISndGroupInvitation {groupInvitation :: CIGroupInvitation, memberRole :: GroupMemberRole} + | DBJCIRcvGroupEvent {rcvGroupEvent :: DBRcvGroupEvent} + | DBJCISndGroupEvent {sndGroupEvent :: DBSndGroupEvent} + | DBJCIRcvConnEvent {rcvConnEvent :: DBRcvConnEvent} + | DBJCISndConnEvent {sndConnEvent :: DBSndConnEvent} + | DBJCIRcvChatFeature {feature :: ChatFeature, enabled :: PrefEnabled, param :: Maybe Int} + | DBJCISndChatFeature {feature :: ChatFeature, enabled :: PrefEnabled, param :: Maybe Int} + | DBJCIRcvChatPreference {feature :: ChatFeature, allowed :: FeatureAllowed, param :: Maybe Int} + | DBJCISndChatPreference {feature :: ChatFeature, allowed :: FeatureAllowed, param :: Maybe Int} + | DBJCIRcvGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int} + | DBJCISndGroupFeature {groupFeature :: GroupFeature, preference :: GroupPreference, param :: Maybe Int} + | DBJCIRcvChatFeatureRejected {feature :: ChatFeature} + | DBJCIRcvGroupFeatureRejected {groupFeature :: GroupFeature} + | DBJCISndModerated + | DBJCIRcvModerated + | DBJCIInvalidJSON {direction :: MsgDirection, json :: Text} + deriving (Generic) + +instance FromJSON DBJSONCIContent where + parseJSON = J.genericParseJSON . singleFieldJSON $ dropPrefix "DBJCI" + +instance ToJSON DBJSONCIContent where + toJSON = J.genericToJSON . singleFieldJSON $ dropPrefix "DBJCI" + toEncoding = J.genericToEncoding . singleFieldJSON $ dropPrefix "DBJCI" + +dbJsonCIContent :: forall d. MsgDirectionI d => CIContent d -> DBJSONCIContent +dbJsonCIContent = \case + CISndMsgContent mc -> DBJCISndMsgContent mc + CIRcvMsgContent mc -> DBJCIRcvMsgContent mc + CISndDeleted cidm -> DBJCISndDeleted cidm + CIRcvDeleted cidm -> DBJCIRcvDeleted cidm + CISndCall status duration -> DBJCISndCall {status, duration} + CIRcvCall status duration -> DBJCIRcvCall {status, duration} + CIRcvIntegrityError err -> DBJCIRcvIntegrityError $ DBME err + CIRcvDecryptionError err n -> DBJCIRcvDecryptionError err n + CIRcvGroupInvitation groupInvitation memberRole -> DBJCIRcvGroupInvitation {groupInvitation, memberRole} + CISndGroupInvitation groupInvitation memberRole -> DBJCISndGroupInvitation {groupInvitation, memberRole} + CIRcvGroupEvent rge -> DBJCIRcvGroupEvent $ RGE rge + CISndGroupEvent sge -> DBJCISndGroupEvent $ SGE sge + CIRcvConnEvent rce -> DBJCIRcvConnEvent $ RCE rce + CISndConnEvent sce -> DBJCISndConnEvent $ SCE sce + CIRcvChatFeature feature enabled param -> DBJCIRcvChatFeature {feature, enabled, param} + CISndChatFeature feature enabled param -> DBJCISndChatFeature {feature, enabled, param} + CIRcvChatPreference feature allowed param -> DBJCIRcvChatPreference {feature, allowed, param} + CISndChatPreference feature allowed param -> DBJCISndChatPreference {feature, allowed, param} + CIRcvGroupFeature groupFeature preference param -> DBJCIRcvGroupFeature {groupFeature, preference, param} + CISndGroupFeature groupFeature preference param -> DBJCISndGroupFeature {groupFeature, preference, param} + CIRcvChatFeatureRejected feature -> DBJCIRcvChatFeatureRejected {feature} + CIRcvGroupFeatureRejected groupFeature -> DBJCIRcvGroupFeatureRejected {groupFeature} + CISndModerated -> DBJCISndModerated + CIRcvModerated -> DBJCIRcvModerated + CIInvalidJSON json -> DBJCIInvalidJSON (toMsgDirection $ msgDirection @d) json + +aciContentDBJSON :: DBJSONCIContent -> ACIContent +aciContentDBJSON = \case + DBJCISndMsgContent mc -> ACIContent SMDSnd $ CISndMsgContent mc + DBJCIRcvMsgContent mc -> ACIContent SMDRcv $ CIRcvMsgContent mc + DBJCISndDeleted cidm -> ACIContent SMDSnd $ CISndDeleted cidm + DBJCIRcvDeleted cidm -> ACIContent SMDRcv $ CIRcvDeleted cidm + DBJCISndCall {status, duration} -> ACIContent SMDSnd $ CISndCall status duration + DBJCIRcvCall {status, duration} -> ACIContent SMDRcv $ CIRcvCall status duration + DBJCIRcvIntegrityError (DBME err) -> ACIContent SMDRcv $ CIRcvIntegrityError err + DBJCIRcvDecryptionError err n -> ACIContent SMDRcv $ CIRcvDecryptionError err n + DBJCIRcvGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDRcv $ CIRcvGroupInvitation groupInvitation memberRole + DBJCISndGroupInvitation {groupInvitation, memberRole} -> ACIContent SMDSnd $ CISndGroupInvitation groupInvitation memberRole + DBJCIRcvGroupEvent (RGE rge) -> ACIContent SMDRcv $ CIRcvGroupEvent rge + DBJCISndGroupEvent (SGE sge) -> ACIContent SMDSnd $ CISndGroupEvent sge + DBJCIRcvConnEvent (RCE rce) -> ACIContent SMDRcv $ CIRcvConnEvent rce + DBJCISndConnEvent (SCE sce) -> ACIContent SMDSnd $ CISndConnEvent sce + DBJCIRcvChatFeature {feature, enabled, param} -> ACIContent SMDRcv $ CIRcvChatFeature feature enabled param + DBJCISndChatFeature {feature, enabled, param} -> ACIContent SMDSnd $ CISndChatFeature feature enabled param + DBJCIRcvChatPreference {feature, allowed, param} -> ACIContent SMDRcv $ CIRcvChatPreference feature allowed param + DBJCISndChatPreference {feature, allowed, param} -> ACIContent SMDSnd $ CISndChatPreference feature allowed param + DBJCIRcvGroupFeature {groupFeature, preference, param} -> ACIContent SMDRcv $ CIRcvGroupFeature groupFeature preference param + DBJCISndGroupFeature {groupFeature, preference, param} -> ACIContent SMDSnd $ CISndGroupFeature groupFeature preference param + DBJCIRcvChatFeatureRejected {feature} -> ACIContent SMDRcv $ CIRcvChatFeatureRejected feature + DBJCIRcvGroupFeatureRejected {groupFeature} -> ACIContent SMDRcv $ CIRcvGroupFeatureRejected groupFeature + DBJCISndModerated -> ACIContent SMDSnd CISndModerated + DBJCIRcvModerated -> ACIContent SMDRcv CIRcvModerated + DBJCIInvalidJSON dir json -> case fromMsgDirection dir of + AMsgDirection d -> ACIContent d $ CIInvalidJSON json + +data CICallStatus + = CISCallPending + | CISCallMissed + | CISCallRejected -- only possible for received calls, not on type level + | CISCallAccepted + | CISCallNegotiated + | CISCallProgress + | CISCallEnded + | CISCallError + deriving (Show, Generic) + +instance FromJSON CICallStatus where + parseJSON = J.genericParseJSON . enumJSON $ dropPrefix "CISCall" + +instance ToJSON CICallStatus where + toJSON = J.genericToJSON . enumJSON $ dropPrefix "CISCall" + toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "CISCall" + +ciCallInfoText :: CICallStatus -> Int -> Text +ciCallInfoText status duration = case status of + CISCallPending -> "calling..." + CISCallMissed -> "missed" + CISCallRejected -> "rejected" + CISCallAccepted -> "accepted" + CISCallNegotiated -> "connecting..." + CISCallProgress -> "in progress " <> durationText duration + CISCallEnded -> "ended " <> durationText duration + CISCallError -> "error" diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 4640a8bcdb..12ac37032d 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -329,6 +329,7 @@ import GHC.Generics (Generic) import Simplex.Chat.Call import Simplex.Chat.Markdown import Simplex.Chat.Messages +import Simplex.Chat.Messages.ChatItemContent import Simplex.Chat.Migrations.M20220101_initial import Simplex.Chat.Migrations.M20220122_v1_1 import Simplex.Chat.Migrations.M20220205_chat_item_status @@ -4866,8 +4867,8 @@ getGroupChatReactions_ db g c@Chat {chatItems} = do getDirectCIReactions :: DB.Connection -> Contact -> SharedMsgId -> IO [CIReactionCount] getDirectCIReactions db Contact {contactId} itemSharedMsgId = - map toCIReaction <$> - DB.query + map toCIReaction + <$> DB.query db [sql| SELECT reaction, MAX(reaction_sent), COUNT(chat_item_reaction_id) @@ -4879,8 +4880,8 @@ getDirectCIReactions db Contact {contactId} itemSharedMsgId = getGroupCIReactions :: DB.Connection -> GroupInfo -> MemberId -> SharedMsgId -> IO [CIReactionCount] getGroupCIReactions db GroupInfo {groupId} itemMemberId itemSharedMsgId = - map toCIReaction <$> - DB.query + map toCIReaction + <$> DB.query db [sql| SELECT reaction, MAX(reaction_sent), COUNT(chat_item_reaction_id) @@ -4905,14 +4906,15 @@ getACIReactions db aci@(AChatItem _ md chat ci@ChatItem {meta = CIMeta {itemShar deleteDirectCIReactions_ :: DB.Connection -> ContactId -> ChatItem 'CTDirect d -> IO () deleteDirectCIReactions_ db contactId ChatItem {meta = CIMeta {itemSharedMsgId}} = - forM_ itemSharedMsgId $ \itemSharedMId -> + forM_ itemSharedMsgId $ \itemSharedMId -> DB.execute db "DELETE FROM chat_item_reactions WHERE contact_id = ? AND shared_msg_id = ?" (contactId, itemSharedMId) deleteGroupCIReactions_ :: DB.Connection -> GroupInfo -> ChatItem 'CTGroup d -> IO () deleteGroupCIReactions_ db g@GroupInfo {groupId} ci@ChatItem {meta = CIMeta {itemSharedMsgId}} = forM_ itemSharedMsgId $ \itemSharedMId -> do let GroupMember {memberId} = chatItemMember g ci - DB.execute db + DB.execute + db "DELETE FROM chat_item_reactions WHERE group_id = ? AND shared_msg_id = ? AND item_member_id = ?" (groupId, itemSharedMId, memberId) @@ -4921,8 +4923,8 @@ toCIReaction (reaction, userReacted, totalReacted) = CIReactionCount {reaction, getDirectReactions :: DB.Connection -> Contact -> SharedMsgId -> Bool -> IO [MsgReaction] getDirectReactions db ct itemSharedMId sent = - map fromOnly <$> - DB.query + map fromOnly + <$> DB.query db [sql| SELECT reaction @@ -4953,8 +4955,8 @@ setDirectReaction db ct itemSharedMId sent reaction add msgId reactionTs getGroupReactions :: DB.Connection -> GroupInfo -> GroupMember -> MemberId -> SharedMsgId -> Bool -> IO [MsgReaction] getGroupReactions db GroupInfo {groupId} m itemMemberId itemSharedMId sent = - map fromOnly <$> - DB.query + map fromOnly + <$> DB.query db [sql| SELECT reaction diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs index 719b77b73c..37644ad5e9 100644 --- a/src/Simplex/Chat/Terminal/Input.hs +++ b/src/Simplex/Chat/Terminal/Input.hs @@ -31,6 +31,7 @@ import GHC.Weak (deRefWeak) import Simplex.Chat import Simplex.Chat.Controller import Simplex.Chat.Messages +import Simplex.Chat.Messages.ChatItemContent import Simplex.Chat.Styled import Simplex.Chat.Terminal.Output import Simplex.Chat.Types (User (..)) @@ -322,7 +323,7 @@ updateTermState user_ st ac live tw (key, ms) ts@TerminalState {inputString = s, go _ _ = "" charsWithContact cs | live = cs - | null s && cs /= "@" && cs /= "#" && cs /= "/" && cs /= ">" && cs /= "\\" && cs /= "!" && cs /= "+" && cs /= "-" = + | null s && cs /= "@" && cs /= "#" && cs /= "/" && cs /= ">" && cs /= "\\" && cs /= "!" && cs /= "+" && cs /= "-" = contactPrefix <> cs | (s == ">" || s == "\\" || s == "!") && cs == " " = cs <> contactPrefix diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index a49b0d460f..c13318250e 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -37,6 +37,7 @@ import Simplex.Chat.Controller import Simplex.Chat.Help import Simplex.Chat.Markdown import Simplex.Chat.Messages hiding (NewChatItem (..)) +import Simplex.Chat.Messages.ChatItemContent import Simplex.Chat.Protocol import Simplex.Chat.Store (AutoAccept (..), StoreError (..), UserContactLink (..)) import Simplex.Chat.Styled diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 8359e72e33..b813569089 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -95,7 +95,8 @@ data TestCC = TestCC virtualTerminal :: VirtualTerminal, chatAsync :: Async (), termAsync :: Async (), - termQ :: TQueue String + termQ :: TQueue String, + printOutput :: Bool } aCfg :: AgentConfig @@ -149,7 +150,7 @@ startTestChat_ db cfg opts user = do atomically . unless (maintenance opts) $ readTVar (agentAsync cc) >>= \a -> when (isNothing a) retry termQ <- newTQueueIO termAsync <- async $ readTerminalOutput t termQ - pure TestCC {chatController = cc, virtualTerminal = t, chatAsync, termAsync, termQ} + pure TestCC {chatController = cc, virtualTerminal = t, chatAsync, termAsync, termQ, printOutput = False} stopTestChat :: TestCC -> IO () stopTestChat TestCC {chatController = cc, chatAsync, termAsync} = do @@ -192,6 +193,9 @@ withTestChatOpts tmp = withTestChatCfgOpts tmp testCfg withTestChatCfgOpts :: HasCallStack => FilePath -> ChatConfig -> ChatOpts -> String -> (HasCallStack => TestCC -> IO a) -> IO a withTestChatCfgOpts tmp cfg opts dbPrefix = bracket (startTestChat tmp cfg opts dbPrefix) (\cc -> cc / 100000 >> stopTestChat cc) +withTestOutput :: HasCallStack => TestCC -> (HasCallStack => TestCC -> IO a) -> IO a +withTestOutput cc runTest = runTest cc {printOutput = True} + readTerminalOutput :: VirtualTerminal -> TQueue String -> IO () readTerminalOutput t termQ = do let w = virtualWindow t @@ -239,14 +243,15 @@ getTermLine :: HasCallStack => TestCC -> IO String getTermLine cc = 5000000 `timeout` atomically (readTQueue $ termQ cc) >>= \case Just s -> do - -- uncomment 2 lines below to echo virtual terminal - -- name <- userName cc - -- putStrLn $ name <> ": " <> s + -- remove condition to always echo virtual terminal + when (printOutput cc) $ do + name <- userName cc + putStrLn $ name <> ": " <> s pure s _ -> error "no output for 5 seconds" userName :: TestCC -> IO [Char] -userName (TestCC ChatController {currentUser} _ _ _ _) = T.unpack . localDisplayName . fromJust <$> readTVarIO currentUser +userName (TestCC ChatController {currentUser} _ _ _ _ _) = T.unpack . localDisplayName . fromJust <$> readTVarIO currentUser testChat2 :: HasCallStack => Profile -> Profile -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO () testChat2 = testChatCfgOpts2 testCfg testOpts diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 17a3c23bcf..48b3fd9537 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -895,8 +895,8 @@ testMaintenanceModeWithFiles tmp = do testDatabaseEncryption :: HasCallStack => FilePath -> IO () testDatabaseEncryption tmp = do - withNewTestChat tmp "bob" bobProfile $ \bob -> do - withNewTestChatOpts tmp testOpts {maintenance = True} "alice" aliceProfile $ \alice -> do + withNewTestChat tmp "bob" bobProfile $ \b -> withTestOutput b $ \bob -> do + withNewTestChatOpts tmp testOpts {maintenance = True} "alice" aliceProfile $ \a -> withTestOutput a $ \alice -> do alice ##> "/_start" alice <## "chat started" connectUsers alice bob @@ -914,7 +914,7 @@ testDatabaseEncryption tmp = do alice <## "ok" alice ##> "/_start" alice <## "error: chat store changed, please restart chat" - withTestChatOpts tmp (getTestOpts True "mykey") "alice" $ \alice -> do + withTestChatOpts tmp (getTestOpts True "mykey") "alice" $ \a -> withTestOutput a $ \alice -> do alice ##> "/_start" alice <## "chat started" testChatWorking alice bob @@ -926,7 +926,7 @@ testDatabaseEncryption tmp = do alice <## "ok" alice ##> "/_db encryption {\"currentKey\":\"nextkey\",\"newKey\":\"anotherkey\"}" alice <## "ok" - withTestChatOpts tmp (getTestOpts True "anotherkey") "alice" $ \alice -> do + withTestChatOpts tmp (getTestOpts True "anotherkey") "alice" $ \a -> withTestOutput a $ \alice -> do alice ##> "/_start" alice <## "chat started" testChatWorking alice bob @@ -934,7 +934,8 @@ testDatabaseEncryption tmp = do alice <## "chat stopped" alice ##> "/db decrypt anotherkey" alice <## "ok" - withTestChat tmp "alice" $ \alice -> testChatWorking alice bob + withTestChat tmp "alice" $ \a -> withTestOutput a $ \alice -> do + testChatWorking alice bob testMuteContact :: HasCallStack => FilePath -> IO () testMuteContact = @@ -1315,13 +1316,13 @@ testUsersRestartCIExpiration tmp = do withNewTestChat tmp "bob" bobProfile $ \bob -> do withNewTestChatCfg tmp cfg "alice" aliceProfile $ \alice -> do -- set ttl for first user - alice #$> ("/_ttl 1 1", id, "ok") + alice #$> ("/_ttl 1 2", id, "ok") connectUsers alice bob -- create second user and set ttl alice ##> "/create user alisa" showActiveUser alice "alisa" - alice #$> ("/_ttl 2 3", id, "ok") + alice #$> ("/_ttl 2 5", id, "ok") connectUsers alice bob -- first user messages @@ -1353,7 +1354,7 @@ testUsersRestartCIExpiration tmp = do -- first user messages alice ##> "/user alice" showActiveUser alice "alice (Alice)" - alice #$> ("/ttl", id, "old messages are set to be deleted after: 1 second(s)") + alice #$> ("/ttl", id, "old messages are set to be deleted after: 2 second(s)") alice #> "@bob alice 3" bob <# "alice> alice 3" @@ -1365,7 +1366,7 @@ testUsersRestartCIExpiration tmp = do -- second user messages alice ##> "/user alisa" showActiveUser alice "alisa" - alice #$> ("/ttl", id, "old messages are set to be deleted after: 3 second(s)") + alice #$> ("/ttl", id, "old messages are set to be deleted after: 5 second(s)") alice #> "@bob alisa 3" bob <# "alisa> alisa 3" @@ -1374,7 +1375,7 @@ testUsersRestartCIExpiration tmp = do alice #$> ("/_get chat @4 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")]) - threadDelay 2000000 + threadDelay 3000000 -- messages both before and after restart are deleted -- first user messages @@ -1387,7 +1388,7 @@ testUsersRestartCIExpiration tmp = do showActiveUser alice "alisa" alice #$> ("/_get chat @4 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")]) - threadDelay 2000000 + threadDelay 3000000 alice #$> ("/_get chat @4 count=100", chat, []) where diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs index 862dcc5489..9ecf95a729 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -50,7 +50,7 @@ chatFileTests = do describe "async sending and receiving files" $ do -- fails on CI xit'' "send and receive file, sender restarts" testAsyncFileTransferSenderRestarts - it "send and receive file, receiver restarts" testAsyncFileTransferReceiverRestarts + xit'' "send and receive file, receiver restarts" testAsyncFileTransferReceiverRestarts xdescribe "send and receive file, fully asynchronous" $ do it "v2" testAsyncFileTransfer it "v1" testAsyncFileTransferV1 @@ -65,7 +65,7 @@ chatFileTests = do it "with changed XFTP config: send and receive file" testXFTPWithChangedConfig it "with relative paths: send and receive file" testXFTPWithRelativePaths xit' "continue receiving file after restart" testXFTPContinueRcv - it "receive file marked to receive on chat start" testXFTPMarkToReceive + xit' "receive file marked to receive on chat start" testXFTPMarkToReceive it "error receiving file" testXFTPRcvError it "cancel receiving file, repeat receive" testXFTPCancelRcvRepeat @@ -986,13 +986,17 @@ testXFTPFileTransfer = alice #> "/f @bob ./tests/fixtures/test.pdf" alice <## "use /fc 1 to cancel sending" + -- alice <## "started sending file 1 (test.pdf) to bob" -- TODO "started uploading" ? bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)" bob <## "use /fr 1 [