IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: delivery receipts (#2644)

Browse Source 
* core: delivery receipts

* update simplexmq

* preference, migration

* add activated state to receipts preference, update tests

* set receiveReceipts as activated on new profiles

* update simplexmq, fix tests

* update simplexmq, fix withAckMessage

* one more option

* more

* use tryChatError in ack message

* enable all tests

* rename pref

* update item status on delivery receipts

* show receipts for tests

* remove chat preference for delivery receipts

* add user, contact and group settings for delivery receipts

* only send delivery receipts if enabled for the contact or user profile (and not disabled for the contact)

* fix tests

* reuse event, test

* configure per contact - db, api, test

* rename commands

* update simplexmq

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
This commit is contained in:
Evgeny Poberezkin 2023-07-13 23:48:25 +01:00 committed by GitHub
parent 43ceb184c4
commit 0f4473d272
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
34 changed files with 510 additions and 132 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
apps/ios/Shared/ContentView.swift
View File

@ -136,6 +136,9 @@ struct ContentView: View {
.sheet(isPresented: $showWhatsNew) {
WhatsNewView()
}
if chatModel.setDeliveryReceipts {
SetDeliveryReceiptsView()
}
IncomingCallView()
}
.onContinueUserActivity("INStartCallIntent", perform: processUserActivity)

1
apps/ios/Shared/Model/ChatModel.swift
View File

@ -13,6 +13,7 @@ import SimpleXChat
final class ChatModel: ObservableObject {
@Published var onboardingStage: OnboardingStage?
@Published var setDeliveryReceipts = false
@Published var v3DBMigration: V3DBMigrationState = v3DBMigrationDefault.get()
@Published var currentUser: User?
@Published var users: [UserInfo] = []

4
apps/ios/Shared/Model/SimpleXAPI.swift
View File

@ -1091,6 +1091,7 @@ func initializeChat(start: Bool, dbKey: String? = nil, refreshInvitations: Bool
m.currentUser = try apiGetActiveUser()
if m.currentUser == nil {
onboardingStageDefault.set(.step1_SimpleXInfo)
privacyDeliveryReceiptsSet.set(true)
m.onboardingStage = .step1_SimpleXInfo
} else if start {
try startChat(refreshInvitations: refreshInvitations)
@ -1120,6 +1121,9 @@ func startChat(refreshInvitations: Bool = true) throws {
m.onboardingStage = [.step1_SimpleXInfo, .step2_CreateProfile].contains(savedOnboardingStage) && m.users.count == 1
? .step3_CreateSimpleXAddress
: savedOnboardingStage
if m.onboardingStage == .onboardingComplete && !privacyDeliveryReceiptsSet.get() {
m.setDeliveryReceipts = true
}
}
}
ChatReceiver.shared.start()

31
apps/ios/Shared/Views/Chat/ChatInfoView.swift
View File

@ -57,6 +57,22 @@ private func serverHost(_ s: String) -> String {
}
}
enum SendReceipts: Identifiable, Hashable {
case yes
case no
case userDefault(Bool)
var id: Self { self }
var text: LocalizedStringKey {
switch self {
case .yes: "yes"
case .no: "no"
case let .userDefault(on): on ? "default (yes)" : "default (no)"
}
}
}
struct ChatInfoView: View {
@EnvironmentObject var chatModel: ChatModel
@Environment(\.dismiss) var dismiss: DismissAction
@ -68,6 +84,7 @@ struct ChatInfoView: View {
@Binding var connectionCode: String?
@FocusState private var aliasTextFieldFocused: Bool
@State private var alert: ChatInfoViewAlert? = nil
@State private var sendReceipts = SendReceipts.yes
@AppStorage(DEFAULT_DEVELOPER_TOOLS) private var developerTools = false
enum ChatInfoViewAlert: Identifiable {
@ -117,6 +134,7 @@ struct ChatInfoView: View {
Section {
if let code = connectionCode { verifyCodeButton(code) }
contactPreferencesButton()
sendReceiptsOption()
if let connStats = connectionStats,
connStats.ratchetSyncAllowed {
synchronizeConnectionButton()
@ -153,7 +171,7 @@ struct ChatInfoView: View {
connStats.rcvQueuesInfo.contains { $0.rcvSwitchStatus != nil }
|| connStats.ratchetSyncSendProhibited
)
if connStats.rcvQueuesInfo.contains { $0.rcvSwitchStatus != nil } {
if connStats.rcvQueuesInfo.contains(where: { $0.rcvSwitchStatus != nil }) {
Button("Abort changing address") {
alert = .abortSwitchAddressAlert
}
@ -295,6 +313,17 @@ struct ChatInfoView: View {
}
}
private func sendReceiptsOption() -> some View {
Picker(selection: $sendReceipts) {
ForEach([.yes, .no, .userDefault(true)]) { (opt: SendReceipts) in
Text(opt.text)
}
} label: {
Label("Send receipts", systemImage: "checkmark.message")
}
.frame(height: 36)
}
private func synchronizeConnectionButton() -> some View {
Button {
syncContactConnection(force: false)

19
apps/ios/Shared/Views/UserSettings/PrivacySettings.swift
View File

@ -68,6 +68,25 @@ struct PrivacySettings: View {
Text("Opening the link in the browser may reduce connection privacy and security. Untrusted SimpleX links will be red.")
}
}
Section {
settingsRow("person") {
Toggle("Contacts", isOn: $useLinkPreviews)
}
settingsRow("person.2") {
Toggle("Small groups (max 10)", isOn: Binding.constant(false))
}
.foregroundColor(.secondary)
.disabled(true)
} header: {
Text("Send delivery receipts to")
} footer: {
VStack(alignment: .leading) {
Text("These settings are for your current profile **\(ChatModel.shared.currentUser?.displayName ?? "")**.")
Text("They can be overridden in contact and group settings")
}
.frame(maxWidth: .infinity, alignment: .leading)
}
}
}
}

63
apps/ios/Shared/Views/UserSettings/SetDeliveryReceiptsView.swift Normal file
View File

@ -0,0 +1,63 @@
//
// SetDeliveryReceiptsView.swift
// SimpleX (iOS)
//
// Created by Evgeny on 12/07/2023.
// Copyright © 2023 SimpleX Chat. All rights reserved.
//
import SwiftUI
struct SetDeliveryReceiptsView: View {
@EnvironmentObject var m: ChatModel
var body: some View {
VStack(spacing: 16) {
Text("Delivery receipts!")
.font(.title)
.foregroundColor(.secondary)
.padding(.vertical)
.multilineTextAlignment(.center)
Spacer()
Button("Enable") {
m.setDeliveryReceipts = false
}
.font(.largeTitle)
Group {
if m.users.count > 1 {
Text("Delivery receipts will be enabled for all contacts in all visible chat profiles.")
} else {
Text("Delivery receipts will be enabled for all contacts.")
}
}
.multilineTextAlignment(.center)
Spacer()
Button("Enable later via Settings") {
AlertManager.shared.showAlert(Alert(
title: Text("Delivery receipts are disabled!"),
message: Text("You can enable them later via app Privacy & Security settings."),
primaryButton: .default(Text("Don't show again")) {
m.setDeliveryReceipts = false
},
secondaryButton: .default(Text("Ok")) {
m.setDeliveryReceipts = false
}
))
}
}
.padding()
.padding(.horizontal)
.frame(maxWidth: .infinity, maxHeight: .infinity, alignment: .topLeading)
.background(Color(uiColor: .systemBackground))
}
}
struct SetDeliveryReceiptsView_Previews: PreviewProvider {
static var previews: some View {
SetDeliveryReceiptsView()
}
}

4
apps/ios/Shared/Views/UserSettings/SettingsView.swift
View File

@ -31,6 +31,7 @@ let DEFAULT_PRIVACY_ACCEPT_IMAGES = "privacyAcceptImages"
let DEFAULT_PRIVACY_LINK_PREVIEWS = "privacyLinkPreviews"
let DEFAULT_PRIVACY_SIMPLEX_LINK_MODE = "privacySimplexLinkMode"
let DEFAULT_PRIVACY_PROTECT_SCREEN = "privacyProtectScreen"
let DEFAULT_PRIVACY_DELIVERY_RECEIPTS_SET = "privacyDeliveryReceiptsSet"
let DEFAULT_EXPERIMENTAL_CALLS = "experimentalCalls"
let DEFAULT_CHAT_ARCHIVE_NAME = "chatArchiveName"
let DEFAULT_CHAT_ARCHIVE_TIME = "chatArchiveTime"
@ -65,6 +66,7 @@ let appDefaults: [String: Any] = [
DEFAULT_PRIVACY_LINK_PREVIEWS: true,
DEFAULT_PRIVACY_SIMPLEX_LINK_MODE: SimpleXLinkMode.description.rawValue,
DEFAULT_PRIVACY_PROTECT_SCREEN: false,
DEFAULT_PRIVACY_DELIVERY_RECEIPTS_SET: false,
DEFAULT_EXPERIMENTAL_CALLS: false,
DEFAULT_CHAT_V3_DB_MIGRATION: V3DBMigrationState.offer.rawValue,
DEFAULT_DEVELOPER_TOOLS: false,
@ -114,6 +116,8 @@ let privacySimplexLinkModeDefault = EnumDefault<SimpleXLinkMode>(defaults: UserD
let privacyLocalAuthModeDefault = EnumDefault<LAMode>(defaults: UserDefaults.standard, forKey: DEFAULT_LA_MODE, withDefault: .system)
let privacyDeliveryReceiptsSet = BoolDefault(defaults: UserDefaults.standard, forKey: DEFAULT_PRIVACY_DELIVERY_RECEIPTS_SET)
let onboardingStageDefault = EnumDefault<OnboardingStage>(defaults: UserDefaults.standard, forKey: DEFAULT_ONBOARDING_STAGE, withDefault: .onboardingComplete)
let customDisappearingMessageTimeDefault = IntDefault(defaults: UserDefaults.standard, forKey: DEFAULT_CUSTOM_DISAPPEARING_MESSAGE_TIME)

4
apps/ios/SimpleX.xcodeproj/project.pbxproj
View File

@ -142,6 +142,7 @@
5CEACCE327DE9246000BD591 /* ComposeView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CEACCE227DE9246000BD591 /* ComposeView.swift */; };
5CEACCED27DEA495000BD591 /* MsgContentView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CEACCEC27DEA495000BD591 /* MsgContentView.swift */; };
5CEBD7462A5C0A8F00665FE2 /* KeyboardPadding.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CEBD7452A5C0A8F00665FE2 /* KeyboardPadding.swift */; };
5CEBD7482A5F115D00665FE2 /* SetDeliveryReceiptsView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CEBD7472A5F115D00665FE2 /* SetDeliveryReceiptsView.swift */; };
5CFA59C42860BC6200863A68 /* MigrateToAppGroupView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CFA59C32860BC6200863A68 /* MigrateToAppGroupView.swift */; };
5CFA59D12864782E00863A68 /* ChatArchiveView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CFA59CF286477B400863A68 /* ChatArchiveView.swift */; };
5CFE0921282EEAF60002594B /* ZoomableScrollView.swift in Sources */ = {isa = PBXBuildFile; fileRef = 5CFE0920282EEAF60002594B /* ZoomableScrollView.swift */; };
@ -419,6 +420,7 @@
5CEACCE227DE9246000BD591 /* ComposeView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ComposeView.swift; sourceTree = "<group>"; };
5CEACCEC27DEA495000BD591 /* MsgContentView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = MsgContentView.swift; sourceTree = "<group>"; };
5CEBD7452A5C0A8F00665FE2 /* KeyboardPadding.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = KeyboardPadding.swift; sourceTree = "<group>"; };
5CEBD7472A5F115D00665FE2 /* SetDeliveryReceiptsView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = SetDeliveryReceiptsView.swift; sourceTree = "<group>"; };
5CFA59C32860BC6200863A68 /* MigrateToAppGroupView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = MigrateToAppGroupView.swift; sourceTree = "<group>"; };
5CFA59CF286477B400863A68 /* ChatArchiveView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; path = ChatArchiveView.swift; sourceTree = "<group>"; };
5CFE0920282EEAF60002594B /* ZoomableScrollView.swift */ = {isa = PBXFileReference; lastKnownFileType = sourcecode.swift; name = ZoomableScrollView.swift; path = Shared/Views/ZoomableScrollView.swift; sourceTree = SOURCE_ROOT; };
@ -744,6 +746,7 @@
5C65DAF829D0CC20003CEE45 /* DeveloperView.swift */,
64D0C2BF29F9688300B38D5F /* UserAddressView.swift */,
64D0C2C129FA57AB00B38D5F /* UserAddressLearnMore.swift */,
5CEBD7472A5F115D00665FE2 /* SetDeliveryReceiptsView.swift */,
);
path = UserSettings;
sourceTree = "<group>";
@ -1194,6 +1197,7 @@
5C9CC7A928C532AB00BEF955 /* DatabaseErrorView.swift in Sources */,
5C1A4C1E27A715B700EAD5AD /* ChatItemView.swift in Sources */,
64AA1C6927EE10C800AC7277 /* ContextItemView.swift in Sources */,
5CEBD7482A5F115D00665FE2 /* SetDeliveryReceiptsView.swift in Sources */,
5C9C2DA7289957AE00CC63B1 /* AdvancedNetworkSettings.swift in Sources */,
5CADE79A29211BB900072E13 /* PreferencesView.swift in Sources */,
644EFFE42937BE9700525D5B /* MarkedDeletedItemView.swift in Sources */,

2
cabal.project
View File

@ -7,7 +7,7 @@ constraints: zip +disable-bzip2 +disable-zstd
source-repository-package
type: git
location: https://github.com/simplex-chat/simplexmq.git
tag: 1afcefa5e7cf7c4a5e5732104105d14259be16b6
tag: 58cb2855d23ac970a619a61d088ed2a08dfb3d81
source-repository-package
type: git

2
scripts/nix/sha256map.nix
View File

@ -1,5 +1,5 @@
{
"https://github.com/simplex-chat/simplexmq.git"."1afcefa5e7cf7c4a5e5732104105d14259be16b6" = "0h017r0cjjc00d59wn3gs482dyjaqgapym370s36xhhvhn11n96x";
"https://github.com/simplex-chat/simplexmq.git"."58cb2855d23ac970a619a61d088ed2a08dfb3d81" = "053id418z9l0qciignvrl88kip6gmnfa36r7sl0avarqpach0fn1";
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
"https://github.com/kazu-yamamoto/http2.git"."b5a1b7200cf5bc7044af34ba325284271f6dff25" = "0dqb50j57an64nf4qcf5vcz4xkd1vzvghvf8bk529c1k30r9nfzb";
"https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";

1
simplex-chat.cabal
View File

@ -103,6 +103,7 @@ library
Simplex.Chat.Migrations.M20230608_deleted_contacts
Simplex.Chat.Migrations.M20230618_favorite_chats
Simplex.Chat.Migrations.M20230621_chat_item_moderations
Simplex.Chat.Migrations.M20230705_delivery_receipts
Simplex.Chat.Mobile
Simplex.Chat.Mobile.WebRTC
Simplex.Chat.Options

105
src/Simplex/Chat.hs
View File

@ -96,7 +96,6 @@ import Text.Read (readMaybe)
import UnliftIO.Async
import UnliftIO.Concurrent (forkFinally, forkIO, mkWeakThreadId, threadDelay)
import UnliftIO.Directory
import qualified UnliftIO.Exception as UE
import UnliftIO.IO (hClose, hSeek, hTell, openFile)
import UnliftIO.STM
@ -124,6 +123,7 @@ defaultChatConfig =
xftpFileConfig = Just defaultXFTPFileConfig,
tempDir = Nothing,
showReactions = False,
showReceipts = False,
logLevel = CLLImportant,
subscriptionEvents = False,
hostEvents = False,
@ -388,6 +388,13 @@ processChatCommand = \case
tryError (withStore (`getUserIdByName` uName)) >>= \case
Left _ -> throwChatError CEUserUnknown
Right userId -> processChatCommand $ APISetActiveUser userId viewPwd_
SetAllContactReceipts onOff -> withUser $ \_ -> withStore' (`updateAllContactReceipts` onOff) >> ok_
APISetUserContactReceipts userId' settings -> withUser $ \user -> do
user' <- privateGetUser userId'
validateUserPassword user user' Nothing
withStore' $ \db -> updateUserContactReceipts db user' settings
ok user
SetUserContactReceipts settings -> withUser $ \User {userId} -> processChatCommand $ APISetUserContactReceipts userId settings
APIHideUser userId' (UserPwd viewPwd) -> withUser $ \user -> do
user' <- privateGetUser userId'
case viewPwdHash user' of
@ -1192,18 +1199,8 @@ processChatCommand = \case
withStore' $ \db -> setConnectionAuthErrCounter db user conn 0
ok user
_ -> throwChatError CEGroupMemberNotActive
ShowMessages (ChatName cType name) ntfOn -> withUser $ \user -> do
(chatId, chatSettings) <- case cType of
CTDirect -> withStore $ \db -> do
ctId <- getContactIdByName db user name
Contact {chatSettings} <- getContact db user ctId
pure (ctId, chatSettings)
CTGroup -> withStore $ \db -> do
gId <- getGroupIdByName db user name
GroupInfo {chatSettings} <- getGroupInfo db user gId
pure (gId, chatSettings)
_ -> throwChatError $ CECommandError "not supported"
processChatCommand $ APISetChatSettings (ChatRef cType chatId) $ chatSettings {enableNtfs = ntfOn}
SetShowMessages cName ntfOn -> updateChatSettings cName (\cs -> cs {enableNtfs = ntfOn})
SetSendReceipts cName rcptsOn_ -> updateChatSettings cName (\cs -> cs {sendRcpts = rcptsOn_})
ContactInfo cName -> withContactName cName APIContactInfo
GroupMemberInfo gName mName -> withMemberName gName mName APIGroupMemberInfo
SwitchContact cName -> withContactName cName APISwitchContact
@ -1962,6 +1959,19 @@ processChatCommand = \case
withAgent $ \a -> deleteUser a (aUserId user) delSMPQueues
withStore' (`deleteUserRecord` user)
ok_
updateChatSettings :: ChatName -> (ChatSettings -> ChatSettings) -> m ChatResponse
updateChatSettings (ChatName cType name) updateSettings = withUser $ \user -> do
(chatId, chatSettings) <- case cType of
CTDirect -> withStore $ \db -> do
ctId <- getContactIdByName db user name
Contact {chatSettings} <- getContact db user ctId
pure (ctId, chatSettings)
CTGroup -> withStore $ \db -> do
gId <- getGroupIdByName db user name
GroupInfo {chatSettings} <- getGroupInfo db user gId
pure (gId, chatSettings)
_ -> throwChatError $ CECommandError "not supported"
processChatCommand $ APISetChatSettings (ChatRef cType chatId) $ updateSettings chatSettings
assertDirectAllowed :: ChatMonad m => User -> MsgDirection -> Contact -> CMEventTag e -> m ()
assertDirectAllowed user dir ct event =
@ -2744,8 +2754,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
saveConnInfo conn connInfo
MSG meta _msgFlags msgBody -> do
cmdId <- createAckCmd conn
withAckMessage agentConnId cmdId meta . void $
saveRcvMSG conn (ConnectionId connId) meta msgBody cmdId
withAckMessage agentConnId cmdId meta $
saveRcvMSG conn (ConnectionId connId) meta msgBody cmdId $> False
SENT msgId ->
sentMsgDeliveryEvent conn msgId
OK ->
@ -2801,6 +2811,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
XCallEnd callId -> xCallEnd ct callId msg msgMeta
BFileChunk sharedMsgId chunk -> bFileChunk ct sharedMsgId chunk msgMeta
_ -> messageError $ "unsupported message: " <> T.pack (show event)
let Contact {chatSettings = ChatSettings {sendRcpts}} = ct
pure $ fromMaybe (sendRcptsContacts user) sendRcpts && hasDeliveryReceipt (toCMEventTag event)
RCVD msgMeta msgRcpt ->
withAckMessage' agentConnId conn msgMeta $
directMsgReceived ct conn msgMeta msgRcpt
CONF confId _ connInfo -> do
-- confirming direct connection with a member
ChatMessage {chatMsgEvent} <- parseChatMessage conn connInfo
@ -3048,10 +3063,14 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
XGrpInfo p' -> xGrpInfo gInfo m p' msg msgMeta
BFileChunk sharedMsgId chunk -> bFileChunkGroup gInfo sharedMsgId chunk msgMeta
_ -> messageError $ "unsupported message: " <> T.pack (show event)
pure False -- no receipts in group now $ hasDeliveryReceipt $ toCMEventTag event
where
canSend a
| memberRole (m :: GroupMember) <= GRObserver = messageError "member is not allowed to send messages"
| otherwise = a
RCVD msgMeta msgRcpt ->
withAckMessage' agentConnId conn msgMeta $
groupMsgReceived gInfo m conn msgMeta msgRcpt
SENT msgId -> do
sentMsgDeliveryEvent conn msgId
checkSndInlineFTComplete conn msgId
@ -3156,9 +3175,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
getChatItemByFileId db user fileId
toView $ CRSndFileRcvCancelled user ci ft
_ -> throwChatError $ CEFileSend fileId err
MSG meta _ _ -> do
cmdId <- createAckCmd conn
withAckMessage agentConnId cmdId meta $ pure ()
MSG meta _ _ -> withAckMessage' agentConnId conn meta $ pure ()
OK ->
-- [async agent commands] continuation on receiving OK
withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
@ -3251,9 +3268,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo
where
ack a = case conn_ of
Just conn -> do
cmdId <- createAckCmd conn
withAckMessage agentConnId cmdId meta a
Just conn -> withAckMessage' agentConnId conn meta a
Nothing -> a
processUserContactRequest :: ACommand 'Agent e -> ConnectionEntity -> Connection -> UserContact -> m ()
@ -3336,10 +3351,25 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
createAckCmd Connection {connId} = do
withStore' $ \db -> createCommand db user (Just connId) CFAckMessage
withAckMessage :: ConnId -> CommandId -> MsgMeta -> m () -> m ()
withAckMessage' :: ConnId -> Connection -> MsgMeta -> m () -> m ()
withAckMessage' cId conn msgMeta action = do
cmdId <- createAckCmd conn
withAckMessage cId cmdId msgMeta $ action $> False
withAckMessage :: ConnId -> CommandId -> MsgMeta -> m Bool -> m ()
withAckMessage cId cmdId MsgMeta {recipient = (msgId, _)} action = do
-- [async agent commands] command should be asynchronous, continuation is ackMsgDeliveryEvent
action `chatFinally` withAgent (\a -> ackMessageAsync a (aCorrId cmdId) cId msgId)
-- TODO catching error and sending ACK after an error, particularly if it is a database error, will result in the message not processed (and no notification to the user).
-- Possible solutions are:
-- 1) retry processing several times
-- 2) stabilize database
-- 3) show screen of death to the user asking to restart
-- TODO send receipt depending on contact/group settings
tryChatError action >>= \case
Right withRcpt -> ack $ if withRcpt then Just "" else Nothing
Left e -> ack Nothing >> throwError e
where
ack rcpt = withAgent $ \a -> ackMessageAsync a (aCorrId cmdId) cId msgId rcpt
ackMsgDeliveryEvent :: Connection -> CommandId -> m ()
ackMsgDeliveryEvent Connection {connId} ackCmdId =
@ -4260,6 +4290,23 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
groupMsgToView g' m ci msgMeta
createGroupFeatureChangedItems user cd CIRcvGroupFeature g g'
directMsgReceived :: Contact -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m ()
directMsgReceived ct@Contact {contactId} Connection {connId} msgMeta msgRcpts = do
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} -> do
withStore $ \db -> createSndMsgDeliveryEvent db connId agentMsgId $ MDSSndRcvd msgRcptStatus
withStore' (\db -> getDirectChatItemByAgentMsgId db user contactId connId agentMsgId) >>= \case
Just (CChatItem SMDSnd ci) -> do
chatItem <- withStore $ \db -> updateDirectChatItemStatus db user contactId (chatItemId' ci) $ CISSndRcvd msgRcptStatus
toView $ CRChatItemStatusUpdated user (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem)
_ -> pure ()
groupMsgReceived :: GroupInfo -> GroupMember -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> m ()
groupMsgReceived gInfo m Connection {connId} msgMeta msgRcpts = do
checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta
forM_ msgRcpts $ \MsgReceipt {agentMsgId, msgRcptStatus} ->
withStore $ \db -> createSndMsgDeliveryEvent db connId agentMsgId $ MDSSndRcvd msgRcptStatus
parseFileDescription :: (ChatMonad m, FilePartyI p) => Text -> m (ValidFileDescription p)
parseFileDescription =
liftEither . first (ChatError . CEInvalidFileDescription) . (strDecode . encodeUtf8)
@ -4866,13 +4913,17 @@ withStoreCtx ctx_ action = do
chatCommandP :: Parser ChatCommand
chatCommandP =
choice
[ "/mute " *> ((`ShowMessages` False) <$> chatNameP),
"/unmute " *> ((`ShowMessages` True) <$> chatNameP),
[ "/mute " *> ((`SetShowMessages` False) <$> chatNameP),
"/unmute " *> ((`SetShowMessages` True) <$> chatNameP),
"/receipts " *> (SetSendReceipts <$> chatNameP <* " " <*> ((Just <$> onOffP) <|> ("default" $> Nothing))),
"/_create user " *> (CreateActiveUser <$> jsonP),
"/create user " *> (CreateActiveUser <$> newUserP),
"/users" $> ListUsers,
"/_user " *> (APISetActiveUser <$> A.decimal <*> optional (A.space *> jsonP)),
("/user " <|> "/u ") *> (SetActiveUser <$> displayName <*> optional (A.space *> pwdP)),
"/set receipts all " *> (SetAllContactReceipts <$> onOffP),
"/_set receipts " *> (APISetUserContactReceipts <$> A.decimal <* A.space <*> receiptSettings),
"/set receipts " *> (SetUserContactReceipts <$> receiptSettings),
"/_hide user " *> (APIHideUser <$> A.decimal <* A.space <*> jsonP),
"/_unhide user " *> (APIUnhideUser <$> A.decimal <* A.space <*> jsonP),
"/_mute user " *> (APIMuteUser <$> A.decimal),
@ -5126,6 +5177,10 @@ chatCommandP =
refChar c = c > ' ' && c /= '#' && c /= '@'
liveMessageP = " live=" *> onOffP <|> pure False
sendMessageTTLP = " ttl=" *> ((Just <$> A.decimal) <|> ("default" $> Nothing)) <|> pure Nothing
receiptSettings = do
enable <- onOffP
clearOverrides <- (" clear_overrides=" *> onOffP) <|> pure False
pure UserMsgReceiptSettings {enable, clearOverrides}
onOffP = ("on" $> True) <|> ("off" $> False)
profileNames = (,) <$> displayName <*> fullNameP
newUserP = do

15
src/Simplex/Chat/Controller.hs
View File

@ -45,7 +45,7 @@ import Simplex.Chat.Markdown (MarkdownList)
import Simplex.Chat.Messages
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Protocol
import Simplex.Chat.Store (AutoAccept, StoreError, UserContactLink)
import Simplex.Chat.Store (AutoAccept, StoreError, UserContactLink, UserMsgReceiptSettings)
import Simplex.Chat.Types
import Simplex.Messaging.Agent (AgentClient)
import Simplex.Messaging.Agent.Client (AgentLocks, ProtocolTestFailure)
@ -61,7 +61,7 @@ import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType, CorrId,
import Simplex.Messaging.TMap (TMap)
import Simplex.Messaging.Transport (simplexMQVersion)
import Simplex.Messaging.Transport.Client (TransportHost)
import Simplex.Messaging.Util (catchAllErrors, allFinally)
import Simplex.Messaging.Util (allFinally, catchAllErrors, tryAllErrors)
import System.IO (Handle)
import System.Mem.Weak (Weak)
import UnliftIO.STM
@ -109,6 +109,7 @@ data ChatConfig = ChatConfig
xftpFileConfig :: Maybe XFTPFileConfig, -- Nothing - XFTP is disabled
tempDir :: Maybe FilePath,
showReactions :: Bool,
showReceipts :: Bool,
subscriptionEvents :: Bool,
hostEvents :: Bool,
logLevel :: ChatLogLevel,
@ -198,6 +199,9 @@ data ChatCommand
| ListUsers
| APISetActiveUser UserId (Maybe UserPwd)
| SetActiveUser UserName (Maybe UserPwd)
| SetAllContactReceipts Bool
| APISetUserContactReceipts UserId UserMsgReceiptSettings
| SetUserContactReceipts UserMsgReceiptSettings
| APIHideUser UserId UserPwd
| APIUnhideUser UserId UserPwd
| APIMuteUser UserId
@ -297,7 +301,8 @@ data ChatCommand
| APIVerifyGroupMember GroupId GroupMemberId (Maybe Text)
| APIEnableContact ContactId
| APIEnableGroupMember GroupId GroupMemberId
| ShowMessages ChatName Bool
| SetShowMessages ChatName Bool
| SetSendReceipts ChatName (Maybe Bool)
| ContactInfo ContactName
| GroupMemberInfo GroupName ContactName
| SwitchContact ContactName
@ -902,6 +907,10 @@ type ChatMonad' m = (MonadUnliftIO m, MonadReader ChatController m)
type ChatMonad m = (ChatMonad' m, MonadError ChatError m)
tryChatError :: ChatMonad m => m a -> m (Either ChatError a)
tryChatError = tryAllErrors mkChatError
{-# INLINE tryChatError #-}
catchChatError :: ChatMonad m => m a -> (ChatError -> m a) -> m a
catchChatError = catchAllErrors mkChatError
{-# INLINE catchChatError #-}

36
src/Simplex/Chat/Messages.hs
View File

@ -35,9 +35,9 @@ import Simplex.Chat.Markdown
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Protocol
import Simplex.Chat.Types
import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgMeta (..))
import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgMeta (..), MsgReceiptStatus (..))
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, sumTypeJSON)
import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, parseAll, sumTypeJSON)
import Simplex.Messaging.Protocol (MsgBody)
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
@ -624,6 +624,7 @@ data CIFileInfo = CIFileInfo
data CIStatus (d :: MsgDirection) where
CISSndNew :: CIStatus 'MDSnd
CISSndSent :: CIStatus 'MDSnd
CISSndRcvd :: MsgReceiptStatus -> CIStatus 'MDSnd
CISSndErrorAuth :: CIStatus 'MDSnd
CISSndError :: String -> CIStatus 'MDSnd
CISRcvNew :: CIStatus 'MDRcv
@ -647,6 +648,7 @@ instance MsgDirectionI d => StrEncoding (CIStatus d) where
strEncode = \case
CISSndNew -> "snd_new"
CISSndSent -> "snd_sent"
CISSndRcvd status -> "snd_rcvd " <> strEncode status
CISSndErrorAuth -> "snd_error_auth"
CISSndError e -> "snd_error " <> encodeUtf8 (T.pack e)
CISRcvNew -> "rcv_new"
@ -659,6 +661,7 @@ instance StrEncoding ACIStatus where
A.takeTill (== ' ') >>= \case
"snd_new" -> pure $ ACIStatus SMDSnd CISSndNew
"snd_sent" -> pure $ ACIStatus SMDSnd CISSndSent
"snd_rcvd" -> ACIStatus SMDSnd . CISSndRcvd <$> (A.space *> strP)
"snd_error_auth" -> pure $ ACIStatus SMDSnd CISSndErrorAuth
"snd_error" -> ACIStatus SMDSnd . CISSndError . T.unpack . safeDecodeUtf8 <$> (A.space *> A.takeByteString)
"rcv_new" -> pure $ ACIStatus SMDRcv CISRcvNew
@ -668,6 +671,7 @@ instance StrEncoding ACIStatus where
data JSONCIStatus
= JCISSndNew
| JCISSndSent
| JCISSndRcvd {msgRcptStatus :: MsgReceiptStatus}
| JCISSndErrorAuth
| JCISSndError {agentError :: String}
| JCISRcvNew
@ -682,6 +686,7 @@ jsonCIStatus :: CIStatus d -> JSONCIStatus
jsonCIStatus = \case
CISSndNew -> JCISSndNew
CISSndSent -> JCISSndSent
CISSndRcvd ok -> JCISSndRcvd ok
CISSndErrorAuth -> JCISSndErrorAuth
CISSndError e -> JCISSndError e
CISRcvNew -> JCISRcvNew
@ -805,7 +810,7 @@ data MsgDeliveryStatus (d :: MsgDirection) where
MDSSndPending :: MsgDeliveryStatus 'MDSnd
MDSSndAgent :: MsgDeliveryStatus 'MDSnd
MDSSndSent :: MsgDeliveryStatus 'MDSnd
MDSSndReceived :: MsgDeliveryStatus 'MDSnd
MDSSndRcvd :: MsgReceiptStatus -> MsgDeliveryStatus 'MDSnd
MDSSndRead :: MsgDeliveryStatus 'MDSnd
data AMsgDeliveryStatus = forall d. AMDS (SMsgDirection d) (MsgDeliveryStatus d)
@ -822,20 +827,23 @@ serializeMsgDeliveryStatus = \case
MDSSndPending -> "snd_pending"
MDSSndAgent -> "snd_agent"
MDSSndSent -> "snd_sent"
MDSSndReceived -> "snd_received"
MDSSndRcvd status -> "snd_rcvd " <> safeDecodeUtf8 (strEncode status)
MDSSndRead -> "snd_read"
msgDeliveryStatusT :: Text -> Maybe AMsgDeliveryStatus
msgDeliveryStatusT = \case
"rcv_agent" -> Just $ AMDS SMDRcv MDSRcvAgent
"rcv_acknowledged" -> Just $ AMDS SMDRcv MDSRcvAcknowledged
"snd_pending" -> Just $ AMDS SMDSnd MDSSndPending
"snd_agent" -> Just $ AMDS SMDSnd MDSSndAgent
"snd_sent" -> Just $ AMDS SMDSnd MDSSndSent
"snd_received" -> Just $ AMDS SMDSnd MDSSndReceived
"snd_read" -> Just $ AMDS SMDSnd MDSSndRead
_ -> Nothing
msgDeliveryStatusT = eitherToMaybe . parseAll statusP . encodeUtf8
where
statusP =
A.takeTill (== ' ') >>= \case
"rcv_agent" -> pure $ AMDS SMDRcv MDSRcvAgent
"rcv_acknowledged" -> pure $ AMDS SMDRcv MDSRcvAcknowledged
"snd_pending" -> pure $ AMDS SMDSnd MDSSndPending
"snd_agent" -> pure $ AMDS SMDSnd MDSSndAgent
"snd_sent" -> pure $ AMDS SMDSnd MDSSndSent
"snd_rcvd" -> AMDS SMDSnd . MDSSndRcvd <$> (A.space *> strP)
"snd_read" -> pure $ AMDS SMDSnd MDSSndRead
_ -> fail "bad AMsgDeliveryStatus"
msgDeliveryStatusT' :: forall d. MsgDirectionI d => Text -> Maybe (MsgDeliveryStatus d)
msgDeliveryStatusT' s =
msgDeliveryStatusT s >>= \(AMDS d st) ->

24
src/Simplex/Chat/Migrations/M20230705_delivery_receipts.hs Normal file
View File

@ -0,0 +1,24 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230705_delivery_receipts where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20230705_delivery_receipts :: Query
m20230705_delivery_receipts =
[sql|
ALTER TABLE users ADD COLUMN send_rcpts_contacts INTEGER NOT NULL DEFAULT 0;
ALTER TABLE users ADD COLUMN send_rcpts_small_groups INTEGER NOT NULL DEFAULT 0;
ALTER TABLE contacts ADD COLUMN send_rcpts INTEGER;
ALTER TABLE groups ADD COLUMN send_rcpts INTEGER;
|]
down_m20230705_delivery_receipts :: Query
down_m20230705_delivery_receipts =
[sql|
ALTER TABLE users DROP COLUMN send_rcpts_contacts;
ALTER TABLE users DROP COLUMN send_rcpts_small_groups;
ALTER TABLE contacts DROP COLUMN send_rcpts;
ALTER TABLE groups DROP COLUMN send_rcpts;
|]

8
src/Simplex/Chat/Migrations/chat_schema.sql
View File

@ -31,7 +31,9 @@ CREATE TABLE users(
agent_user_id INTEGER CHECK(agent_user_id NOT NULL),
view_pwd_hash BLOB,
view_pwd_salt BLOB,
show_ntfs INTEGER NOT NULL DEFAULT 1, -- 1 for active user
show_ntfs INTEGER NOT NULL DEFAULT 1,
send_rcpts_contacts INTEGER NOT NULL DEFAULT 0,
send_rcpts_small_groups INTEGER NOT NULL DEFAULT 0, -- 1 for active user
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE
@ -65,6 +67,7 @@ CREATE TABLE contacts(
chat_ts TEXT,
deleted INTEGER NOT NULL DEFAULT 0,
favorite INTEGER NOT NULL DEFAULT 0,
send_rcpts INTEGER,
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE
@ -137,7 +140,8 @@ CREATE TABLE groups(
host_conn_custom_user_profile_id INTEGER REFERENCES contact_profiles ON DELETE SET NULL,
unread_chat INTEGER DEFAULT 0 CHECK(unread_chat NOT NULL),
chat_ts TEXT,
favorite INTEGER NOT NULL DEFAULT 0, -- received
favorite INTEGER NOT NULL DEFAULT 0,
send_rcpts INTEGER, -- received
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE

7
src/Simplex/Chat/Protocol.hs
View File

@ -712,6 +712,13 @@ hasNotification = \case
XCallInv_ -> True
_ -> False
hasDeliveryReceipt :: CMEventTag e -> Bool
hasDeliveryReceipt = \case
XMsgNew_ -> True
XGrpInv_ -> True
XCallInv_ -> True
_ -> False
appBinaryToCM :: AppMessageBinary -> Either String (ChatMessage 'Binary)
appBinaryToCM AppMessageBinary {msgId, tag, body} = do
eventTag <- strDecode $ B.singleton tag

1
src/Simplex/Chat/Store.hs
View File

@ -1,6 +1,7 @@
module Simplex.Chat.Store
( SQLiteStore,
StoreError (..),
UserMsgReceiptSettings (..),
UserContactLink (..),
AutoAccept (..),
createChatStore,

10
src/Simplex/Chat/Store/Connections.hs
View File

@ -60,17 +60,17 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
db
[sql|
SELECT
c.contact_profile_id, c.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, c.via_group, c.contact_used, c.enable_ntfs, c.favorite,
c.contact_profile_id, c.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, c.via_group, c.contact_used, c.enable_ntfs, c.send_rcpts, c.favorite,
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts
FROM contacts c
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
WHERE c.user_id = ? AND c.contact_id = ? AND c.deleted = 0
|]
(userId, contactId)
toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool, Maybe Bool, Bool) :. (Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime)] -> Either StoreError Contact
toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed, enableNtfs_, favorite) :. (preferences, userPreferences, createdAt, updatedAt, chatTs)] =
toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime)] -> Either StoreError Contact
toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs)] =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, favorite}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs}
toContact' _ _ _ = Left $ SEInternalError "referenced contact not found"
@ -82,7 +82,7 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
[sql|
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,

11
src/Simplex/Chat/Store/Direct.hs
View File

@ -12,6 +12,7 @@ module Simplex.Chat.Store.Direct
updateContactProfile_,
updateContactProfile_',
deleteContactProfile_,
-- * Contacts and connections functions
getPendingContactConnection,
deletePendingContactConnection,
@ -134,7 +135,7 @@ getConnReqContactXContactId db user@User {userId} cReqHash = do
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.favorite,
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
@ -421,7 +422,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId Profi
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.favorite,
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
@ -566,7 +567,7 @@ getContact_ db user@User {userId} contactId deleted =
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.favorite,
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
@ -670,8 +671,8 @@ updateConnectionStatus db Connection {connId} connStatus = do
DB.execute db "UPDATE connections SET conn_status = ?, updated_at = ? WHERE connection_id = ?" (connStatus, currentTs, connId)
updateContactSettings :: DB.Connection -> User -> Int64 -> ChatSettings -> IO ()
updateContactSettings db User {userId} contactId ChatSettings {enableNtfs, favorite} =
DB.execute db "UPDATE contacts SET enable_ntfs = ?, favorite = ? WHERE user_id = ? AND contact_id = ?" (enableNtfs, favorite, userId, contactId)
updateContactSettings db User {userId} contactId ChatSettings {enableNtfs, sendRcpts, favorite} =
DB.execute db "UPDATE contacts SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND contact_id = ?" (enableNtfs, sendRcpts, favorite, userId, contactId)
setConnConnReqInv :: DB.Connection -> User -> Int64 -> ConnReqInvitation -> IO ()
setConnConnReqInv db User {userId} connId connReq = do

32
src/Simplex/Chat/Store/Groups.hs
View File

@ -103,16 +103,16 @@ import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Util (eitherToMaybe)
import UnliftIO.STM
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime) :. GroupMemberRow
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe Bool, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime) :. GroupMemberRow
type GroupMemberRow = ((Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus) :. (Maybe Int64, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus) :. (Maybe Int64, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
toGroupInfo :: Int64 -> GroupInfoRow -> GroupInfo
toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs) :. userMemberRow) =
toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs) :. userMemberRow) =
let membership = toGroupMember userContactId userMemberRow
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, favorite}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
fullGroupPreferences = mergeGroupPreferences groupPreferences
groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences}
in GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs}
@ -218,7 +218,7 @@ getGroupAndMember db User {userId, userContactId} groupMemberId =
[sql|
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
@ -270,7 +270,7 @@ createNewGroup db gVar user@User {userId} groupProfile = ExceptT $ do
insertedRowId db
memberId <- liftIO $ encodedRandomBytes gVar 12
membership <- createContactMemberInv_ db user groupId user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser Nothing currentTs
let chatSettings = ChatSettings {enableNtfs = True, favorite = False}
let chatSettings = ChatSettings {enableNtfs = True, sendRcpts = Nothing, favorite = False}
pure GroupInfo {groupId, localDisplayName = ldn, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = Nothing, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs}
-- | creates a new group record for the group the current user was invited to, or returns an existing one
@ -315,7 +315,7 @@ createGroupInvitation db user@User {userId} contact@Contact {contactId, activeCo
insertedRowId db
GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs
membership <- createContactMemberInv_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs
let chatSettings = ChatSettings {enableNtfs = True, favorite = False}
let chatSettings = ChatSettings {enableNtfs = True, sendRcpts = Nothing, favorite = False}
pure (GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = customUserProfileId, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs}, groupMemberId)
getHostMemberId_ :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO GroupMemberId
@ -452,7 +452,7 @@ getUserGroupDetails db User {userId, userContactId} =
<$> DB.query
db
[sql|
SELECT g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
SELECT g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
mu.group_member_id, g.group_id, mu.member_id, mu.member_role, mu.member_category, mu.member_status,
mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
FROM groups g
@ -633,7 +633,7 @@ getContactViaMember db user@User {userId} GroupMember {groupMemberId} =
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.favorite,
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
@ -932,7 +932,7 @@ getViaGroupMember db User {userId, userContactId} Contact {contactId} =
[sql|
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
@ -972,7 +972,7 @@ getViaGroupContact db user@User {userId} GroupMember {groupMemberId} =
db
[sql|
SELECT
ct.contact_id, ct.contact_profile_id, ct.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, ct.via_group, ct.contact_used, ct.enable_ntfs, ct.favorite,
ct.contact_id, ct.contact_profile_id, ct.local_display_name, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, ct.via_group, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
p.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter
@ -989,10 +989,10 @@ getViaGroupContact db user@User {userId} GroupMember {groupMemberId} =
|]
(userId, groupMemberId)
where
toContact' :: ((ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool, Maybe Bool, Bool) :. (Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime)) :. ConnectionRow -> Contact
toContact' (((contactId, profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed, enableNtfs_, favorite) :. (preferences, userPreferences, createdAt, updatedAt, chatTs)) :. connRow) =
toContact' :: ((ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime)) :. ConnectionRow -> Contact
toContact' (((contactId, profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, favorite}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
activeConn = toConnection connRow
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs}
@ -1039,7 +1039,7 @@ getGroupInfo db User {userId, userContactId} groupId =
[sql|
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
-- GroupMember - membership
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
@ -1229,8 +1229,8 @@ mergeContactRecords db userId ct1 ct2 = do
ctCreatedAt Contact {createdAt} = createdAt
updateGroupSettings :: DB.Connection -> User -> Int64 -> ChatSettings -> IO ()
updateGroupSettings db User {userId} groupId ChatSettings {enableNtfs, favorite} =
DB.execute db "UPDATE groups SET enable_ntfs = ?, favorite = ? WHERE user_id = ? AND group_id = ?" (enableNtfs, favorite, userId, groupId)
updateGroupSettings db User {userId} groupId ChatSettings {enableNtfs, sendRcpts, favorite} =
DB.execute db "UPDATE groups SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND group_id = ?" (enableNtfs, sendRcpts, favorite, userId, groupId)
getXGrpMemIntroContDirect :: DB.Connection -> User -> Contact -> IO (Maybe (Int64, XGrpMemIntroCont))
getXGrpMemIntroContDirect db User {userId} Contact {contactId} = do

4
src/Simplex/Chat/Store/Messages.hs
View File

@ -466,7 +466,7 @@ getDirectChatPreviews_ db user@User {userId} = do
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.favorite,
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
@ -531,7 +531,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
[sql|
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences, g.created_at, g.updated_at, g.chat_ts,
-- GroupMember - membership
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,

4
src/Simplex/Chat/Store/Migrations.hs
View File

@ -73,6 +73,7 @@ import Simplex.Chat.Migrations.M20230529_indexes
import Simplex.Chat.Migrations.M20230608_deleted_contacts
import Simplex.Chat.Migrations.M20230618_favorite_chats
import Simplex.Chat.Migrations.M20230621_chat_item_moderations
import Simplex.Chat.Migrations.M20230705_delivery_receipts
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@ -145,7 +146,8 @@ schemaMigrations =
("20230529_indexes", m20230529_indexes, Just down_m20230529_indexes),
("20230608_deleted_contacts", m20230608_deleted_contacts, Just down_m20230608_deleted_contacts),
("20230618_favorite_chats", m20230618_favorite_chats, Just down_m20230618_favorite_chats),
("20230621_chat_item_moderations", m20230621_chat_item_moderations, Just down_m20230621_chat_item_moderations)
("20230621_chat_item_moderations", m20230621_chat_item_moderations, Just down_m20230621_chat_item_moderations),
("20230705_delivery_receipts", m20230705_delivery_receipts, Just down_m20230705_delivery_receipts)
]
-- | The list of migrations in ascending order by date

27
src/Simplex/Chat/Store/Profiles.hs
View File

@ -9,6 +9,7 @@
module Simplex.Chat.Store.Profiles
( AutoAccept (..),
UserMsgReceiptSettings (..),
UserContactLink (..),
createUserRecord,
createUserRecordAt,
@ -27,6 +28,8 @@ module Simplex.Chat.Store.Profiles
getUserFileInfo,
deleteUserRecord,
updateUserPrivacy,
updateAllContactReceipts,
updateUserContactReceipts,
updateUserProfile,
setUserProfileContactLink,
getUserContactProfiles,
@ -86,10 +89,13 @@ createUserRecordAt :: DB.Connection -> AgentUserId -> Profile -> Bool -> UTCTime
createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image, preferences = userPreferences} activeUser currentTs =
checkConstraint SEDuplicateName . liftIO $ do
when activeUser $ DB.execute_ db "UPDATE users SET active_user = 0"
let showNtfs = True
sendRcptsContacts = True
sendRcptsSmallGroups = False
DB.execute
db
"INSERT INTO users (agent_user_id, local_display_name, active_user, contact_id, show_ntfs, created_at, updated_at) VALUES (?,?,?,0,?,?,?)"
(auId, displayName, activeUser, True, currentTs, currentTs)
"INSERT INTO users (agent_user_id, local_display_name, active_user, contact_id, show_ntfs, send_rcpts_contacts, send_rcpts_small_groups, created_at, updated_at) VALUES (?,?,?,0,?,?,?,?,?)"
(auId, displayName, activeUser, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, currentTs, currentTs)
userId <- insertedRowId db
DB.execute
db
@ -106,7 +112,7 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image,
(profileId, displayName, userId, True, currentTs, currentTs)
contactId <- insertedRowId db
DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId)
pure $ toUser $ (userId, auId, contactId, profileId, activeUser, displayName, fullName, image, Nothing, userPreferences, True) :. (Nothing, Nothing)
pure $ toUser $ (userId, auId, contactId, profileId, activeUser, displayName, fullName, image, Nothing, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, Nothing, Nothing)
getUsersInfo :: DB.Connection -> IO [UserInfo]
getUsersInfo db = getUsers db >>= mapM getUserInfo
@ -213,6 +219,15 @@ updateUserPrivacy db User {userId, showNtfs, viewPwdHash} =
where
hashSalt = L.unzip . fmap (\UserPwdHash {hash, salt} -> (hash, salt))
updateAllContactReceipts :: DB.Connection -> Bool -> IO ()
updateAllContactReceipts db onOff =
DB.execute db "UPDATE users SET send_rcpts_contacts = ? WHERE view_pwd_hash IS NULL" (Only onOff)
updateUserContactReceipts :: DB.Connection -> User -> UserMsgReceiptSettings -> IO ()
updateUserContactReceipts db User {userId} UserMsgReceiptSettings {enable, clearOverrides} = do
DB.execute db "UPDATE users SET send_rcpts_contacts = ? WHERE user_id = ?" (enable, userId)
when clearOverrides $ DB.execute_ db "UPDATE contacts SET send_rcpts = NULL"
updateUserProfile :: DB.Connection -> User -> Profile -> ExceptT StoreError IO User
updateUserProfile db user p'
| displayName == newName = do
@ -357,6 +372,12 @@ deleteUserAddress db user@User {userId} = do
void $ setUserProfileContactLink db user Nothing
DB.execute db "DELETE FROM user_contact_links WHERE user_id = ? AND local_display_name = '' AND group_id IS NULL" (Only userId)
data UserMsgReceiptSettings = UserMsgReceiptSettings
{ enable :: Bool,
clearOverrides :: Bool
}
deriving (Show)
data UserContactLink = UserContactLink
{ connReqContact :: ConnReqContact,
autoAccept :: Maybe AutoAccept

19
src/Simplex/Chat/Store/Shared.hs
View File

@ -218,20 +218,20 @@ deleteUnusedIncognitoProfileById_ db User {userId} profile_id =
|]
[":user_id" := userId, ":profile_id" := profile_id]
type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool, Maybe Bool, Bool) :. (Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime)
type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool) :. (Maybe Bool, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime)
toContact :: User -> ContactRow :. ConnectionRow -> Contact
toContact user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, enableNtfs_, favorite) :. (preferences, userPreferences, createdAt, updatedAt, chatTs)) :. connRow) =
toContact user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
activeConn = toConnection connRow
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, favorite}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs}
toContactOrError :: User -> ContactRow :. MaybeConnectionRow -> Either StoreError Contact
toContactOrError user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, enableNtfs_, favorite) :. (preferences, userPreferences, createdAt, updatedAt, chatTs)) :. connRow) =
toContactOrError user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, favorite}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_, sendRcpts, favorite}
in case toMaybeConnection connRow of
Just activeConn ->
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
@ -263,15 +263,16 @@ toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, userCo
userQuery :: Query
userQuery =
[sql|
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.local_display_name, ucp.full_name, ucp.image, ucp.contact_link, ucp.preferences, u.show_ntfs, u.view_pwd_hash, u.view_pwd_salt
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.local_display_name, ucp.full_name, ucp.image, ucp.contact_link, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt
FROM users u
JOIN contacts uct ON uct.contact_id = u.contact_id
JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
|]
toUser :: (UserId, UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences, Bool) :. (Maybe B64UrlByteString, Maybe B64UrlByteString) -> User
toUser ((userId, auId, userContactId, profileId, activeUser, displayName, fullName, image, contactLink, userPreferences, showNtfs) :. (viewPwdHash_, viewPwdSalt_)) =
User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, fullPreferences, showNtfs, viewPwdHash}
toUser :: (UserId, UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences) :. (Bool, Bool, Bool, Maybe B64UrlByteString, Maybe B64UrlByteString) -> User
toUser ((userId, auId, userContactId, profileId, activeUser, displayName, fullName, image, contactLink, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash_, viewPwdSalt_)) =
User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash}
where
profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences = userPreferences, localAlias = ""}
fullPreferences = mergePreferences Nothing userPreferences

32
src/Simplex/Chat/Types.hs
View File

@ -112,7 +112,9 @@ data User = User
fullPreferences :: FullPreferences,
activeUser :: Bool,
viewPwdHash :: Maybe UserPwdHash,
showNtfs :: Bool
showNtfs :: Bool,
sendRcptsContacts :: Bool,
sendRcptsSmallGroups :: Bool
}
deriving (Show, Generic, FromJSON)
@ -334,6 +336,7 @@ contactAndGroupIds = \case
-- TODO when more settings are added we should create another type to allow partial setting updates (with all Maybe properties)
data ChatSettings = ChatSettings
{ enableNtfs :: Bool,
sendRcpts :: Maybe Bool,
favorite :: Bool
}
deriving (Eq, Show, Generic, FromJSON)
@ -343,6 +346,7 @@ instance ToJSON ChatSettings where toEncoding = J.genericToEncoding J.defaultOpt
defaultChatSettings :: ChatSettings
defaultChatSettings = ChatSettings
{ enableNtfs = True,
sendRcpts = Nothing,
favorite = False
}
@ -352,8 +356,7 @@ pattern DisableNtfs <- ChatSettings {enableNtfs = False}
data ChatFeature
= CFTimedMessages
| CFFullDelete
| -- | CFReceipts
CFReactions
| CFReactions
| CFVoice
| CFCalls
deriving (Show, Generic)
@ -398,7 +401,6 @@ allChatFeatures :: [AChatFeature]
allChatFeatures =
[ ACF SCFTimedMessages,
ACF SCFFullDelete,
-- ACF SCFReceipts,
ACF SCFReactions,
ACF SCFVoice,
ACF SCFCalls
@ -408,7 +410,6 @@ chatPrefSel :: SChatFeature f -> Preferences -> Maybe (FeaturePreference f)
chatPrefSel = \case
SCFTimedMessages -> timedMessages
SCFFullDelete -> fullDelete
-- SCFReceipts -> receipts
SCFReactions -> reactions
SCFVoice -> voice
SCFCalls -> calls
@ -434,7 +435,6 @@ instance PreferenceI FullPreferences where
getPreference = \case
SCFTimedMessages -> timedMessages
SCFFullDelete -> fullDelete
-- CFReceipts -> receipts
SCFReactions -> reactions
SCFVoice -> voice
SCFCalls -> calls
@ -464,7 +464,6 @@ setPreference_ f pref_ prefs =
data Preferences = Preferences
{ timedMessages :: Maybe TimedMessagesPreference,
fullDelete :: Maybe FullDeletePreference,
-- receipts :: Maybe SimplePreference,
reactions :: Maybe ReactionsPreference,
voice :: Maybe VoicePreference,
calls :: Maybe CallsPreference
@ -485,8 +484,7 @@ data GroupFeature
= GFTimedMessages
| GFDirectMessages
| GFFullDelete
| -- | GFReceipts
GFReactions
| GFReactions
| GFVoice
| GFFiles
deriving (Show, Generic)
@ -495,7 +493,6 @@ data SGroupFeature (f :: GroupFeature) where
SGFTimedMessages :: SGroupFeature 'GFTimedMessages
SGFDirectMessages :: SGroupFeature 'GFDirectMessages
SGFFullDelete :: SGroupFeature 'GFFullDelete
-- SGFReceipts :: SGroupFeature 'GFReceipts
SGFReactions :: SGroupFeature 'GFReactions
SGFVoice :: SGroupFeature 'GFVoice
SGFFiles :: SGroupFeature 'GFFiles
@ -537,7 +534,6 @@ allGroupFeatures =
[ AGF SGFTimedMessages,
AGF SGFDirectMessages,
AGF SGFFullDelete,
-- GFReceipts,
AGF SGFReactions,
AGF SGFVoice,
AGF SGFFiles
@ -548,7 +544,6 @@ groupPrefSel = \case
SGFTimedMessages -> timedMessages
SGFDirectMessages -> directMessages
SGFFullDelete -> fullDelete
-- GFReceipts -> receipts
SGFReactions -> reactions
SGFVoice -> voice
SGFFiles -> files
@ -576,7 +571,6 @@ instance GroupPreferenceI FullGroupPreferences where
SGFTimedMessages -> timedMessages
SGFDirectMessages -> directMessages
SGFFullDelete -> fullDelete
-- GFReceipts -> receipts
SGFReactions -> reactions
SGFVoice -> voice
SGFFiles -> files
@ -587,7 +581,6 @@ data GroupPreferences = GroupPreferences
{ timedMessages :: Maybe TimedMessagesGroupPreference,
directMessages :: Maybe DirectMessagesGroupPreference,
fullDelete :: Maybe FullDeleteGroupPreference,
-- receipts :: Maybe GroupPreference,
reactions :: Maybe ReactionsGroupPreference,
voice :: Maybe VoiceGroupPreference,
files :: Maybe FilesGroupPreference
@ -637,7 +630,6 @@ setGroupTimedMessagesPreference pref prefs_ =
data FullPreferences = FullPreferences
{ timedMessages :: TimedMessagesPreference,
fullDelete :: FullDeletePreference,
-- receipts :: SimplePreference,
reactions :: ReactionsPreference,
voice :: VoicePreference,
calls :: CallsPreference
@ -652,7 +644,6 @@ data FullGroupPreferences = FullGroupPreferences
{ timedMessages :: TimedMessagesGroupPreference,
directMessages :: DirectMessagesGroupPreference,
fullDelete :: FullDeleteGroupPreference,
-- receipts :: GroupPreference,
reactions :: ReactionsGroupPreference,
voice :: VoiceGroupPreference,
files :: FilesGroupPreference
@ -665,7 +656,6 @@ instance ToJSON FullGroupPreferences where toEncoding = J.genericToEncoding J.de
data ContactUserPreferences = ContactUserPreferences
{ timedMessages :: ContactUserPreference TimedMessagesPreference,
fullDelete :: ContactUserPreference FullDeletePreference,
-- receipts :: ContactUserPreference,
reactions :: ContactUserPreference ReactionsPreference,
voice :: ContactUserPreference VoicePreference,
calls :: ContactUserPreference CallsPreference
@ -695,7 +685,6 @@ toChatPrefs FullPreferences {timedMessages, fullDelete, reactions, voice, calls}
Preferences
{ timedMessages = Just timedMessages,
fullDelete = Just fullDelete,
-- receipts = Just receipts,
reactions = Just reactions,
voice = Just voice,
calls = Just calls
@ -706,7 +695,6 @@ defaultChatPrefs =
FullPreferences
{ timedMessages = TimedMessagesPreference {allow = FAYes, ttl = Nothing},
fullDelete = FullDeletePreference {allow = FANo},
-- receipts = SimplePreference {allow = FANo},
reactions = ReactionsPreference {allow = FAYes},
voice = VoicePreference {allow = FAYes},
calls = CallsPreference {allow = FAYes}
@ -721,7 +709,6 @@ defaultGroupPrefs =
{ timedMessages = TimedMessagesGroupPreference {enable = FEOff, ttl = Just 86400},
directMessages = DirectMessagesGroupPreference {enable = FEOff},
fullDelete = FullDeleteGroupPreference {enable = FEOff},
-- receipts = GroupPreference {enable = FEOff},
reactions = ReactionsGroupPreference {enable = FEOn},
voice = VoiceGroupPreference {enable = FEOn},
files = FilesGroupPreference {enable = FEOn}
@ -1009,7 +996,6 @@ mergePreferences contactPrefs userPreferences =
FullPreferences
{ timedMessages = pref SCFTimedMessages,
fullDelete = pref SCFFullDelete,
-- receipts = pref CFReceipts,
reactions = pref SCFReactions,
voice = pref SCFVoice,
calls = pref SCFCalls
@ -1034,7 +1020,6 @@ mergeGroupPreferences groupPreferences =
{ timedMessages = pref SGFTimedMessages,
directMessages = pref SGFDirectMessages,
fullDelete = pref SGFFullDelete,
-- receipts = pref GFReceipts,
reactions = pref SGFReactions,
voice = pref SGFVoice,
files = pref SGFFiles
@ -1049,7 +1034,6 @@ toGroupPreferences groupPreferences =
{ timedMessages = pref SGFTimedMessages,
directMessages = pref SGFDirectMessages,
fullDelete = pref SGFFullDelete,
-- receipts = pref GFReceipts,
reactions = pref SGFReactions,
voice = pref SGFVoice,
files = pref SGFFiles
@ -1128,7 +1112,6 @@ contactUserPreferences user userPreferences contactPreferences connectedIncognit
ContactUserPreferences
{ timedMessages = pref SCFTimedMessages,
fullDelete = pref SCFFullDelete,
-- receipts = pref CFReceipts,
reactions = pref SCFReactions,
voice = pref SCFVoice,
calls = pref SCFCalls
@ -1156,7 +1139,6 @@ getContactUserPreference :: SChatFeature f -> ContactUserPreferences -> ContactU
getContactUserPreference = \case
SCFTimedMessages -> timedMessages
SCFFullDelete -> fullDelete
-- CFReceipts -> receipts
SCFReactions -> reactions
SCFVoice -> voice
SCFCalls -> calls

20
src/Simplex/Chat/View.hs
View File

@ -62,7 +62,7 @@ serializeChatResponse :: Maybe User -> CurrentTime -> TimeZone -> ChatResponse -
serializeChatResponse user_ ts tz = unlines . map unStyle . responseToView user_ defaultChatConfig False ts tz
responseToView :: Maybe User -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> ChatResponse -> [StyledString]
responseToView user_ ChatConfig {logLevel, showReactions, testView} liveItems ts tz = \case
responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView} liveItems ts tz = \case
CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile
CRUsersList users -> viewUsersList users
CRChatStarted -> ["chat started"]
@ -98,7 +98,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, testView} liveItems ts
CRChatItems u chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts tz <> viewItemReactions item) chatItems
CRChatItemInfo u ci ciInfo -> ttyUser u $ viewChatItemInfo ci ciInfo tz
CRChatItemId u itemId -> ttyUser u [plain $ maybe "no item" show itemId]
CRChatItemStatusUpdated u _ -> ttyUser u []
CRChatItemStatusUpdated u ci -> ttyUser u $ viewChatItemStatusUpdated ci ts tz testView showReceipts
CRChatItemUpdated u (AChatItem _ _ chat item) -> ttyUser u $ unmuted chat item $ viewItemUpdate chat item liveItems ts tz
CRChatItemNotChanged u ci -> ttyUser u $ viewItemNotChanged ci
CRChatItemDeleted u (AChatItem _ _ chat deletedItem) toItem byUser timed -> ttyUser u $ unmuted chat deletedItem $ viewItemDelete chat deletedItem toItem byUser timed ts tz testView
@ -461,6 +461,20 @@ localTs tz ts = do
formattedTime = formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" localTime
formattedTime
viewChatItemStatusUpdated :: AChatItem -> CurrentTime -> TimeZone -> Bool -> Bool -> [StyledString]
viewChatItemStatusUpdated (AChatItem _ _ chat item@ChatItem {meta = CIMeta {itemStatus}}) ts tz testView showReceipts =
case itemStatus of
CISSndRcvd rcptStatus ->
if testView && showReceipts
then prependFirst (viewDeliveryReceipt rcptStatus <> " ") $ viewChatItem chat item False ts tz
else []
_ -> []
viewDeliveryReceipt :: MsgReceiptStatus -> StyledString
viewDeliveryReceipt = \case
MROk -> "⩗"
MRBadMsgHash -> ttyError' "⩗!"
viewItemUpdate :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> CurrentTime -> TimeZone -> [StyledString]
viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemEdited, itemLive}, content, quotedItem} liveItems ts tz = case chat of
DirectChat c -> case chatDir of
@ -495,7 +509,7 @@ viewItemUpdate chat ChatItem {chatDir, meta = meta@CIMeta {itemEdited, itemLive}
quote = maybe [] (groupQuote g) quotedItem
_ -> []
hideLive :: CIMeta с d -> [StyledString] -> [StyledString]
hideLive :: CIMeta c d -> [StyledString] -> [StyledString]
hideLive CIMeta {itemLive = Just True} _ = []
hideLive _ s = s

2
stack.yaml
View File

@ -49,7 +49,7 @@ extra-deps:
# - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
# - ../simplexmq
- github: simplex-chat/simplexmq
commit: 1afcefa5e7cf7c4a5e5732104105d14259be16b6
commit: 58cb2855d23ac970a619a61d088ed2a08dfb3d81
- github: kazu-yamamoto/http2
commit: b5a1b7200cf5bc7044af34ba325284271f6dff25
# - ../direct-sqlcipher

2
tests/ChatClient.hs
View File

@ -116,6 +116,7 @@ testCfg :: ChatConfig
testCfg =
defaultChatConfig
{ agentConfig = testAgentCfg,
showReceipts = False,
testView = True,
tbqSize = 16,
xftpFileConfig = Nothing
@ -248,6 +249,7 @@ getTermLine cc =
Just s -> do
-- remove condition to always echo virtual terminal
when (printOutput cc) $ do
-- when True $ do
name <- userName cc
putStrLn $ name <> ": " <> s
pure s

113
tests/ChatTests/Direct.hs
View File

@ -91,6 +91,9 @@ chatDirectTests = do
it "synchronize ratchets, reset connection code" testSyncRatchetCodeReset
describe "message reactions" $ do
it "set message reactions" testSetMessageReactions
describe "delivery receipts" $ do
it "should send delivery receipts" testSendDeliveryReceipts
it "should send delivery receipts depending on configuration" testConfigureDeliveryReceipts
testAddContact :: HasCallStack => SpecWith FilePath
testAddContact = versionTestMatrix2 runTestAddContact
@ -491,6 +494,7 @@ testRepeatAuthErrorsDisableContact =
testChat2 aliceProfile bobProfile $ \alice bob -> do
connectUsers alice bob
alice <##> bob
threadDelay 500000
bob ##> "/d alice"
bob <## "alice: contact is deleted"
forM_ [1 .. authErrDisableCount] $ \_ -> sendAuth alice
@ -2007,7 +2011,7 @@ testMsgDecryptError tmp =
withTestChat tmp "bob" $ \bob -> do
bob <## "1 contacts connected (use /cs for the list)"
alice #> "@bob hello again"
bob <# "alice> skipped message ID 5..7"
bob <# "alice> skipped message ID 9..11"
bob <# "alice> hello again"
bob #> "@alice received!"
alice <# "bob> received!"
@ -2017,10 +2021,15 @@ setupDesynchronizedRatchet tmp alice = do
copyDb "bob" "bob_old"
withTestChat tmp "bob" $ \bob -> do
bob <## "1 contacts connected (use /cs for the list)"
alice #> "@bob hello"
bob <# "alice> hello"
bob #> "@alice hello too"
alice <# "bob> hello too"
alice #> "@bob 1"
bob <# "alice> 1"
bob #> "@alice 2"
alice <# "bob> 2"
alice #> "@bob 3"
bob <# "alice> 3"
bob #> "@alice 4"
alice <# "bob> 4"
threadDelay 500000
withTestChat tmp "bob_old" $ \bob -> do
bob <## "1 contacts connected (use /cs for the list)"
bob ##> "/sync alice"
@ -2168,3 +2177,97 @@ testSetMessageReactions =
bob ##> "/tail @alice 1"
bob <# "alice> hi"
bob <## " 👍 1"
testSendDeliveryReceipts :: HasCallStack => FilePath -> IO ()
testSendDeliveryReceipts tmp =
withNewTestChatCfg tmp cfg "alice" aliceProfile $ \alice -> do
withNewTestChatCfg tmp cfg "bob" bobProfile $ \bob -> do
connectUsers alice bob
alice #> "@bob hi"
bob <# "alice> hi"
alice ⩗ "@bob hi"
bob #> "@alice hey"
alice <# "bob> hey"
bob ⩗ "@alice hey"
where
cfg = testCfg {showReceipts = True}
testConfigureDeliveryReceipts :: HasCallStack => FilePath -> IO ()
testConfigureDeliveryReceipts tmp =
withNewTestChatCfg tmp cfg "alice" aliceProfile $ \alice -> do
withNewTestChatCfg tmp cfg "bob" bobProfile $ \bob -> do
withNewTestChatCfg tmp cfg "cath" cathProfile $ \cath -> do
connectUsers alice bob
connectUsers alice cath
-- for new users receipts are enabled by default
receipt bob alice "1"
receipt cath alice "2"
-- configure receipts in all chats
alice ##> "/set receipts all off"
alice <## "ok"
noReceipt bob alice "3"
noReceipt cath alice "4"
-- configure receipts for user contacts
alice ##> "/_set receipts 1 on"
alice <## "ok"
receipt bob alice "5"
receipt cath alice "6"
-- configure receipts for user contacts (terminal api)
alice ##> "/set receipts off"
alice <## "ok"
noReceipt bob alice "7"
noReceipt cath alice "8"
-- configure receipts for contact
alice ##> "/receipts @bob on"
alice <## "ok"
receipt bob alice "9"
noReceipt cath alice "10"
-- configure receipts for user contacts (don't clear overrides)
alice ##> "/_set receipts 1 off"
alice <## "ok"
receipt bob alice "11"
noReceipt cath alice "12"
alice ##> "/_set receipts 1 off clear_overrides=off"
alice <## "ok"
receipt bob alice "13"
noReceipt cath alice "14"
-- configure receipts for user contacts (clear overrides)
alice ##> "/set receipts off clear_overrides=on"
alice <## "ok"
noReceipt bob alice "15"
noReceipt cath alice "16"
-- configure receipts for contact, reset to default
alice ##> "/receipts @bob on"
alice <## "ok"
receipt bob alice "17"
noReceipt cath alice "18"
alice ##> "/receipts @bob default"
alice <## "ok"
noReceipt bob alice "19"
noReceipt cath alice "20"
where
cfg = testCfg {showReceipts = True}
receipt cc1 cc2 msg = do
name1 <- userName cc1
name2 <- userName cc2
cc1 #> ("@" <> name2 <> " " <> msg)
cc2 <# (name1 <> "> " <> msg)
cc1 ⩗ ("@" <> name2 <> " " <> msg)
noReceipt cc1 cc2 msg = do
name1 <- userName cc1
name2 <- userName cc2
cc1 #> ("@" <> name2 <> " " <> msg)
cc2 <# (name1 <> "> " <> msg)
cc1 <// 50000

2
tests/ChatTests/Groups.hs
View File

@ -587,6 +587,7 @@ testGroupDeleteInvitedContact =
bob <## "#team: alice invites you to join the group as admin"
bob <## "use /j team to accept"
]
threadDelay 500000
alice ##> "/d bob"
alice <## "bob: contact is deleted"
bob ##> "/j team"
@ -1798,6 +1799,7 @@ testGroupLinkContactUsed =
bob @@@ [("#team", "connected")]
alice #> "@bob hello"
bob <# "alice> hello"
threadDelay 500000
alice #$> ("/clear bob", id, "bob: all messages are removed locally ONLY")
alice @@@ [("@bob", ""), ("#team", "connected")]
bob #$> ("/clear alice", id, "alice: all messages are removed locally ONLY")

9
tests/ChatTests/Profiles.hs
View File

@ -106,7 +106,7 @@ testUpdateProfileImage =
alice <## "profile image removed"
alice ##> "/show profile image"
alice <## "No profile image"
alice ##> "/_profile 1 {\"displayName\": \"alice2\", \"fullName\": \"\"}"
alice ##> "/_profile 1 {\"displayName\": \"alice2\", \"fullName\": \"\", \"preferences\": {\"receipts\": {\"allow\": \"yes\", \"activated\": true}}}"
alice <## "user profile is changed to alice2 (your 1 contacts are notified)"
bob <## "contact alice changed to alice2"
bob <## "use @alice2 <message> to send messages"
@ -596,6 +596,7 @@ testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $
bob ##> "/contacts"
bob <## "i alice (Alice)"
bob `hasContactProfiles` ["alice", "bob", T.pack bobIncognito]
threadDelay 500000
-- delete contact, incognito profile is deleted
bob ##> "/d alice"
bob <## "alice: contact is deleted"
@ -878,7 +879,7 @@ testCantSeeGlobalPrefsUpdateIncognito = testChat3 aliceProfile bobProfile cathPr
cath <## "alice (Alice): contact is connected"
]
alice <## "cath (Catherine): contact is connected"
alice ##> "/_profile 1 {\"displayName\": \"alice\", \"fullName\": \"\", \"preferences\": {\"fullDelete\": {\"allow\": \"always\"}}}"
alice ##> "/_profile 1 {\"displayName\": \"alice\", \"fullName\": \"\", \"preferences\": {\"fullDelete\": {\"allow\": \"always\"}, \"receipts\": {\"allow\": \"yes\", \"activated\": true}}}"
alice <## "user full name removed (your 1 contacts are notified)"
alice <## "updated preferences:"
alice <## "Full deletion allowed: always"
@ -1050,7 +1051,7 @@ testSetContactPrefs = testChat2 aliceProfile bobProfile $
createDirectoryIfMissing True "./tests/tmp/bob"
copyFile "./tests/fixtures/test.txt" "./tests/tmp/alice/test.txt"
copyFile "./tests/fixtures/test.txt" "./tests/tmp/bob/test.txt"
bob ##> "/_profile 1 {\"displayName\": \"bob\", \"fullName\": \"Bob\", \"preferences\": {\"voice\": {\"allow\": \"no\"}}}"
bob ##> "/_profile 1 {\"displayName\": \"bob\", \"fullName\": \"Bob\", \"preferences\": {\"voice\": {\"allow\": \"no\"}, \"receipts\": {\"allow\": \"yes\", \"activated\": true}}}"
bob <## "profile image removed"
bob <## "updated preferences:"
bob <## "Voice messages allowed: no"
@ -1100,7 +1101,7 @@ testSetContactPrefs = testChat2 aliceProfile bobProfile $
bob <## "Voice messages: off (you allow: default (no), contact allows: yes)"
bob #$> ("/_get chat @2 count=100", chat, startFeatures <> [(0, "Voice messages: enabled for you"), (1, "voice message (00:10)"), (0, "Voice messages: off")])
(bob </)
bob ##> "/_profile 1 {\"displayName\": \"bob\", \"fullName\": \"\", \"preferences\": {\"voice\": {\"allow\": \"yes\"}}}"
bob ##> "/_profile 1 {\"displayName\": \"bob\", \"fullName\": \"\", \"preferences\": {\"voice\": {\"allow\": \"yes\"}, \"receipts\": {\"allow\": \"yes\", \"activated\": true}}}"
bob <## "user full name removed (your 1 contacts are notified)"
bob <## "updated preferences:"
bob <## "Voice messages allowed: yes"

13
tests/ChatTests/Utils.hs
View File

@ -307,6 +307,9 @@ cc ?<# line = (dropTime <$> getTermLine cc) `shouldReturn` "i " <> line
($<#) :: HasCallStack => (TestCC, String) -> String -> Expectation
(cc, uName) $<# line = (dropTime . dropUser uName <$> getTermLine cc) `shouldReturn` line
(⩗) :: HasCallStack => TestCC -> String -> Expectation
cc ⩗ line = (dropTime . dropReceipt <$> getTermLine cc) `shouldReturn` line
(</) :: HasCallStack => TestCC -> Expectation
(</) = (<// 500000)
@ -342,6 +345,16 @@ dropTime_ msg = case splitAt 6 msg of
if all isDigit [m, m', s, s'] then Just text else Nothing
_ -> Nothing
dropReceipt :: HasCallStack => String -> String
dropReceipt msg = fromMaybe err $ dropReceipt_ msg
where
err = error $ "invalid receipt: " <> msg
dropReceipt_ :: String -> Maybe String
dropReceipt_ msg = case splitAt 2 msg of
("⩗ ", text) -> Just text
_ -> Nothing
getInvitation :: HasCallStack => TestCC -> IO String
getInvitation cc = do
cc <## "pass this invitation link to your contact (via another channel):"

12
tests/MobileTests.hs
View File

@ -16,7 +16,7 @@ mobileTests :: SpecWith FilePath
mobileTests = do
describe "mobile API" $ do
it "start new chat without user" testChatApiNoUser
xit "start new chat with existing user" testChatApi
it "start new chat with existing user" testChatApi
noActiveUser :: String
#if defined(darwin_HOST_OS) && defined(swiftJSON)
@ -27,16 +27,16 @@ noActiveUser = "{\"resp\":{\"type\":\"chatCmdError\",\"chatError\":{\"type\":\"e
activeUserExists :: String
#if defined(darwin_HOST_OS) && defined(swiftJSON)
activeUserExists = "{\"resp\":{\"chatCmdError\":{\"user_\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true},\"chatError\":{\"error\":{\"errorType\":{\"userExists\":{\"contactName\":\"alice\"}}}}}}}"
activeUserExists = "{\"resp\":{\"chatCmdError\":{\"user_\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":false},\"chatError\":{\"error\":{\"errorType\":{\"userExists\":{\"contactName\":\"alice\"}}}}}}}"
#else
activeUserExists = "{\"resp\":{\"type\":\"chatCmdError\",\"user_\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true},\"chatError\":{\"type\":\"error\",\"errorType\":{\"type\":\"userExists\",\"contactName\":\"alice\"}}}}"
activeUserExists = "{\"resp\":{\"type\":\"chatCmdError\",\"user_\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":false},\"chatError\":{\"type\":\"error\",\"errorType\":{\"type\":\"userExists\",\"contactName\":\"alice\"}}}}"
#endif
activeUser :: String
#if defined(darwin_HOST_OS) && defined(swiftJSON)
activeUser = "{\"resp\":{\"activeUser\":{\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true}}}}"
activeUser = "{\"resp\":{\"activeUser\":{\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":false}}}}"
#else
activeUser = "{\"resp\":{\"type\":\"activeUser\",\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true}}}"
activeUser = "{\"resp\":{\"type\":\"activeUser\",\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":false}}}"
#endif
chatStarted :: String
@ -75,7 +75,7 @@ pendingSubSummary = "{\"resp\":{\"type\":\"pendingSubSummary\"," <> userJSON <>
#endif
userJSON :: String
userJSON = "\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true}"
userJSON = "\"user\":{\"userId\":1,\"agentUserId\":\"1\",\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"profileId\":1,\"displayName\":\"alice\",\"fullName\":\"Alice\",\"localAlias\":\"\"},\"fullPreferences\":{\"timedMessages\":{\"allow\":\"yes\"},\"fullDelete\":{\"allow\":\"no\"},\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"},\"calls\":{\"allow\":\"yes\"}},\"activeUser\":true,\"showNtfs\":true,\"sendRcptsContacts\":true,\"sendRcptsSmallGroups\":false}"
parsedMarkdown :: String
#if defined(darwin_HOST_OS) && defined(swiftJSON)