mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-14 14:45:33 +00:00
Merge branch 'master' into master-ghc8107
This commit is contained in:
Evgeny Poberezkin
@@ -95,13 +95,13 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
|
||||
-- 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,
|
||||
-- GroupInfo {membership}
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
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.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.member_role, m.member_category, m.member_status, m.show_messages,
|
||||
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.contact_link, p.local_alias, p.preferences
|
||||
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.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
|
||||
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
|
||||
|
||||
@@ -42,6 +42,7 @@ module Simplex.Chat.Store.Groups
|
||||
getGroupInfoByName,
|
||||
getGroupMember,
|
||||
getGroupMemberById,
|
||||
getGroupMemberByMemberId,
|
||||
getGroupMembers,
|
||||
getGroupMembersForExpiration,
|
||||
getGroupCurrentMembersCount,
|
||||
@@ -74,6 +75,9 @@ module Simplex.Chat.Store.Groups
|
||||
createIntroductions,
|
||||
updateIntroStatus,
|
||||
saveIntroInvitation,
|
||||
getIntroduction,
|
||||
getForwardIntroducedMembers,
|
||||
getForwardInvitedMembers,
|
||||
createIntroReMember,
|
||||
createIntroToMemberContact,
|
||||
saveMemberInvitation,
|
||||
@@ -120,6 +124,7 @@ 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 (currentChatVersion, groupForwardVRange, supportedChatVRange)
|
||||
import Simplex.Chat.Store.Direct
|
||||
import Simplex.Chat.Store.Shared
|
||||
import Simplex.Chat.Types
|
||||
@@ -135,9 +140,9 @@ import UnliftIO.STM
|
||||
|
||||
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime) :. GroupMemberRow
|
||||
|
||||
type GroupMemberRow = ((Int64, Int64, MemberId, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool) :. (Maybe Int64, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
|
||||
type GroupMemberRow = ((Int64, Int64, MemberId, Version, Version, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
|
||||
|
||||
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool) :. (Maybe Int64, 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 Version, Maybe Version, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
|
||||
|
||||
toGroupInfo :: Int64 -> GroupInfoRow -> GroupInfo
|
||||
toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs) :. userMemberRow) =
|
||||
@@ -148,16 +153,17 @@ toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, de
|
||||
in GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId, chatSettings, createdAt, updatedAt, chatTs}
|
||||
|
||||
toGroupMember :: Int64 -> GroupMemberRow -> GroupMember
|
||||
toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, showMessages) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) =
|
||||
toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, preferences)) =
|
||||
let memberProfile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
|
||||
memberSettings = GroupMemberSettings {showMessages}
|
||||
invitedBy = toInvitedBy userContactId invitedById
|
||||
activeConn = Nothing
|
||||
memberChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
|
||||
in GroupMember {..}
|
||||
|
||||
toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember
|
||||
toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages) :. (invitedById, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image, contactLink, Just localAlias, contactPreferences)) =
|
||||
Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, showMessages) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, contactPreferences))
|
||||
toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages) :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId, Just profileId, Just displayName, Just fullName, image, contactLink, Just localAlias, contactPreferences)) =
|
||||
Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, contactPreferences))
|
||||
toMaybeGroupMember _ _ = Nothing
|
||||
|
||||
createGroupLink :: DB.Connection -> User -> GroupInfo -> ConnId -> ConnReqContact -> GroupLinkId -> GroupMemberRole -> SubscriptionMode -> ExceptT StoreError IO ()
|
||||
@@ -252,13 +258,13 @@ getGroupAndMember db User {userId, userContactId} groupMemberId =
|
||||
-- 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,
|
||||
-- GroupInfo {membership}
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
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.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.member_role, m.member_category, m.member_status, m.show_messages,
|
||||
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.contact_link, p.local_alias, p.preferences,
|
||||
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.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.auth_err_counter,
|
||||
c.peer_chat_min_version, c.peer_chat_max_version
|
||||
@@ -303,14 +309,14 @@ createNewGroup db gVar user@User {userId} groupProfile incognitoProfile = Except
|
||||
(ldn, userId, profileId, True, currentTs, currentTs, currentTs)
|
||||
insertedRowId db
|
||||
memberId <- liftIO $ encodedRandomBytes gVar 12
|
||||
membership <- createContactMemberInv_ db user groupId user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser customUserProfileId currentTs
|
||||
membership <- createContactMemberInv_ db user groupId Nothing user (MemberIdRole (MemberId memberId) GROwner) GCUserMember GSMemCreator IBUser customUserProfileId currentTs supportedChatVRange
|
||||
let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False}
|
||||
pure GroupInfo {groupId, localDisplayName = ldn, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = Nothing, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs}
|
||||
|
||||
-- | creates a new group record for the group the current user was invited to, or returns an existing one
|
||||
createGroupInvitation :: DB.Connection -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId)
|
||||
createGroupInvitation _ _ Contact {localDisplayName, activeConn = Nothing} _ _ = throwError $ SEContactNotReady localDisplayName
|
||||
createGroupInvitation db user@User {userId} contact@Contact {contactId, activeConn = Just Connection {customUserProfileId}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do
|
||||
createGroupInvitation db user@User {userId} contact@Contact {contactId, activeConn = Just hostConn@Connection {customUserProfileId}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do
|
||||
liftIO getInvitationGroupId_ >>= \case
|
||||
Nothing -> createGroupInvitation_
|
||||
Just gId -> do
|
||||
@@ -348,8 +354,9 @@ createGroupInvitation db user@User {userId} contact@Contact {contactId, activeCo
|
||||
"INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, host_conn_custom_user_profile_id, user_id, enable_ntfs, created_at, updated_at, chat_ts) VALUES (?,?,?,?,?,?,?,?,?)"
|
||||
(profileId, localDisplayName, connRequest, customUserProfileId, userId, True, currentTs, currentTs, currentTs)
|
||||
insertedRowId db
|
||||
GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs
|
||||
membership <- createContactMemberInv_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs
|
||||
let JVersionRange hostVRange = hostConn.peerChatVRange
|
||||
GroupMember {groupMemberId} <- createContactMemberInv_ db user groupId Nothing contact fromMember GCHostMember GSMemInvited IBUnknown Nothing currentTs hostVRange
|
||||
membership <- createContactMemberInv_ db user groupId (Just groupMemberId) user invitedMember GCUserMember GSMemInvited (IBContact contactId) incognitoProfileId currentTs supportedChatVRange
|
||||
let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False}
|
||||
pure (GroupInfo {groupId, localDisplayName, groupProfile, fullGroupPreferences, membership, hostConnCustomUserProfileId = customUserProfileId, chatSettings, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs}, groupMemberId)
|
||||
|
||||
@@ -358,8 +365,8 @@ getHostMemberId_ db User {userId} groupId =
|
||||
ExceptT . firstRow fromOnly (SEHostMemberIdNotFound groupId) $
|
||||
DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND member_category = ?" (userId, groupId, GCHostMember)
|
||||
|
||||
createContactMemberInv_ :: IsContact a => DB.Connection -> User -> GroupId -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ProfileId -> UTCTime -> ExceptT StoreError IO GroupMember
|
||||
createContactMemberInv_ db User {userId, userContactId} groupId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy incognitoProfileId createdAt = do
|
||||
createContactMemberInv_ :: IsContact a => DB.Connection -> User -> GroupId -> Maybe GroupMemberId -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ProfileId -> UTCTime -> VersionRange -> ExceptT StoreError IO GroupMember
|
||||
createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMemberId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy incognitoProfileId createdAt memberChatVRange@(VersionRange minV maxV) = do
|
||||
incognitoProfile <- forM incognitoProfileId $ \profileId -> getProfileById db userId profileId
|
||||
(localDisplayName, memberProfile) <- case (incognitoProfile, incognitoProfileId) of
|
||||
(Just profile@LocalProfile {displayName}, Just profileId) ->
|
||||
@@ -376,11 +383,13 @@ createContactMemberInv_ db User {userId, userContactId} groupId userOrContact Me
|
||||
memberStatus,
|
||||
memberSettings = defaultMemberSettings,
|
||||
invitedBy,
|
||||
invitedByGroupMemberId,
|
||||
localDisplayName,
|
||||
memberProfile,
|
||||
memberContactId = Just $ contactId' userOrContact,
|
||||
memberContactProfileId = localProfileId (profile' userOrContact),
|
||||
activeConn = Nothing
|
||||
activeConn = Nothing,
|
||||
memberChatVRange = JVersionRange memberChatVRange
|
||||
}
|
||||
where
|
||||
insertMember_ :: IO ContactName
|
||||
@@ -390,12 +399,14 @@ createContactMemberInv_ db User {userId, userContactId} groupId userOrContact Me
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO group_members
|
||||
( group_id, member_id, member_role, member_category, member_status, invited_by,
|
||||
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
( group_id, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
|
||||
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
|
||||
peer_chat_min_version, peer_chat_max_version)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (groupId, memberId, memberRole, memberCategory, memberStatus, fromInvitedBy userContactId invitedBy)
|
||||
( (groupId, memberId, memberRole, memberCategory, memberStatus, fromInvitedBy userContactId invitedBy, invitedByGroupMemberId)
|
||||
:. (userId, localDisplayName' userOrContact, contactId' userOrContact, localProfileId $ profile' userOrContact, createdAt, createdAt)
|
||||
:. (minV, maxV)
|
||||
)
|
||||
pure localDisplayName
|
||||
insertMemberIncognitoProfile_ :: ContactName -> ProfileId -> ExceptT StoreError IO ContactName
|
||||
@@ -405,12 +416,14 @@ createContactMemberInv_ db User {userId, userContactId} groupId userOrContact Me
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO group_members
|
||||
( group_id, member_id, member_role, member_category, member_status, invited_by,
|
||||
user_id, local_display_name, contact_id, contact_profile_id, member_profile_id, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
( group_id, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
|
||||
user_id, local_display_name, contact_id, contact_profile_id, member_profile_id, created_at, updated_at,
|
||||
peer_chat_min_version, peer_chat_max_version)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (groupId, memberId, memberRole, memberCategory, memberStatus, fromInvitedBy userContactId invitedBy)
|
||||
( (groupId, memberId, memberRole, memberCategory, memberStatus, fromInvitedBy userContactId invitedBy, invitedByGroupMemberId)
|
||||
:. (userId, incognitoLdn, contactId' userOrContact, localProfileId $ profile' userOrContact, customUserProfileId, createdAt, createdAt)
|
||||
:. (minV, maxV)
|
||||
)
|
||||
pure $ Right incognitoLdn
|
||||
|
||||
@@ -425,7 +438,7 @@ createGroupInvitedViaLink
|
||||
hostMemberId <- insertHost_ currentTs groupId
|
||||
liftIO $ DB.execute db "UPDATE connections SET conn_type = ?, group_member_id = ?, updated_at = ? WHERE connection_id = ?" (ConnMember, hostMemberId, currentTs, connId)
|
||||
-- using IBUnknown since host is created without contact
|
||||
void $ createContactMemberInv_ db user groupId user invitedMember GCUserMember GSMemAccepted IBUnknown customUserProfileId currentTs
|
||||
void $ createContactMemberInv_ db user groupId (Just hostMemberId) user invitedMember GCUserMember GSMemAccepted IBUnknown customUserProfileId currentTs supportedChatVRange
|
||||
liftIO $ setViaGroupLinkHash db groupId connId
|
||||
(,) <$> getGroupInfo db user groupId <*> getGroupMemberById db user hostMemberId
|
||||
where
|
||||
@@ -547,8 +560,8 @@ getUserGroupDetails db User {userId, userContactId} _contactId_ search_ =
|
||||
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,
|
||||
mu.group_member_id, g.group_id, mu.member_id, mu.member_role, mu.member_category, mu.member_status, mu.show_messages,
|
||||
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.contact_link, pu.local_alias, pu.preferences
|
||||
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.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)
|
||||
@@ -612,8 +625,8 @@ groupMemberQuery :: Query
|
||||
groupMemberQuery =
|
||||
[sql|
|
||||
SELECT
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.show_messages,
|
||||
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.contact_link, p.local_alias, p.preferences,
|
||||
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.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.auth_err_counter,
|
||||
c.peer_chat_min_version, c.peer_chat_max_version
|
||||
@@ -642,6 +655,14 @@ getGroupMemberById db user@User {userId} groupMemberId =
|
||||
(groupMemberQuery <> " WHERE m.group_member_id = ? AND m.user_id = ?")
|
||||
(userId, groupMemberId, userId)
|
||||
|
||||
getGroupMemberByMemberId :: DB.Connection -> User -> GroupInfo -> MemberId -> ExceptT StoreError IO GroupMember
|
||||
getGroupMemberByMemberId db user@User {userId} GroupInfo {groupId} memberId =
|
||||
ExceptT . firstRow (toContactMember user) (SEGroupMemberNotFoundByMemberId memberId) $
|
||||
DB.query
|
||||
db
|
||||
(groupMemberQuery <> " WHERE m.group_id = ? AND m.member_id = ?")
|
||||
(userId, groupId, memberId)
|
||||
|
||||
getGroupMembers :: DB.Connection -> User -> GroupInfo -> IO [GroupMember]
|
||||
getGroupMembers db user@User {userId, userContactId} GroupInfo {groupId} = do
|
||||
map (toContactMember user)
|
||||
@@ -700,15 +721,17 @@ getGroupInvitation db user groupId =
|
||||
firstRow fromOnly (SEGroupNotFound groupId) $
|
||||
DB.query db "SELECT g.inv_queue_info FROM groups g WHERE g.group_id = ? AND g.user_id = ?" (groupId, userId)
|
||||
|
||||
createNewContactMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupId -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> SubscriptionMode -> ExceptT StoreError IO GroupMember
|
||||
createNewContactMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> SubscriptionMode -> ExceptT StoreError IO GroupMember
|
||||
createNewContactMember _ _ _ _ Contact {localDisplayName, activeConn = Nothing} _ _ _ _ = throwError $ SEContactNotReady localDisplayName
|
||||
createNewContactMember db gVar User {userId, userContactId} groupId Contact {contactId, localDisplayName, profile, activeConn = Just Connection {peerChatVRange}} memberRole agentConnId connRequest subMode =
|
||||
createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId, membership} Contact {contactId, localDisplayName, profile, activeConn = Just Connection {peerChatVRange}} memberRole agentConnId connRequest subMode =
|
||||
createWithRandomId gVar $ \memId -> do
|
||||
createdAt <- liftIO getCurrentTime
|
||||
member@GroupMember {groupMemberId} <- createMember_ (MemberId memId) createdAt
|
||||
void $ createMemberConnection_ db userId groupMemberId agentConnId (fromJVersionRange peerChatVRange) Nothing 0 createdAt subMode
|
||||
pure member
|
||||
where
|
||||
JVersionRange (VersionRange minV maxV) = peerChatVRange
|
||||
invitedByGroupMemberId = groupMemberId' membership
|
||||
createMember_ memberId createdAt = do
|
||||
insertMember_
|
||||
groupMemberId <- liftIO $ insertedRowId db
|
||||
@@ -722,11 +745,13 @@ createNewContactMember db gVar User {userId, userContactId} groupId Contact {con
|
||||
memberStatus = GSMemInvited,
|
||||
memberSettings = defaultMemberSettings,
|
||||
invitedBy = IBUser,
|
||||
invitedByGroupMemberId = Just invitedByGroupMemberId,
|
||||
localDisplayName,
|
||||
memberProfile = profile,
|
||||
memberContactId = Just contactId,
|
||||
memberContactProfileId = localProfileId profile,
|
||||
activeConn = Nothing
|
||||
activeConn = Nothing,
|
||||
memberChatVRange = peerChatVRange
|
||||
}
|
||||
where
|
||||
insertMember_ =
|
||||
@@ -734,16 +759,18 @@ createNewContactMember db gVar User {userId, userContactId} groupId Contact {con
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO group_members
|
||||
( group_id, member_id, member_role, member_category, member_status, invited_by,
|
||||
user_id, local_display_name, contact_id, contact_profile_id, sent_inv_queue_info, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
( group_id, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
|
||||
user_id, local_display_name, contact_id, contact_profile_id, sent_inv_queue_info, created_at, updated_at,
|
||||
peer_chat_min_version, peer_chat_max_version)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (groupId, memberId, memberRole, GCInviteeMember, GSMemInvited, fromInvitedBy userContactId IBUser)
|
||||
( (groupId, memberId, memberRole, GCInviteeMember, GSMemInvited, fromInvitedBy userContactId IBUser, invitedByGroupMemberId)
|
||||
:. (userId, localDisplayName, contactId, localProfileId profile, connRequest, createdAt, createdAt)
|
||||
:. (minV, maxV)
|
||||
)
|
||||
|
||||
createNewContactMemberAsync :: DB.Connection -> TVar ChaChaDRG -> User -> GroupId -> Contact -> GroupMemberRole -> (CommandId, ConnId) -> VersionRange -> SubscriptionMode -> ExceptT StoreError IO ()
|
||||
createNewContactMemberAsync db gVar user@User {userId, userContactId} groupId Contact {contactId, localDisplayName, profile} memberRole (cmdId, agentConnId) peerChatVRange subMode =
|
||||
createNewContactMemberAsync :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> Contact -> GroupMemberRole -> (CommandId, ConnId) -> VersionRange -> SubscriptionMode -> ExceptT StoreError IO ()
|
||||
createNewContactMemberAsync db gVar user@User {userId, userContactId} GroupInfo {groupId, membership} Contact {contactId, localDisplayName, profile} memberRole (cmdId, agentConnId) peerChatVRange subMode =
|
||||
createWithRandomId gVar $ \memId -> do
|
||||
createdAt <- liftIO getCurrentTime
|
||||
insertMember_ (MemberId memId) createdAt
|
||||
@@ -751,17 +778,20 @@ createNewContactMemberAsync db gVar user@User {userId, userContactId} groupId Co
|
||||
Connection {connId} <- createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 createdAt subMode
|
||||
setCommandConnId db user cmdId connId
|
||||
where
|
||||
VersionRange minV maxV = peerChatVRange
|
||||
insertMember_ memberId createdAt =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO group_members
|
||||
( group_id, member_id, member_role, member_category, member_status, invited_by,
|
||||
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
( group_id, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
|
||||
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
|
||||
peer_chat_min_version, peer_chat_max_version)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (groupId, memberId, memberRole, GCInviteeMember, GSMemInvited, fromInvitedBy userContactId IBUser)
|
||||
( (groupId, memberId, memberRole, GCInviteeMember, GSMemInvited, fromInvitedBy userContactId IBUser, groupMemberId' membership)
|
||||
:. (userId, localDisplayName, contactId, localProfileId profile, createdAt, createdAt)
|
||||
:. (minV, maxV)
|
||||
)
|
||||
|
||||
createAcceptedMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> UserContactRequest -> GroupMemberRole -> ExceptT StoreError IO (GroupMemberId, MemberId)
|
||||
@@ -769,8 +799,8 @@ createAcceptedMember
|
||||
db
|
||||
gVar
|
||||
User {userId, userContactId}
|
||||
GroupInfo {groupId}
|
||||
UserContactRequest {localDisplayName, profileId}
|
||||
GroupInfo {groupId, membership}
|
||||
UserContactRequest {cReqChatVRange, localDisplayName, profileId}
|
||||
memberRole = do
|
||||
liftIO $
|
||||
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
|
||||
@@ -780,17 +810,20 @@ createAcceptedMember
|
||||
groupMemberId <- liftIO $ insertedRowId db
|
||||
pure (groupMemberId, MemberId memId)
|
||||
where
|
||||
JVersionRange (VersionRange minV maxV) = cReqChatVRange
|
||||
insertMember_ memberId createdAt =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO group_members
|
||||
( group_id, member_id, member_role, member_category, member_status, invited_by,
|
||||
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
( group_id, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
|
||||
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
|
||||
peer_chat_min_version, peer_chat_max_version)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (groupId, memberId, memberRole, GCInviteeMember, GSMemAccepted, fromInvitedBy userContactId IBUser)
|
||||
( (groupId, memberId, memberRole, GCInviteeMember, GSMemAccepted, fromInvitedBy userContactId IBUser, groupMemberId' membership)
|
||||
:. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, createdAt, createdAt)
|
||||
:. (minV, maxV)
|
||||
)
|
||||
|
||||
createAcceptedMemberConnection :: DB.Connection -> User -> (CommandId, ConnId) -> UserContactRequest -> GroupMemberId -> SubscriptionMode -> IO ()
|
||||
@@ -859,8 +892,8 @@ updateGroupMemberStatusById db userId groupMemberId memStatus = do
|
||||
(memStatus, currentTs, userId, groupMemberId)
|
||||
|
||||
-- | add new member with profile
|
||||
createNewGroupMember :: DB.Connection -> User -> GroupInfo -> MemberInfo -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
|
||||
createNewGroupMember db user gInfo memInfo@MemberInfo {profile} memCategory memStatus = do
|
||||
createNewGroupMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
|
||||
createNewGroupMember db user gInfo invitingMember memInfo@MemberInfo {profile} memCategory memStatus = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
(localDisplayName, memProfileId) <- createNewMemberProfile_ db user profile currentTs
|
||||
let newMember =
|
||||
@@ -869,6 +902,7 @@ createNewGroupMember db user gInfo memInfo@MemberInfo {profile} memCategory memS
|
||||
memCategory,
|
||||
memStatus,
|
||||
memInvitedBy = IBUnknown,
|
||||
memInvitedByGroupMemberId = Just $ groupMemberId' invitingMember,
|
||||
localDisplayName,
|
||||
memContactId = Nothing,
|
||||
memProfileId
|
||||
@@ -891,10 +925,11 @@ createNewMember_
|
||||
User {userId, userContactId}
|
||||
GroupInfo {groupId}
|
||||
NewGroupMember
|
||||
{ memInfo = MemberInfo memberId memberRole _ memberProfile,
|
||||
{ memInfo = MemberInfo memberId memberRole memChatVRange memberProfile,
|
||||
memCategory = memberCategory,
|
||||
memStatus = memberStatus,
|
||||
memInvitedBy = invitedBy,
|
||||
memInvitedByGroupMemberId,
|
||||
localDisplayName,
|
||||
memContactId = memberContactId,
|
||||
memProfileId = memberContactProfileId
|
||||
@@ -902,18 +937,38 @@ createNewMember_
|
||||
createdAt = do
|
||||
let invitedById = fromInvitedBy userContactId invitedBy
|
||||
activeConn = Nothing
|
||||
mcvr@(VersionRange minV maxV) = maybe chatInitialVRange fromChatVRange memChatVRange
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO group_members
|
||||
(group_id, member_id, member_role, member_category, member_status,
|
||||
invited_by, user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
(group_id, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
|
||||
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
|
||||
peer_chat_min_version, peer_chat_max_version)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
(groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, userId, localDisplayName, memberContactId, memberContactProfileId, createdAt, createdAt)
|
||||
( (groupId, memberId, memberRole, memberCategory, memberStatus, invitedById, memInvitedByGroupMemberId)
|
||||
:. (userId, localDisplayName, memberContactId, memberContactProfileId, createdAt, createdAt)
|
||||
:. (minV, maxV)
|
||||
)
|
||||
groupMemberId <- insertedRowId db
|
||||
let memberSettings = defaultMemberSettings
|
||||
pure GroupMember {groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus, memberSettings, invitedBy, localDisplayName, memberProfile = toLocalProfile memberContactProfileId memberProfile "", memberContactId, memberContactProfileId, activeConn}
|
||||
pure GroupMember {
|
||||
groupMemberId,
|
||||
groupId,
|
||||
memberId,
|
||||
memberRole,
|
||||
memberCategory,
|
||||
memberStatus,
|
||||
memberSettings = defaultMemberSettings,
|
||||
invitedBy,
|
||||
invitedByGroupMemberId = memInvitedByGroupMemberId,
|
||||
localDisplayName,
|
||||
memberProfile = toLocalProfile memberContactProfileId memberProfile "",
|
||||
memberContactId,
|
||||
memberContactProfileId,
|
||||
activeConn,
|
||||
memberChatVRange = JVersionRange mcvr
|
||||
}
|
||||
|
||||
checkGroupMemberHasItems :: DB.Connection -> User -> GroupMember -> IO (Maybe ChatItemId)
|
||||
checkGroupMemberHasItems db User {userId} GroupMember {groupMemberId, groupId} =
|
||||
@@ -960,10 +1015,10 @@ createIntroductions db members toMember = do
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO group_member_intros
|
||||
(re_group_member_id, to_group_member_id, intro_status, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?)
|
||||
(re_group_member_id, to_group_member_id, intro_status, intro_chat_protocol_version, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?)
|
||||
|]
|
||||
(groupMemberId' reMember, groupMemberId' toMember, GMIntroPending, ts, ts)
|
||||
(groupMemberId' reMember, groupMemberId' toMember, GMIntroPending, currentChatVersion, ts, ts)
|
||||
introId <- insertedRowId db
|
||||
pure GroupMemberIntro {introId, reMember, toMember, introStatus = GMIntroPending, introInvitation = Nothing}
|
||||
|
||||
@@ -981,7 +1036,7 @@ updateIntroStatus db introId introStatus = do
|
||||
|
||||
saveIntroInvitation :: DB.Connection -> GroupMember -> GroupMember -> IntroInvitation -> ExceptT StoreError IO GroupMemberIntro
|
||||
saveIntroInvitation db reMember toMember introInv = do
|
||||
intro <- getIntroduction_ db reMember toMember
|
||||
intro <- getIntroduction db reMember toMember
|
||||
liftIO $ do
|
||||
currentTs <- getCurrentTime
|
||||
DB.executeNamed
|
||||
@@ -1022,8 +1077,8 @@ saveMemberInvitation db GroupMember {groupMemberId} IntroInvitation {groupConnRe
|
||||
":group_member_id" := groupMemberId
|
||||
]
|
||||
|
||||
getIntroduction_ :: DB.Connection -> GroupMember -> GroupMember -> ExceptT StoreError IO GroupMemberIntro
|
||||
getIntroduction_ db reMember toMember = ExceptT $ do
|
||||
getIntroduction :: DB.Connection -> GroupMember -> GroupMember -> ExceptT StoreError IO GroupMemberIntro
|
||||
getIntroduction db reMember toMember = ExceptT $ do
|
||||
toIntro
|
||||
<$> DB.query
|
||||
db
|
||||
@@ -1040,10 +1095,50 @@ getIntroduction_ db reMember toMember = ExceptT $ do
|
||||
in Right GroupMemberIntro {introId, reMember, toMember, introStatus, introInvitation}
|
||||
toIntro _ = Left SEIntroNotFound
|
||||
|
||||
getForwardIntroducedMembers :: DB.Connection -> User -> GroupMember -> Bool -> IO [GroupMember]
|
||||
getForwardIntroducedMembers db user invitee highlyAvailable = do
|
||||
memberIds <- map fromOnly <$> query
|
||||
filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db user) memberIds
|
||||
where
|
||||
mId = groupMemberId' invitee
|
||||
query
|
||||
| highlyAvailable = DB.query db q (mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected)
|
||||
| otherwise =
|
||||
DB.query
|
||||
db
|
||||
(q <> " AND intro_chat_protocol_version >= ?")
|
||||
(mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, minVersion groupForwardVRange)
|
||||
q =
|
||||
[sql|
|
||||
SELECT re_group_member_id
|
||||
FROM group_member_intros
|
||||
WHERE to_group_member_id = ? AND intro_status NOT IN (?,?,?)
|
||||
|]
|
||||
|
||||
getForwardInvitedMembers :: DB.Connection -> User -> GroupMember -> Bool -> IO [GroupMember]
|
||||
getForwardInvitedMembers db user forwardMember highlyAvailable = do
|
||||
memberIds <- map fromOnly <$> query
|
||||
filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db user) memberIds
|
||||
where
|
||||
mId = groupMemberId' forwardMember
|
||||
query
|
||||
| highlyAvailable = DB.query db q (mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected)
|
||||
| otherwise =
|
||||
DB.query
|
||||
db
|
||||
(q <> " AND intro_chat_protocol_version >= ?")
|
||||
(mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, minVersion groupForwardVRange)
|
||||
q =
|
||||
[sql|
|
||||
SELECT to_group_member_id
|
||||
FROM group_member_intros
|
||||
WHERE re_group_member_id = ? AND intro_status NOT IN (?,?,?)
|
||||
|]
|
||||
|
||||
createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> ExceptT StoreError IO GroupMember
|
||||
createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupMember {memberContactId, activeConn} memInfo@(MemberInfo _ _ memberChatVRange memberProfile) (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do
|
||||
let mcvr = maybe chatInitialVRange fromChatVRange memberChatVRange
|
||||
cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn
|
||||
createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupMember {memberContactId, activeConn} memInfo@(MemberInfo _ _ memChatVRange memberProfile) (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do
|
||||
let mcvr = maybe chatInitialVRange fromChatVRange memChatVRange
|
||||
cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn
|
||||
currentTs <- liftIO getCurrentTime
|
||||
newMember <- case directConnIds of
|
||||
Just (directCmdId, directAgentConnId) -> do
|
||||
@@ -1051,10 +1146,10 @@ createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupM
|
||||
liftIO $ setCommandConnId db user directCmdId directConnId
|
||||
(localDisplayName, contactId, memProfileId) <- createContact_ db userId memberProfile "" (Just groupId) currentTs Nothing
|
||||
liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, directConnId)
|
||||
pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, localDisplayName, memContactId = Just contactId, memProfileId}
|
||||
pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Just contactId, memProfileId}
|
||||
Nothing -> do
|
||||
(localDisplayName, memProfileId) <- createNewMemberProfile_ db user memberProfile currentTs
|
||||
pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, localDisplayName, memContactId = Nothing, memProfileId}
|
||||
pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId}
|
||||
liftIO $ do
|
||||
member <- createNewMember_ db user gInfo newMember currentTs
|
||||
conn@Connection {connId = groupConnId} <- createMemberConnection_ db userId (groupMemberId' member) groupAgentConnId mcvr memberContactId cLevel currentTs subMode
|
||||
@@ -1111,13 +1206,13 @@ getViaGroupMember db User {userId, userContactId} Contact {contactId} =
|
||||
-- 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,
|
||||
-- GroupInfo {membership}
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
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.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.member_role, m.member_category, m.member_status, m.show_messages,
|
||||
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.contact_link, p.local_alias, p.preferences,
|
||||
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.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.auth_err_counter,
|
||||
c.peer_chat_min_version, c.peer_chat_max_version
|
||||
@@ -1204,8 +1299,8 @@ getGroupInfo db User {userId, userContactId} groupId =
|
||||
-- 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,
|
||||
-- GroupMember - membership
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
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.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 ON gp.group_profile_id = g.group_profile_id
|
||||
|
||||
@@ -21,6 +21,7 @@ module Simplex.Chat.Store.Messages
|
||||
createNewSndMessage,
|
||||
createSndMsgDelivery,
|
||||
createNewMessageAndRcvMsgDelivery,
|
||||
createNewRcvMessage,
|
||||
createSndMsgDeliveryEvent,
|
||||
createRcvMsgDeliveryEvent,
|
||||
createPendingGroupMessage,
|
||||
@@ -181,25 +182,53 @@ createSndMsgDelivery db sndMsgDelivery messageId = do
|
||||
createMsgDeliveryEvent_ db msgDeliveryId MDSSndAgent currentTs
|
||||
pure msgDeliveryId
|
||||
|
||||
createNewMessageAndRcvMsgDelivery :: forall e. MsgEncodingI e => DB.Connection -> ConnOrGroupId -> NewMessage e -> Maybe SharedMsgId -> RcvMsgDelivery -> IO RcvMessage
|
||||
createNewMessageAndRcvMsgDelivery db connOrGroupId NewMessage {chatMsgEvent, msgBody} sharedMsgId_ RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId} = do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO messages (msg_sent, chat_msg_event, msg_body, created_at, updated_at, connection_id, group_id, shared_msg_id) VALUES (?,?,?,?,?,?,?,?)"
|
||||
(MDRcv, toCMEventTag chatMsgEvent, msgBody, currentTs, currentTs, connId_, groupId_, sharedMsgId_)
|
||||
msgId <- insertedRowId db
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO msg_deliveries (message_id, connection_id, agent_msg_id, agent_msg_meta, agent_ack_cmd_id, chat_ts, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
|
||||
(msgId, connId, agentMsgId, msgMetaJson agentMsgMeta, agentAckCmdId, snd $ broker agentMsgMeta, currentTs, currentTs)
|
||||
msgDeliveryId <- insertedRowId db
|
||||
createMsgDeliveryEvent_ db msgDeliveryId MDSRcvAgent currentTs
|
||||
pure RcvMessage {msgId, chatMsgEvent = ACME (encoding @e) chatMsgEvent, sharedMsgId_, msgBody}
|
||||
where
|
||||
(connId_, groupId_) = case connOrGroupId of
|
||||
ConnectionId connId' -> (Just connId', Nothing)
|
||||
GroupId groupId -> (Nothing, Just groupId)
|
||||
createNewMessageAndRcvMsgDelivery :: forall e. MsgEncodingI e => DB.Connection -> ConnOrGroupId -> NewMessage e -> Maybe SharedMsgId -> RcvMsgDelivery -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage
|
||||
createNewMessageAndRcvMsgDelivery db connOrGroupId newMessage sharedMsgId_ RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId} authorGroupMemberId_ = do
|
||||
msg@RcvMessage {msgId} <- createNewRcvMessage db connOrGroupId newMessage sharedMsgId_ authorGroupMemberId_ Nothing
|
||||
liftIO $ do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"INSERT INTO msg_deliveries (message_id, connection_id, agent_msg_id, agent_msg_meta, agent_ack_cmd_id, chat_ts, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
|
||||
(msgId, connId, agentMsgId, msgMetaJson agentMsgMeta, agentAckCmdId, snd $ broker agentMsgMeta, currentTs, currentTs)
|
||||
msgDeliveryId <- insertedRowId db
|
||||
createMsgDeliveryEvent_ db msgDeliveryId MDSRcvAgent currentTs
|
||||
pure msg
|
||||
|
||||
createNewRcvMessage :: forall e. (MsgEncodingI e) => DB.Connection -> ConnOrGroupId -> NewMessage e -> Maybe SharedMsgId -> Maybe GroupMemberId -> Maybe GroupMemberId -> ExceptT StoreError IO RcvMessage
|
||||
createNewRcvMessage db connOrGroupId NewMessage{chatMsgEvent, msgBody} sharedMsgId_ authorGroupMemberId forwardedByGroupMemberId =
|
||||
case connOrGroupId of
|
||||
ConnectionId connId -> liftIO $ insertRcvMsg (Just connId) Nothing
|
||||
GroupId groupId -> case sharedMsgId_ of
|
||||
Just sharedMsgId -> liftIO (duplicateGroupMsgMemberIds groupId sharedMsgId) >>= \case
|
||||
Just (duplAuthorId, duplFwdMemberId) ->
|
||||
throwError $ SEDuplicateGroupMessage groupId sharedMsgId duplAuthorId duplFwdMemberId
|
||||
Nothing -> liftIO $ insertRcvMsg Nothing $ Just groupId
|
||||
Nothing -> liftIO $ insertRcvMsg Nothing $ Just groupId
|
||||
where
|
||||
duplicateGroupMsgMemberIds :: Int64 -> SharedMsgId -> IO (Maybe (Maybe GroupMemberId, Maybe GroupMemberId))
|
||||
duplicateGroupMsgMemberIds groupId sharedMsgId =
|
||||
maybeFirstRow id
|
||||
$ DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT author_group_member_id, forwarded_by_group_member_id
|
||||
FROM messages
|
||||
WHERE group_id = ? AND shared_msg_id = ? LIMIT 1
|
||||
|]
|
||||
(groupId, sharedMsgId)
|
||||
insertRcvMsg connId_ groupId_ = do
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO messages
|
||||
(msg_sent, chat_msg_event, msg_body, created_at, updated_at, connection_id, group_id, shared_msg_id, author_group_member_id, forwarded_by_group_member_id)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
(MDRcv, toCMEventTag chatMsgEvent, msgBody, currentTs, currentTs, connId_, groupId_, sharedMsgId_, authorGroupMemberId, forwardedByGroupMemberId)
|
||||
msgId <- insertedRowId db
|
||||
pure RcvMessage{msgId, chatMsgEvent = ACME (encoding @e) chatMsgEvent, sharedMsgId_, msgBody, authorGroupMemberId, forwardedByGroupMemberId}
|
||||
|
||||
createSndMsgDeliveryEvent :: DB.Connection -> Int64 -> AgentMsgId -> MsgDeliveryStatus 'MDSnd -> ExceptT StoreError IO ()
|
||||
createSndMsgDeliveryEvent db connId agentMsgId sndMsgDeliveryStatus = do
|
||||
@@ -318,7 +347,7 @@ updateChatTs db User {userId} chatDirection chatTs = case toChatInfo chatDirecti
|
||||
|
||||
createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId
|
||||
createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciContent quotedItem timed live createdAt =
|
||||
createNewChatItem_ db user chatDirection createdByMsgId (Just sharedMsgId) ciContent quoteRow timed live createdAt createdAt
|
||||
createNewChatItem_ db user chatDirection createdByMsgId (Just sharedMsgId) ciContent quoteRow timed live createdAt Nothing createdAt
|
||||
where
|
||||
createdByMsgId = if msgId == 0 then Nothing else Just msgId
|
||||
quoteRow :: NewQuoteRow
|
||||
@@ -333,8 +362,8 @@ createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciCon
|
||||
CIQGroupRcv Nothing -> (Just False, Nothing)
|
||||
|
||||
createNewRcvChatItem :: DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c))
|
||||
createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent} sharedMsgId_ ciContent timed live itemTs createdAt = do
|
||||
ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow timed live itemTs createdAt
|
||||
createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forwardedByGroupMemberId} sharedMsgId_ ciContent timed live itemTs createdAt = do
|
||||
ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow timed live itemTs forwardedByGroupMemberId createdAt
|
||||
quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg
|
||||
pure (ciId, quotedItem)
|
||||
where
|
||||
@@ -349,14 +378,14 @@ createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent} shar
|
||||
(Just $ Just userMemberId == memberId, memberId)
|
||||
|
||||
createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> CIContent d -> UTCTime -> UTCTime -> IO ChatItemId
|
||||
createNewChatItemNoMsg db user chatDirection ciContent =
|
||||
createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow Nothing False
|
||||
createNewChatItemNoMsg db user chatDirection ciContent itemTs =
|
||||
createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow Nothing False itemTs Nothing
|
||||
where
|
||||
quoteRow :: NewQuoteRow
|
||||
quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing)
|
||||
|
||||
createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO ChatItemId
|
||||
createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow timed live itemTs createdAt = do
|
||||
createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CITimed -> Bool -> UTCTime -> Maybe GroupMemberId -> UTCTime -> IO ChatItemId
|
||||
createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow timed live itemTs forwardedByGroupMemberId createdAt = do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
@@ -364,18 +393,18 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
|
||||
-- user and IDs
|
||||
user_id, created_by_msg_id, contact_id, group_id, group_member_id,
|
||||
-- meta
|
||||
item_sent, item_ts, item_content, item_text, item_status, shared_msg_id, created_at, updated_at, item_live, timed_ttl, timed_delete_at,
|
||||
item_sent, item_ts, item_content, item_text, item_status, shared_msg_id, forwarded_by_group_member_id, created_at, updated_at, item_live, timed_ttl, timed_delete_at,
|
||||
-- quote
|
||||
quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
((userId, msgId_) :. idsRow :. itemRow :. quoteRow)
|
||||
ciId <- insertedRowId db
|
||||
forM_ msgId_ $ \msgId -> insertChatItemMessage_ db ciId msgId createdAt
|
||||
pure ciId
|
||||
where
|
||||
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, CIStatus d, Maybe SharedMsgId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime)
|
||||
itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed
|
||||
itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, CIStatus d, Maybe SharedMsgId, Maybe GroupMemberId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime)
|
||||
itemRow = (msgDirection @d, itemTs, ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId, forwardedByGroupMemberId) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed
|
||||
idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64)
|
||||
idsRow = case chatDirection of
|
||||
CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing)
|
||||
@@ -436,8 +465,8 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
|
||||
[sql|
|
||||
SELECT i.chat_item_id,
|
||||
-- GroupMember
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
|
||||
m.member_status, m.show_messages, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
|
||||
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.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
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
@@ -552,8 +581,8 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
|
||||
-- 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,
|
||||
-- GroupMember - membership
|
||||
mu.group_member_id, mu.group_id, mu.member_id, mu.member_role, mu.member_category,
|
||||
mu.member_status, mu.show_messages, mu.invited_by, mu.local_display_name, mu.contact_id, mu.contact_profile_id, pu.contact_profile_id,
|
||||
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.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,
|
||||
-- ChatStats
|
||||
COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), g.unread_chat,
|
||||
@@ -561,19 +590,21 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
||||
-- CIMeta forwardedByGroupMemberId
|
||||
i.forwarded_by_group_member_id,
|
||||
-- Maybe GroupMember - sender
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
|
||||
m.member_status, m.show_messages, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
|
||||
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.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,
|
||||
-- quoted ChatItem
|
||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
|
||||
-- quoted GroupMember
|
||||
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category,
|
||||
rm.member_status, rm.show_messages, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
|
||||
rm.group_member_id, rm.group_id, rm.member_id, rm.peer_chat_min_version, rm.peer_chat_max_version, rm.member_role, rm.member_category,
|
||||
rm.member_status, rm.show_messages, rm.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
|
||||
rp.display_name, rp.full_name, rp.image, rp.contact_link, rp.local_alias, rp.preferences,
|
||||
-- deleted by GroupMember
|
||||
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.member_role, dbm.member_category,
|
||||
dbm.member_status, dbm.show_messages, dbm.invited_by, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
|
||||
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.peer_chat_min_version, dbm.peer_chat_max_version, dbm.member_role, dbm.member_category,
|
||||
dbm.member_status, dbm.show_messages, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
|
||||
dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences
|
||||
FROM groups g
|
||||
JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id
|
||||
@@ -1016,7 +1047,7 @@ toDirectChatItem currentTs (((itemId, itemTs, AMsgDirection msgDir, itemContentT
|
||||
DBCINotDeleted -> Nothing
|
||||
_ -> Just (CIDeleted @'CTDirect deletedTs)
|
||||
itemEdited' = fromMaybe False itemEdited
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs createdAt updatedAt
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
@@ -1027,7 +1058,7 @@ toDirectChatItemList _ _ = []
|
||||
|
||||
type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow
|
||||
|
||||
type MaybeGroupChatItemRow = MaybeChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow
|
||||
type MaybeGroupChatItemRow = MaybeChatItemRow :. Only (Maybe GroupMemberId) :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow
|
||||
|
||||
toGroupQuote :: QuoteRow -> Maybe GroupMember -> Maybe (CIQuote 'CTGroup)
|
||||
toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction quotedSent quotedMember_
|
||||
@@ -1038,8 +1069,8 @@ toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction
|
||||
direction _ _ = Nothing
|
||||
|
||||
-- this function can be changed so it never fails, not only avoid failure on invalid json
|
||||
toGroupChatItem :: UTCTime -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup)
|
||||
toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
|
||||
toGroupChatItem :: UTCTime -> Int64 -> ChatItemRow :. Only (Maybe GroupMemberId) :. MaybeGroupMemberRow :. GroupQuoteRow :. MaybeGroupMemberRow -> Either StoreError (CChatItem 'CTGroup)
|
||||
toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) :. Only forwardedByGroupMemberId :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) = do
|
||||
chatItem $ fromRight invalid $ dbParseACIContent itemContentText
|
||||
where
|
||||
member_ = toMaybeGroupMember userContactId memberRow_
|
||||
@@ -1075,13 +1106,13 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
|
||||
DBCIBlocked -> Just (CIBlocked @'CTGroup deletedTs)
|
||||
_ -> Just (maybe (CIDeleted @'CTGroup deletedTs) (CIModerated deletedTs) deletedByGroupMember_)
|
||||
itemEdited' = fromMaybe False itemEdited
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs createdAt updatedAt
|
||||
in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs forwardedByGroupMemberId createdAt updatedAt
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
toGroupChatItemList :: UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup]
|
||||
toGroupChatItemList currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) =
|
||||
either (const []) (: []) $ toGroupChatItem currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_)
|
||||
toGroupChatItemList currentTs userContactId (((Just itemId, Just itemTs, Just msgDir, Just itemContent, Just itemText, Just itemStatus, sharedMsgId) :. (Just itemDeleted, deletedTs, itemEdited, Just createdAt, Just updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. forwardedByGroupMemberId :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_) =
|
||||
either (const []) (: []) $ toGroupChatItem currentTs userContactId (((itemId, itemTs, msgDir, itemContent, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. forwardedByGroupMemberId :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_)
|
||||
toGroupChatItemList _ _ _ = []
|
||||
|
||||
getAllChatItems :: DB.Connection -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem]
|
||||
@@ -1525,19 +1556,21 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do
|
||||
i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live,
|
||||
-- CIFile
|
||||
f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol,
|
||||
-- CIMeta forwardedByGroupMemberId
|
||||
i.forwarded_by_group_member_id,
|
||||
-- GroupMember
|
||||
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category,
|
||||
m.member_status, m.show_messages, m.invited_by, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id,
|
||||
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.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,
|
||||
-- quoted ChatItem
|
||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent,
|
||||
-- quoted GroupMember
|
||||
rm.group_member_id, rm.group_id, rm.member_id, rm.member_role, rm.member_category,
|
||||
rm.member_status, rm.show_messages, rm.invited_by, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
|
||||
rm.group_member_id, rm.group_id, rm.member_id, rm.peer_chat_min_version, rm.peer_chat_max_version, rm.member_role, rm.member_category,
|
||||
rm.member_status, rm.show_messages, rm.invited_by, rm.invited_by_group_member_id, rm.local_display_name, rm.contact_id, rm.contact_profile_id, rp.contact_profile_id,
|
||||
rp.display_name, rp.full_name, rp.image, rp.contact_link, rp.local_alias, rp.preferences,
|
||||
-- deleted by GroupMember
|
||||
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.member_role, dbm.member_category,
|
||||
dbm.member_status, dbm.show_messages, dbm.invited_by, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
|
||||
dbm.group_member_id, dbm.group_id, dbm.member_id, dbm.peer_chat_min_version, dbm.peer_chat_max_version, dbm.member_role, dbm.member_category,
|
||||
dbm.member_status, dbm.show_messages, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id,
|
||||
dbp.display_name, dbp.full_name, dbp.image, dbp.contact_link, dbp.local_alias, dbp.preferences
|
||||
FROM chat_items i
|
||||
LEFT JOIN files f ON f.chat_item_id = i.chat_item_id
|
||||
|
||||
@@ -88,6 +88,7 @@ import Simplex.Chat.Migrations.M20231010_member_settings
|
||||
import Simplex.Chat.Migrations.M20231019_indexes
|
||||
import Simplex.Chat.Migrations.M20231030_xgrplinkmem_received
|
||||
import Simplex.Chat.Migrations.M20231107_indexes
|
||||
import Simplex.Chat.Migrations.M20231113_group_forward
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@@ -175,7 +176,8 @@ schemaMigrations =
|
||||
("20231010_member_settings", m20231010_member_settings, Just down_m20231010_member_settings),
|
||||
("20231019_indexes", m20231019_indexes, Just down_m20231019_indexes),
|
||||
("20231030_xgrplinkmem_received", m20231030_xgrplinkmem_received, Just down_m20231030_xgrplinkmem_received),
|
||||
("20231107_indexes", m20231107_indexes, Just down_m20231107_indexes)
|
||||
("20231107_indexes", m20231107_indexes, Just down_m20231107_indexes),
|
||||
("20231113_group_forward", m20231113_group_forward, Just down_m20231113_group_forward)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -98,6 +98,7 @@ data StoreError
|
||||
| SEHostMemberIdNotFound {groupId :: Int64}
|
||||
| SEContactNotFoundByFileId {fileId :: FileTransferId}
|
||||
| SENoGroupSndStatus {itemId :: ChatItemId, groupMemberId :: GroupMemberId}
|
||||
| SEDuplicateGroupMessage {groupId :: Int64, sharedMsgId :: SharedMsgId, authorGroupMemberId :: Maybe GroupMemberId, forwardedByGroupMemberId :: Maybe GroupMemberId}
|
||||
deriving (Show, Exception, Generic)
|
||||
|
||||
instance ToJSON StoreError where
|
||||
@@ -204,6 +205,17 @@ setPeerChatVRange db connId (VersionRange minVer maxVer) =
|
||||
|]
|
||||
(minVer, maxVer, connId)
|
||||
|
||||
setMemberChatVRange :: DB.Connection -> GroupMemberId -> VersionRange -> IO ()
|
||||
setMemberChatVRange db mId (VersionRange minVer maxVer) =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE group_members
|
||||
SET peer_chat_min_version = ?, peer_chat_max_version = ?
|
||||
WHERE group_member_id = ?
|
||||
|]
|
||||
(minVer, maxVer, mId)
|
||||
|
||||
setCommandConnId :: DB.Connection -> User -> CommandId -> Int64 -> IO ()
|
||||
setCommandConnId db User {userId} cmdId connId = do
|
||||
updatedAt <- getCurrentTime
|
||||
|
||||
Reference in New Issue
Block a user