mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-03-14 09:45:42 +00:00
core: wallpapers api (#4110)
* core: wallpapers api * optional colors * update * api * update * whitespace * typo * test, fix * fix color parsing * separate UI and Theme color schemes * update * enable test * multiple themes, one per color scheme * theme overrides as a separate type * rename --------- Co-authored-by: Avently <7953703+avently@users.noreply.github.com>
This commit is contained in:
Evgeny Poberezkin
GitHub
parent
e38d5bd885
commit
bc5af35a3e
17 changed files with 484 additions and 73 deletions
|
|
@ -141,6 +141,7 @@ library
|
|||
Simplex.Chat.Migrations.M20240313_drop_agent_ack_cmd_id
|
||||
Simplex.Chat.Migrations.M20240324_custom_data
|
||||
Simplex.Chat.Migrations.M20240402_item_forwarded
|
||||
Simplex.Chat.Migrations.M20240430_ui_theme
|
||||
Simplex.Chat.Mobile
|
||||
Simplex.Chat.Mobile.File
|
||||
Simplex.Chat.Mobile.Shared
|
||||
|
|
@ -176,6 +177,7 @@ library
|
|||
Simplex.Chat.Types
|
||||
Simplex.Chat.Types.Preferences
|
||||
Simplex.Chat.Types.Shared
|
||||
Simplex.Chat.Types.UITheme
|
||||
Simplex.Chat.Types.Util
|
||||
Simplex.Chat.Util
|
||||
Simplex.Chat.View
|
||||
|
|
|
|||
|
|
@ -249,6 +249,7 @@ newChatController
|
|||
showLiveItems <- newTVarIO False
|
||||
encryptLocalFiles <- newTVarIO False
|
||||
tempDirectory <- newTVarIO optTempDirectory
|
||||
assetsDirectory <- newTVarIO Nothing
|
||||
contactMergeEnabled <- newTVarIO True
|
||||
pure
|
||||
ChatController
|
||||
|
|
@ -285,6 +286,7 @@ newChatController
|
|||
showLiveItems,
|
||||
encryptLocalFiles,
|
||||
tempDirectory,
|
||||
assetsDirectory,
|
||||
logFilePath = logFile,
|
||||
contactMergeEnabled
|
||||
}
|
||||
|
|
@ -630,6 +632,17 @@ processChatCommand' vr = \case
|
|||
createDirectoryIfMissing True rf
|
||||
chatWriteVar remoteHostsFolder $ Just rf
|
||||
ok_
|
||||
-- has to be called before StartChat
|
||||
APISetAppFilePaths cfg -> do
|
||||
setFolder filesFolder $ appFilesFolder cfg
|
||||
setFolder tempDirectory $ appTempFolder cfg
|
||||
setFolder assetsDirectory $ appAssetsFolder cfg
|
||||
mapM_ (setFolder remoteHostsFolder) $ appRemoteHostsFolder cfg
|
||||
ok_
|
||||
where
|
||||
setFolder sel f = do
|
||||
createDirectoryIfMissing True f
|
||||
chatWriteVar sel $ Just f
|
||||
APISetEncryptLocalFiles on -> chatWriteVar encryptLocalFiles on >> ok_
|
||||
SetContactMergeEnabled onOff -> chatWriteVar contactMergeEnabled onOff >> ok_
|
||||
APIExportArchive cfg -> checkChatStopped $ lift (exportArchive cfg) >> ok_
|
||||
|
|
@ -1226,6 +1239,25 @@ processChatCommand' vr = \case
|
|||
conn <- getPendingContactConnection db userId connId
|
||||
liftIO $ updateContactConnectionAlias db userId conn localAlias
|
||||
pure $ CRConnectionAliasUpdated user conn'
|
||||
APISetUserUIThemes uId uiThemes -> withUser $ \user@User {userId} -> do
|
||||
user'@User {userId = uId'} <- withStore $ \db -> do
|
||||
user' <- getUser db uId
|
||||
liftIO $ setUserUIThemes db user uiThemes
|
||||
pure user'
|
||||
when (userId == uId') $ chatWriteVar currentUser $ Just (user :: User) {uiThemes}
|
||||
ok user'
|
||||
APISetChatUIThemes (ChatRef cType chatId) uiThemes -> withUser $ \user -> case cType of
|
||||
CTDirect -> do
|
||||
withStore $ \db -> do
|
||||
ct <- getContact db vr user chatId
|
||||
liftIO $ setContactUIThemes db user ct uiThemes
|
||||
ok user
|
||||
CTGroup -> do
|
||||
withStore $ \db -> do
|
||||
g <- getGroupInfo db vr user chatId
|
||||
liftIO $ setGroupUIThemes db user g uiThemes
|
||||
ok user
|
||||
_ -> pure $ chatCmdError (Just user) "not supported"
|
||||
APIParseMarkdown text -> pure . CRApiParsedMarkdown $ parseMaybeMarkdownList text
|
||||
APIGetNtfToken -> withUser $ \_ -> crNtfToken <$> withAgent getNtfToken
|
||||
APIRegisterToken token mode -> withUser $ \_ ->
|
||||
|
|
@ -3591,7 +3623,7 @@ processAgentMessageNoConn = \case
|
|||
processAgentMsgSndFile :: ACorrId -> SndFileId -> ACommand 'Agent 'AESndFile -> CM ()
|
||||
processAgentMsgSndFile _corrId aFileId msg = do
|
||||
(cRef_, fileId) <- withStore (`getXFTPSndFileDBIds` AgentSndFileId aFileId)
|
||||
withEntityLock_ cRef_ $ withFileLock "processAgentMsgSndFile" fileId $
|
||||
withEntityLock_ cRef_ . withFileLock "processAgentMsgSndFile" fileId $
|
||||
withStore' (`getUserByASndFileId` AgentSndFileId aFileId) >>= \case
|
||||
Just user -> process user fileId `catchChatError` (toView . CRChatError (Just user))
|
||||
_ -> do
|
||||
|
|
@ -3718,7 +3750,7 @@ splitFileDescr rfdText = do
|
|||
processAgentMsgRcvFile :: ACorrId -> RcvFileId -> ACommand 'Agent 'AERcvFile -> CM ()
|
||||
processAgentMsgRcvFile _corrId aFileId msg = do
|
||||
(cRef_, fileId) <- withStore (`getXFTPRcvFileDBIds` AgentRcvFileId aFileId)
|
||||
withEntityLock_ cRef_ $ withFileLock "processAgentMsgRcvFile" fileId $
|
||||
withEntityLock_ cRef_ . withFileLock "processAgentMsgRcvFile" fileId $
|
||||
withStore' (`getUserByARcvFileId` AgentRcvFileId aFileId) >>= \case
|
||||
Just user -> process user fileId `catchChatError` (toView . CRChatError (Just user))
|
||||
_ -> do
|
||||
|
|
@ -7028,9 +7060,13 @@ chatCommandP =
|
|||
"/_app activate" $> APIActivateChat True,
|
||||
"/_app suspend " *> (APISuspendChat <$> A.decimal),
|
||||
"/_resubscribe all" $> ResubscribeAllConnections,
|
||||
-- deprecated, use /set file paths
|
||||
"/_temp_folder " *> (SetTempFolder <$> filePath),
|
||||
-- /_files_folder deprecated, use /set file paths
|
||||
("/_files_folder " <|> "/files_folder ") *> (SetFilesFolder <$> filePath),
|
||||
-- deprecated, use /set file paths
|
||||
"/remote_hosts_folder " *> (SetRemoteHostsFolder <$> filePath),
|
||||
"/set file paths " *> (APISetAppFilePaths <$> jsonP),
|
||||
"/_files_encrypt " *> (APISetEncryptLocalFiles <$> onOffP),
|
||||
"/contact_merge " *> (SetContactMergeEnabled <$> onOffP),
|
||||
"/_db export " *> (APIExportArchive <$> jsonP),
|
||||
|
|
@ -7086,6 +7122,8 @@ chatCommandP =
|
|||
"/_set alias @" *> (APISetContactAlias <$> A.decimal <*> (A.space *> textP <|> pure "")),
|
||||
"/_set alias :" *> (APISetConnectionAlias <$> A.decimal <*> (A.space *> textP <|> pure "")),
|
||||
"/_set prefs @" *> (APISetContactPrefs <$> A.decimal <* A.space <*> jsonP),
|
||||
"/_set theme user " *> (APISetUserUIThemes <$> A.decimal <*> optional (A.space *> jsonP)),
|
||||
"/_set theme " *> (APISetChatUIThemes <$> chatRefP <*> optional (A.space *> jsonP)),
|
||||
"/_parse " *> (APIParseMarkdown . safeDecodeUtf8 <$> A.takeByteString),
|
||||
"/_ntf get" $> APIGetNtfToken,
|
||||
"/_ntf register " *> (APIRegisterToken <$> strP_ <*> strP),
|
||||
|
|
|
|||
|
|
@ -11,6 +11,7 @@ import qualified Data.Aeson as J
|
|||
import qualified Data.Aeson.TH as JQ
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import Simplex.Chat.Types.UITheme
|
||||
import Simplex.Messaging.Client (NetworkConfig, defaultNetworkConfig)
|
||||
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)
|
||||
import Simplex.Messaging.Util (catchAll_)
|
||||
|
|
@ -43,7 +44,11 @@ data AppSettings = AppSettings
|
|||
confirmDBUpgrades :: Maybe Bool,
|
||||
androidCallOnLockScreen :: Maybe LockScreenCalls,
|
||||
iosCallKitEnabled :: Maybe Bool,
|
||||
iosCallKitCallsInRecents :: Maybe Bool
|
||||
iosCallKitCallsInRecents :: Maybe Bool,
|
||||
uiProfileImageCornerRadius :: Maybe Double,
|
||||
uiColorScheme :: Maybe UIColorScheme,
|
||||
uiDarkColorScheme :: Maybe DarkColorScheme,
|
||||
uiThemes :: Maybe UIThemes
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
|
|
@ -69,7 +74,11 @@ defaultAppSettings =
|
|||
confirmDBUpgrades = Just False,
|
||||
androidCallOnLockScreen = Just LSCShow,
|
||||
iosCallKitEnabled = Just True,
|
||||
iosCallKitCallsInRecents = Just False
|
||||
iosCallKitCallsInRecents = Just False,
|
||||
uiProfileImageCornerRadius = Just 22.5,
|
||||
uiColorScheme = Just UCSSystem,
|
||||
uiDarkColorScheme = Just DCSSimplex,
|
||||
uiThemes = Nothing
|
||||
}
|
||||
|
||||
defaultParseAppSettings :: AppSettings
|
||||
|
|
@ -94,13 +103,17 @@ defaultParseAppSettings =
|
|||
confirmDBUpgrades = Nothing,
|
||||
androidCallOnLockScreen = Nothing,
|
||||
iosCallKitEnabled = Nothing,
|
||||
iosCallKitCallsInRecents = Nothing
|
||||
iosCallKitCallsInRecents = Nothing,
|
||||
uiProfileImageCornerRadius = Nothing,
|
||||
uiColorScheme = Nothing,
|
||||
uiDarkColorScheme = Nothing,
|
||||
uiThemes = Nothing
|
||||
}
|
||||
|
||||
combineAppSettings :: AppSettings -> AppSettings -> AppSettings
|
||||
combineAppSettings platformDefaults storedSettings =
|
||||
AppSettings
|
||||
{ appPlatform = p appPlatform,
|
||||
{ appPlatform = p appPlatform,
|
||||
networkConfig = p networkConfig,
|
||||
privacyEncryptLocalFiles = p privacyEncryptLocalFiles,
|
||||
privacyAcceptImages = p privacyAcceptImages,
|
||||
|
|
@ -119,7 +132,11 @@ combineAppSettings platformDefaults storedSettings =
|
|||
confirmDBUpgrades = p confirmDBUpgrades,
|
||||
iosCallKitEnabled = p iosCallKitEnabled,
|
||||
iosCallKitCallsInRecents = p iosCallKitCallsInRecents,
|
||||
androidCallOnLockScreen = p androidCallOnLockScreen
|
||||
androidCallOnLockScreen = p androidCallOnLockScreen,
|
||||
uiProfileImageCornerRadius = p uiProfileImageCornerRadius,
|
||||
uiColorScheme = p uiColorScheme,
|
||||
uiDarkColorScheme = p uiDarkColorScheme,
|
||||
uiThemes = p uiThemes
|
||||
}
|
||||
where
|
||||
p :: (AppSettings -> Maybe a) -> Maybe a
|
||||
|
|
@ -157,6 +174,10 @@ instance FromJSON AppSettings where
|
|||
iosCallKitEnabled <- p "iosCallKitEnabled"
|
||||
iosCallKitCallsInRecents <- p "iosCallKitCallsInRecents"
|
||||
androidCallOnLockScreen <- p "androidCallOnLockScreen"
|
||||
uiProfileImageCornerRadius <- p "uiProfileImageCornerRadius"
|
||||
uiColorScheme <- p "uiColorScheme"
|
||||
uiDarkColorScheme <- p "uiDarkColorScheme"
|
||||
uiThemes <- p "uiThemes"
|
||||
pure
|
||||
AppSettings
|
||||
{ appPlatform,
|
||||
|
|
@ -178,7 +199,11 @@ instance FromJSON AppSettings where
|
|||
confirmDBUpgrades,
|
||||
iosCallKitEnabled,
|
||||
iosCallKitCallsInRecents,
|
||||
androidCallOnLockScreen
|
||||
androidCallOnLockScreen,
|
||||
uiProfileImageCornerRadius,
|
||||
uiColorScheme,
|
||||
uiDarkColorScheme,
|
||||
uiThemes
|
||||
}
|
||||
where
|
||||
p key = v .:? key <|> pure Nothing
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
|
@ -44,14 +45,22 @@ archiveChatDbFile = "simplex_v1_chat.db"
|
|||
archiveFilesFolder :: String
|
||||
archiveFilesFolder = "simplex_v1_files"
|
||||
|
||||
archiveAssetsFolder :: String
|
||||
archiveAssetsFolder = "simplex_v1_assets"
|
||||
|
||||
wallpapersFolder :: String
|
||||
wallpapersFolder = "wallpapers"
|
||||
|
||||
exportArchive :: ArchiveConfig -> CM' ()
|
||||
exportArchive cfg@ArchiveConfig {archivePath, disableCompression} =
|
||||
withTempDir cfg "simplex-chat." $ \dir -> do
|
||||
StorageFiles {chatStore, agentStore, filesPath} <- storageFiles
|
||||
StorageFiles {chatStore, agentStore, filesPath, assetsPath} <- storageFiles
|
||||
copyFile (dbFilePath chatStore) $ dir </> archiveChatDbFile
|
||||
copyFile (dbFilePath agentStore) $ dir </> archiveAgentDbFile
|
||||
forM_ filesPath $ \fp ->
|
||||
copyDirectoryFiles fp $ dir </> archiveFilesFolder
|
||||
forM_ assetsPath $ \fp ->
|
||||
copyDirectoryFiles (fp </> wallpapersFolder) $ dir </> archiveAssetsFolder </> wallpapersFolder
|
||||
let method = if disableCompression == Just True then Z.Store else Z.Deflate
|
||||
Z.createArchive archivePath $ Z.packDirRecur method Z.mkEntrySelector dir
|
||||
|
||||
|
|
@ -59,24 +68,24 @@ importArchive :: ArchiveConfig -> CM' [ArchiveError]
|
|||
importArchive cfg@ArchiveConfig {archivePath} =
|
||||
withTempDir cfg "simplex-chat." $ \dir -> do
|
||||
Z.withArchive archivePath $ Z.unpackInto dir
|
||||
fs@StorageFiles {chatStore, agentStore, filesPath} <- storageFiles
|
||||
fs@StorageFiles {chatStore, agentStore, filesPath, assetsPath} <- storageFiles
|
||||
liftIO $ closeSQLiteStore `withStores` fs
|
||||
backup `withDBs` fs
|
||||
copyFile (dir </> archiveChatDbFile) $ dbFilePath chatStore
|
||||
copyFile (dir </> archiveAgentDbFile) $ dbFilePath agentStore
|
||||
copyFiles dir filesPath
|
||||
`E.catch` \(e :: E.SomeException) -> pure [AEImport . ChatError . CEException $ show e]
|
||||
errs <- copyFiles (dir </> archiveFilesFolder) filesPath
|
||||
errs' <- copyFiles (dir </> archiveAssetsFolder </> wallpapersFolder) ((</> wallpapersFolder) <$> assetsPath)
|
||||
pure $ errs <> errs'
|
||||
where
|
||||
backup f = whenM (doesFileExist f) $ copyFile f $ f <> ".bak"
|
||||
copyFiles dir filesPath = do
|
||||
let filesDir = dir </> archiveFilesFolder
|
||||
case filesPath of
|
||||
Just fp ->
|
||||
ifM
|
||||
(doesDirectoryExist filesDir)
|
||||
(copyDirectoryFiles filesDir fp)
|
||||
(pure [])
|
||||
_ -> pure []
|
||||
copyFiles fromDir = \case
|
||||
Just fp ->
|
||||
ifM
|
||||
(doesDirectoryExist fromDir)
|
||||
(copyDirectoryFiles fromDir fp)
|
||||
(pure [])
|
||||
`E.catch` \(e :: E.SomeException) -> pure [AEImport . ChatError . CEException $ show e]
|
||||
_ -> pure []
|
||||
|
||||
withTempDir :: ArchiveConfig -> (String -> (FilePath -> CM' a) -> CM' a)
|
||||
withTempDir cfg = case parentTempDirectory (cfg :: ArchiveConfig) of
|
||||
|
|
@ -85,7 +94,7 @@ withTempDir cfg = case parentTempDirectory (cfg :: ArchiveConfig) of
|
|||
|
||||
copyDirectoryFiles :: FilePath -> FilePath -> CM' [ArchiveError]
|
||||
copyDirectoryFiles fromDir toDir = do
|
||||
createDirectoryIfMissing False toDir
|
||||
createDirectoryIfMissing True toDir
|
||||
fs <- listDirectory fromDir
|
||||
foldM copyFileCatchError [] fs
|
||||
where
|
||||
|
|
@ -103,6 +112,7 @@ deleteStorage = do
|
|||
liftIO $ closeSQLiteStore `withStores` fs
|
||||
remove `withDBs` fs
|
||||
mapM_ removeDir $ filesPath fs
|
||||
mapM_ removeDir $ assetsPath fs
|
||||
mapM_ removeDir =<< chatReadVar tempDirectory
|
||||
where
|
||||
remove f = whenM (doesFileExist f) $ removeFile f
|
||||
|
|
@ -111,15 +121,17 @@ deleteStorage = do
|
|||
data StorageFiles = StorageFiles
|
||||
{ chatStore :: SQLiteStore,
|
||||
agentStore :: SQLiteStore,
|
||||
filesPath :: Maybe FilePath
|
||||
filesPath :: Maybe FilePath,
|
||||
assetsPath :: Maybe FilePath
|
||||
}
|
||||
|
||||
storageFiles :: CM' StorageFiles
|
||||
storageFiles = do
|
||||
ChatController {chatStore, filesFolder, smpAgent} <- ask
|
||||
ChatController {chatStore, filesFolder, assetsDirectory, smpAgent} <- ask
|
||||
let agentStore = agentClientStore smpAgent
|
||||
filesPath <- readTVarIO filesFolder
|
||||
pure StorageFiles {chatStore, agentStore, filesPath}
|
||||
assetsPath <- readTVarIO assetsDirectory
|
||||
pure StorageFiles {chatStore, agentStore, filesPath, assetsPath}
|
||||
|
||||
sqlCipherExport :: DBEncryptionConfig -> CM ()
|
||||
sqlCipherExport DBEncryptionConfig {currentKey = DBEncryptionKey key, newKey = DBEncryptionKey key', keepKey} =
|
||||
|
|
@ -177,9 +189,9 @@ testSQL k =
|
|||
T.unlines $
|
||||
keySQL k
|
||||
<> [ "PRAGMA foreign_keys = ON;",
|
||||
"PRAGMA secure_delete = ON;",
|
||||
"SELECT count(*) FROM sqlite_master;"
|
||||
]
|
||||
"PRAGMA secure_delete = ON;",
|
||||
"SELECT count(*) FROM sqlite_master;"
|
||||
]
|
||||
|
||||
keySQL :: BA.ScrubbedBytes -> [Text]
|
||||
keySQL k = ["PRAGMA key = " <> keyString k <> ";" | not (BA.null k)]
|
||||
|
|
|
|||
|
|
@ -63,6 +63,7 @@ import Simplex.Chat.Store (AutoAccept, ChatLockEntity, StoreError (..), UserCont
|
|||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Preferences
|
||||
import Simplex.Chat.Types.Shared
|
||||
import Simplex.Chat.Types.UITheme
|
||||
import Simplex.Chat.Util (liftIOEither)
|
||||
import Simplex.FileTransfer.Description (FileDescriptionURI)
|
||||
import Simplex.Messaging.Agent (AgentClient, SubscriptionsInfo)
|
||||
|
|
@ -229,6 +230,7 @@ data ChatController = ChatController
|
|||
showLiveItems :: TVar Bool,
|
||||
encryptLocalFiles :: TVar Bool,
|
||||
tempDirectory :: TVar (Maybe FilePath),
|
||||
assetsDirectory :: TVar (Maybe FilePath),
|
||||
logFilePath :: Maybe FilePath,
|
||||
contactMergeEnabled :: TVar Bool
|
||||
}
|
||||
|
|
@ -265,6 +267,7 @@ data ChatCommand
|
|||
| SetTempFolder FilePath
|
||||
| SetFilesFolder FilePath
|
||||
| SetRemoteHostsFolder FilePath
|
||||
| APISetAppFilePaths AppFilePathsConfig
|
||||
| APISetEncryptLocalFiles Bool
|
||||
| SetContactMergeEnabled Bool
|
||||
| APIExportArchive ArchiveConfig
|
||||
|
|
@ -311,6 +314,8 @@ data ChatCommand
|
|||
| APISetContactPrefs ContactId Preferences
|
||||
| APISetContactAlias ContactId LocalAlias
|
||||
| APISetConnectionAlias Int64 LocalAlias
|
||||
| APISetUserUIThemes UserId (Maybe UIThemeEntityOverrides)
|
||||
| APISetChatUIThemes ChatRef (Maybe UIThemeEntityOverrides)
|
||||
| APIParseMarkdown Text
|
||||
| APIGetNtfToken
|
||||
| APIRegisterToken DeviceToken NotificationsMode
|
||||
|
|
@ -928,6 +933,14 @@ instance StrEncoding DBEncryptionKey where
|
|||
instance FromJSON DBEncryptionKey where
|
||||
parseJSON = strParseJSON "DBEncryptionKey"
|
||||
|
||||
data AppFilePathsConfig = AppFilePathsConfig
|
||||
{ appFilesFolder :: FilePath,
|
||||
appTempFolder :: FilePath,
|
||||
appAssetsFolder :: FilePath,
|
||||
appRemoteHostsFolder :: Maybe FilePath
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data ContactSubStatus = ContactSubStatus
|
||||
{ contact :: Contact,
|
||||
contactError :: Maybe ChatError
|
||||
|
|
@ -1399,6 +1412,8 @@ $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "DB") ''DatabaseError)
|
|||
|
||||
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "Chat") ''ChatError)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''AppFilePathsConfig)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''ContactSubStatus)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''MemberSubStatus)
|
||||
|
|
|
|||
22
src/Simplex/Chat/Migrations/M20240430_ui_theme.hs
Normal file
22
src/Simplex/Chat/Migrations/M20240430_ui_theme.hs
Normal file
|
|
@ -0,0 +1,22 @@
|
|||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20240430_ui_theme where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20240430_ui_theme :: Query
|
||||
m20240430_ui_theme =
|
||||
[sql|
|
||||
ALTER TABLE users ADD COLUMN ui_themes TEXT;
|
||||
ALTER TABLE contacts ADD COLUMN ui_themes TEXT;
|
||||
ALTER TABLE groups ADD COLUMN ui_themes TEXT;
|
||||
|]
|
||||
|
||||
down_m20240430_ui_theme :: Query
|
||||
down_m20240430_ui_theme =
|
||||
[sql|
|
||||
ALTER TABLE users DROP COLUMN ui_themes;
|
||||
ALTER TABLE contacts DROP COLUMN ui_themes;
|
||||
ALTER TABLE groups DROP COLUMN ui_themes;
|
||||
|]
|
||||
|
|
@ -34,7 +34,8 @@ CREATE TABLE users(
|
|||
show_ntfs INTEGER NOT NULL DEFAULT 1,
|
||||
send_rcpts_contacts INTEGER NOT NULL DEFAULT 0,
|
||||
send_rcpts_small_groups INTEGER NOT NULL DEFAULT 0,
|
||||
user_member_profile_updated_at TEXT, -- 1 for active user
|
||||
user_member_profile_updated_at TEXT,
|
||||
ui_themes TEXT, -- 1 for active user
|
||||
FOREIGN KEY(user_id, local_display_name)
|
||||
REFERENCES display_names(user_id, local_display_name)
|
||||
ON DELETE RESTRICT
|
||||
|
|
@ -74,6 +75,7 @@ CREATE TABLE contacts(
|
|||
contact_grp_inv_sent INTEGER NOT NULL DEFAULT 0,
|
||||
contact_status TEXT NOT NULL DEFAULT 'active',
|
||||
custom_data BLOB,
|
||||
ui_themes TEXT,
|
||||
FOREIGN KEY(user_id, local_display_name)
|
||||
REFERENCES display_names(user_id, local_display_name)
|
||||
ON DELETE CASCADE
|
||||
|
|
@ -122,7 +124,8 @@ CREATE TABLE groups(
|
|||
send_rcpts INTEGER,
|
||||
via_group_link_uri_hash BLOB,
|
||||
user_member_profile_sent_at TEXT,
|
||||
custom_data BLOB, -- received
|
||||
custom_data BLOB,
|
||||
ui_themes TEXT, -- received
|
||||
FOREIGN KEY(user_id, local_display_name)
|
||||
REFERENCES display_names(user_id, local_display_name)
|
||||
ON DELETE CASCADE
|
||||
|
|
|
|||
|
|
@ -22,8 +22,6 @@ import Control.Monad
|
|||
import Control.Monad.Except
|
||||
import Data.Int (Int64)
|
||||
import Data.Maybe (catMaybes, fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import Data.Time.Clock (UTCTime (..))
|
||||
import Database.SQLite.Simple (Only (..), (:.) (..))
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
import Simplex.Chat.Protocol
|
||||
|
|
@ -32,7 +30,6 @@ import Simplex.Chat.Store.Groups
|
|||
import Simplex.Chat.Store.Profiles
|
||||
import Simplex.Chat.Store.Shared
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Preferences
|
||||
import Simplex.Messaging.Agent.Protocol (ConnId)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (firstRow, firstRow', maybeFirstRow)
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
|
|
@ -100,20 +97,20 @@ getConnectionEntity db vr 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.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.custom_data
|
||||
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
|
||||
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, ContactStatus) :. (Maybe MsgFilter, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool, Maybe CustomData)] -> Either StoreError Contact
|
||||
toContact' contactId conn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, customData)] =
|
||||
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)] =
|
||||
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, customData}
|
||||
in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, uiThemes, customData}
|
||||
toContact' _ _ _ = Left $ SEInternalError "referenced contact not found"
|
||||
getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
|
||||
getGroupAndMember_ groupMemberId c = ExceptT $ do
|
||||
|
|
@ -125,7 +122,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
|
|||
-- 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.send_rcpts, g.favorite, gp.preferences,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.custom_data,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.ui_themes, g.custom_data,
|
||||
-- GroupInfo {membership}
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
|
|
|
|||
|
|
@ -69,6 +69,7 @@ module Simplex.Chat.Store.Direct
|
|||
setConnConnReqInv,
|
||||
resetContactConnInitiated,
|
||||
setContactCustomData,
|
||||
setContactUIThemes,
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -87,6 +88,7 @@ import Simplex.Chat.Messages
|
|||
import Simplex.Chat.Store.Shared
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Preferences
|
||||
import Simplex.Chat.Types.UITheme
|
||||
import Simplex.Messaging.Agent.Protocol (ConnId, InvitationId, UserId)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
|
|
@ -176,7 +178,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.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.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,
|
||||
|
|
@ -222,7 +224,26 @@ createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p
|
|||
let profile = toLocalProfile profileId p localAlias
|
||||
userPreferences = emptyChatPrefs
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
|
||||
pure $ Contact {contactId, localDisplayName, profile, activeConn = Just conn, viaGroup = Nothing, contactUsed, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False, customData = Nothing}
|
||||
pure $
|
||||
Contact
|
||||
{ contactId,
|
||||
localDisplayName,
|
||||
profile,
|
||||
activeConn = Just conn,
|
||||
viaGroup = Nothing,
|
||||
contactUsed,
|
||||
contactStatus = CSActive,
|
||||
chatSettings = defaultChatSettings,
|
||||
userPreferences,
|
||||
mergedPreferences,
|
||||
createdAt = currentTs,
|
||||
updatedAt = currentTs,
|
||||
chatTs = Just currentTs,
|
||||
contactGroupMemberId = Nothing,
|
||||
contactGrpInvSent = False,
|
||||
customData = Nothing,
|
||||
uiThemes = Nothing
|
||||
}
|
||||
|
||||
deleteContactConnectionsAndFiles :: DB.Connection -> UserId -> Contact -> IO ()
|
||||
deleteContactConnectionsAndFiles db userId Contact {contactId} = do
|
||||
|
|
@ -579,7 +600,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.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.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,
|
||||
|
|
@ -725,7 +746,26 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}
|
|||
contactId <- insertedRowId db
|
||||
conn <- createConnection_ db userId ConnContact (Just contactId) agentConnId connChatVersion cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode pqSup
|
||||
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
|
||||
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn = Just conn, viaGroup = Nothing, contactUsed, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False, customData = Nothing}
|
||||
pure $
|
||||
Contact
|
||||
{ contactId,
|
||||
localDisplayName,
|
||||
profile = toLocalProfile profileId profile "",
|
||||
activeConn = Just conn,
|
||||
viaGroup = Nothing,
|
||||
contactUsed,
|
||||
contactStatus = CSActive,
|
||||
chatSettings = defaultChatSettings,
|
||||
userPreferences,
|
||||
mergedPreferences,
|
||||
createdAt,
|
||||
updatedAt = createdAt,
|
||||
chatTs = Just createdAt,
|
||||
contactGroupMemberId = Nothing,
|
||||
contactGrpInvSent = False,
|
||||
uiThemes = Nothing,
|
||||
customData = Nothing
|
||||
}
|
||||
|
||||
getContactIdByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Int64
|
||||
getContactIdByName db User {userId} cName =
|
||||
|
|
@ -744,7 +784,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.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.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,
|
||||
|
|
@ -889,3 +929,8 @@ setContactCustomData :: DB.Connection -> User -> Contact -> Maybe CustomData ->
|
|||
setContactCustomData db User {userId} Contact {contactId} customData = do
|
||||
updatedAt <- getCurrentTime
|
||||
DB.execute db "UPDATE contacts SET custom_data = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (customData, updatedAt, userId, contactId)
|
||||
|
||||
setContactUIThemes :: DB.Connection -> User -> Contact -> Maybe UIThemeEntityOverrides -> IO ()
|
||||
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)
|
||||
|
|
|
|||
|
|
@ -3,8 +3,8 @@
|
|||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
|
@ -117,6 +117,7 @@ module Simplex.Chat.Store.Groups
|
|||
updateUnknownMemberAnnounced,
|
||||
updateUserMemberProfileSentAt,
|
||||
setGroupCustomData,
|
||||
setGroupUIThemes,
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -141,6 +142,7 @@ import Simplex.Chat.Store.Shared
|
|||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Preferences
|
||||
import Simplex.Chat.Types.Shared
|
||||
import Simplex.Chat.Types.UITheme
|
||||
import Simplex.Messaging.Agent.Protocol (ConnId, UserId)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
|
|
@ -151,19 +153,19 @@ import Simplex.Messaging.Util (eitherToMaybe, ($>>=), (<$$>))
|
|||
import Simplex.Messaging.Version
|
||||
import UnliftIO.STM
|
||||
|
||||
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime, Maybe CustomData) :. GroupMemberRow
|
||||
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime, Maybe UIThemeEntityOverrides, Maybe CustomData) :. GroupMemberRow
|
||||
|
||||
type GroupMemberRow = ((Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
|
||||
|
||||
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
|
||||
|
||||
toGroupInfo :: VersionRangeChat -> Int64 -> GroupInfoRow -> GroupInfo
|
||||
toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt, customData) :. userMemberRow) =
|
||||
toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt, uiThemes, customData) :. userMemberRow) =
|
||||
let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr}
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll 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, userMemberProfileSentAt, customData}
|
||||
in GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, uiThemes, customData}
|
||||
|
||||
toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
|
||||
toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) =
|
||||
|
|
@ -274,7 +276,7 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr =
|
|||
-- 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.send_rcpts, g.favorite, gp.preferences,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.custom_data,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.ui_themes, g.custom_data,
|
||||
-- GroupInfo {membership}
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
|
|
@ -348,6 +350,7 @@ createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = Exc
|
|||
updatedAt = currentTs,
|
||||
chatTs = Just currentTs,
|
||||
userMemberProfileSentAt = Just currentTs,
|
||||
uiThemes = Nothing,
|
||||
customData = Nothing
|
||||
}
|
||||
|
||||
|
|
@ -414,6 +417,7 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ
|
|||
updatedAt = currentTs,
|
||||
chatTs = Just currentTs,
|
||||
userMemberProfileSentAt = Just currentTs,
|
||||
uiThemes = Nothing,
|
||||
customData = Nothing
|
||||
},
|
||||
groupMemberId
|
||||
|
|
@ -633,7 +637,7 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ =
|
|||
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, g.user_member_profile_sent_at, g.custom_data,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.ui_themes, g.custom_data,
|
||||
mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction,
|
||||
mu.invited_by, mu.invited_by_group_member_id, 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
|
||||
|
|
@ -1298,7 +1302,7 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} =
|
|||
-- 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.send_rcpts, g.favorite, gp.preferences,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.custom_data,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.ui_themes, g.custom_data,
|
||||
-- GroupInfo {membership}
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
|
|
@ -1394,7 +1398,7 @@ getGroupInfo db vr User {userId, userContactId} groupId =
|
|||
-- 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.send_rcpts, g.favorite, gp.preferences,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.custom_data,
|
||||
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.ui_themes, g.custom_data,
|
||||
-- GroupMember - membership
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
|
|
@ -1956,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, 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, customData = Nothing}
|
||||
|
||||
getMemberContact :: DB.Connection -> VersionRangeChat -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
|
||||
getMemberContact db vr user contactId = do
|
||||
|
|
@ -1993,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, 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, customData = Nothing}
|
||||
m' = m {memberContactId = Just contactId}
|
||||
pure (mCt', m')
|
||||
where
|
||||
|
|
@ -2198,3 +2202,8 @@ setGroupCustomData :: DB.Connection -> User -> GroupInfo -> Maybe CustomData ->
|
|||
setGroupCustomData db User {userId} GroupInfo {groupId} customData = do
|
||||
updatedAt <- getCurrentTime
|
||||
DB.execute db "UPDATE groups SET custom_data = ?, updated_at = ? WHERE user_id = ? AND group_id = ?" (customData, updatedAt, userId, groupId)
|
||||
|
||||
setGroupUIThemes :: DB.Connection -> User -> GroupInfo -> Maybe UIThemeEntityOverrides -> IO ()
|
||||
setGroupUIThemes db User {userId} GroupInfo {groupId} uiThemes = do
|
||||
updatedAt <- getCurrentTime
|
||||
DB.execute db "UPDATE groups SET ui_themes = ?, updated_at = ? WHERE user_id = ? AND group_id = ?" (uiThemes, updatedAt, userId, groupId)
|
||||
|
|
|
|||
|
|
@ -105,6 +105,7 @@ import Simplex.Chat.Migrations.M20240228_pq
|
|||
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.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
|
|
@ -209,7 +210,8 @@ schemaMigrations =
|
|||
("20240228_pq", m20240228_pq, Just down_m20240228_pq),
|
||||
("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)
|
||||
("20240402_item_forwarded", m20240402_item_forwarded, Just down_m20240402_item_forwarded),
|
||||
("20240430_ui_theme", m20240430_ui_theme, Just down_m20240430_ui_theme)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
|
|
|||
|
|
@ -57,6 +57,7 @@ module Simplex.Chat.Store.Profiles
|
|||
deleteCommand,
|
||||
updateCommandStatus,
|
||||
getCommandDataByCorrId,
|
||||
setUserUIThemes,
|
||||
)
|
||||
where
|
||||
|
||||
|
|
@ -82,6 +83,7 @@ import Simplex.Chat.Store.Shared
|
|||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Preferences
|
||||
import Simplex.Chat.Types.Shared
|
||||
import Simplex.Chat.Types.UITheme
|
||||
import Simplex.Messaging.Agent.Protocol (ACorrId, ConnId, UserId)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
|
|
@ -123,7 +125,7 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image,
|
|||
(profileId, displayName, userId, True, currentTs, 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) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, Nothing, Nothing, Nothing)
|
||||
pure $ toUser $ (userId, auId, contactId, profileId, activeUser, displayName, fullName, image, Nothing, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, Nothing, Nothing, Nothing, Nothing)
|
||||
|
||||
getUsersInfo :: DB.Connection -> IO [UserInfo]
|
||||
getUsersInfo db = getUsers db >>= mapM getUserInfo
|
||||
|
|
@ -274,8 +276,8 @@ updateUserProfile db user p'
|
|||
where
|
||||
updateUserMemberProfileUpdatedAt_ currentTs
|
||||
| userMemberProfileChanged = do
|
||||
DB.execute db "UPDATE users SET user_member_profile_updated_at = ? WHERE user_id = ?" (currentTs, userId)
|
||||
pure $ Just currentTs
|
||||
DB.execute db "UPDATE users SET user_member_profile_updated_at = ? WHERE user_id = ?" (currentTs, userId)
|
||||
pure $ Just currentTs
|
||||
| otherwise = pure userMemberProfileUpdatedAt
|
||||
userMemberProfileChanged = newName /= displayName || newFullName /= fullName || newImage /= image
|
||||
User {userId, userContactId, localDisplayName, profile = LocalProfile {profileId, displayName, fullName, image, localAlias}, userMemberProfileUpdatedAt} = user
|
||||
|
|
@ -619,3 +621,8 @@ getCommandDataByCorrId db User {userId} corrId =
|
|||
where
|
||||
toCommandData :: (CommandId, Maybe Int64, CommandFunction, CommandStatus) -> CommandData
|
||||
toCommandData (cmdId, cmdConnId, cmdFunction, cmdStatus) = CommandData {cmdId, cmdConnId, cmdFunction, cmdStatus}
|
||||
|
||||
setUserUIThemes :: DB.Connection -> User -> Maybe UIThemeEntityOverrides -> IO ()
|
||||
setUserUIThemes db User {userId} uiThemes = do
|
||||
updatedAt <- getCurrentTime
|
||||
DB.execute db "UPDATE users SET ui_themes = ?, updated_at = ? WHERE user_id = ?" (uiThemes, updatedAt, userId)
|
||||
|
|
|
|||
|
|
@ -3,8 +3,8 @@
|
|||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
|
@ -33,6 +33,7 @@ import Simplex.Chat.Protocol
|
|||
import Simplex.Chat.Remote.Types
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Preferences
|
||||
import Simplex.Chat.Types.UITheme
|
||||
import Simplex.Messaging.Agent.Protocol (ConnId, UserId)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
|
|
@ -380,16 +381,18 @@ deleteUnusedIncognitoProfileById_ db User {userId} profileId =
|
|||
|]
|
||||
[":user_id" := userId, ":profile_id" := profileId]
|
||||
|
||||
type ContactRow = (ContactId, 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 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, Maybe CustomData)
|
||||
|
||||
type ContactRow = Only ContactId :. ContactRow'
|
||||
|
||||
toContact :: VersionRangeChat -> User -> ContactRow :. MaybeConnectionRow -> Contact
|
||||
toContact vr user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, 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, 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, customData}
|
||||
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent, uiThemes, customData}
|
||||
|
||||
getProfileById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalProfile
|
||||
getProfileById db userId profileId =
|
||||
|
|
@ -418,15 +421,15 @@ 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.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at
|
||||
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.ui_themes
|
||||
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, Bool, Bool, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime) -> User
|
||||
toUser ((userId, auId, userContactId, profileId, activeUser, displayName, fullName, image, contactLink, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt)) =
|
||||
User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash, userMemberProfileUpdatedAt}
|
||||
toUser :: (UserId, UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences) :. (Bool, Bool, Bool, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, Maybe UIThemeEntityOverrides) -> User
|
||||
toUser ((userId, auId, userContactId, profileId, activeUser, displayName, fullName, image, contactLink, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, uiThemes)) =
|
||||
User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash, userMemberProfileUpdatedAt, uiThemes}
|
||||
where
|
||||
profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences = userPreferences, localAlias = ""}
|
||||
fullPreferences = mergePreferences Nothing userPreferences
|
||||
|
|
|
|||
|
|
@ -45,6 +45,7 @@ import Database.SQLite.Simple.Ok
|
|||
import Database.SQLite.Simple.ToField (ToField (..))
|
||||
import Simplex.Chat.Types.Preferences
|
||||
import Simplex.Chat.Types.Shared
|
||||
import Simplex.Chat.Types.UITheme
|
||||
import Simplex.Chat.Types.Util
|
||||
import Simplex.FileTransfer.Description (FileDigest)
|
||||
import Simplex.Messaging.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), APartyCmdTag (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, RcvFileId, SAEntity (..), SndFileId, UserId)
|
||||
|
|
@ -117,7 +118,8 @@ data User = User
|
|||
showNtfs :: Bool,
|
||||
sendRcptsContacts :: Bool,
|
||||
sendRcptsSmallGroups :: Bool,
|
||||
userMemberProfileUpdatedAt :: Maybe UTCTime
|
||||
userMemberProfileUpdatedAt :: Maybe UTCTime,
|
||||
uiThemes :: Maybe UIThemeEntityOverrides
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
|
|
@ -175,6 +177,7 @@ data Contact = Contact
|
|||
chatTs :: Maybe UTCTime,
|
||||
contactGroupMemberId :: Maybe GroupMemberId,
|
||||
contactGrpInvSent :: Bool,
|
||||
uiThemes :: Maybe UIThemeEntityOverrides,
|
||||
customData :: Maybe CustomData
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
|
@ -372,6 +375,7 @@ data GroupInfo = GroupInfo
|
|||
updatedAt :: UTCTime,
|
||||
chatTs :: Maybe UTCTime,
|
||||
userMemberProfileSentAt :: Maybe UTCTime,
|
||||
uiThemes :: Maybe UIThemeEntityOverrides,
|
||||
customData :: Maybe CustomData
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
|
|
|||
166
src/Simplex/Chat/Types/UITheme.hs
Normal file
166
src/Simplex/Chat/Types/UITheme.hs
Normal file
|
|
@ -0,0 +1,166 @@
|
|||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Simplex.Chat.Types.UITheme where
|
||||
|
||||
import Data.Aeson (FromJSON (..), ToJSON (..))
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Aeson.TH as JQ
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||
import Data.Char (toLower)
|
||||
import Data.Maybe (fromMaybe)
|
||||
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,
|
||||
wallpaper :: Maybe ChatWallpaper,
|
||||
colors :: UIColors
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data UIColorMode = UCMLight | UCMDark
|
||||
deriving (Eq, Show)
|
||||
|
||||
data UIThemeEntityOverrides = UIThemeEntityOverrides
|
||||
{ light :: Maybe UIThemeEntityOverride,
|
||||
dark :: Maybe UIThemeEntityOverride
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data UIThemeEntityOverride = UIThemeEntityOverride
|
||||
{ mode :: UIColorMode,
|
||||
wallpaper :: Maybe ChatWallpaper,
|
||||
colors :: UIColors
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data ThemeColorScheme = TCSLight | TCSDark | TCSSimplex
|
||||
deriving (Eq, Show)
|
||||
|
||||
data UIColorScheme
|
||||
= UCSSystem
|
||||
| UCSLight
|
||||
| UCSDark
|
||||
| UCSSimplex
|
||||
deriving (Show)
|
||||
|
||||
data DarkColorScheme = DCSDark | DCSSimplex
|
||||
deriving (Show)
|
||||
|
||||
instance StrEncoding ThemeColorScheme where
|
||||
strEncode = \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 (== ' ')
|
||||
|
||||
instance FromJSON ThemeColorScheme where
|
||||
parseJSON = strParseJSON "ThemeColorScheme"
|
||||
|
||||
instance ToJSON ThemeColorScheme where
|
||||
toJSON = strToJSON
|
||||
toEncoding = strToJEncoding
|
||||
|
||||
data ChatWallpaper = ChatWallpaper
|
||||
{ preset :: Maybe ChatWallpaperPreset,
|
||||
imageFile :: Maybe FilePath,
|
||||
background :: Maybe UIColor,
|
||||
tint :: Maybe UIColor,
|
||||
scaleType :: Maybe ChatWallpaperScale,
|
||||
scale :: Maybe Double
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data ChatWallpaperScale = CWSFill | CWSFit | CWSRepeat
|
||||
deriving (Eq, Show)
|
||||
|
||||
data UIColors = UIColors
|
||||
{ accent :: Maybe UIColor,
|
||||
accentVariant :: Maybe UIColor,
|
||||
secondary :: Maybe UIColor,
|
||||
secondaryVariant :: Maybe UIColor,
|
||||
background :: Maybe UIColor,
|
||||
menus :: Maybe UIColor,
|
||||
title :: Maybe UIColor,
|
||||
sentMessage :: Maybe UIColor,
|
||||
receivedMessage :: Maybe UIColor
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
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)
|
||||
|
||||
instance FromJSON UIColor where
|
||||
parseJSON v = toColor =<< J.parseJSON v
|
||||
where
|
||||
toColor s@('#' : cs)
|
||||
| length cs == 8 && all hexDigit cs = pure $ UIColor s
|
||||
toColor _ = fail "bad UIColor"
|
||||
hexDigit c = (c >= '0' && c <= '9') || (let c' = toLower c in c' >= 'a' && c' <= 'f')
|
||||
|
||||
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)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''UIThemeEntityOverride)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''UIThemeEntityOverrides)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''UITheme)
|
||||
|
||||
$(JQ.deriveJSON defaultJSON ''UIThemes)
|
||||
|
||||
instance ToField UIThemeEntityOverrides where
|
||||
toField = toField . encodeJSON
|
||||
|
||||
instance FromField UIThemeEntityOverrides where
|
||||
fromField = fromTextField_ $ Just . fromMaybe (UIThemeEntityOverrides Nothing Nothing) . decodeJSON
|
||||
|
|
@ -50,6 +50,7 @@ import Simplex.Chat.Styled
|
|||
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 Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), SubscriptionsInfo (..))
|
||||
import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..))
|
||||
|
|
@ -83,7 +84,7 @@ serializeChatResponse user_ ts tz remoteHost_ = unlines . map unStyle . response
|
|||
|
||||
responseToView :: (Maybe RemoteHostId, Maybe User) -> ChatConfig -> Bool -> CurrentTime -> TimeZone -> Maybe RemoteHostId -> ChatResponse -> [StyledString]
|
||||
responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showReceipts, testView} liveItems ts tz outputRH = \case
|
||||
CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile
|
||||
CRActiveUser User {profile, uiThemes} -> viewUserProfile (fromLocalProfile profile) <> viewUITheme uiThemes
|
||||
CRUsersList users -> viewUsersList users
|
||||
CRChatStarted -> ["chat started"]
|
||||
CRChatRunning -> ["chat is running"]
|
||||
|
|
@ -1209,7 +1210,7 @@ viewNetworkConfig NetworkConfig {socksProxy, tcpTimeout} =
|
|||
]
|
||||
|
||||
viewContactInfo :: Contact -> Maybe ConnectionStats -> Maybe Profile -> [StyledString]
|
||||
viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink}, activeConn, customData} stats incognitoProfile =
|
||||
viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink}, activeConn, uiThemes, customData} stats incognitoProfile =
|
||||
["contact ID: " <> sShow contactId]
|
||||
<> maybe [] viewConnectionStats stats
|
||||
<> maybe [] (\l -> ["contact address: " <> (plain . strEncode) (simplexChatContact l)]) contactLink
|
||||
|
|
@ -1221,15 +1222,20 @@ viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, conta
|
|||
<> [viewConnectionVerified (contactSecurityCode ct)]
|
||||
<> ["quantum resistant end-to-end encryption" | contactPQEnabled ct == CR.PQEncOn]
|
||||
<> maybe [] (\ac -> [viewPeerChatVRange (peerChatVRange ac)]) activeConn
|
||||
<> viewUITheme uiThemes
|
||||
<> viewCustomData customData
|
||||
|
||||
viewGroupInfo :: GroupInfo -> GroupSummary -> [StyledString]
|
||||
viewGroupInfo GroupInfo {groupId, customData} s =
|
||||
viewGroupInfo GroupInfo {groupId, uiThemes, customData} s =
|
||||
[ "group ID: " <> sShow groupId,
|
||||
"current members: " <> sShow (currentMembers s)
|
||||
]
|
||||
<> viewUITheme uiThemes
|
||||
<> viewCustomData customData
|
||||
|
||||
viewUITheme :: Maybe UIThemeEntityOverrides -> [StyledString]
|
||||
viewUITheme = maybe [] (\uiThemes -> ["UI themes: " <> plain (LB.toStrict $ J.encode uiThemes)])
|
||||
|
||||
viewCustomData :: Maybe CustomData -> [StyledString]
|
||||
viewCustomData = maybe [] (\(CustomData v) -> ["custom data: " <> plain (LB.toStrict . J.encode $ J.Object v)])
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,4 @@
|
|||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PostfixOperators #-}
|
||||
|
||||
|
|
@ -15,6 +16,8 @@ import qualified Data.Text as T
|
|||
import Simplex.Chat.Store.Shared (createContact)
|
||||
import Simplex.Chat.Types (ConnStatus (..), Profile (..))
|
||||
import Simplex.Chat.Types.Shared (GroupMemberRole (..))
|
||||
import Simplex.Chat.Types.UITheme
|
||||
import Simplex.Chat.Types.Util (encodeJSON)
|
||||
import Simplex.Messaging.Encoding.String (StrEncoding (..))
|
||||
import System.Directory (copyFile, createDirectoryIfMissing)
|
||||
import Test.Hspec hiding (it)
|
||||
|
|
@ -73,6 +76,7 @@ chatProfileTests = do
|
|||
it "direct messages" testGroupPrefsDirectForRole
|
||||
it "files & media" testGroupPrefsFilesForRole
|
||||
it "SimpleX links" testGroupPrefsSimplexLinksForRole
|
||||
it "set user, contact and group UI theme" testSetUITheme
|
||||
|
||||
testUpdateProfile :: HasCallStack => FilePath -> IO ()
|
||||
testUpdateProfile =
|
||||
|
|
@ -1935,8 +1939,8 @@ testGroupPrefsDirectForRole = testChat4 aliceProfile bobProfile cathProfile danP
|
|||
dan <## "#team: you joined the group"
|
||||
dan
|
||||
<### [ "#team: member alice (Alice) is connected",
|
||||
"#team: member bob (Bob) is connected"
|
||||
],
|
||||
"#team: member bob (Bob) is connected"
|
||||
],
|
||||
do
|
||||
alice <## "#team: cath added dan (Daniel) to the group (connecting...)"
|
||||
alice <## "#team: new member dan is connected",
|
||||
|
|
@ -1947,7 +1951,7 @@ testGroupPrefsDirectForRole = testChat4 aliceProfile bobProfile cathProfile danP
|
|||
-- dan cannot send direct messages to alice (owner)
|
||||
dan ##> "@alice hello alice"
|
||||
dan <## "bad chat command: direct messages not allowed"
|
||||
(alice </)
|
||||
(alice </)
|
||||
-- but alice can
|
||||
alice `send` "@dan hello dan"
|
||||
alice <## "member #team dan does not have direct connection, creating"
|
||||
|
|
@ -2029,3 +2033,54 @@ testGroupPrefsSimplexLinksForRole = testChat3 aliceProfile bobProfile cathProfil
|
|||
cc <## "alice updated group #team:"
|
||||
cc <## "updated group preferences:"
|
||||
cc <## "SimpleX links: on for owners"
|
||||
|
||||
testSetUITheme :: HasCallStack => FilePath -> IO ()
|
||||
testSetUITheme =
|
||||
testChat2 aliceProfile bobProfile $ \alice bob -> do
|
||||
connectUsers alice bob
|
||||
alice ##> "/g team"
|
||||
alice <## "group #team is created"
|
||||
alice <## "to add members use /a team <name> or /create link #team"
|
||||
alice #$> ("/_set theme user 1 " <> theme UCMDark, id, "ok")
|
||||
alice #$> ("/_set theme @2 " <> theme UCMDark, id, "ok")
|
||||
alice #$> ("/_set theme #1 " <> theme UCMDark, id, "ok")
|
||||
alice ##> "/u"
|
||||
userInfo alice "alice (Alice)"
|
||||
alice <## ("UI themes: " <> theme UCMDark)
|
||||
alice ##> "/create user alice2"
|
||||
userInfo alice "alice2"
|
||||
alice ##> "/u alice"
|
||||
userInfo alice "alice (Alice)"
|
||||
alice <## ("UI themes: " <> theme UCMDark)
|
||||
alice ##> "/i @bob"
|
||||
contactInfo alice
|
||||
alice <## ("UI themes: " <> theme UCMDark)
|
||||
alice ##> "/i #team"
|
||||
groupInfo alice
|
||||
alice <## ("UI themes: " <> theme UCMDark)
|
||||
alice #$> ("/_set theme user 1", id, "ok")
|
||||
alice #$> ("/_set theme @2", id, "ok")
|
||||
alice #$> ("/_set theme #1", id, "ok")
|
||||
alice ##> "/u"
|
||||
userInfo alice "alice (Alice)"
|
||||
alice ##> "/i @bob"
|
||||
contactInfo alice
|
||||
alice ##> "/i #team"
|
||||
groupInfo alice
|
||||
where
|
||||
theme cm = T.unpack $ encodeJSON UIThemeEntityOverrides {light = Nothing, dark = Just $ UIThemeEntityOverride cm Nothing defaultUIColors}
|
||||
userInfo a name = do
|
||||
a <## ("user profile: " <> name)
|
||||
a <## "use /p <display name> to change it"
|
||||
a <## "(the updated profile will be sent to all your contacts)"
|
||||
contactInfo a = do
|
||||
a <## "contact ID: 2"
|
||||
a <## "receiving messages via: localhost"
|
||||
a <## "sending messages via: localhost"
|
||||
a <## "you've shared main profile with this contact"
|
||||
a <## "connection not verified, use /code command to see security code"
|
||||
a <## "quantum resistant end-to-end encryption"
|
||||
a <## "peer chat protocol version range: (Version 1, Version 8)"
|
||||
groupInfo a = do
|
||||
a <## "group ID: 1"
|
||||
a <## "current members: 1"
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue