dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-06-04 06:01:50 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: support postgres backend (#5403)

Browse Source 
* postgres: modules structure (#5401)

* postgres: schema, field conversions (#5430)

* postgres: rework chat list pagination query (#5441)

* prepare cabal for merge

* restore cabal changes

* simplexmq

* postgres: implementation wip (tests don't pass) (#5481)

* restore ios file

* postgres: implementation - tests pass (#5487)

* refactor DB options

* refactor

* line

* style

* style

* refactor

* $

* update simplexmq

* constraintError

* handleDBErrors

* fix

* remove param

* Ok

* case

* case

* case

* comment

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
This commit is contained in:
spaced4ndy
2025-01-10 15:27:29 +04:00
committed by GitHub
parent 13fae855fc
commit e05a35e26e
187 changed files with 2847 additions and 1291 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Store/Groups.hs
+172 -170
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
@@ -141,8 +142,6 @@ import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
import Data.Ord (Down (..))
import Data.Text (Text)
import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), (:.) (..))
import Database.SQLite.Simple.QQ (sql)
import Simplex.Chat.Messages
import Simplex.Chat.Protocol (groupForwardVersion)
import Simplex.Chat.Store.Direct
@@ -152,16 +151,24 @@ import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Protocol (ConnId, UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, fromOnlyBI, maybeFirstRow)
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..))
import qualified Simplex.Messaging.Agent.Store.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet (pattern PQEncOff, pattern PQSupportOff)
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Util (eitherToMaybe, ($>>=), (<$$>))
import Simplex.Messaging.Version
import UnliftIO.STM
#if defined(dbPostgres)
import Database.PostgreSQL.Simple (Only (..), Query, (:.) (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
import Database.SQLite.Simple (Only (..), Query, (:.) (..))
import Database.SQLite.Simple.QQ (sql)
#endif
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember
toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages, memberBlocked) :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image, contactLink, Just localAlias, contactPreferences)) =
@@ -175,7 +182,7 @@ createGroupLink db User {userId} groupInfo@GroupInfo {groupId, localDisplayName}
DB.execute
db
"INSERT INTO user_contact_links (user_id, group_id, group_link_id, local_display_name, conn_req_contact, group_link_member_role, auto_accept, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
(userId, groupId, groupLinkId, "group_link_" <> localDisplayName, cReq, memberRole, True, currentTs, currentTs)
(userId, groupId, groupLinkId, "group_link_" <> localDisplayName, cReq, memberRole, BI True, currentTs, currentTs)
userContactLinkId <- insertedRowId db
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId ConnNew initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode PQSupportOff
@@ -254,41 +261,42 @@ setGroupLinkMemberRole db User {userId} userContactLinkId memberRole =
getGroupAndMember :: DB.Connection -> User -> Int64 -> VersionRangeChat -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember db User {userId, userContactId} groupMemberId vr = do
gm <- ExceptT . firstRow toGroupAndMember (SEInternalError "referenced group member not found") $
DB.query
db
[sql|
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- from GroupMember
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, 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.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
JOIN groups g ON g.group_id = m.group_id
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu ON g.group_id = mu.group_id
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
LEFT JOIN connections c ON c.connection_id = (
SELECT max(cc.connection_id)
FROM connections cc
where cc.user_id = ? AND cc.group_member_id = m.group_member_id
)
WHERE m.group_member_id = ? AND g.user_id = ? AND mu.contact_id = ?
|]
(userId, groupMemberId, userId, userContactId)
gm <-
ExceptT . firstRow toGroupAndMember (SEInternalError "referenced group member not found") $
DB.query
db
[sql|
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- from GroupMember
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, 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.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
JOIN groups g ON g.group_id = m.group_id
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu ON g.group_id = mu.group_id
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
LEFT JOIN connections c ON c.connection_id = (
SELECT max(cc.connection_id)
FROM connections cc
where cc.user_id = ? AND cc.group_member_id = m.group_member_id
)
WHERE m.group_member_id = ? AND g.user_id = ? AND mu.contact_id = ?
|]
(userId, groupMemberId, userId, userContactId)
liftIO $ bitraverse (addGroupChatTags db) pure gm
where
toGroupAndMember :: (GroupInfoRow :. GroupMemberRow :. MaybeConnectionRow) -> (GroupInfo, GroupMember)
@@ -319,7 +327,7 @@ createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = Exc
created_at, updated_at, chat_ts, user_member_profile_sent_at)
VALUES (?,?,?,?,?,?,?,?)
|]
(ldn, userId, profileId, True, currentTs, currentTs, currentTs, currentTs)
(ldn, userId, profileId, BI True, currentTs, currentTs, currentTs, currentTs)
insertedRowId db
memberId <- liftIO $ encodedRandomBytes gVar 12
membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser customUserProfileId currentTs vr
@@ -387,7 +395,7 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ
created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat, business_member_id, customer_member_id)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
((profileId, localDisplayName, connRequest, customUserProfileId, userId, True, currentTs, currentTs, currentTs, currentTs) :. businessChatInfoRow business)
((profileId, localDisplayName, connRequest, customUserProfileId, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. businessChatInfoRow business)
insertedRowId db
let hostVRange = adjustedMemberVRange vr peerChatVRange
GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs hostVRange
@@ -532,7 +540,7 @@ createGroupInvitedViaLink
created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat, business_member_id, customer_member_id)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
|]
((profileId, localDisplayName, customUserProfileId, userId, True, currentTs, currentTs, currentTs, currentTs) :. businessChatInfoRow business)
((profileId, localDisplayName, customUserProfileId, userId, BI True, currentTs, currentTs, currentTs, currentTs) :. businessChatInfoRow business)
insertedRowId db
insertHost_ currentTs groupId = do
let fromMemberProfile = profileFromName fromMemberName
@@ -632,24 +640,28 @@ getUserGroups db vr user@User {userId} = do
getUserGroupDetails :: DB.Connection -> VersionRangeChat -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfo]
getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = do
g_ <- map (toGroupInfo vr userContactId [])
<$> DB.query
db
[sql|
SELECT
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data,
mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction,
mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
FROM groups g
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu USING (group_id)
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
WHERE g.user_id = ? AND mu.contact_id = ?
AND (gp.display_name LIKE '%' || ? || '%' OR gp.full_name LIKE '%' || ? || '%' OR gp.description LIKE '%' || ? || '%')
|]
(userId, userContactId, search, search, search)
g_ <-
map (toGroupInfo vr userContactId [])
<$> DB.query
db
[sql|
SELECT
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data,
mu.group_member_id, g.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category, mu.member_status, mu.show_messages, mu.member_restriction,
mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id, pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences
FROM groups g
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu USING (group_id)
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
WHERE g.user_id = ? AND mu.contact_id = ?
AND (LOWER(gp.display_name) LIKE '%' || LOWER(?) || '%'
OR LOWER(gp.full_name) LIKE '%' || LOWER(?) || '%'
OR LOWER(gp.description) LIKE '%' || LOWER(?) || '%'
)
|]
(userId, userContactId, search, search, search)
mapM (addGroupChatTags db) g_
where
search = fromMaybe "" search_
@@ -958,7 +970,7 @@ createBusinessRequestGroup
created_at, updated_at, chat_ts, user_member_profile_sent_at, business_chat, business_xcontact_id)
VALUES (?,?,?,?,?,?,?,?,?,?)
|]
(profileId, localDisplayName, userId, True, currentTs, currentTs, currentTs, currentTs, BCCustomer, xContactId)
(profileId, localDisplayName, userId, BI True, currentTs, currentTs, currentTs, currentTs, BCCustomer, xContactId)
insertedRowId db
memberId <- liftIO $ encodedRandomBytes gVar 12
membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser Nothing currentTs vr
@@ -1193,57 +1205,47 @@ createIntroductions db chatV members toMember = do
updateIntroStatus :: DB.Connection -> Int64 -> GroupMemberIntroStatus -> IO ()
updateIntroStatus db introId introStatus = do
currentTs <- getCurrentTime
DB.executeNamed
DB.execute
db
[sql|
UPDATE group_member_intros
SET intro_status = :intro_status, updated_at = :updated_at
WHERE group_member_intro_id = :intro_id
SET intro_status = ?, updated_at = ?
WHERE group_member_intro_id = ?
|]
[":intro_status" := introStatus, ":updated_at" := currentTs, ":intro_id" := introId]
(introStatus, currentTs, introId)
saveIntroInvitation :: DB.Connection -> GroupMember -> GroupMember -> IntroInvitation -> ExceptT StoreError IO GroupMemberIntro
saveIntroInvitation db reMember toMember introInv@IntroInvitation {groupConnReq} = do
intro <- getIntroduction db reMember toMember
liftIO $ do
currentTs <- getCurrentTime
DB.executeNamed
DB.execute
db
[sql|
UPDATE group_member_intros
SET intro_status = :intro_status,
group_queue_info = :group_queue_info,
direct_queue_info = :direct_queue_info,
updated_at = :updated_at
WHERE group_member_intro_id = :intro_id
SET intro_status = ?,
group_queue_info = ?,
direct_queue_info = ?,
updated_at = ?
WHERE group_member_intro_id = ?
|]
[ ":intro_status" := GMIntroInvReceived,
":group_queue_info" := groupConnReq,
":direct_queue_info" := directConnReq introInv,
":updated_at" := currentTs,
":intro_id" := introId intro
]
(GMIntroInvReceived, groupConnReq, directConnReq introInv, currentTs, introId intro)
pure intro {introInvitation = Just introInv, introStatus = GMIntroInvReceived}
saveMemberInvitation :: DB.Connection -> GroupMember -> IntroInvitation -> IO ()
saveMemberInvitation db GroupMember {groupMemberId} IntroInvitation {groupConnReq, directConnReq} = do
currentTs <- getCurrentTime
DB.executeNamed
DB.execute
db
[sql|
UPDATE group_members
SET member_status = :member_status,
group_queue_info = :group_queue_info,
direct_queue_info = :direct_queue_info,
updated_at = :updated_at
WHERE group_member_id = :group_member_id
SET member_status = ?,
group_queue_info = ?,
direct_queue_info = ?,
updated_at = ?
WHERE group_member_id = ?
|]
[ ":member_status" := GSMemIntroInvited,
":group_queue_info" := groupConnReq,
":direct_queue_info" := directConnReq,
":updated_at" := currentTs,
":group_member_id" := groupMemberId
]
(GSMemIntroInvited, groupConnReq, directConnReq, currentTs, groupMemberId)
getIntroduction :: DB.Connection -> GroupMember -> GroupMember -> ExceptT StoreError IO GroupMemberIntro
getIntroduction db reMember toMember = ExceptT $ do
@@ -1364,14 +1366,14 @@ createIntroToMemberContact db user@User {userId} GroupMember {memberContactId =
pure contactId
updateMember_ :: Int64 -> UTCTime -> IO ()
updateMember_ contactId ts =
DB.executeNamed
DB.execute
db
[sql|
UPDATE group_members
SET contact_id = :contact_id, updated_at = :updated_at
WHERE group_member_id = :group_member_id
SET contact_id = ?, updated_at = ?
WHERE group_member_id = ?
|]
[":contact_id" := contactId, ":updated_at" := ts, ":group_member_id" := groupMemberId]
(contactId, ts, groupMemberId)
createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> VersionChat -> VersionRangeChat -> Maybe Int64 -> Int -> UTCTime -> SubscriptionMode -> IO Connection
createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange viaContact connLevel currentTs subMode =
@@ -1379,42 +1381,43 @@ createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange
getViaGroupMember :: DB.Connection -> VersionRangeChat -> User -> Contact -> IO (Maybe (GroupInfo, GroupMember))
getViaGroupMember db vr User {userId, userContactId} Contact {contactId} = do
gm_ <- maybeFirstRow toGroupAndMember $
DB.query
db
[sql|
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- via GroupMember
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, 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.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM group_members m
JOIN contacts ct ON ct.contact_id = m.contact_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 AND g.group_id = ct.via_group
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu ON g.group_id = mu.group_id
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
LEFT JOIN connections c ON c.connection_id = (
SELECT max(cc.connection_id)
FROM connections cc
where cc.user_id = ? AND cc.group_member_id = m.group_member_id
)
WHERE ct.user_id = ? AND ct.contact_id = ? AND mu.contact_id = ? AND ct.deleted = 0
|]
(userId, userId, contactId, userContactId)
gm_ <-
maybeFirstRow toGroupAndMember $
DB.query
db
[sql|
SELECT
-- GroupInfo
g.group_id, g.local_display_name, gp.display_name, gp.full_name, gp.description, gp.image,
g.host_conn_custom_user_profile_id, g.enable_ntfs, g.send_rcpts, g.favorite, gp.preferences,
g.created_at, g.updated_at, g.chat_ts, g.user_member_profile_sent_at, g.business_chat, g.business_member_id, g.customer_member_id, g.ui_themes, g.custom_data,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
mu.member_status, mu.show_messages, mu.member_restriction, mu.invited_by, mu.invited_by_group_member_id, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
-- GroupInfo {membership = GroupMember {memberProfile}}
pu.display_name, pu.full_name, pu.image, pu.contact_link, pu.local_alias, pu.preferences,
-- via GroupMember
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, 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.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM group_members m
JOIN contacts ct ON ct.contact_id = m.contact_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 AND g.group_id = ct.via_group
JOIN group_profiles gp USING (group_profile_id)
JOIN group_members mu ON g.group_id = mu.group_id
JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
LEFT JOIN connections c ON c.connection_id = (
SELECT max(cc.connection_id)
FROM connections cc
where cc.user_id = ? AND cc.group_member_id = m.group_member_id
)
WHERE ct.user_id = ? AND ct.contact_id = ? AND mu.contact_id = ? AND ct.deleted = 0
|]
(userId, userId, contactId, userContactId)
mapM (bitraverse (addGroupChatTags db) pure) gm_
where
toGroupAndMember :: (GroupInfoRow :. GroupMemberRow :. MaybeConnectionRow) -> (GroupInfo, GroupMember)
@@ -1650,7 +1653,7 @@ createSentProbe db gVar userId to =
DB.execute
db
"INSERT INTO sent_probes (contact_id, group_member_id, probe, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
(ctId, gmId, probe, userId, currentTs, currentTs)
(ctId, gmId, Binary probe, userId, currentTs, currentTs)
(Probe probe,) <$> insertedRowId db
createSentProbeHash :: DB.Connection -> UserId -> Int64 -> ContactOrMember -> IO ()
@@ -1676,13 +1679,13 @@ matchReceivedProbe db vr user@User {userId} from (Probe probe) = do
LEFT JOIN groups g ON g.group_id = m.group_id
WHERE r.user_id = ? AND r.probe_hash = ? AND r.probe IS NULL
|]
(userId, probeHash)
(userId, Binary probeHash)
currentTs <- getCurrentTime
let (ctId, gmId) = contactOrMemberIds from
DB.execute
db
"INSERT INTO received_probes (contact_id, group_member_id, probe, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
(ctId, gmId, probe, probeHash, userId, currentTs, currentTs)
(ctId, gmId, Binary probe, Binary probeHash, userId, currentTs, currentTs)
let cgmIds' = filterFirstContactId cgmIds
catMaybes <$> mapM (getContactOrMember_ db vr user) cgmIds'
where
@@ -1708,13 +1711,13 @@ matchReceivedProbeHash db vr user@User {userId} from (ProbeHash probeHash) = do
LEFT JOIN groups g ON g.group_id = m.group_id
WHERE r.user_id = ? AND r.probe_hash = ? AND r.probe IS NOT NULL
|]
(userId, probeHash)
(userId, Binary probeHash)
currentTs <- getCurrentTime
let (ctId, gmId) = contactOrMemberIds from
DB.execute
db
"INSERT INTO received_probes (contact_id, group_member_id, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
(ctId, gmId, probeHash, userId, currentTs, currentTs)
(ctId, gmId, Binary probeHash, userId, currentTs, currentTs)
pure probeIds $>>= \(Only probe :. cgmIds) -> (,Probe probe) <$$> getContactOrMember_ db vr user cgmIds
matchSentProbe :: DB.Connection -> VersionRangeChat -> User -> ContactOrMember -> Probe -> IO (Maybe ContactOrMember)
@@ -1736,7 +1739,7 @@ matchSentProbe db vr user@User {userId} _from (Probe probe) = do
WHERE s.user_id = ? AND s.probe = ?
AND (h.contact_id = ? OR h.group_member_id = ?)
|]
(userId, probe, ctId, gmId)
(userId, Binary probe, ctId, gmId)
getContactOrMember_ :: DB.Connection -> VersionRangeChat -> User -> (Maybe ContactId, Maybe GroupId, Maybe GroupMemberId) -> IO (Maybe ContactOrMember)
getContactOrMember_ db vr user ids =
@@ -1777,22 +1780,18 @@ mergeContactRecords db vr user@User {userId} to@Contact {localDisplayName = keep
db
"UPDATE chat_items SET contact_id = ?, updated_at = ? WHERE contact_id = ? AND user_id = ?"
(toContactId, currentTs, fromContactId, userId)
DB.executeNamed
DB.execute
db
[sql|
UPDATE group_members
SET contact_id = :to_contact_id,
local_display_name = (SELECT local_display_name FROM contacts WHERE contact_id = :to_contact_id),
contact_profile_id = (SELECT contact_profile_id FROM contacts WHERE contact_id = :to_contact_id),
updated_at = :updated_at
WHERE contact_id = :from_contact_id
AND user_id = :user_id
SET contact_id = ?,
local_display_name = (SELECT local_display_name FROM contacts WHERE contact_id = ?),
contact_profile_id = (SELECT contact_profile_id FROM contacts WHERE contact_id = ?),
updated_at = ?
WHERE contact_id = ?
AND user_id = ?
|]
[ ":to_contact_id" := toContactId,
":from_contact_id" := fromContactId,
":user_id" := userId,
":updated_at" := currentTs
]
(toContactId, toContactId, toContactId, currentTs, fromContactId, userId)
deleteContactProfile_ db userId fromContactId
DB.execute db "DELETE FROM contacts WHERE contact_id = ? AND user_id = ?" (fromContactId, userId)
deleteUnusedDisplayName_ db userId fromLDN
@@ -1867,41 +1866,44 @@ associateContactWithMemberRecord
deleteUnusedDisplayName_ :: DB.Connection -> UserId -> ContactName -> IO ()
deleteUnusedDisplayName_ db userId localDisplayName =
DB.executeNamed
DB.execute
db
[sql|
DELETE FROM display_names
WHERE user_id = :user_id AND local_display_name = :local_display_name
WHERE user_id = ? AND local_display_name = ?
AND 1 NOT IN (
SELECT 1 FROM users
WHERE local_display_name = :local_display_name LIMIT 1
WHERE local_display_name = ? LIMIT 1
)
AND 1 NOT IN (
SELECT 1 FROM contacts
WHERE user_id = :user_id AND local_display_name = :local_display_name LIMIT 1
WHERE user_id = ? AND local_display_name = ? LIMIT 1
)
AND 1 NOT IN (
SELECT 1 FROM groups
WHERE user_id = :user_id AND local_display_name = :local_display_name LIMIT 1
WHERE user_id = ? AND local_display_name = ? LIMIT 1
)
AND 1 NOT IN (
SELECT 1 FROM group_members
WHERE user_id = :user_id AND local_display_name = :local_display_name LIMIT 1
WHERE user_id = ? AND local_display_name = ? LIMIT 1
)
AND 1 NOT IN (
SELECT 1 FROM user_contact_links
WHERE user_id = :user_id AND local_display_name = :local_display_name LIMIT 1
WHERE user_id = ? AND local_display_name = ? LIMIT 1
)
AND 1 NOT IN (
SELECT 1 FROM contact_requests
WHERE user_id = :user_id AND local_display_name = :local_display_name LIMIT 1
WHERE user_id = ? AND local_display_name = ? LIMIT 1
)
AND 1 NOT IN (
SELECT 1 FROM contact_requests
WHERE user_id = :user_id AND local_display_name = :local_display_name LIMIT 1
WHERE user_id = ? AND local_display_name = ? LIMIT 1
)
|]
[":user_id" := userId, ":local_display_name" := localDisplayName]
( (userId, localDisplayName, localDisplayName, userId, localDisplayName, userId, localDisplayName)
:. (userId, localDisplayName, userId, localDisplayName, userId, localDisplayName)
:. (userId, localDisplayName)
)
deleteOldProbes :: DB.Connection -> UTCTime -> IO ()
deleteOldProbes db createdAtCutoff = do
@@ -1911,7 +1913,7 @@ deleteOldProbes db createdAtCutoff = do
updateGroupSettings :: DB.Connection -> User -> Int64 -> ChatSettings -> IO ()
updateGroupSettings db User {userId} groupId ChatSettings {enableNtfs, sendRcpts, favorite} =
DB.execute db "UPDATE groups SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND group_id = ?" (enableNtfs, sendRcpts, favorite, userId, groupId)
DB.execute db "UPDATE groups SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND group_id = ?" (enableNtfs, BI <$> sendRcpts, BI favorite, userId, groupId)
updateGroupMemberSettings :: DB.Connection -> User -> GroupId -> GroupMemberId -> GroupMemberSettings -> IO ()
updateGroupMemberSettings db User {userId} gId gMemberId GroupMemberSettings {showMessages} = do
@@ -1923,7 +1925,7 @@ updateGroupMemberSettings db User {userId} gId gMemberId GroupMemberSettings {sh
SET show_messages = ?, updated_at = ?
WHERE user_id = ? AND group_id = ? AND group_member_id = ?
|]
(showMessages, currentTs, userId, gId, gMemberId)
(BI showMessages, currentTs, userId, gId, gMemberId)
updateGroupMemberBlocked :: DB.Connection -> User -> GroupId -> GroupMemberId -> MemberRestrictionStatus -> IO ()
updateGroupMemberBlocked db User {userId} gId gMemberId memberBlocked = do
@@ -2025,8 +2027,8 @@ createMemberContact
contact_group_member_id, contact_grp_inv_sent, created_at, updated_at, chat_ts
) VALUES (?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, localDisplayName, memberContactProfileId, True, userPreferences, True)
:. (groupMemberId, False, currentTs, currentTs, currentTs)
( (userId, localDisplayName, memberContactProfileId, BI True, userPreferences, BI True)
:. (groupMemberId, BI False, currentTs, currentTs, currentTs)
)
contactId <- insertedRowId db
DB.execute
@@ -2041,8 +2043,8 @@ createMemberContact
conn_chat_version, peer_chat_min_version, peer_chat_max_version, created_at, updated_at, to_subscribe
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, acId, cReq, connLevel, ConnNew, ConnContact, True, contactId, customUserProfileId)
:. (connChatVersion, minV, maxV, currentTs, currentTs, subMode == SMOnlyCreate)
( (userId, acId, cReq, connLevel, ConnNew, ConnContact, BI True, contactId, customUserProfileId)
:. (connChatVersion, minV, maxV, currentTs, currentTs, BI (subMode == SMOnlyCreate))
)
connId <- insertedRowId db
let ctConn =
@@ -2093,7 +2095,7 @@ setContactGrpInvSent db Contact {contactId} xGrpDirectInvSent = do
DB.execute
db
"UPDATE contacts SET contact_grp_inv_sent = ?, updated_at = ? WHERE contact_id = ?"
(xGrpDirectInvSent, currentTs, contactId)
(BI xGrpDirectInvSent, currentTs, contactId)
createMemberContactInvited :: DB.Connection -> User -> (CommandId, ConnId) -> GroupInfo -> GroupMember -> Connection -> SubscriptionMode -> IO (Contact, GroupMember)
createMemberContactInvited
@@ -2123,7 +2125,7 @@ createMemberContactInvited
created_at, updated_at, chat_ts
) VALUES (?,?,?,?,?,?,?,?,?)
|]
( (userId, memberLDN, memberContactProfileId, True, userPreferences, True)
( (userId, memberLDN, memberContactProfileId, BI True, userPreferences, BI True)
:. (currentTs, currentTs, currentTs)
)
contactId <- insertedRowId db
@@ -2175,7 +2177,7 @@ createMemberContactConn_
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, acId, connLevel, ConnJoined, ConnContact, contactId, customUserProfileId)
:. (connChatVersion, minV, maxV, currentTs, currentTs, subMode == SMOnlyCreate)
:. (connChatVersion, minV, maxV, currentTs, currentTs, BI (subMode == SMOnlyCreate))
)
connId <- insertedRowId db
setCommandConnId db user cmdId connId
@@ -2244,7 +2246,7 @@ updateContactMemberProfile db user@User {userId} m ct@Contact {contactId} p'
getXGrpLinkMemReceived :: DB.Connection -> GroupMemberId -> ExceptT StoreError IO Bool
getXGrpLinkMemReceived db mId =
ExceptT . firstRow fromOnly (SEGroupMemberNotFound mId) $
ExceptT . firstRow fromOnlyBI (SEGroupMemberNotFound mId) $
DB.query db "SELECT xgrplinkmem_received FROM group_members WHERE group_member_id = ?" (Only mId)
setXGrpLinkMemReceived :: DB.Connection -> GroupMemberId -> Bool -> IO ()
@@ -2253,7 +2255,7 @@ setXGrpLinkMemReceived db mId xGrpLinkMemReceived = do
DB.execute
db
"UPDATE group_members SET xgrplinkmem_received = ?, updated_at = ? WHERE group_member_id = ?"
(xGrpLinkMemReceived, currentTs, mId)
(BI xGrpLinkMemReceived, currentTs, mId)
createNewUnknownGroupMember :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> MemberId -> Text -> ExceptT StoreError IO GroupMember
createNewUnknownGroupMember db vr user@User {userId, userContactId} GroupInfo {groupId} memberId memberName = do