dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-07-21 06:51:20 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into master-android

Browse Source
This commit is contained in:
Evgeny Poberezkin
2024-05-13 21:13:29 +01:00
parent e424b3eb66 396b73b480
commit 68f7956512
27 changed files with 318 additions and 151 deletions
Download Patch File Download Diff File Expand all files Collapse all files
apps/ios/Shared/Model/SimpleXAPI.swift
+20 -12
View File
@@ -1849,21 +1849,29 @@ func processReceivedMsg(_ res: ChatResponse) async {
}
case .chatSuspended:
chatSuspended()
case let .contactSwitch(_, contact, switchProgress):
await MainActor.run {
m.updateContactConnectionStats(contact, switchProgress.connectionStats)
case let .contactSwitch(user, contact, switchProgress):
if active(user) {
await MainActor.run {
m.updateContactConnectionStats(contact, switchProgress.connectionStats)
}
}
case let .groupMemberSwitch(_, groupInfo, member, switchProgress):
await MainActor.run {
m.updateGroupMemberConnectionStats(groupInfo, member, switchProgress.connectionStats)
case let .groupMemberSwitch(user, groupInfo, member, switchProgress):
if active(user) {
await MainActor.run {
m.updateGroupMemberConnectionStats(groupInfo, member, switchProgress.connectionStats)
}
}
case let .contactRatchetSync(_, contact, ratchetSyncProgress):
await MainActor.run {
m.updateContactConnectionStats(contact, ratchetSyncProgress.connectionStats)
case let .contactRatchetSync(user, contact, ratchetSyncProgress):
if active(user) {
await MainActor.run {
m.updateContactConnectionStats(contact, ratchetSyncProgress.connectionStats)
}
}
case let .groupMemberRatchetSync(_, groupInfo, member, ratchetSyncProgress):
await MainActor.run {
m.updateGroupMemberConnectionStats(groupInfo, member, ratchetSyncProgress.connectionStats)
case let .groupMemberRatchetSync(user, groupInfo, member, ratchetSyncProgress):
if active(user) {
await MainActor.run {
m.updateGroupMemberConnectionStats(groupInfo, member, ratchetSyncProgress.connectionStats)
}
}
case let .remoteCtrlFound(remoteCtrl, ctrlAppInfo_, appVersion, compatible):
await MainActor.run {
apps/ios/Shared/Views/UserSettings/AdvancedNetworkSettings.swift
+2 -2
View File
@@ -51,10 +51,10 @@ struct AdvancedNetworkSettings: View {
}
.disabled(currentNetCfg == NetCfg.proxyDefaults)
timeoutSettingPicker("TCP connection timeout", selection: $netCfg.tcpConnectTimeout, values: [10_000000, 15_000000, 20_000000, 25_000000, 35_000000, 50_000000], label: secondsLabel)
timeoutSettingPicker("TCP connection timeout", selection: $netCfg.tcpConnectTimeout, values: [10_000000, 15_000000, 20_000000, 30_000000, 45_000000, 60_000000, 90_000000], label: secondsLabel)
timeoutSettingPicker("Protocol timeout", selection: $netCfg.tcpTimeout, values: [5_000000, 7_000000, 10_000000, 15_000000, 20_000000, 30_000000], label: secondsLabel)
timeoutSettingPicker("Protocol timeout per KB", selection: $netCfg.tcpTimeoutPerKb, values: [2_500, 5_000, 10_000, 15_000, 20_000, 30_000], label: secondsLabel)
intSettingPicker("Receiving concurrency", selection: $netCfg.rcvConcurrency, values: [1, 2, 4, 8, 12, 16, 24], label: "")
// intSettingPicker("Receiving concurrency", selection: $netCfg.rcvConcurrency, values: [1, 2, 4, 8, 12, 16, 24], label: "")
timeoutSettingPicker("PING interval", selection: $netCfg.smpPingInterval, values: [120_000000, 300_000000, 600_000000, 1200_000000, 2400_000000, 3600_000000], label: secondsLabel)
intSettingPicker("PING count", selection: $netCfg.smpPingCount, values: [1, 2, 3, 5, 8], label: "")
Toggle("Enable TCP keep-alive", isOn: $enableKeepAlive)
apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt
+12 -4
View File
@@ -2031,13 +2031,21 @@ object ChatController {
}
}
is CR.ContactSwitch ->
chatModel.updateContactConnectionStats(rhId, r.contact, r.switchProgress.connectionStats)
if (active(r.user)) {
chatModel.updateContactConnectionStats(rhId, r.contact, r.switchProgress.connectionStats)
}
is CR.GroupMemberSwitch ->
chatModel.updateGroupMemberConnectionStats(rhId, r.groupInfo, r.member, r.switchProgress.connectionStats)
if (active(r.user)) {
chatModel.updateGroupMemberConnectionStats(rhId, r.groupInfo, r.member, r.switchProgress.connectionStats)
}
is CR.ContactRatchetSync ->
chatModel.updateContactConnectionStats(rhId, r.contact, r.ratchetSyncProgress.connectionStats)
if (active(r.user)) {
chatModel.updateContactConnectionStats(rhId, r.contact, r.ratchetSyncProgress.connectionStats)
}
is CR.GroupMemberRatchetSync ->
chatModel.updateGroupMemberConnectionStats(rhId, r.groupInfo, r.member, r.ratchetSyncProgress.connectionStats)
if (active(r.user)) {
chatModel.updateGroupMemberConnectionStats(rhId, r.groupInfo, r.member, r.ratchetSyncProgress.connectionStats)
}
is CR.RemoteHostSessionCode -> {
chatModel.remoteHostPairing.value = r.remoteHost_ to RemoteHostSessionState.PendingConfirmation(r.sessionCode)
}
apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/views/usersettings/AdvancedNetworkSettings.kt
+7 -7
View File
@@ -159,7 +159,7 @@ fun AdvancedNetworkSettingsView(chatModel: ChatModel) {
SectionItemView {
TimeoutSettingRow(
stringResource(MR.strings.network_option_tcp_connection_timeout), networkTCPConnectTimeout,
listOf(10_000000, 15_000000, 20_000000, 25_000000, 35_000000, 50_000000), secondsLabel
listOf(10_000000, 15_000000, 20_000000, 30_000000, 45_000000, 60_000000, 90_000000), secondsLabel
)
}
SectionItemView {
@@ -175,12 +175,12 @@ fun AdvancedNetworkSettingsView(chatModel: ChatModel) {
listOf(2_500, 5_000, 10_000, 15_000, 20_000, 30_000), secondsLabel
)
}
SectionItemView {
IntSettingRow(
stringResource(MR.strings.network_option_rcv_concurrency), networkRcvConcurrency,
listOf(1, 2, 4, 8, 12, 16, 24), ""
)
}
// SectionItemView {
// IntSettingRow(
// stringResource(MR.strings.network_option_rcv_concurrency), networkRcvConcurrency,
// listOf(1, 2, 4, 8, 12, 16, 24), ""
// )
// }
SectionItemView {
TimeoutSettingRow(
stringResource(MR.strings.network_option_ping_interval), networkSMPPingInterval,
cabal.project
+1 -1
View File
@@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
source-repository-package
type: git
location: https://github.com/simplex-chat/simplexmq.git
tag: 1339a8da1105ae836b3804113498dabbdf5901ee
tag: 762909ce33c01d71bbabfed156e1e9faeebbedca
source-repository-package
type: git
package.yaml
+1 -1
View File
@@ -1,5 +1,5 @@
name: simplex-chat
version: 5.7.3.0
version: 5.8.0.0
#synopsis:
#description:
homepage: https://github.com/simplex-chat/simplex-chat#readme
scripts/nix/sha256map.nix
+1 -1
View File
@@ -1,5 +1,5 @@
{
"https://github.com/simplex-chat/simplexmq.git"."1339a8da1105ae836b3804113498dabbdf5901ee" = "0hkjcs2kv87vbj67rqp04a4l6qjqs4b0qcpwf0mw6f56lfps9751";
"https://github.com/simplex-chat/simplexmq.git"."762909ce33c01d71bbabfed156e1e9faeebbedca" = "0jsfi792n84zk6bhfhg138mn0mv6wvvfmm0d6qxmplpb6glcbqaj";
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
"https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
"https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";
simplex-chat.cabal
+2 -1
View File
@@ -5,7 +5,7 @@ cabal-version: 1.12
-- see: https://github.com/sol/hpack
name: simplex-chat
version: 5.7.3.0
version: 5.8.0.0
category: Web, System, Services, Cryptography
homepage: https://github.com/simplex-chat/simplex-chat#readme
author: simplex.chat
@@ -142,6 +142,7 @@ library
Simplex.Chat.Migrations.M20240324_custom_data
Simplex.Chat.Migrations.M20240402_item_forwarded
Simplex.Chat.Migrations.M20240430_ui_theme
Simplex.Chat.Migrations.M20240501_chat_deleted
Simplex.Chat.Mobile
Simplex.Chat.Mobile.File
Simplex.Chat.Mobile.Shared
src/Simplex/Chat.hs
+59 -25
View File
@@ -46,6 +46,7 @@ import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList)
import Data.Ord (Down (..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
@@ -1022,22 +1023,41 @@ processChatCommand' vr = \case
liftIO $ updateNoteFolderUnreadChat db user nf unreadChat
ok user
_ -> pure $ chatCmdError (Just user) "not supported"
APIDeleteChat (ChatRef cType chatId) notify -> withUser $ \user@User {userId} -> case cType of
APIDeleteChat cRef@(ChatRef cType chatId) cdm -> withUser $ \user@User {userId} -> case cType of
CTDirect -> do
ct <- withStore $ \db -> getContact db vr user chatId
filesInfo <- withStore' $ \db -> getContactFileInfo db user ct
withContactLock "deleteChat direct" chatId . procCmd $ do
cancelFilesInProgress user filesInfo
deleteFilesLocally filesInfo
let doSendDel = contactReady ct && contactActive ct && notify
when doSendDel $ void (sendDirectContactMessage user ct XDirectDel) `catchChatError` const (pure ())
contactConnIds <- map aConnId <$> withStore' (\db -> getContactConnections db vr userId ct)
deleteAgentConnectionsAsync' user contactConnIds doSendDel
-- functions below are called in separate transactions to prevent crashes on android
-- (possibly, race condition on integrity check?)
withStore' $ \db -> deleteContactConnectionsAndFiles db userId ct
withStore $ \db -> deleteContact db user ct
pure $ CRContactDeleted user ct
withContactLock "deleteChat direct" chatId . procCmd $
case cdm of
CDMFull notify -> do
cancelFilesInProgress user filesInfo
deleteFilesLocally filesInfo
sendDelDeleteConns ct notify
-- functions below are called in separate transactions to prevent crashes on android
-- (possibly, race condition on integrity check?)
withStore' $ \db -> do
deleteContactConnections db user ct
deleteContactFiles db user ct
withStore $ \db -> deleteContact db user ct
pure $ CRContactDeleted user ct
CDMEntity notify -> do
cancelFilesInProgress user filesInfo
sendDelDeleteConns ct notify
ct' <- withStore $ \db -> do
liftIO $ deleteContactConnections db user ct
liftIO $ void $ updateContactStatus db user ct CSDeletedByUser
getContact db vr user chatId
pure $ CRContactDeleted user ct'
CDMMessages -> do
void $ processChatCommand $ APIClearChat cRef
withStore' $ \db -> setContactChatDeleted db user ct True
pure $ CRContactDeleted user ct {chatDeleted = True}
where
sendDelDeleteConns ct notify = do
let doSendDel = contactReady ct && contactActive ct && notify
when doSendDel $ void (sendDirectContactMessage user ct XDirectDel) `catchChatError` const (pure ())
contactConnIds <- map aConnId <$> withStore' (\db -> getContactConnections db vr userId ct)
deleteAgentConnectionsAsync' user contactConnIds doSendDel
CTContactConnection -> withConnectionLock "deleteChat contactConnection" chatId . procCmd $ do
conn@PendingContactConnection {pccAgentConnId = AgentConnId acId} <- withStore $ \db -> getPendingContactConnection db userId chatId
deleteAgentConnectionAsync user acId
@@ -1554,7 +1574,7 @@ processChatCommand' vr = \case
CPContactAddress (CAPContactViaAddress Contact {contactId}) ->
processChatCommand $ APIConnectContactViaAddress userId incognito contactId
_ -> processChatCommand $ APIConnect userId incognito (Just cReqUri)
DeleteContact cName -> withContactName cName $ \ctId -> APIDeleteChat (ChatRef CTDirect ctId) True
DeleteContact cName cdm -> withContactName cName $ \ctId -> APIDeleteChat (ChatRef CTDirect ctId) cdm
ClearContact cName -> withContactName cName $ APIClearChat . ChatRef CTDirect
APIListContacts userId -> withUserId userId $ \user ->
CRContactsList user <$> withStore' (\db -> getUserContacts db vr user)
@@ -1889,7 +1909,7 @@ processChatCommand' vr = \case
processChatCommand $ APILeaveGroup groupId
DeleteGroup gName -> withUser $ \user -> do
groupId <- withStore $ \db -> getGroupIdByName db user gName
processChatCommand $ APIDeleteChat (ChatRef CTGroup groupId) True
processChatCommand $ APIDeleteChat (ChatRef CTGroup groupId) (CDMFull True)
ClearGroup gName -> withUser $ \user -> do
groupId <- withStore $ \db -> getGroupIdByName db user gName
processChatCommand $ APIClearChat (ChatRef CTGroup groupId)
@@ -2203,6 +2223,10 @@ processChatCommand' vr = \case
stat (AgentStatsKey {host, clientTs, cmd, res}, count) =
map B.unpack [host, clientTs, cmd, res, bshow count]
ResetAgentStats -> lift (withAgent' resetAgentStats) >> ok_
GetAgentMsgCounts -> lift $ do
counts <- map (first decodeLatin1) <$> withAgent' getMsgCounts
let allMsgs = foldl' (\(ts, ds) (_, (t, d)) -> (ts + t, ds + d)) (0, 0) counts
pure CRAgentMsgCounts {msgCounts = ("all", allMsgs) : sortOn (Down . snd) (filter (\(_, (_, d)) -> d /= 0) counts)}
GetAgentSubs -> lift $ summary <$> withAgent' getAgentSubscriptions
where
summary SubscriptionsInfo {activeSubscriptions, pendingSubscriptions, removedSubscriptions} =
@@ -3036,7 +3060,7 @@ receiveFile' user ft rcvInline_ filePath_ = do
where
processError = \case
-- TODO AChatItem in Cancelled events
ChatErrorAgent (SMP SMP.AUTH) _ -> pure $ CRRcvFileAcceptedSndCancelled user ft
ChatErrorAgent (SMP _ SMP.AUTH) _ -> pure $ CRRcvFileAcceptedSndCancelled user ft
ChatErrorAgent (CONN DUPLICATE) _ -> pure $ CRRcvFileAcceptedSndCancelled user ft
e -> throwError e
@@ -3373,7 +3397,7 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do
errorNetworkStatus :: ChatError -> String
errorNetworkStatus = \case
ChatErrorAgent (BROKER _ NETWORK) _ -> "network"
ChatErrorAgent (SMP SMP.AUTH) _ -> "contact deleted"
ChatErrorAgent (SMP _ SMP.AUTH) _ -> "contact deleted"
e -> show e
-- TODO possibly below could be replaced with less noisy events for API
contactLinkSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId UserContact -> CM ()
@@ -4499,7 +4523,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
MERR _ err -> do
cancelSndFileTransfer user ft True >>= mapM_ (deleteAgentConnectionAsync user)
case err of
SMP SMP.AUTH -> unless (fileStatus == FSCancelled) $ do
SMP _ SMP.AUTH -> unless (fileStatus == FSCancelled) $ do
ci <- withStore $ \db -> do
liftIO (lookupChatRefByFileId db user fileId) >>= \case
Just (ChatRef CTDirect _) -> liftIO $ updateFileCancelled db user fileId CIFSSndCancelled
@@ -4654,7 +4678,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
incAuthErrCounter :: ConnectionEntity -> Connection -> AgentErrorType -> CM ()
incAuthErrCounter connEntity conn err = do
case err of
SMP SMP.AUTH -> do
SMP _ SMP.AUTH -> do
authErrCounter' <- withStore' $ \db -> incConnectionAuthErrCounter db user conn
when (authErrCounter' >= authErrDisableCount) $ do
toView $ CRConnectionDisabled connEntity
@@ -4706,7 +4730,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
withStore' $ \db -> updateSndMsgDeliveryStatus db connId msgId MDSSndSent
agentErrToItemStatus :: AgentErrorType -> CIStatus 'MDSnd
agentErrToItemStatus (SMP AUTH) = CISSndErrorAuth
agentErrToItemStatus (SMP _ AUTH) = CISSndErrorAuth
agentErrToItemStatus err = CISSndError . T.unpack . safeDecodeUtf8 $ strEncode err
badRcvFileChunk :: RcvFileTransfer -> String -> CM ()
@@ -6676,7 +6700,7 @@ saveSndChatItem' :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> SndMessage
saveSndChatItem' user cd msg@SndMessage {sharedMsgId} content ciFile quotedItem itemForwarded itemTimed live = do
createdAt <- liftIO getCurrentTime
ciId <- withStore' $ \db -> do
when (ciRequiresAttention content) $ updateChatTs db user cd createdAt
when (ciRequiresAttention content || contactChatDeleted cd) $ updateChatTs db user cd createdAt
ciId <- createNewSndChatItem db user cd msg content quotedItem itemForwarded itemTimed live createdAt
forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
pure ciId
@@ -6690,7 +6714,7 @@ saveRcvChatItem' :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c
saveRcvChatItem' user cd msg@RcvMessage {forwardedByMember} sharedMsgId_ brokerTs content ciFile itemTimed live = do
createdAt <- liftIO getCurrentTime
(ciId, quotedItem, itemForwarded) <- withStore' $ \db -> do
when (ciRequiresAttention content) $ updateChatTs db user cd createdAt
when (ciRequiresAttention content || contactChatDeleted cd) $ updateChatTs db user cd createdAt
r@(ciId, _, _) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live brokerTs createdAt
forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
pure r
@@ -6956,7 +6980,7 @@ createInternalItemsForChats user itemTs_ dirsCIContents = do
where
updateChat :: DB.Connection -> UTCTime -> ChatDirection c d -> [CIContent d] -> IO ()
updateChat db createdAt cd contents
| any ciRequiresAttention contents = updateChatTs db user cd createdAt
| any ciRequiresAttention contents || contactChatDeleted cd = updateChatTs db user cd createdAt
| otherwise = pure ()
createACIs :: DB.Connection -> UTCTime -> UTCTime -> ChatDirection c d -> [CIContent d] -> [IO AChatItem]
createACIs db itemTs createdAt cd = map $ \content -> do
@@ -7104,7 +7128,7 @@ chatCommandP =
"/read user" $> UserRead,
"/_read chat " *> (APIChatRead <$> chatRefP <*> optional (A.space *> ((,) <$> ("from=" *> A.decimal) <* A.space <*> ("to=" *> A.decimal)))),
"/_unread chat " *> (APIChatUnread <$> chatRefP <* A.space <*> onOffP),
"/_delete " *> (APIDeleteChat <$> chatRefP <*> (A.space *> "notify=" *> onOffP <|> pure True)),
"/_delete " *> (APIDeleteChat <$> chatRefP <*> chatDeleteMode),
"/_clear chat " *> (APIClearChat <$> chatRefP),
"/_accept" *> (APIAcceptContact <$> incognitoOnOffP <* A.space <*> A.decimal),
"/_reject " *> (APIRejectContact <$> A.decimal),
@@ -7210,7 +7234,7 @@ chatCommandP =
("/remove " <|> "/rm ") *> char_ '#' *> (RemoveMember <$> displayName <* A.space <* char_ '@' <*> displayName),
("/leave " <|> "/l ") *> char_ '#' *> (LeaveGroup <$> displayName),
("/delete #" <|> "/d #") *> (DeleteGroup <$> displayName),
("/delete " <|> "/d ") *> char_ '@' *> (DeleteContact <$> displayName),
("/delete " <|> "/d ") *> char_ '@' *> (DeleteContact <$> displayName <*> chatDeleteMode),
"/clear *" $> ClearNoteFolder,
"/clear #" *> (ClearGroup <$> displayName),
"/clear " *> char_ '@' *> (ClearContact <$> displayName),
@@ -7341,6 +7365,7 @@ chatCommandP =
"/get subs details" $> GetAgentSubsDetails,
"/get workers" $> GetAgentWorkers,
"/get workers details" $> GetAgentWorkersDetails,
"/get msgs" $> GetAgentMsgCounts,
"//" *> (CustomChatCommand <$> A.takeByteString)
]
where
@@ -7361,6 +7386,15 @@ chatCommandP =
mcTextP = MCText . safeDecodeUtf8 <$> A.takeByteString
msgContentP = "text " *> mcTextP <|> "json " *> jsonP
ciDeleteMode = "broadcast" $> CIDMBroadcast <|> "internal" $> CIDMInternal
chatDeleteMode =
A.choice
[ " full" *> (CDMFull <$> notifyP),
" entity" *> (CDMEntity <$> notifyP),
" messages" $> CDMMessages,
CDMFull <$> notifyP -- backwards compatible
]
where
notifyP = " notify=" *> onOffP <|> pure True
displayName = safeDecodeUtf8 <$> (quoted "'" <|> takeNameTill isSpace)
where
takeNameTill p =
src/Simplex/Chat/AppSettings.hs
+18 -5
View File
@@ -9,6 +9,7 @@ import Control.Applicative ((<|>))
import Data.Aeson (FromJSON (..), (.:?))
import qualified Data.Aeson as J
import qualified Data.Aeson.TH as JQ
import Data.Map.Strict (Map)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Simplex.Chat.Types.UITheme
@@ -48,7 +49,9 @@ data AppSettings = AppSettings
uiProfileImageCornerRadius :: Maybe Double,
uiColorScheme :: Maybe UIColorScheme,
uiDarkColorScheme :: Maybe DarkColorScheme,
uiThemes :: Maybe UIThemes
uiCurrentThemeIds :: Maybe (Map ThemeColorScheme Text),
uiThemes :: Maybe [UITheme],
oneHandUI :: Maybe Bool
}
deriving (Show)
@@ -78,7 +81,9 @@ defaultAppSettings =
uiProfileImageCornerRadius = Just 22.5,
uiColorScheme = Just UCSSystem,
uiDarkColorScheme = Just DCSSimplex,
uiThemes = Nothing
uiCurrentThemeIds = Nothing,
uiThemes = Nothing,
oneHandUI = Just True
}
defaultParseAppSettings :: AppSettings
@@ -107,7 +112,9 @@ defaultParseAppSettings =
uiProfileImageCornerRadius = Nothing,
uiColorScheme = Nothing,
uiDarkColorScheme = Nothing,
uiThemes = Nothing
uiCurrentThemeIds = Nothing,
uiThemes = Nothing,
oneHandUI = Nothing
}
combineAppSettings :: AppSettings -> AppSettings -> AppSettings
@@ -136,7 +143,9 @@ combineAppSettings platformDefaults storedSettings =
uiProfileImageCornerRadius = p uiProfileImageCornerRadius,
uiColorScheme = p uiColorScheme,
uiDarkColorScheme = p uiDarkColorScheme,
uiThemes = p uiThemes
uiCurrentThemeIds = p uiCurrentThemeIds,
uiThemes = p uiThemes,
oneHandUI = p oneHandUI
}
where
p :: (AppSettings -> Maybe a) -> Maybe a
@@ -177,7 +186,9 @@ instance FromJSON AppSettings where
uiProfileImageCornerRadius <- p "uiProfileImageCornerRadius"
uiColorScheme <- p "uiColorScheme"
uiDarkColorScheme <- p "uiDarkColorScheme"
uiCurrentThemeIds <- p "uiCurrentThemeIds"
uiThemes <- p "uiThemes"
oneHandUI <- p "oneHandUI"
pure
AppSettings
{ appPlatform,
@@ -203,7 +214,9 @@ instance FromJSON AppSettings where
uiProfileImageCornerRadius,
uiColorScheme,
uiDarkColorScheme,
uiThemes
uiCurrentThemeIds,
uiThemes,
oneHandUI
}
where
p key = v .:? key <|> pure Nothing
src/Simplex/Chat/Controller.hs
+10 -2
View File
@@ -296,7 +296,7 @@ data ChatCommand
| UserRead
| APIChatRead ChatRef (Maybe (ChatItemId, ChatItemId))
| APIChatUnread ChatRef Bool
| APIDeleteChat ChatRef Bool -- `notify` flag is only applied to direct chats
| APIDeleteChat ChatRef ChatDeleteMode -- currently delete mode settings are only applied to direct chats
| APIClearChat ChatRef
| APIAcceptContact IncognitoEnabled Int64
| APIRejectContact Int64
@@ -395,7 +395,7 @@ data ChatCommand
| Connect IncognitoEnabled (Maybe AConnectionRequestUri)
| APIConnectContactViaAddress UserId IncognitoEnabled ContactId
| ConnectSimplex IncognitoEnabled -- UserId (not used in UI)
| DeleteContact ContactName
| DeleteContact ContactName ChatDeleteMode
| ClearContact ContactName
| APIListContacts UserId
| ListContacts
@@ -501,6 +501,7 @@ data ChatCommand
| GetAgentSubsDetails
| GetAgentWorkers
| GetAgentWorkersDetails
| GetAgentMsgCounts
| -- The parser will return this command for strings that start from "//".
-- This command should be processed in preCmdHook
CustomChatCommand ByteString
@@ -746,6 +747,7 @@ data ChatResponse
| CRAgentWorkersSummary {agentWorkersSummary :: AgentWorkersSummary}
| CRAgentSubs {activeSubs :: Map Text Int, pendingSubs :: Map Text Int, removedSubs :: Map Text [String]}
| CRAgentSubsDetails {agentSubs :: SubscriptionsInfo}
| CRAgentMsgCounts {msgCounts :: [(Text, (Int, Int))]}
| CRConnectionDisabled {connectionEntity :: ConnectionEntity}
| CRAgentRcvQueueDeleted {agentConnId :: AgentConnId, server :: SMPServer, agentQueueId :: AgentQueueId, agentError_ :: Maybe AgentErrorType}
| CRAgentConnDeleted {agentConnId :: AgentConnId}
@@ -824,6 +826,12 @@ data ChatListQuery
clqNoFilters :: ChatListQuery
clqNoFilters = CLQFilters {favorite = False, unread = False}
data ChatDeleteMode
= CDMFull {notify :: Bool} -- delete both contact and conversation
| CDMEntity {notify :: Bool} -- delete contact (connection), keep conversation
| CDMMessages -- delete conversation, keep contact - can be re-opened from Contacts view
deriving (Show)
data ConnectionPlan
= CPInvitationLink {invitationLinkPlan :: InvitationLinkPlan}
| CPContactAddress {contactAddressPlan :: ContactAddressPlan}
src/Simplex/Chat/Messages.hs
+7
View File
@@ -45,6 +45,7 @@ import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Protocol
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Util (textParseJSON)
import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgMeta (..), MsgReceiptStatus (..))
import Simplex.Messaging.Crypto.File (CryptoFile (..))
import qualified Simplex.Messaging.Crypto.File as CF
@@ -277,6 +278,12 @@ toChatInfo = \case
CDLocalSnd l -> LocalChat l
CDLocalRcv l -> LocalChat l
contactChatDeleted :: ChatDirection c d -> Bool
contactChatDeleted = \case
CDDirectSnd Contact {chatDeleted} -> chatDeleted
CDDirectRcv Contact {chatDeleted} -> chatDeleted
_ -> False
data NewChatItem d = NewChatItem
{ createdByMsgId :: Maybe MessageId,
itemSent :: SMsgDirection d,
src/Simplex/Chat/Migrations/M20240501_chat_deleted.hs
+18
View File
@@ -0,0 +1,18 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20240501_chat_deleted where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20240501_chat_deleted :: Query
m20240501_chat_deleted =
[sql|
ALTER TABLE contacts ADD COLUMN chat_deleted INTEGER NOT NULL DEFAULT 0;
|]
down_m20240501_chat_deleted :: Query
down_m20240501_chat_deleted =
[sql|
ALTER TABLE contacts DROP COLUMN chat_deleted;
|]
src/Simplex/Chat/Migrations/chat_schema.sql
+1
View File
@@ -76,6 +76,7 @@ CREATE TABLE contacts(
contact_status TEXT NOT NULL DEFAULT 'active',
custom_data BLOB,
ui_themes TEXT,
chat_deleted INTEGER NOT NULL DEFAULT 0,
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE
src/Simplex/Chat/Store/Connections.hs
+3 -3
View File
@@ -98,19 +98,19 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
[sql|
SELECT
c.contact_profile_id, c.local_display_name, c.via_group, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, c.contact_used, c.contact_status, c.enable_ntfs, c.send_rcpts, c.favorite,
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.contact_group_member_id, c.contact_grp_inv_sent, c.ui_themes, c.custom_data
p.preferences, c.user_preferences, c.created_at, c.updated_at, c.chat_ts, c.contact_group_member_id, c.contact_grp_inv_sent, c.ui_themes, c.chat_deleted, c.custom_data
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 -> [ContactRow'] -> Either StoreError Contact
toContact' contactId conn [(profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, uiThemes, customData)] =
toContact' contactId conn [(profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (contactGroupMemberId, contactGrpInvSent, uiThemes, chatDeleted, customData)] =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
activeConn = Just conn
in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, uiThemes, customData}
in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, uiThemes, chatDeleted, customData}
toContact' _ _ _ = Left $ SEInternalError "referenced contact not found"
getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember_ groupMemberId c = ExceptT $ do
src/Simplex/Chat/Store/Direct.hs
+20 -8
View File
@@ -30,7 +30,8 @@ module Simplex.Chat.Store.Direct
getConnReqContactXContactId,
getContactByConnReqHash,
createDirectContact,
deleteContactConnectionsAndFiles,
deleteContactConnections,
deleteContactFiles,
deleteContact,
deleteContactWithoutGroups,
setContactDeleted,
@@ -70,6 +71,7 @@ module Simplex.Chat.Store.Direct
resetContactConnInitiated,
setContactCustomData,
setContactUIThemes,
setContactChatDeleted,
)
where
@@ -178,7 +180,7 @@ getContactByConnReqHash db vr user@User {userId} cReqHash =
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.custom_data,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
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.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
@@ -241,12 +243,13 @@ createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p
chatTs = Just currentTs,
contactGroupMemberId = Nothing,
contactGrpInvSent = False,
customData = Nothing,
uiThemes = Nothing
uiThemes = Nothing,
chatDeleted = False,
customData = Nothing
}
deleteContactConnectionsAndFiles :: DB.Connection -> UserId -> Contact -> IO ()
deleteContactConnectionsAndFiles db userId Contact {contactId} = do
deleteContactConnections :: DB.Connection -> User -> Contact -> IO ()
deleteContactConnections db User {userId} Contact {contactId} = do
DB.execute
db
[sql|
@@ -258,6 +261,9 @@ deleteContactConnectionsAndFiles db userId Contact {contactId} = do
)
|]
(userId, contactId)
deleteContactFiles :: DB.Connection -> User -> Contact -> IO ()
deleteContactFiles db User {userId} Contact {contactId} = do
DB.execute db "DELETE FROM files WHERE user_id = ? AND contact_id = ?" (userId, contactId)
deleteContact :: DB.Connection -> User -> Contact -> ExceptT StoreError IO ()
@@ -600,7 +606,7 @@ createOrUpdateContactRequest db vr user@User {userId} userContactLinkId invId (V
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.custom_data,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
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.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
@@ -764,6 +770,7 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}
contactGroupMemberId = Nothing,
contactGrpInvSent = False,
uiThemes = Nothing,
chatDeleted = False,
customData = Nothing
}
@@ -784,7 +791,7 @@ getContact_ db vr user@User {userId} contactId deleted =
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.custom_data,
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data,
-- Connection
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
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.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
@@ -934,3 +941,8 @@ setContactUIThemes :: DB.Connection -> User -> Contact -> Maybe UIThemeEntityOve
setContactUIThemes db User {userId} Contact {contactId} uiThemes = do
updatedAt <- getCurrentTime
DB.execute db "UPDATE contacts SET ui_themes = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (uiThemes, updatedAt, userId, contactId)
setContactChatDeleted :: DB.Connection -> User -> Contact -> Bool -> IO ()
setContactChatDeleted db User {userId} Contact {contactId} chatDeleted = do
updatedAt <- getCurrentTime
DB.execute db "UPDATE contacts SET chat_deleted = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (chatDeleted, updatedAt, userId, contactId)
src/Simplex/Chat/Store/Groups.hs
+2 -2
View File
@@ -1960,7 +1960,7 @@ createMemberContact
authErrCounter = 0
}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, uiThemes = Nothing, customData = Nothing}
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, uiThemes = Nothing, chatDeleted = False, customData = Nothing}
getMemberContact :: DB.Connection -> VersionRangeChat -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
getMemberContact db vr user contactId = do
@@ -1997,7 +1997,7 @@ createMemberContactInvited
contactId <- createContactUpdateMember currentTs userPreferences
ctConn <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False, uiThemes = Nothing, customData = Nothing}
mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False, uiThemes = Nothing, chatDeleted = False, customData = Nothing}
m' = m {memberContactId = Just contactId}
pure (mCt', m')
where
src/Simplex/Chat/Store/Messages.hs
+1 -1
View File
@@ -315,7 +315,7 @@ updateChatTs db User {userId} chatDirection chatTs = case toChatInfo chatDirecti
DirectChat Contact {contactId} ->
DB.execute
db
"UPDATE contacts SET chat_ts = ? WHERE user_id = ? AND contact_id = ?"
"UPDATE contacts SET chat_ts = ?, chat_deleted = 0 WHERE user_id = ? AND contact_id = ?"
(chatTs, userId, contactId)
GroupChat GroupInfo {groupId} ->
DB.execute
src/Simplex/Chat/Store/Migrations.hs
+3 -1
View File
@@ -106,6 +106,7 @@ import Simplex.Chat.Migrations.M20240313_drop_agent_ack_cmd_id
import Simplex.Chat.Migrations.M20240324_custom_data
import Simplex.Chat.Migrations.M20240402_item_forwarded
import Simplex.Chat.Migrations.M20240430_ui_theme
import Simplex.Chat.Migrations.M20240501_chat_deleted
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@@ -211,7 +212,8 @@ schemaMigrations =
("20240313_drop_agent_ack_cmd_id", m20240313_drop_agent_ack_cmd_id, Just down_m20240313_drop_agent_ack_cmd_id),
("20240324_custom_data", m20240324_custom_data, Just down_m20240324_custom_data),
("20240402_item_forwarded", m20240402_item_forwarded, Just down_m20240402_item_forwarded),
("20240430_ui_theme", m20240430_ui_theme, Just down_m20240430_ui_theme)
("20240430_ui_theme", m20240430_ui_theme, Just down_m20240430_ui_theme),
("20240501_chat_deleted", m20240501_chat_deleted, Just down_m20240501_chat_deleted)
]
-- | The list of migrations in ascending order by date
src/Simplex/Chat/Store/Shared.hs
+4 -3
View File
@@ -381,18 +381,19 @@ deleteUnusedIncognitoProfileById_ db User {userId} profileId =
|]
[":user_id" := userId, ":profile_id" := profileId]
type ContactRow' = (ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool, ContactStatus) :. (Maybe MsgFilter, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool, Maybe UIThemeEntityOverrides, Maybe CustomData)
type ContactRow' = (ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool, ContactStatus) :. (Maybe MsgFilter, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) :. (Maybe GroupMemberId, Bool, Maybe UIThemeEntityOverrides, Bool, Maybe CustomData)
type ContactRow = Only ContactId :. ContactRow'
toContact :: VersionRangeChat -> User -> ContactRow :. MaybeConnectionRow -> Contact
toContact vr user ((Only contactId :. (profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, uiThemes, customData)) :. connRow) =
toContact vr user ((Only contactId :. (profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. (contactGroupMemberId, contactGrpInvSent, uiThemes, chatDeleted, customData)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
activeConn = toMaybeConnection vr connRow
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
incognito = maybe False connIncognito activeConn
mergedPreferences = contactUserPreferences user userPreferences preferences incognito
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, uiThemes, customData}
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, uiThemes, chatDeleted, customData}
getProfileById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalProfile
getProfileById db userId profileId =
src/Simplex/Chat/Types.hs
+6 -6
View File
@@ -27,7 +27,6 @@ import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.Aeson as J
import qualified Data.Aeson.Encoding as JE
import qualified Data.Aeson.TH as JQ
import qualified Data.Aeson.Types as JT
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.ByteString.Char8 (ByteString, pack, unpack)
import Data.Int (Int64)
@@ -178,6 +177,7 @@ data Contact = Contact
contactGroupMemberId :: Maybe GroupMemberId,
contactGrpInvSent :: Bool,
uiThemes :: Maybe UIThemeEntityOverrides,
chatDeleted :: Bool,
customData :: Maybe CustomData
}
deriving (Eq, Show)
@@ -227,7 +227,7 @@ contactActive :: Contact -> Bool
contactActive Contact {contactStatus} = contactStatus == CSActive
contactDeleted :: Contact -> Bool
contactDeleted Contact {contactStatus} = contactStatus == CSDeleted
contactDeleted Contact {contactStatus} = contactStatus == CSDeleted || contactStatus == CSDeletedByUser
contactSecurityCode :: Contact -> Maybe SecurityCode
contactSecurityCode Contact {activeConn} = connectionCode =<< activeConn
@@ -237,7 +237,8 @@ contactPQEnabled Contact {activeConn} = maybe PQEncOff connPQEnabled activeConn
data ContactStatus
= CSActive
| CSDeleted -- contact deleted by contact
| CSDeleted
| CSDeletedByUser
deriving (Eq, Show, Ord)
instance FromField ContactStatus where fromField = fromTextField_ textDecode
@@ -255,10 +256,12 @@ instance TextEncoding ContactStatus where
textDecode = \case
"active" -> Just CSActive
"deleted" -> Just CSDeleted
"deletedByUser" -> Just CSDeletedByUser
_ -> Nothing
textEncode = \case
CSActive -> "active"
CSDeleted -> "deleted"
CSDeletedByUser -> "deletedByUser"
data ContactRef = ContactRef
{ contactId :: ContactId,
@@ -1480,9 +1483,6 @@ serializeIntroStatus = \case
GMIntroToConnected -> "to-con"
GMIntroConnected -> "con"
textParseJSON :: TextEncoding a => String -> J.Value -> JT.Parser a
textParseJSON name = J.withText name $ maybe (fail $ "bad " <> name) pure . textDecode
data NetworkStatus
= NSUnknown
| NSConnected
src/Simplex/Chat/Types/UITheme.hs
+61 -55
View File
@@ -7,26 +7,21 @@ module Simplex.Chat.Types.UITheme where
import Data.Aeson (FromJSON (..), ToJSON (..))
import qualified Data.Aeson as J
import qualified Data.Aeson.Encoding as JE
import qualified Data.Aeson.Key as JK
import qualified Data.Aeson.TH as JQ
import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.Char (toLower)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Database.SQLite.Simple.FromField (FromField (..))
import Database.SQLite.Simple.ToField (ToField (..))
import Simplex.Chat.Types.Util
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_)
import Simplex.Messaging.Util ((<$?>))
data UIThemes = UIThemes
{ light :: Maybe UITheme,
dark :: Maybe UITheme,
simplex :: Maybe UITheme
}
deriving (Eq, Show)
data UITheme = UITheme
{ base :: ThemeColorScheme,
{ themeId :: Text,
base :: ThemeColorScheme,
wallpaper :: Maybe ChatWallpaper,
colors :: UIColors
}
@@ -48,40 +43,72 @@ data UIThemeEntityOverride = UIThemeEntityOverride
}
deriving (Eq, Show)
data ThemeColorScheme = TCSLight | TCSDark | TCSSimplex
deriving (Eq, Show)
data DarkColorScheme = DCSDark | DCSBlack | DCSSimplex
deriving (Eq, Ord, Show)
data UIColorScheme
= UCSSystem
| UCSLight
| UCSDark
| UCSSimplex
deriving (Show)
data ThemeColorScheme = TCSLight | TCSDark DarkColorScheme
deriving (Eq, Ord, Show)
data DarkColorScheme = DCSDark | DCSSimplex
deriving (Show)
data UIColorScheme = UCSSystem | UCSFixed ThemeColorScheme
deriving (Eq, Ord, Show)
instance StrEncoding ThemeColorScheme where
strEncode = \case
instance TextEncoding DarkColorScheme where
textEncode = \case
DCSDark -> "DARK"
DCSBlack -> "BLACK"
DCSSimplex -> "SIMPLEX"
textDecode s =
Just $ case s of
"DARK" -> DCSDark
"BLACK" -> DCSBlack
"SIMPLEX" -> DCSSimplex
_ -> DCSDark
instance TextEncoding ThemeColorScheme where
textEncode = \case
TCSLight -> "LIGHT"
TCSDark -> "DARK"
TCSSimplex -> "SIMPLEX"
strDecode = \case
"LIGHT" -> Right TCSLight
"DARK" -> Right TCSDark
"SIMPLEX" -> Right TCSSimplex
_ -> Left "bad ColorScheme"
strP = strDecode <$?> A.takeTill (== ' ')
TCSDark s -> textEncode s
textDecode = \case
"LIGHT" -> Just TCSLight
s -> TCSDark <$> textDecode s
instance TextEncoding UIColorScheme where
textEncode = \case
UCSSystem -> "SYSTEM"
UCSFixed s -> textEncode s
textDecode = \case
"SYSTEM" -> Just UCSSystem
s -> UCSFixed <$> textDecode s
instance FromJSON DarkColorScheme where
parseJSON = textParseJSON "DarkColorScheme"
instance ToJSON DarkColorScheme where
toJSON = J.String . textEncode
toEncoding = JE.text . textEncode
instance FromJSON ThemeColorScheme where
parseJSON = strParseJSON "ThemeColorScheme"
parseJSON = textParseJSON "ThemeColorScheme"
instance ToJSON ThemeColorScheme where
toJSON = strToJSON
toEncoding = strToJEncoding
toJSON = J.String . textEncode
toEncoding = JE.text . textEncode
instance FromJSON UIColorScheme where
parseJSON = textParseJSON "UIColorScheme"
instance ToJSON UIColorScheme where
toJSON = J.String . textEncode
toEncoding = JE.text . textEncode
instance J.FromJSONKey ThemeColorScheme where
fromJSONKey = J.FromJSONKeyText $ fromMaybe (TCSDark DCSDark) . textDecode
instance J.ToJSONKey ThemeColorScheme where
toJSONKey = J.ToJSONKeyText (JK.fromText . textEncode) (JE.text . textEncode)
data ChatWallpaper = ChatWallpaper
{ preset :: Maybe ChatWallpaperPreset,
{ preset :: Maybe Text,
imageFile :: Maybe FilePath,
background :: Maybe UIColor,
tint :: Maybe UIColor,
@@ -109,19 +136,6 @@ data UIColors = UIColors
defaultUIColors :: UIColors
defaultUIColors = UIColors Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
data ChatWallpaperPreset
= CWPKids
| CWPCats
| CWPPets
| CWPFlowers
| CWPHearts
| CWPSocial
| CWPTravel
| CWPInternet
| CWPSpace
| CWPSchool
deriving (Eq, Show)
newtype UIColor = UIColor String
deriving (Eq, Show)
@@ -137,16 +151,10 @@ instance ToJSON UIColor where
toJSON (UIColor t) = J.toJSON t
toEncoding (UIColor t) = J.toEncoding t
$(JQ.deriveJSON (enumJSON $ dropPrefix "DCS") ''DarkColorScheme)
$(JQ.deriveJSON (enumJSON $ dropPrefix "UCM") ''UIColorMode)
$(JQ.deriveJSON (enumJSON $ dropPrefix "UCS") ''UIColorScheme)
$(JQ.deriveJSON (enumJSON $ dropPrefix "CWS") ''ChatWallpaperScale)
$(JQ.deriveJSON (enumJSON $ dropPrefix "CWP") ''ChatWallpaperPreset)
$(JQ.deriveJSON defaultJSON ''ChatWallpaper)
$(JQ.deriveJSON defaultJSON ''UIColors)
@@ -157,8 +165,6 @@ $(JQ.deriveJSON defaultJSON ''UIThemeEntityOverrides)
$(JQ.deriveJSON defaultJSON ''UITheme)
$(JQ.deriveJSON defaultJSON ''UIThemes)
instance ToField UIThemeEntityOverrides where
toField = toField . encodeJSON
src/Simplex/Chat/Types/Util.hs
+5
View File
@@ -4,6 +4,7 @@ module Simplex.Chat.Types.Util where
import Data.Aeson (FromJSON, ToJSON)
import qualified Data.Aeson as J
import qualified Data.Aeson.Types as JT
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Text (Text)
@@ -13,6 +14,7 @@ import Database.SQLite.Simple (ResultError (..), SQLData (..))
import Database.SQLite.Simple.FromField (FieldParser, returnError)
import Database.SQLite.Simple.Internal (Field (..))
import Database.SQLite.Simple.Ok (Ok (Ok))
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Util (safeDecodeUtf8)
encodeJSON :: ToJSON a => a -> Text
@@ -21,6 +23,9 @@ encodeJSON = safeDecodeUtf8 . LB.toStrict . J.encode
decodeJSON :: FromJSON a => Text -> Maybe a
decodeJSON = J.decode . LB.fromStrict . encodeUtf8
textParseJSON :: TextEncoding a => String -> J.Value -> JT.Parser a
textParseJSON name = J.withText name $ maybe (fail $ "bad " <> name) pure . textDecode
fromBlobField_ :: Typeable k => (ByteString -> Either String k) -> FieldParser k
fromBlobField_ p = \case
f@(Field (SQLBlob b) _) ->
src/Simplex/Chat/View.hs
+5 -4
View File
@@ -51,7 +51,7 @@ import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.UITheme
import qualified Simplex.FileTransfer.Transport as XFTPTransport
import qualified Simplex.FileTransfer.Transport as XFTP
import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), SubscriptionsInfo (..))
import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..))
import Simplex.Messaging.Agent.Protocol
@@ -375,6 +375,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
[ "agent workers details:",
plain . LB.unpack $ J.encode agentWorkersDetails -- this would be huge, but copypastable when has its own line
]
CRAgentMsgCounts {msgCounts} -> ["received messages (total, duplicates):", plain . LB.unpack $ J.encode msgCounts]
CRConnectionDisabled entity -> viewConnectionEntityDisabled entity
CRAgentRcvQueueDeleted acId srv aqId err_ ->
[ ("completed deleting rcv queue, agent connection id: " <> sShow acId)
@@ -1179,8 +1180,8 @@ viewServerTestResult :: AProtoServerWithAuth -> Maybe ProtocolTestFailure -> [St
viewServerTestResult (AProtoServerWithAuth p _) = \case
Just ProtocolTestFailure {testStep, testError} ->
result
<> [pName <> " server requires authorization to create queues, check password" | testStep == TSCreateQueue && testError == SMP SMP.AUTH]
<> [pName <> " server requires authorization to upload files, check password" | testStep == TSCreateFile && testError == XFTP XFTPTransport.AUTH]
<> [pName <> " server requires authorization to create queues, check password" | testStep == TSCreateQueue && (case testError of SMP _ SMP.AUTH -> True; _ -> False)]
<> [pName <> " server requires authorization to upload files, check password" | testStep == TSCreateFile && (case testError of XFTP _ XFTP.AUTH -> True; _ -> False)]
<> ["Possibly, certificate fingerprint in " <> pName <> " server address is incorrect" | testStep == TSConnect && brokerErr]
where
result = [pName <> " server test failed at " <> plain (drop 2 $ show testStep) <> ", error: " <> plain (strEncode testError)]
@@ -2025,7 +2026,7 @@ viewChatError logLevel testView = \case
e -> ["chat database error: " <> sShow e]
ChatErrorAgent err entity_ -> case err of
CMD PROHIBITED -> [withConnEntity <> "error: command is prohibited"]
SMP SMP.AUTH ->
SMP _ SMP.AUTH ->
[ withConnEntity
<> "error: connection authorization failed - this could happen if connection was deleted,\
\ secured with different credentials, or due to a bug - please re-create the connection"
tests/ChatTests/Direct.hs
+44 -4
View File
@@ -37,6 +37,8 @@ chatDirectTests = do
describe "add contact and send/receive messages" testAddContact
it "clear chat with contact" testContactClear
it "deleting contact deletes profile" testDeleteContactDeletesProfile
it "delete contact keeping conversation" testDeleteContactKeepConversation
it "delete conversation keeping contact" testDeleteConversationKeepContact
it "unused contact is deleted silently" testDeleteUnusedContactSilent
it "direct message quoted replies" testDirectMessageQuotedReply
it "direct message update" testDirectMessageUpdate
@@ -185,9 +187,10 @@ testAddContact = versionTestMatrix2 runTestAddContact
bob #$> ("/_read chat @2", id, "ok")
alice #$> ("/read user", id, "ok")
alice #$> ("/_read user 1", id, "ok")
features = if pqExpected
then chatFeatures
else (0, e2eeInfoNoPQStr) : tail chatFeatures
features =
if pqExpected
then chatFeatures
else (0, e2eeInfoNoPQStr) : tail chatFeatures
testDuplicateContactsSeparate :: HasCallStack => FilePath -> IO ()
testDuplicateContactsSeparate =
@@ -343,7 +346,7 @@ testDeleteContactDeletesProfile =
connectUsers alice bob
alice <##> bob
-- alice deletes contact, profile is deleted
alice ##> "/d bob"
alice ##> "/_delete @2 full notify=on"
alice <## "bob: contact is deleted"
bob <## "alice (Alice) deleted contact with you"
alice ##> "/_contacts 1"
@@ -356,6 +359,43 @@ testDeleteContactDeletesProfile =
(bob </)
bob `hasContactProfiles` ["bob"]
testDeleteContactKeepConversation :: HasCallStack => FilePath -> IO ()
testDeleteContactKeepConversation =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice <##> bob
alice ##> "/_delete @2 entity notify=on"
alice <## "bob: contact is deleted"
bob <## "alice (Alice) deleted contact with you"
alice @@@ [("@bob", "hey")]
alice ##> "@bob hi"
alice <## "bob: not ready"
bob @@@ [("@alice", "contact deleted")]
bob ##> "@alice hey"
bob <## "alice: not ready"
testDeleteConversationKeepContact :: HasCallStack => FilePath -> IO ()
testDeleteConversationKeepContact =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice <##> bob
alice @@@ [("@bob", "hey")]
alice ##> "/_delete @2 messages"
alice <## "bob: contact is deleted"
alice @@@ [("@bob", "")] -- UI would filter
bob @@@ [("@alice", "hey")]
bob #> "@alice hi"
alice <# "bob> hi"
alice @@@ [("@bob", "hi")]
alice <##> bob
testDeleteUnusedContactSilent :: HasCallStack => FilePath -> IO ()
testDeleteUnusedContactSilent =
testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $
tests/ChatTests/Groups.hs
+4 -2
View File
@@ -69,7 +69,7 @@ chatGroupTests = do
it "group is known if host contact was deleted" testPlanHostContactDeletedGroupLinkKnown
it "own group link" testPlanGroupLinkOwn
it "connecting via group link" testPlanGroupLinkConnecting
it "re-join existing group after leaving" testPlanGroupLinkLeaveRejoin
xit "re-join existing group after leaving" testPlanGroupLinkLeaveRejoin
describe "group links without contact" $ do
it "join via group link without creating contact" testGroupLinkNoContact
it "invitees were previously connected as contacts" testGroupLinkNoContactInviteesWereConnected
@@ -2621,7 +2621,9 @@ testPlanGroupLinkConnecting tmp = do
testPlanGroupLinkLeaveRejoin :: HasCallStack => FilePath -> IO ()
testPlanGroupLinkLeaveRejoin =
testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $
\alice bob -> do
\a b -> do
let alice = a {printOutput = True}
bob = b {printOutput = True}
alice ##> "/g team"
alice <## "group #team is created"
alice <## "to add members use /a team <name> or /create link #team"
website/langs/en.json
+1 -1
View File
@@ -251,7 +251,7 @@
"signing-key-fingerprint": "Signing key fingerprint (SHA-256)",
"f-droid-org-repo": "F-Droid.org repo",
"stable-versions-built-by-f-droid-org": "Stable versions built by F-Droid.org",
"releases-to-this-repo-are-done-1-2-days-later": "The releases to this repo are done 1-2 days later",
"releases-to-this-repo-are-done-1-2-days-later": "The releases to this repo are done several days later",
"f-droid-page-f-droid-org-repo-section-text": "SimpleX Chat and F-Droid.org repositories sign builds with the different keys. To switch, please <a href='/docs/guide/chat-profiles.html#move-your-chat-profiles-to-another-device'>export</a> the chat database and re-install the app.",
"jobs": "Join team",
"please-enable-javascript": "Please enable JavaScript to see the QR code.",