mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-10-15 13:20:36 +00:00
core, ui: fix profiles, add error alerts (#7663)
* core, ui: fix profiles, add error alerts * simplify * query plans --------- Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
This commit is contained in:
Evgeny
co-authored by
Evgeny @ SimpleX Chat
Evgeny @ SimpleX Chat
parent
a24a3b1911
commit
9c9c86f9c0
@@ -75,10 +75,10 @@ simplexChatCore cfg@ChatConfig {confirmMigrations, testView, chatHooks} opts@Cha
|
||||
noMaintenance
|
||||
img_ <- mapM loadImageFile userImageFile
|
||||
createActiveUser cc coreOptions createBot userDisplayName img_
|
||||
Just u@User {localDisplayName} -> do
|
||||
Just u@User {profile = LocalProfile {displayName}} -> do
|
||||
forM_ userDisplayName $ \name ->
|
||||
when (localDisplayName /= name) $ do
|
||||
putStrLn $ "Active user display name " <> show localDisplayName <> " does not match --user-display-name " <> show name
|
||||
when (displayName /= name) $ do
|
||||
putStrLn $ "Active user display name " <> show displayName <> " does not match --user-display-name " <> show name
|
||||
exitFailure
|
||||
-- --user-image-file only applies when the profile is created; ignore it for an existing user
|
||||
forM_ userImageFile $ \_ ->
|
||||
|
||||
@@ -174,7 +174,9 @@ checkProfileImageSize = mapM_ $ \(ImageData t) ->
|
||||
in when (size > maxProfileImageSize) $ throwCmdError $ "Profile image is too large " <> show size
|
||||
|
||||
checkProfileSize :: Profile -> CM ()
|
||||
checkProfileSize p = checkInfoSize "Profile" (XInfo p Nothing)
|
||||
checkProfileSize p@Profile {contactDomain} = checkInfoSize "Profile" (XInfo p' Nothing)
|
||||
where
|
||||
p' = (p :: Profile) {badge = Nothing, contactDomain = (\d -> d {proof = Nothing} :: SimplexDomainClaim) <$> contactDomain}
|
||||
|
||||
checkGroupProfileSize :: GroupProfile -> CM ()
|
||||
checkGroupProfileSize p = checkInfoSize "Group profile" (XGrpInfo p)
|
||||
@@ -454,7 +456,7 @@ processChatCommand cxt nm = \case
|
||||
p@Profile {displayName} <- liftIO $ maybe generateRandomProfile pure profile
|
||||
u <- asks currentUser
|
||||
users <- withFastStore' getUsers
|
||||
forM_ users $ \User {localDisplayName = n, activeUser, viewPwdHash, userChatRelay = userChatRelay'} -> do
|
||||
forM_ users $ \User {profile = LocalProfile {displayName = n}, activeUser, viewPwdHash, userChatRelay = userChatRelay'} -> do
|
||||
when (n == displayName) . throwChatError $
|
||||
if activeUser || isNothing viewPwdHash then CEUserExists displayName else CEInvalidDisplayName {displayName, validName = ""}
|
||||
when (isTrue userChatRelay && isTrue userChatRelay') $ throwChatError CEChatRelayExists
|
||||
@@ -1596,8 +1598,8 @@ processChatCommand cxt nm = \case
|
||||
APICallStatus contactId receivedStatus ->
|
||||
withCurrentCall contactId $ \user ct call ->
|
||||
updateCallItemStatus user ct call receivedStatus Nothing $> Just call
|
||||
APIUpdateProfile userId profile -> withUserId userId (`updateProfile` profile)
|
||||
APISetUserDomain userId strDomain_ -> withUserId userId $ \user@User {profile = p@LocalProfile {contactLink, contactDomain}} -> do
|
||||
APIUpdateProfile userId profile -> withUserProfileLock "updateProfile" $ withUserId userId (`updateProfile` profile)
|
||||
APISetUserDomain userId strDomain_ -> withUserProfileLock "setUserDomain" $ withUserId userId $ \user@User {profile = p@LocalProfile {contactLink, contactDomain}} -> do
|
||||
let domain_ = unStrJSON <$> strDomain_
|
||||
if (claimDomain <$> contactDomain) == domain_
|
||||
then pure $ CRUserProfileNoChange user
|
||||
@@ -1637,7 +1639,7 @@ processChatCommand cxt nm = \case
|
||||
APISetUserUIThemes uId uiThemes -> withUser $ \user@User {userId} -> do
|
||||
user'@User {userId = uId'} <- withFastStore $ \db -> do
|
||||
user' <- getUser db uId
|
||||
liftIO $ setUserUIThemes db user uiThemes
|
||||
liftIO $ setUserUIThemes db user' uiThemes
|
||||
pure user'
|
||||
when (userId == uId') $ chatWriteVar currentUser $ Just (user :: User) {uiThemes}
|
||||
ok user'
|
||||
@@ -2480,12 +2482,12 @@ processChatCommand cxt nm = \case
|
||||
pure $ CRUserContactLinkCreated user ccLink''
|
||||
CreateMyAddress ratchetKeys_ -> withUser $ \User {userId} ->
|
||||
processChatCommand cxt nm $ APICreateMyAddress userId Nothing ratchetKeys_
|
||||
APIDeleteMyAddress userId -> withUserId userId $ \user@User {profile = p} -> do
|
||||
APIDeleteMyAddress userId -> withUserProfileLock "deleteMyAddress" $ withUserId userId $ \user@User {profile = p} -> do
|
||||
conn <- withFastStore $ \db -> getUserAddressConnection db cxt user
|
||||
withChatLock "deleteMyAddress" $ do
|
||||
deleteAgentConnectionAsync $ aConnId conn
|
||||
withFastStore' (`deleteUserAddress` user)
|
||||
let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing}
|
||||
let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing, contactDomain = Nothing}
|
||||
r <- updateProfile_ user p' False $ withFastStore' $ \db -> setUserProfileContactLink db user Nothing
|
||||
let user' = case r of
|
||||
CRUserProfileUpdated u' _ _ _ -> u'
|
||||
@@ -2503,10 +2505,10 @@ processChatCommand cxt nm = \case
|
||||
CRUserContactLink user <$> (withFastStore (`getUserAddress` user) >>= setMyAddressData False pqInitKeys user)
|
||||
APIRotateAddressRatchetKeys userId -> withUserId' userId $ \user ->
|
||||
CRUserContactLink user <$> (withFastStore (`getUserAddress` user) >>= setMyAddressData True (Just IKUsePQ) user)
|
||||
APISetProfileAddress userId False -> withUserId userId $ \user@User {profile = p} -> do
|
||||
let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing}
|
||||
APISetProfileAddress userId False -> withUserProfileLock "setProfileAddress" $ withUserId userId $ \user@User {profile = p} -> do
|
||||
let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing, contactDomain = Nothing}
|
||||
updateProfile_ user p' True $ withFastStore' $ \db -> setUserProfileContactLink db user Nothing
|
||||
APISetProfileAddress userId True -> withUserId userId $ \user@User {profile = p} -> do
|
||||
APISetProfileAddress userId True -> withUserProfileLock "setProfileAddress" $ withUserId userId $ \user@User {profile = p} -> do
|
||||
ucl <- withFastStore (`getUserAddress` user)
|
||||
-- TODO [short links] replace with short links
|
||||
let p' = (fromLocalProfile p :: Profile) {contactLink = Just $ profileContactLink ucl}
|
||||
@@ -3582,23 +3584,23 @@ processChatCommand cxt nm = \case
|
||||
-- after the write, so the pass it signals arms a wake for the snooze rather than raising again
|
||||
lift $ startBadgeWork user
|
||||
CRBadgeState user <$> getUserBadgeState user
|
||||
SetBotCommands commands -> withUser $ \user@User {profile} -> do
|
||||
SetBotCommands commands -> withUserProfileLock "updateProfile" $ withUser $ \user@User {profile} -> do
|
||||
let LocalProfile {preferences} = profile
|
||||
prefs = Just (fromMaybe emptyChatPrefs preferences :: Preferences) {commands = Just commands}
|
||||
p = (fromLocalProfile profile :: Profile) {preferences = prefs, peerType = Just CPTBot}
|
||||
updateProfile user p
|
||||
UpdateProfile displayName shortDescr -> withUser $ \user@User {profile} -> do
|
||||
UpdateProfile displayName shortDescr -> withUserProfileLock "updateProfile" $ withUser $ \user@User {profile} -> do
|
||||
let p = (fromLocalProfile profile :: Profile) {displayName, shortDescr, fullName = ""}
|
||||
updateProfile user p
|
||||
UpdateProfileImage image -> withUser $ \user@User {profile} -> do
|
||||
UpdateProfileImage image -> withUserProfileLock "updateProfile" $ withUser $ \user@User {profile} -> do
|
||||
let p = (fromLocalProfile profile :: Profile) {image}
|
||||
updateProfile user p
|
||||
UpdateProfileImageFromFile path -> withUser $ \user@User {profile} -> do
|
||||
UpdateProfileImageFromFile path -> withUserProfileLock "updateProfile" $ withUser $ \user@User {profile} -> do
|
||||
img <- readProfileImageFile path
|
||||
let p = (fromLocalProfile profile :: Profile) {image = Just img}
|
||||
updateProfile user p
|
||||
ShowProfileImage -> withUser $ \user@User {profile} -> pure $ CRUserProfileImage user $ fromLocalProfile profile
|
||||
SetUserFeature (ACF f) allowed -> withUser $ \user@User {profile} -> do
|
||||
SetUserFeature (ACF f) allowed -> withUserProfileLock "updateProfile" $ withUser $ \user@User {profile} -> do
|
||||
let p = (fromLocalProfile profile :: Profile) {preferences = Just . setPreference f (Just allowed) $ preferences' user}
|
||||
updateProfile user p
|
||||
SetContactFeature (ACF f) cName allowed_ -> withUser $ \user -> do
|
||||
@@ -3616,7 +3618,7 @@ processChatCommand cxt nm = \case
|
||||
case memberAdmission of
|
||||
Nothing -> p {memberAdmission = Just (emptyGroupMemberAdmission :: GroupMemberAdmission) {review = reviewAdmissionApplication}}
|
||||
Just ma -> p {memberAdmission = Just (ma :: GroupMemberAdmission) {review = reviewAdmissionApplication}}
|
||||
SetUserTimedMessages onOff -> withUser $ \user@User {profile} -> do
|
||||
SetUserTimedMessages onOff -> withUserProfileLock "updateProfile" $ withUser $ \user@User {profile} -> do
|
||||
let allowed = if onOff then FAYes else FANo
|
||||
pref = TimedMessagesPreference allowed Nothing
|
||||
p = (fromLocalProfile profile :: Profile) {preferences = Just . setPreference' SCFTimedMessages (Just pref) $ preferences' user}
|
||||
@@ -3685,6 +3687,7 @@ processChatCommand cxt nm = \case
|
||||
CLContactRequest crId -> "ContactRequest " <> tshow crId
|
||||
CLFile fId -> "File " <> tshow fId
|
||||
CLBadgeUser uId -> "BadgeUser " <> tshow uId
|
||||
CLUserProfile -> "UserProfile"
|
||||
DebugEvent event -> toView event >> ok_
|
||||
GetAgentSubsTotal userId -> withUserId userId $ \user -> do
|
||||
users <- withStore' $ \db -> getUsers db
|
||||
@@ -4009,20 +4012,29 @@ processChatCommand cxt nm = \case
|
||||
when (fileSize > maxSndXFTPFileSize lims now sndBadge) $ throwChatError $ CEFileSize f
|
||||
pure fileSize
|
||||
updateProfile :: User -> Profile -> CM ChatResponse
|
||||
updateProfile user p' = updateProfile_ user p' True $ withFastStore $ \db -> updateUserProfile db user p'
|
||||
updateProfile user@User {profile = LocalProfile {contactDomain}} p = updateProfile_ user p' True $ withFastStore $ \db -> updateUserProfile db user p'
|
||||
where
|
||||
p' = (p :: Profile) {contactDomain}
|
||||
updateProfile_ :: User -> Profile -> Bool -> CM User -> CM ChatResponse
|
||||
updateProfile_ user@User {profile = p@LocalProfile {displayName = n}} p'@Profile {displayName = n', image = img'} shouldUpdateAddressData updateUser
|
||||
| p' == fromLocalProfile p = pure $ CRUserProfileNoChange user
|
||||
| otherwise = do
|
||||
when (n /= n') $ checkValidName n'
|
||||
when (n /= n') $ do
|
||||
checkValidName n'
|
||||
users <- withFastStore' getUsers
|
||||
forM_ users $ \User {profile = LocalProfile {displayName}, activeUser, viewPwdHash} ->
|
||||
when (displayName == n') . throwChatError $
|
||||
if activeUser || isNothing viewPwdHash then CEUserExists n' else CEInvalidDisplayName {displayName = n', validName = ""}
|
||||
checkProfileImageSize img'
|
||||
checkProfileSize p'
|
||||
when shouldUpdateAddressData $ do
|
||||
ts <- liftIO getCurrentTime
|
||||
setMyAddressData' (user :: User) {profile = updatedUserProfile user p' ts}
|
||||
-- read contacts before user update to correctly merge preferences
|
||||
contacts <- withFastStore' $ \db -> getUserContacts db cxt user
|
||||
user' <- updateUser
|
||||
asks currentUser >>= atomically . (`writeTVar` Just user')
|
||||
withChatLock "updateProfile" $ do
|
||||
when shouldUpdateAddressData $ setMyAddressData' user'
|
||||
summary <- sendUpdateToContacts user' contacts
|
||||
pure $ CRUserProfileUpdated user' (fromLocalProfile p) p' summary
|
||||
where
|
||||
@@ -5630,7 +5642,7 @@ presentIssuedBadge user p@UserBadgePurchase {badgePurchaseId, shown} now
|
||||
| otherwise = do
|
||||
cred_ <- withStore' (`getLatestIssuedCredential` badgePurchaseId)
|
||||
forM_ cred_ $ \cred@(BadgeCredential _ _ _ info) ->
|
||||
when (presentDue cred) $ do
|
||||
when (presentDue cred) $ withUserProfileLock "presentIssuedBadge" $ do
|
||||
user' <- withStore $ \db -> setUserBadge db user (Just $ OwnBadge cred (mkBadgeStatus now (Just True) info))
|
||||
presentUserBadgeToContacts user'
|
||||
where
|
||||
@@ -5643,7 +5655,7 @@ presentIssuedBadge user p@UserBadgePurchase {badgePurchaseId, shown} now
|
||||
retireExpiredBadge :: User -> UserBadgePurchase -> UTCTime -> StatementEntry -> CM Bool
|
||||
retireExpiredBadge user UserBadgePurchase {badgePurchaseId, shown} now balance
|
||||
| not (shown && L.paidThrough balance <= now) = pure False
|
||||
| otherwise = do
|
||||
| otherwise = withUserProfileLock "retireExpiredBadge" $ do
|
||||
user' <- withStore $ \db -> do
|
||||
liftIO $ clearShownBadge db user badgePurchaseId
|
||||
setUserBadge db user Nothing
|
||||
@@ -6678,8 +6690,11 @@ displayNameP_ = quoted '\'' <|> takeNameTill (\c -> isSpace c || c == ',')
|
||||
refChar c = c > ' ' && c /= '#' && c /= '@' && c /= '\''
|
||||
|
||||
mkValidName :: String -> String
|
||||
mkValidName = dropWhileEnd isSpace . take 50 . reverse . fst3 . foldl' addChar ("", '\NUL', 0 :: Int)
|
||||
mkValidName = noLdnSuffix . dropWhileEnd isSpace . take 50 . reverse . fst3 . foldl' addChar ("", '\NUL', 0 :: Int)
|
||||
where
|
||||
noLdnSuffix s = case break (== '_') (reverse s) of
|
||||
(ds@(_ : _), '_' : rest@(_ : _)) | all isDigit ds -> reverse rest <> ('-' : reverse ds)
|
||||
_ -> s
|
||||
fst3 (x, _, _) = x
|
||||
addChar (r, prev, punct) c' = if validChar then (c : r, c, punct') else (r, prev, punct)
|
||||
where
|
||||
|
||||
@@ -160,6 +160,10 @@ withFileLock :: Text -> Int64 -> CM a -> CM a
|
||||
withFileLock name = withEntityLock name . CLFile
|
||||
{-# INLINE withFileLock #-}
|
||||
|
||||
withUserProfileLock :: Text -> CM a -> CM a
|
||||
withUserProfileLock name = withEntityLock name CLUserProfile
|
||||
{-# INLINE withUserProfileLock #-}
|
||||
|
||||
useServerCfgs :: forall p. UserProtocol p => SProtocolType p -> RandomAgentServers -> [(Text, ServerOperator)] -> [UserServer p] -> NonEmpty (ServerCfg p)
|
||||
useServerCfgs p RandomAgentServers {smpServers, xftpServers} opDomains =
|
||||
fromMaybe (rndAgentServers p) . L.nonEmpty . agentServerCfgs p opDomains
|
||||
|
||||
@@ -44,6 +44,7 @@ module Simplex.Chat.Store.Profiles
|
||||
updateUserAutoAcceptMemberContacts,
|
||||
updateUserAutoAcceptGroupInvitations,
|
||||
updateUserProfile,
|
||||
updatedUserProfile,
|
||||
setUserBadge,
|
||||
setUserProfileContactLink,
|
||||
getUserContactProfiles,
|
||||
@@ -169,7 +170,7 @@ createUserRecordAt db (AgentUserId auId) userChatRelay clientService Profile {di
|
||||
(profileId, displayName, userId, BI True, currentTs, currentTs, currentTs)
|
||||
contactId <- insertedRowId db
|
||||
DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId)
|
||||
pure $ toUser currentTs $ (userId, auId, contactId, profileId, BI activeUser, order) :. (displayName, fullName, shortDescr, description, image, Nothing, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, BI autoAcceptGroupInvitations, Nothing, Nothing, Nothing, BI userChatRelay, BI clientService, Nothing) :. localBadgeToRow Nothing :. (Nothing, Nothing, Nothing)
|
||||
pure $ toUser currentTs $ (userId, auId, contactId, profileId, BI activeUser, order, displayName) :. (displayName, fullName, shortDescr, description, image, Nothing, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, BI autoAcceptGroupInvitations, Nothing, Nothing, Nothing, BI userChatRelay, BI clientService, Nothing) :. localBadgeToRow Nothing :. (Nothing, Nothing, Nothing)
|
||||
|
||||
-- TODO [mentions]
|
||||
getUsersInfo :: DB.Connection -> IO [UserInfo]
|
||||
@@ -344,21 +345,15 @@ updateUserProfile db user p'
|
||||
currentTs <- getCurrentTime
|
||||
updateUserProfileFields_' db userId profileId p' currentTs
|
||||
userMemberProfileUpdatedAt' <- updateUserMemberProfileUpdatedAt_ currentTs
|
||||
pure user {profile = (toLocalProfile profileId p' localAlias currentTs (Just False) Nothing) {localBadge}, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
|
||||
pure user {profile = updatedUserProfile user p' currentTs, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
|
||||
| otherwise =
|
||||
checkConstraint SEDuplicateName . liftIO $ do
|
||||
checkConstraint SEDuplicateName . ExceptT . withLocalDisplayName db userId newName $ \newLDN -> do
|
||||
currentTs <- getCurrentTime
|
||||
-- Insert first: checkConstraint returns the violation as a value, so the
|
||||
-- transaction commits, keeping whatever ran before the failing insert.
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO display_names (local_display_name, ldn_base, user_id, created_at, updated_at) VALUES (?,?,?,?,?)"
|
||||
(newName, newName, userId, currentTs, currentTs)
|
||||
DB.execute db "UPDATE users SET local_display_name = ?, updated_at = ? WHERE user_id = ?" (newName, currentTs, userId)
|
||||
DB.execute db "UPDATE users SET local_display_name = ?, updated_at = ? WHERE user_id = ?" (newLDN, currentTs, userId)
|
||||
userMemberProfileUpdatedAt' <- updateUserMemberProfileUpdatedAt_ currentTs
|
||||
updateUserProfileFields_' db userId profileId p' currentTs
|
||||
updateContactLDN_ db user userContactId localDisplayName newName currentTs
|
||||
pure user {localDisplayName = newName, profile = (toLocalProfile profileId p' localAlias currentTs (Just False) Nothing) {localBadge}, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
|
||||
updateContactLDN_ db user userContactId localDisplayName newLDN currentTs
|
||||
pure $ Right user {localDisplayName = newLDN, profile = updatedUserProfile user p' currentTs, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
|
||||
where
|
||||
updateUserMemberProfileUpdatedAt_ currentTs
|
||||
| userMemberProfileChanged = do
|
||||
@@ -366,10 +361,14 @@ updateUserProfile db user p'
|
||||
pure $ Just currentTs
|
||||
| otherwise = pure userMemberProfileUpdatedAt
|
||||
userMemberProfileChanged = newName /= displayName || fn' /= fullName || d' /= shortDescr || desc' /= description || img' /= image
|
||||
User {userId, userContactId, localDisplayName, profile = LocalProfile {profileId, displayName, fullName, shortDescr, description, image, localBadge, localAlias}, userMemberProfileUpdatedAt} = user
|
||||
User {userId, userContactId, localDisplayName, profile = LocalProfile {profileId, displayName, fullName, shortDescr, description, image}, userMemberProfileUpdatedAt} = user
|
||||
Profile {displayName = newName, fullName = fn', shortDescr = d', description = desc', image = img', preferences} = p'
|
||||
fullPreferences = fullPreferences' preferences
|
||||
|
||||
updatedUserProfile :: User -> Profile -> UTCTime -> LocalProfile
|
||||
updatedUserProfile User {profile = LocalProfile {profileId, localBadge, localAlias}} p' ts =
|
||||
(toLocalProfile profileId p' localAlias ts (Just False) Nothing) {localBadge}
|
||||
|
||||
-- own profile field update; leaves the badge columns alone (the credential is owned by setUserBadge/addUserBadge)
|
||||
updateUserProfileFields_' :: DB.Connection -> UserId -> ProfileId -> Profile -> UTCTime -> IO ()
|
||||
updateUserProfileFields_' db userId profileId Profile {displayName, fullName, shortDescr, description, image, contactLink, preferences, peerType} updatedAt =
|
||||
@@ -411,19 +410,20 @@ setUserSimplexDomain db user@User {userId, profile = p@LocalProfile {profileId}}
|
||||
pure (user :: User) {profile = p {contactDomain = mkDomainClaim <$> domain_}}
|
||||
|
||||
setUserProfileContactLink :: DB.Connection -> User -> Maybe UserContactLink -> IO User
|
||||
setUserProfileContactLink db user@User {userId, profile = p@LocalProfile {profileId}} ucl_ = do
|
||||
setUserProfileContactLink db user@User {userId, profile = p@LocalProfile {profileId, contactDomain}} ucl_ = do
|
||||
ts <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE contact_profiles
|
||||
SET contact_link = ?, updated_at = ?
|
||||
SET contact_link = ?, contact_domain = ?, updated_at = ?
|
||||
WHERE user_id = ? AND contact_profile_id = ?
|
||||
|]
|
||||
(contactLink, ts, userId, profileId)
|
||||
pure (user :: User) {profile = p {contactLink}}
|
||||
(contactLink, claimDomain <$> contactDomain', ts, userId, profileId)
|
||||
pure (user :: User) {profile = p {contactLink, contactDomain = contactDomain'}}
|
||||
where
|
||||
contactLink = profileContactLink <$> ucl_
|
||||
contactDomain' = if isJust contactLink then contactDomain else Nothing
|
||||
|
||||
-- only used in tests
|
||||
getUserContactProfiles :: DB.Connection -> User -> IO [Profile]
|
||||
|
||||
@@ -1391,6 +1391,10 @@ Query: SELECT conn_id FROM connections WHERE user_id = ?
|
||||
Plan:
|
||||
SEARCH connections USING COVERING INDEX idx_connections_user (user_id=?)
|
||||
|
||||
Query: SELECT conn_id FROM rcv_queues WHERE switch_status = ? AND deleted = 0
|
||||
Plan:
|
||||
SCAN rcv_queues
|
||||
|
||||
Query: SELECT conn_id, rc_verify_code_ad, rc_verify_code_pq, CASE WHEN rc_verify_code_ad IS NULL THEN ratchet_state END FROM ratchets WHERE conn_id = ?
|
||||
Plan:
|
||||
SEARCH ratchets USING PRIMARY KEY (conn_id=?)
|
||||
|
||||
@@ -5344,7 +5344,7 @@ SEARCH connections_sync USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
UPDATE contact_profiles
|
||||
SET contact_link = ?, updated_at = ?
|
||||
SET contact_link = ?, contact_domain = ?, updated_at = ?
|
||||
WHERE user_id = ? AND contact_profile_id = ?
|
||||
|
||||
Plan:
|
||||
@@ -6365,7 +6365,7 @@ Plan:
|
||||
SEARCH server_operators USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
|
||||
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
|
||||
FROM users u
|
||||
@@ -6378,7 +6378,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
|
||||
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
|
||||
FROM users u
|
||||
@@ -6392,7 +6392,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
|
||||
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
|
||||
FROM users u
|
||||
@@ -6406,7 +6406,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
|
||||
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
|
||||
FROM users u
|
||||
@@ -6421,7 +6421,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
|
||||
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
|
||||
FROM users u
|
||||
@@ -6435,7 +6435,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
|
||||
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
|
||||
FROM users u
|
||||
@@ -6449,7 +6449,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
|
||||
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
|
||||
FROM users u
|
||||
@@ -6463,7 +6463,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
|
||||
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
|
||||
FROM users u
|
||||
@@ -6477,7 +6477,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
|
||||
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
|
||||
FROM users u
|
||||
@@ -6490,7 +6490,7 @@ SEARCH uct USING INTEGER PRIMARY KEY (rowid=?)
|
||||
SEARCH ucp USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query:
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
|
||||
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
|
||||
FROM users u
|
||||
@@ -7632,6 +7632,10 @@ Query: SELECT member_id FROM group_members WHERE local_display_name = ?
|
||||
Plan:
|
||||
SCAN group_members
|
||||
|
||||
Query: SELECT member_id FROM group_members WHERE member_category = ?
|
||||
Plan:
|
||||
SCAN group_members
|
||||
|
||||
Query: SELECT member_id FROM group_members WHERE member_role = ? LIMIT 1
|
||||
Plan:
|
||||
SCAN group_members
|
||||
@@ -7908,6 +7912,10 @@ Query: UPDATE contact_profiles SET contact_domain = ?, updated_at = ? WHERE user
|
||||
Plan:
|
||||
SEARCH contact_profiles USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query: UPDATE contact_profiles SET contact_domain_verified = NULL WHERE user_id = ? AND contact_profile_id = ?
|
||||
Plan:
|
||||
SEARCH contact_profiles USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query: UPDATE contact_profiles SET image = ? WHERE display_name = ?
|
||||
Plan:
|
||||
SEARCH contact_profiles USING INDEX contact_profiles_index (display_name=?)
|
||||
@@ -8100,6 +8108,10 @@ Query: UPDATE group_members SET xgrplinkmem_received = ?, updated_at = ? WHERE g
|
||||
Plan:
|
||||
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
Query: UPDATE group_profiles SET description = ? WHERE display_name = ?
|
||||
Plan:
|
||||
SCAN group_profiles
|
||||
|
||||
Query: UPDATE group_relays SET relay_status = ?, updated_at = ? WHERE group_relay_id = ?
|
||||
Plan:
|
||||
SEARCH group_relays USING INTEGER PRIMARY KEY (rowid=?)
|
||||
|
||||
@@ -74,6 +74,7 @@ data ChatLockEntity
|
||||
| CLContactRequest Int64
|
||||
| CLFile Int64
|
||||
| CLBadgeUser Int64 -- one signed badge request per profile in flight
|
||||
| CLUserProfile
|
||||
deriving (Eq, Ord)
|
||||
|
||||
-- These error type constructors must be added to mobile apps
|
||||
@@ -558,7 +559,7 @@ toContactRequest now ((contactRequestId, localDisplayName, agentInvitationId, co
|
||||
userQuery :: Query
|
||||
userQuery =
|
||||
[sql|
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
SELECT u.user_id, u.agent_user_id, u.contact_id, ucp.contact_profile_id, u.active_user, u.active_order, u.local_display_name, ucp.display_name, ucp.full_name, ucp.short_descr, ucp.description, ucp.image, ucp.contact_link, ucp.chat_peer_type, ucp.preferences,
|
||||
u.show_ntfs, u.send_rcpts_contacts, u.send_rcpts_small_groups, u.auto_accept_member_contacts, u.auto_accept_group_invitations, u.view_pwd_hash, u.view_pwd_salt, u.user_member_profile_updated_at, u.is_user_chat_relay, u.client_service, u.ui_themes,
|
||||
ucp.badge_proof, ucp.badge_pres_header, ucp.badge_expiry, ucp.badge_type, ucp.badge_verified, ucp.badge_extra, ucp.badge_master_key, ucp.badge_signature, ucp.badge_key_idx, ucp.contact_domain, ucp.contact_domain_proof, ucp.contact_domain_verified
|
||||
FROM users u
|
||||
@@ -566,9 +567,9 @@ userQuery =
|
||||
JOIN contact_profiles ucp ON ucp.contact_profile_id = uct.contact_profile_id
|
||||
|]
|
||||
|
||||
toUser :: UTCTime -> (UserId, UserId, ContactId, ProfileId, BoolInt, Int64) :. (ContactName, Text, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences) :. (BoolInt, BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, BoolInt, BoolInt, Maybe UIThemeEntityOverrides) :. BadgeRow :. ContactDomainRow -> User
|
||||
toUser now ((userId, auId, userContactId, profileId, BI activeUser, activeOrder) :. (displayName, fullName, shortDescr, description, image, contactLink, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, BI autoAcceptGroupInv, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, BI userChatRelay, BI clientService, uiThemes) :. badgeRow :. domainRow) =
|
||||
User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, activeOrder, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, autoAcceptMemberContacts, autoAcceptGroupInvitations, viewPwdHash, userMemberProfileUpdatedAt, userChatRelay = BoolDef userChatRelay, clientService = BoolDef clientService, uiThemes}
|
||||
toUser :: UTCTime -> (UserId, UserId, ContactId, ProfileId, BoolInt, Int64, ContactName) :. (ContactName, Text, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe Preferences) :. (BoolInt, BoolInt, BoolInt, BoolInt, BoolInt, Maybe B64UrlByteString, Maybe B64UrlByteString, Maybe UTCTime, BoolInt, BoolInt, Maybe UIThemeEntityOverrides) :. BadgeRow :. ContactDomainRow -> User
|
||||
toUser now ((userId, auId, userContactId, profileId, BI activeUser, activeOrder, localDisplayName) :. (displayName, fullName, shortDescr, description, image, contactLink, peerType, userPreferences) :. (BI showNtfs, BI sendRcptsContacts, BI sendRcptsSmallGroups, BI autoAcceptMemberContacts, BI autoAcceptGroupInv, viewPwdHash_, viewPwdSalt_, userMemberProfileUpdatedAt, BI userChatRelay, BI clientService, uiThemes) :. badgeRow :. domainRow) =
|
||||
User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName, profile, activeUser, activeOrder, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, autoAcceptMemberContacts, autoAcceptGroupInvitations, viewPwdHash, userMemberProfileUpdatedAt, userChatRelay = BoolDef userChatRelay, clientService = BoolDef clientService, uiThemes}
|
||||
where
|
||||
profile = LocalProfile {profileId, displayName, fullName, shortDescr, description, image, contactLink, contactDomain = rowToContactDomain domainRow, contactDomainVerified = rowToDomainVerified domainRow, peerType, localBadge = rowToBadge now badgeRow, preferences = userPreferences, localAlias = ""}
|
||||
fullPreferences = fullPreferences' userPreferences
|
||||
|
||||
Reference in New Issue
Block a user