mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-06-28 12:19:54 +00:00
1074 lines
52 KiB
Haskell
1074 lines
52 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE QuasiQuotes #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE TupleSections #-}
|
|
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
|
|
|
module Simplex.Chat.Store.Direct
|
|
( updateContactLDN_,
|
|
updateContactProfile_,
|
|
updateContactProfile_',
|
|
updateMemberContactProfileReset_',
|
|
updateMemberContactProfileReset_,
|
|
updateMemberContactProfile_,
|
|
updateMemberContactProfile_',
|
|
deleteContactProfile_,
|
|
deleteUnusedProfile_,
|
|
|
|
-- * Contacts and connections functions
|
|
getPendingContactConnection,
|
|
deletePendingContactConnection,
|
|
createDirectConnection,
|
|
createIncognitoProfile,
|
|
createConnReqConnection,
|
|
createAddressContactConnection,
|
|
getProfileById,
|
|
getConnReqContactXContactId,
|
|
getContactByConnReqHash,
|
|
createDirectContact,
|
|
deleteContactConnections,
|
|
deleteContactFiles,
|
|
deleteContact,
|
|
deleteContactWithoutGroups,
|
|
getDeletedContacts,
|
|
getContactByName,
|
|
getContact,
|
|
getContactIdByName,
|
|
updateContactProfile,
|
|
updateContactUserPreferences,
|
|
updateContactAlias,
|
|
updateContactConnectionAlias,
|
|
updatePCCIncognito,
|
|
deletePCCIncognitoProfile,
|
|
updateContactUnreadChat,
|
|
setUserChatsRead,
|
|
updateContactStatus,
|
|
updateGroupUnreadChat,
|
|
setConnectionVerified,
|
|
incAuthErrCounter,
|
|
setAuthErrCounter,
|
|
incQuotaErrCounter,
|
|
setQuotaErrCounter,
|
|
getUserContacts,
|
|
createOrUpdateContactRequest,
|
|
getUserContactLinkIdByCReq,
|
|
getContactRequest',
|
|
getContactRequest,
|
|
getContactRequestIdByName,
|
|
deleteContactRequest,
|
|
createAcceptedContact,
|
|
deleteContactRequestRec,
|
|
updateContactAccepted,
|
|
getUserByContactRequestId,
|
|
getPendingContactConnections,
|
|
getContactConnections,
|
|
getConnectionById,
|
|
getConnectionsContacts,
|
|
updateConnectionStatus,
|
|
updateConnectionStatusFromTo,
|
|
updateContactSettings,
|
|
setConnConnReqInv,
|
|
resetContactConnInitiated,
|
|
setContactCustomData,
|
|
setContactUIThemes,
|
|
setContactChatDeleted,
|
|
getDirectChatTags,
|
|
updateDirectChatTags,
|
|
setDirectChatTTL,
|
|
getDirectChatTTL,
|
|
getUserContactsToExpire
|
|
)
|
|
where
|
|
|
|
import Control.Monad
|
|
import Control.Monad.Except
|
|
import Control.Monad.IO.Class
|
|
import Data.Either (rights)
|
|
import Data.Functor (($>))
|
|
import Data.Int (Int64)
|
|
import Data.Maybe (fromMaybe, isJust, isNothing)
|
|
import Data.Text (Text)
|
|
import Data.Time.Clock (UTCTime (..), getCurrentTime)
|
|
import Simplex.Chat.Messages
|
|
import Simplex.Chat.Store.Shared
|
|
import Simplex.Chat.Types
|
|
import Simplex.Chat.Types.Preferences
|
|
import Simplex.Chat.Types.UITheme
|
|
import Simplex.Messaging.Agent.Protocol (ConnId, CreatedConnLink (..), InvitationId, UserId)
|
|
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, maybeFirstRow)
|
|
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..))
|
|
import qualified Simplex.Messaging.Agent.Store.DB as DB
|
|
import Simplex.Messaging.Crypto.Ratchet (PQSupport)
|
|
import Simplex.Messaging.Protocol (SubscriptionMode (..))
|
|
import Simplex.Messaging.Util ((<$$>))
|
|
import Simplex.Messaging.Version
|
|
#if defined(dbPostgres)
|
|
import Database.PostgreSQL.Simple (Only (..), (:.) (..))
|
|
import Database.PostgreSQL.Simple.SqlQQ (sql)
|
|
#else
|
|
import Database.SQLite.Simple (Only (..), (:.) (..))
|
|
import Database.SQLite.Simple.QQ (sql)
|
|
#endif
|
|
|
|
getPendingContactConnection :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO PendingContactConnection
|
|
getPendingContactConnection db userId connId = do
|
|
ExceptT . firstRow toPendingContactConnection (SEPendingConnectionNotFound connId) $
|
|
DB.query
|
|
db
|
|
[sql|
|
|
SELECT connection_id, agent_conn_id, conn_status, via_contact_uri_hash, via_user_contact_link, group_link_id, custom_user_profile_id, conn_req_inv, short_link_inv, local_alias, created_at, updated_at
|
|
FROM connections
|
|
WHERE user_id = ?
|
|
AND connection_id = ?
|
|
AND conn_type = ?
|
|
AND contact_id IS NULL
|
|
AND conn_level = 0
|
|
AND via_contact IS NULL
|
|
|]
|
|
(userId, connId, ConnContact)
|
|
|
|
deletePendingContactConnection :: DB.Connection -> UserId -> Int64 -> IO ()
|
|
deletePendingContactConnection db userId connId =
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
DELETE FROM connections
|
|
WHERE user_id = ?
|
|
AND connection_id = ?
|
|
AND conn_type = ?
|
|
AND contact_id IS NULL
|
|
AND conn_level = 0
|
|
AND via_contact IS NULL
|
|
|]
|
|
(userId, connId, ConnContact)
|
|
|
|
createAddressContactConnection :: DB.Connection -> VersionRangeChat -> User -> Contact -> ConnId -> ConnReqUriHash -> Maybe ShortLinkContact -> XContactId -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> ExceptT StoreError IO (Int64, Contact)
|
|
createAddressContactConnection db vr user@User {userId} Contact {contactId} acId cReqHash sLnk xContactId incognitoProfile subMode chatV pqSup = do
|
|
PendingContactConnection {pccConnId} <- liftIO $ createConnReqConnection db userId acId cReqHash sLnk xContactId incognitoProfile Nothing subMode chatV pqSup
|
|
liftIO $ DB.execute db "UPDATE connections SET contact_id = ? WHERE connection_id = ?" (contactId, pccConnId)
|
|
(pccConnId,) <$> getContact db vr user contactId
|
|
|
|
createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> Maybe ShortLinkContact -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection
|
|
createConnReqConnection db userId acId cReqHash sLnk xContactId incognitoProfile groupLinkId subMode chatV pqSup = do
|
|
createdAt <- getCurrentTime
|
|
customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile
|
|
let pccConnStatus = ConnJoined
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
INSERT INTO connections (
|
|
user_id, agent_conn_id, conn_status, conn_type, contact_conn_initiated,
|
|
via_contact_uri_hash, via_short_link_contact, xcontact_id, custom_user_profile_id, via_group_link, group_link_id,
|
|
created_at, updated_at, to_subscribe, conn_chat_version, pq_support, pq_encryption
|
|
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
|
|]
|
|
( (userId, acId, pccConnStatus, ConnContact, BI True, cReqHash, sLnk, xContactId)
|
|
:. (customUserProfileId, BI (isJust groupLinkId), groupLinkId)
|
|
:. (createdAt, createdAt, BI (subMode == SMOnlyCreate), chatV, pqSup, pqSup)
|
|
)
|
|
pccConnId <- insertedRowId db
|
|
pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = True, viaUserContactLink = Nothing, groupLinkId, customUserProfileId, connLinkInv = Nothing, localAlias = "", createdAt, updatedAt = createdAt}
|
|
|
|
getConnReqContactXContactId :: DB.Connection -> VersionRangeChat -> User -> ConnReqUriHash -> IO (Maybe Contact, Maybe XContactId)
|
|
getConnReqContactXContactId db vr user@User {userId} cReqHash = do
|
|
getContactByConnReqHash db vr user cReqHash >>= \case
|
|
c@(Just _) -> pure (c, Nothing)
|
|
Nothing -> (Nothing,) <$> getXContactId
|
|
where
|
|
getXContactId :: IO (Maybe XContactId)
|
|
getXContactId =
|
|
maybeFirstRow fromOnly $
|
|
DB.query
|
|
db
|
|
"SELECT xcontact_id FROM connections WHERE user_id = ? AND via_contact_uri_hash = ? LIMIT 1"
|
|
(userId, cReqHash)
|
|
|
|
getContactByConnReqHash :: DB.Connection -> VersionRangeChat -> User -> ConnReqUriHash -> IO (Maybe Contact)
|
|
getContactByConnReqHash db vr user@User {userId} cReqHash = do
|
|
ct_ <-
|
|
maybeFirstRow (toContact vr user []) $
|
|
DB.query
|
|
db
|
|
[sql|
|
|
SELECT
|
|
-- Contact
|
|
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
|
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
|
|
-- Connection
|
|
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 contacts ct
|
|
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
|
|
JOIN connections c ON c.contact_id = ct.contact_id
|
|
WHERE c.user_id = ? AND c.via_contact_uri_hash = ? AND ct.contact_status = ? AND ct.deleted = 0
|
|
ORDER BY c.created_at DESC
|
|
LIMIT 1
|
|
|]
|
|
(userId, cReqHash, CSActive)
|
|
mapM (addDirectChatTags db) ct_
|
|
|
|
createDirectConnection :: DB.Connection -> User -> ConnId -> CreatedLinkInvitation -> ConnStatus -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection
|
|
createDirectConnection db User {userId} acId ccLink@(CCLink cReq shortLinkInv) pccConnStatus incognitoProfile subMode chatV pqSup = do
|
|
createdAt <- getCurrentTime
|
|
customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile
|
|
let contactConnInitiated = pccConnStatus == ConnNew
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
INSERT INTO connections
|
|
(user_id, agent_conn_id, conn_req_inv, short_link_inv, conn_status, conn_type, contact_conn_initiated, custom_user_profile_id,
|
|
created_at, updated_at, to_subscribe, conn_chat_version, pq_support, pq_encryption)
|
|
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
|
|]
|
|
( (userId, acId, cReq, shortLinkInv, pccConnStatus, ConnContact, BI contactConnInitiated, customUserProfileId)
|
|
:. (createdAt, createdAt, BI (subMode == SMOnlyCreate), chatV, pqSup, pqSup)
|
|
)
|
|
pccConnId <- insertedRowId db
|
|
pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = False, viaUserContactLink = Nothing, groupLinkId = Nothing, customUserProfileId, connLinkInv = Just ccLink, localAlias = "", createdAt, updatedAt = createdAt}
|
|
|
|
createIncognitoProfile :: DB.Connection -> User -> Profile -> IO Int64
|
|
createIncognitoProfile db User {userId} p = do
|
|
createdAt <- getCurrentTime
|
|
createIncognitoProfile_ db userId createdAt p
|
|
|
|
createDirectContact :: DB.Connection -> User -> Connection -> Profile -> ExceptT StoreError IO Contact
|
|
createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p@Profile {preferences} = do
|
|
currentTs <- liftIO getCurrentTime
|
|
(localDisplayName, contactId, profileId) <- createContact_ db userId p localAlias Nothing currentTs
|
|
liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, connId)
|
|
let profile = toLocalProfile profileId p localAlias
|
|
userPreferences = emptyChatPrefs
|
|
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
|
|
pure $
|
|
Contact
|
|
{ contactId,
|
|
localDisplayName,
|
|
profile,
|
|
activeConn = Just conn,
|
|
viaGroup = Nothing,
|
|
contactUsed = True,
|
|
contactStatus = CSActive,
|
|
chatSettings = defaultChatSettings,
|
|
userPreferences,
|
|
mergedPreferences,
|
|
createdAt = currentTs,
|
|
updatedAt = currentTs,
|
|
chatTs = Just currentTs,
|
|
contactGroupMemberId = Nothing,
|
|
contactGrpInvSent = False,
|
|
chatTags = [],
|
|
chatItemTTL = Nothing,
|
|
uiThemes = Nothing,
|
|
chatDeleted = False,
|
|
customData = Nothing
|
|
}
|
|
|
|
deleteContactConnections :: DB.Connection -> User -> Contact -> IO ()
|
|
deleteContactConnections db User {userId} Contact {contactId} = do
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
DELETE FROM connections WHERE connection_id IN (
|
|
SELECT connection_id
|
|
FROM connections c
|
|
JOIN contacts ct ON ct.contact_id = c.contact_id
|
|
WHERE ct.user_id = ? AND ct.contact_id = ?
|
|
)
|
|
|]
|
|
(userId, contactId)
|
|
|
|
deleteContactFiles :: DB.Connection -> User -> Contact -> IO ()
|
|
deleteContactFiles db User {userId} Contact {contactId} = do
|
|
DB.execute db "DELETE FROM files WHERE user_id = ? AND contact_id = ?" (userId, contactId)
|
|
|
|
deleteContact :: DB.Connection -> User -> Contact -> ExceptT StoreError IO ()
|
|
deleteContact db user@User {userId} ct@Contact {contactId, localDisplayName, activeConn} = do
|
|
assertNotUser db user ct
|
|
liftIO $ do
|
|
DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (userId, contactId)
|
|
ctMember :: (Maybe ContactId) <- maybeFirstRow fromOnly $ DB.query db "SELECT contact_id FROM group_members WHERE contact_id = ? LIMIT 1" (Only contactId)
|
|
if isNothing ctMember
|
|
then do
|
|
deleteContactProfile_ db userId contactId
|
|
-- user's local display name already checked in assertNotUser
|
|
DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
|
|
else do
|
|
currentTs <- getCurrentTime
|
|
DB.execute db "UPDATE group_members SET contact_id = NULL, updated_at = ? WHERE user_id = ? AND contact_id = ?" (currentTs, userId, contactId)
|
|
DB.execute db "DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId)
|
|
forM_ activeConn $ \Connection {customUserProfileId} ->
|
|
forM_ customUserProfileId $ \profileId ->
|
|
deleteUnusedIncognitoProfileById_ db user profileId
|
|
|
|
-- should only be used if contact is not member of any groups
|
|
deleteContactWithoutGroups :: DB.Connection -> User -> Contact -> ExceptT StoreError IO ()
|
|
deleteContactWithoutGroups db user@User {userId} ct@Contact {contactId, localDisplayName, activeConn} = do
|
|
assertNotUser db user ct
|
|
liftIO $ do
|
|
DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (userId, contactId)
|
|
deleteContactProfile_ db userId contactId
|
|
-- user's local display name already checked in assertNotUser
|
|
DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
|
|
DB.execute db "DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId)
|
|
forM_ activeConn $ \Connection {customUserProfileId} ->
|
|
forM_ customUserProfileId $ \profileId ->
|
|
deleteUnusedIncognitoProfileById_ db user profileId
|
|
|
|
-- TODO remove in future versions: only used for legacy contact cleanup
|
|
getDeletedContacts :: DB.Connection -> VersionRangeChat -> User -> IO [Contact]
|
|
getDeletedContacts db vr user@User {userId} = do
|
|
contactIds <- map fromOnly <$> DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND deleted = 1" (Only userId)
|
|
rights <$> mapM (runExceptT . getDeletedContact db vr user) contactIds
|
|
|
|
getDeletedContact :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Contact
|
|
getDeletedContact db vr user contactId = getContact_ db vr user contactId True
|
|
|
|
deleteContactProfile_ :: DB.Connection -> UserId -> ContactId -> IO ()
|
|
deleteContactProfile_ db userId contactId =
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
DELETE FROM contact_profiles
|
|
WHERE contact_profile_id in (
|
|
SELECT contact_profile_id
|
|
FROM contacts
|
|
WHERE user_id = ? AND contact_id = ?
|
|
)
|
|
|]
|
|
(userId, contactId)
|
|
|
|
deleteUnusedProfile_ :: DB.Connection -> UserId -> ProfileId -> IO ()
|
|
deleteUnusedProfile_ db userId profileId =
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
DELETE FROM contact_profiles
|
|
WHERE user_id = ? AND contact_profile_id = ?
|
|
AND 1 NOT IN (
|
|
SELECT 1 FROM connections
|
|
WHERE user_id = ? AND custom_user_profile_id = ? LIMIT 1
|
|
)
|
|
AND 1 NOT IN (
|
|
SELECT 1 FROM contacts
|
|
WHERE user_id = ? AND contact_profile_id = ? LIMIT 1
|
|
)
|
|
AND 1 NOT IN (
|
|
SELECT 1 FROM contact_requests
|
|
WHERE user_id = ? AND contact_profile_id = ? LIMIT 1
|
|
)
|
|
AND 1 NOT IN (
|
|
SELECT 1 FROM group_members
|
|
WHERE user_id = ?
|
|
AND (member_profile_id = ? OR contact_profile_id = ?)
|
|
LIMIT 1
|
|
)
|
|
|]
|
|
( (userId, profileId, userId, profileId, userId, profileId)
|
|
:. (userId, profileId, userId, profileId, profileId)
|
|
)
|
|
|
|
updateContactProfile :: DB.Connection -> User -> Contact -> Profile -> ExceptT StoreError IO Contact
|
|
updateContactProfile db user@User {userId} c p'
|
|
| displayName == newName = do
|
|
liftIO $ updateContactProfile_ db userId profileId p'
|
|
pure c {profile, mergedPreferences}
|
|
| otherwise =
|
|
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
|
|
currentTs <- getCurrentTime
|
|
updateContactProfile_' db userId profileId p' currentTs
|
|
updateContactLDN_ db user contactId localDisplayName ldn currentTs
|
|
pure $ Right c {localDisplayName = ldn, profile, mergedPreferences}
|
|
where
|
|
Contact {contactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias}, userPreferences} = c
|
|
Profile {displayName = newName, preferences} = p'
|
|
profile = toLocalProfile profileId p' localAlias
|
|
mergedPreferences = contactUserPreferences user userPreferences preferences $ contactConnIncognito c
|
|
|
|
updateContactUserPreferences :: DB.Connection -> User -> Contact -> Preferences -> IO Contact
|
|
updateContactUserPreferences db user@User {userId} c@Contact {contactId} userPreferences = do
|
|
updatedAt <- getCurrentTime
|
|
DB.execute
|
|
db
|
|
"UPDATE contacts SET user_preferences = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?"
|
|
(userPreferences, updatedAt, userId, contactId)
|
|
let mergedPreferences = contactUserPreferences user userPreferences (preferences' c) $ contactConnIncognito c
|
|
pure $ c {mergedPreferences, userPreferences}
|
|
|
|
updateContactAlias :: DB.Connection -> UserId -> Contact -> LocalAlias -> IO Contact
|
|
updateContactAlias db userId c@Contact {profile = lp@LocalProfile {profileId}} localAlias = do
|
|
updatedAt <- getCurrentTime
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
UPDATE contact_profiles
|
|
SET local_alias = ?, updated_at = ?
|
|
WHERE user_id = ? AND contact_profile_id = ?
|
|
|]
|
|
(localAlias, updatedAt, userId, profileId)
|
|
pure $ (c :: Contact) {profile = lp {localAlias}}
|
|
|
|
updateContactConnectionAlias :: DB.Connection -> UserId -> PendingContactConnection -> LocalAlias -> IO PendingContactConnection
|
|
updateContactConnectionAlias db userId conn localAlias = do
|
|
updatedAt <- getCurrentTime
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
UPDATE connections
|
|
SET local_alias = ?, updated_at = ?
|
|
WHERE user_id = ? AND connection_id = ?
|
|
|]
|
|
(localAlias, updatedAt, userId, pccConnId conn)
|
|
pure (conn :: PendingContactConnection) {localAlias, updatedAt}
|
|
|
|
updatePCCIncognito :: DB.Connection -> User -> PendingContactConnection -> Maybe ProfileId -> IO PendingContactConnection
|
|
updatePCCIncognito db User {userId} conn customUserProfileId = do
|
|
updatedAt <- getCurrentTime
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
UPDATE connections
|
|
SET custom_user_profile_id = ?, updated_at = ?
|
|
WHERE user_id = ? AND connection_id = ?
|
|
|]
|
|
(customUserProfileId, updatedAt, userId, pccConnId conn)
|
|
pure (conn :: PendingContactConnection) {customUserProfileId, updatedAt}
|
|
|
|
deletePCCIncognitoProfile :: DB.Connection -> User -> ProfileId -> IO ()
|
|
deletePCCIncognitoProfile db User {userId} profileId =
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
DELETE FROM contact_profiles
|
|
WHERE user_id = ? AND contact_profile_id = ? AND incognito = 1
|
|
|]
|
|
(userId, profileId)
|
|
|
|
updateContactUnreadChat :: DB.Connection -> User -> Contact -> Bool -> IO ()
|
|
updateContactUnreadChat db User {userId} Contact {contactId} unreadChat = do
|
|
updatedAt <- getCurrentTime
|
|
DB.execute db "UPDATE contacts SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (BI unreadChat, updatedAt, userId, contactId)
|
|
|
|
setUserChatsRead :: DB.Connection -> User -> IO ()
|
|
setUserChatsRead db User {userId} = do
|
|
updatedAt <- getCurrentTime
|
|
DB.execute db "UPDATE contacts SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (BI False, updatedAt, userId, BI True)
|
|
DB.execute db "UPDATE groups SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (BI False, updatedAt, userId, BI True)
|
|
DB.execute db "UPDATE note_folders SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (BI False, updatedAt, userId, BI True)
|
|
DB.execute db "UPDATE chat_items SET item_status = ?, updated_at = ? WHERE user_id = ? AND item_status = ?" (CISRcvRead, updatedAt, userId, CISRcvNew)
|
|
|
|
updateContactStatus :: DB.Connection -> User -> Contact -> ContactStatus -> IO Contact
|
|
updateContactStatus db User {userId} ct@Contact {contactId} contactStatus = do
|
|
currentTs <- getCurrentTime
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
UPDATE contacts
|
|
SET contact_status = ?, updated_at = ?
|
|
WHERE user_id = ? AND contact_id = ?
|
|
|]
|
|
(contactStatus, currentTs, userId, contactId)
|
|
pure ct {contactStatus}
|
|
|
|
updateGroupUnreadChat :: DB.Connection -> User -> GroupInfo -> Bool -> IO ()
|
|
updateGroupUnreadChat db User {userId} GroupInfo {groupId} unreadChat = do
|
|
updatedAt <- getCurrentTime
|
|
DB.execute db "UPDATE groups SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND group_id = ?" (BI unreadChat, updatedAt, userId, groupId)
|
|
|
|
setConnectionVerified :: DB.Connection -> User -> Int64 -> Maybe Text -> IO ()
|
|
setConnectionVerified db User {userId} connId code = do
|
|
updatedAt <- getCurrentTime
|
|
DB.execute db "UPDATE connections SET security_code = ?, security_code_verified_at = ?, updated_at = ? WHERE user_id = ? AND connection_id = ?" (code, code $> updatedAt, updatedAt, userId, connId)
|
|
|
|
incAuthErrCounter :: DB.Connection -> User -> Connection -> IO Int
|
|
incAuthErrCounter db User {userId} Connection {connId, authErrCounter} = do
|
|
updatedAt <- getCurrentTime
|
|
(counter_ :: Maybe Int) <- maybeFirstRow fromOnly $ DB.query db "SELECT auth_err_counter FROM connections WHERE user_id = ? AND connection_id = ?" (userId, connId)
|
|
let counter' = fromMaybe authErrCounter counter_ + 1
|
|
DB.execute db "UPDATE connections SET auth_err_counter = ?, updated_at = ? WHERE user_id = ? AND connection_id = ?" (counter', updatedAt, userId, connId)
|
|
pure counter'
|
|
|
|
setAuthErrCounter :: DB.Connection -> User -> Connection -> Int -> IO ()
|
|
setAuthErrCounter db User {userId} Connection {connId} counter = do
|
|
updatedAt <- getCurrentTime
|
|
DB.execute db "UPDATE connections SET auth_err_counter = ?, updated_at = ? WHERE user_id = ? AND connection_id = ?" (counter, updatedAt, userId, connId)
|
|
|
|
incQuotaErrCounter :: DB.Connection -> User -> Connection -> IO Int
|
|
incQuotaErrCounter db User {userId} Connection {connId, quotaErrCounter} = do
|
|
updatedAt <- getCurrentTime
|
|
(counter_ :: Maybe Int) <- maybeFirstRow fromOnly $ DB.query db "SELECT quota_err_counter FROM connections WHERE user_id = ? AND connection_id = ?" (userId, connId)
|
|
let counter' = fromMaybe quotaErrCounter counter_ + 1
|
|
DB.execute db "UPDATE connections SET quota_err_counter = ?, updated_at = ? WHERE user_id = ? AND connection_id = ?" (counter', updatedAt, userId, connId)
|
|
pure counter'
|
|
|
|
setQuotaErrCounter :: DB.Connection -> User -> Connection -> Int -> IO ()
|
|
setQuotaErrCounter db User {userId} Connection {connId} counter = do
|
|
updatedAt <- getCurrentTime
|
|
DB.execute db "UPDATE connections SET quota_err_counter = ?, updated_at = ? WHERE user_id = ? AND connection_id = ?" (counter, updatedAt, userId, connId)
|
|
|
|
updateContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> IO ()
|
|
updateContactProfile_ db userId profileId profile = do
|
|
currentTs <- getCurrentTime
|
|
updateContactProfile_' db userId profileId profile currentTs
|
|
|
|
updateContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> UTCTime -> IO ()
|
|
updateContactProfile_' db userId profileId Profile {displayName, fullName, image, contactLink, preferences} updatedAt = do
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
UPDATE contact_profiles
|
|
SET display_name = ?, full_name = ?, image = ?, contact_link = ?, preferences = ?, updated_at = ?
|
|
WHERE user_id = ? AND contact_profile_id = ?
|
|
|]
|
|
(displayName, fullName, image, contactLink, preferences, updatedAt, userId, profileId)
|
|
|
|
-- update only member profile fields (when member doesn't have associated contact - we can reset contactLink and prefs)
|
|
updateMemberContactProfileReset_ :: DB.Connection -> UserId -> ProfileId -> Profile -> IO ()
|
|
updateMemberContactProfileReset_ db userId profileId profile = do
|
|
currentTs <- getCurrentTime
|
|
updateMemberContactProfileReset_' db userId profileId profile currentTs
|
|
|
|
updateMemberContactProfileReset_' :: DB.Connection -> UserId -> ProfileId -> Profile -> UTCTime -> IO ()
|
|
updateMemberContactProfileReset_' db userId profileId Profile {displayName, fullName, image} updatedAt = do
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
UPDATE contact_profiles
|
|
SET display_name = ?, full_name = ?, image = ?, contact_link = NULL, preferences = NULL, updated_at = ?
|
|
WHERE user_id = ? AND contact_profile_id = ?
|
|
|]
|
|
(displayName, fullName, image, updatedAt, userId, profileId)
|
|
|
|
-- update only member profile fields (when member has associated contact - we keep contactLink and prefs)
|
|
updateMemberContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> IO ()
|
|
updateMemberContactProfile_ db userId profileId profile = do
|
|
currentTs <- getCurrentTime
|
|
updateMemberContactProfile_' db userId profileId profile currentTs
|
|
|
|
updateMemberContactProfile_' :: DB.Connection -> UserId -> ProfileId -> Profile -> UTCTime -> IO ()
|
|
updateMemberContactProfile_' db userId profileId Profile {displayName, fullName, image} updatedAt = do
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
UPDATE contact_profiles
|
|
SET display_name = ?, full_name = ?, image = ?, updated_at = ?
|
|
WHERE user_id = ? AND contact_profile_id = ?
|
|
|]
|
|
(displayName, fullName, image, updatedAt, userId, profileId)
|
|
|
|
updateContactLDN_ :: DB.Connection -> User -> Int64 -> ContactName -> ContactName -> UTCTime -> IO ()
|
|
updateContactLDN_ db user@User {userId} contactId displayName newName updatedAt = do
|
|
DB.execute
|
|
db
|
|
"UPDATE contacts SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?"
|
|
(newName, updatedAt, userId, contactId)
|
|
DB.execute
|
|
db
|
|
"UPDATE group_members SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?"
|
|
(newName, updatedAt, userId, contactId)
|
|
safeDeleteLDN db user displayName
|
|
|
|
getContactByName :: DB.Connection -> VersionRangeChat -> User -> ContactName -> ExceptT StoreError IO Contact
|
|
getContactByName db vr user localDisplayName = do
|
|
cId <- getContactIdByName db user localDisplayName
|
|
getContact db vr user cId
|
|
|
|
getUserContacts :: DB.Connection -> VersionRangeChat -> User -> IO [Contact]
|
|
getUserContacts db vr user@User {userId} = do
|
|
contactIds <- map fromOnly <$> DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND deleted = 0" (Only userId)
|
|
contacts <- rights <$> mapM (runExceptT . getContact db vr user) contactIds
|
|
pure $ filter (\Contact {activeConn} -> isJust activeConn) contacts
|
|
|
|
createOrUpdateContactRequest :: DB.Connection -> VersionRangeChat -> User -> Int64 -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> ExceptT StoreError IO ChatOrRequest
|
|
createOrUpdateContactRequest db vr user@User {userId, userContactId} userContactLinkId invId (VersionRange minV maxV) Profile {displayName, fullName, image, contactLink, preferences} xContactId_ pqSup =
|
|
liftIO (maybeM getContactOrGroup xContactId_) >>= \case
|
|
Just cr -> pure cr
|
|
Nothing -> CORRequest <$> createOrUpdate_
|
|
where
|
|
maybeM = maybe (pure Nothing)
|
|
getContactOrGroup xContactId =
|
|
getContact' xContactId >>= \case
|
|
Just ct -> pure $ Just $ CORContact ct
|
|
Nothing -> CORGroup <$$> getGroupInfo' xContactId
|
|
createOrUpdate_ :: ExceptT StoreError IO UserContactRequest
|
|
createOrUpdate_ = do
|
|
cReqId <-
|
|
ExceptT $
|
|
maybeM getContactRequestByXContactId xContactId_ >>= \case
|
|
Nothing -> createContactRequest
|
|
Just cr@UserContactRequest {contactRequestId} -> updateContactRequest cr $> Right contactRequestId
|
|
getContactRequest db user cReqId
|
|
createContactRequest :: IO (Either StoreError Int64)
|
|
createContactRequest = do
|
|
currentTs <- getCurrentTime
|
|
withLocalDisplayName db userId displayName (fmap Right . createContactRequest_ currentTs)
|
|
where
|
|
createContactRequest_ currentTs ldn = do
|
|
DB.execute
|
|
db
|
|
"INSERT INTO contact_profiles (display_name, full_name, image, contact_link, user_id, preferences, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
|
|
(displayName, fullName, image, contactLink, userId, preferences, currentTs, currentTs)
|
|
profileId <- insertedRowId db
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
INSERT INTO contact_requests
|
|
(user_contact_link_id, agent_invitation_id, peer_chat_min_version, peer_chat_max_version, contact_profile_id, local_display_name, user_id,
|
|
created_at, updated_at, xcontact_id, pq_support)
|
|
VALUES (?,?,?,?,?,?,?,?,?,?,?)
|
|
|]
|
|
( (userContactLinkId, Binary invId, minV, maxV, profileId, ldn, userId)
|
|
:. (currentTs, currentTs, xContactId_, pqSup)
|
|
)
|
|
insertedRowId db
|
|
getContact' :: XContactId -> IO (Maybe Contact)
|
|
getContact' xContactId = do
|
|
ct_ <-
|
|
maybeFirstRow (toContact vr user []) $
|
|
DB.query
|
|
db
|
|
[sql|
|
|
SELECT
|
|
-- Contact
|
|
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
|
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
|
|
-- Connection
|
|
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 contacts ct
|
|
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
|
|
LEFT JOIN connections c ON c.contact_id = ct.contact_id
|
|
WHERE ct.user_id = ? AND ct.xcontact_id = ? AND ct.deleted = 0
|
|
ORDER BY c.created_at DESC
|
|
LIMIT 1
|
|
|]
|
|
(userId, xContactId)
|
|
mapM (addDirectChatTags db) ct_
|
|
getGroupInfo' :: XContactId -> IO (Maybe GroupInfo)
|
|
getGroupInfo' xContactId = do
|
|
g_ <-
|
|
maybeFirstRow (toGroupInfo vr userContactId []) $
|
|
DB.query
|
|
db
|
|
(groupInfoQuery <> " WHERE g.business_xcontact_id = ? AND g.user_id = ? AND mu.contact_id = ?")
|
|
(xContactId, userId, userContactId)
|
|
mapM (addGroupChatTags db) g_
|
|
getContactRequestByXContactId :: XContactId -> IO (Maybe UserContactRequest)
|
|
getContactRequestByXContactId xContactId =
|
|
maybeFirstRow toContactRequest $
|
|
DB.query
|
|
db
|
|
[sql|
|
|
SELECT
|
|
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.contact_id, cr.user_contact_link_id,
|
|
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, cr.pq_support, p.preferences, cr.created_at, cr.updated_at,
|
|
cr.peer_chat_min_version, cr.peer_chat_max_version
|
|
FROM contact_requests cr
|
|
JOIN connections c USING (user_contact_link_id)
|
|
JOIN contact_profiles p USING (contact_profile_id)
|
|
WHERE cr.user_id = ?
|
|
AND cr.xcontact_id = ?
|
|
LIMIT 1
|
|
|]
|
|
(userId, xContactId)
|
|
updateContactRequest :: UserContactRequest -> IO (Either StoreError ())
|
|
updateContactRequest UserContactRequest {contactRequestId = cReqId, localDisplayName = oldLdn, profile = Profile {displayName = oldDisplayName}} = do
|
|
currentTs <- liftIO getCurrentTime
|
|
updateProfile currentTs
|
|
if displayName == oldDisplayName
|
|
then
|
|
Right
|
|
<$> DB.execute
|
|
db
|
|
[sql|
|
|
UPDATE contact_requests
|
|
SET agent_invitation_id = ?, pq_support = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, updated_at = ?
|
|
WHERE user_id = ? AND contact_request_id = ?
|
|
|]
|
|
(Binary invId, pqSup, minV, maxV, currentTs, userId, cReqId)
|
|
else withLocalDisplayName db userId displayName $ \ldn ->
|
|
Right <$> do
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
UPDATE contact_requests
|
|
SET agent_invitation_id = ?, pq_support = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, local_display_name = ?, updated_at = ?
|
|
WHERE user_id = ? AND contact_request_id = ?
|
|
|]
|
|
(Binary invId, pqSup, minV, maxV, ldn, currentTs, userId, cReqId)
|
|
safeDeleteLDN db user oldLdn
|
|
where
|
|
updateProfile currentTs =
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
UPDATE contact_profiles
|
|
SET display_name = ?,
|
|
full_name = ?,
|
|
image = ?,
|
|
contact_link = ?,
|
|
updated_at = ?
|
|
WHERE contact_profile_id IN (
|
|
SELECT contact_profile_id
|
|
FROM contact_requests
|
|
WHERE user_id = ?
|
|
AND contact_request_id = ?
|
|
)
|
|
|]
|
|
(displayName, fullName, image, contactLink, currentTs, userId, cReqId)
|
|
|
|
getUserContactLinkIdByCReq :: DB.Connection -> Int64 -> ExceptT StoreError IO Int64
|
|
getUserContactLinkIdByCReq db contactRequestId =
|
|
ExceptT . firstRow fromOnly (SEContactRequestNotFound contactRequestId) $
|
|
DB.query db "SELECT user_contact_link_id FROM contact_requests WHERE contact_request_id = ?" (Only contactRequestId)
|
|
|
|
getContactRequest' :: DB.Connection -> Int64 -> ExceptT StoreError IO (User, UserContactRequest)
|
|
getContactRequest' db contactRequestId = do
|
|
user <- getUserByContactRequestId db contactRequestId
|
|
(user,) <$> getContactRequest db user contactRequestId
|
|
|
|
getContactRequest :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO UserContactRequest
|
|
getContactRequest db User {userId} contactRequestId =
|
|
ExceptT . firstRow toContactRequest (SEContactRequestNotFound contactRequestId) $
|
|
DB.query
|
|
db
|
|
[sql|
|
|
SELECT
|
|
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.contact_id, cr.user_contact_link_id,
|
|
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, cr.pq_support, p.preferences, cr.created_at, cr.updated_at,
|
|
cr.peer_chat_min_version, cr.peer_chat_max_version
|
|
FROM contact_requests cr
|
|
JOIN connections c USING (user_contact_link_id)
|
|
JOIN contact_profiles p USING (contact_profile_id)
|
|
WHERE cr.user_id = ?
|
|
AND cr.contact_request_id = ?
|
|
|]
|
|
(userId, contactRequestId)
|
|
|
|
getContactRequestIdByName :: DB.Connection -> UserId -> ContactName -> ExceptT StoreError IO Int64
|
|
getContactRequestIdByName db userId cName =
|
|
ExceptT . firstRow fromOnly (SEContactRequestNotFoundByName cName) $
|
|
DB.query db "SELECT contact_request_id FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, cName)
|
|
|
|
deleteContactRequest :: DB.Connection -> User -> Int64 -> IO ()
|
|
deleteContactRequest db User {userId} contactRequestId = do
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
DELETE FROM contact_profiles
|
|
WHERE contact_profile_id in (
|
|
SELECT contact_profile_id
|
|
FROM contact_requests
|
|
WHERE user_id = ? AND contact_request_id = ?
|
|
)
|
|
|]
|
|
(userId, contactRequestId)
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
DELETE FROM display_names
|
|
WHERE user_id = ? AND local_display_name = (
|
|
SELECT local_display_name FROM contact_requests
|
|
WHERE user_id = ? AND contact_request_id = ?
|
|
)
|
|
AND local_display_name NOT IN (SELECT local_display_name FROM users WHERE user_id = ?)
|
|
|]
|
|
(userId, userId, contactRequestId, userId)
|
|
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId)
|
|
|
|
createAcceptedContact :: DB.Connection -> User -> ConnId -> VersionChat -> VersionRangeChat -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> PQSupport -> Bool -> IO (Contact, Connection)
|
|
createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}} agentConnId connChatVersion cReqChatVRange localDisplayName profileId profile userContactLinkId xContactId incognitoProfile subMode pqSup contactUsed = do
|
|
createdAt <- getCurrentTime
|
|
customUserProfileId <- forM incognitoProfile $ \case
|
|
NewIncognito p -> createIncognitoProfile_ db userId createdAt p
|
|
ExistingIncognito LocalProfile {profileId = pId} -> pure pId
|
|
let userPreferences = fromMaybe emptyChatPrefs $ incognitoProfile >> preferences
|
|
DB.execute
|
|
db
|
|
"INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, created_at, updated_at, chat_ts, xcontact_id, contact_used) VALUES (?,?,?,?,?,?,?,?,?,?)"
|
|
(userId, localDisplayName, profileId, BI True, userPreferences, createdAt, createdAt, createdAt, xContactId, BI contactUsed)
|
|
contactId <- insertedRowId db
|
|
DB.execute db "UPDATE contact_requests SET contact_id = ? WHERE user_id = ? AND local_display_name = ?" (contactId, userId, localDisplayName)
|
|
conn <- createConnection_ db userId ConnContact (Just contactId) agentConnId ConnNew connChatVersion cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode pqSup
|
|
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
|
|
ct =
|
|
Contact
|
|
{ contactId,
|
|
localDisplayName,
|
|
profile = toLocalProfile profileId profile "",
|
|
activeConn = Just conn,
|
|
viaGroup = Nothing,
|
|
contactUsed,
|
|
contactStatus = CSActive,
|
|
chatSettings = defaultChatSettings,
|
|
userPreferences,
|
|
mergedPreferences,
|
|
createdAt,
|
|
updatedAt = createdAt,
|
|
chatTs = Just createdAt,
|
|
contactGroupMemberId = Nothing,
|
|
contactGrpInvSent = False,
|
|
chatTags = [],
|
|
chatItemTTL = Nothing,
|
|
uiThemes = Nothing,
|
|
chatDeleted = False,
|
|
customData = Nothing
|
|
}
|
|
pure (ct, conn)
|
|
|
|
deleteContactRequestRec :: DB.Connection -> User -> UserContactRequest -> IO ()
|
|
deleteContactRequestRec db User {userId} UserContactRequest {contactRequestId} =
|
|
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId)
|
|
|
|
updateContactAccepted :: DB.Connection -> User -> Contact -> Bool -> IO ()
|
|
updateContactAccepted db User {userId} Contact {contactId} contactUsed =
|
|
DB.execute
|
|
db
|
|
"UPDATE contacts SET contact_used = ? WHERE user_id = ? AND contact_id = ?"
|
|
(BI contactUsed, userId, contactId)
|
|
|
|
getContactIdByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Int64
|
|
getContactIdByName db User {userId} cName =
|
|
ExceptT . firstRow fromOnly (SEContactNotFoundByName cName) $
|
|
DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND local_display_name = ? AND deleted = 0" (userId, cName)
|
|
|
|
getContact :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Contact
|
|
getContact db vr user contactId = getContact_ db vr user contactId False
|
|
|
|
getContact_ :: DB.Connection -> VersionRangeChat -> User -> Int64 -> Bool -> ExceptT StoreError IO Contact
|
|
getContact_ db vr user@User {userId} contactId deleted = do
|
|
chatTags <- liftIO $ getDirectChatTags db contactId
|
|
ExceptT . firstRow (toContact vr user chatTags) (SEContactNotFound contactId) $
|
|
DB.query
|
|
db
|
|
[sql|
|
|
SELECT
|
|
-- Contact
|
|
ct.contact_id, ct.contact_profile_id, ct.local_display_name, ct.via_group, cp.display_name, cp.full_name, cp.image, cp.contact_link, cp.local_alias, ct.contact_used, ct.contact_status, ct.enable_ntfs, ct.send_rcpts, ct.favorite,
|
|
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data, ct.chat_item_ttl,
|
|
-- Connection
|
|
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 contacts ct
|
|
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
|
|
LEFT JOIN connections c ON c.contact_id = ct.contact_id
|
|
WHERE ct.user_id = ? AND ct.contact_id = ?
|
|
AND ct.deleted = ?
|
|
AND (
|
|
c.connection_id = (
|
|
SELECT cc_connection_id FROM (
|
|
SELECT
|
|
cc.connection_id AS cc_connection_id,
|
|
cc.created_at AS cc_created_at,
|
|
(CASE WHEN cc.conn_status = ? OR cc.conn_status = ? THEN 1 ELSE 0 END) AS cc_conn_status_ord
|
|
FROM connections cc
|
|
WHERE cc.user_id = ct.user_id AND cc.contact_id = ct.contact_id
|
|
ORDER BY cc_conn_status_ord DESC, cc_created_at DESC
|
|
LIMIT 1
|
|
) cc
|
|
)
|
|
OR c.connection_id IS NULL
|
|
)
|
|
|]
|
|
(userId, contactId, BI deleted, ConnReady, ConnSndReady)
|
|
|
|
getUserByContactRequestId :: DB.Connection -> Int64 -> ExceptT StoreError IO User
|
|
getUserByContactRequestId db contactRequestId =
|
|
ExceptT . firstRow toUser (SEUserNotFoundByContactRequestId contactRequestId) $
|
|
DB.query db (userQuery <> " JOIN contact_requests cr ON cr.user_id = u.user_id WHERE cr.contact_request_id = ?") (Only contactRequestId)
|
|
|
|
getPendingContactConnections :: DB.Connection -> User -> IO [PendingContactConnection]
|
|
getPendingContactConnections db User {userId} = do
|
|
map toPendingContactConnection
|
|
<$> DB.query
|
|
db
|
|
[sql|
|
|
SELECT connection_id, agent_conn_id, conn_status, via_contact_uri_hash, via_user_contact_link, group_link_id, custom_user_profile_id, conn_req_inv, short_link_inv, local_alias, created_at, updated_at
|
|
FROM connections
|
|
WHERE user_id = ?
|
|
AND conn_type = ?
|
|
AND contact_id IS NULL
|
|
|]
|
|
(userId, ConnContact)
|
|
|
|
getContactConnections :: DB.Connection -> VersionRangeChat -> UserId -> Contact -> IO [Connection]
|
|
getContactConnections db vr userId Contact {contactId} =
|
|
connections =<< liftIO getConnections_
|
|
where
|
|
getConnections_ =
|
|
DB.query
|
|
db
|
|
[sql|
|
|
SELECT 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 connections c
|
|
JOIN contacts ct ON ct.contact_id = c.contact_id
|
|
WHERE c.user_id = ? AND ct.user_id = ? AND ct.contact_id = ?
|
|
|]
|
|
(userId, userId, contactId)
|
|
connections [] = pure []
|
|
connections rows = pure $ map (toConnection vr) rows
|
|
|
|
getConnectionById :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Connection
|
|
getConnectionById db vr User {userId} connId = ExceptT $ do
|
|
firstRow (toConnection vr) (SEConnectionNotFoundById connId) $
|
|
DB.query
|
|
db
|
|
[sql|
|
|
SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, custom_user_profile_id,
|
|
conn_status, conn_type, contact_conn_initiated, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id,
|
|
created_at, security_code, security_code_verified_at, pq_support, pq_encryption, pq_snd_enabled, pq_rcv_enabled, auth_err_counter, quota_err_counter,
|
|
conn_chat_version, peer_chat_min_version, peer_chat_max_version
|
|
FROM connections
|
|
WHERE user_id = ? AND connection_id = ?
|
|
|]
|
|
(userId, connId)
|
|
|
|
getConnectionsContacts :: DB.Connection -> [ConnId] -> IO [ContactRef]
|
|
getConnectionsContacts db agentConnIds = do
|
|
DB.execute_ db "DROP TABLE IF EXISTS temp_conn_ids"
|
|
#if defined(dbPostgres)
|
|
DB.execute_ db "CREATE TABLE temp_conn_ids (conn_id BYTEA)"
|
|
#else
|
|
DB.execute_ db "CREATE TABLE temp_conn_ids (conn_id BLOB)"
|
|
#endif
|
|
DB.executeMany db "INSERT INTO temp_conn_ids (conn_id) VALUES (?)" $ map Only agentConnIds
|
|
conns <-
|
|
map toContactRef
|
|
<$> DB.query
|
|
db
|
|
[sql|
|
|
SELECT ct.contact_id, c.connection_id, c.agent_conn_id, ct.local_display_name
|
|
FROM contacts ct
|
|
JOIN connections c ON c.contact_id = ct.contact_id
|
|
WHERE c.agent_conn_id IN (SELECT conn_id FROM temp_conn_ids)
|
|
AND c.conn_type = ?
|
|
AND ct.deleted = 0
|
|
|]
|
|
(Only ConnContact)
|
|
DB.execute_ db "DROP TABLE temp_conn_ids"
|
|
pure conns
|
|
where
|
|
toContactRef :: (ContactId, Int64, ConnId, ContactName) -> ContactRef
|
|
toContactRef (contactId, connId, acId, localDisplayName) = ContactRef {contactId, connId, agentConnId = AgentConnId acId, localDisplayName}
|
|
|
|
updateConnectionStatus :: DB.Connection -> Connection -> ConnStatus -> IO ()
|
|
updateConnectionStatus db Connection {connId} = updateConnectionStatus_ db connId
|
|
{-# INLINE updateConnectionStatus #-}
|
|
|
|
updateConnectionStatusFromTo :: DB.Connection -> Int64 -> ConnStatus -> ConnStatus -> IO ()
|
|
updateConnectionStatusFromTo db connId fromStatus toStatus = do
|
|
maybeFirstRow fromOnly (DB.query db "SELECT conn_status FROM connections WHERE connection_id = ?" (Only connId)) >>= \case
|
|
Just status | status == fromStatus -> updateConnectionStatus_ db connId toStatus
|
|
_ -> pure ()
|
|
|
|
updateConnectionStatus_ :: DB.Connection -> Int64 -> ConnStatus -> IO ()
|
|
updateConnectionStatus_ db connId connStatus = do
|
|
currentTs <- getCurrentTime
|
|
if connStatus == ConnReady
|
|
then DB.execute db "UPDATE connections SET conn_status = ?, updated_at = ?, conn_req_inv = NULL, short_link_inv = NULL WHERE connection_id = ?" (connStatus, currentTs, connId)
|
|
else DB.execute db "UPDATE connections SET conn_status = ?, updated_at = ? WHERE connection_id = ?" (connStatus, currentTs, connId)
|
|
|
|
updateContactSettings :: DB.Connection -> User -> Int64 -> ChatSettings -> IO ()
|
|
updateContactSettings db User {userId} contactId ChatSettings {enableNtfs, sendRcpts, favorite} =
|
|
DB.execute db "UPDATE contacts SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND contact_id = ?" (enableNtfs, BI <$> sendRcpts, BI favorite, userId, contactId)
|
|
|
|
setConnConnReqInv :: DB.Connection -> User -> Int64 -> ConnReqInvitation -> IO ()
|
|
setConnConnReqInv db User {userId} connId connReq = do
|
|
updatedAt <- getCurrentTime
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
UPDATE connections
|
|
SET conn_req_inv = ?, updated_at = ?
|
|
WHERE user_id = ? AND connection_id = ?
|
|
|]
|
|
(connReq, updatedAt, userId, connId)
|
|
|
|
resetContactConnInitiated :: DB.Connection -> User -> Connection -> IO ()
|
|
resetContactConnInitiated db User {userId} Connection {connId} = do
|
|
updatedAt <- getCurrentTime
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
UPDATE connections
|
|
SET contact_conn_initiated = 0, updated_at = ?
|
|
WHERE user_id = ? AND connection_id = ?
|
|
|]
|
|
(updatedAt, userId, connId)
|
|
|
|
setContactCustomData :: DB.Connection -> User -> Contact -> Maybe CustomData -> IO ()
|
|
setContactCustomData db User {userId} Contact {contactId} customData = do
|
|
updatedAt <- getCurrentTime
|
|
DB.execute db "UPDATE contacts SET custom_data = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (customData, updatedAt, userId, contactId)
|
|
|
|
setContactUIThemes :: DB.Connection -> User -> Contact -> Maybe UIThemeEntityOverrides -> IO ()
|
|
setContactUIThemes db User {userId} Contact {contactId} uiThemes = do
|
|
updatedAt <- getCurrentTime
|
|
DB.execute db "UPDATE contacts SET ui_themes = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (uiThemes, updatedAt, userId, contactId)
|
|
|
|
setContactChatDeleted :: DB.Connection -> User -> Contact -> Bool -> IO ()
|
|
setContactChatDeleted db User {userId} Contact {contactId} chatDeleted = do
|
|
updatedAt <- getCurrentTime
|
|
DB.execute db "UPDATE contacts SET chat_deleted = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (BI chatDeleted, updatedAt, userId, contactId)
|
|
|
|
updateDirectChatTags :: DB.Connection -> ContactId -> [ChatTagId] -> IO ()
|
|
updateDirectChatTags db contactId tIds = do
|
|
currentTags <- getDirectChatTags db contactId
|
|
let tagsToAdd = filter (`notElem` currentTags) tIds
|
|
tagsToDelete = filter (`notElem` tIds) currentTags
|
|
forM_ tagsToDelete $ untagDirectChat db contactId
|
|
forM_ tagsToAdd $ tagDirectChat db contactId
|
|
|
|
tagDirectChat :: DB.Connection -> ContactId -> ChatTagId -> IO ()
|
|
tagDirectChat db contactId tId =
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
INSERT INTO chat_tags_chats (contact_id, chat_tag_id)
|
|
VALUES (?,?)
|
|
|]
|
|
(contactId, tId)
|
|
|
|
untagDirectChat :: DB.Connection -> ContactId -> ChatTagId -> IO ()
|
|
untagDirectChat db contactId tId =
|
|
DB.execute
|
|
db
|
|
[sql|
|
|
DELETE FROM chat_tags_chats
|
|
WHERE contact_id = ? AND chat_tag_id = ?
|
|
|]
|
|
(contactId, tId)
|
|
|
|
getDirectChatTags :: DB.Connection -> ContactId -> IO [ChatTagId]
|
|
getDirectChatTags db contactId = map fromOnly <$> DB.query db "SELECT chat_tag_id FROM chat_tags_chats WHERE contact_id = ?" (Only contactId)
|
|
|
|
addDirectChatTags :: DB.Connection -> Contact -> IO Contact
|
|
addDirectChatTags db ct = do
|
|
chatTags <- getDirectChatTags db $ contactId' ct
|
|
pure (ct :: Contact) {chatTags}
|
|
|
|
setDirectChatTTL :: DB.Connection -> ContactId -> Maybe Int64 -> IO ()
|
|
setDirectChatTTL db ctId ttl = do
|
|
updatedAt <- getCurrentTime
|
|
DB.execute db "UPDATE contacts SET chat_item_ttl = ?, updated_at = ? WHERE contact_id = ?" (ttl, updatedAt, ctId)
|
|
|
|
getDirectChatTTL :: DB.Connection -> ContactId -> IO (Maybe Int64)
|
|
getDirectChatTTL db ctId =
|
|
fmap join . maybeFirstRow fromOnly $
|
|
DB.query db "SELECT chat_item_ttl FROM contacts WHERE contact_id = ? LIMIT 1" (Only ctId)
|
|
|
|
getUserContactsToExpire :: DB.Connection -> User -> Int64 -> IO [ContactId]
|
|
getUserContactsToExpire db User {userId} globalTTL =
|
|
map fromOnly <$> DB.query db ("SELECT contact_id FROM contacts WHERE user_id = ? AND chat_item_ttl > 0" <> cond) (Only userId)
|
|
where
|
|
cond = if globalTTL == 0 then "" else " OR chat_item_ttl IS NULL"
|