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

core: Chat preferences (#1261)

Browse Source 
* 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 2022-11-01 17:32:49 +03:00 committed by GitHub
parent 14038ce370
commit 4e5a5c11dc
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
12 changed files with 339 additions and 149 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
simplex-chat.cabal
View File

@ -59,6 +59,7 @@ library
Simplex.Chat.Migrations.M20221019_unread_chat Simplex.Chat.Migrations.M20221019_unread_chat
Simplex.Chat.Migrations.M20221021_auto_accept__group_links Simplex.Chat.Migrations.M20221021_auto_accept__group_links
Simplex.Chat.Migrations.M20221024_contact_used Simplex.Chat.Migrations.M20221024_contact_used
Simplex.Chat.Migrations.M20221025_chat_settings
Simplex.Chat.Mobile Simplex.Chat.Mobile
Simplex.Chat.Options Simplex.Chat.Options
Simplex.Chat.ProfileGenerator Simplex.Chat.ProfileGenerator

67
src/Simplex/Chat.hs
View File

@ -645,6 +645,9 @@ processChatCommand = \case
withCurrentCall contactId $ \userId ct call -> withCurrentCall contactId $ \userId ct call ->
updateCallItemStatus userId ct call receivedStatus Nothing $> Just call updateCallItemStatus userId ct call receivedStatus Nothing $> Just call
APIUpdateProfile profile -> withUser (`updateProfile` profile) 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 APISetContactAlias contactId localAlias -> withUser $ \User {userId} -> do
ct' <- withStore $ \db -> do ct' <- withStore $ \db -> do
ct <- getContact db userId contactId ct <- getContact db userId contactId
@ -754,13 +757,13 @@ processChatCommand = \case
conn <- withStore' $ \db -> createDirectConnection db userId connId cReq ConnNew incognitoProfile conn <- withStore' $ \db -> createDirectConnection db userId connId cReq ConnNew incognitoProfile
toView $ CRNewContactConnection conn toView $ CRNewContactConnection conn
pure $ CRInvitation cReq 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] generate profile to send
incognito <- readTVarIO =<< asks incognitoMode incognito <- readTVarIO =<< asks incognitoMode
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing 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 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 toView $ CRNewContactConnection conn
pure CRSentConfirmation pure CRSentConfirmation
Connect (Just (ACR SCMContact cReq)) -> withUser $ \User {userId, profile} -> Connect (Just (ACR SCMContact cReq)) -> withUser $ \User {userId, profile} ->
@ -1151,9 +1154,23 @@ processChatCommand = \case
filter (\ct -> isReady ct && not (contactConnIncognito ct)) filter (\ct -> isReady ct && not (contactConnIncognito ct))
<$> withStore' (`getUserContacts` user) <$> withStore' (`getUserContacts` user)
withChatLock "updateProfile" . procCmd $ do withChatLock "updateProfile" . procCmd $ do
forM_ contacts $ \ct -> forM_ contacts $ \ct -> do
void (sendDirectContactMessage ct $ XInfo p') `catchError` (toView . CRChatError) let mergedProfile = userProfileToSend user' Nothing $ Just ct
void (sendDirectContactMessage ct $ XInfo mergedProfile) `catchError` (toView . CRChatError)
pure $ CRUserProfileUpdated (fromLocalProfile p) p' 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 :: Contact -> Bool
isReady ct = isReady ct =
let s = connStatus $ activeConn (ct :: Contact) 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) in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> m Contact 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 let profileToSend = profileToSendOnAccept user incognitoProfile
acId <- withAgent $ \a -> acceptContact a True invId . directMessage $ XInfo profileToSend 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 :: 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 let profileToSend = profileToSendOnAccept user incognitoProfile
(cmdId, acId) <- agentAcceptContactAsync user True invId $ XInfo profileToSend (cmdId, acId) <- agentAcceptContactAsync user True invId $ XInfo profileToSend
withStore' $ \db -> do 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 setCommandConnId db user cmdId connId
pure ct pure ct
profileToSendOnAccept :: User -> Maybe IncognitoProfile -> Profile profileToSendOnAccept :: User -> Maybe IncognitoProfile -> Profile
profileToSendOnAccept User {profile} = \case profileToSendOnAccept user ip = userProfileToSend user (getIncognitoProfile <$> ip) Nothing
Just (NewIncognito p) -> p where
Just (ExistingIncognito lp) -> fromLocalProfile lp getIncognitoProfile = \case
Nothing -> fromLocalProfile profile NewIncognito p -> p
ExistingIncognito lp -> fromLocalProfile lp
deleteGroupLink' :: ChatMonad m => User -> GroupInfo -> m () deleteGroupLink' :: ChatMonad m => User -> GroupInfo -> m ()
deleteGroupLink' user gInfo = do deleteGroupLink' user gInfo = do
@ -1585,7 +1603,7 @@ processAgentMessage (Just user) _ agentConnId END =
showToast (c <> "> ") "connected to another client" showToast (c <> "> ") "connected to another client"
unsetActive $ ActiveC c unsetActive $ ActiveC c
entity -> toView $ CRSubscriptionEnd entity 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 (withStore (\db -> getConnectionEntity db user $ AgentConnId agentConnId) >>= updateConnStatus) >>= \case
RcvDirectMsgConnection conn contact_ -> RcvDirectMsgConnection conn contact_ ->
processDirectMessage agentMessage conn contact_ processDirectMessage agentMessage conn contact_
@ -1623,7 +1641,7 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM
CONF confId _ connInfo -> do CONF confId _ connInfo -> do
-- [incognito] send saved profile -- [incognito] send saved profile
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) 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 saveConnInfo conn connInfo
-- [async agent commands] no continuation needed, but command should be asynchronous for stability -- [async agent commands] no continuation needed, but command should be asynchronous for stability
allowAgentConnectionAsync user conn confId $ XInfo profileToSend 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 cmdId <- withStore' $ \db -> createCommand db user (Just connId) CFDeleteConn
withAgent $ \a -> deleteConnectionAsync a (aCorrId cmdId) acId 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 :: SQLiteStore -> IO User
getCreateActiveUser st = do getCreateActiveUser st = do
user <- user <-
@ -3007,7 +3036,7 @@ getCreateActiveUser st = do
loop = do loop = do
displayName <- getContactName displayName <- getContactName
fullName <- T.pack <$> getWithPrompt "full name (optional)" 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 Left SEDuplicateName -> do
putStrLn "chosen display name is already used by another profile on this device, choose another one" putStrLn "chosen display name is already used by another profile on this device, choose another one"
loop loop
@ -3140,6 +3169,7 @@ chatCommandP =
"/_profile " *> (APIUpdateProfile <$> jsonP), "/_profile " *> (APIUpdateProfile <$> jsonP),
"/_set alias @" *> (APISetContactAlias <$> A.decimal <*> (A.space *> textP <|> pure "")), "/_set alias @" *> (APISetContactAlias <$> A.decimal <*> (A.space *> textP <|> pure "")),
"/_set alias :" *> (APISetConnectionAlias <$> 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), "/_parse " *> (APIParseMarkdown . safeDecodeUtf8 <$> A.takeByteString),
"/_ntf get" $> APIGetNtfToken, "/_ntf get" $> APIGetNtfToken,
"/_ntf register " *> (APIRegisterToken <$> strP_ <*> strP), "/_ntf register " *> (APIRegisterToken <$> strP_ <*> strP),
@ -3190,6 +3220,7 @@ chatCommandP =
("/members #" <|> "/members " <|> "/ms #" <|> "/ms ") *> (ListMembers <$> displayName), ("/members #" <|> "/members " <|> "/ms #" <|> "/ms ") *> (ListMembers <$> displayName),
("/groups" <|> "/gs") $> ListGroups, ("/groups" <|> "/gs") $> ListGroups,
"/_group_profile #" *> (APIUpdateGroupProfile <$> A.decimal <* A.space <*> jsonP), "/_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), ("/group_profile #" <|> "/gp #" <|> "/group_profile " <|> "/gp ") *> (UpdateGroupProfile <$> displayName <* A.space <*> groupProfile),
"/_create link #" *> (APICreateGroupLink <$> A.decimal), "/_create link #" *> (APICreateGroupLink <$> A.decimal),
"/_delete link #" *> (APIDeleteGroupLink <$> A.decimal), "/_delete link #" *> (APIDeleteGroupLink <$> A.decimal),
@ -3256,13 +3287,13 @@ chatCommandP =
pure (cName, fullName) pure (cName, fullName)
userProfile = do userProfile = do
(cName, fullName) <- userNames (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.FromJSON a => Parser a
jsonP = J.eitherDecodeStrict' <$?> A.takeByteString jsonP = J.eitherDecodeStrict' <$?> A.takeByteString
groupProfile = do groupProfile = do
gName <- displayName gName <- displayName
fullName <- fullNameP gName fullName <- fullNameP gName
pure GroupProfile {displayName = gName, fullName, image = Nothing} pure GroupProfile {displayName = gName, fullName, image = Nothing, preferences = Nothing}
fullNameP name = do fullNameP name = do
n <- (A.space *> A.takeByteString) <|> pure "" n <- (A.space *> A.takeByteString) <|> pure ""
pure $ if B.null n then name else safeDecodeUtf8 n pure $ if B.null n then name else safeDecodeUtf8 n

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

@ -166,6 +166,7 @@ data ChatCommand
| APIGetCallInvitations | APIGetCallInvitations
| APICallStatus ContactId WebRTCCallStatus | APICallStatus ContactId WebRTCCallStatus
| APIUpdateProfile Profile | APIUpdateProfile Profile
| APISetContactPrefs Int64 ChatPreferences
| APISetContactAlias ContactId LocalAlias | APISetContactAlias ContactId LocalAlias
| APISetConnectionAlias Int64 LocalAlias | APISetConnectionAlias Int64 LocalAlias
| APIParseMarkdown Text | APIParseMarkdown Text
@ -321,6 +322,7 @@ data ChatResponse
| CRUserProfileUpdated {fromProfile :: Profile, toProfile :: Profile} | CRUserProfileUpdated {fromProfile :: Profile, toProfile :: Profile}
| CRContactAliasUpdated {toContact :: Contact} | CRContactAliasUpdated {toContact :: Contact}
| CRConnectionAliasUpdated {toConnection :: PendingContactConnection} | CRConnectionAliasUpdated {toConnection :: PendingContactConnection}
| CRContactPrefsUpdated {toContact :: Contact}
| CRContactConnecting {contact :: Contact} | CRContactConnecting {contact :: Contact}
| CRContactConnected {contact :: Contact, userCustomProfile :: Maybe Profile} | CRContactConnected {contact :: Contact, userCustomProfile :: Maybe Profile}
| CRContactAnotherClient {contact :: Contact} | CRContactAnotherClient {contact :: Contact}

21
src/Simplex/Chat/Migrations/M20221025_chat_settings.hs Normal file
View 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;
|]

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

@ -15,7 +15,8 @@ CREATE TABLE contact_profiles(
image TEXT, image TEXT,
user_id INTEGER DEFAULT NULL REFERENCES users ON DELETE CASCADE, user_id INTEGER DEFAULT NULL REFERENCES users ON DELETE CASCADE,
incognito INTEGER, 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( CREATE INDEX contact_profiles_index ON contact_profiles(
display_name, display_name,
@ -58,6 +59,7 @@ CREATE TABLE contacts(
enable_ntfs INTEGER, enable_ntfs INTEGER,
unread_chat INTEGER DEFAULT 0 CHECK(unread_chat NOT NULL), unread_chat INTEGER DEFAULT 0 CHECK(unread_chat NOT NULL),
contact_used INTEGER DEFAULT 0 CHECK(contact_used 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) FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE ON DELETE CASCADE
@ -113,7 +115,8 @@ CREATE TABLE group_profiles(
created_at TEXT CHECK(created_at NOT NULL), created_at TEXT CHECK(created_at NOT NULL),
updated_at TEXT CHECK(updated_at NOT NULL), updated_at TEXT CHECK(updated_at NOT NULL),
image TEXT, 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( CREATE TABLE groups(
group_id INTEGER PRIMARY KEY, -- local group ID group_id INTEGER PRIMARY KEY, -- local group ID

2
src/Simplex/Chat/ProfileGenerator.hs
View File

@ -10,7 +10,7 @@ generateRandomProfile :: IO Profile
generateRandomProfile = do generateRandomProfile = do
adjective <- pick adjectives adjective <- pick adjectives
noun <- pickNoun adjective 2 noun <- pickNoun adjective 2
pure $ Profile {displayName = adjective <> noun, fullName = "", image = Nothing} pure $ Profile {displayName = adjective <> noun, fullName = "", image = Nothing, preferences = Nothing}
where where
pick :: [a] -> IO a pick :: [a] -> IO a
pick xs = (xs !!) <$> randomRIO (0, length xs - 1) pick xs = (xs !!) <$> randomRIO (0, length xs - 1)

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

@ -40,6 +40,7 @@ module Simplex.Chat.Store
getContactIdByName, getContactIdByName,
updateUserProfile, updateUserProfile,
updateContactProfile, updateContactProfile,
updateContactUserPreferences,
updateContactAlias, updateContactAlias,
updateContactConnectionAlias, updateContactConnectionAlias,
updateContactUsed, updateContactUsed,
@ -290,6 +291,7 @@ import Simplex.Chat.Migrations.M20221012_inline_files
import Simplex.Chat.Migrations.M20221019_unread_chat import Simplex.Chat.Migrations.M20221019_unread_chat
import Simplex.Chat.Migrations.M20221021_auto_accept__group_links import Simplex.Chat.Migrations.M20221021_auto_accept__group_links
import Simplex.Chat.Migrations.M20221024_contact_used import Simplex.Chat.Migrations.M20221024_contact_used
import Simplex.Chat.Migrations.M20221025_chat_settings
import Simplex.Chat.Protocol import Simplex.Chat.Protocol
import Simplex.Chat.Types import Simplex.Chat.Types
import Simplex.Messaging.Agent.Protocol (ACorrId, AgentMsgId, ConnId, InvitationId, MsgMeta (..)) import Simplex.Messaging.Agent.Protocol (ACorrId, AgentMsgId, ConnId, InvitationId, MsgMeta (..))
@ -334,7 +336,8 @@ schemaMigrations =
("20221012_inline_files", m20221012_inline_files), ("20221012_inline_files", m20221012_inline_files),
("20221019_unread_chat", m20221019_unread_chat), ("20221019_unread_chat", m20221019_unread_chat),
("20221021_auto_accept__group_links", m20221021_auto_accept__group_links), ("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 -- | 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()" insertedRowId db = fromOnly . head <$> DB.query_ db "SELECT last_insert_rowid()"
createUser :: DB.Connection -> Profile -> Bool -> ExceptT StoreError IO User 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 checkConstraint SEDuplicateName . liftIO $ do
currentTs <- getCurrentTime currentTs <- getCurrentTime
DB.execute DB.execute
@ -378,8 +381,8 @@ createUser db Profile {displayName, fullName, image} activeUser =
(displayName, displayName, userId, currentTs, currentTs) (displayName, displayName, userId, currentTs, currentTs)
DB.execute DB.execute
db db
"INSERT INTO contact_profiles (display_name, full_name, image, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)" "INSERT INTO contact_profiles (display_name, full_name, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
(displayName, fullName, image, userId, currentTs, currentTs) (displayName, fullName, image, userId, userPreferences, currentTs, currentTs)
profileId <- insertedRowId db profileId <- insertedRowId db
DB.execute DB.execute
db db
@ -387,7 +390,7 @@ createUser db Profile {displayName, fullName, image} activeUser =
(profileId, displayName, userId, True, currentTs, currentTs) (profileId, displayName, userId, True, currentTs, currentTs)
contactId <- insertedRowId db contactId <- insertedRowId db
DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId) 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.Connection -> IO [User]
getUsers db = getUsers db =
@ -395,15 +398,15 @@ getUsers db =
<$> DB.query_ <$> DB.query_
db db
[sql| [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 FROM users u
JOIN contacts c ON u.contact_id = c.contact_id JOIN contacts c ON u.contact_id = c.contact_id
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_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, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe ChatPreferences) -> User
toUser (userId, userContactId, profileId, activeUser, displayName, fullName, image) = toUser (userId, userContactId, profileId, activeUser, displayName, fullName, image, userPreferences) =
let profile = LocalProfile {profileId, displayName, fullName, image, localAlias = ""} let profile = LocalProfile {profileId, displayName, fullName, image, preferences = userPreferences, localAlias = ""}
in User {userId, userContactId, localDisplayName = displayName, profile, activeUser} in User {userId, userContactId, localDisplayName = displayName, profile, activeUser}
setActiveUser :: DB.Connection -> UserId -> IO () setActiveUser :: DB.Connection -> UserId -> IO ()
@ -442,7 +445,7 @@ getConnReqContactXContactId db userId cReqHash = do
[sql| [sql|
SELECT SELECT
-- Contact -- 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 -- 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.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 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.query
db db
[sql| [sql|
SELECT display_name, full_name, image, local_alias SELECT cp.display_name, cp.full_name, cp.image, cp.local_alias, cp.preferences -- , ct.user_preferences
FROM contact_profiles FROM contact_profiles cp
WHERE user_id = ? AND contact_profile_id = ? -- JOIN contacts ct ON cp.contact_profile_id = ct.contact_profile_id
WHERE cp.user_id = ? AND cp.contact_profile_id = ?
|] |]
(userId, profileId) (userId, profileId)
where where
toProfile :: (ContactName, Text, Maybe ImageData, LocalAlias) -> LocalProfile toProfile :: (ContactName, Text, Maybe ImageData, LocalAlias, Maybe ChatPreferences) -> LocalProfile
toProfile (displayName, fullName, image, localAlias) = LocalProfile {profileId, displayName, fullName, image, localAlias} 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.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 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 createDirectContact db userId activeConn@Connection {connId, localAlias} profile = do
createdAt <- liftIO getCurrentTime createdAt <- liftIO getCurrentTime
(localDisplayName, contactId, profileId) <- createContact_ db userId connId profile localAlias Nothing createdAt (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.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 ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do
DB.execute DB.execute
db db
"INSERT INTO contact_profiles (display_name, full_name, image, user_id, local_alias, created_at, updated_at) VALUES (?,?,?,?,?,?,?)" "INSERT INTO contact_profiles (display_name, full_name, image, user_id, local_alias, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
(displayName, fullName, image, userId, localAlias, currentTs, currentTs) (displayName, fullName, image, userId, localAlias, preferences, currentTs, currentTs)
profileId <- insertedRowId db profileId <- insertedRowId db
DB.execute DB.execute
db db
@ -632,6 +636,14 @@ updateContactProfile db userId c@Contact {contactId, localDisplayName, profile =
updateContact_ db userId contactId localDisplayName ldn currentTs updateContact_ db userId contactId localDisplayName ldn currentTs
pure . Right $ (c :: Contact) {localDisplayName = ldn, profile = toLocalProfile profileId p' localAlias} 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.Connection -> UserId -> Contact -> LocalAlias -> IO Contact
updateContactAlias db userId c@Contact {profile = lp@LocalProfile {profileId}} localAlias = do updateContactAlias db userId c@Contact {profile = lp@LocalProfile {profileId}} localAlias = do
updatedAt <- getCurrentTime updatedAt <- getCurrentTime
@ -679,15 +691,15 @@ updateContactProfile_ db userId profileId profile = do
updateContactProfile_' db userId profileId profile currentTs updateContactProfile_' db userId profileId profile currentTs
updateContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> UTCTime -> IO () 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.execute
db db
[sql| [sql|
UPDATE contact_profiles 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 = ? 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.Connection -> UserId -> Int64 -> ContactName -> ContactName -> UTCTime -> IO ()
updateContact_ db userId contactId displayName newName updatedAt = do updateContact_ db userId contactId displayName newName updatedAt = do
@ -701,22 +713,22 @@ updateContact_ db userId contactId displayName newName updatedAt = do
(newName, updatedAt, userId, contactId) (newName, updatedAt, userId, contactId)
DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (displayName, userId) 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 :: ContactRow :. ConnectionRow -> Contact
toContact ((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, localAlias, contactUsed, enableNtfs_, createdAt, updatedAt) :. connRow) = toContact (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, localAlias, contactUsed, enableNtfs_) :. (preferences, userPreferences, createdAt, updatedAt)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, localAlias} let profile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
activeConn = toConnection connRow activeConn = toConnection connRow
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_} 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 :: ContactRow :. MaybeConnectionRow -> Either StoreError Contact
toContactOrError ((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, localAlias, contactUsed, enableNtfs_, createdAt, updatedAt) :. connRow) = toContactOrError (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, localAlias, contactUsed, enableNtfs_) :. (preferences, userPreferences, createdAt, updatedAt)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, localAlias} let profile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_} chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
in case toMaybeConnection connRow of in case toMaybeConnection connRow of
Just activeConn -> 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 _ -> Left $ SEContactNotReady localDisplayName
-- TODO return the last connection that is ready, not any last connection -- 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) 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.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 liftIO (maybeM getContact' xContactId_) >>= \case
Just contact -> pure $ CORContact contact Just contact -> pure $ CORContact contact
Nothing -> CORRequest <$> createOrUpdate_ Nothing -> CORRequest <$> createOrUpdate_
@ -976,8 +988,8 @@ createOrUpdateContactRequest db userId userContactLinkId invId Profile {displayN
createContactRequest_ currentTs ldn = do createContactRequest_ currentTs ldn = do
DB.execute DB.execute
db db
"INSERT INTO contact_profiles (display_name, full_name, image, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)" "INSERT INTO contact_profiles (display_name, full_name, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
(displayName, fullName, image, userId, currentTs, currentTs) (displayName, fullName, image, userId, preferences, currentTs, currentTs)
profileId <- insertedRowId db profileId <- insertedRowId db
DB.execute DB.execute
db db
@ -996,7 +1008,7 @@ createOrUpdateContactRequest db userId userContactLinkId invId Profile {displayN
[sql| [sql|
SELECT SELECT
-- Contact -- 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 -- 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.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 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| [sql|
SELECT SELECT
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id, 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 FROM contact_requests cr
JOIN connections c USING (user_contact_link_id) JOIN connections c USING (user_contact_link_id)
JOIN contact_profiles p USING (contact_profile_id) JOIN contact_profiles p USING (contact_profile_id)
@ -1062,7 +1074,7 @@ getContactRequest db userId contactRequestId =
[sql| [sql|
SELECT SELECT
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id, 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 FROM contact_requests cr
JOIN connections c USING (user_contact_link_id) JOIN connections c USING (user_contact_link_id)
JOIN contact_profiles p USING (contact_profile_id) JOIN contact_profiles p USING (contact_profile_id)
@ -1071,11 +1083,11 @@ getContactRequest db userId contactRequestId =
|] |]
(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 :: ContactRequestRow -> UserContactRequest
toContactRequest (contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image, xContactId, createdAt, updatedAt) = do toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image) :. (xContactId, preferences, createdAt, updatedAt)) = do
let profile = Profile {displayName, fullName, image} let profile = Profile {displayName, fullName, image, preferences}
in UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, localDisplayName, profileId, profile, xContactId, createdAt, updatedAt} in UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, localDisplayName, profileId, profile, xContactId, createdAt, updatedAt}
getContactRequestIdByName :: DB.Connection -> UserId -> ContactName -> ExceptT StoreError IO Int64 getContactRequestIdByName :: DB.Connection -> UserId -> ContactName -> ExceptT StoreError IO Int64
@ -1108,20 +1120,21 @@ deleteContactRequest db userId contactRequestId = do
(userId, userId, contactRequestId) (userId, userId, contactRequestId)
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (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.Connection -> User -> ConnId -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> IO Contact
createAcceptedContact db userId agentConnId localDisplayName profileId profile userContactLinkId xContactId incognitoProfile = do 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) DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
createdAt <- getCurrentTime createdAt <- getCurrentTime
customUserProfileId <- forM incognitoProfile $ \case customUserProfileId <- forM incognitoProfile $ \case
NewIncognito p -> createIncognitoProfile_ db userId createdAt p NewIncognito p -> createIncognitoProfile_ db userId createdAt p
ExistingIncognito LocalProfile {profileId = pId} -> pure pId ExistingIncognito LocalProfile {profileId = pId} -> pure pId
let contactUserPrefs = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences
DB.execute DB.execute
db db
"INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, created_at, updated_at, xcontact_id) VALUES (?,?,?,?,?,?,?)" "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, createdAt, createdAt, xContactId) (userId, localDisplayName, profileId, True, contactUserPrefs, createdAt, createdAt, xContactId)
contactId <- insertedRowId db contactId <- insertedRowId db
activeConn <- createConnection_ db userId ConnContact (Just contactId) agentConnId Nothing (Just userContactLinkId) customUserProfileId 0 createdAt 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.Connection -> User -> IO [SndFileTransfer]
getLiveSndFileTransfers db User {userId} = do getLiveSndFileTransfers db User {userId} = do
@ -1403,17 +1416,17 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
<$> DB.query <$> DB.query
db db
[sql| [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 FROM contacts c
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
WHERE c.user_id = ? AND c.contact_id = ? WHERE c.user_id = ? AND c.contact_id = ?
|] |]
(userId, contactId) (userId, contactId)
toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, LocalAlias, Maybe Int64, Bool, Maybe Bool, UTCTime, UTCTime)] -> Either StoreError Contact 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_, createdAt, updatedAt)] = toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, localAlias, viaGroup, contactUsed, enableNtfs_) :. (preferences, userPreferences, createdAt, updatedAt)] =
let profile = LocalProfile {profileId, displayName, fullName, image, localAlias} let profile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_} 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" toContact' _ _ _ = Left $ SEInternalError "referenced contact not found"
getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember) getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember_ groupMemberId c = ExceptT $ do getGroupAndMember_ groupMemberId c = ExceptT $ do
@ -1423,15 +1436,15 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
[sql| [sql|
SELECT SELECT
-- GroupInfo -- 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} -- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, 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, 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}} -- 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 -- from GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, 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 FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) 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 JOIN groups g ON g.group_id = m.group_id
@ -1524,15 +1537,15 @@ getGroupAndMember db User {userId, userContactId} groupMemberId =
[sql| [sql|
SELECT SELECT
-- GroupInfo -- 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} -- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, 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, 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}} -- 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 -- from GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, 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.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 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 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 -- | creates completely new group with a single member - the current user
createNewGroup :: DB.Connection -> TVar ChaChaDRG -> User -> GroupProfile -> ExceptT StoreError IO GroupInfo createNewGroup :: DB.Connection -> TVar ChaChaDRG -> User -> GroupProfile -> ExceptT StoreError IO GroupInfo
createNewGroup db gVar user@User {userId} groupProfile = ExceptT $ do createNewGroup db gVar user@User {userId} groupProfile = ExceptT $ do
let GroupProfile {displayName, fullName, image} = groupProfile let GroupProfile {displayName, fullName, image, preferences} = groupProfile
currentTs <- getCurrentTime currentTs <- getCurrentTime
withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
groupId <- liftIO $ do groupId <- liftIO $ do
DB.execute DB.execute
db db
"INSERT INTO group_profiles (display_name, full_name, image, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)" "INSERT INTO group_profiles (display_name, full_name, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
(displayName, fullName, image, userId, currentTs, currentTs) (displayName, fullName, image, userId, preferences, currentTs, currentTs)
profileId <- insertedRowId db profileId <- insertedRowId db
DB.execute DB.execute
db 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) 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_ :: ExceptT StoreError IO GroupInfo
createGroupInvitation_ = do createGroupInvitation_ = do
let GroupProfile {displayName, fullName, image} = groupProfile let GroupProfile {displayName, fullName, image, preferences} = groupProfile
ExceptT $ ExceptT $
withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do
currentTs <- liftIO getCurrentTime currentTs <- liftIO getCurrentTime
groupId <- liftIO $ do groupId <- liftIO $ do
DB.execute DB.execute
db db
"INSERT INTO group_profiles (display_name, full_name, image, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)" "INSERT INTO group_profiles (display_name, full_name, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
(displayName, fullName, image, userId, currentTs, currentTs) (displayName, fullName, image, userId, preferences, currentTs, currentTs)
profileId <- insertedRowId db profileId <- insertedRowId db
DB.execute DB.execute
db db
@ -1734,9 +1747,9 @@ getUserGroupDetails db User {userId, userContactId} =
<$> DB.query <$> DB.query
db db
[sql| [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.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 FROM groups g
JOIN group_profiles gp USING (group_profile_id) JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu USING (group_id) JOIN group_members mu USING (group_id)
@ -1750,13 +1763,13 @@ getGroupInfoByName db user gName = do
gId <- getGroupIdByName db user gName gId <- getGroupIdByName db user gName
getGroupInfo db user gId 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 :: 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 let membership = toGroupMember userContactId userMemberRow
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_} 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.Connection -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO GroupMember
getGroupMember db user@User {userId} groupId groupMemberId = getGroupMember db user@User {userId} groupId groupMemberId =
@ -1766,7 +1779,7 @@ getGroupMember db user@User {userId} groupId groupMemberId =
[sql| [sql|
SELECT SELECT
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, 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.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 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 FROM group_members m
@ -1788,7 +1801,7 @@ getGroupMembers db user@User {userId, userContactId} GroupInfo {groupId} = do
[sql| [sql|
SELECT SELECT
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, 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.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 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 FROM group_members m
@ -1852,20 +1865,20 @@ getGroupInvitation db user groupId = do
findFromContact (IBContact contactId) = find ((== Just contactId) . memberContactId) findFromContact (IBContact contactId) = find ((== Just contactId) . memberContactId)
findFromContact _ = const Nothing 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 :: Int64 -> GroupMemberRow -> GroupMember
toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, 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, localAlias} let memberProfile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
invitedBy = toInvitedBy userContactId invitedById invitedBy = toInvitedBy userContactId invitedById
activeConn = Nothing activeConn = Nothing
in GroupMember {..} in GroupMember {..}
toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe 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)) = 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)) Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, localAlias, contactPreferences))
toMaybeGroupMember _ _ = Nothing toMaybeGroupMember _ _ = Nothing
createNewContactMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupId -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> ExceptT StoreError IO GroupMember 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| [sql|
SELECT SELECT
-- Contact -- 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 -- 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.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 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 -- | add new member with profile
createNewGroupMember :: DB.Connection -> User -> GroupInfo -> MemberInfo -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember 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 ExceptT . withLocalDisplayName db userId displayName $ \localDisplayName -> do
currentTs <- getCurrentTime currentTs <- getCurrentTime
DB.execute DB.execute
db db
"INSERT INTO contact_profiles (display_name, full_name, image, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)" "INSERT INTO contact_profiles (display_name, full_name, image, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
(displayName, fullName, image, userId, currentTs, currentTs) (displayName, fullName, image, userId, preferences, currentTs, currentTs)
memProfileId <- insertedRowId db memProfileId <- insertedRowId db
let newMember = let newMember =
NewGroupMember NewGroupMember
@ -2235,15 +2248,15 @@ getViaGroupMember db User {userId, userContactId} Contact {contactId} =
[sql| [sql|
SELECT SELECT
-- GroupInfo -- 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} -- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, 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, 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}} -- 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 -- via GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, 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.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 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 FROM group_members m
@ -2275,7 +2288,7 @@ getViaGroupContact db User {userId} GroupMember {groupMemberId} =
db db
[sql| [sql|
SELECT 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.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 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 FROM contacts ct
@ -2291,12 +2304,12 @@ getViaGroupContact db User {userId} GroupMember {groupMemberId} =
|] |]
(userId, groupMemberId) (userId, groupMemberId)
where where
toContact' :: (ContactId, ProfileId, ContactName, Text, Text, Maybe ImageData, LocalAlias, Maybe Int64, Bool, Maybe Bool, UTCTime, UTCTime) :. ConnectionRow -> Contact 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_, createdAt, updatedAt) :. connRow) = toContact' (((contactId, profileId, localDisplayName, displayName, fullName, image, localAlias, viaGroup, contactUsed, enableNtfs_) :. (preferences, userPreferences, createdAt, updatedAt)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, localAlias} let profile = LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_} chatSettings = ChatSettings {enableNtfs = fromMaybe True enableNtfs_}
activeConn = toConnection connRow 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.Connection -> UserId -> Contact -> FilePath -> FileInvitation -> Maybe ConnId -> Integer -> IO FileTransferMeta
createSndDirectFileTransfer db userId Contact {contactId} filePath FileInvitation {fileName, fileSize, fileInline} acId_ chunkSize = do 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 -- GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, 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, 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 FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) 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 LEFT JOIN contacts c ON m.contact_id = c.contact_id
@ -3152,7 +3165,7 @@ getDirectChatPreviews_ db User {userId} = do
[sql| [sql|
SELECT SELECT
-- Contact -- 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 -- 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.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, 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| [sql|
SELECT SELECT
-- GroupInfo -- 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 -- GroupMember - membership
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, 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, 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 -- ChatStats
COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), g.unread_chat, COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), g.unread_chat,
-- ChatItem -- ChatItem
@ -3231,13 +3244,13 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
-- Maybe GroupMember - sender -- Maybe GroupMember - sender
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, 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, 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 -- quoted ChatItem
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
-- quoted GroupMember -- quoted GroupMember
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category, 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, 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 FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
JOIN group_members mu ON mu.group_id = g.group_id JOIN group_members mu ON mu.group_id = g.group_id
@ -3282,7 +3295,7 @@ getContactRequestChatPreviews_ db User {userId} =
[sql| [sql|
SELECT SELECT
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id, 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 FROM contact_requests cr
JOIN connections c ON c.user_contact_link_id = cr.user_contact_link_id 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 JOIN contact_profiles p ON p.contact_profile_id = cr.contact_profile_id
@ -3476,7 +3489,7 @@ getContact db userId contactId =
[sql| [sql|
SELECT SELECT
-- Contact -- 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 -- 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.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 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| [sql|
SELECT SELECT
-- GroupInfo -- 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 -- GroupMember - membership
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category, 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, 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 FROM groups g
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
JOIN group_members mu ON mu.group_id = g.group_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) (groupId, userId, userContactId)
updateGroupProfile :: DB.Connection -> User -> GroupInfo -> GroupProfile -> ExceptT StoreError IO GroupInfo 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 | displayName == newName = liftIO $ do
currentTs <- getCurrentTime currentTs <- getCurrentTime
updateGroupProfile_ currentTs $> (g :: GroupInfo) {groupProfile = p'} updateGroupProfile_ currentTs $> (g :: GroupInfo) {groupProfile = p'}
@ -3614,14 +3627,14 @@ updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, grou
db db
[sql| [sql|
UPDATE group_profiles 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 ( WHERE group_profile_id IN (
SELECT group_profile_id SELECT group_profile_id
FROM groups FROM groups
WHERE user_id = ? AND group_id = ? WHERE user_id = ? AND group_id = ?
) )
|] |]
(newName, fullName, image, currentTs, userId, groupId) (newName, fullName, image, preferences, currentTs, userId, groupId)
updateGroup_ ldn currentTs = do updateGroup_ ldn currentTs = do
DB.execute DB.execute
db db
@ -3927,13 +3940,13 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
-- GroupMember -- GroupMember
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, 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, 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 -- quoted ChatItem
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
-- quoted GroupMember -- quoted GroupMember
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category, 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, 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 FROM chat_items i
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id 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 LEFT JOIN group_members m ON m.group_member_id = i.group_member_id

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

@ -26,10 +26,12 @@ import qualified Data.Aeson.Types as JT
import qualified Data.Attoparsec.ByteString.Char8 as A import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.ByteString.Char8 (ByteString, pack, unpack) import Data.ByteString.Char8 (ByteString, pack, unpack)
import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Int (Int64) import Data.Int (Int64)
import Data.Maybe (isJust) import Data.Maybe (isJust)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Time.Clock (UTCTime) import Data.Time.Clock (UTCTime)
import Data.Typeable import Data.Typeable
import Database.SQLite.Simple (ResultError (..), SQLData (..)) 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.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId)
import Simplex.Messaging.Encoding.String import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, sumTypeJSON) import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, sumTypeJSON)
import Simplex.Messaging.Util ((<$?>)) import Simplex.Messaging.Util ((<$?>), safeDecodeUtf8)
class IsContact a where class IsContact a where
contactId' :: a -> ContactId contactId' :: a -> ContactId
@ -83,6 +85,7 @@ data Contact = Contact
viaGroup :: Maybe Int64, viaGroup :: Maybe Int64,
contactUsed :: Bool, contactUsed :: Bool,
chatSettings :: ChatSettings, chatSettings :: ChatSettings,
userPreferences :: ChatPreferences,
createdAt :: UTCTime, createdAt :: UTCTime,
updatedAt :: UTCTime updatedAt :: UTCTime
} }
@ -227,10 +230,70 @@ defaultChatSettings = ChatSettings {enableNtfs = True}
pattern DisableNtfs :: ChatSettings pattern DisableNtfs :: ChatSettings
pattern DisableNtfs = ChatSettings {enableNtfs = False} 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 data Profile = Profile
{ displayName :: ContactName, { displayName :: ContactName,
fullName :: Text, 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: -- fields that should not be read into this data type to prevent sending them as part of profile to contacts:
-- - contact_profile_id -- - contact_profile_id
-- - incognito -- - incognito
@ -251,6 +314,7 @@ data LocalProfile = LocalProfile
displayName :: ContactName, displayName :: ContactName,
fullName :: Text, fullName :: Text,
image :: Maybe ImageData, image :: Maybe ImageData,
preferences :: Maybe ChatPreferences,
localAlias :: LocalAlias localAlias :: LocalAlias
} }
deriving (Eq, Show, Generic, FromJSON) deriving (Eq, Show, Generic, FromJSON)
@ -263,17 +327,18 @@ localProfileId :: LocalProfile -> ProfileId
localProfileId = profileId localProfileId = profileId
toLocalProfile :: ProfileId -> Profile -> LocalAlias -> LocalProfile toLocalProfile :: ProfileId -> Profile -> LocalAlias -> LocalProfile
toLocalProfile profileId Profile {displayName, fullName, image} localAlias = toLocalProfile profileId Profile {displayName, fullName, image, preferences} localAlias =
LocalProfile {profileId, displayName, fullName, image, localAlias} LocalProfile {profileId, displayName, fullName, image, preferences, localAlias}
fromLocalProfile :: LocalProfile -> Profile fromLocalProfile :: LocalProfile -> Profile
fromLocalProfile LocalProfile {displayName, fullName, image} = fromLocalProfile LocalProfile {displayName, fullName, image, preferences} =
Profile {displayName, fullName, image} Profile {displayName, fullName, image, preferences}
data GroupProfile = GroupProfile data GroupProfile = GroupProfile
{ displayName :: GroupName, { displayName :: GroupName,
fullName :: Text, fullName :: Text,
image :: Maybe ImageData image :: Maybe ImageData,
preferences :: Maybe ChatPreferences
} }
deriving (Eq, Show, Generic, FromJSON) deriving (Eq, Show, Generic, FromJSON)

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

@ -123,6 +123,7 @@ responseToView testView = \case
CRSndGroupFileCancelled _ ftm fts -> viewSndGroupFileCancelled ftm fts CRSndGroupFileCancelled _ ftm fts -> viewSndGroupFileCancelled ftm fts
CRRcvFileCancelled ft -> receivingFile_ "cancelled" ft CRRcvFileCancelled ft -> receivingFile_ "cancelled" ft
CRUserProfileUpdated p p' -> viewUserProfileUpdated p p' CRUserProfileUpdated p p' -> viewUserProfileUpdated p p'
CRContactPrefsUpdated ct -> viewContactPrefsUpdated ct
CRContactAliasUpdated c -> viewContactAliasUpdated c CRContactAliasUpdated c -> viewContactAliasUpdated c
CRConnectionAliasUpdated c -> viewConnectionAliasUpdated c CRConnectionAliasUpdated c -> viewConnectionAliasUpdated c
CRContactUpdated c c' -> viewContactUpdated c c' CRContactUpdated c c' -> viewContactUpdated c c'
@ -701,6 +702,18 @@ viewUserProfileUpdated Profile {displayName = n, fullName, image} Profile {displ
where where
notified = " (your contacts are notified)" 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 -> GroupInfo -> Maybe GroupMember -> [StyledString]
viewGroupUpdated viewGroupUpdated
GroupInfo {localDisplayName = n, groupProfile = GroupProfile {fullName, image}} GroupInfo {localDisplayName = n, groupProfile = GroupProfile {fullName, image}}

49
tests/ChatTests.hs
View File

@ -2,6 +2,7 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PostfixOperators #-} {-# LANGUAGE PostfixOperators #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
@ -24,7 +25,7 @@ import qualified Data.Text as T
import Simplex.Chat.Call import Simplex.Chat.Call
import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), InlineFilesConfig (..), defaultInlineFilesConfig) import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), InlineFilesConfig (..), defaultInlineFilesConfig)
import Simplex.Chat.Options (ChatOpts (..)) import Simplex.Chat.Options (ChatOpts (..))
import Simplex.Chat.Types (ConnStatus (..), GroupMemberRole (..), ImageData (..), LocalProfile (..), Profile (..), User (..)) import Simplex.Chat.Types (ConnStatus (..), GroupMemberRole (..), ImageData (..), LocalProfile (..), Profile (..), User (..), defaultChatPrefs)
import Simplex.Messaging.Encoding.String import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Util (unlessM) import Simplex.Messaging.Util (unlessM)
import System.Directory (copyFile, doesDirectoryExist, doesFileExist) import System.Directory (copyFile, doesDirectoryExist, doesFileExist)
@ -32,16 +33,16 @@ import System.FilePath ((</>))
import Test.Hspec import Test.Hspec
aliceProfile :: Profile aliceProfile :: Profile
aliceProfile = Profile {displayName = "alice", fullName = "Alice", image = Nothing} aliceProfile = Profile {displayName = "alice", fullName = "Alice", image = Nothing, preferences = Just defaultChatPrefs}
bobProfile :: Profile bobProfile :: Profile
bobProfile = Profile {displayName = "bob", fullName = "Bob", image = Just (ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAKHGlDQ1BJQ0MgUHJvZmlsZQAASImFVgdUVNcWve9Nb7QZeu9NehtAem/Sq6gMQ28OQxWxgAQjEFFEREARNFQFg1KjiIhiIQgoYA9IEFBisCAq6OQNJNH4//r/zDpz9ttzz7n73ffWmg0A6QCDxYqD+QCIT0hmezlYywQEBsngngEYCAIy0AC6DGYSy8rDwxUg8Xf9d7wbAxC33tHgzvrP3/9nCISFJzEBgIIRTGey2MkILkawT1oyi4tnEUxjI6IQvMLFkauYqxjQQtewwuoaHy8bBNMBwJMZDHYkAERbhJdJZUYic4hhCNZOCItOQDB3vjkzioFwxLsIXhcRl5IOAImrRzs+fivCk7QRrIL0shAcwNUW+tX8yH/tFfrPXgxG5D84Pi6F+dc9ck+HHJ7g641UMSQlQATQBHEgBaQDGcACbLAVYaIRJhx5Dv+9j77aZ4OsZIFtSEc0iARRIBnpt/9qlvfqpGSQBhjImnCEcUU+NtxnujZy4fbqVEiU/wuXdQyA9S0cDqfzC+e2F4DzyLkSB79wyi0A8KoBcL2GmcJOXePQ3C8MIAJeQAOiQArIAxXuWwMMgSmwBHbAGbgDHxAINgMmojceUZUGMkEWyAX54AA4DMpAJTgJ6sAZ0ALawQVwGVwDt8AQGAUPwQSYBi/AAngHliEIwkEUiAqJQtKQIqQO6UJ0yByyg1whLygQCoEioQQoBcqE9kD5UBFUBlVB9dBPUCd0GboBDUP3oUloDnoNfYRRMBmmwZKwEqwF02Er2AX2gTfBkXAinAHnwPvhUrgaPg23wZfhW/AoPAG/gBdRAEVCCaFkURooOsoG5Y4KQkWg2KidqDxUCaoa1YTqQvWj7qAmUPOoD2gsmoqWQWugTdGOaF80E52I3okuQJeh69Bt6D70HfQkegH9GUPBSGDUMSYYJ0wAJhKThsnFlGBqMK2Yq5hRzDTmHRaLFcIqY42wjthAbAx2O7YAewzbjO3BDmOnsIs4HE4Up44zw7njGLhkXC7uKO407hJuBDeNe48n4aXxunh7fBA+AZ+NL8E34LvxI/gZ/DKBj6BIMCG4E8II2wiFhFOELsJtwjRhmchPVCaaEX2IMcQsYimxiXiV+Ij4hkQiyZGMSZ6kaNJuUinpLOk6aZL0gSxAViPbkIPJKeT95FpyD/k++Q2FQlGiWFKCKMmU/ZR6yhXKE8p7HiqPJo8TTxjPLp5ynjaeEZ6XvAReRV4r3s28GbwlvOd4b/PO8xH4lPhs+Bh8O/nK+Tr5xvkW+an8Ovzu/PH8BfwN/Df4ZwVwAkoCdgJhAjkCJwWuCExRUVR5qg2VSd1DPUW9Sp2mYWnKNCdaDC2fdoY2SFsQFBDUF/QTTBcsF7woOCGEElISchKKEyoUahEaE/ooLClsJRwuvE+4SXhEeElEXMRSJFwkT6RZZFTko6iMqJ1orOhB0XbRx2JoMTUxT7E0seNiV8XmxWnipuJM8TzxFvEHErCEmoSXxHaJkxIDEouSUpIOkizJo5JXJOelhKQspWKkiqW6peakqdLm0tHSxdKXpJ/LCMpYycTJlMr0ySzISsg6yqbIVskOyi7LKcv5ymXLNcs9lifK0+Uj5Ivle+UXFKQV3BQyFRoVHigSFOmKUYpHFPsVl5SUlfyV9iq1K80qiyg7KWcoNyo/UqGoWKgkqlSr3FXFqtJVY1WPqQ6pwWoGalFq5Wq31WF1Q/Vo9WPqw+sw64zXJayrXjeuQdaw0kjVaNSY1BTSdNXM1mzXfKmloBWkdVCrX+uztoF2nPYp7Yc6AjrOOtk6XTqvddV0mbrlunf1KHr2erv0OvRe6avrh+sf179nQDVwM9hr0GvwydDIkG3YZDhnpGAUYlRhNE6n0T3oBfTrxhhja+NdxheMP5gYmiSbtJj8YaphGmvaYDq7Xnl9+PpT66fM5MwYZlVmE+Yy5iHmJ8wnLGQtGBbVFk8t5S3DLGssZ6xUrWKsTlu9tNa2Zlu3Wi/ZmNjssOmxRdk62ObZDtoJ2Pnaldk9sZezj7RvtF9wMHDY7tDjiHF0cTzoOO4k6cR0qndacDZy3uHc50J28XYpc3nqqubKdu1yg92c3Q65PdqguCFhQ7s7cHdyP+T+2EPZI9HjZ0+sp4dnueczLx2vTK9+b6r3Fu8G73c+1j6FPg99VXxTfHv9eP2C/er9lvxt/Yv8JwK0AnYE3AoUC4wO7AjCBfkF1QQtbrTbeHjjdLBBcG7w2CblTembbmwW2xy3+eIW3i2MLedCMCH+IQ0hKwx3RjVjMdQptCJ0gWnDPMJ8EWYZVhw2F24WXhQ+E2EWURQxG2kWeShyLsoiqiRqPtomuiz6VYxjTGXMUqx7bG0sJ84/rjkeHx8S35kgkBCb0LdVamv61mGWOiuXNZFokng4cYHtwq5JgpI2JXUk05A/0oEUlZTvUiZTzVPLU9+n+aWdS+dPT0gf2Ka2bd+2mQz7jB+3o7czt/dmymZmZU7usNpRtRPaGbqzd5f8rpxd07sddtdlEbNis37J1s4uyn67x39PV45kzu6cqe8cvmvM5cll547vNd1b+T36++jvB/fp7Tu673NeWN7NfO38kvyVAmbBzR90fij9gbM/Yv9goWHh8QPYAwkHxg5aHKwr4i/KKJo65HaorVimOK/47eEth2+U6JdUHiEeSTkyUepa2nFU4eiBoytlUWWj5dblzRUSFfsqlo6FHRs5bnm8qVKyMr/y44noE/eqHKraqpWqS05iT6aefHbK71T/j/Qf62vEavJrPtUm1E7UedX11RvV1zdINBQ2wo0pjXOng08PnbE909Gk0VTVLNScfxacTTn7/KeQn8ZaXFp6z9HPNZ1XPF/RSm3Na4PatrUttEe1T3QEdgx3Onf2dpl2tf6s+XPtBdkL5RcFLxZ2E7tzujmXMi4t9rB65i9HXp7q3dL78ErAlbt9nn2DV12uXr9mf+1Kv1X/petm1y/cMLnReZN+s/2W4a22AYOB1l8MfmkdNBxsu210u2PIeKhreP1w94jFyOU7tneu3XW6e2t0w+jwmO/YvfHg8Yl7Yfdm78fdf/Ug9cHyw92PMI/yHvM9Lnki8aT6V9VfmycMJy5O2k4OPPV++nCKOfXit6TfVqZznlGelcxIz9TP6s5emLOfG3q+8fn0C9aL5fnc3/l/r3ip8vL8H5Z/DCwELEy/Yr/ivC54I/qm9q3+295Fj8Un7+LfLS/lvRd9X/eB/qH/o//HmeW0FdxK6SfVT12fXT4/4sRzOCwGm7FqBVBIwhERALyuBYASCAB1CPEPG9f8119+BvrK2fyNwVndL5jhvubRVsMQgCakeCFp04OsQ1LJEgAe5NodqT6WANbT+yf/iqQIPd21PXgaAcDJcjivtwJAQHLFgcNZ9uBwPlUgYhHf1z37f7V9g9e8ITewiP88wfWIYET6HPg21nzjV2fybQVcxfrg2/onng/F50lD/ccAAAA4ZVhJZk1NACoAAAAIAAGHaQAEAAAAAQAAABoAAAAAAAKgAgAEAAAAAQAAABigAwAEAAAAAQAAABgAAAAAwf1XlwAAAaNJREFUSA3FlT1LA0EQQBN/gYUYRTksJZVgEbCR/D+7QMr8ABtttBBCsLGzsLG2sxaxED/ie4d77u0dyaE5HHjczn7MzO7M7nU6/yXz+bwLhzCCjTQO+rZhDH3opuNLdRYN4RHe4RIKJ7R34Ro+4AEGSw2mE1iUwT18gpI74WvkGlccu4XNdH0jnYU7cAUacidn37qR23cOxc4aGU0nYUAn7iSWEHkz46w0ocdQu1X6B/AMQZ5o7KfBqNOfwRH8JB7FajGhnmcpKvQe3MEbvILiDm5gPXaCHnZr4vvFGMoEKudKn8YvQIOOe+YzCPop7dwJ3zRfJ7GDuso4YJGRa0yZgg4tUaNXdGrbuZWKKxzYYEJc2xp9AUUjGt8KC2jvgYadF8+10vJyDnNLXwbdiWUZi0fUK01Eoc+AZhCLZVzK4Vq6sDUdz+0dEcbbTTIOJmAyTVhx/WmvrExbv2jtPhWLKodjCtefZiEeZeVZWWSndgwj6fVf3XON8Qwq15++uoqrfYVrow6dGBpCq79ME291jaB0/Q2CPncyht/99MNO/vr9AqW/CGi8sJqbAAAAAElFTkSuQmCC")} bobProfile = Profile {displayName = "bob", fullName = "Bob", image = Just (ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAKHGlDQ1BJQ0MgUHJvZmlsZQAASImFVgdUVNcWve9Nb7QZeu9NehtAem/Sq6gMQ28OQxWxgAQjEFFEREARNFQFg1KjiIhiIQgoYA9IEFBisCAq6OQNJNH4//r/zDpz9ttzz7n73ffWmg0A6QCDxYqD+QCIT0hmezlYywQEBsngngEYCAIy0AC6DGYSy8rDwxUg8Xf9d7wbAxC33tHgzvrP3/9nCISFJzEBgIIRTGey2MkILkawT1oyi4tnEUxjI6IQvMLFkauYqxjQQtewwuoaHy8bBNMBwJMZDHYkAERbhJdJZUYic4hhCNZOCItOQDB3vjkzioFwxLsIXhcRl5IOAImrRzs+fivCk7QRrIL0shAcwNUW+tX8yH/tFfrPXgxG5D84Pi6F+dc9ck+HHJ7g641UMSQlQATQBHEgBaQDGcACbLAVYaIRJhx5Dv+9j77aZ4OsZIFtSEc0iARRIBnpt/9qlvfqpGSQBhjImnCEcUU+NtxnujZy4fbqVEiU/wuXdQyA9S0cDqfzC+e2F4DzyLkSB79wyi0A8KoBcL2GmcJOXePQ3C8MIAJeQAOiQArIAxXuWwMMgSmwBHbAGbgDHxAINgMmojceUZUGMkEWyAX54AA4DMpAJTgJ6sAZ0ALawQVwGVwDt8AQGAUPwQSYBi/AAngHliEIwkEUiAqJQtKQIqQO6UJ0yByyg1whLygQCoEioQQoBcqE9kD5UBFUBlVB9dBPUCd0GboBDUP3oUloDnoNfYRRMBmmwZKwEqwF02Er2AX2gTfBkXAinAHnwPvhUrgaPg23wZfhW/AoPAG/gBdRAEVCCaFkURooOsoG5Y4KQkWg2KidqDxUCaoa1YTqQvWj7qAmUPOoD2gsmoqWQWugTdGOaF80E52I3okuQJeh69Bt6D70HfQkegH9GUPBSGDUMSYYJ0wAJhKThsnFlGBqMK2Yq5hRzDTmHRaLFcIqY42wjthAbAx2O7YAewzbjO3BDmOnsIs4HE4Up44zw7njGLhkXC7uKO407hJuBDeNe48n4aXxunh7fBA+AZ+NL8E34LvxI/gZ/DKBj6BIMCG4E8II2wiFhFOELsJtwjRhmchPVCaaEX2IMcQsYimxiXiV+Ij4hkQiyZGMSZ6kaNJuUinpLOk6aZL0gSxAViPbkIPJKeT95FpyD/k++Q2FQlGiWFKCKMmU/ZR6yhXKE8p7HiqPJo8TTxjPLp5ynjaeEZ6XvAReRV4r3s28GbwlvOd4b/PO8xH4lPhs+Bh8O/nK+Tr5xvkW+an8Ovzu/PH8BfwN/Df4ZwVwAkoCdgJhAjkCJwWuCExRUVR5qg2VSd1DPUW9Sp2mYWnKNCdaDC2fdoY2SFsQFBDUF/QTTBcsF7woOCGEElISchKKEyoUahEaE/ooLClsJRwuvE+4SXhEeElEXMRSJFwkT6RZZFTko6iMqJ1orOhB0XbRx2JoMTUxT7E0seNiV8XmxWnipuJM8TzxFvEHErCEmoSXxHaJkxIDEouSUpIOkizJo5JXJOelhKQspWKkiqW6peakqdLm0tHSxdKXpJ/LCMpYycTJlMr0ySzISsg6yqbIVskOyi7LKcv5ymXLNcs9lifK0+Uj5Ivle+UXFKQV3BQyFRoVHigSFOmKUYpHFPsVl5SUlfyV9iq1K80qiyg7KWcoNyo/UqGoWKgkqlSr3FXFqtJVY1WPqQ6pwWoGalFq5Wq31WF1Q/Vo9WPqw+sw64zXJayrXjeuQdaw0kjVaNSY1BTSdNXM1mzXfKmloBWkdVCrX+uztoF2nPYp7Yc6AjrOOtk6XTqvddV0mbrlunf1KHr2erv0OvRe6avrh+sf179nQDVwM9hr0GvwydDIkG3YZDhnpGAUYlRhNE6n0T3oBfTrxhhja+NdxheMP5gYmiSbtJj8YaphGmvaYDq7Xnl9+PpT66fM5MwYZlVmE+Yy5iHmJ8wnLGQtGBbVFk8t5S3DLGssZ6xUrWKsTlu9tNa2Zlu3Wi/ZmNjssOmxRdk62ObZDtoJ2Pnaldk9sZezj7RvtF9wMHDY7tDjiHF0cTzoOO4k6cR0qndacDZy3uHc50J28XYpc3nqqubKdu1yg92c3Q65PdqguCFhQ7s7cHdyP+T+2EPZI9HjZ0+sp4dnueczLx2vTK9+b6r3Fu8G73c+1j6FPg99VXxTfHv9eP2C/er9lvxt/Yv8JwK0AnYE3AoUC4wO7AjCBfkF1QQtbrTbeHjjdLBBcG7w2CblTembbmwW2xy3+eIW3i2MLedCMCH+IQ0hKwx3RjVjMdQptCJ0gWnDPMJ8EWYZVhw2F24WXhQ+E2EWURQxG2kWeShyLsoiqiRqPtomuiz6VYxjTGXMUqx7bG0sJ84/rjkeHx8S35kgkBCb0LdVamv61mGWOiuXNZFokng4cYHtwq5JgpI2JXUk05A/0oEUlZTvUiZTzVPLU9+n+aWdS+dPT0gf2Ka2bd+2mQz7jB+3o7czt/dmymZmZU7usNpRtRPaGbqzd5f8rpxd07sddtdlEbNis37J1s4uyn67x39PV45kzu6cqe8cvmvM5cll547vNd1b+T36++jvB/fp7Tu673NeWN7NfO38kvyVAmbBzR90fij9gbM/Yv9goWHh8QPYAwkHxg5aHKwr4i/KKJo65HaorVimOK/47eEth2+U6JdUHiEeSTkyUepa2nFU4eiBoytlUWWj5dblzRUSFfsqlo6FHRs5bnm8qVKyMr/y44noE/eqHKraqpWqS05iT6aefHbK71T/j/Qf62vEavJrPtUm1E7UedX11RvV1zdINBQ2wo0pjXOng08PnbE909Gk0VTVLNScfxacTTn7/KeQn8ZaXFp6z9HPNZ1XPF/RSm3Na4PatrUttEe1T3QEdgx3Onf2dpl2tf6s+XPtBdkL5RcFLxZ2E7tzujmXMi4t9rB65i9HXp7q3dL78ErAlbt9nn2DV12uXr9mf+1Kv1X/petm1y/cMLnReZN+s/2W4a22AYOB1l8MfmkdNBxsu210u2PIeKhreP1w94jFyOU7tneu3XW6e2t0w+jwmO/YvfHg8Yl7Yfdm78fdf/Ug9cHyw92PMI/yHvM9Lnki8aT6V9VfmycMJy5O2k4OPPV++nCKOfXit6TfVqZznlGelcxIz9TP6s5emLOfG3q+8fn0C9aL5fnc3/l/r3ip8vL8H5Z/DCwELEy/Yr/ivC54I/qm9q3+295Fj8Un7+LfLS/lvRd9X/eB/qH/o//HmeW0FdxK6SfVT12fXT4/4sRzOCwGm7FqBVBIwhERALyuBYASCAB1CPEPG9f8119+BvrK2fyNwVndL5jhvubRVsMQgCakeCFp04OsQ1LJEgAe5NodqT6WANbT+yf/iqQIPd21PXgaAcDJcjivtwJAQHLFgcNZ9uBwPlUgYhHf1z37f7V9g9e8ITewiP88wfWIYET6HPg21nzjV2fybQVcxfrg2/onng/F50lD/ccAAAA4ZVhJZk1NACoAAAAIAAGHaQAEAAAAAQAAABoAAAAAAAKgAgAEAAAAAQAAABigAwAEAAAAAQAAABgAAAAAwf1XlwAAAaNJREFUSA3FlT1LA0EQQBN/gYUYRTksJZVgEbCR/D+7QMr8ABtttBBCsLGzsLG2sxaxED/ie4d77u0dyaE5HHjczn7MzO7M7nU6/yXz+bwLhzCCjTQO+rZhDH3opuNLdRYN4RHe4RIKJ7R34Ro+4AEGSw2mE1iUwT18gpI74WvkGlccu4XNdH0jnYU7cAUacidn37qR23cOxc4aGU0nYUAn7iSWEHkz46w0ocdQu1X6B/AMQZ5o7KfBqNOfwRH8JB7FajGhnmcpKvQe3MEbvILiDm5gPXaCHnZr4vvFGMoEKudKn8YvQIOOe+YzCPop7dwJ3zRfJ7GDuso4YJGRa0yZgg4tUaNXdGrbuZWKKxzYYEJc2xp9AUUjGt8KC2jvgYadF8+10vJyDnNLXwbdiWUZi0fUK01Eoc+AZhCLZVzK4Vq6sDUdz+0dEcbbTTIOJmAyTVhx/WmvrExbv2jtPhWLKodjCtefZiEeZeVZWWSndgwj6fVf3XON8Qwq15++uoqrfYVrow6dGBpCq79ME291jaB0/Q2CPncyht/99MNO/vr9AqW/CGi8sJqbAAAAAElFTkSuQmCC"), preferences = Just defaultChatPrefs}
cathProfile :: Profile cathProfile :: Profile
cathProfile = Profile {displayName = "cath", fullName = "Catherine", image = Nothing} cathProfile = Profile {displayName = "cath", fullName = "Catherine", image = Nothing, preferences = Just defaultChatPrefs}
danProfile :: Profile danProfile :: Profile
danProfile = Profile {displayName = "dan", fullName = "Daniel", image = Nothing} danProfile = Profile {displayName = "dan", fullName = "Daniel", image = Nothing, preferences = Just defaultChatPrefs}
chatTests :: Spec chatTests :: Spec
chatTests = do chatTests = do
@ -107,9 +108,10 @@ chatTests = do
it "accept contact request incognito" testAcceptContactRequestIncognito it "accept contact request incognito" testAcceptContactRequestIncognito
it "join group incognito" testJoinGroupIncognito it "join group incognito" testJoinGroupIncognito
it "can't invite contact to whom user connected incognito to a group" testCantInviteContactIncognito it "can't invite contact to whom user connected incognito to a group" testCantInviteContactIncognito
describe "contact aliases" $ do describe "contact aliases and prefs" $ do
it "set contact alias" testSetAlias it "set contact alias" testSetAlias
it "set connection alias" testSetConnectionAlias it "set connection alias" testSetConnectionAlias
it "set contact prefs" testSetContactPrefs
describe "SMP servers" $ describe "SMP servers" $
it "get and set SMP servers" testGetSetSMPServers it "get and set SMP servers" testGetSetSMPServers
describe "async connection handshake" $ do describe "async connection handshake" $ do
@ -2408,6 +2410,17 @@ testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfi
bob ?<# (aliceIncognito <> "> do you see that I've changed profile?") bob ?<# (aliceIncognito <> "> do you see that I've changed profile?")
bob ?#> ("@" <> aliceIncognito <> " no") bob ?#> ("@" <> aliceIncognito <> " no")
alice ?<# (bobIncognito <> "> no") alice ?<# (bobIncognito <> "> no")
alice ##> "/_set prefs @2 {}"
alice <## "preferences were updated: contact's voice messages are off, user's voice messages are unset"
alice ##> "/_set prefs @2 {\"voice\": {\"enable\": \"on\"}}"
alice <## "preferences were updated: contact's voice messages are off, user's voice messages are on"
-- with delay it shouldn't fail here (and without it too)
threadDelay 1000000
bob ##> "/_set prefs @2 {}"
bob <## "preferences were updated: contact's voice messages are on, user's voice messages are unset"
threadDelay 1000000
alice ##> "/_set prefs @2 {\"voice\": {\"enable\": \"off\"}}"
alice <## "preferences were updated: contact's voice messages are off, user's voice messages are off"
testConnectIncognitoContactAddress :: IO () testConnectIncognitoContactAddress :: IO ()
testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $ testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $
@ -2708,6 +2721,30 @@ testSetConnectionAlias = testChat2 aliceProfile bobProfile $
alice ##> "/cs" alice ##> "/cs"
alice <## "bob (Bob) (alias: friend)" alice <## "bob (Bob) (alias: friend)"
testSetContactPrefs :: IO ()
testSetContactPrefs = testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice ##> "/_set prefs @2 {}"
alice <## "preferences were updated: contact's voice messages are off, user's voice messages are unset"
alice ##> "/_set prefs @2 {\"voice\": {\"enable\": \"on\"}}"
alice <## "preferences were updated: contact's voice messages are off, user's voice messages are on"
alice ##> "/_profile {\"displayName\": \"alice\", \"fullName\": \"\", \"preferences\": {\"voice\": {\"enable\": \"off\"}}}"
alice <## "user full name removed (your contacts are notified)"
bob <## "contact alice removed full name"
alice ##> "/_set prefs @2 {\"voice\": {\"enable\": \"on\"}}"
alice <## "preferences were updated: contact's voice messages are off, user's voice messages are on"
bob ##> "/_profile {\"displayName\": \"bob\", \"fullName\": \"\", \"preferences\": {\"voice\": {\"enable\": \"on\"}}}"
bob <## "user full name removed (your contacts are notified)"
alice <## "contact bob removed full name"
bob ##> "/_set prefs @2 {}"
bob <## "preferences were updated: contact's voice messages are on, user's voice messages are unset"
alice ##> "/_set prefs @2 {\"voice\": {\"enable\": \"off\"}}"
alice <## "preferences were updated: contact's voice messages are on, user's voice messages are off"
threadDelay 1000000
bob ##> "/_set prefs @2 {}"
bob <## "preferences were updated: contact's voice messages are off, user's voice messages are unset"
testGetSetSMPServers :: IO () testGetSetSMPServers :: IO ()
testGetSetSMPServers = testGetSetSMPServers =
testChat2 aliceProfile bobProfile $ testChat2 aliceProfile bobProfile $

3
tests/MobileTests.hs
View File

@ -7,6 +7,7 @@ import ChatTests
import Control.Monad.Except import Control.Monad.Except
import Simplex.Chat.Mobile import Simplex.Chat.Mobile
import Simplex.Chat.Store import Simplex.Chat.Store
import Simplex.Chat.Types (Profile (..))
import Test.Hspec import Test.Hspec
mobileTests :: Spec mobileTests :: Spec
@ -92,7 +93,7 @@ testChatApi = withTmpFiles $ do
let dbPrefix = testDBPrefix <> "1" let dbPrefix = testDBPrefix <> "1"
f = chatStoreFile dbPrefix f = chatStoreFile dbPrefix
st <- createChatStore f "myKey" True st <- createChatStore f "myKey" True
Right _ <- withTransaction st $ \db -> runExceptT $ createUser db aliceProfile True Right _ <- withTransaction st $ \db -> runExceptT $ createUser db aliceProfile {preferences = Nothing} True
Right cc <- chatMigrateInit dbPrefix "myKey" Right cc <- chatMigrateInit dbPrefix "myKey"
Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "" Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix ""
Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "anotherKey" Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "anotherKey"

31
tests/ProtocolTests.hs
View File

@ -79,11 +79,14 @@ s #==# msg = do
s #== msg s #== msg
s ==# msg s ==# msg
testChatPreferences :: Maybe ChatPreferences
testChatPreferences = Just ChatPreferences {voice = Just Preference {enable = PSOn}}
testProfile :: Profile testProfile :: Profile
testProfile = Profile {displayName = "alice", fullName = "Alice", image = Just (ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=")} testProfile = Profile {displayName = "alice", fullName = "Alice", image = Just (ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII="), preferences = testChatPreferences}
testGroupProfile :: GroupProfile testGroupProfile :: GroupProfile
testGroupProfile = GroupProfile {displayName = "team", fullName = "Team", image = Nothing} testGroupProfile = GroupProfile {displayName = "team", fullName = "Team", image = Nothing, preferences = testChatPreferences}
decodeChatMessageTest :: Spec decodeChatMessageTest :: Spec
decodeChatMessageTest = describe "Chat message encoding/decoding" $ do decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
@ -174,43 +177,43 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
"{\"event\":\"x.file.cancel\",\"params\":{\"msgId\":\"AQIDBA==\"}}" "{\"event\":\"x.file.cancel\",\"params\":{\"msgId\":\"AQIDBA==\"}}"
#==# XFileCancel (SharedMsgId "\1\2\3\4") #==# XFileCancel (SharedMsgId "\1\2\3\4")
it "x.info" $ it "x.info" $
"{\"event\":\"x.info\",\"params\":{\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}" "{\"event\":\"x.info\",\"params\":{\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"enable\":\"on\"}}}}}"
#==# XInfo testProfile #==# XInfo testProfile
it "x.info with empty full name" $ it "x.info with empty full name" $
"{\"event\":\"x.info\",\"params\":{\"profile\":{\"fullName\":\"\",\"displayName\":\"alice\"}}}" "{\"event\":\"x.info\",\"params\":{\"profile\":{\"fullName\":\"\",\"displayName\":\"alice\",\"preferences\":{\"voice\":{\"enable\":\"on\"}}}}}"
#==# XInfo Profile {displayName = "alice", fullName = "", image = Nothing} #==# XInfo Profile {displayName = "alice", fullName = "", image = Nothing, preferences = testChatPreferences}
it "x.contact with xContactId" $ it "x.contact with xContactId" $
"{\"event\":\"x.contact\",\"params\":{\"contactReqId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}" "{\"event\":\"x.contact\",\"params\":{\"contactReqId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"enable\":\"on\"}}}}}"
#==# XContact testProfile (Just $ XContactId "\1\2\3\4") #==# XContact testProfile (Just $ XContactId "\1\2\3\4")
it "x.contact without XContactId" $ it "x.contact without XContactId" $
"{\"event\":\"x.contact\",\"params\":{\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}" "{\"event\":\"x.contact\",\"params\":{\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"enable\":\"on\"}}}}}"
#==# XContact testProfile Nothing #==# XContact testProfile Nothing
it "x.contact with content null" $ it "x.contact with content null" $
"{\"event\":\"x.contact\",\"params\":{\"content\":null,\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}" "{\"event\":\"x.contact\",\"params\":{\"content\":null,\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"enable\":\"on\"}}}}}"
==# XContact testProfile Nothing ==# XContact testProfile Nothing
it "x.contact with content (ignored)" $ it "x.contact with content (ignored)" $
"{\"event\":\"x.contact\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}" "{\"event\":\"x.contact\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"enable\":\"on\"}}}}}"
==# XContact testProfile Nothing ==# XContact testProfile Nothing
it "x.grp.inv" $ it "x.grp.inv" $
"{\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\"},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}}}}" "{\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\",\"preferences\":{\"voice\":{\"enable\":\"on\"}}},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}}}}"
#==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile} #==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile}
it "x.grp.acpt without incognito profile" $ it "x.grp.acpt without incognito profile" $
"{\"event\":\"x.grp.acpt\",\"params\":{\"memberId\":\"AQIDBA==\"}}" "{\"event\":\"x.grp.acpt\",\"params\":{\"memberId\":\"AQIDBA==\"}}"
#==# XGrpAcpt (MemberId "\1\2\3\4") #==# XGrpAcpt (MemberId "\1\2\3\4")
it "x.grp.mem.new" $ it "x.grp.mem.new" $
"{\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}}" "{\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"enable\":\"on\"}}}}}}"
#==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, profile = testProfile} #==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, profile = testProfile}
it "x.grp.mem.intro" $ it "x.grp.mem.intro" $
"{\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}}" "{\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"enable\":\"on\"}}}}}}"
#==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, profile = testProfile} #==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, profile = testProfile}
it "x.grp.mem.inv" $ it "x.grp.mem.inv" $
"{\"event\":\"x.grp.mem.inv\",\"params\":{\"memberId\":\"AQIDBA==\",\"memberIntro\":{\"directConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}}" "{\"event\":\"x.grp.mem.inv\",\"params\":{\"memberId\":\"AQIDBA==\",\"memberIntro\":{\"directConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}}"
#==# XGrpMemInv (MemberId "\1\2\3\4") IntroInvitation {groupConnReq = testConnReq, directConnReq = testConnReq} #==# XGrpMemInv (MemberId "\1\2\3\4") IntroInvitation {groupConnReq = testConnReq, directConnReq = testConnReq}
it "x.grp.mem.fwd" $ it "x.grp.mem.fwd" $
"{\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"directConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}}" "{\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"directConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"groupConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"enable\":\"on\"}}}}}}"
#==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = testConnReq} #==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = testConnReq}
it "x.grp.mem.info" $ it "x.grp.mem.info" $
"{\"event\":\"x.grp.mem.info\",\"params\":{\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}" "{\"event\":\"x.grp.mem.info\",\"params\":{\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"enable\":\"on\"}}}}}"
#==# XGrpMemInfo (MemberId "\1\2\3\4") testProfile #==# XGrpMemInfo (MemberId "\1\2\3\4") testProfile
it "x.grp.mem.con" $ it "x.grp.mem.con" $
"{\"event\":\"x.grp.mem.con\",\"params\":{\"memberId\":\"AQIDBA==\"}}" "{\"event\":\"x.grp.mem.con\",\"params\":{\"memberId\":\"AQIDBA==\"}}"