dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-05-24 19:35:33 +00:00
Code Issues Packages Projects Releases Wiki Activity

rfc: bot messages and buttons, core: command markdown, supported commands in profile preferences, chat sessions preference, peer type field in profile to identify bots (#5360)

Browse Source 
* rfc: bot messages and buttons

* update

* update bot rfc

* core: add bot commands to chat preferences and peer type to profile

* update postgresql schema

* update query plans

* chat sessions preference

* markdown for bot commands

* schema

* core: file preference, options to create bot from CLI

* core: different command type

* ios: commands menu

* update types

* update ios

* improve command markdown

* core, ios: update types

* android, desktop: clickable commands in messages in chats with bots

* android, desktop: commands menu

* command menu button, bot icon

* ios: connect flow for bots

* android, desktop: connect flow for bots

* icon

* CLI commands to view and set commands, remove "hidden" property of command, bot api docs

* corrections

* fix inheriting profile preferences to business groups

* note on business address

* ios: export localizations

* fix test

* commands to set file preference on user/contact, tidy up layout and display of command and attachment buttons
This commit is contained in:
Evgeny
2025-08-07 11:13:35 +01:00
committed by GitHub
parent 9596029c30
commit 4811d663e6
93 changed files with 2810 additions and 466 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Controller.hs
+1
View File
@@ -530,6 +530,7 @@ data ChatCommand
| CancelFile {fileId :: FileTransferId}
| FileStatus FileTransferId
| ShowProfile -- UserId (not used in UI)
| SetBotCommands [ChatBotCommand]
| UpdateProfile ContactName (Maybe Text) -- UserId (not used in UI)
| UpdateProfileImage (Maybe ImageData) -- UserId (not used in UI)
| ShowProfileImage
src/Simplex/Chat/Core.hs
+22 -14
View File
@@ -2,6 +2,7 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
module Simplex.Chat.Core
( simplexChatCore,
@@ -23,10 +24,11 @@ import Data.Time.LocalTime (getCurrentTimeZone)
import Simplex.Chat
import Simplex.Chat.Controller
import Simplex.Chat.Library.Commands
import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts (..))
import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts (..), CreateBotOpts (..))
import Simplex.Chat.Remote.Types (RemoteHostId)
import Simplex.Chat.Store.Profiles
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences (FeatureAllowed (..), FilesPreference (..), Preferences (..), emptyChatPrefs)
import Simplex.Chat.View (ChatResponseEvent, serializeChatError, serializeChatResponse)
import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
import Simplex.Messaging.Agent.Store.Common (DBStore, withTransaction)
@@ -36,7 +38,7 @@ import Text.Read (readMaybe)
import UnliftIO.Async
simplexChatCore :: ChatConfig -> ChatOpts -> (User -> ChatController -> IO ()) -> IO ()
simplexChatCore cfg@ChatConfig {confirmMigrations, testView} opts@ChatOpts {coreOptions = CoreChatOpts {dbOptions, logAgent, yesToUpMigrations}, maintenance} chat =
simplexChatCore cfg@ChatConfig {confirmMigrations, testView} opts@ChatOpts {coreOptions = CoreChatOpts {dbOptions, logAgent, yesToUpMigrations}, createBot, maintenance} chat =
case logAgent of
Just level -> do
setLogLevel level
@@ -52,7 +54,7 @@ simplexChatCore cfg@ChatConfig {confirmMigrations, testView} opts@ChatOpts {core
u_ <- getSelectActiveUser chatStore
let backgroundMode = not maintenance
cc <- newChatController db u_ cfg opts backgroundMode
u <- maybe (createActiveUser cc) pure u_
u <- maybe (createActiveUser cc createBot) pure u_
unless testView $ putStrLn $ "Current user: " <> userStr u
runSimplexChat opts u cc chat
@@ -96,21 +98,27 @@ getSelectActiveUser st = do
let user = users !! (n - 1)
in Just <$> withTransaction st (`setActiveUser` user)
createActiveUser :: ChatController -> IO User
createActiveUser cc = do
putStrLn
"No user profiles found, it will be created now.\n\
\Please choose your display name.\n\
\It will be sent to your contacts when you connect.\n\
\It is only stored on your device and you can change it later."
loop
createActiveUser :: ChatController -> Maybe CreateBotOpts -> IO User
createActiveUser cc = \case
Just CreateBotOpts {botDisplayName, allowFiles} -> do
let preferences = if allowFiles then Nothing else Just emptyChatPrefs {files = Just FilesPreference {allow = FANo}}
createUser exitFailure $ (mkProfile botDisplayName) {peerType = Just CPTBot, preferences}
Nothing -> do
putStrLn
"No user profiles found, it will be created now.\n\
\Please choose your display name.\n\
\It will be sent to your contacts when you connect.\n\
\It is only stored on your device and you can change it later."
loop
where
loop = do
displayName <- T.pack <$> getWithPrompt "display name"
let profile = Just Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, preferences = Nothing}
execChatCommand' (CreateActiveUser NewUser {profile, pastTimestamp = False}) 0 `runReaderT` cc >>= \case
createUser loop $ mkProfile displayName
mkProfile displayName = Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing}
createUser onError p =
execChatCommand' (CreateActiveUser NewUser {profile = Just p, pastTimestamp = False}) 0 `runReaderT` cc >>= \case
Right (CRActiveUser user) -> pure user
r -> printResponseEvent (Nothing, Nothing) (config cc) r >> loop
r -> printResponseEvent (Nothing, Nothing) (config cc) r >> onError
printResponseEvent :: ChatResponseEvent r => (Maybe RemoteHostId, Maybe User) -> ChatConfig -> Either ChatError r -> IO ()
printResponseEvent hu cfg = \case
src/Simplex/Chat/Library/Commands.hs
+35 -1
View File
@@ -2799,6 +2799,11 @@ processChatCommand vr nm = \case
fileStatus <- withFastStore $ \db -> getFileTransferProgress db user fileId
pure $ CRFileTransferStatus user fileStatus
ShowProfile -> withUser $ \user@User {profile} -> pure $ CRUserProfile user (fromLocalProfile profile)
SetBotCommands commands -> withUser $ \user@User {profile} -> do
let LocalProfile {preferences} = profile
prefs = Just (fromMaybe emptyChatPrefs preferences :: Preferences) {commands = Just commands}
p = (fromLocalProfile profile :: Profile) {preferences = prefs, peerType = Just CPTBot}
updateProfile user p
UpdateProfile displayName shortDescr -> withUser $ \user@User {profile} -> do
let p = (fromLocalProfile profile :: Profile) {displayName, shortDescr, fullName = ""}
updateProfile user p
@@ -4376,6 +4381,7 @@ chatCommandP =
"/unblock #" *> (SetShowMemberMessages <$> displayNameP <* A.space <*> (char_ '@' *> displayNameP) <*> pure True),
"/_create user " *> (CreateActiveUser <$> jsonP),
"/create user " *> (CreateActiveUser <$> newUserP),
"/create bot " *> (CreateActiveUser <$> newBotUserP),
"/users" $> ListUsers,
"/_user " *> (APISetActiveUser <$> A.decimal <*> optional (A.space *> jsonP)),
("/user " <|> "/u ") *> (SetActiveUser <$> displayNameP <*> optional (A.space *> pwdP)),
@@ -4690,10 +4696,14 @@ chatCommandP =
"/show profile image" $> ShowProfileImage,
("/profile " <|> "/p ") *> (uncurry UpdateProfile <$> profileNameDescr),
("/profile" <|> "/p") $> ShowProfile,
"/set bot commands " *> (SetBotCommands <$> botCommandsP),
"/delete bot commands" $> SetBotCommands [],
"/set voice #" *> (SetGroupFeatureRole (AGFR SGFVoice) <$> displayNameP <*> _strP <*> optional memberRole),
"/set voice @" *> (SetContactFeature (ACF SCFVoice) <$> displayNameP <*> optional (A.space *> strP)),
"/set voice " *> (SetUserFeature (ACF SCFVoice) <$> strP),
"/set files #" *> (SetGroupFeatureRole (AGFR SGFFiles) <$> displayNameP <*> _strP <*> optional memberRole),
"/set files @" *> (SetContactFeature (ACF SCFFiles) <$> displayNameP <*> optional (A.space *> strP)),
"/set files " *> (SetUserFeature (ACF SCFFiles) <$> strP),
"/set history #" *> (SetGroupFeature (AGFNR SGFHistory) <$> displayNameP <*> (A.space *> strP)),
"/set reactions #" *> (SetGroupFeature (AGFNR SGFReactions) <$> displayNameP <*> (A.space *> strP)),
"/set calls @" *> (SetContactFeature (ACF SCFCalls) <$> displayNameP <*> optional (A.space *> strP)),
@@ -4803,9 +4813,33 @@ chatCommandP =
pure UserMsgReceiptSettings {enable, clearOverrides}
onOffP = ("on" $> True) <|> ("off" $> False)
profileNameDescr = (,) <$> displayNameP <*> shortDescrP
-- 'Help with bot':'link <ID>','Menu of commands':[...]
botCommandsP :: Parser [ChatBotCommand]
botCommandsP = commandP `A.sepBy'` A.char ','
where
commandP = do
label <- safeDecodeUtf8 <$> ((quoted <|> A.takeTill (== ':')) <* A.char ':')
when (T.null label) $ fail "empty command label"
A.peekChar' >>= \case
'{' -> A.char '{' *> (CBCMenu label <$> botCommandsP) <* A.char '}'
_ -> do
cmd <- safeDecodeUtf8 <$> (optional (A.char '/') *> (quoted <|> A.takeTill (A.inClass ":,}")))
(keyword, params) <- case T.words cmd of
[] -> fail "empty command"
k : ws -> pure (k, if null ws then Nothing else Just $ T.unwords ws)
pure CBCCommand {label, keyword, params}
quoted = A.char '\'' *> A.takeTill (== '\'') <* A.char '\''
newUserP = do
(cName, shortDescr) <- profileNameDescr
let profile = Just Profile {displayName = cName, fullName = "", shortDescr, image = Nothing, contactLink = Nothing, preferences = Nothing}
let profile = Just Profile {displayName = cName, fullName = "", shortDescr, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing}
pure NewUser {profile, pastTimestamp = False}
newBotUserP = do
files_ <- optional $ "files=" *> onOffP <* A.space
(cName, shortDescr) <- profileNameDescr
let preferences = case files_ of
Just True -> Nothing
_ -> Just (emptyChatPrefs :: Preferences) {files = Just FilesPreference {allow = FANo}}
profile = Just Profile {displayName = cName, fullName = "", shortDescr, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences}
pure NewUser {profile, pastTimestamp = False}
jsonP :: J.FromJSON a => Parser a
jsonP = J.eitherDecodeStrict' <$?> A.takeByteString
src/Simplex/Chat/Library/Internal.hs
+3 -1
View File
File diff suppressed because one or more lines are too long
src/Simplex/Chat/Markdown.hs
+32 -10
View File
@@ -50,6 +50,7 @@ data Format
| Colored {color :: FormatColor}
| Uri
| SimplexLink {linkType :: SimplexLinkType, simplexUri :: AConnectionLink, smpHosts :: NonEmpty Text}
| Command {commandStr :: Text}
| Mention {memberName :: Text}
| Email
| Phone
@@ -134,11 +135,21 @@ unmarked :: Text -> Markdown
unmarked = Markdown Nothing
parseMaybeMarkdownList :: Text -> Maybe MarkdownList
parseMaybeMarkdownList s
| all (isNothing . format) ml = Nothing
| otherwise = Just . reverse $ foldl' acc [] ml
parseMaybeMarkdownList s = case ls of
[] -> Nothing
[l]
| T.null cmd -> Nothing
| isCmd -> Just [FormattedText (Just $ Command cmd) l]
where
(isCmd, cmd) = case T.uncons $ T.dropWhile (== ' ') l of
Just (c, rest) -> (c == '/', rest)
Nothing -> (False, "")
_
| all (isNothing . format) ml -> Nothing
| otherwise -> Just . reverse $ foldl' acc [] ml
where
ml = intercalate ["\n"] . map (markdownToList . parseMarkdown) $ T.lines s
ls = T.lines s
ml = intercalate ["\n"] $ map (markdownToList . parseMarkdown) ls
acc [] m = [m]
acc ms@(FormattedText f t : ms') ft@(FormattedText f' t')
| f == f' = FormattedText f (t <> t') : ms'
@@ -175,6 +186,7 @@ markdownP = mconcat <$> A.many' fragmentP
'#' -> A.char '#' *> secretP
'!' -> coloredP <|> wordP
'@' -> mentionP <|> wordP
'/' -> commandP <|> wordP
_
| isDigit c -> phoneP <|> wordP
| otherwise -> wordP
@@ -204,12 +216,14 @@ markdownP = mconcat <$> A.many' fragmentP
if T.null s || T.last s == ' '
then fail "not colored"
else pure $ markdown (colored clr) s
mentionP = do
c <- A.char '@' *> A.peekChar'
(name, punct) <- displayNameTextP_
let sName = if c == '\'' then '\'' `T.cons` name `T.snoc` '\'' else name
mention = markdown (Mention name) ('@' `T.cons` sName)
pure $ if T.null punct then mention else mention :|: unmarked punct
mentionP = prefixedStringP '@' displayNameTextP_ Mention
commandP = prefixedStringP '/' commandTextP Command
prefixedStringP pfx parser format = do
c <- A.char pfx *> A.peekChar'
(str, punct) <- parser
let origStr = if c == '\'' then '\'' `T.cons` str `T.snoc` '\'' else str
res = markdown (format str) (pfx `T.cons` origStr)
pure $ if T.null punct then res else res :|: unmarked punct
colorP =
A.anyChar >>= \case
'r' -> optional "ed" $> Red
@@ -304,6 +318,7 @@ markdownText (FormattedText f_ t) = case f_ of
Uri -> t
SimplexLink {} -> t
Mention _ -> t
Command _ -> t
Email -> t
Phone -> t
Unknown _ -> t
@@ -336,6 +351,13 @@ displayNameTextP_ = (,"") <$> quoted '\'' <|> splitPunctuation <$> takeNameTill
quoted c = A.char c *> takeNameTill (== c) <* A.char c
refChar c = c > ' ' && c /= '#' && c /= '@' && c /= '\''
commandTextP :: Parser (Text, Text)
commandTextP = do
(cmd, punct) <- displayNameTextP_
case T.words cmd of
(keyword : _) | T.all (\c -> isAlpha c || isDigit c || c == '_') keyword -> pure (cmd, punct)
_ -> fail "invalid command keyword"
-- quotes names that contain spaces or end on punctuation
viewName :: Text -> Text
viewName s = if T.any isSpace s || maybe False (isPunctuation . snd) (T.unsnoc s) then "'" <> s <> "'" else s
src/Simplex/Chat/Mobile.hs
+1
View File
@@ -244,6 +244,7 @@ mobileChatOpts dbOptions =
autoAcceptFileSize = 0,
muteNotifications = True,
markRead = False,
createBot = Nothing,
maintenance = True
}
src/Simplex/Chat/Options.hs
+24
View File
@@ -8,6 +8,7 @@
module Simplex.Chat.Options
( ChatOpts (..),
CoreChatOpts (..),
CreateBotOpts (..),
ChatCmdLog (..),
chatOptsP,
coreChatOptsP,
@@ -49,6 +50,7 @@ data ChatOpts = ChatOpts
autoAcceptFileSize :: Integer,
muteNotifications :: Bool,
markRead :: Bool,
createBot :: Maybe CreateBotOpts,
maintenance :: Bool
}
@@ -68,6 +70,11 @@ data CoreChatOpts = CoreChatOpts
yesToUpMigrations :: Bool
}
data CreateBotOpts = CreateBotOpts
{ botDisplayName :: Text,
allowFiles :: Bool
}
data ChatCmdLog = CCLAll | CCLMessages | CCLNone
deriving (Eq)
@@ -354,6 +361,18 @@ chatOptsP appDir defaultDbName = do
<> short 'r'
<> help "Mark shown messages as read"
)
createBotDisplayName <-
optional $
strOption
( long "create-bot-display-name"
<> metavar "BOT_NAME"
<> help "Create new bot user on the first start with the passed display name"
)
createBotAllowFiles <-
switch
( long "create-bot-allow-files"
<> help "Flag for created bot to allow files (only allowed together with --create-bot option)"
)
maintenance <-
switch
( long "maintenance"
@@ -374,6 +393,11 @@ chatOptsP appDir defaultDbName = do
autoAcceptFileSize,
muteNotifications,
markRead,
createBot = case createBotDisplayName of
Just botDisplayName -> Just CreateBotOpts {botDisplayName, allowFiles = createBotAllowFiles}
Nothing
| createBotAllowFiles -> error "--create-bot-allow-files option requires --create-bot-name option"
| otherwise -> Nothing,
maintenance
}
src/Simplex/Chat/ProfileGenerator.hs
+1 -1
View File
@@ -10,7 +10,7 @@ generateRandomProfile :: IO Profile
generateRandomProfile = do
adjective <- pick adjectives
noun <- pickNoun adjective 2
pure $ Profile {displayName = adjective <> noun, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, preferences = Nothing}
pure $ Profile {displayName = adjective <> noun, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Nothing, preferences = Nothing}
where
pick :: [a] -> IO a
pick xs = (xs !!) <$> randomRIO (0, length xs - 1)
src/Simplex/Chat/Store/Connections.hs
+5 -5
View File
@@ -110,7 +110,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
db
[sql|
SELECT
c.contact_profile_id, c.local_display_name, c.via_group, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.local_alias, c.contact_used, c.contact_status, c.enable_ntfs, c.send_rcpts, c.favorite,
c.contact_profile_id, c.local_display_name, c.via_group, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, 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.conn_full_link_to_connect, c.conn_short_link_to_connect, c.welcome_shared_msg_id, c.request_shared_msg_id, c.contact_request_id,
c.contact_group_member_id, c.contact_grp_inv_sent, c.grp_direct_inv_link, c.grp_direct_inv_from_group_id, c.grp_direct_inv_from_group_member_id, c.grp_direct_inv_from_member_conn_id, c.grp_direct_inv_started_connection,
c.ui_themes, c.chat_deleted, c.custom_data, c.chat_item_ttl
@@ -120,8 +120,8 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
|]
(userId, contactId)
toContact' :: Int64 -> Connection -> [ChatTagId] -> ContactRow' -> Contact
toContact' contactId conn chatTags ((profileId, localDisplayName, viaGroup, displayName, fullName, shortDescr, image, contactLink, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL)) =
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, preferences, localAlias}
toContact' contactId conn chatTags ((profileId, localDisplayName, viaGroup, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL)) =
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
activeConn = Just conn
@@ -148,12 +148,12 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
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,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at,
mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts,
-- from GroupMember
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.local_alias, p.preferences,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts
FROM group_members m
src/Simplex/Chat/Store/ContactRequest.hs
+3 -4
View File
@@ -109,7 +109,7 @@ createOrUpdateContactRequest
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.chat_peer_type, 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.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.request_shared_msg_id, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
@@ -144,7 +144,7 @@ createOrUpdateContactRequest
SELECT
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, cr.xcontact_id,
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, cr.xcontact_id,
cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
cr.created_at, cr.updated_at,
cr.peer_chat_min_version, cr.peer_chat_max_version
@@ -204,8 +204,7 @@ createOrUpdateContactRequest
ct <- getContact db vr user contactId
pure $ RSCurrentRequest Nothing ucr (Just $ REContact ct)
createBusinessChat = do
let Profile {preferences = userPreferences} = userProfileInGroup user Nothing
groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs userPreferences
let groupPreferences = maybe defaultBusinessGroupPrefs businessGroupPrefs $ preferences' user
(gInfo@GroupInfo {groupId}, clientMember) <-
createBusinessRequestGroup db vr gVar user cReqChatVRange profile profileId ldn groupPreferences
liftIO $
src/Simplex/Chat/Store/Direct.hs
+6 -6
View File
@@ -262,7 +262,7 @@ getContactByConnReqHash db vr user@User {userId} cReqHash1 cReqHash2 = do
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.chat_peer_type, 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.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.request_shared_msg_id, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
@@ -642,15 +642,15 @@ updateContactProfile_ db userId profileId profile = do
updateContactProfile_' db userId profileId profile currentTs
updateContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> UTCTime -> IO ()
updateContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences} updatedAt = do
updateContactProfile_' db userId profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType} updatedAt = do
DB.execute
db
[sql|
UPDATE contact_profiles
SET display_name = ?, full_name = ?, short_descr = ?, image = ?, contact_link = ?, preferences = ?, updated_at = ?
SET display_name = ?, full_name = ?, short_descr = ?, image = ?, contact_link = ?, preferences = ?, chat_peer_type = ?, updated_at = ?
WHERE user_id = ? AND contact_profile_id = ?
|]
(displayName, fullName, shortDescr, image, contactLink, preferences, updatedAt, userId, profileId)
(displayName, fullName, shortDescr, image, contactLink, preferences, peerType, updatedAt, userId, profileId)
-- update only member profile fields (when member doesn't have associated contact - we can reset contactLink and prefs)
updateMemberContactProfileReset_ :: DB.Connection -> UserId -> ProfileId -> Profile -> IO ()
@@ -735,7 +735,7 @@ contactRequestQuery =
SELECT
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, cr.xcontact_id,
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, cr.xcontact_id,
cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
cr.created_at, cr.updated_at,
cr.peer_chat_min_version, cr.peer_chat_max_version
@@ -854,7 +854,7 @@ getContact_ db vr user@User {userId} contactId deleted = do
[sql|
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.chat_peer_type, 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.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.request_shared_msg_id, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
src/Simplex/Chat/Store/Groups.hs
+7 -7
View File
@@ -201,11 +201,11 @@ import Database.SQLite.Simple (Only (..), Query, (:.) (..))
import Database.SQLite.Simple.QQ (sql)
#endif
type MaybeGroupMemberRow = (Maybe Int64, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId) :. (Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe LocalAlias, Maybe Preferences) :. (Maybe UTCTime, Maybe UTCTime) :. (Maybe UTCTime, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime)
type MaybeGroupMemberRow = (Maybe Int64, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId) :. (Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe LocalAlias, Maybe Preferences) :. (Maybe UTCTime, Maybe UTCTime) :. (Maybe UTCTime, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime)
toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember
toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId) :. (Just profileId, Just displayName, Just fullName, shortDescr, image, contactLink, Just localAlias, contactPreferences) :. (Just createdAt, Just updatedAt) :. (supportChatTs, Just supportChatUnread, Just supportChatUnanswered, Just supportChatMentions, supportChatLastMsgFromMemberTs)) =
Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId) :. (profileId, displayName, fullName, shortDescr, image, contactLink, localAlias, contactPreferences) :. (createdAt, updatedAt) :. (supportChatTs, supportChatUnread, supportChatUnanswered, supportChatMentions, supportChatLastMsgFromMemberTs))
toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId) :. (Just profileId, Just displayName, Just fullName, shortDescr, image, contactLink, peerType, Just localAlias, contactPreferences) :. (Just createdAt, Just updatedAt) :. (supportChatTs, Just supportChatUnread, Just supportChatUnanswered, Just supportChatMentions, supportChatLastMsgFromMemberTs)) =
Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId) :. (profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, contactPreferences) :. (createdAt, updatedAt) :. (supportChatTs, supportChatUnread, supportChatUnanswered, supportChatMentions, supportChatLastMsgFromMemberTs))
toMaybeGroupMember _ _ = Nothing
createGroupLink :: DB.Connection -> User -> GroupInfo -> ConnId -> CreatedLinkContact -> GroupLinkId -> GroupMemberRole -> SubscriptionMode -> ExceptT StoreError IO GroupLink
@@ -958,7 +958,7 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = do
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
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.short_descr, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
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.short_descr, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at,
mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts
FROM groups g
@@ -1024,7 +1024,7 @@ groupMemberQuery =
[sql|
SELECT
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.local_alias, p.preferences,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
@@ -1918,12 +1918,12 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = do
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,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at,
mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts,
-- via GroupMember
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.local_alias, p.preferences,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
src/Simplex/Chat/Store/Messages.hs
+5 -5
View File
@@ -648,7 +648,7 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
-- GroupMember
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.local_alias, p.preferences,
p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts
FROM group_members m
@@ -1066,7 +1066,7 @@ getContactRequestChatPreviews_ db User {userId} pagination clq = case clq of
SELECT
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, cr.xcontact_id,
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, cr.xcontact_id,
cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
cr.created_at, cr.updated_at,
cr.peer_chat_min_version, cr.peer_chat_max_version
@@ -2920,7 +2920,7 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
-- GroupMember
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.local_alias, p.preferences,
p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts,
-- quoted ChatItem
@@ -2928,13 +2928,13 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
-- quoted GroupMember
rm.group_member_id, rm.group_id, rm.member_id, rm.peer_chat_min_version, rm.peer_chat_max_version, rm.member_role, rm.member_category,
rm.member_status, rm.show_messages, rm.member_restriction, rm.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
rp.display_name, rp.full_name, rp.short_descr, rp.image, rp.contact_link, rp.local_alias, rp.preferences,
rp.display_name, rp.full_name, rp.short_descr, rp.image, rp.contact_link, rp.chat_peer_type, rp.local_alias, rp.preferences,
rm.created_at, rm.updated_at,
rm.support_chat_ts, rm.support_chat_items_unread, rm.support_chat_items_member_attention, rm.support_chat_items_mentions, rm.support_chat_last_msg_from_member_ts,
-- deleted by GroupMember
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.peer_chat_min_version, dbm.peer_chat_max_version, dbm.member_role, dbm.member_category,
dbm.member_status, dbm.show_messages, dbm.member_restriction, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
dbp.display_name, dbp.full_name, dbp.short_descr, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences,
dbp.display_name, dbp.full_name, dbp.short_descr, dbp.image, dbp.contact_link, dbp.chat_peer_type, dbp.local_alias, dbp.preferences,
dbm.created_at, dbm.updated_at,
dbm.support_chat_ts, dbm.support_chat_items_unread, dbm.support_chat_items_member_attention, dbm.support_chat_items_mentions, dbm.support_chat_last_msg_from_member_ts
FROM chat_items i
src/Simplex/Chat/Store/Postgres/Migrations.hs
+3 -1
View File
@@ -15,6 +15,7 @@ import Simplex.Chat.Store.Postgres.Migrations.M20250709_profile_short_descr
import Simplex.Chat.Store.Postgres.Migrations.M20250721_indexes
import Simplex.Chat.Store.Postgres.Migrations.M20250729_member_contact_requests
import Simplex.Chat.Store.Postgres.Migrations.M20250801_via_group_link_uri
import Simplex.Chat.Store.Postgres.Migrations.M20250802_chat_peer_type
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Text, Maybe Text)]
@@ -29,7 +30,8 @@ schemaMigrations =
("20250709_profile_short_descr", m20250709_profile_short_descr, Just down_m20250709_profile_short_descr),
("20250721_indexes", m20250721_indexes, Just down_m20250721_indexes),
("20250729_member_contact_requests", m20250729_member_contact_requests, Just down_m20250729_member_contact_requests),
("20250801_via_group_link_uri", m20250801_via_group_link_uri, Just down_m20250801_via_group_link_uri)
("20250801_via_group_link_uri", m20250801_via_group_link_uri, Just down_m20250801_via_group_link_uri),
("20250802_chat_peer_type", m20250802_chat_peer_type, Just down_m20250802_chat_peer_type)
]
-- | The list of migrations in ascending order by date
src/Simplex/Chat/Store/Postgres/Migrations/M20250802_chat_peer_type.hs
+21
View File
@@ -0,0 +1,21 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.Postgres.Migrations.M20250802_chat_peer_type where
import Data.Text (Text)
import qualified Data.Text as T
import Text.RawString.QQ (r)
m20250802_chat_peer_type :: Text
m20250802_chat_peer_type =
T.pack
[r|
ALTER TABLE contact_profiles ADD COLUMN chat_peer_type TEXT;
|]
down_m20250802_chat_peer_type :: Text
down_m20250802_chat_peer_type =
T.pack
[r|
ALTER TABLE contact_profiles DROP COLUMN chat_peer_type;
|]
src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql
+2 -1
View File
@@ -333,7 +333,8 @@ CREATE TABLE test_chat_schema.contact_profiles (
local_alias text DEFAULT ''::text NOT NULL,
preferences text,
contact_link bytea,
short_descr text
short_descr text,
chat_peer_type text
);
src/Simplex/Chat/Store/Profiles.hs
+7 -7
View File
@@ -130,7 +130,7 @@ createUserRecord :: DB.Connection -> AgentUserId -> Profile -> Bool -> ExceptT S
createUserRecord db auId p activeUser = createUserRecordAt db auId p activeUser =<< liftIO getCurrentTime
createUserRecordAt :: DB.Connection -> AgentUserId -> Profile -> Bool -> UTCTime -> ExceptT StoreError IO User
createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, shortDescr, image, preferences = userPreferences} activeUser currentTs =
createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, shortDescr, image, peerType, preferences = userPreferences} activeUser currentTs =
checkConstraint SEDuplicateName . liftIO $ do
when activeUser $ DB.execute_ db "UPDATE users SET active_user = 0"
let showNtfs = True
@@ -149,8 +149,8 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, shortDe
(displayName, displayName, userId, currentTs, currentTs)
DB.execute
db
"INSERT INTO contact_profiles (display_name, full_name, short_descr, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
(displayName, fullName, shortDescr, image, userId, userPreferences, currentTs, currentTs)
"INSERT INTO contact_profiles (display_name, full_name, short_descr, image, chat_peer_type, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
(displayName, fullName, shortDescr, image, peerType, userId, userPreferences, currentTs, currentTs)
profileId <- insertedRowId db
DB.execute
db
@@ -158,7 +158,7 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, shortDe
(profileId, displayName, userId, BI 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, BI activeUser, order, displayName, fullName, shortDescr, image, Nothing, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, Nothing, Nothing, Nothing, Nothing)
pure $ toUser $ (userId, auId, contactId, profileId, BI activeUser, order) :. (displayName, fullName, shortDescr, image, Nothing, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, Nothing, Nothing, Nothing, Nothing)
-- TODO [mentions]
getUsersInfo :: DB.Connection -> IO [UserInfo]
@@ -350,14 +350,14 @@ getUserContactProfiles db User {userId} =
<$> DB.query
db
[sql|
SELECT display_name, full_name, short_descr, image, contact_link, preferences
SELECT display_name, full_name, short_descr, image, contact_link, chat_peer_type, preferences
FROM contact_profiles
WHERE user_id = ?
|]
(Only userId)
where
toContactProfile :: (ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe Preferences) -> Profile
toContactProfile (displayName, fullName, shortDescr, image, contactLink, preferences) = Profile {displayName, fullName, shortDescr, image, contactLink, preferences}
toContactProfile :: (ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences) -> Profile
toContactProfile (displayName, fullName, shortDescr, image, contactLink, peerType, preferences) = Profile {displayName, fullName, shortDescr, image, contactLink, peerType, preferences}
createUserContactLink :: DB.Connection -> User -> ConnId -> CreatedLinkContact -> SubscriptionMode -> ExceptT StoreError IO ()
createUserContactLink db User {userId} agentConnId (CCLink cReq shortLink) subMode =
src/Simplex/Chat/Store/SQLite/Migrations.hs
+3 -1
View File
@@ -138,6 +138,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20250709_profile_short_descr
import Simplex.Chat.Store.SQLite.Migrations.M20250721_indexes
import Simplex.Chat.Store.SQLite.Migrations.M20250729_member_contact_requests
import Simplex.Chat.Store.SQLite.Migrations.M20250801_via_group_link_uri
import Simplex.Chat.Store.SQLite.Migrations.M20250802_chat_peer_type
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@@ -275,7 +276,8 @@ schemaMigrations =
("20250709_profile_short_descr", m20250709_profile_short_descr, Just down_m20250709_profile_short_descr),
("20250721_indexes", m20250721_indexes, Just down_m20250721_indexes),
("20250729_member_contact_requests", m20250729_member_contact_requests, Just down_m20250729_member_contact_requests),
("20250801_via_group_link_uri", m20250801_via_group_link_uri, Just down_m20250801_via_group_link_uri)
("20250801_via_group_link_uri", m20250801_via_group_link_uri, Just down_m20250801_via_group_link_uri),
("20250802_chat_peer_type", m20250802_chat_peer_type, Just down_m20250802_chat_peer_type)
]
-- | The list of migrations in ascending order by date
src/Simplex/Chat/Store/SQLite/Migrations/M20250802_chat_peer_type.hs
+18
View File
@@ -0,0 +1,18 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.SQLite.Migrations.M20250802_chat_peer_type where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20250802_chat_peer_type :: Query
m20250802_chat_peer_type =
[sql|
ALTER TABLE contact_profiles ADD COLUMN chat_peer_type TEXT;
|]
down_m20250802_chat_peer_type :: Query
down_m20250802_chat_peer_type =
[sql|
ALTER TABLE contact_profiles DROP COLUMN chat_peer_type;
|]
src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt
+45 -45
View File
@@ -70,12 +70,12 @@ Query:
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,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at,
mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts,
-- from GroupMember
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.local_alias, p.preferences,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts
FROM group_members m
@@ -196,7 +196,7 @@ Plan:
Query:
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.chat_peer_type, 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.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.request_shared_msg_id, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
@@ -386,7 +386,7 @@ Plan:
Query:
SELECT
c.contact_profile_id, c.local_display_name, c.via_group, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.local_alias, c.contact_used, c.contact_status, c.enable_ntfs, c.send_rcpts, c.favorite,
c.contact_profile_id, c.local_display_name, c.via_group, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, 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.conn_full_link_to_connect, c.conn_short_link_to_connect, c.welcome_shared_msg_id, c.request_shared_msg_id, c.contact_request_id,
c.contact_group_member_id, c.contact_grp_inv_sent, c.grp_direct_inv_link, c.grp_direct_inv_from_group_id, c.grp_direct_inv_from_group_member_id, c.grp_direct_inv_from_member_conn_id, c.grp_direct_inv_started_connection,
c.ui_themes, c.chat_deleted, c.custom_data, c.chat_item_ttl
@@ -402,7 +402,7 @@ Query:
SELECT
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, cr.xcontact_id,
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, cr.xcontact_id,
cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
cr.created_at, cr.updated_at,
cr.peer_chat_min_version, cr.peer_chat_max_version
@@ -677,7 +677,7 @@ Query:
-- GroupMember
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.local_alias, p.preferences,
p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts
FROM group_members m
@@ -871,7 +871,7 @@ Query:
-- GroupMember
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category,
m.member_status, m.show_messages, m.member_restriction, m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.local_alias, p.preferences,
p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts,
-- quoted ChatItem
@@ -879,13 +879,13 @@ Query:
-- quoted GroupMember
rm.group_member_id, rm.group_id, rm.member_id, rm.peer_chat_min_version, rm.peer_chat_max_version, rm.member_role, rm.member_category,
rm.member_status, rm.show_messages, rm.member_restriction, rm.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
rp.display_name, rp.full_name, rp.short_descr, rp.image, rp.contact_link, rp.local_alias, rp.preferences,
rp.display_name, rp.full_name, rp.short_descr, rp.image, rp.contact_link, rp.chat_peer_type, rp.local_alias, rp.preferences,
rm.created_at, rm.updated_at,
rm.support_chat_ts, rm.support_chat_items_unread, rm.support_chat_items_member_attention, rm.support_chat_items_mentions, rm.support_chat_last_msg_from_member_ts,
-- deleted by GroupMember
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.peer_chat_min_version, dbm.peer_chat_max_version, dbm.member_role, dbm.member_category,
dbm.member_status, dbm.show_messages, dbm.member_restriction, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
dbp.display_name, dbp.full_name, dbp.short_descr, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences,
dbp.display_name, dbp.full_name, dbp.short_descr, dbp.image, dbp.contact_link, dbp.chat_peer_type, dbp.local_alias, dbp.preferences,
dbm.created_at, dbm.updated_at,
dbm.support_chat_ts, dbm.support_chat_items_unread, dbm.support_chat_items_member_attention, dbm.support_chat_items_mentions, dbm.support_chat_last_msg_from_member_ts
FROM chat_items i
@@ -937,7 +937,7 @@ SEARCH ri USING COVERING INDEX idx_chat_items_direct_shared_msg_id (user_id=? AN
Query:
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.chat_peer_type, 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.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.request_shared_msg_id, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
@@ -978,12 +978,12 @@ Query:
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,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at,
mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts,
-- via GroupMember
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.local_alias, p.preferences,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
@@ -1025,7 +1025,7 @@ Query:
g.business_chat, g.business_member_id, g.customer_member_id,
g.ui_themes, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
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.short_descr, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
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.short_descr, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at,
mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts
FROM groups g
@@ -1580,7 +1580,7 @@ Plan:
Query:
SELECT
-- Contact
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.chat_peer_type, 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.conn_full_link_to_connect, ct.conn_short_link_to_connect, ct.welcome_shared_msg_id, ct.request_shared_msg_id, ct.contact_request_id,
ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.grp_direct_inv_link, ct.grp_direct_inv_from_group_id, ct.grp_direct_inv_from_group_member_id, ct.grp_direct_inv_from_member_conn_id, ct.grp_direct_inv_started_connection,
ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
@@ -1684,7 +1684,7 @@ Query:
SELECT
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, cr.xcontact_id,
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, cr.xcontact_id,
cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
cr.created_at, cr.updated_at,
cr.peer_chat_min_version, cr.peer_chat_max_version
@@ -1713,7 +1713,7 @@ Query:
SELECT
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, cr.xcontact_id,
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, cr.xcontact_id,
cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
cr.created_at, cr.updated_at,
cr.peer_chat_min_version, cr.peer_chat_max_version
@@ -1742,7 +1742,7 @@ Query:
SELECT
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, cr.xcontact_id,
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, cr.xcontact_id,
cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
cr.created_at, cr.updated_at,
cr.peer_chat_min_version, cr.peer_chat_max_version
@@ -3231,7 +3231,7 @@ Plan:
SEARCH connections USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT cp.contact_profile_id, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.local_alias, cp.preferences -- , ct.user_preferences
SELECT cp.contact_profile_id, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.chat_peer_type, cp.local_alias, cp.preferences -- , ct.user_preferences
FROM contact_profiles cp
WHERE cp.user_id = ? AND cp.contact_profile_id = ?
@@ -3274,7 +3274,7 @@ SEARCH f USING PRIMARY KEY (file_id=?)
SEARCH d USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT display_name, full_name, short_descr, image, contact_link, preferences
SELECT display_name, full_name, short_descr, image, contact_link, chat_peer_type, preferences
FROM contact_profiles
WHERE user_id = ?
@@ -4462,7 +4462,7 @@ SEARCH contact_profiles USING INTEGER PRIMARY KEY (rowid=?)
Query:
UPDATE contact_profiles
SET display_name = ?, full_name = ?, short_descr = ?, image = ?, contact_link = ?, preferences = ?, updated_at = ?
SET display_name = ?, full_name = ?, short_descr = ?, image = ?, contact_link = ?, preferences = ?, chat_peer_type = ?, updated_at = ?
WHERE user_id = ? AND contact_profile_id = ?
Plan:
@@ -4753,7 +4753,7 @@ Query:
-- 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,
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at,
mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts
FROM groups g
@@ -4779,7 +4779,7 @@ Query:
-- 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,
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at,
mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts
FROM groups g
@@ -4797,7 +4797,7 @@ Query:
SELECT
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, cr.xcontact_id,
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, cr.xcontact_id,
cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
cr.created_at, cr.updated_at,
cr.peer_chat_min_version, cr.peer_chat_max_version
@@ -4812,7 +4812,7 @@ Query:
SELECT
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id,
cr.contact_id, cr.business_group_id, cr.user_contact_link_id,
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, cr.xcontact_id,
cr.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, cr.xcontact_id,
cr.pq_support, cr.welcome_shared_msg_id, cr.request_shared_msg_id, p.preferences,
cr.created_at, cr.updated_at,
cr.peer_chat_min_version, cr.peer_chat_max_version
@@ -4826,7 +4826,7 @@ SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.local_alias, p.preferences,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
@@ -4859,7 +4859,7 @@ SEARCH cc USING COVERING INDEX idx_connections_group_member (user_id=? AND group
Query:
SELECT
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.local_alias, p.preferences,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
@@ -4884,7 +4884,7 @@ SEARCH cc USING COVERING INDEX idx_connections_group_member (user_id=? AND group
Query:
SELECT
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.local_alias, p.preferences,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
@@ -4909,7 +4909,7 @@ SEARCH cc USING COVERING INDEX idx_connections_group_member (user_id=? AND group
Query:
SELECT
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.local_alias, p.preferences,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
@@ -4934,7 +4934,7 @@ SEARCH cc USING COVERING INDEX idx_connections_group_member (user_id=? AND group
Query:
SELECT
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.local_alias, p.preferences,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
@@ -4959,7 +4959,7 @@ SEARCH cc USING COVERING INDEX idx_connections_group_member (user_id=? AND group
Query:
SELECT
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.local_alias, p.preferences,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
@@ -4984,7 +4984,7 @@ SEARCH cc USING COVERING INDEX idx_connections_group_member (user_id=? AND group
Query:
SELECT
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.local_alias, p.preferences,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
@@ -5130,7 +5130,7 @@ Plan:
SEARCH server_operators USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, 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
@@ -5142,7 +5142,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, 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
@@ -5155,7 +5155,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, 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
@@ -5168,7 +5168,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, 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
@@ -5182,7 +5182,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, 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
@@ -5195,7 +5195,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, 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
@@ -5208,7 +5208,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, 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
@@ -5221,7 +5221,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, 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
@@ -5234,7 +5234,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
Query:
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, 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
@@ -5727,7 +5727,11 @@ Plan:
Query: INSERT INTO chat_item_messages (chat_item_id, message_id, created_at, updated_at) VALUES (?,?,?,?)
Plan:
Query: INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, local_alias, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?)
Query: INSERT INTO contact_profiles (display_name, full_name, short_descr, image, chat_peer_type, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)
Plan:
SEARCH contact_requests USING COVERING INDEX idx_contact_requests_contact_profile_id (contact_profile_id=?)
Query: INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, chat_peer_type, user_id, local_alias, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH contact_requests USING COVERING INDEX idx_contact_requests_contact_profile_id (contact_profile_id=?)
@@ -5735,10 +5739,6 @@ Query: INSERT INTO contact_profiles (display_name, full_name, short_descr, image
Plan:
SEARCH contact_requests USING COVERING INDEX idx_contact_requests_contact_profile_id (contact_profile_id=?)
Query: INSERT INTO contact_profiles (display_name, full_name, short_descr, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)
Plan:
SEARCH contact_requests USING COVERING INDEX idx_contact_requests_contact_profile_id (contact_profile_id=?)
Query: INSERT INTO contacts (contact_profile_id, local_display_name, user_id, is_user, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?)
Plan:
SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?)
src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql
+2 -1
View File
@@ -19,7 +19,8 @@ CREATE TABLE contact_profiles(
local_alias TEXT DEFAULT '' CHECK(local_alias NOT NULL),
preferences TEXT,
contact_link BLOB,
short_descr TEXT
short_descr TEXT,
chat_peer_type TEXT
);
CREATE TABLE users(
user_id INTEGER PRIMARY KEY,
src/Simplex/Chat/Store/Shared.hs
+18 -18
View File
@@ -387,12 +387,12 @@ createContact db user profile = do
void $ createContact_ db user profile emptyChatPrefs Nothing "" Nothing currentTs
createContact_ :: DB.Connection -> User -> Profile -> Preferences -> Maybe (ACreatedConnLink, Maybe SharedMsgId) -> LocalAlias -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO ContactId
createContact_ db User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, preferences} ctUserPreferences prepared localAlias viaGroup currentTs =
createContact_ db User {userId} Profile {displayName, fullName, shortDescr, image, contactLink, peerType, preferences} ctUserPreferences prepared localAlias viaGroup currentTs =
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
DB.execute
db
"INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, user_id, local_alias, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?)"
(displayName, fullName, shortDescr, image, contactLink, userId, localAlias, preferences, currentTs, currentTs)
"INSERT INTO contact_profiles (display_name, full_name, short_descr, image, contact_link, chat_peer_type, user_id, local_alias, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?)"
((displayName, fullName, shortDescr, image, contactLink, peerType) :. (userId, localAlias, preferences, currentTs, currentTs))
profileId <- insertedRowId db
DB.execute
db
@@ -459,13 +459,13 @@ type PreparedContactRow = (Maybe AConnectionRequestUri, Maybe AConnShortLink, Ma
type GroupDirectInvitationRow = (Maybe ConnReqInvitation, Maybe GroupId, Maybe GroupMemberId, Maybe Int64, BoolInt)
type ContactRow' = (ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, LocalAlias, BoolInt, ContactStatus) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) :. PreparedContactRow :. (Maybe Int64, Maybe GroupMemberId, BoolInt) :. GroupDirectInvitationRow :. (Maybe UIThemeEntityOverrides, BoolInt, Maybe CustomData, Maybe Int64)
type ContactRow' = (ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, BoolInt, ContactStatus) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime) :. PreparedContactRow :. (Maybe Int64, Maybe GroupMemberId, BoolInt) :. GroupDirectInvitationRow :. (Maybe UIThemeEntityOverrides, BoolInt, Maybe CustomData, Maybe Int64)
type ContactRow = Only ContactId :. ContactRow'
toContact :: VersionRangeChat -> User -> [ChatTagId] -> ContactRow :. MaybeConnectionRow -> Contact
toContact vr user chatTags ((Only contactId :. (profileId, localDisplayName, viaGroup, displayName, fullName, shortDescr, image, contactLink, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, preferences, localAlias}
toContact vr user chatTags ((Only contactId :. (profileId, localDisplayName, viaGroup, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, BI contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, BI favorite, preferences, userPreferences, createdAt, updatedAt, chatTs) :. preparedContactRow :. (contactRequestId, contactGroupMemberId, BI contactGrpInvSent) :. groupDirectInvRow :. (uiThemes, BI chatDeleted, customData, chatItemTTL)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, preferences, localAlias}
activeConn = toMaybeConnection vr connRow
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
incognito = maybe False connIncognito activeConn
@@ -496,35 +496,35 @@ getProfileById db userId profileId =
DB.query
db
[sql|
SELECT cp.contact_profile_id, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.local_alias, cp.preferences -- , ct.user_preferences
SELECT cp.contact_profile_id, cp.display_name, cp.full_name, cp.short_descr, cp.image, cp.contact_link, cp.chat_peer_type, cp.local_alias, cp.preferences -- , ct.user_preferences
FROM contact_profiles cp
WHERE cp.user_id = ? AND cp.contact_profile_id = ?
|]
(userId, profileId)
type ContactRequestRow = (Int64, ContactName, AgentInvId, Maybe ContactId, Maybe GroupId, Maybe Int64) :. (Int64, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact) :. (Maybe XContactId, PQSupport, Maybe SharedMsgId, Maybe SharedMsgId, Maybe Preferences, UTCTime, UTCTime, VersionChat, VersionChat)
type ContactRequestRow = (Int64, ContactName, AgentInvId, Maybe ContactId, Maybe GroupId, Maybe Int64) :. (Int64, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType) :. (Maybe XContactId, PQSupport, Maybe SharedMsgId, Maybe SharedMsgId, Maybe Preferences, UTCTime, UTCTime, VersionChat, VersionChat)
toContactRequest :: ContactRequestRow -> UserContactRequest
toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, contactId_, businessGroupId_, userContactLinkId_) :. (profileId, displayName, fullName, shortDescr, image, contactLink) :. (xContactId, pqSupport, welcomeSharedMsgId, requestSharedMsgId, preferences, createdAt, updatedAt, minVer, maxVer)) = do
let profile = Profile {displayName, fullName, shortDescr, image, contactLink, preferences}
toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, contactId_, businessGroupId_, userContactLinkId_) :. (profileId, displayName, fullName, shortDescr, image, contactLink, peerType) :. (xContactId, pqSupport, welcomeSharedMsgId, requestSharedMsgId, preferences, createdAt, updatedAt, minVer, maxVer)) = do
let profile = Profile {displayName, fullName, shortDescr, image, contactLink, peerType, preferences}
cReqChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
in UserContactRequest {contactRequestId, agentInvitationId, contactId_, businessGroupId_, userContactLinkId_, cReqChatVRange, localDisplayName, profileId, profile, xContactId, pqSupport, welcomeSharedMsgId, requestSharedMsgId, createdAt, updatedAt}
userQuery :: Query
userQuery =
[sql|
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.preferences,
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, 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, BoolInt, Int64, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe Preferences) :. (BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, Maybe UIThemeEntityOverrides) -> User
toUser ((userId, auId, userContactId, profileId, BI activeUser, activeOrder, displayName, fullName, shortDescr, image, contactLink, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, uiThemes)) =
toUser :: (UserId, UserId, ContactId, ProfileId, BoolInt, Int64) :. (ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences) :. (BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, Maybe UIThemeEntityOverrides) -> User
toUser ((userId, auId, userContactId, profileId, BI activeUser, activeOrder) :. (displayName, fullName, shortDescr, image, contactLink, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, uiThemes)) =
User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, activeOrder, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, autoAcceptMemberContacts = BoolDef autoAcceptMemberContacts, viewPwdHash, userMemberProfileUpdatedAt, uiThemes}
where
profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, preferences = userPreferences, localAlias = ""}
profile = LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, preferences = userPreferences, localAlias = ""}
fullPreferences = fullPreferences' userPreferences
viewPwdHash = UserPwdHash <$> viewPwdHash_ <*> viewPwdSalt_
@@ -642,7 +642,7 @@ type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Text, Maybe
type GroupMemberRow = (Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId) :. ProfileRow :. (UTCTime, UTCTime) :. (Maybe UTCTime, Int64, Int64, Int64, Maybe UTCTime)
type ProfileRow = (ProfileId, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, LocalAlias, Maybe Preferences)
type ProfileRow = (ProfileId, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, Maybe Preferences)
toGroupInfo :: VersionRangeChat -> Int64 -> [ChatTagId] -> GroupInfoRow -> GroupInfo
toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, shortDescr, localAlias, description, image) :. (enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (uiThemes, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. userMemberRow) =
@@ -681,8 +681,8 @@ toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer,
in GroupMember {..}
rowToLocalProfile :: ProfileRow -> LocalProfile
rowToLocalProfile (profileId, displayName, fullName, shortDescr, image, contactLink, localAlias, preferences) =
LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, localAlias, preferences}
rowToLocalProfile (profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, preferences) =
LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, peerType, localAlias, preferences}
toBusinessChatInfo :: BusinessChatInfoRow -> Maybe BusinessChatInfo
toBusinessChatInfo (Just chatType, Just businessId, Just customerId) = Just BusinessChatInfo {chatType, businessId, customerId}
@@ -702,7 +702,7 @@ groupInfoQuery =
-- 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,
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
pu.display_name, pu.full_name, pu.short_descr, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences,
mu.created_at, mu.updated_at,
mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts
FROM groups g
src/Simplex/Chat/Types.hs
+37 -9
View File
@@ -616,7 +616,10 @@ contactUserPreferences user userPreferences contactPreferences connectedIncognit
fullDelete = pref SCFFullDelete,
reactions = pref SCFReactions,
voice = pref SCFVoice,
calls = pref SCFCalls
files = pref SCFFiles,
calls = pref SCFCalls,
sessions = pref SCFSessions,
commands = contactPreferences >>= commands_
}
where
pref :: FeatureI f => SChatFeature f -> ContactUserPreference (FeaturePreference f)
@@ -642,7 +645,8 @@ data Profile = Profile
shortDescr :: Maybe Text, -- short description limited to 160 characters
image :: Maybe ImageData,
contactLink :: Maybe ConnLinkContact,
preferences :: Maybe Preferences
preferences :: Maybe Preferences,
peerType :: Maybe ChatPeerType
-- fields that should not be read into this data type to prevent sending them as part of profile to contacts:
-- - contact_profile_id
-- - incognito
@@ -650,9 +654,32 @@ data Profile = Profile
}
deriving (Eq, Show)
data ChatPeerType = CPTHuman | CPTBot
deriving (Eq, Show)
instance FromJSON ChatPeerType where
parseJSON = textParseJSON "ChatPeerType"
instance ToJSON ChatPeerType where
toJSON = J.String . textEncode
toEncoding = JE.text . textEncode
instance FromField ChatPeerType where fromField = fromTextField_ textDecode
instance ToField ChatPeerType where toField = toField . textEncode
instance TextEncoding ChatPeerType where
textDecode = \case
"human" -> Just CPTHuman
"bot" -> Just CPTBot
_ -> Nothing
textEncode = \case
CPTHuman -> "human"
CPTBot -> "bot"
profileFromName :: ContactName -> Profile
profileFromName displayName =
Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, preferences = Nothing}
Profile {displayName, fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, preferences = Nothing, peerType = Nothing}
-- check if profiles match ignoring preferences
profilesMatch :: LocalProfile -> LocalProfile -> Bool
@@ -662,8 +689,8 @@ profilesMatch
n1 == n2 && fn1 == fn2 && i1 == i2
redactedMemberProfile :: Profile -> Profile
redactedMemberProfile Profile {displayName, fullName, shortDescr, image} =
Profile {displayName, fullName, shortDescr, image, contactLink = Nothing, preferences = Nothing}
redactedMemberProfile Profile {displayName, fullName, shortDescr, image, peerType} =
Profile {displayName, fullName, shortDescr, image, contactLink = Nothing, preferences = Nothing, peerType}
data IncognitoProfile = NewIncognito Profile | ExistingIncognito LocalProfile
@@ -700,6 +727,7 @@ data LocalProfile = LocalProfile
image :: Maybe ImageData,
contactLink :: Maybe ConnLinkContact,
preferences :: Maybe Preferences,
peerType :: Maybe ChatPeerType,
localAlias :: LocalAlias
}
deriving (Eq, Show)
@@ -708,12 +736,12 @@ localProfileId :: LocalProfile -> ProfileId
localProfileId LocalProfile {profileId} = profileId
toLocalProfile :: ProfileId -> Profile -> LocalAlias -> LocalProfile
toLocalProfile profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences} localAlias =
LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, preferences, localAlias}
toLocalProfile profileId Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType} localAlias =
LocalProfile {profileId, displayName, fullName, shortDescr, image, contactLink, preferences, peerType, localAlias}
fromLocalProfile :: LocalProfile -> Profile
fromLocalProfile LocalProfile {displayName, fullName, shortDescr, image, contactLink, preferences} =
Profile {displayName, fullName, shortDescr, image, contactLink, preferences}
fromLocalProfile LocalProfile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType} =
Profile {displayName, fullName, shortDescr, image, contactLink, preferences, peerType}
data GroupProfile = GroupProfile
{ displayName :: GroupName,
src/Simplex/Chat/Types/Preferences.hs
+174 -25
View File
@@ -1,9 +1,11 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
@@ -34,7 +36,7 @@ import Simplex.Chat.Options.DB (FromField (..), ToField (..))
import Simplex.Chat.Types.Shared
import Simplex.Messaging.Agent.Store.DB (blobFieldDecoder, fromTextField_)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON)
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON, taggedObjectJSON)
import Simplex.Messaging.Util (decodeJSON, encodeJSON, safeDecodeUtf8, (<$?>))
data ChatFeature
@@ -42,7 +44,9 @@ data ChatFeature
| CFFullDelete
| CFReactions
| CFVoice
| CFFiles
| CFCalls
| CFSessions
deriving (Show)
data SChatFeature (f :: ChatFeature) where
@@ -50,7 +54,9 @@ data SChatFeature (f :: ChatFeature) where
SCFFullDelete :: SChatFeature 'CFFullDelete
SCFReactions :: SChatFeature 'CFReactions
SCFVoice :: SChatFeature 'CFVoice
SCFFiles :: SChatFeature 'CFFiles
SCFCalls :: SChatFeature 'CFCalls
SCFSessions :: SChatFeature 'CFSessions
deriving instance Show (SChatFeature f)
@@ -64,7 +70,9 @@ chatFeatureNameText = \case
CFFullDelete -> "Full deletion"
CFReactions -> "Message reactions"
CFVoice -> "Voice messages"
CFFiles -> "Files and media"
CFCalls -> "Audio/video calls"
CFSessions -> "Chat sessions"
chatFeatureNameText' :: SChatFeature f -> Text
chatFeatureNameText' = chatFeatureNameText . chatFeature
@@ -75,16 +83,20 @@ allChatFeatures =
ACF SCFFullDelete,
ACF SCFReactions,
ACF SCFVoice,
-- ACF SCFFiles, -- not showing in the UI
ACF SCFCalls
-- ACF SCFSessions -- not showing in the UI
]
chatPrefSel :: SChatFeature f -> Preferences -> Maybe (FeaturePreference f)
chatPrefSel f Preferences {timedMessages, fullDelete, reactions, voice, calls} = case f of
chatPrefSel f Preferences {timedMessages, fullDelete, reactions, voice, files, calls, sessions} = case f of
SCFTimedMessages -> timedMessages
SCFFullDelete -> fullDelete
SCFReactions -> reactions
SCFVoice -> voice
SCFFiles -> files
SCFCalls -> calls
SCFSessions -> sessions
chatFeature :: SChatFeature f -> ChatFeature
chatFeature = \case
@@ -92,7 +104,9 @@ chatFeature = \case
SCFFullDelete -> CFFullDelete
SCFReactions -> CFReactions
SCFVoice -> CFVoice
SCFFiles -> CFFiles
SCFCalls -> CFCalls
SCFSessions -> CFSessions
class PreferenceI p where
getPreference :: SChatFeature f -> p -> FeaturePreference f
@@ -104,12 +118,14 @@ instance PreferenceI (Maybe Preferences) where
getPreference f prefs = fromMaybe (getPreference f defaultChatPrefs) (chatPrefSel f =<< prefs)
instance PreferenceI FullPreferences where
getPreference f FullPreferences {timedMessages, fullDelete, reactions, voice, calls} = case f of
getPreference f FullPreferences {timedMessages, fullDelete, reactions, voice, files, calls, sessions} = case f of
SCFTimedMessages -> timedMessages
SCFFullDelete -> fullDelete
SCFReactions -> reactions
SCFVoice -> voice
SCFFiles -> files
SCFCalls -> calls
SCFSessions -> sessions
{-# INLINE getPreference #-}
setPreference :: forall f. FeatureI f => SChatFeature f -> Maybe FeatureAllowed -> Maybe Preferences -> Preferences
@@ -129,7 +145,9 @@ setPreference_ f pref_ prefs =
SCFFullDelete -> prefs {fullDelete = pref_}
SCFReactions -> prefs {reactions = pref_}
SCFVoice -> prefs {voice = pref_}
SCFFiles -> prefs {files = pref_}
SCFCalls -> prefs {calls = pref_}
SCFSessions -> prefs {sessions = pref_}
-- collection of optional chat preferences for the user and the contact
data Preferences = Preferences
@@ -137,10 +155,17 @@ data Preferences = Preferences
fullDelete :: Maybe FullDeletePreference,
reactions :: Maybe ReactionsPreference,
voice :: Maybe VoicePreference,
calls :: Maybe CallsPreference
files :: Maybe FilesPreference,
calls :: Maybe CallsPreference,
sessions :: Maybe SessionsPreference,
commands :: Maybe [ChatBotCommand]
}
deriving (Eq, Show)
class HasCommands p where commands_ :: p -> Maybe [ChatBotCommand]
instance HasCommands Preferences where commands_ Preferences {commands} = commands
data GroupFeature
= GFTimedMessages
| GFDirectMessages
@@ -151,6 +176,7 @@ data GroupFeature
| GFSimplexLinks
| GFReports
| GFHistory
| GFSessions
deriving (Show)
data SGroupFeature (f :: GroupFeature) where
@@ -163,6 +189,7 @@ data SGroupFeature (f :: GroupFeature) where
SGFSimplexLinks :: SGroupFeature 'GFSimplexLinks
SGFReports :: SGroupFeature 'GFReports
SGFHistory :: SGroupFeature 'GFHistory
SGFSessions :: SGroupFeature 'GFSessions
deriving instance Show (SGroupFeature f)
@@ -189,6 +216,7 @@ groupFeatureNameText = \case
GFSimplexLinks -> "SimpleX links"
GFReports -> "Member reports"
GFHistory -> "Recent history"
GFSessions -> "Chat sessions"
groupFeatureNameText' :: SGroupFeature f -> Text
groupFeatureNameText' = groupFeatureNameText . toGroupFeature
@@ -216,7 +244,7 @@ allGroupFeatures =
]
groupPrefSel :: SGroupFeature f -> GroupPreferences -> Maybe (GroupFeaturePreference f)
groupPrefSel f GroupPreferences {timedMessages, directMessages, fullDelete, reactions, voice, files, simplexLinks, reports, history} = case f of
groupPrefSel f GroupPreferences {timedMessages, directMessages, fullDelete, reactions, voice, files, simplexLinks, reports, history, sessions} = case f of
SGFTimedMessages -> timedMessages
SGFDirectMessages -> directMessages
SGFFullDelete -> fullDelete
@@ -226,6 +254,7 @@ groupPrefSel f GroupPreferences {timedMessages, directMessages, fullDelete, reac
SGFSimplexLinks -> simplexLinks
SGFReports -> reports
SGFHistory -> history
SGFSessions -> sessions
toGroupFeature :: SGroupFeature f -> GroupFeature
toGroupFeature = \case
@@ -238,6 +267,7 @@ toGroupFeature = \case
SGFSimplexLinks -> GFSimplexLinks
SGFReports -> GFReports
SGFHistory -> GFHistory
SGFSessions -> GFSessions
class GroupPreferenceI p where
getGroupPreference :: SGroupFeature f -> p -> GroupFeaturePreference f
@@ -249,7 +279,7 @@ instance GroupPreferenceI (Maybe GroupPreferences) where
getGroupPreference pt prefs = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPrefSel pt =<< prefs)
instance GroupPreferenceI FullGroupPreferences where
getGroupPreference f FullGroupPreferences {timedMessages, directMessages, fullDelete, reactions, voice, files, simplexLinks, reports, history} = case f of
getGroupPreference f FullGroupPreferences {timedMessages, directMessages, fullDelete, reactions, voice, files, simplexLinks, reports, history, sessions} = case f of
SGFTimedMessages -> timedMessages
SGFDirectMessages -> directMessages
SGFFullDelete -> fullDelete
@@ -259,6 +289,7 @@ instance GroupPreferenceI FullGroupPreferences where
SGFSimplexLinks -> simplexLinks
SGFReports -> reports
SGFHistory -> history
SGFSessions -> sessions
{-# INLINE getGroupPreference #-}
-- collection of optional group preferences
@@ -271,10 +302,26 @@ data GroupPreferences = GroupPreferences
files :: Maybe FilesGroupPreference,
simplexLinks :: Maybe SimplexLinksGroupPreference,
reports :: Maybe ReportsGroupPreference,
history :: Maybe HistoryGroupPreference
history :: Maybe HistoryGroupPreference,
sessions :: Maybe SessionsGroupPreference,
commands :: Maybe [ChatBotCommand]
}
deriving (Eq, Show)
instance HasCommands GroupPreferences where commands_ GroupPreferences {commands} = commands
data ChatBotCommand
= CBCCommand
{ keyword :: Text, -- "order"
label :: Text, -- Information about order
params :: Maybe Text -- "<order number>", command is sent on selection if params is absent
}
| CBCMenu
{ label :: Text, -- Orders
commands :: [ChatBotCommand]
}
deriving (Eq, Show)
setGroupPreference :: forall f. GroupFeatureNoRoleI f => SGroupFeature f -> GroupFeatureEnabled -> Maybe GroupPreferences -> GroupPreferences
setGroupPreference f enable prefs_ = setGroupPreference_ f pref prefs
where
@@ -306,6 +353,7 @@ setGroupPreference_ f pref prefs =
SGFSimplexLinks -> prefs {simplexLinks = pref}
SGFReports -> prefs {reports = pref}
SGFHistory -> prefs {history = pref}
SGFSessions -> prefs {sessions = pref}
setGroupTimedMessagesPreference :: TimedMessagesGroupPreference -> Maybe GroupPreferences -> GroupPreferences
setGroupTimedMessagesPreference pref prefs_ =
@@ -320,10 +368,21 @@ data FullPreferences = FullPreferences
fullDelete :: FullDeletePreference,
reactions :: ReactionsPreference,
voice :: VoicePreference,
calls :: CallsPreference
files :: FilesPreference,
calls :: CallsPreference,
sessions :: SessionsPreference,
commands :: ListDef ChatBotCommand
}
deriving (Eq, Show)
newtype ListDef a = ListDef [a]
deriving (Eq, Show)
deriving newtype (ToJSON)
instance FromJSON a => FromJSON (ListDef a) where
parseJSON v = ListDef <$> parseJSON v
omittedField = Just (ListDef [])
-- full collection of group preferences defined in the app - it is used to ensure we include all preferences and to simplify processing
-- if some of the preferences are not defined in GroupPreferences, defaults from defaultGroupPrefs are used here.
data FullGroupPreferences = FullGroupPreferences
@@ -335,7 +394,9 @@ data FullGroupPreferences = FullGroupPreferences
files :: FilesGroupPreference,
simplexLinks :: SimplexLinksGroupPreference,
reports :: ReportsGroupPreference,
history :: HistoryGroupPreference
history :: HistoryGroupPreference,
sessions :: SessionsGroupPreference,
commands :: ListDef ChatBotCommand
}
deriving (Eq, Show)
@@ -345,7 +406,10 @@ data ContactUserPreferences = ContactUserPreferences
fullDelete :: ContactUserPreference FullDeletePreference,
reactions :: ContactUserPreference ReactionsPreference,
voice :: ContactUserPreference VoicePreference,
calls :: ContactUserPreference CallsPreference
files :: ContactUserPreference FilesPreference,
calls :: ContactUserPreference CallsPreference,
sessions :: ContactUserPreference SessionsPreference,
commands :: Maybe [ChatBotCommand]
}
deriving (Eq, Show)
@@ -360,13 +424,16 @@ data ContactUserPref p = CUPContact {preference :: p} | CUPUser {preference :: p
deriving (Eq, Show)
toChatPrefs :: FullPreferences -> Preferences
toChatPrefs FullPreferences {timedMessages, fullDelete, reactions, voice, calls} =
toChatPrefs FullPreferences {timedMessages, fullDelete, reactions, voice, files, calls, sessions, commands = ListDef cmds} =
Preferences
{ timedMessages = Just timedMessages,
fullDelete = Just fullDelete,
reactions = Just reactions,
voice = Just voice,
calls = Just calls
files = Just files,
calls = Just calls,
sessions = Just sessions,
commands = Just cmds
}
defaultChatPrefs :: FullPreferences
@@ -376,11 +443,14 @@ defaultChatPrefs =
fullDelete = FullDeletePreference {allow = FANo},
reactions = ReactionsPreference {allow = FAYes},
voice = VoicePreference {allow = FAYes},
calls = CallsPreference {allow = FAYes}
files = FilesPreference {allow = FAAlways},
calls = CallsPreference {allow = FAYes},
sessions = SessionsPreference {allow = FANo},
commands = ListDef []
}
emptyChatPrefs :: Preferences
emptyChatPrefs = Preferences Nothing Nothing Nothing Nothing Nothing
emptyChatPrefs = Preferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
defaultGroupPrefs :: FullGroupPreferences
defaultGroupPrefs =
@@ -393,19 +463,24 @@ defaultGroupPrefs =
files = FilesGroupPreference {enable = FEOn, role = Nothing},
simplexLinks = SimplexLinksGroupPreference {enable = FEOn, role = Nothing},
reports = ReportsGroupPreference {enable = FEOn},
history = HistoryGroupPreference {enable = FEOff}
history = HistoryGroupPreference {enable = FEOff},
sessions = SessionsGroupPreference {enable = FEOff, role = Nothing},
commands = ListDef []
}
emptyGroupPrefs :: GroupPreferences
emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
emptyGroupPrefs = GroupPreferences Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
businessGroupPrefs :: Preferences -> GroupPreferences
businessGroupPrefs Preferences {timedMessages, fullDelete, reactions, voice} =
businessGroupPrefs Preferences {timedMessages, fullDelete, reactions, voice, files, sessions, commands} =
defaultBusinessGroupPrefs
{ timedMessages = Just TimedMessagesGroupPreference {enable = maybe FEOff enableFeature timedMessages, ttl = maybe Nothing prefParam timedMessages},
fullDelete = Just FullDeleteGroupPreference {enable = maybe FEOff enableFeature fullDelete, role = Nothing},
reactions = Just ReactionsGroupPreference {enable = maybe FEOn enableFeature reactions},
voice = Just VoiceGroupPreference {enable = maybe FEOff enableFeature voice, role = Nothing}
voice = Just VoiceGroupPreference {enable = maybe FEOff enableFeature voice, role = Nothing},
files = Just FilesGroupPreference {enable = maybe FEOff enableFeature files, role = Nothing},
sessions = Just SessionsGroupPreference {enable = maybe FEOff enableFeature sessions, role = Nothing},
commands
}
where
enableFeature :: FeatureI f => FeaturePreference f -> GroupFeatureEnabled
@@ -424,7 +499,9 @@ defaultBusinessGroupPrefs =
files = Just $ FilesGroupPreference FEOn Nothing,
simplexLinks = Just $ SimplexLinksGroupPreference FEOn Nothing,
reports = Just $ ReportsGroupPreference FEOff,
history = Just $ HistoryGroupPreference FEOn
history = Just $ HistoryGroupPreference FEOn,
sessions = Just $ SessionsGroupPreference FEOn Nothing,
commands = Nothing
}
data TimedMessagesPreference = TimedMessagesPreference
@@ -442,9 +519,15 @@ data ReactionsPreference = ReactionsPreference {allow :: FeatureAllowed}
data VoicePreference = VoicePreference {allow :: FeatureAllowed}
deriving (Eq, Show)
data FilesPreference = FilesPreference {allow :: FeatureAllowed}
deriving (Eq, Show)
data CallsPreference = CallsPreference {allow :: FeatureAllowed}
deriving (Eq, Show)
data SessionsPreference = SessionsPreference {allow :: FeatureAllowed}
deriving (Eq, Show)
class (Eq (FeaturePreference f), HasField "allow" (FeaturePreference f) FeatureAllowed) => FeatureI f where
type FeaturePreference (f :: ChatFeature) = p | p -> f
sFeature :: SChatFeature f
@@ -462,9 +545,15 @@ instance HasField "allow" ReactionsPreference FeatureAllowed where
instance HasField "allow" VoicePreference FeatureAllowed where
hasField p@VoicePreference {allow} = (\a -> p {allow = a}, allow)
instance HasField "allow" FilesPreference FeatureAllowed where
hasField p@FilesPreference {allow} = (\a -> p {allow = a}, allow)
instance HasField "allow" CallsPreference FeatureAllowed where
hasField p@CallsPreference {allow} = (\a -> p {allow = a}, allow)
instance HasField "allow" SessionsPreference FeatureAllowed where
hasField p@SessionsPreference {allow} = (\a -> p {allow = a}, allow)
instance FeatureI 'CFTimedMessages where
type FeaturePreference 'CFTimedMessages = TimedMessagesPreference
sFeature = SCFTimedMessages
@@ -485,11 +574,21 @@ instance FeatureI 'CFVoice where
sFeature = SCFVoice
prefParam _ = Nothing
instance FeatureI 'CFFiles where
type FeaturePreference 'CFFiles = FilesPreference
sFeature = SCFFiles
prefParam _ = Nothing
instance FeatureI 'CFCalls where
type FeaturePreference 'CFCalls = CallsPreference
sFeature = SCFCalls
prefParam _ = Nothing
instance FeatureI 'CFSessions where
type FeaturePreference 'CFSessions = SessionsPreference
sFeature = SCFSessions
prefParam _ = Nothing
data GroupPreference = GroupPreference
{enable :: GroupFeatureEnabled}
deriving (Eq, Show)
@@ -532,6 +631,10 @@ data HistoryGroupPreference = HistoryGroupPreference
{enable :: GroupFeatureEnabled}
deriving (Eq, Show)
data SessionsGroupPreference = SessionsGroupPreference
{enable :: GroupFeatureEnabled, role :: Maybe GroupMemberRole}
deriving (Eq, Show)
class (Eq (GroupFeaturePreference f), HasField "enable" (GroupFeaturePreference f) GroupFeatureEnabled) => GroupFeatureI f where
type GroupFeaturePreference (f :: GroupFeature) = p | p -> f
sGroupFeature :: SGroupFeature f
@@ -572,6 +675,9 @@ instance HasField "enable" ReportsGroupPreference GroupFeatureEnabled where
instance HasField "enable" HistoryGroupPreference GroupFeatureEnabled where
hasField p@HistoryGroupPreference {enable} = (\e -> p {enable = e}, enable)
instance HasField "enable" SessionsGroupPreference GroupFeatureEnabled where
hasField p@SessionsGroupPreference {enable} = (\e -> p {enable = e}, enable)
instance GroupFeatureI 'GFTimedMessages where
type GroupFeaturePreference 'GFTimedMessages = TimedMessagesGroupPreference
sGroupFeature = SGFTimedMessages
@@ -626,6 +732,12 @@ instance GroupFeatureI 'GFHistory where
groupPrefParam _ = Nothing
groupPrefRole _ = Nothing
instance GroupFeatureI 'GFSessions where
type GroupFeaturePreference 'GFSessions = SessionsGroupPreference
sGroupFeature = SGFSessions
groupPrefParam _ = Nothing
groupPrefRole SessionsGroupPreference {role} = role
instance GroupFeatureNoRoleI 'GFTimedMessages
instance GroupFeatureNoRoleI 'GFFullDelete
@@ -651,6 +763,9 @@ instance HasField "role" FilesGroupPreference (Maybe GroupMemberRole) where
instance HasField "role" SimplexLinksGroupPreference (Maybe GroupMemberRole) where
hasField p@SimplexLinksGroupPreference {role} = (\r -> p {role = r}, role)
instance HasField "role" SessionsGroupPreference (Maybe GroupMemberRole) where
hasField p@SessionsGroupPreference {role} = (\r -> p {role = r}, role)
instance GroupFeatureRoleI 'GFDirectMessages
instance GroupFeatureRoleI 'GFFullDelete
@@ -661,6 +776,8 @@ instance GroupFeatureRoleI 'GFFiles
instance GroupFeatureRoleI 'GFSimplexLinks
instance GroupFeatureRoleI 'GFSessions
groupPrefStateText :: HasField "enable" p GroupFeatureEnabled => GroupFeature -> p -> Maybe Int -> Maybe GroupMemberRole -> Text
groupPrefStateText feature pref param role =
let enabled = getField @"enable" pref
@@ -770,7 +887,10 @@ mergePreferences contactPrefs userPreferences canFallbackToUserTTL =
fullDelete = pref SCFFullDelete,
reactions = pref SCFReactions,
voice = pref SCFVoice,
calls = pref SCFCalls
files = pref SCFFiles,
calls = pref SCFCalls,
sessions = pref SCFSessions,
commands = ListDef $ fromMaybe [] $ (contactPrefs >>= commands_) <|> (userPreferences >>= commands_)
}
where
timedPrefNoTTLFallback :: TimedMessagesPreference
@@ -794,7 +914,10 @@ fullPreferences' userPreferences =
fullDelete = pref SCFFullDelete,
reactions = pref SCFReactions,
voice = pref SCFVoice,
calls = pref SCFCalls
files = pref SCFFiles,
calls = pref SCFCalls,
sessions = pref SCFSessions,
commands = ListDef $ fromMaybe [] $ userPreferences >>= commands_
}
where
pref :: SChatFeature f -> FeaturePreference f
@@ -813,14 +936,16 @@ mergeGroupPreferences groupPreferences =
files = pref SGFFiles,
simplexLinks = pref SGFSimplexLinks,
reports = pref SGFReports,
history = pref SGFHistory
history = pref SGFHistory,
sessions = pref SGFSessions,
commands = ListDef $ fromMaybe [] $ groupPreferences >>= commands_
}
where
pref :: SGroupFeature f -> GroupFeaturePreference f
pref pt = fromMaybe (getGroupPreference pt defaultGroupPrefs) (groupPreferences >>= groupPrefSel pt)
toGroupPreferences :: FullGroupPreferences -> GroupPreferences
toGroupPreferences groupPreferences =
toGroupPreferences groupPreferences@FullGroupPreferences {commands = ListDef cmds} =
GroupPreferences
{ timedMessages = pref SGFTimedMessages,
directMessages = pref SGFDirectMessages,
@@ -830,7 +955,9 @@ toGroupPreferences groupPreferences =
files = pref SGFFiles,
simplexLinks = pref SGFSimplexLinks,
reports = pref SGFReports,
history = pref SGFHistory
history = pref SGFHistory,
sessions = pref SGFSessions,
commands = Just cmds
}
where
pref :: SGroupFeature f -> Maybe (GroupFeaturePreference f)
@@ -893,12 +1020,14 @@ preferenceState pref =
in (allow, param)
getContactUserPreference :: SChatFeature f -> ContactUserPreferences -> ContactUserPreference (FeaturePreference f)
getContactUserPreference f ContactUserPreferences {timedMessages, fullDelete, reactions, voice, calls} = case f of
getContactUserPreference f ContactUserPreferences {timedMessages, fullDelete, reactions, voice, files, calls, sessions} = case f of
SCFTimedMessages -> timedMessages
SCFFullDelete -> fullDelete
SCFReactions -> reactions
SCFVoice -> voice
SCFFiles -> files
SCFCalls -> calls
SCFSessions -> sessions
$(J.deriveJSON (enumJSON $ dropPrefix "CF") ''ChatFeature)
@@ -912,8 +1041,22 @@ $(J.deriveJSON defaultJSON ''ReactionsPreference)
$(J.deriveJSON defaultJSON ''VoicePreference)
$(J.deriveToJSON defaultJSON ''FilesPreference)
instance FromJSON FilesPreference where
parseJSON v = $(J.mkParseJSON defaultJSON ''FilesPreference) v
omittedField = Just FilesPreference {allow = FAAlways}
$(J.deriveJSON defaultJSON ''CallsPreference)
$(J.deriveToJSON defaultJSON ''SessionsPreference)
instance FromJSON SessionsPreference where
parseJSON v = $(J.mkParseJSON defaultJSON ''SessionsPreference) v
omittedField = Just SessionsPreference {allow = FANo}
$(J.deriveJSON (taggedObjectJSON $ dropPrefix "CBC") ''ChatBotCommand)
$(J.deriveJSON defaultJSON ''Preferences)
instance ToField Preferences where
@@ -942,6 +1085,12 @@ $(J.deriveJSON defaultJSON ''ReportsGroupPreference)
$(J.deriveJSON defaultJSON ''HistoryGroupPreference)
$(J.deriveToJSON defaultJSON ''SessionsGroupPreference)
instance FromJSON SessionsGroupPreference where
parseJSON v = $(J.mkParseJSON defaultJSON ''SessionsGroupPreference) v
omittedField = Just SessionsGroupPreference {enable = FEOff, role = Nothing}
$(J.deriveJSON defaultJSON ''GroupPreferences)
instance ToField GroupPreferences where
src/Simplex/Chat/View.hs
+23 -7
View File
@@ -19,7 +19,7 @@ import qualified Data.Aeson as J
import qualified Data.Aeson.TH as JQ
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Char (toUpper)
import Data.Char (isSpace, toUpper)
import Data.Function (on)
import Data.Int (Int64)
import Data.List (groupBy, intercalate, intersperse, partition, sortOn)
@@ -607,8 +607,8 @@ viewUsersList us =
in if null ss then ["no users"] else ss
where
ldn (UserInfo User {localDisplayName = n} _) = T.toLower n
userInfo (UserInfo User {localDisplayName = n, profile = LocalProfile {fullName, shortDescr}, activeUser, showNtfs, viewPwdHash} count)
| activeUser || isNothing viewPwdHash = Just $ ttyFullName n fullName shortDescr <> infoStr
userInfo (UserInfo User {localDisplayName = n, profile = LocalProfile {fullName, shortDescr, peerType}, activeUser, showNtfs, viewPwdHash} count)
| activeUser || isNothing viewPwdHash = Just $ ttyFullName n fullName shortDescr <> infoStr <> bot
| otherwise = Nothing
where
infoStr = if null info then "" else " (" <> mconcat (intersperse ", " info) <> ")"
@@ -617,6 +617,9 @@ viewUsersList us =
<> [highlight' "hidden" | isJust viewPwdHash]
<> ["muted" | not showNtfs]
<> [plain ("unread: " <> show count) | count /= 0]
bot = case peerType of
Just CPTBot -> " (bot)"
_ -> ""
viewGroupSubscribed :: GroupName -> [StyledString]
viewGroupSubscribed g = [ttyGroup g <> ": connected to server(s)"]
@@ -1429,11 +1432,24 @@ viewContactAndMemberAssociated ct g m ct' =
]
viewUserProfile :: Profile -> [StyledString]
viewUserProfile Profile {displayName, fullName, shortDescr} =
[ "user profile: " <> ttyFullName displayName fullName shortDescr,
"use " <> highlight' "/p <name> [<bio>]" <> " to change it",
"(the updated profile will be sent to all your contacts)"
viewUserProfile Profile {displayName, fullName, shortDescr, peerType, preferences} =
[ "user profile: " <> ttyFullName displayName fullName shortDescr <> bot,
"use " <> highlight' "/p <name> [<bio>]" <> " to change it"
]
++ viewCommands
where
viewCommands = case preferences of
Just Preferences {commands = Just cmds} | peerType == Just CPTBot && not (null cmds) ->
("Bot commands:" : concatMap (viewCommand "") cmds)
++ ["use " <> highlight' "/set bot commands ..." <> " or " <> highlight' "/delete bot commands"]
_ -> []
viewCommand indent = \case
CBCCommand {label, keyword, params} ->
[plain $ indent <> quoted label <> ":/" <> quoted (keyword <> maybe "" (" " <>) params)]
CBCMenu {label, commands} ->
(plain (indent <> quoted label <> ":{") : concatMap (viewCommand $ " " <> indent) commands) ++ [plain $ indent <> "}"]
quoted s = if T.any isSpace s then "'" <> s <> "'" else s
bot = if peerType == Just CPTBot then " (bot)" else ""
viewUserPrivacy :: User -> User -> [StyledString]
viewUserPrivacy User {userId} User {userId = userId', localDisplayName = n', showNtfs, viewPwdHash} =