mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-04-25 07:42:15 +00:00
core: Chat preferences (#1261)
* core: Preferences * Changes * fix types * Follow up * Review * Review * update logic * update * update 2 * Tests * Fixed a bug and tests * Voice -> voice messages * refactor * fix Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
Stanislav Dmitrenko
committed by
GitHub
GitHub
parent
14038ce370
commit
4e5a5c11dc
@@ -645,6 +645,9 @@ processChatCommand = \case
|
||||
withCurrentCall contactId $ \userId ct call ->
|
||||
updateCallItemStatus userId ct call receivedStatus Nothing $> Just call
|
||||
APIUpdateProfile profile -> withUser (`updateProfile` profile)
|
||||
APISetContactPrefs contactId prefs' -> withUser $ \user@User {userId} -> do
|
||||
ct <- withStore $ \db -> getContact db userId contactId
|
||||
updateContactPrefs user ct prefs'
|
||||
APISetContactAlias contactId localAlias -> withUser $ \User {userId} -> do
|
||||
ct' <- withStore $ \db -> do
|
||||
ct <- getContact db userId contactId
|
||||
@@ -754,13 +757,13 @@ processChatCommand = \case
|
||||
conn <- withStore' $ \db -> createDirectConnection db userId connId cReq ConnNew incognitoProfile
|
||||
toView $ CRNewContactConnection conn
|
||||
pure $ CRInvitation cReq
|
||||
Connect (Just (ACR SCMInvitation cReq)) -> withUser $ \User {userId, profile} -> withChatLock "connect" . procCmd $ do
|
||||
Connect (Just (ACR SCMInvitation cReq)) -> withUser $ \user@User {userId} -> withChatLock "connect" . procCmd $ do
|
||||
-- [incognito] generate profile to send
|
||||
incognito <- readTVarIO =<< asks incognitoMode
|
||||
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
|
||||
let profileToSend = fromMaybe (fromLocalProfile profile) incognitoProfile
|
||||
let profileToSend = userProfileToSend user incognitoProfile Nothing
|
||||
connId <- withAgent $ \a -> joinConnection a True cReq . directMessage $ XInfo profileToSend
|
||||
conn <- withStore' $ \db -> createDirectConnection db userId connId cReq ConnJoined incognitoProfile
|
||||
conn <- withStore' $ \db -> createDirectConnection db userId connId cReq ConnJoined $ incognitoProfile $> profileToSend
|
||||
toView $ CRNewContactConnection conn
|
||||
pure CRSentConfirmation
|
||||
Connect (Just (ACR SCMContact cReq)) -> withUser $ \User {userId, profile} ->
|
||||
@@ -1151,9 +1154,23 @@ processChatCommand = \case
|
||||
filter (\ct -> isReady ct && not (contactConnIncognito ct))
|
||||
<$> withStore' (`getUserContacts` user)
|
||||
withChatLock "updateProfile" . procCmd $ do
|
||||
forM_ contacts $ \ct ->
|
||||
void (sendDirectContactMessage ct $ XInfo p') `catchError` (toView . CRChatError)
|
||||
forM_ contacts $ \ct -> do
|
||||
let mergedProfile = userProfileToSend user' Nothing $ Just ct
|
||||
void (sendDirectContactMessage ct $ XInfo mergedProfile) `catchError` (toView . CRChatError)
|
||||
pure $ CRUserProfileUpdated (fromLocalProfile p) p'
|
||||
updateContactPrefs :: User -> Contact -> ChatPreferences -> m ChatResponse
|
||||
updateContactPrefs user@User {userId} ct@Contact {contactId, activeConn = Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs'
|
||||
| contactUserPrefs == contactUserPrefs' = pure $ CRContactPrefsUpdated ct -- nothing changed actually
|
||||
| otherwise = do
|
||||
withStore' $ \db -> updateContactUserPreferences db userId contactId contactUserPrefs'
|
||||
-- [incognito] filter out contacts with whom user has incognito connections
|
||||
let ct' = (ct :: Contact) {userPreferences = contactUserPrefs'}
|
||||
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId
|
||||
let p' = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct')
|
||||
withChatLock "updateProfile" . procCmd $ do
|
||||
void (sendDirectContactMessage ct' $ XInfo p') `catchError` (toView . CRChatError)
|
||||
pure $ CRContactPrefsUpdated ct'
|
||||
|
||||
isReady :: Contact -> Bool
|
||||
isReady ct =
|
||||
let s = connStatus $ activeConn (ct :: Contact)
|
||||
@@ -1369,25 +1386,26 @@ getRcvFilePath fileId fPath_ fn = case fPath_ of
|
||||
in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
|
||||
|
||||
acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> m Contact
|
||||
acceptContactRequest user@User {userId} UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile = do
|
||||
acceptContactRequest user UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = cp, userContactLinkId, xContactId} incognitoProfile = do
|
||||
let profileToSend = profileToSendOnAccept user incognitoProfile
|
||||
acId <- withAgent $ \a -> acceptContact a True invId . directMessage $ XInfo profileToSend
|
||||
withStore' $ \db -> createAcceptedContact db userId acId cName profileId p userContactLinkId xContactId incognitoProfile
|
||||
withStore' $ \db -> createAcceptedContact db user acId cName profileId cp userContactLinkId xContactId incognitoProfile
|
||||
|
||||
acceptContactRequestAsync :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> m Contact
|
||||
acceptContactRequestAsync user@User {userId} UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile = do
|
||||
acceptContactRequestAsync user UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile = do
|
||||
let profileToSend = profileToSendOnAccept user incognitoProfile
|
||||
(cmdId, acId) <- agentAcceptContactAsync user True invId $ XInfo profileToSend
|
||||
withStore' $ \db -> do
|
||||
ct@Contact {activeConn = Connection {connId}} <- createAcceptedContact db userId acId cName profileId p userContactLinkId xContactId incognitoProfile
|
||||
ct@Contact {activeConn = Connection {connId}} <- createAcceptedContact db user acId cName profileId p userContactLinkId xContactId incognitoProfile
|
||||
setCommandConnId db user cmdId connId
|
||||
pure ct
|
||||
|
||||
profileToSendOnAccept :: User -> Maybe IncognitoProfile -> Profile
|
||||
profileToSendOnAccept User {profile} = \case
|
||||
Just (NewIncognito p) -> p
|
||||
Just (ExistingIncognito lp) -> fromLocalProfile lp
|
||||
Nothing -> fromLocalProfile profile
|
||||
profileToSendOnAccept user ip = userProfileToSend user (getIncognitoProfile <$> ip) Nothing
|
||||
where
|
||||
getIncognitoProfile = \case
|
||||
NewIncognito p -> p
|
||||
ExistingIncognito lp -> fromLocalProfile lp
|
||||
|
||||
deleteGroupLink' :: ChatMonad m => User -> GroupInfo -> m ()
|
||||
deleteGroupLink' user gInfo = do
|
||||
@@ -1585,7 +1603,7 @@ processAgentMessage (Just user) _ agentConnId END =
|
||||
showToast (c <> "> ") "connected to another client"
|
||||
unsetActive $ ActiveC c
|
||||
entity -> toView $ CRSubscriptionEnd entity
|
||||
processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentMessage =
|
||||
processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage =
|
||||
(withStore (\db -> getConnectionEntity db user $ AgentConnId agentConnId) >>= updateConnStatus) >>= \case
|
||||
RcvDirectMsgConnection conn contact_ ->
|
||||
processDirectMessage agentMessage conn contact_
|
||||
@@ -1623,7 +1641,7 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
|
||||
CONF confId _ connInfo -> do
|
||||
-- [incognito] send saved profile
|
||||
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId)
|
||||
let profileToSend = fromLocalProfile $ fromMaybe profile incognitoProfile
|
||||
let profileToSend = userProfileToSend user (fromLocalProfile <$> incognitoProfile) Nothing
|
||||
saveConnInfo conn connInfo
|
||||
-- [async agent commands] no continuation needed, but command should be asynchronous for stability
|
||||
allowAgentConnectionAsync user conn confId $ XInfo profileToSend
|
||||
@@ -2986,6 +3004,17 @@ deleteAgentConnectionAsync' user connId (AgentConnId acId) = do
|
||||
cmdId <- withStore' $ \db -> createCommand db user (Just connId) CFDeleteConn
|
||||
withAgent $ \a -> deleteConnectionAsync a (aCorrId cmdId) acId
|
||||
|
||||
userProfileToSend :: User -> Maybe Profile -> Maybe Contact -> Profile
|
||||
userProfileToSend user@User {profile} incognitoProfile ct =
|
||||
let p = fromMaybe (fromLocalProfile profile) incognitoProfile
|
||||
preferences = Just . mergeChatPreferences user $ userPreferences <$> ct
|
||||
in (p :: Profile) {preferences}
|
||||
|
||||
mergeChatPreferences :: User -> Maybe ChatPreferences -> ChatPreferences
|
||||
mergeChatPreferences User {profile = LocalProfile {preferences}} contactPrefs =
|
||||
let ChatPreferences {voice = defaultVoice} = defaultChatPrefs
|
||||
in ChatPreferences {voice = (contactPrefs >>= voice) <|> (preferences >>= voice) <|> defaultVoice}
|
||||
|
||||
getCreateActiveUser :: SQLiteStore -> IO User
|
||||
getCreateActiveUser st = do
|
||||
user <-
|
||||
@@ -3007,7 +3036,7 @@ getCreateActiveUser st = do
|
||||
loop = do
|
||||
displayName <- getContactName
|
||||
fullName <- T.pack <$> getWithPrompt "full name (optional)"
|
||||
withTransaction st (\db -> runExceptT $ createUser db Profile {displayName, fullName, image = Nothing} True) >>= \case
|
||||
withTransaction st (\db -> runExceptT $ createUser db Profile {displayName, fullName, image = Nothing, preferences = Just defaultChatPrefs} True) >>= \case
|
||||
Left SEDuplicateName -> do
|
||||
putStrLn "chosen display name is already used by another profile on this device, choose another one"
|
||||
loop
|
||||
@@ -3140,6 +3169,7 @@ chatCommandP =
|
||||
"/_profile " *> (APIUpdateProfile <$> jsonP),
|
||||
"/_set alias @" *> (APISetContactAlias <$> A.decimal <*> (A.space *> textP <|> pure "")),
|
||||
"/_set alias :" *> (APISetConnectionAlias <$> A.decimal <*> (A.space *> textP <|> pure "")),
|
||||
"/_set prefs @" *> (APISetContactPrefs <$> A.decimal <* A.space <*> jsonP),
|
||||
"/_parse " *> (APIParseMarkdown . safeDecodeUtf8 <$> A.takeByteString),
|
||||
"/_ntf get" $> APIGetNtfToken,
|
||||
"/_ntf register " *> (APIRegisterToken <$> strP_ <*> strP),
|
||||
@@ -3190,6 +3220,7 @@ chatCommandP =
|
||||
("/members #" <|> "/members " <|> "/ms #" <|> "/ms ") *> (ListMembers <$> displayName),
|
||||
("/groups" <|> "/gs") $> ListGroups,
|
||||
"/_group_profile #" *> (APIUpdateGroupProfile <$> A.decimal <* A.space <*> jsonP),
|
||||
-- TODO group profile update via terminal should not reset image and preferences to Nothing (now it does)
|
||||
("/group_profile #" <|> "/gp #" <|> "/group_profile " <|> "/gp ") *> (UpdateGroupProfile <$> displayName <* A.space <*> groupProfile),
|
||||
"/_create link #" *> (APICreateGroupLink <$> A.decimal),
|
||||
"/_delete link #" *> (APIDeleteGroupLink <$> A.decimal),
|
||||
@@ -3256,13 +3287,13 @@ chatCommandP =
|
||||
pure (cName, fullName)
|
||||
userProfile = do
|
||||
(cName, fullName) <- userNames
|
||||
pure Profile {displayName = cName, fullName, image = Nothing}
|
||||
pure Profile {displayName = cName, fullName, image = Nothing, preferences = Nothing}
|
||||
jsonP :: J.FromJSON a => Parser a
|
||||
jsonP = J.eitherDecodeStrict' <$?> A.takeByteString
|
||||
groupProfile = do
|
||||
gName <- displayName
|
||||
fullName <- fullNameP gName
|
||||
pure GroupProfile {displayName = gName, fullName, image = Nothing}
|
||||
pure GroupProfile {displayName = gName, fullName, image = Nothing, preferences = Nothing}
|
||||
fullNameP name = do
|
||||
n <- (A.space *> A.takeByteString) <|> pure ""
|
||||
pure $ if B.null n then name else safeDecodeUtf8 n
|
||||
|
||||
@@ -166,6 +166,7 @@ data ChatCommand
|
||||
| APIGetCallInvitations
|
||||
| APICallStatus ContactId WebRTCCallStatus
|
||||
| APIUpdateProfile Profile
|
||||
| APISetContactPrefs Int64 ChatPreferences
|
||||
| APISetContactAlias ContactId LocalAlias
|
||||
| APISetConnectionAlias Int64 LocalAlias
|
||||
| APIParseMarkdown Text
|
||||
@@ -321,6 +322,7 @@ data ChatResponse
|
||||
| CRUserProfileUpdated {fromProfile :: Profile, toProfile :: Profile}
|
||||
| CRContactAliasUpdated {toContact :: Contact}
|
||||
| CRConnectionAliasUpdated {toConnection :: PendingContactConnection}
|
||||
| CRContactPrefsUpdated {toContact :: Contact}
|
||||
| CRContactConnecting {contact :: Contact}
|
||||
| CRContactConnected {contact :: Contact, userCustomProfile :: Maybe Profile}
|
||||
| CRContactAnotherClient {contact :: Contact}
|
||||
|
||||
21
src/Simplex/Chat/Migrations/M20221025_chat_settings.hs
Normal file
21
src/Simplex/Chat/Migrations/M20221025_chat_settings.hs
Normal file
@@ -0,0 +1,21 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20221025_chat_settings where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20221025_chat_settings :: Query
|
||||
m20221025_chat_settings =
|
||||
[sql|
|
||||
PRAGMA ignore_check_constraints=ON;
|
||||
|
||||
ALTER TABLE group_profiles ADD COLUMN preferences TEXT;
|
||||
|
||||
ALTER TABLE contact_profiles ADD COLUMN preferences TEXT;
|
||||
|
||||
ALTER TABLE contacts ADD COLUMN user_preferences TEXT DEFAULT '{}' CHECK (user_preferences NOT NULL);
|
||||
UPDATE contacts SET user_preferences = '{}';
|
||||
|
||||
PRAGMA ignore_check_constraints=OFF;
|
||||
|]
|
||||
@@ -15,7 +15,8 @@ CREATE TABLE contact_profiles(
|
||||
image TEXT,
|
||||
user_id INTEGER DEFAULT NULL REFERENCES users ON DELETE CASCADE,
|
||||
incognito INTEGER,
|
||||
local_alias TEXT DEFAULT '' CHECK(local_alias NOT NULL)
|
||||
local_alias TEXT DEFAULT '' CHECK(local_alias NOT NULL),
|
||||
preferences TEXT
|
||||
);
|
||||
CREATE INDEX contact_profiles_index ON contact_profiles(
|
||||
display_name,
|
||||
@@ -58,6 +59,7 @@ CREATE TABLE contacts(
|
||||
enable_ntfs INTEGER,
|
||||
unread_chat INTEGER DEFAULT 0 CHECK(unread_chat NOT NULL),
|
||||
contact_used INTEGER DEFAULT 0 CHECK(contact_used NOT NULL),
|
||||
user_preferences TEXT DEFAULT '{}' CHECK(user_preferences NOT NULL),
|
||||
FOREIGN KEY(user_id, local_display_name)
|
||||
REFERENCES display_names(user_id, local_display_name)
|
||||
ON DELETE CASCADE
|
||||
@@ -113,7 +115,8 @@ CREATE TABLE group_profiles(
|
||||
created_at TEXT CHECK(created_at NOT NULL),
|
||||
updated_at TEXT CHECK(updated_at NOT NULL),
|
||||
image TEXT,
|
||||
user_id INTEGER DEFAULT NULL REFERENCES users ON DELETE CASCADE
|
||||
user_id INTEGER DEFAULT NULL REFERENCES users ON DELETE CASCADE,
|
||||
preferences TEXT
|
||||
);
|
||||
CREATE TABLE groups(
|
||||
group_id INTEGER PRIMARY KEY, -- local group ID
|
||||
|
||||
@@ -10,7 +10,7 @@ generateRandomProfile :: IO Profile
|
||||
generateRandomProfile = do
|
||||
adjective <- pick adjectives
|
||||
noun <- pickNoun adjective 2
|
||||
pure $ Profile {displayName = adjective <> noun, fullName = "", image = Nothing}
|
||||
pure $ Profile {displayName = adjective <> noun, fullName = "", image = Nothing, preferences = Nothing}
|
||||
where
|
||||
pick :: [a] -> IO a
|
||||
pick xs = (xs !!) <$> randomRIO (0, length xs - 1)
|
||||
|
||||
@@ -40,6 +40,7 @@ module Simplex.Chat.Store
|
||||
getContactIdByName,
|
||||
updateUserProfile,
|
||||
updateContactProfile,
|
||||
updateContactUserPreferences,
|
||||
updateContactAlias,
|
||||
updateContactConnectionAlias,
|
||||
updateContactUsed,
|
||||
@@ -290,6 +291,7 @@ import Simplex.Chat.Migrations.M20221012_inline_files
|
||||
import Simplex.Chat.Migrations.M20221019_unread_chat
|
||||
import Simplex.Chat.Migrations.M20221021_auto_accept__group_links
|
||||
import Simplex.Chat.Migrations.M20221024_contact_used
|
||||
import Simplex.Chat.Migrations.M20221025_chat_settings
|
||||
import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Messaging.Agent.Protocol (ACorrId, AgentMsgId, ConnId, InvitationId, MsgMeta (..))
|
||||
@@ -334,7 +336,8 @@ schemaMigrations =
|
||||
("20221012_inline_files", m20221012_inline_files),
|
||||
("20221019_unread_chat", m20221019_unread_chat),
|
||||
("20221021_auto_accept__group_links", m20221021_auto_accept__group_links),
|
||||
("20221024_contact_used", m20221024_contact_used)
|
||||
("20221024_contact_used", m20221024_contact_used),
|
||||
("20221025_chat_settings", m20221025_chat_settings)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
@@ -364,7 +367,7 @@ insertedRowId :: DB.Connection -> IO Int64
|
||||
insertedRowId db = fromOnly . head <$> DB.query_ db "SELECT last_insert_rowid()"
|
||||
|
||||
createUser :: DB.Connection -> Profile -> Bool -> ExceptT StoreError IO User
|
||||
createUser db Profile {displayName, fullName, image} activeUser =
|
||||
createUser db Profile {displayName, fullName, image, preferences = userPreferences} activeUser =
|
||||
checkConstraint SEDuplicateName . liftIO $ do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
@@ -378,8 +381,8 @@ createUser db Profile {displayName, fullName, image} activeUser =
|
||||
(displayName, displayName, userId, currentTs, currentTs)
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO contact_profiles (display_name, full_name, image, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
|
||||
(displayName, fullName, image, userId, currentTs, currentTs)
|
||||
"INSERT INTO contact_profiles (display_name, full_name, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
|
||||
(displayName, fullName, image, userId, userPreferences, currentTs, currentTs)
|
||||
profileId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
@@ -387,7 +390,7 @@ createUser db Profile {displayName, fullName, image} activeUser =
|
||||
(profileId, displayName, userId, True, currentTs, currentTs)
|
||||
contactId <- insertedRowId db
|
||||
DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId)
|
||||
pure $ toUser (userId, contactId, profileId, activeUser, displayName, fullName, image)
|
||||
pure $ toUser (userId, contactId, profileId, activeUser, displayName, fullName, image, userPreferences)
|
||||
|
||||
getUsers :: DB.Connection -> IO [User]
|
||||
getUsers db =
|
||||
@@ -395,15 +398,15 @@ getUsers db =
|
||||
<$> DB.query_
|
||||
db
|
||||
[sql|
|
||||
SELECT u.user_id, u.contact_id, p.contact_profile_id, u.active_user, u.local_display_name, p.full_name, p.image
|
||||
SELECT u.user_id, u.contact_id, p.contact_profile_id, u.active_user, u.local_display_name, p.full_name, p.image, p.preferences
|
||||
FROM users u
|
||||
JOIN contacts c ON u.contact_id = c.contact_id
|
||||
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
|
||||
|]
|
||||
|
||||
toUser :: (UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData) -> User
|
||||
toUser (userId, userContactId, profileId, activeUser, displayName, fullName, image) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, localAlias = ""}
|
||||
toUser :: (UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe ChatPreferences) -> User
|
||||
toUser (userId, userContactId, profileId, activeUser, displayName, fullName, image, userPreferences) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, preferences = userPreferences, localAlias = ""}
|
||||
in User {userId, userContactId, localDisplayName = displayName, profile, activeUser}
|
||||
|
||||
setActiveUser :: DB.Connection -> UserId -> IO ()
|
||||
@@ -442,7 +445,7 @@ getConnReqContactXContactId db userId cReqHash = do
|
||||
[sql|
|
||||
SELECT
|
||||
-- Contact
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.created_at, ct.updated_at,
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.local_alias, ct.contact_used, ct.enable_ntfs, cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
|
||||
@@ -493,14 +496,15 @@ getProfileById db userId profileId =
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT display_name, full_name, image, local_alias
|
||||
FROM contact_profiles
|
||||
WHERE user_id = ? AND contact_profile_id = ?
|
||||
SELECT cp.display_name, cp.full_name, cp.image, cp.local_alias, cp.preferences -- , ct.user_preferences
|
||||
FROM contact_profiles cp
|
||||
-- JOIN contacts ct ON cp.contact_profile_id = ct.contact_profile_id
|
||||
WHERE cp.user_id = ? AND cp.contact_profile_id = ?
|
||||
|]
|
||||
(userId, profileId)
|
||||
where
|
||||
toProfile :: (ContactName, Text, Maybe ImageData, LocalAlias) -> LocalProfile
|
||||
toProfile (displayName, fullName, image, localAlias) = LocalProfile {profileId, displayName, fullName, image, localAlias}
|
||||
toProfile :: (ContactName, Text, Maybe ImageData, LocalAlias, Maybe ChatPreferences) -> LocalProfile
|
||||
toProfile (displayName, fullName, image, localAlias, preferences) = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
|
||||
|
||||
createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> IO Connection
|
||||
createConnection_ db userId connType entityId acId viaContact viaUserContactLink customUserProfileId connLevel currentTs = do
|
||||
@@ -527,15 +531,15 @@ createDirectContact :: DB.Connection -> UserId -> Connection -> Profile -> Excep
|
||||
createDirectContact db userId activeConn@Connection {connId, localAlias} profile = do
|
||||
createdAt <- liftIO getCurrentTime
|
||||
(localDisplayName, contactId, profileId) <- createContact_ db userId connId profile localAlias Nothing createdAt
|
||||
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile localAlias, activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, createdAt, updatedAt = createdAt}
|
||||
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile localAlias, activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, userPreferences = emptyChatPrefs, createdAt, updatedAt = createdAt}
|
||||
|
||||
createContact_ :: DB.Connection -> UserId -> Int64 -> Profile -> LocalAlias -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO (Text, ContactId, ProfileId)
|
||||
createContact_ db userId connId Profile {displayName, fullName, image} localAlias viaGroup currentTs =
|
||||
createContact_ db userId connId Profile {displayName, fullName, image, preferences} localAlias viaGroup currentTs =
|
||||
ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO contact_profiles (display_name, full_name, image, user_id, local_alias, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
|
||||
(displayName, fullName, image, userId, localAlias, currentTs, currentTs)
|
||||
"INSERT INTO contact_profiles (display_name, full_name, image, user_id, local_alias, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
|
||||
(displayName, fullName, image, userId, localAlias, preferences, currentTs, currentTs)
|
||||
profileId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
@@ -632,6 +636,14 @@ updateContactProfile db userId c@Contact {contactId, localDisplayName, profile =
|
||||
updateContact_ db userId contactId localDisplayName ldn currentTs
|
||||
pure . Right $ (c :: Contact) {localDisplayName = ldn, profile = toLocalProfile profileId p' localAlias}
|
||||
|
||||
updateContactUserPreferences :: DB.Connection -> UserId -> Int64 -> ChatPreferences -> IO ()
|
||||
updateContactUserPreferences db userId contactId userPreferences = do
|
||||
updatedAt <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE contacts SET user_preferences = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?"
|
||||
(userPreferences, updatedAt, userId, contactId)
|
||||
|
||||
updateContactAlias :: DB.Connection -> UserId -> Contact -> LocalAlias -> IO Contact
|
||||
updateContactAlias db userId c@Contact {profile = lp@LocalProfile {profileId}} localAlias = do
|
||||
updatedAt <- getCurrentTime
|
||||
@@ -679,15 +691,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, image} updatedAt = do
|
||||
updateContactProfile_' db userId profileId Profile {displayName, fullName, image, preferences} updatedAt = do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE contact_profiles
|
||||
SET display_name = ?, full_name = ?, image = ?, updated_at = ?
|
||||
SET display_name = ?, full_name = ?, image = ?, preferences = ?, updated_at = ?
|
||||
WHERE user_id = ? AND contact_profile_id = ?
|
||||
|]
|
||||
(displayName, fullName, image, updatedAt, userId, profileId)
|
||||
(displayName, fullName, image, preferences, updatedAt, userId, profileId)
|
||||
|
||||
updateContact_ :: DB.Connection -> UserId -> Int64 -> ContactName -> ContactName -> UTCTime -> IO ()
|
||||
updateContact_ db userId contactId displayName newName updatedAt = do
|
||||
@@ -701,22 +713,22 @@ updateContact_ db userId contactId displayName newName updatedAt = do
|
||||
(newName, updatedAt, userId, contactId)
|
||||
DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (displayName, userId)
|
||||
|
||||
type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, LocalAlias, Bool, Maybe Bool, UTCTime, UTCTime)
|
||||
type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, LocalAlias, Bool, Maybe Bool) :. (Maybe ChatPreferences, ChatPreferences, UTCTime, UTCTime)
|
||||
|
||||
toContact :: ContactRow :. ConnectionRow -> Contact
|
||||
toContact ((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, localAlias, contactUsed, enableNtfs_, createdAt, updatedAt) :. connRow) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, localAlias}
|
||||
toContact (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, localAlias, contactUsed, enableNtfs_) :. (preferences, userPreferences, createdAt, updatedAt)) :. connRow) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
|
||||
activeConn = toConnection connRow
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
|
||||
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, createdAt, updatedAt}
|
||||
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, createdAt, updatedAt}
|
||||
|
||||
toContactOrError :: ContactRow :. MaybeConnectionRow -> Either StoreError Contact
|
||||
toContactOrError ((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, localAlias, contactUsed, enableNtfs_, createdAt, updatedAt) :. connRow) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, localAlias}
|
||||
toContactOrError (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, localAlias, contactUsed, enableNtfs_) :. (preferences, userPreferences, createdAt, updatedAt)) :. connRow) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
|
||||
in case toMaybeConnection connRow of
|
||||
Just activeConn ->
|
||||
Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, createdAt, updatedAt}
|
||||
Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, createdAt, updatedAt}
|
||||
_ -> Left $ SEContactNotReady localDisplayName
|
||||
|
||||
-- TODO return the last connection that is ready, not any last connection
|
||||
@@ -954,7 +966,7 @@ getGroupLink db User {userId} gInfo@GroupInfo {groupId} =
|
||||
DB.query db "SELECT conn_req_contact FROM user_contact_links WHERE user_id = ? AND group_id = ?" (userId, groupId)
|
||||
|
||||
createOrUpdateContactRequest :: DB.Connection -> UserId -> Int64 -> InvitationId -> Profile -> Maybe XContactId -> ExceptT StoreError IO ContactOrRequest
|
||||
createOrUpdateContactRequest db userId userContactLinkId invId Profile {displayName, fullName, image} xContactId_ =
|
||||
createOrUpdateContactRequest db userId userContactLinkId invId Profile {displayName, fullName, image, preferences} xContactId_ =
|
||||
liftIO (maybeM getContact' xContactId_) >>= \case
|
||||
Just contact -> pure $ CORContact contact
|
||||
Nothing -> CORRequest <$> createOrUpdate_
|
||||
@@ -976,8 +988,8 @@ createOrUpdateContactRequest db userId userContactLinkId invId Profile {displayN
|
||||
createContactRequest_ currentTs ldn = do
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO contact_profiles (display_name, full_name, image, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
|
||||
(displayName, fullName, image, userId, currentTs, currentTs)
|
||||
"INSERT INTO contact_profiles (display_name, full_name, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
|
||||
(displayName, fullName, image, userId, preferences, currentTs, currentTs)
|
||||
profileId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
@@ -996,7 +1008,7 @@ createOrUpdateContactRequest db userId userContactLinkId invId Profile {displayN
|
||||
[sql|
|
||||
SELECT
|
||||
-- Contact
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.created_at, ct.updated_at,
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.local_alias, ct.contact_used, ct.enable_ntfs, cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
|
||||
@@ -1016,7 +1028,7 @@ createOrUpdateContactRequest db userId userContactLinkId invId Profile {displayN
|
||||
[sql|
|
||||
SELECT
|
||||
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id,
|
||||
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, cr.xcontact_id, cr.created_at, cr.updated_at
|
||||
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, cr.xcontact_id, p.preferences, cr.created_at, cr.updated_at
|
||||
FROM contact_requests cr
|
||||
JOIN connections c USING (user_contact_link_id)
|
||||
JOIN contact_profiles p USING (contact_profile_id)
|
||||
@@ -1062,7 +1074,7 @@ getContactRequest db userId contactRequestId =
|
||||
[sql|
|
||||
SELECT
|
||||
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id,
|
||||
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, cr.xcontact_id, cr.created_at, cr.updated_at
|
||||
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, cr.xcontact_id, p.preferences, cr.created_at, cr.updated_at
|
||||
FROM contact_requests cr
|
||||
JOIN connections c USING (user_contact_link_id)
|
||||
JOIN contact_profiles p USING (contact_profile_id)
|
||||
@@ -1071,11 +1083,11 @@ getContactRequest db userId contactRequestId =
|
||||
|]
|
||||
(userId, contactRequestId)
|
||||
|
||||
type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text, Maybe ImageData, Maybe XContactId, UTCTime, UTCTime)
|
||||
type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text, Maybe ImageData) :. (Maybe XContactId, Maybe ChatPreferences, UTCTime, UTCTime)
|
||||
|
||||
toContactRequest :: ContactRequestRow -> UserContactRequest
|
||||
toContactRequest (contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image, xContactId, createdAt, updatedAt) = do
|
||||
let profile = Profile {displayName, fullName, image}
|
||||
toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image) :. (xContactId, preferences, createdAt, updatedAt)) = do
|
||||
let profile = Profile {displayName, fullName, image, preferences}
|
||||
in UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, localDisplayName, profileId, profile, xContactId, createdAt, updatedAt}
|
||||
|
||||
getContactRequestIdByName :: DB.Connection -> UserId -> ContactName -> ExceptT StoreError IO Int64
|
||||
@@ -1108,20 +1120,21 @@ deleteContactRequest db userId contactRequestId = do
|
||||
(userId, userId, contactRequestId)
|
||||
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId)
|
||||
|
||||
createAcceptedContact :: DB.Connection -> UserId -> ConnId -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> IO Contact
|
||||
createAcceptedContact db userId agentConnId localDisplayName profileId profile userContactLinkId xContactId incognitoProfile = do
|
||||
createAcceptedContact :: DB.Connection -> User -> ConnId -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> IO Contact
|
||||
createAcceptedContact db User {userId, profile = LocalProfile {preferences}} agentConnId localDisplayName profileId profile userContactLinkId xContactId incognitoProfile = do
|
||||
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
|
||||
createdAt <- getCurrentTime
|
||||
customUserProfileId <- forM incognitoProfile $ \case
|
||||
NewIncognito p -> createIncognitoProfile_ db userId createdAt p
|
||||
ExistingIncognito LocalProfile {profileId = pId} -> pure pId
|
||||
let contactUserPrefs = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, created_at, updated_at, xcontact_id) VALUES (?,?,?,?,?,?,?)"
|
||||
(userId, localDisplayName, profileId, True, createdAt, createdAt, xContactId)
|
||||
"INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, created_at, updated_at, xcontact_id) VALUES (?,?,?,?,?,?,?,?)"
|
||||
(userId, localDisplayName, profileId, True, contactUserPrefs, createdAt, createdAt, xContactId)
|
||||
contactId <- insertedRowId db
|
||||
activeConn <- createConnection_ db userId ConnContact (Just contactId) agentConnId Nothing (Just userContactLinkId) customUserProfileId 0 createdAt
|
||||
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, createdAt = createdAt, updatedAt = createdAt}
|
||||
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, userPreferences = contactUserPrefs, createdAt = createdAt, updatedAt = createdAt}
|
||||
|
||||
getLiveSndFileTransfers :: DB.Connection -> User -> IO [SndFileTransfer]
|
||||
getLiveSndFileTransfers db User {userId} = do
|
||||
@@ -1403,17 +1416,17 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT c.contact_profile_id, c.local_display_name, p.display_name, p.full_name, p.image, p.local_alias, c.via_group, c.contact_used, c.enable_ntfs, c.created_at, c.updated_at
|
||||
SELECT c.contact_profile_id, c.local_display_name, p.display_name, p.full_name, p.image, p.local_alias, c.via_group, c.contact_used, c.enable_ntfs, p.preferences, c.user_preferences, c.created_at, c.updated_at
|
||||
FROM contacts c
|
||||
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
|
||||
WHERE c.user_id = ? AND c.contact_id = ?
|
||||
|]
|
||||
(userId, contactId)
|
||||
toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, LocalAlias, Maybe Int64, Bool, Maybe Bool, UTCTime, UTCTime)] -> Either StoreError Contact
|
||||
toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, localAlias, viaGroup, contactUsed, enableNtfs_, createdAt, updatedAt)] =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, localAlias}
|
||||
toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, LocalAlias, Maybe Int64, Bool, Maybe Bool) :. (Maybe ChatPreferences, ChatPreferences, UTCTime, UTCTime)] -> Either StoreError Contact
|
||||
toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, localAlias, viaGroup, contactUsed, enableNtfs_) :. (preferences, userPreferences, createdAt, updatedAt)] =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
|
||||
in Right $ Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, createdAt, updatedAt}
|
||||
in Right $ Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, createdAt, updatedAt}
|
||||
toContact' _ _ _ = Left $ SEInternalError "referenced contact not found"
|
||||
getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
|
||||
getGroupAndMember_ groupMemberId c = ExceptT $ do
|
||||
@@ -1423,15 +1436,15 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
|
||||
[sql|
|
||||
SELECT
|
||||
-- GroupInfo
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.created_at, g.updated_at,
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, gp.preferences, g.created_at, g.updated_at,
|
||||
-- GroupInfo {membership}
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
-- GroupInfo {membership = GroupMember {memberProfile}}
|
||||
pu.display_name, pu.full_name, pu.image, pu.local_alias,
|
||||
pu.display_name, pu.full_name, pu.image, pu.local_alias, pu.preferences,
|
||||
-- from GroupMember
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
|
||||
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.local_alias
|
||||
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.local_alias, p.preferences
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
JOIN groups g ON g.group_id = m.group_id
|
||||
@@ -1524,15 +1537,15 @@ getGroupAndMember db User {userId, userContactId} groupMemberId =
|
||||
[sql|
|
||||
SELECT
|
||||
-- GroupInfo
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.created_at, g.updated_at,
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, gp.preferences, g.created_at, g.updated_at,
|
||||
-- GroupInfo {membership}
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
-- GroupInfo {membership = GroupMember {memberProfile}}
|
||||
pu.display_name, pu.full_name, pu.image, pu.local_alias,
|
||||
pu.display_name, pu.full_name, pu.image, pu.local_alias, pu.preferences,
|
||||
-- from GroupMember
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
|
||||
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.local_alias,
|
||||
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.local_alias, p.preferences,
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
|
||||
FROM group_members m
|
||||
@@ -1564,14 +1577,14 @@ updateConnectionStatus db Connection {connId} connStatus = do
|
||||
-- | creates completely new group with a single member - the current user
|
||||
createNewGroup :: DB.Connection -> TVar ChaChaDRG -> User -> GroupProfile -> ExceptT StoreError IO GroupInfo
|
||||
createNewGroup db gVar user@User {userId} groupProfile = ExceptT $ do
|
||||
let GroupProfile {displayName, fullName, image} = groupProfile
|
||||
let GroupProfile {displayName, fullName, image, preferences} = groupProfile
|
||||
currentTs <- getCurrentTime
|
||||
withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
|
||||
groupId <- liftIO $ do
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO group_profiles (display_name, full_name, image, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
|
||||
(displayName, fullName, image, userId, currentTs, currentTs)
|
||||
"INSERT INTO group_profiles (display_name, full_name, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
|
||||
(displayName, fullName, image, userId, preferences, currentTs, currentTs)
|
||||
profileId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
@@ -1604,15 +1617,15 @@ createGroupInvitation db user@User {userId} contact@Contact {contactId, activeCo
|
||||
DB.query db "SELECT group_id FROM groups WHERE inv_queue_info = ? AND user_id = ? LIMIT 1" (connRequest, userId)
|
||||
createGroupInvitation_ :: ExceptT StoreError IO GroupInfo
|
||||
createGroupInvitation_ = do
|
||||
let GroupProfile {displayName, fullName, image} = groupProfile
|
||||
let GroupProfile {displayName, fullName, image, preferences} = groupProfile
|
||||
ExceptT $
|
||||
withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
groupId <- liftIO $ do
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO group_profiles (display_name, full_name, image, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
|
||||
(displayName, fullName, image, userId, currentTs, currentTs)
|
||||
"INSERT INTO group_profiles (display_name, full_name, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
|
||||
(displayName, fullName, image, userId, preferences, currentTs, currentTs)
|
||||
profileId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
@@ -1734,9 +1747,9 @@ getUserGroupDetails db User {userId, userContactId} =
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.created_at, g.updated_at,
|
||||
SELECT g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, gp.preferences, g.created_at, g.updated_at,
|
||||
mu.group_member_id, g.group_id, mu.member_id, mu.member_role, mu.member_category, mu.member_status,
|
||||
mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.local_alias
|
||||
mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.local_alias, pu.preferences
|
||||
FROM groups g
|
||||
JOIN group_profiles gp USING (group_profile_id)
|
||||
JOIN group_members mu USING (group_id)
|
||||
@@ -1750,13 +1763,13 @@ getGroupInfoByName db user gName = do
|
||||
gId <- getGroupIdByName db user gName
|
||||
getGroupInfo db user gId
|
||||
|
||||
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe ImageData, Maybe ProfileId, Maybe Bool, UTCTime, UTCTime) :. GroupMemberRow
|
||||
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe ImageData, Maybe ProfileId, Maybe Bool, Maybe ChatPreferences, UTCTime, UTCTime) :. GroupMemberRow
|
||||
|
||||
toGroupInfo :: Int64 -> GroupInfoRow -> GroupInfo
|
||||
toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, image, hostConnCustomUserProfileId, enableNtfs_, createdAt, updatedAt) :. userMemberRow) =
|
||||
toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, image, hostConnCustomUserProfileId, enableNtfs_, preferences, createdAt, updatedAt) :. userMemberRow) =
|
||||
let membership = toGroupMember userContactId userMemberRow
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
|
||||
in GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, fullName, image}, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt}
|
||||
in GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, fullName, image, preferences}, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt}
|
||||
|
||||
getGroupMember :: DB.Connection -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO GroupMember
|
||||
getGroupMember db user@User {userId} groupId groupMemberId =
|
||||
@@ -1766,7 +1779,7 @@ getGroupMember db user@User {userId} groupId groupMemberId =
|
||||
[sql|
|
||||
SELECT
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
|
||||
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.local_alias,
|
||||
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.local_alias, p.preferences,
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
|
||||
FROM group_members m
|
||||
@@ -1788,7 +1801,7 @@ getGroupMembers db user@User {userId, userContactId} GroupInfo {groupId} = do
|
||||
[sql|
|
||||
SELECT
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
|
||||
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.local_alias,
|
||||
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.local_alias, p.preferences,
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
|
||||
FROM group_members m
|
||||
@@ -1852,20 +1865,20 @@ getGroupInvitation db user groupId = do
|
||||
findFromContact (IBContact contactId) = find ((== Just contactId) . memberContactId)
|
||||
findFromContact _ = const Nothing
|
||||
|
||||
type GroupMemberRow = ((Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus) :. (Maybe Int64, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, LocalAlias))
|
||||
type GroupMemberRow = ((Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus) :. (Maybe Int64, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, LocalAlias, Maybe ChatPreferences))
|
||||
|
||||
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus) :. (Maybe Int64, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe LocalAlias))
|
||||
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus) :. (Maybe Int64, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe LocalAlias, Maybe ChatPreferences))
|
||||
|
||||
toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
|
||||
toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, localAlias)) =
|
||||
let memberProfile = LocalProfile {profileId, displayName, fullName, image, localAlias}
|
||||
toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, localAlias, preferences)) =
|
||||
let memberProfile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
|
||||
invitedBy = toInvitedBy userContactId invitedById
|
||||
activeConn = Nothing
|
||||
in GroupMember {..}
|
||||
|
||||
toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember
|
||||
toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just memberRole, Just memberCategory, Just memberStatus) :. (invitedById, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image, Just localAlias)) =
|
||||
Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, localAlias))
|
||||
toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just memberRole, Just memberCategory, Just memberStatus) :. (invitedById, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image, Just localAlias, contactPreferences)) =
|
||||
Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, localAlias, contactPreferences))
|
||||
toMaybeGroupMember _ _ = Nothing
|
||||
|
||||
createNewContactMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupId -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> ExceptT StoreError IO GroupMember
|
||||
@@ -1938,7 +1951,7 @@ getContactViaMember db User {userId} GroupMember {groupMemberId} =
|
||||
[sql|
|
||||
SELECT
|
||||
-- Contact
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.created_at, ct.updated_at,
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.local_alias, ct.contact_used, ct.enable_ntfs, cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
|
||||
@@ -1986,13 +1999,13 @@ updateGroupMemberStatusById db userId groupMemberId memStatus = do
|
||||
|
||||
-- | add new member with profile
|
||||
createNewGroupMember :: DB.Connection -> User -> GroupInfo -> MemberInfo -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
|
||||
createNewGroupMember db user@User {userId} gInfo memInfo@(MemberInfo _ _ Profile {displayName, fullName, image}) memCategory memStatus =
|
||||
createNewGroupMember db user@User {userId} gInfo memInfo@(MemberInfo _ _ Profile {displayName, fullName, image, preferences}) memCategory memStatus =
|
||||
ExceptT . withLocalDisplayName db userId displayName $ \localDisplayName -> do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO contact_profiles (display_name, full_name, image, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
|
||||
(displayName, fullName, image, userId, currentTs, currentTs)
|
||||
"INSERT INTO contact_profiles (display_name, full_name, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
|
||||
(displayName, fullName, image, userId, preferences, currentTs, currentTs)
|
||||
memProfileId <- insertedRowId db
|
||||
let newMember =
|
||||
NewGroupMember
|
||||
@@ -2235,15 +2248,15 @@ getViaGroupMember db User {userId, userContactId} Contact {contactId} =
|
||||
[sql|
|
||||
SELECT
|
||||
-- GroupInfo
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.created_at, g.updated_at,
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, gp.preferences, g.created_at, g.updated_at,
|
||||
-- GroupInfo {membership}
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
-- GroupInfo {membership = GroupMember {memberProfile}}
|
||||
pu.display_name, pu.full_name, pu.image, pu.local_alias,
|
||||
pu.display_name, pu.full_name, pu.image, pu.local_alias, pu.preferences,
|
||||
-- via GroupMember
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
|
||||
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.local_alias,
|
||||
m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.local_alias, p.preferences,
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
|
||||
FROM group_members m
|
||||
@@ -2275,7 +2288,7 @@ getViaGroupContact db User {userId} GroupMember {groupMemberId} =
|
||||
db
|
||||
[sql|
|
||||
SELECT
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, p.display_name, p.full_name, p.image, p.local_alias, ct.via_group, ct.contact_used, ct.enable_ntfs, ct.created_at, ct.updated_at,
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, p.display_name, p.full_name, p.image, p.local_alias, ct.via_group, ct.contact_used, ct.enable_ntfs, p.preferences, ct.user_preferences, ct.created_at, ct.updated_at,
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
|
||||
FROM contacts ct
|
||||
@@ -2291,12 +2304,12 @@ getViaGroupContact db User {userId} GroupMember {groupMemberId} =
|
||||
|]
|
||||
(userId, groupMemberId)
|
||||
where
|
||||
toContact' :: (ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, LocalAlias, Maybe Int64, Bool, Maybe Bool, UTCTime, UTCTime) :. ConnectionRow -> Contact
|
||||
toContact' ((contactId, profileId, localDisplayName, displayName, fullName, image, localAlias, viaGroup, contactUsed, enableNtfs_, createdAt, updatedAt) :. connRow) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, localAlias}
|
||||
toContact' :: ((ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, LocalAlias, Maybe Int64, Bool, Maybe Bool) :. (Maybe ChatPreferences, ChatPreferences, UTCTime, UTCTime)) :. ConnectionRow -> Contact
|
||||
toContact' (((contactId, profileId, localDisplayName, displayName, fullName, image, localAlias, viaGroup, contactUsed, enableNtfs_) :. (preferences, userPreferences, createdAt, updatedAt)) :. connRow) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
|
||||
activeConn = toConnection connRow
|
||||
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, createdAt, updatedAt}
|
||||
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, chatSettings, userPreferences, createdAt, updatedAt}
|
||||
|
||||
createSndDirectFileTransfer :: DB.Connection -> UserId -> Contact -> FilePath -> FileInvitation -> Maybe ConnId -> Integer -> IO FileTransferMeta
|
||||
createSndDirectFileTransfer db userId Contact {contactId} filePath FileInvitation {fileName, fileSize, fileInline} acId_ chunkSize = do
|
||||
@@ -3115,7 +3128,7 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
|
||||
-- GroupMember
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
|
||||
m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
|
||||
p.display_name, p.full_name, p.image, p.local_alias
|
||||
p.display_name, p.full_name, p.image, p.local_alias, p.preferences
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
LEFT JOIN contacts c ON m.contact_id = c.contact_id
|
||||
@@ -3152,7 +3165,7 @@ getDirectChatPreviews_ db User {userId} = do
|
||||
[sql|
|
||||
SELECT
|
||||
-- Contact
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.created_at, ct.updated_at,
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.local_alias, ct.contact_used, ct.enable_ntfs, cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at,
|
||||
@@ -3217,11 +3230,11 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
|
||||
[sql|
|
||||
SELECT
|
||||
-- GroupInfo
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.created_at, g.updated_at,
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, gp.preferences, g.created_at, g.updated_at,
|
||||
-- GroupMember - membership
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
pu.display_name, pu.full_name, pu.image, pu.local_alias,
|
||||
pu.display_name, pu.full_name, pu.image, pu.local_alias, pu.preferences,
|
||||
-- ChatStats
|
||||
COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), g.unread_chat,
|
||||
-- ChatItem
|
||||
@@ -3231,13 +3244,13 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
|
||||
-- Maybe GroupMember - sender
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
|
||||
m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
|
||||
p.display_name, p.full_name, p.image, p.local_alias,
|
||||
p.display_name, p.full_name, p.image, p.local_alias, p.preferences,
|
||||
-- quoted ChatItem
|
||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
|
||||
-- quoted GroupMember
|
||||
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category,
|
||||
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
|
||||
rp.display_name, rp.full_name, rp.image, rp.local_alias
|
||||
rp.display_name, rp.full_name, rp.image, rp.local_alias, rp.preferences
|
||||
FROM groups g
|
||||
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
|
||||
JOIN group_members mu ON mu.group_id = g.group_id
|
||||
@@ -3282,7 +3295,7 @@ getContactRequestChatPreviews_ db User {userId} =
|
||||
[sql|
|
||||
SELECT
|
||||
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id,
|
||||
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, cr.xcontact_id, cr.created_at, cr.updated_at
|
||||
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, cr.xcontact_id, p.preferences, cr.created_at, cr.updated_at
|
||||
FROM contact_requests cr
|
||||
JOIN connections c ON c.user_contact_link_id = cr.user_contact_link_id
|
||||
JOIN contact_profiles p ON p.contact_profile_id = cr.contact_profile_id
|
||||
@@ -3476,7 +3489,7 @@ getContact db userId contactId =
|
||||
[sql|
|
||||
SELECT
|
||||
-- Contact
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.local_alias, ct.contact_used, ct.enable_ntfs, ct.created_at, ct.updated_at,
|
||||
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.local_alias, ct.contact_used, ct.enable_ntfs, cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.custom_user_profile_id, c.conn_status, c.conn_type, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
|
||||
@@ -3584,11 +3597,11 @@ getGroupInfo db User {userId, userContactId} groupId =
|
||||
[sql|
|
||||
SELECT
|
||||
-- GroupInfo
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, g.created_at, g.updated_at,
|
||||
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.image, g.host_conn_custom_user_profile_id, g.enable_ntfs, gp.preferences, g.created_at, g.updated_at,
|
||||
-- GroupMember - membership
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
pu.display_name, pu.full_name, pu.image, pu.local_alias
|
||||
pu.display_name, pu.full_name, pu.image, pu.local_alias, pu.preferences
|
||||
FROM groups g
|
||||
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
|
||||
JOIN group_members mu ON mu.group_id = g.group_id
|
||||
@@ -3598,7 +3611,7 @@ getGroupInfo db User {userId, userContactId} groupId =
|
||||
(groupId, userId, userContactId)
|
||||
|
||||
updateGroupProfile :: DB.Connection -> User -> GroupInfo -> GroupProfile -> ExceptT StoreError IO GroupInfo
|
||||
updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName}} p'@GroupProfile {displayName = newName, fullName, image}
|
||||
updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, preferences}} p'@GroupProfile {displayName = newName, fullName, image}
|
||||
| displayName == newName = liftIO $ do
|
||||
currentTs <- getCurrentTime
|
||||
updateGroupProfile_ currentTs $> (g :: GroupInfo) {groupProfile = p'}
|
||||
@@ -3614,14 +3627,14 @@ updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, grou
|
||||
db
|
||||
[sql|
|
||||
UPDATE group_profiles
|
||||
SET display_name = ?, full_name = ?, image = ?, updated_at = ?
|
||||
SET display_name = ?, full_name = ?, image = ?, preferences = ?, updated_at = ?
|
||||
WHERE group_profile_id IN (
|
||||
SELECT group_profile_id
|
||||
FROM groups
|
||||
WHERE user_id = ? AND group_id = ?
|
||||
)
|
||||
|]
|
||||
(newName, fullName, image, currentTs, userId, groupId)
|
||||
(newName, fullName, image, preferences, currentTs, userId, groupId)
|
||||
updateGroup_ ldn currentTs = do
|
||||
DB.execute
|
||||
db
|
||||
@@ -3927,13 +3940,13 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
|
||||
-- GroupMember
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
|
||||
m.member_status, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
|
||||
p.display_name, p.full_name, p.image, p.local_alias,
|
||||
p.display_name, p.full_name, p.image, p.local_alias, p.preferences,
|
||||
-- quoted ChatItem
|
||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
|
||||
-- quoted GroupMember
|
||||
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category,
|
||||
rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
|
||||
rp.display_name, rp.full_name, rp.image, rp.local_alias
|
||||
rp.display_name, rp.full_name, rp.image, rp.local_alias, rp.preferences
|
||||
FROM chat_items i
|
||||
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
|
||||
LEFT JOIN group_members m ON m.group_member_id = i.group_member_id
|
||||
|
||||
@@ -26,10 +26,12 @@ import qualified Data.Aeson.Types as JT
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||
import Data.ByteString.Char8 (ByteString, pack, unpack)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import Data.Int (Int64)
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.Time.Clock (UTCTime)
|
||||
import Data.Typeable
|
||||
import Database.SQLite.Simple (ResultError (..), SQLData (..))
|
||||
@@ -41,7 +43,7 @@ import GHC.Generics (Generic)
|
||||
import Simplex.Messaging.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId)
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, sumTypeJSON)
|
||||
import Simplex.Messaging.Util ((<$?>))
|
||||
import Simplex.Messaging.Util ((<$?>), safeDecodeUtf8)
|
||||
|
||||
class IsContact a where
|
||||
contactId' :: a -> ContactId
|
||||
@@ -83,6 +85,7 @@ data Contact = Contact
|
||||
viaGroup :: Maybe Int64,
|
||||
contactUsed :: Bool,
|
||||
chatSettings :: ChatSettings,
|
||||
userPreferences :: ChatPreferences,
|
||||
createdAt :: UTCTime,
|
||||
updatedAt :: UTCTime
|
||||
}
|
||||
@@ -227,10 +230,70 @@ defaultChatSettings = ChatSettings {enableNtfs = True}
|
||||
pattern DisableNtfs :: ChatSettings
|
||||
pattern DisableNtfs = ChatSettings {enableNtfs = False}
|
||||
|
||||
data ChatPreferences = ChatPreferences
|
||||
{ voice :: Maybe Preference
|
||||
-- image :: Maybe Preference,
|
||||
-- file :: Maybe Preference,
|
||||
-- delete :: Maybe Preference,
|
||||
-- acceptDelete :: Maybe Preference,
|
||||
-- edit :: Maybe Preference,
|
||||
-- receipts :: Maybe Preference
|
||||
}
|
||||
deriving (Eq, Show, Generic, FromJSON)
|
||||
|
||||
defaultChatPrefs :: ChatPreferences
|
||||
defaultChatPrefs = ChatPreferences {voice = Just Preference {enable = PSOff}}
|
||||
|
||||
emptyChatPrefs :: ChatPreferences
|
||||
emptyChatPrefs = ChatPreferences {voice = Nothing}
|
||||
|
||||
instance ToJSON ChatPreferences where
|
||||
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
|
||||
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
|
||||
|
||||
instance ToField ChatPreferences where
|
||||
toField = toField . safeDecodeUtf8 . LB.toStrict . J.encode
|
||||
|
||||
instance FromField ChatPreferences where
|
||||
fromField = fromTextField_ $ J.decode . LB.fromStrict . encodeUtf8
|
||||
|
||||
data Preference = Preference
|
||||
{enable :: PrefSwitch}
|
||||
deriving (Eq, Show, Generic, FromJSON)
|
||||
|
||||
instance ToJSON Preference where
|
||||
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
|
||||
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
|
||||
|
||||
data PrefSwitch = PSOn | PSOff -- for example it can be extended to include PSMutual, that is only enabled if it's enabled by another party
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance FromField PrefSwitch where fromField = fromBlobField_ strDecode
|
||||
|
||||
instance ToField PrefSwitch where toField = toField . strEncode
|
||||
|
||||
instance StrEncoding PrefSwitch where
|
||||
strEncode = \case
|
||||
PSOn -> "on"
|
||||
PSOff -> "off"
|
||||
strDecode = \case
|
||||
"on" -> Right PSOn
|
||||
"off" -> Right PSOff
|
||||
r -> Left $ "bad PrefSwitch " <> B.unpack r
|
||||
strP = strDecode <$?> A.takeByteString
|
||||
|
||||
instance FromJSON PrefSwitch where
|
||||
parseJSON = strParseJSON "PrefSwitch"
|
||||
|
||||
instance ToJSON PrefSwitch where
|
||||
toJSON = strToJSON
|
||||
toEncoding = strToJEncoding
|
||||
|
||||
data Profile = Profile
|
||||
{ displayName :: ContactName,
|
||||
fullName :: Text,
|
||||
image :: Maybe ImageData
|
||||
image :: Maybe ImageData,
|
||||
preferences :: Maybe ChatPreferences
|
||||
-- fields that should not be read into this data type to prevent sending them as part of profile to contacts:
|
||||
-- - contact_profile_id
|
||||
-- - incognito
|
||||
@@ -251,6 +314,7 @@ data LocalProfile = LocalProfile
|
||||
displayName :: ContactName,
|
||||
fullName :: Text,
|
||||
image :: Maybe ImageData,
|
||||
preferences :: Maybe ChatPreferences,
|
||||
localAlias :: LocalAlias
|
||||
}
|
||||
deriving (Eq, Show, Generic, FromJSON)
|
||||
@@ -263,17 +327,18 @@ localProfileId :: LocalProfile -> ProfileId
|
||||
localProfileId = profileId
|
||||
|
||||
toLocalProfile :: ProfileId -> Profile -> LocalAlias -> LocalProfile
|
||||
toLocalProfile profileId Profile {displayName, fullName, image} localAlias =
|
||||
LocalProfile {profileId, displayName, fullName, image, localAlias}
|
||||
toLocalProfile profileId Profile {displayName, fullName, image, preferences} localAlias =
|
||||
LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
|
||||
|
||||
fromLocalProfile :: LocalProfile -> Profile
|
||||
fromLocalProfile LocalProfile {displayName, fullName, image} =
|
||||
Profile {displayName, fullName, image}
|
||||
fromLocalProfile LocalProfile {displayName, fullName, image, preferences} =
|
||||
Profile {displayName, fullName, image, preferences}
|
||||
|
||||
data GroupProfile = GroupProfile
|
||||
{ displayName :: GroupName,
|
||||
fullName :: Text,
|
||||
image :: Maybe ImageData
|
||||
image :: Maybe ImageData,
|
||||
preferences :: Maybe ChatPreferences
|
||||
}
|
||||
deriving (Eq, Show, Generic, FromJSON)
|
||||
|
||||
|
||||
@@ -123,6 +123,7 @@ responseToView testView = \case
|
||||
CRSndGroupFileCancelled _ ftm fts -> viewSndGroupFileCancelled ftm fts
|
||||
CRRcvFileCancelled ft -> receivingFile_ "cancelled" ft
|
||||
CRUserProfileUpdated p p' -> viewUserProfileUpdated p p'
|
||||
CRContactPrefsUpdated ct -> viewContactPrefsUpdated ct
|
||||
CRContactAliasUpdated c -> viewContactAliasUpdated c
|
||||
CRConnectionAliasUpdated c -> viewConnectionAliasUpdated c
|
||||
CRContactUpdated c c' -> viewContactUpdated c c'
|
||||
@@ -701,6 +702,18 @@ viewUserProfileUpdated Profile {displayName = n, fullName, image} Profile {displ
|
||||
where
|
||||
notified = " (your contacts are notified)"
|
||||
|
||||
viewContactPrefsUpdated :: Contact -> [StyledString]
|
||||
viewContactPrefsUpdated Contact {profile = LocalProfile {preferences}, userPreferences = ChatPreferences {voice = userVoice}} =
|
||||
let contactVoice = preferences >>= voice
|
||||
in ["preferences were updated: " <> "contact's voice messages are " <> viewPreference contactVoice <> ", user's voice messages are " <> viewPreference userVoice]
|
||||
|
||||
viewPreference :: Maybe Preference -> StyledString
|
||||
viewPreference = \case
|
||||
Just Preference {enable} -> case enable of
|
||||
PSOn -> "on"
|
||||
PSOff -> "off"
|
||||
_ -> "unset"
|
||||
|
||||
viewGroupUpdated :: GroupInfo -> GroupInfo -> Maybe GroupMember -> [StyledString]
|
||||
viewGroupUpdated
|
||||
GroupInfo {localDisplayName = n, groupProfile = GroupProfile {fullName, image}}
|
||||
|
||||
Reference in New Issue
Block a user