Merge remote-tracking branch 'origin/master' into ab/zstd

This commit is contained in:
Alexander Bondarenko
2024-03-15 15:50:32 +02:00
138 changed files with 8546 additions and 2844 deletions
+22
View File
@@ -0,0 +1,22 @@
{-# LANGUAGE OverloadedStrings #-}
module Simplex.Chat.Store.AppSettings where
import Control.Monad (join)
import Control.Monad.IO.Class (liftIO)
import qualified Data.Aeson as J
import Data.Maybe (fromMaybe)
import Database.SQLite.Simple (Only (..))
import Simplex.Chat.AppSettings (AppSettings (..), combineAppSettings, defaultAppSettings, defaultParseAppSettings)
import Simplex.Messaging.Agent.Store.SQLite (maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
saveAppSettings :: DB.Connection -> AppSettings -> IO ()
saveAppSettings db appSettings = do
DB.execute_ db "DELETE FROM app_settings"
DB.execute db "INSERT INTO app_settings (app_settings) VALUES (?)" (Only $ J.encode appSettings)
getAppSettings :: DB.Connection -> Maybe AppSettings -> IO AppSettings
getAppSettings db platformDefaults = do
stored_ <- join <$> liftIO (maybeFirstRow (J.decodeStrict . fromOnly) $ DB.query_ db "SELECT app_settings FROM app_settings")
pure $ combineAppSettings (fromMaybe defaultAppSettings platformDefaults) (fromMaybe defaultParseAppSettings stored_)
+9 -8
View File
@@ -34,10 +34,10 @@ import Simplex.Chat.Types.Preferences
import Simplex.Messaging.Agent.Protocol (ConnId)
import Simplex.Messaging.Agent.Store.SQLite (firstRow, firstRow', maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Crypto.Ratchet (PQSupport)
import Simplex.Messaging.Util (eitherToMaybe)
import Simplex.Messaging.Version (VersionRange)
getConnectionEntity :: DB.Connection -> VersionRange -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity
getConnectionEntity :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity
getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
c@Connection {connType, entityId} <- getConnection_
case entityId of
@@ -55,13 +55,14 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
where
getConnection_ :: ExceptT StoreError IO Connection
getConnection_ = ExceptT $ do
firstRow toConnection (SEConnectionNotFound agentConnId) $
firstRow (toConnection vr) (SEConnectionNotFound agentConnId) $
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, auth_err_counter,
peer_chat_min_version, peer_chat_max_version
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,
conn_chat_version, peer_chat_min_version, peer_chat_max_version
FROM connections
WHERE user_id = ? AND agent_conn_id = ?
|]
@@ -157,7 +158,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
userContact_ [(cReq, groupId)] = Right UserContact {userContactLinkId, connReqContact = cReq, groupId}
userContact_ _ = Left SEUserContactLinkNotFound
getConnectionEntityByConnReq :: DB.Connection -> VersionRange -> User -> (ConnReqInvitation, ConnReqInvitation) -> IO (Maybe ConnectionEntity)
getConnectionEntityByConnReq :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> (ConnReqInvitation, ConnReqInvitation) -> IO (Maybe ConnectionEntity)
getConnectionEntityByConnReq db vr user@User {userId} (cReqSchema1, cReqSchema2) = do
connId_ <-
maybeFirstRow fromOnly $
@@ -168,7 +169,7 @@ getConnectionEntityByConnReq db vr user@User {userId} (cReqSchema1, cReqSchema2)
-- multiple connections can have same via_contact_uri_hash if request was repeated;
-- this function searches for latest connection with contact so that "known contact" plan would be chosen;
-- deleted connections are filtered out to allow re-connecting via same contact address
getContactConnEntityByConnReqHash :: DB.Connection -> VersionRange -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe ConnectionEntity)
getContactConnEntityByConnReqHash :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe ConnectionEntity)
getContactConnEntityByConnReqHash db vr user@User {userId} (cReqHash1, cReqHash2) = do
connId_ <-
maybeFirstRow fromOnly $
@@ -188,7 +189,7 @@ getContactConnEntityByConnReqHash db vr user@User {userId} (cReqHash1, cReqHash2
(userId, cReqHash1, cReqHash2, ConnDeleted)
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db vr user) connId_
getConnectionsToSubscribe :: DB.Connection -> VersionRange -> IO ([ConnId], [ConnectionEntity])
getConnectionsToSubscribe :: DB.Connection -> (PQSupport -> VersionRangeChat) -> IO ([ConnId], [ConnectionEntity])
getConnectionsToSubscribe db vr = do
aConnIds <- map fromOnly <$> DB.query_ db "SELECT agent_conn_id FROM connections where to_subscribe = 1"
entities <- forM aConnIds $ \acId -> do
+123 -100
View File
@@ -89,6 +89,7 @@ import Simplex.Chat.Types.Preferences
import Simplex.Messaging.Agent.Protocol (ConnId, InvitationId, UserId)
import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Crypto.Ratchet (PQSupport)
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Version
@@ -124,14 +125,14 @@ deletePendingContactConnection db userId connId =
|]
(userId, connId, ConnContact)
createAddressContactConnection :: DB.Connection -> User -> Contact -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> SubscriptionMode -> ExceptT StoreError IO Contact
createAddressContactConnection db user@User {userId} Contact {contactId} acId cReqHash xContactId incognitoProfile subMode = do
PendingContactConnection {pccConnId} <- liftIO $ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile Nothing subMode
createAddressContactConnection :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Contact -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> ExceptT StoreError IO Contact
createAddressContactConnection db vr user@User {userId} Contact {contactId} acId cReqHash xContactId incognitoProfile subMode chatV pqSup = do
PendingContactConnection {pccConnId} <- liftIO $ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile Nothing subMode chatV pqSup
liftIO $ DB.execute db "UPDATE connections SET contact_id = ? WHERE connection_id = ?" (contactId, pccConnId)
getContact db user contactId
getContact db vr user contactId
createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> IO PendingContactConnection
createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId subMode = do
createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection
createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId subMode chatV pqSup = do
createdAt <- getCurrentTime
customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile
let pccConnStatus = ConnJoined
@@ -140,16 +141,20 @@ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile grou
[sql|
INSERT INTO connections (
user_id, agent_conn_id, conn_status, conn_type, contact_conn_initiated,
via_contact_uri_hash, xcontact_id, custom_user_profile_id, via_group_link, group_link_id, created_at, updated_at, to_subscribe
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
via_contact_uri_hash, 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, True, cReqHash, xContactId) :. (customUserProfileId, isJust groupLinkId, groupLinkId, createdAt, createdAt, subMode == SMOnlyCreate))
( (userId, acId, pccConnStatus, ConnContact, True, cReqHash, xContactId)
:. (customUserProfileId, isJust groupLinkId, groupLinkId)
:. (createdAt, createdAt, subMode == SMOnlyCreate, chatV, pqSup, pqSup)
)
pccConnId <- insertedRowId db
pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = True, viaUserContactLink = Nothing, groupLinkId, customUserProfileId, connReqInv = Nothing, localAlias = "", createdAt, updatedAt = createdAt}
getConnReqContactXContactId :: DB.Connection -> User -> ConnReqUriHash -> IO (Maybe Contact, Maybe XContactId)
getConnReqContactXContactId db user@User {userId} cReqHash = do
getContactByConnReqHash db user cReqHash >>= \case
getConnReqContactXContactId :: DB.Connection -> (PQSupport -> 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
@@ -161,9 +166,9 @@ getConnReqContactXContactId db user@User {userId} cReqHash = do
"SELECT xcontact_id FROM connections WHERE user_id = ? AND via_contact_uri_hash = ? LIMIT 1"
(userId, cReqHash)
getContactByConnReqHash :: DB.Connection -> User -> ConnReqUriHash -> IO (Maybe Contact)
getContactByConnReqHash db user@User {userId} cReqHash =
maybeFirstRow (toContact user) $
getContactByConnReqHash :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ConnReqUriHash -> IO (Maybe Contact)
getContactByConnReqHash db vr user@User {userId} cReqHash =
maybeFirstRow (toContact vr user) $
DB.query
db
[sql|
@@ -173,8 +178,8 @@ getContactByConnReqHash db user@User {userId} cReqHash =
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
-- 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.auth_err_counter,
c.peer_chat_min_version, c.peer_chat_max_version
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.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
@@ -184,8 +189,8 @@ getContactByConnReqHash db user@User {userId} cReqHash =
|]
(userId, cReqHash, CSActive)
createDirectConnection :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> ConnStatus -> Maybe Profile -> SubscriptionMode -> IO PendingContactConnection
createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile subMode = do
createDirectConnection :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> ConnStatus -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection
createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile subMode chatV pqSup = do
createdAt <- getCurrentTime
customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile
let contactConnInitiated = pccConnStatus == ConnNew
@@ -193,9 +198,13 @@ createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile
db
[sql|
INSERT INTO connections
(user_id, agent_conn_id, conn_req_inv, conn_status, conn_type, contact_conn_initiated, custom_user_profile_id, created_at, updated_at, to_subscribe) VALUES (?,?,?,?,?,?,?,?,?,?)
(user_id, agent_conn_id, conn_req_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, pccConnStatus, ConnContact, contactConnInitiated, customUserProfileId, createdAt, createdAt, subMode == SMOnlyCreate)
( (userId, acId, cReq, pccConnStatus, ConnContact, contactConnInitiated, customUserProfileId)
:. (createdAt, createdAt, subMode == SMOnlyCreate, chatV, pqSup, pqSup)
)
pccConnId <- insertedRowId db
pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = False, viaUserContactLink = Nothing, groupLinkId = Nothing, customUserProfileId, connReqInv = Just cReq, localAlias = "", createdAt, updatedAt = createdAt}
@@ -229,45 +238,53 @@ deleteContactConnectionsAndFiles db userId Contact {contactId} = do
(userId, contactId)
DB.execute db "DELETE FROM files WHERE user_id = ? AND contact_id = ?" (userId, contactId)
deleteContact :: DB.Connection -> User -> Contact -> IO ()
deleteContact db user@User {userId} Contact {contactId, localDisplayName, activeConn} = 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 user_id = ? AND contact_id = ? LIMIT 1" (userId, contactId)
if isNothing ctMember
then do
deleteContactProfile_ db userId contactId
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
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 user_id = ? AND contact_id = ? LIMIT 1" (userId, 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 -> IO ()
deleteContactWithoutGroups db user@User {userId} Contact {contactId, localDisplayName, activeConn} = do
DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (userId, contactId)
deleteContactProfile_ db userId contactId
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
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
setContactDeleted :: DB.Connection -> User -> Contact -> IO ()
setContactDeleted db User {userId} Contact {contactId} = do
currentTs <- getCurrentTime
DB.execute db "UPDATE contacts SET deleted = 1, updated_at = ? WHERE user_id = ? AND contact_id = ?" (currentTs, userId, contactId)
setContactDeleted :: DB.Connection -> User -> Contact -> ExceptT StoreError IO ()
setContactDeleted db user@User {userId} ct@Contact {contactId} = do
assertNotUser db user ct
liftIO $ do
currentTs <- getCurrentTime
DB.execute db "UPDATE contacts SET deleted = 1, updated_at = ? WHERE user_id = ? AND contact_id = ?" (currentTs, userId, contactId)
getDeletedContacts :: DB.Connection -> User -> IO [Contact]
getDeletedContacts db user@User {userId} = do
getDeletedContacts :: DB.Connection -> (PQSupport -> 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 user) contactIds
rights <$> mapM (runExceptT . getDeletedContact db vr user) contactIds
getDeletedContact :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO Contact
getDeletedContact db user contactId = getContact_ db user contactId True
getDeletedContact :: DB.Connection -> (PQSupport -> 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 =
@@ -320,7 +337,7 @@ updateContactProfile db user@User {userId} c p'
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
currentTs <- getCurrentTime
updateContactProfile_' db userId profileId p' currentTs
updateContactLDN_ db userId contactId localDisplayName ldn 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
@@ -491,8 +508,8 @@ updateMemberContactProfile_' db userId profileId Profile {displayName, fullName,
|]
(displayName, fullName, image, updatedAt, userId, profileId)
updateContactLDN_ :: DB.Connection -> UserId -> Int64 -> ContactName -> ContactName -> UTCTime -> IO ()
updateContactLDN_ db userId contactId displayName newName updatedAt = do
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 = ?"
@@ -501,21 +518,21 @@ updateContactLDN_ db userId contactId displayName newName updatedAt = do
db
"UPDATE group_members SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?"
(newName, updatedAt, userId, contactId)
DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (displayName, userId)
safeDeleteLDN db user displayName
getContactByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Contact
getContactByName db user localDisplayName = do
getContactByName :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ContactName -> ExceptT StoreError IO Contact
getContactByName db vr user localDisplayName = do
cId <- getContactIdByName db user localDisplayName
getContact db user cId
getContact db vr user cId
getUserContacts :: DB.Connection -> User -> IO [Contact]
getUserContacts db user@User {userId} = do
getUserContacts :: DB.Connection -> (PQSupport -> 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 user) contactIds
contacts <- rights <$> mapM (runExceptT . getContact db vr user) contactIds
pure $ filter (\Contact {activeConn} -> isJust activeConn) contacts
createOrUpdateContactRequest :: DB.Connection -> User -> Int64 -> InvitationId -> VersionRange -> Profile -> Maybe XContactId -> ExceptT StoreError IO ContactOrRequest
createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (VersionRange minV maxV) Profile {displayName, fullName, image, contactLink, preferences} xContactId_ =
createOrUpdateContactRequest :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> ExceptT StoreError IO ContactOrRequest
createOrUpdateContactRequest db vr user@User {userId} userContactLinkId invId (VersionRange minV maxV) Profile {displayName, fullName, image, contactLink, preferences} xContactId_ pqSup =
liftIO (maybeM getContact' xContactId_) >>= \case
Just contact -> pure $ CORContact contact
Nothing -> CORRequest <$> createOrUpdate_
@@ -544,14 +561,17 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers
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)
VALUES (?,?,?,?,?,?,?,?,?,?)
(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, invId, minV, maxV, profileId, ldn, userId, currentTs, currentTs, xContactId_)
( (userContactLinkId, invId, minV, maxV, profileId, ldn, userId)
:. (currentTs, currentTs, xContactId_, pqSup)
)
insertedRowId db
getContact' :: XContactId -> IO (Maybe Contact)
getContact' xContactId =
maybeFirstRow (toContact user) $
maybeFirstRow (toContact vr user) $
DB.query
db
[sql|
@@ -561,8 +581,8 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
-- 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.auth_err_counter,
c.peer_chat_min_version, c.peer_chat_max_version
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.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
@@ -579,7 +599,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers
[sql|
SELECT
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id,
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, p.preferences, cr.created_at, cr.updated_at,
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)
@@ -600,21 +620,21 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers
db
[sql|
UPDATE contact_requests
SET agent_invitation_id = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, updated_at = ?
SET agent_invitation_id = ?, pq_support = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, updated_at = ?
WHERE user_id = ? AND contact_request_id = ?
|]
(invId, minV, maxV, currentTs, userId, cReqId)
(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 = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, local_display_name = ?, updated_at = ?
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 = ?
|]
(invId, minV, maxV, ldn, currentTs, userId, cReqId)
DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (oldLdn, userId)
(invId, pqSup, minV, maxV, ldn, currentTs, userId, cReqId)
safeDeleteLDN db user oldLdn
where
updateProfile currentTs =
DB.execute
@@ -648,7 +668,7 @@ getContactRequest db User {userId} contactRequestId =
[sql|
SELECT
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id,
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, p.preferences, cr.created_at, cr.updated_at,
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)
@@ -684,12 +704,13 @@ deleteContactRequest db User {userId} contactRequestId = do
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, userId, contactRequestId, userId)
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId)
createAcceptedContact :: DB.Connection -> User -> ConnId -> VersionRange -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> Bool -> IO Contact
createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}} agentConnId cReqChatVRange localDisplayName profileId profile userContactLinkId xContactId incognitoProfile subMode contactUsed = do
createAcceptedContact :: DB.Connection -> User -> ConnId -> VersionChat -> VersionRangeChat -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> PQSupport -> Bool -> IO Contact
createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}} agentConnId connChatVersion cReqChatVRange localDisplayName profileId profile userContactLinkId xContactId incognitoProfile subMode pqSup contactUsed = do
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
createdAt <- getCurrentTime
customUserProfileId <- forM incognitoProfile $ \case
@@ -701,7 +722,7 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}
"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, True, userPreferences, createdAt, createdAt, createdAt, xContactId, contactUsed)
contactId <- insertedRowId db
conn <- createConnection_ db userId ConnContact (Just contactId) agentConnId cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode
conn <- createConnection_ db userId ConnContact (Just contactId) agentConnId connChatVersion cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode pqSup
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn = Just conn, viaGroup = Nothing, contactUsed, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False}
@@ -710,12 +731,12 @@ 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 -> User -> Int64 -> ExceptT StoreError IO Contact
getContact db user contactId = getContact_ db user contactId False
getContact :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ExceptT StoreError IO Contact
getContact db vr user contactId = getContact_ db vr user contactId False
getContact_ :: DB.Connection -> User -> Int64 -> Bool -> ExceptT StoreError IO Contact
getContact_ db user@User {userId} contactId deleted =
ExceptT . firstRow (toContact user) (SEContactNotFound contactId) $
getContact_ :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> Bool -> ExceptT StoreError IO Contact
getContact_ db vr user@User {userId} contactId deleted =
ExceptT . firstRow (toContact vr user) (SEContactNotFound contactId) $
DB.query
db
[sql|
@@ -725,8 +746,8 @@ getContact_ db user@User {userId} contactId deleted =
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
-- 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.auth_err_counter,
c.peer_chat_min_version, c.peer_chat_max_version
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.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
@@ -769,8 +790,8 @@ getPendingContactConnections db User {userId} = do
|]
[":user_id" := userId, ":conn_type" := ConnContact]
getContactConnections :: DB.Connection -> UserId -> Contact -> IO [Connection]
getContactConnections db userId Contact {contactId} =
getContactConnections :: DB.Connection -> (PQSupport -> VersionRangeChat) -> UserId -> Contact -> IO [Connection]
getContactConnections db vr userId Contact {contactId} =
connections =<< liftIO getConnections_
where
getConnections_ =
@@ -778,25 +799,27 @@ getContactConnections db userId Contact {contactId} =
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.auth_err_counter,
c.peer_chat_min_version, c.peer_chat_max_version
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.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 rows
connections rows = pure $ map (toConnection vr) rows
getConnectionById :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO Connection
getConnectionById db User {userId} connId = ExceptT $ do
firstRow toConnection (SEConnectionNotFoundById connId) $
getConnectionById :: DB.Connection -> (PQSupport -> 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, auth_err_counter,
peer_chat_min_version, peer_chat_max_version
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,
conn_chat_version, peer_chat_min_version, peer_chat_max_version
FROM connections
WHERE user_id = ? AND connection_id = ?
|]
+19 -35
View File
@@ -14,7 +14,6 @@ module Simplex.Chat.Store.Files
( getLiveSndFileTransfers,
getLiveRcvFileTransfers,
getPendingSndChunks,
createSndDirectFileTransfer,
createSndDirectFTConnection,
createSndGroupFileTransfer,
createSndGroupFileTransferConnection,
@@ -115,8 +114,9 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
import qualified Simplex.Messaging.Crypto.File as CF
import Simplex.Messaging.Crypto.Ratchet as CR
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Version (VersionRange)
import Simplex.Messaging.Version
import System.FilePath (takeFileName)
getLiveSndFileTransfers :: DB.Connection -> User -> IO [SndFileTransfer]
@@ -174,27 +174,10 @@ getPendingSndChunks db fileId connId =
|]
(fileId, connId)
createSndDirectFileTransfer :: DB.Connection -> UserId -> Contact -> FilePath -> FileInvitation -> Maybe ConnId -> Integer -> SubscriptionMode -> IO FileTransferMeta
createSndDirectFileTransfer db userId Contact {contactId} filePath FileInvitation {fileName, fileSize, fileInline} acId_ chunkSize subMode = do
createSndDirectFTConnection :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> (CommandId, ConnId) -> SubscriptionMode -> IO ()
createSndDirectFTConnection db vr user@User {userId} fileId (cmdId, acId) subMode = do
currentTs <- getCurrentTime
DB.execute
db
"INSERT INTO files (user_id, contact_id, file_name, file_path, file_size, chunk_size, file_inline, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?)"
((userId, contactId, fileName, filePath, fileSize, chunkSize) :. (fileInline, CIFSSndStored, FPSMP, currentTs, currentTs))
fileId <- insertedRowId db
forM_ acId_ $ \acId -> do
Connection {connId} <- createSndFileConnection_ db userId fileId acId subMode
let fileStatus = FSNew
DB.execute
db
"INSERT INTO snd_files (file_id, file_status, file_inline, connection_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
(fileId, fileStatus, fileInline, connId, currentTs, currentTs)
pure FileTransferMeta {fileId, xftpSndFile = Nothing, xftpRedirectFor = Nothing, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
createSndDirectFTConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> SubscriptionMode -> IO ()
createSndDirectFTConnection db user@User {userId} fileId (cmdId, acId) subMode = do
currentTs <- getCurrentTime
Connection {connId} <- createSndFileConnection_ db userId fileId acId subMode
Connection {connId} <- createSndFileConnection_ db vr userId fileId acId subMode
setCommandConnId db user cmdId connId
DB.execute
db
@@ -211,10 +194,10 @@ createSndGroupFileTransfer db userId GroupInfo {groupId} filePath FileInvitation
fileId <- insertedRowId db
pure FileTransferMeta {fileId, xftpSndFile = Nothing, xftpRedirectFor = Nothing, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
createSndGroupFileTransferConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> GroupMember -> SubscriptionMode -> IO ()
createSndGroupFileTransferConnection db user@User {userId} fileId (cmdId, acId) GroupMember {groupMemberId} subMode = do
createSndGroupFileTransferConnection :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> (CommandId, ConnId) -> GroupMember -> SubscriptionMode -> IO ()
createSndGroupFileTransferConnection db vr user@User {userId} fileId (cmdId, acId) GroupMember {groupMemberId} subMode = do
currentTs <- getCurrentTime
Connection {connId} <- createSndFileConnection_ db userId fileId acId subMode
Connection {connId} <- createSndFileConnection_ db vr userId fileId acId subMode
setCommandConnId db user cmdId connId
DB.execute
db
@@ -446,10 +429,11 @@ lookupChatRefByFileId db User {userId} fileId =
|]
(userId, fileId)
createSndFileConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> SubscriptionMode -> IO Connection
createSndFileConnection_ db userId fileId agentConnId subMode = do
-- TODO v6.0 remove
createSndFileConnection_ :: DB.Connection -> (PQSupport -> VersionRangeChat) -> UserId -> Int64 -> ConnId -> SubscriptionMode -> IO Connection
createSndFileConnection_ db vr userId fileId agentConnId subMode = do
currentTs <- getCurrentTime
createConnection_ db userId ConnSndFile (Just fileId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode
createConnection_ db userId ConnSndFile (Just fileId) agentConnId (minVersion $ vr PQSupportOff) chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode CR.PQSupportOff
updateSndFileStatus :: DB.Connection -> SndFileTransfer -> FileStatus -> IO ()
updateSndFileStatus db SndFileTransfer {fileId, connId} status = do
@@ -711,7 +695,7 @@ getRcvFileTransfer_ db userId fileId = do
_ -> pure Nothing
cancelled = fromMaybe False cancelled_
acceptRcvFileTransfer :: DB.Connection -> VersionRange -> User -> Int64 -> (CommandId, ConnId) -> ConnStatus -> FilePath -> SubscriptionMode -> ExceptT StoreError IO AChatItem
acceptRcvFileTransfer :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> (CommandId, ConnId) -> ConnStatus -> FilePath -> SubscriptionMode -> ExceptT StoreError IO AChatItem
acceptRcvFileTransfer db vr user@User {userId} fileId (cmdId, acId) connStatus filePath subMode = ExceptT $ do
currentTs <- getCurrentTime
acceptRcvFT_ db user fileId filePath Nothing currentTs
@@ -723,16 +707,16 @@ acceptRcvFileTransfer db vr user@User {userId} fileId (cmdId, acId) connStatus f
setCommandConnId db user cmdId connId
runExceptT $ getChatItemByFileId db vr user fileId
getContactByFileId :: DB.Connection -> User -> FileTransferId -> ExceptT StoreError IO Contact
getContactByFileId db user@User {userId} fileId = do
getContactByFileId :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> FileTransferId -> ExceptT StoreError IO Contact
getContactByFileId db vr user@User {userId} fileId = do
cId <- getContactIdByFileId
getContact db user cId
getContact db vr user cId
where
getContactIdByFileId =
ExceptT . firstRow fromOnly (SEContactNotFoundByFileId fileId) $
DB.query db "SELECT contact_id FROM files WHERE user_id = ? AND file_id = ?" (userId, fileId)
acceptRcvInlineFT :: DB.Connection -> VersionRange -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
acceptRcvInlineFT :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
acceptRcvInlineFT db vr user fileId filePath = do
liftIO $ acceptRcvFT_ db user fileId filePath (Just IFMOffer) =<< getCurrentTime
getChatItemByFileId db vr user fileId
@@ -741,7 +725,7 @@ startRcvInlineFT :: DB.Connection -> User -> RcvFileTransfer -> FilePath -> Mayb
startRcvInlineFT db user RcvFileTransfer {fileId} filePath rcvFileInline =
acceptRcvFT_ db user fileId filePath rcvFileInline =<< getCurrentTime
xftpAcceptRcvFT :: DB.Connection -> VersionRange -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
xftpAcceptRcvFT :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
xftpAcceptRcvFT db vr user fileId filePath = do
liftIO $ acceptRcvFT_ db user fileId filePath Nothing =<< getCurrentTime
getChatItemByFileId db vr user fileId
@@ -1016,7 +1000,7 @@ getLocalCryptoFile db userId fileId sent =
pure $ CryptoFile filePath fileCryptoArgs
_ -> throwError $ SEFileNotFound fileId
updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> VersionRange -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem
updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem
updateDirectCIFileStatus db vr user fileId fileStatus = do
aci@(AChatItem cType d cInfo ci) <- getChatItemByFileId db vr user fileId
case (cType, testEquality d $ msgDirection @d) of
+229 -162
View File
@@ -4,6 +4,7 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
@@ -132,7 +133,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 (groupForwardVRange)
import Simplex.Chat.Protocol (groupForwardVersion)
import Simplex.Chat.Store.Direct
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
@@ -141,6 +142,7 @@ import Simplex.Messaging.Agent.Protocol (ConnId, UserId)
import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet (PQSupport, pattern PQEncOff, pattern PQSupportOff)
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Util (eitherToMaybe, ($>>=), (<$$>))
import Simplex.Messaging.Version
@@ -148,13 +150,13 @@ 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, Maybe UTCTime) :. GroupMemberRow
type GroupMemberRow = ((Int64, Int64, MemberId, Version, Version, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
type GroupMemberRow = ((Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool, Maybe MemberRestrictionStatus) :. (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 Version, Maybe Version, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
toGroupInfo :: VersionRange -> Int64 -> GroupInfoRow -> GroupInfo
toGroupInfo :: (PQSupport -> VersionRangeChat) -> Int64 -> GroupInfoRow -> GroupInfo
toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. userMemberRow) =
let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = JVersionRange vr}
let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr PQSupportOff}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
fullGroupPreferences = mergeGroupPreferences groupPreferences
groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences}
@@ -167,7 +169,7 @@ toGroupMember userContactId ((groupMemberId, groupId, memberId, minVer, maxVer,
blockedByAdmin = maybe False mrsBlocked memberRestriction_
invitedBy = toInvitedBy userContactId invitedById
activeConn = Nothing
memberChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
memberChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
in GroupMember {..}
toMaybeGroupMember :: Int64 -> MaybeGroupMemberRow -> Maybe GroupMember
@@ -184,17 +186,18 @@ createGroupLink db User {userId} groupInfo@GroupInfo {groupId, localDisplayName}
"INSERT INTO user_contact_links (user_id, group_id, group_link_id, local_display_name, conn_req_contact, group_link_member_role, auto_accept, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
(userId, groupId, groupLinkId, "group_link_" <> localDisplayName, cReq, memberRole, True, currentTs, currentTs)
userContactLinkId <- insertedRowId db
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode PQSupportOff
getGroupLinkConnection :: DB.Connection -> User -> GroupInfo -> ExceptT StoreError IO Connection
getGroupLinkConnection db User {userId} groupInfo@GroupInfo {groupId} =
ExceptT . firstRow toConnection (SEGroupLinkNotFound groupInfo) $
getGroupLinkConnection :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupInfo -> ExceptT StoreError IO Connection
getGroupLinkConnection db vr User {userId} groupInfo@GroupInfo {groupId} =
ExceptT . firstRow (toConnection vr) (SEGroupLinkNotFound groupInfo) $
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.auth_err_counter,
c.peer_chat_min_version, c.peer_chat_max_version
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.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM connections c
JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id
WHERE c.user_id = ? AND uc.user_id = ? AND uc.group_id = ?
@@ -225,8 +228,9 @@ deleteGroupLink db User {userId} GroupInfo {groupId} = do
JOIN user_contact_links uc USING (user_contact_link_id)
WHERE uc.user_id = ? AND uc.group_id = ?
)
AND local_display_name NOT IN (SELECT local_display_name FROM users WHERE user_id = ?)
|]
(userId, userId, groupId)
(userId, userId, groupId, userId)
DB.execute
db
[sql|
@@ -257,7 +261,7 @@ setGroupLinkMemberRole :: DB.Connection -> User -> Int64 -> GroupMemberRole -> I
setGroupLinkMemberRole db User {userId} userContactLinkId memberRole =
DB.execute db "UPDATE user_contact_links SET group_link_member_role = ? WHERE user_id = ? AND user_contact_link_id = ?" (memberRole, userId, userContactLinkId)
getGroupAndMember :: DB.Connection -> User -> Int64 -> VersionRange -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember :: DB.Connection -> User -> Int64 -> (PQSupport -> VersionRangeChat) -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember db User {userId, userContactId} groupMemberId vr =
ExceptT . firstRow toGroupAndMember (SEInternalError "referenced group member not found") $
DB.query
@@ -277,8 +281,9 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr =
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
c.peer_chat_min_version, c.peer_chat_max_version
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.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
JOIN groups g ON g.group_id = m.group_id
@@ -298,10 +303,10 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr =
toGroupAndMember (groupInfoRow :. memberRow :. connRow) =
let groupInfo = toGroupInfo vr userContactId groupInfoRow
member = toGroupMember userContactId memberRow
in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection connRow})
in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection vr connRow})
-- | creates completely new group with a single member - the current user
createNewGroup :: DB.Connection -> VersionRange -> TVar ChaChaDRG -> User -> GroupProfile -> Maybe Profile -> ExceptT StoreError IO GroupInfo
createNewGroup :: DB.Connection -> (PQSupport -> VersionRangeChat) -> TVar ChaChaDRG -> User -> GroupProfile -> Maybe Profile -> ExceptT StoreError IO GroupInfo
createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = ExceptT $ do
let GroupProfile {displayName, fullName, description, image, groupPreferences} = groupProfile
fullGroupPreferences = mergeGroupPreferences groupPreferences
@@ -343,7 +348,7 @@ createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = Exc
}
-- | creates a new group record for the group the current user was invited to, or returns an existing one
createGroupInvitation :: DB.Connection -> VersionRange -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId)
createGroupInvitation :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId)
createGroupInvitation _ _ _ Contact {localDisplayName, activeConn = Nothing} _ _ = throwError $ SEContactNotReady localDisplayName
createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activeConn = Just Connection {customUserProfileId, peerChatVRange}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do
liftIO getInvitationGroupId_ >>= \case
@@ -388,7 +393,7 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ
|]
(profileId, localDisplayName, connRequest, customUserProfileId, userId, True, currentTs, currentTs, currentTs, currentTs)
insertedRowId db
let JVersionRange hostVRange = peerChatVRange
let hostVRange = const $ adjustedMemberVRange vr 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 vr
let chatSettings = ChatSettings {enableNtfs = MFAll, sendRcpts = Nothing, favorite = False}
@@ -409,13 +414,18 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ
groupMemberId
)
adjustedMemberVRange :: (PQSupport -> VersionRangeChat) -> VersionRangeChat -> VersionRangeChat
adjustedMemberVRange getVR vr@(VersionRange minV maxV) =
let maxV' = min maxV (maxVersion $ getVR PQSupportOff)
in fromMaybe vr $ safeVersionRange minV (max minV maxV')
getHostMemberId_ :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO GroupMemberId
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 -> 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
createContactMemberInv_ :: IsContact a => DB.Connection -> User -> GroupId -> Maybe GroupMemberId -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ProfileId -> UTCTime -> (PQSupport -> VersionRangeChat) -> ExceptT StoreError IO GroupMember
createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMemberId userOrContact MemberIdRole {memberId, memberRole} memberCategory memberStatus invitedBy incognitoProfileId createdAt vr = do
incognitoProfile <- forM incognitoProfileId $ \profileId -> getProfileById db userId profileId
(localDisplayName, memberProfile) <- case (incognitoProfile, incognitoProfileId) of
(Just profile@LocalProfile {displayName}, Just profileId) ->
@@ -439,9 +449,10 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe
memberContactId = Just $ contactId' userOrContact,
memberContactProfileId = localProfileId (profile' userOrContact),
activeConn = Nothing,
memberChatVRange = JVersionRange memberChatVRange
memberChatVRange
}
where
memberChatVRange@(VersionRange minV maxV) = vr PQSupportOff
insertMember_ :: IO ContactName
insertMember_ = do
let localDisplayName = localDisplayName' userOrContact
@@ -477,7 +488,7 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe
)
pure $ Right incognitoLdn
createGroupInvitedViaLink :: DB.Connection -> VersionRange -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupInvitedViaLink :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupInvitedViaLink
db
vr
@@ -491,7 +502,7 @@ createGroupInvitedViaLink
-- using IBUnknown since host is created without contact
void $ createContactMemberInv_ db user groupId (Just hostMemberId) user invitedMember GCUserMember GSMemAccepted IBUnknown customUserProfileId currentTs vr
liftIO $ setViaGroupLinkHash db groupId connId
(,) <$> getGroupInfo db vr user groupId <*> getGroupMemberById db user hostMemberId
(,) <$> getGroupInfo db vr user groupId <*> getGroupMemberById db vr user hostMemberId
where
insertGroup_ currentTs = ExceptT $ do
let GroupProfile {displayName, fullName, description, image, groupPreferences} = groupProfile
@@ -548,10 +559,10 @@ setGroupInvitationChatItemId db User {userId} groupId chatItemId = do
-- TODO return the last connection that is ready, not any last connection
-- requires updating connection status
getGroup :: DB.Connection -> VersionRange -> User -> GroupId -> ExceptT StoreError IO Group
getGroup :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupId -> ExceptT StoreError IO Group
getGroup db vr user groupId = do
gInfo <- getGroupInfo db vr user groupId
members <- liftIO $ getGroupMembers db user gInfo
members <- liftIO $ getGroupMembers db vr user gInfo
pure $ Group gInfo members
deleteGroupConnectionsAndFiles :: DB.Connection -> User -> GroupInfo -> [GroupMember] -> IO ()
@@ -586,7 +597,7 @@ deleteGroup :: DB.Connection -> User -> GroupInfo -> IO ()
deleteGroup db user@User {userId} g@GroupInfo {groupId, localDisplayName} = do
deleteGroupProfile_ db userId groupId
DB.execute db "DELETE FROM groups WHERE user_id = ? AND group_id = ?" (userId, groupId)
DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
safeDeleteLDN db user localDisplayName
forM_ (incognitoMembershipProfile g) $ deleteUnusedIncognitoProfileById_ db user . localProfileId
deleteGroupProfile_ :: DB.Connection -> UserId -> GroupId -> IO ()
@@ -603,12 +614,12 @@ deleteGroupProfile_ db userId groupId =
|]
(userId, groupId)
getUserGroups :: DB.Connection -> VersionRange -> User -> IO [Group]
getUserGroups :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> IO [Group]
getUserGroups db vr user@User {userId} = do
groupIds <- map fromOnly <$> DB.query db "SELECT group_id FROM groups WHERE user_id = ?" (Only userId)
rights <$> mapM (runExceptT . getGroup db vr user) groupIds
getUserGroupDetails :: DB.Connection -> VersionRange -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfo]
getUserGroupDetails :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfo]
getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ =
map (toGroupInfo vr userContactId)
<$> DB.query
@@ -631,7 +642,7 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ =
where
search = fromMaybe "" search_
getUserGroupsWithSummary :: DB.Connection -> VersionRange -> User -> Maybe ContactId -> Maybe String -> IO [(GroupInfo, GroupSummary)]
getUserGroupsWithSummary :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Maybe ContactId -> Maybe String -> IO [(GroupInfo, GroupSummary)]
getUserGroupsWithSummary db vr user _contactId_ search_ =
getUserGroupDetails db vr user _contactId_ search_
>>= mapM (\g@GroupInfo {groupId} -> (g,) <$> getGroupSummary db user groupId)
@@ -672,7 +683,7 @@ checkContactHasGroups :: DB.Connection -> User -> Contact -> IO (Maybe GroupId)
checkContactHasGroups db User {userId} Contact {contactId} =
maybeFirstRow fromOnly $ DB.query db "SELECT group_id FROM group_members WHERE user_id = ? AND contact_id = ? LIMIT 1" (userId, contactId)
getGroupInfoByName :: DB.Connection -> VersionRange -> User -> GroupName -> ExceptT StoreError IO GroupInfo
getGroupInfoByName :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupName -> ExceptT StoreError IO GroupInfo
getGroupInfoByName db vr user gName = do
gId <- getGroupIdByName db user gName
getGroupInfo db vr user gId
@@ -684,8 +695,9 @@ groupMemberQuery =
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
c.peer_chat_min_version, c.peer_chat_max_version
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.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
LEFT JOIN connections c ON c.connection_id = (
@@ -695,41 +707,41 @@ groupMemberQuery =
)
|]
getGroupMember :: DB.Connection -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO GroupMember
getGroupMember db user@User {userId} groupId groupMemberId =
ExceptT . firstRow (toContactMember user) (SEGroupMemberNotFound groupMemberId) $
getGroupMember :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO GroupMember
getGroupMember db vr user@User {userId} groupId groupMemberId =
ExceptT . firstRow (toContactMember vr user) (SEGroupMemberNotFound groupMemberId) $
DB.query
db
(groupMemberQuery <> " WHERE m.group_id = ? AND m.group_member_id = ? AND m.user_id = ?")
(userId, groupId, groupMemberId, userId)
getGroupMemberById :: DB.Connection -> User -> GroupMemberId -> ExceptT StoreError IO GroupMember
getGroupMemberById db user@User {userId} groupMemberId =
ExceptT . firstRow (toContactMember user) (SEGroupMemberNotFound groupMemberId) $
getGroupMemberById :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMemberId -> ExceptT StoreError IO GroupMember
getGroupMemberById db vr user@User {userId} groupMemberId =
ExceptT . firstRow (toContactMember vr user) (SEGroupMemberNotFound groupMemberId) $
DB.query
db
(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) $
getGroupMemberByMemberId :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupInfo -> MemberId -> ExceptT StoreError IO GroupMember
getGroupMemberByMemberId db vr user@User {userId} GroupInfo {groupId} memberId =
ExceptT . firstRow (toContactMember vr 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)
getGroupMembers :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupInfo -> IO [GroupMember]
getGroupMembers db vr user@User {userId, userContactId} GroupInfo {groupId} = do
map (toContactMember vr user)
<$> DB.query
db
(groupMemberQuery <> " WHERE m.group_id = ? AND m.user_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?)")
(userId, groupId, userId, userContactId)
getGroupMembersForExpiration :: DB.Connection -> User -> GroupInfo -> IO [GroupMember]
getGroupMembersForExpiration db user@User {userId, userContactId} GroupInfo {groupId} = do
map (toContactMember user)
getGroupMembersForExpiration :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupInfo -> IO [GroupMember]
getGroupMembersForExpiration db vr user@User {userId, userContactId} GroupInfo {groupId} = do
map (toContactMember vr user)
<$> DB.query
db
( groupMemberQuery
@@ -743,9 +755,9 @@ getGroupMembersForExpiration db user@User {userId, userContactId} GroupInfo {gro
)
(userId, groupId, userId, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted, GSMemUnknown)
toContactMember :: User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
toContactMember User {userContactId} (memberRow :. connRow) =
(toGroupMember userContactId memberRow) {activeConn = toMaybeConnection connRow}
toContactMember :: (PQSupport -> VersionRangeChat) -> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
toContactMember vr User {userContactId} (memberRow :. connRow) =
(toGroupMember userContactId memberRow) {activeConn = toMaybeConnection vr connRow}
getGroupCurrentMembersCount :: DB.Connection -> User -> GroupInfo -> IO Int
getGroupCurrentMembersCount db User {userId} GroupInfo {groupId} = do
@@ -761,14 +773,14 @@ getGroupCurrentMembersCount db User {userId} GroupInfo {groupId} = do
(groupId, userId)
pure $ length $ filter memberCurrent' statuses
getGroupInvitation :: DB.Connection -> VersionRange -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation
getGroupInvitation :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation
getGroupInvitation db vr user groupId =
getConnRec_ user >>= \case
Just connRequest -> do
groupInfo@GroupInfo {membership} <- getGroupInfo db vr user groupId
when (memberStatus membership /= GSMemInvited) $ throwError SEGroupAlreadyJoined
hostId <- getHostMemberId_ db user groupId
fromMember <- getGroupMember db user groupId hostId
fromMember <- getGroupMember db vr user groupId hostId
pure ReceivedGroupInvitation {fromMember, connRequest, groupInfo}
_ -> throwError SEGroupInvitationNotFound
where
@@ -779,14 +791,14 @@ getGroupInvitation db vr user groupId =
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} GroupInfo {groupId, membership} 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 {connChatVersion, 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
void $ createMemberConnection_ db userId groupMemberId agentConnId connChatVersion peerChatVRange Nothing 0 createdAt subMode
pure member
where
JVersionRange (VersionRange minV maxV) = peerChatVRange
VersionRange minV maxV = peerChatVRange
invitedByGroupMemberId = groupMemberId' membership
createMember_ memberId createdAt = do
insertMember_
@@ -826,13 +838,13 @@ createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId,
:. (minV, maxV)
)
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 =
createNewContactMemberAsync :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> Contact -> GroupMemberRole -> (CommandId, ConnId) -> VersionChat -> VersionRangeChat -> SubscriptionMode -> ExceptT StoreError IO ()
createNewContactMemberAsync db gVar user@User {userId, userContactId} GroupInfo {groupId, membership} Contact {contactId, localDisplayName, profile} memberRole (cmdId, agentConnId) chatV peerChatVRange subMode =
createWithRandomId gVar $ \memId -> do
createdAt <- liftIO getCurrentTime
insertMember_ (MemberId memId) createdAt
groupMemberId <- liftIO $ insertedRowId db
Connection {connId} <- createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 createdAt subMode
Connection {connId} <- createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange Nothing 0 createdAt subMode
setCommandConnId db user cmdId connId
where
VersionRange minV maxV = peerChatVRange
@@ -867,7 +879,7 @@ createAcceptedMember
groupMemberId <- liftIO $ insertedRowId db
pure (groupMemberId, MemberId memId)
where
JVersionRange (VersionRange minV maxV) = cReqChatVRange
VersionRange minV maxV = cReqChatVRange
insertMember_ memberId createdAt =
DB.execute
db
@@ -883,20 +895,21 @@ createAcceptedMember
:. (minV, maxV)
)
createAcceptedMemberConnection :: DB.Connection -> User -> (CommandId, ConnId) -> UserContactRequest -> GroupMemberId -> SubscriptionMode -> IO ()
createAcceptedMemberConnection :: DB.Connection -> User -> (CommandId, ConnId) -> VersionChat -> UserContactRequest -> GroupMemberId -> SubscriptionMode -> IO ()
createAcceptedMemberConnection
db
user@User {userId}
(cmdId, agentConnId)
chatV
UserContactRequest {cReqChatVRange, userContactLinkId}
groupMemberId
subMode = do
createdAt <- liftIO getCurrentTime
Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId (fromJVersionRange cReqChatVRange) Nothing (Just userContactLinkId) Nothing 0 createdAt subMode
Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId chatV cReqChatVRange Nothing (Just userContactLinkId) Nothing 0 createdAt subMode PQSupportOff
setCommandConnId db user cmdId connId
getContactViaMember :: DB.Connection -> User -> GroupMember -> ExceptT StoreError IO Contact
getContactViaMember db user@User {userId} GroupMember {groupMemberId} = do
getContactViaMember :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> ExceptT StoreError IO Contact
getContactViaMember db vr user@User {userId} GroupMember {groupMemberId} = do
contactId <-
ExceptT $
firstRow fromOnly (SEContactNotFoundByMemberId groupMemberId) $
@@ -910,7 +923,7 @@ getContactViaMember db user@User {userId} GroupMember {groupMemberId} = do
LIMIT 1
|]
(userId, groupMemberId)
getContact db user contactId
getContact db vr user contactId
setNewContactMemberConnRequest :: DB.Connection -> User -> GroupMember -> ConnReqInvitation -> IO ()
setNewContactMemberConnRequest db User {userId} GroupMember {groupMemberId} connRequest = do
@@ -922,15 +935,15 @@ getMemberInvitation db User {userId} groupMemberId =
fmap join . maybeFirstRow fromOnly $
DB.query db "SELECT sent_inv_queue_info FROM group_members WHERE group_member_id = ? AND user_id = ?" (groupMemberId, userId)
createMemberConnection :: DB.Connection -> UserId -> GroupMember -> ConnId -> VersionRange -> SubscriptionMode -> IO ()
createMemberConnection db userId GroupMember {groupMemberId} agentConnId peerChatVRange subMode = do
createMemberConnection :: DB.Connection -> UserId -> GroupMember -> ConnId -> VersionChat -> VersionRangeChat -> SubscriptionMode -> IO ()
createMemberConnection db userId GroupMember {groupMemberId} agentConnId chatV peerChatVRange subMode = do
currentTs <- getCurrentTime
void $ createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 currentTs subMode
void $ createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange Nothing 0 currentTs subMode
createMemberConnectionAsync :: DB.Connection -> User -> GroupMemberId -> (CommandId, ConnId) -> VersionRange -> SubscriptionMode -> IO ()
createMemberConnectionAsync db user@User {userId} groupMemberId (cmdId, agentConnId) peerChatVRange subMode = do
createMemberConnectionAsync :: DB.Connection -> User -> GroupMemberId -> (CommandId, ConnId) -> VersionChat -> VersionRangeChat -> SubscriptionMode -> IO ()
createMemberConnectionAsync db user@User {userId} groupMemberId (cmdId, agentConnId) chatV peerChatVRange subMode = do
currentTs <- getCurrentTime
Connection {connId} <- createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 currentTs subMode
Connection {connId} <- createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange Nothing 0 currentTs subMode
setCommandConnId db user cmdId connId
updateGroupMemberStatus :: DB.Connection -> UserId -> GroupMember -> GroupMemberStatus -> IO ()
@@ -996,7 +1009,7 @@ createNewMember_
createdAt = do
let invitedById = fromInvitedBy userContactId invitedBy
activeConn = Nothing
mcvr@(VersionRange minV maxV) = maybe chatInitialVRange fromChatVRange memChatVRange
memberChatVRange@(VersionRange minV maxV) = maybe chatInitialVRange fromChatVRange memChatVRange
DB.execute
db
[sql|
@@ -1028,7 +1041,7 @@ createNewMember_
memberContactId,
memberContactProfileId,
activeConn,
memberChatVRange = JVersionRange mcvr
memberChatVRange
}
checkGroupMemberHasItems :: DB.Connection -> User -> GroupMember -> IO (Maybe ChatItemId)
@@ -1044,14 +1057,14 @@ deleteGroupMember db user@User {userId} m@GroupMember {groupMemberId, groupId, m
when (memberIncognito m) $ deleteUnusedIncognitoProfileById_ db user $ localProfileId memberProfile
cleanupMemberProfileAndName_ :: DB.Connection -> User -> GroupMember -> IO ()
cleanupMemberProfileAndName_ db User {userId} GroupMember {groupMemberId, memberContactId, memberContactProfileId, localDisplayName} =
cleanupMemberProfileAndName_ db user@User {userId} GroupMember {groupMemberId, memberContactId, memberContactProfileId, localDisplayName} =
-- check record has no memberContactId (contact_id) - it means contact has been deleted and doesn't use profile & ldn
when (isNothing memberContactId) $ do
-- check other group member records don't use profile & ldn
sameProfileMember :: (Maybe GroupMemberId) <- maybeFirstRow fromOnly $ DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND contact_profile_id = ? AND group_member_id != ? LIMIT 1" (userId, memberContactProfileId, groupMemberId)
when (isNothing sameProfileMember) $ do
DB.execute db "DELETE FROM contact_profiles WHERE user_id = ? AND contact_profile_id = ?" (userId, memberContactProfileId)
DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
safeDeleteLDN db user localDisplayName
deleteGroupMemberConnection :: DB.Connection -> User -> GroupMember -> IO ()
deleteGroupMemberConnection db User {userId} GroupMember {groupMemberId} =
@@ -1061,7 +1074,7 @@ updateGroupMemberRole :: DB.Connection -> User -> GroupMember -> GroupMemberRole
updateGroupMemberRole db User {userId} GroupMember {groupMemberId} memRole =
DB.execute db "UPDATE group_members SET member_role = ? WHERE user_id = ? AND group_member_id = ?" (memRole, userId, groupMemberId)
createIntroductions :: DB.Connection -> Version -> [GroupMember] -> GroupMember -> IO [GroupMemberIntro]
createIntroductions :: DB.Connection -> VersionChat -> [GroupMember] -> GroupMember -> IO [GroupMemberIntro]
createIntroductions db chatV members toMember = do
let reMembers = filter (\m -> memberCurrent m && groupMemberId' m /= groupMemberId' toMember) members
if null reMembers
@@ -1156,10 +1169,10 @@ 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
getForwardIntroducedMembers :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> Bool -> IO [GroupMember]
getForwardIntroducedMembers db vr user invitee highlyAvailable = do
memberIds <- map fromOnly <$> query
filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db user) memberIds
filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db vr user) memberIds
where
mId = groupMemberId' invitee
query
@@ -1168,7 +1181,7 @@ getForwardIntroducedMembers db user invitee highlyAvailable = do
DB.query
db
(q <> " AND intro_chat_protocol_version >= ?")
(mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, minVersion groupForwardVRange)
(mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, groupForwardVersion)
q =
[sql|
SELECT re_group_member_id
@@ -1176,10 +1189,10 @@ getForwardIntroducedMembers db user invitee highlyAvailable = do
WHERE to_group_member_id = ? AND intro_status NOT IN (?,?,?)
|]
getForwardInvitedMembers :: DB.Connection -> User -> GroupMember -> Bool -> IO [GroupMember]
getForwardInvitedMembers db user forwardMember highlyAvailable = do
getForwardInvitedMembers :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> Bool -> IO [GroupMember]
getForwardInvitedMembers db vr user forwardMember highlyAvailable = do
memberIds <- map fromOnly <$> query
filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db user) memberIds
filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db vr user) memberIds
where
mId = groupMemberId' forwardMember
query
@@ -1188,7 +1201,7 @@ getForwardInvitedMembers db user forwardMember highlyAvailable = do
DB.query
db
(q <> " AND intro_chat_protocol_version >= ?")
(mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, minVersion groupForwardVRange)
(mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, groupForwardVersion)
q =
[sql|
SELECT to_group_member_id
@@ -1196,12 +1209,13 @@ getForwardInvitedMembers db user forwardMember highlyAvailable = do
WHERE re_group_member_id = ? AND intro_status NOT IN (?,?,?)
|]
createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> Maybe MemberRestrictions -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> ExceptT StoreError IO GroupMember
createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> VersionChat -> MemberInfo -> Maybe MemberRestrictions -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> ExceptT StoreError IO GroupMember
createIntroReMember
db
user@User {userId}
gInfo@GroupInfo {groupId}
_host@GroupMember {memberContactId, activeConn}
chatV
memInfo@(MemberInfo _ _ memChatVRange memberProfile)
memRestrictions_
(groupCmdId, groupAgentConnId)
@@ -1214,7 +1228,7 @@ createIntroReMember
currentTs <- liftIO getCurrentTime
newMember <- case directConnIds of
Just (directCmdId, directAgentConnId) -> do
Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId mcvr memberContactId Nothing customUserProfileId cLevel currentTs subMode
Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId chatV mcvr memberContactId Nothing customUserProfileId cLevel currentTs subMode PQSupportOff
liftIO $ setCommandConnId db user directCmdId directConnId
(localDisplayName, contactId, memProfileId) <- createContact_ db userId memberProfile "" (Just groupId) currentTs False
liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, directConnId)
@@ -1224,18 +1238,18 @@ createIntroReMember
pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, 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
conn@Connection {connId = groupConnId} <- createMemberConnection_ db userId (groupMemberId' member) groupAgentConnId chatV mcvr memberContactId cLevel currentTs subMode
liftIO $ setCommandConnId db user groupCmdId groupConnId
pure (member :: GroupMember) {activeConn = Just conn}
createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionRange -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> IO ()
createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = viaContactId, activeConn} _to@GroupMember {groupMemberId, localDisplayName} mcvr (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do
createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionChat -> VersionRangeChat -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> IO ()
createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = viaContactId, activeConn} _to@GroupMember {groupMemberId, localDisplayName} chatV mcvr (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do
let cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn
currentTs <- getCurrentTime
Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId mcvr viaContactId cLevel currentTs subMode
Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId chatV mcvr viaContactId cLevel currentTs subMode
setCommandConnId db user groupCmdId groupConnId
forM_ directConnIds $ \(directCmdId, directAgentConnId) -> do
Connection {connId = directConnId} <- createConnection_ db userId ConnContact Nothing directAgentConnId mcvr viaContactId Nothing customUserProfileId cLevel currentTs subMode
Connection {connId = directConnId} <- createConnection_ db userId ConnContact Nothing directAgentConnId chatV mcvr viaContactId Nothing customUserProfileId cLevel currentTs subMode PQSupportOff
setCommandConnId db user directCmdId directConnId
contactId <- createMemberContact_ directConnId currentTs
updateMember_ contactId currentTs
@@ -1265,10 +1279,11 @@ createIntroToMemberContact db user@User {userId} GroupMember {memberContactId =
|]
[":contact_id" := contactId, ":updated_at" := ts, ":group_member_id" := groupMemberId]
createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> VersionRange -> Maybe Int64 -> Int -> UTCTime -> SubscriptionMode -> IO Connection
createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange viaContact = createConnection_ db userId ConnMember (Just groupMemberId) agentConnId peerChatVRange viaContact Nothing Nothing
createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> VersionChat -> VersionRangeChat -> Maybe Int64 -> Int -> UTCTime -> SubscriptionMode -> IO Connection
createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange viaContact connLevel currentTs subMode =
createConnection_ db userId ConnMember (Just groupMemberId) agentConnId chatV peerChatVRange viaContact Nothing Nothing connLevel currentTs subMode PQSupportOff
getViaGroupMember :: DB.Connection -> VersionRange -> User -> Contact -> IO (Maybe (GroupInfo, GroupMember))
getViaGroupMember :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Contact -> IO (Maybe (GroupInfo, GroupMember))
getViaGroupMember db vr User {userId, userContactId} Contact {contactId} =
maybeFirstRow toGroupAndMember $
DB.query
@@ -1288,8 +1303,9 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} =
m.group_member_id, m.group_id, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.auth_err_counter,
c.peer_chat_min_version, c.peer_chat_max_version
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.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM group_members m
JOIN contacts ct ON ct.contact_id = m.contact_id
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
@@ -1310,10 +1326,10 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} =
toGroupAndMember (groupInfoRow :. memberRow :. connRow) =
let groupInfo = toGroupInfo vr userContactId groupInfoRow
member = toGroupMember userContactId memberRow
in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection connRow})
in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection vr connRow})
getViaGroupContact :: DB.Connection -> User -> GroupMember -> IO (Maybe Contact)
getViaGroupContact db user@User {userId} GroupMember {groupMemberId} = do
getViaGroupContact :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> IO (Maybe Contact)
getViaGroupContact db vr user@User {userId} GroupMember {groupMemberId} = do
contactId_ <-
maybeFirstRow fromOnly $
DB.query
@@ -1327,10 +1343,10 @@ getViaGroupContact db user@User {userId} GroupMember {groupMemberId} = do
LIMIT 1
|]
(userId, groupMemberId)
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db user) contactId_
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db vr user) contactId_
updateGroupProfile :: DB.Connection -> User -> GroupInfo -> GroupProfile -> ExceptT StoreError IO GroupInfo
updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName}} p'@GroupProfile {displayName = newName, fullName, description, image, groupPreferences}
updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName}} p'@GroupProfile {displayName = newName, fullName, description, image, groupPreferences}
| displayName == newName = liftIO $ do
currentTs <- getCurrentTime
updateGroupProfile_ currentTs
@@ -1361,9 +1377,9 @@ updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, grou
db
"UPDATE groups SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND group_id = ?"
(ldn, currentTs, userId, groupId)
DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId)
safeDeleteLDN db user localDisplayName
getGroupInfo :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO GroupInfo
getGroupInfo :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ExceptT StoreError IO GroupInfo
getGroupInfo db vr User {userId, userContactId} groupId =
ExceptT . firstRow (toGroupInfo vr userContactId) (SEGroupNotFound groupId) $
DB.query
@@ -1386,7 +1402,7 @@ getGroupInfo db vr User {userId, userContactId} groupId =
|]
(groupId, userId, userContactId)
getGroupInfoByUserContactLinkConnReq :: DB.Connection -> VersionRange -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe GroupInfo)
getGroupInfoByUserContactLinkConnReq :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe GroupInfo)
getGroupInfoByUserContactLinkConnReq db vr user@User {userId} (cReqSchema1, cReqSchema2) = do
groupId_ <-
maybeFirstRow fromOnly $
@@ -1400,7 +1416,7 @@ getGroupInfoByUserContactLinkConnReq db vr user@User {userId} (cReqSchema1, cReq
(userId, cReqSchema1, cReqSchema2)
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db vr user) groupId_
getGroupInfoByGroupLinkHash :: DB.Connection -> VersionRange -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe GroupInfo)
getGroupInfoByGroupLinkHash :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe GroupInfo)
getGroupInfoByGroupLinkHash db vr user@User {userId, userContactId} (groupLinkHash1, groupLinkHash2) = do
groupId_ <-
maybeFirstRow fromOnly $
@@ -1427,7 +1443,7 @@ getGroupMemberIdByName db User {userId} groupId groupMemberName =
ExceptT . firstRow fromOnly (SEGroupMemberNameNotFound groupId groupMemberName) $
DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND local_display_name = ?" (userId, groupId, groupMemberName)
getActiveMembersByName :: DB.Connection -> VersionRange -> User -> ContactName -> ExceptT StoreError IO [(GroupInfo, GroupMember)]
getActiveMembersByName :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ContactName -> ExceptT StoreError IO [(GroupInfo, GroupMember)]
getActiveMembersByName db vr user@User {userId} groupMemberName = do
groupMemberIds :: [(GroupId, GroupMemberId)] <-
liftIO $
@@ -1442,19 +1458,19 @@ getActiveMembersByName db vr user@User {userId} groupMemberName = do
(userId, groupMemberName, GSMemConnected, GSMemComplete, GCUserMember)
possibleMembers <- forM groupMemberIds $ \(groupId, groupMemberId) -> do
groupInfo <- getGroupInfo db vr user groupId
groupMember <- getGroupMember db user groupId groupMemberId
groupMember <- getGroupMember db vr user groupId groupMemberId
pure (groupInfo, groupMember)
pure $ sortOn (Down . ts . fst) possibleMembers
where
ts GroupInfo {chatTs, updatedAt} = fromMaybe updatedAt chatTs
getMatchingContacts :: DB.Connection -> User -> Contact -> IO [Contact]
getMatchingContacts db user@User {userId} Contact {contactId, profile = LocalProfile {displayName, fullName, image}} = do
getMatchingContacts :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Contact -> IO [Contact]
getMatchingContacts db vr user@User {userId} Contact {contactId, profile = LocalProfile {displayName, fullName, image}} = do
contactIds <-
map fromOnly <$> case image of
Just img -> DB.query db (q <> " AND p.image = ?") (userId, contactId, CSActive, displayName, fullName, img)
Nothing -> DB.query db (q <> " AND p.image is NULL") (userId, contactId, CSActive, displayName, fullName)
rights <$> mapM (runExceptT . getContact db user) contactIds
rights <$> mapM (runExceptT . getContact db vr user) contactIds
where
-- this query is different from one in getMatchingMemberContacts
-- it checks that it's not the same contact
@@ -1464,17 +1480,17 @@ getMatchingContacts db user@User {userId} Contact {contactId, profile = LocalPro
FROM contacts ct
JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id
WHERE ct.user_id = ? AND ct.contact_id != ?
AND ct.contact_status = ? AND ct.deleted = 0
AND ct.contact_status = ? AND ct.deleted = 0 AND ct.is_user = 0
AND p.display_name = ? AND p.full_name = ?
|]
getMatchingMembers :: DB.Connection -> User -> Contact -> IO [GroupMember]
getMatchingMembers db user@User {userId} Contact {profile = LocalProfile {displayName, fullName, image}} = do
getMatchingMembers :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Contact -> IO [GroupMember]
getMatchingMembers db vr user@User {userId} Contact {profile = LocalProfile {displayName, fullName, image}} = do
memberIds <-
map fromOnly <$> case image of
Just img -> DB.query db (q <> " AND p.image = ?") (userId, GCUserMember, displayName, fullName, img)
Nothing -> DB.query db (q <> " AND p.image is NULL") (userId, GCUserMember, displayName, fullName)
filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db user) memberIds
filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db vr user) memberIds
where
-- only match with members without associated contact
q =
@@ -1487,14 +1503,14 @@ getMatchingMembers db user@User {userId} Contact {profile = LocalProfile {displa
AND p.display_name = ? AND p.full_name = ?
|]
getMatchingMemberContacts :: DB.Connection -> User -> GroupMember -> IO [Contact]
getMatchingMemberContacts _ _ GroupMember {memberContactId = Just _} = pure []
getMatchingMemberContacts db user@User {userId} GroupMember {memberProfile = LocalProfile {displayName, fullName, image}} = do
getMatchingMemberContacts :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> IO [Contact]
getMatchingMemberContacts _ _ _ GroupMember {memberContactId = Just _} = pure []
getMatchingMemberContacts db vr user@User {userId} GroupMember {memberProfile = LocalProfile {displayName, fullName, image}} = do
contactIds <-
map fromOnly <$> case image of
Just img -> DB.query db (q <> " AND p.image = ?") (userId, CSActive, displayName, fullName, img)
Nothing -> DB.query db (q <> " AND p.image is NULL") (userId, CSActive, displayName, fullName)
rights <$> mapM (runExceptT . getContact db user) contactIds
rights <$> mapM (runExceptT . getContact db vr user) contactIds
where
q =
[sql|
@@ -1502,7 +1518,7 @@ getMatchingMemberContacts db user@User {userId} GroupMember {memberProfile = Loc
FROM contacts ct
JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id
WHERE ct.user_id = ?
AND ct.contact_status = ? AND ct.deleted = 0
AND ct.contact_status = ? AND ct.deleted = 0 AND ct.is_user = 0
AND p.display_name = ? AND p.full_name = ?
|]
@@ -1526,8 +1542,8 @@ createSentProbeHash db userId probeId to = do
"INSERT INTO sent_probe_hashes (sent_probe_id, contact_id, group_member_id, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
(probeId, ctId, gmId, userId, currentTs, currentTs)
matchReceivedProbe :: DB.Connection -> User -> ContactOrMember -> Probe -> IO [ContactOrMember]
matchReceivedProbe db user@User {userId} from (Probe probe) = do
matchReceivedProbe :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ContactOrMember -> Probe -> IO [ContactOrMember]
matchReceivedProbe db vr user@User {userId} from (Probe probe) = do
let probeHash = C.sha256Hash probe
cgmIds <-
DB.query
@@ -1548,7 +1564,7 @@ matchReceivedProbe db user@User {userId} from (Probe probe) = do
"INSERT INTO received_probes (contact_id, group_member_id, probe, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
(ctId, gmId, probe, probeHash, userId, currentTs, currentTs)
let cgmIds' = filterFirstContactId cgmIds
catMaybes <$> mapM (getContactOrMember_ db user) cgmIds'
catMaybes <$> mapM (getContactOrMember_ db vr user) cgmIds'
where
filterFirstContactId :: [(Maybe ContactId, Maybe GroupId, Maybe GroupMemberId)] -> [(Maybe ContactId, Maybe GroupId, Maybe GroupMemberId)]
filterFirstContactId cgmIds = do
@@ -1558,8 +1574,8 @@ matchReceivedProbe db user@User {userId} from (Probe probe) = do
(x : _) -> [x]
ctIds' <> memIds
matchReceivedProbeHash :: DB.Connection -> User -> ContactOrMember -> ProbeHash -> IO (Maybe (ContactOrMember, Probe))
matchReceivedProbeHash db user@User {userId} from (ProbeHash probeHash) = do
matchReceivedProbeHash :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ContactOrMember -> ProbeHash -> IO (Maybe (ContactOrMember, Probe))
matchReceivedProbeHash db vr user@User {userId} from (ProbeHash probeHash) = do
probeIds <-
maybeFirstRow id $
DB.query
@@ -1579,11 +1595,11 @@ matchReceivedProbeHash db user@User {userId} from (ProbeHash probeHash) = do
db
"INSERT INTO received_probes (contact_id, group_member_id, probe_hash, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
(ctId, gmId, probeHash, userId, currentTs, currentTs)
pure probeIds $>>= \(Only probe :. cgmIds) -> (,Probe probe) <$$> getContactOrMember_ db user cgmIds
pure probeIds $>>= \(Only probe :. cgmIds) -> (,Probe probe) <$$> getContactOrMember_ db vr user cgmIds
matchSentProbe :: DB.Connection -> User -> ContactOrMember -> Probe -> IO (Maybe ContactOrMember)
matchSentProbe db user@User {userId} _from (Probe probe) = do
cgmIds $>>= getContactOrMember_ db user
matchSentProbe :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ContactOrMember -> Probe -> IO (Maybe ContactOrMember)
matchSentProbe db vr user@User {userId} _from (Probe probe) = do
cgmIds $>>= getContactOrMember_ db vr user
where
(ctId, gmId) = contactOrMemberIds _from
cgmIds =
@@ -1602,19 +1618,21 @@ matchSentProbe db user@User {userId} _from (Probe probe) = do
|]
(userId, probe, ctId, gmId)
getContactOrMember_ :: DB.Connection -> User -> (Maybe ContactId, Maybe GroupId, Maybe GroupMemberId) -> IO (Maybe ContactOrMember)
getContactOrMember_ db user ids =
getContactOrMember_ :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> (Maybe ContactId, Maybe GroupId, Maybe GroupMemberId) -> IO (Maybe ContactOrMember)
getContactOrMember_ db vr user ids =
fmap eitherToMaybe . runExceptT $ case ids of
(Just ctId, _, _) -> COMContact <$> getContact db user ctId
(_, Just gId, Just gmId) -> COMGroupMember <$> getGroupMember db user gId gmId
(Just ctId, _, _) -> COMContact <$> getContact db vr user ctId
(_, Just gId, Just gmId) -> COMGroupMember <$> getGroupMember db vr user gId gmId
_ -> throwError $ SEInternalError ""
-- if requested merge direction is overruled (toFromContacts), keepLDN is kept
mergeContactRecords :: DB.Connection -> User -> Contact -> Contact -> ExceptT StoreError IO Contact
mergeContactRecords db user@User {userId} to@Contact {localDisplayName = keepLDN} from = do
mergeContactRecords :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Contact -> Contact -> ExceptT StoreError IO Contact
mergeContactRecords db vr user@User {userId} to@Contact {localDisplayName = keepLDN} from = do
let (toCt, fromCt) = toFromContacts to from
Contact {contactId = toContactId, localDisplayName = toLDN} = toCt
Contact {contactId = fromContactId, localDisplayName = fromLDN} = fromCt
assertNotUser db user toCt
assertNotUser db user fromCt
liftIO $ do
currentTs <- getCurrentTime
-- next query fixes incorrect unused contacts deletion
@@ -1667,7 +1685,7 @@ mergeContactRecords db user@User {userId} to@Contact {localDisplayName = keepLDN
WHERE user_id = ? AND local_display_name = ?
|]
(keepLDN, currentTs, userId, toLDN)
getContact db user toContactId
getContact db vr user toContactId
where
toFromContacts :: Contact -> Contact -> (Contact, Contact)
toFromContacts c1 c2
@@ -1698,9 +1716,10 @@ associateMemberWithContactRecord
when (memProfileId /= profileId) $ deleteUnusedProfile_ db userId memProfileId
when (memLDN /= localDisplayName) $ deleteUnusedDisplayName_ db userId memLDN
associateContactWithMemberRecord :: DB.Connection -> User -> GroupMember -> Contact -> ExceptT StoreError IO Contact
associateContactWithMemberRecord :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> Contact -> ExceptT StoreError IO Contact
associateContactWithMemberRecord
db
vr
user@User {userId}
GroupMember {groupId, groupMemberId, localDisplayName = memLDN, memberProfile = LocalProfile {profileId = memProfileId}}
Contact {contactId, localDisplayName, profile = LocalProfile {profileId}} = do
@@ -1724,7 +1743,7 @@ associateContactWithMemberRecord
(memLDN, memProfileId, currentTs, userId, contactId)
when (profileId /= memProfileId) $ deleteUnusedProfile_ db userId profileId
when (localDisplayName /= memLDN) $ deleteUnusedDisplayName_ db userId localDisplayName
getContact db user contactId
getContact db vr user contactId
deleteUnusedDisplayName_ :: DB.Connection -> UserId -> ContactName -> IO ()
deleteUnusedDisplayName_ db userId localDisplayName =
@@ -1872,7 +1891,7 @@ createMemberContact
cReq
gInfo
GroupMember {groupMemberId, localDisplayName, memberProfile, memberContactProfileId}
Connection {connLevel, peerChatVRange = peerChatVRange@(JVersionRange (VersionRange minV maxV))}
Connection {connLevel, connChatVersion, peerChatVRange = peerChatVRange@(VersionRange minV maxV)}
subMode = do
currentTs <- getCurrentTime
let incognitoProfile = incognitoMembershipProfile gInfo
@@ -1899,25 +1918,49 @@ createMemberContact
[sql|
INSERT INTO connections (
user_id, agent_conn_id, conn_req_inv, conn_level, conn_status, conn_type, contact_conn_initiated, contact_id, custom_user_profile_id,
peer_chat_min_version, peer_chat_max_version, created_at, updated_at, to_subscribe
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
conn_chat_version, peer_chat_min_version, peer_chat_max_version, created_at, updated_at, to_subscribe
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, acId, cReq, connLevel, ConnNew, ConnContact, True, contactId, customUserProfileId)
:. (minV, maxV, currentTs, currentTs, subMode == SMOnlyCreate)
:. (connChatVersion, minV, maxV, currentTs, currentTs, subMode == SMOnlyCreate)
)
connId <- insertedRowId db
let ctConn = Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType = ConnContact, contactConnInitiated = True, entityId = Just contactId, viaContact = Nothing, viaUserContactLink = Nothing, viaGroupLink = False, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}
let ctConn =
Connection
{ connId,
agentConnId = AgentConnId acId,
peerChatVRange,
connChatVersion,
connType = ConnContact,
contactConnInitiated = True,
entityId = Just contactId,
viaContact = Nothing,
viaUserContactLink = Nothing,
viaGroupLink = False,
groupLinkId = Nothing,
customUserProfileId,
connLevel,
connStatus = ConnNew,
localAlias = "",
createdAt = currentTs,
connectionCode = Nothing,
pqSupport = PQSupportOff,
pqEncryption = PQEncOff,
pqSndEnabled = Nothing,
pqRcvEnabled = Nothing,
authErrCounter = 0
}
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False}
getMemberContact :: DB.Connection -> VersionRange -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
getMemberContact :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
getMemberContact db vr user contactId = do
ct <- getContact db user contactId
ct <- getContact db vr user contactId
let Contact {contactGroupMemberId, activeConn} = ct
case (activeConn, contactGroupMemberId) of
(Just Connection {connId}, Just groupMemberId) -> do
cReq <- getConnReqInv db connId
m@GroupMember {groupId} <- getGroupMemberById db user groupMemberId
m@GroupMember {groupId} <- getGroupMemberById db vr user groupMemberId
g <- getGroupInfo db vr user groupId
pure (g, m, ct, cReq)
_ ->
@@ -1997,7 +2040,7 @@ createMemberContactConn_
user@User {userId}
(cmdId, acId)
gInfo
_memberConn@Connection {connLevel, peerChatVRange = peerChatVRange@(JVersionRange (VersionRange minV maxV))}
_memberConn@Connection {connLevel, connChatVersion, peerChatVRange = peerChatVRange@(VersionRange minV maxV)}
contactId
subMode = do
currentTs <- liftIO getCurrentTime
@@ -2007,18 +2050,42 @@ createMemberContactConn_
[sql|
INSERT INTO connections (
user_id, agent_conn_id, conn_level, conn_status, conn_type, contact_id, custom_user_profile_id,
peer_chat_min_version, peer_chat_max_version, created_at, updated_at, to_subscribe
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
conn_chat_version, peer_chat_min_version, peer_chat_max_version, created_at, updated_at, to_subscribe
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, acId, connLevel, ConnJoined, ConnContact, contactId, customUserProfileId)
:. (minV, maxV, currentTs, currentTs, subMode == SMOnlyCreate)
:. (connChatVersion, minV, maxV, currentTs, currentTs, subMode == SMOnlyCreate)
)
connId <- insertedRowId db
setCommandConnId db user cmdId connId
pure Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType = ConnContact, contactConnInitiated = False, entityId = Just contactId, viaContact = Nothing, viaUserContactLink = Nothing, viaGroupLink = False, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnJoined, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}
pure
Connection
{ connId,
agentConnId = AgentConnId acId,
connChatVersion,
peerChatVRange,
connType = ConnContact,
contactConnInitiated = False,
entityId = Just contactId,
viaContact = Nothing,
viaUserContactLink = Nothing,
viaGroupLink = False,
groupLinkId = Nothing,
customUserProfileId,
connLevel,
connStatus = ConnJoined,
localAlias = "",
createdAt = currentTs,
connectionCode = Nothing,
pqSupport = PQSupportOff,
pqEncryption = PQEncOff,
pqSndEnabled = Nothing,
pqRcvEnabled = Nothing,
authErrCounter = 0
}
updateMemberProfile :: DB.Connection -> User -> GroupMember -> Profile -> ExceptT StoreError IO GroupMember
updateMemberProfile db User {userId} m p'
updateMemberProfile db user@User {userId} m p'
| displayName == newName = do
liftIO $ updateMemberContactProfileReset_ db userId profileId p'
pure m {memberProfile = profile}
@@ -2030,7 +2097,7 @@ updateMemberProfile db User {userId} m p'
db
"UPDATE group_members SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND group_member_id = ?"
(ldn, currentTs, userId, groupMemberId)
DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId)
safeDeleteLDN db user localDisplayName
pure $ Right m {localDisplayName = ldn, memberProfile = profile}
where
GroupMember {groupMemberId, localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m
@@ -2038,7 +2105,7 @@ updateMemberProfile db User {userId} m p'
profile = toLocalProfile profileId p' localAlias
updateContactMemberProfile :: DB.Connection -> User -> GroupMember -> Contact -> Profile -> ExceptT StoreError IO (GroupMember, Contact)
updateContactMemberProfile db User {userId} m ct@Contact {contactId} p'
updateContactMemberProfile db user@User {userId} m ct@Contact {contactId} p'
| displayName == newName = do
liftIO $ updateMemberContactProfile_ db userId profileId p'
pure (m {memberProfile = profile}, ct {profile} :: Contact)
@@ -2046,7 +2113,7 @@ updateContactMemberProfile db User {userId} m ct@Contact {contactId} p'
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
currentTs <- getCurrentTime
updateMemberContactProfile_' db userId profileId p' currentTs
updateContactLDN_ db userId contactId localDisplayName ldn currentTs
updateContactLDN_ db user contactId localDisplayName ldn currentTs
pure $ Right (m {localDisplayName = ldn, memberProfile = profile}, ct {localDisplayName = ldn, profile} :: Contact)
where
GroupMember {localDisplayName, memberProfile = LocalProfile {profileId, displayName, localAlias}} = m
@@ -2066,7 +2133,7 @@ setXGrpLinkMemReceived db mId xGrpLinkMemReceived = do
"UPDATE group_members SET xgrplinkmem_received = ?, updated_at = ? WHERE group_member_id = ?"
(xGrpLinkMemReceived, currentTs, mId)
createNewUnknownGroupMember :: DB.Connection -> VersionRange -> User -> GroupInfo -> MemberId -> Text -> ExceptT StoreError IO GroupMember
createNewUnknownGroupMember :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupInfo -> MemberId -> Text -> ExceptT StoreError IO GroupMember
createNewUnknownGroupMember db vr user@User {userId, userContactId} GroupInfo {groupId} memberId memberName = do
currentTs <- liftIO getCurrentTime
let memberProfile = profileFromName memberName
@@ -2086,12 +2153,12 @@ createNewUnknownGroupMember db vr user@User {userId, userContactId} GroupInfo {g
:. (minV, maxV)
)
insertedRowId db
getGroupMemberById db user groupMemberId
getGroupMemberById db vr user groupMemberId
where
VersionRange minV maxV = vr
VersionRange minV maxV = vr PQSupportOff
updateUnknownMemberAnnounced :: DB.Connection -> User -> GroupMember -> GroupMember -> MemberInfo -> ExceptT StoreError IO GroupMember
updateUnknownMemberAnnounced db user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile} = do
updateUnknownMemberAnnounced :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> GroupMember -> MemberInfo -> ExceptT StoreError IO GroupMember
updateUnknownMemberAnnounced db vr user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile} = do
_ <- updateMemberProfile db user unknownMember profile
currentTs <- liftIO getCurrentTime
liftIO $
@@ -2111,9 +2178,9 @@ updateUnknownMemberAnnounced db user@User {userId} invitingMember unknownMember@
( (memberRole, GCPostMember, GSMemAnnounced, groupMemberId' invitingMember)
:. (minV, maxV, currentTs, userId, groupMemberId)
)
getGroupMemberById db user groupMemberId
getGroupMemberById db vr user groupMemberId
where
VersionRange minV maxV = maybe (fromJVersionRange memberChatVRange) fromChatVRange v
VersionRange minV maxV = maybe memberChatVRange fromChatVRange v
updateUserMemberProfileSentAt :: DB.Connection -> User -> GroupInfo -> UTCTime -> IO ()
updateUserMemberProfileSentAt db User {userId} GroupInfo {groupId} sentTs =
+24 -22
View File
@@ -148,6 +148,7 @@ import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, MsgMeta (..), UserI
import Simplex.Messaging.Agent.Store.SQLite (firstRow, firstRow', maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet (PQSupport)
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
import Simplex.Messaging.Util (eitherToMaybe, (<$$>))
import Simplex.Messaging.Version (VersionRange)
@@ -475,7 +476,8 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
LEFT JOIN contacts c ON m.contact_id = c.contact_id
LEFT JOIN chat_items i ON i.group_id = m.group_id
LEFT JOIN chat_items i ON i.user_id = m.user_id
AND i.group_id = m.group_id
AND m.group_member_id = i.group_member_id
AND i.shared_msg_id = :msg_id
WHERE m.user_id = :user_id AND m.group_id = :group_id AND m.member_id = :member_id
@@ -486,7 +488,7 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
ciQuoteGroup [] = ciQuote Nothing $ CIQGroupRcv Nothing
ciQuoteGroup ((Only itemId :. memberRow) : _) = ciQuote itemId . CIQGroupRcv . Just $ toGroupMember userContactId memberRow
getChatPreviews :: DB.Connection -> VersionRange -> User -> Bool -> PaginationByTime -> ChatListQuery -> IO [Either StoreError AChat]
getChatPreviews :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Bool -> PaginationByTime -> ChatListQuery -> IO [Either StoreError AChat]
getChatPreviews db vr user withPCC pagination query = do
directChats <- findDirectChatPreviews_ db user pagination query
groupChats <- findGroupChatPreviews_ db user pagination query
@@ -509,7 +511,7 @@ getChatPreviews db vr user withPCC pagination query = do
PTBefore _ count -> take count . sortBy (comparing $ Down . ts)
getChatPreview :: AChatPreviewData -> ExceptT StoreError IO AChat
getChatPreview (ACPD cType cpd) = case cType of
SCTDirect -> getDirectChatPreview_ db user cpd
SCTDirect -> getDirectChatPreview_ db vr user cpd
SCTGroup -> getGroupChatPreview_ db vr user cpd
SCTLocal -> getLocalChatPreview_ db user cpd
SCTContactRequest -> let (ContactRequestPD _ chat) = cpd in pure chat
@@ -623,9 +625,9 @@ findDirectChatPreviews_ db User {userId} pagination clq =
)
([":user_id" := userId, ":rcv_new" := CISRcvNew, ":search" := search] <> pagParams)
getDirectChatPreview_ :: DB.Connection -> User -> ChatPreviewData 'CTDirect -> ExceptT StoreError IO AChat
getDirectChatPreview_ db user (DirectChatPD _ contactId lastItemId_ stats) = do
contact <- getContact db user contactId
getDirectChatPreview_ :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ChatPreviewData 'CTDirect -> ExceptT StoreError IO AChat
getDirectChatPreview_ db vr user (DirectChatPD _ contactId lastItemId_ stats) = do
contact <- getContact db vr user contactId
lastItem <- case lastItemId_ of
Just lastItemId -> (: []) <$> getDirectChatItem db user contactId lastItemId
Nothing -> pure []
@@ -719,7 +721,7 @@ findGroupChatPreviews_ db User {userId} pagination clq =
)
([":user_id" := userId, ":rcv_new" := CISRcvNew, ":search" := search] <> pagParams)
getGroupChatPreview_ :: DB.Connection -> VersionRange -> User -> ChatPreviewData 'CTGroup -> ExceptT StoreError IO AChat
getGroupChatPreview_ :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ChatPreviewData 'CTGroup -> ExceptT StoreError IO AChat
getGroupChatPreview_ db vr user (GroupChatPD _ groupId lastItemId_ stats) = do
groupInfo <- getGroupInfo db vr user groupId
lastItem <- case lastItemId_ of
@@ -861,7 +863,7 @@ getContactRequestChatPreviews_ db User {userId} pagination clq = case clq of
( [sql|
SELECT
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id,
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, p.preferences,
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 as ts,
cr.peer_chat_min_version, cr.peer_chat_max_version
FROM contact_requests cr
@@ -924,10 +926,10 @@ getContactConnectionChatPreviews_ db User {userId} pagination clq = case clq of
aChat = AChat SCTContactConnection $ Chat (ContactConnection conn) [] stats
in ACPD SCTContactConnection $ ContactConnectionPD updatedAt aChat
getDirectChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChat db user contactId pagination search_ = do
getDirectChat :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChat db vr user contactId pagination search_ = do
let search = fromMaybe "" search_
ct <- getContact db user contactId
ct <- getContact db vr user contactId
liftIO $ case pagination of
CPLast count -> getDirectChatLast_ db user ct count search
CPAfter afterId count -> getDirectChatAfter_ db user ct afterId count search
@@ -1044,7 +1046,7 @@ getDirectChatBefore_ db user@User {userId} ct@Contact {contactId} beforeChatItem
|]
(userId, contactId, search, beforeChatItemId, count)
getGroupChat :: DB.Connection -> VersionRange -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChat :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChat db vr user groupId pagination search_ = do
let search = fromMaybe "" search_
g <- getGroupInfo db vr user groupId
@@ -1510,7 +1512,7 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
ciTimed :: Maybe CITimed
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
getAllChatItems :: DB.Connection -> VersionRange -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem]
getAllChatItems :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem]
getAllChatItems db vr user@User {userId} pagination search_ = do
itemRefs <-
rights . map toChatItemRef <$> case pagination of
@@ -2154,7 +2156,7 @@ deleteLocalChatItem db User {userId} NoteFolder {noteFolderId} ci = do
|]
(userId, noteFolderId, itemId)
getChatItemByFileId :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO AChatItem
getChatItemByFileId :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ExceptT StoreError IO AChatItem
getChatItemByFileId db vr user@User {userId} fileId = do
(chatRef, itemId) <-
ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByFileId fileId) $
@@ -2170,13 +2172,13 @@ getChatItemByFileId db vr user@User {userId} fileId = do
(userId, fileId)
getAChatItem db vr user chatRef itemId
lookupChatItemByFileId :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO (Maybe AChatItem)
lookupChatItemByFileId :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ExceptT StoreError IO (Maybe AChatItem)
lookupChatItemByFileId db vr user fileId = do
fmap Just (getChatItemByFileId db vr user fileId) `catchError` \case
SEChatItemNotFoundByFileId {} -> pure Nothing
e -> throwError e
getChatItemByGroupId :: DB.Connection -> VersionRange -> User -> GroupId -> ExceptT StoreError IO AChatItem
getChatItemByGroupId :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupId -> ExceptT StoreError IO AChatItem
getChatItemByGroupId db vr user@User {userId} groupId = do
(chatRef, itemId) <-
ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByGroupId groupId) $
@@ -2202,10 +2204,10 @@ getChatRefViaItemId db User {userId} itemId = do
(Nothing, Just groupId) -> Right $ ChatRef CTGroup groupId
(_, _) -> Left $ SEBadChatItem itemId Nothing
getAChatItem :: DB.Connection -> VersionRange -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem
getAChatItem :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem
getAChatItem db vr user chatRef itemId = case chatRef of
ChatRef CTDirect contactId -> do
ct <- getContact db user contactId
ct <- getContact db vr user contactId
(CChatItem msgDir ci) <- getDirectChatItem db user contactId itemId
pure $ AChatItem SCTDirect msgDir (DirectChat ct) ci
ChatRef CTGroup groupId -> do
@@ -2442,9 +2444,9 @@ createCIModeration db GroupInfo {groupId} moderatorMember itemMemberId itemShare
|]
(groupId, groupMemberId' moderatorMember, itemMemberId, itemSharedMId, msgId, moderatedAtTs)
getCIModeration :: DB.Connection -> User -> GroupInfo -> MemberId -> Maybe SharedMsgId -> IO (Maybe CIModeration)
getCIModeration _ _ _ _ Nothing = pure Nothing
getCIModeration db user GroupInfo {groupId} itemMemberId (Just sharedMsgId) = do
getCIModeration :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupInfo -> MemberId -> Maybe SharedMsgId -> IO (Maybe CIModeration)
getCIModeration _ _ _ _ _ Nothing = pure Nothing
getCIModeration db vr user GroupInfo {groupId} itemMemberId (Just sharedMsgId) = do
r_ <-
maybeFirstRow id $
DB.query
@@ -2458,7 +2460,7 @@ getCIModeration db user GroupInfo {groupId} itemMemberId (Just sharedMsgId) = do
(groupId, itemMemberId, sharedMsgId)
case r_ of
Just (moderationId, moderatorId, createdByMsgId, moderatedAt) -> do
runExceptT (getGroupMember db user groupId moderatorId) >>= \case
runExceptT (getGroupMember db vr user groupId moderatorId) >>= \case
Right moderatorMember -> pure (Just CIModeration {moderationId, moderatorMember, createdByMsgId, moderatedAt})
_ -> pure Nothing
_ -> pure Nothing
+7 -1
View File
@@ -99,6 +99,9 @@ import Simplex.Chat.Migrations.M20240104_members_profile_update
import Simplex.Chat.Migrations.M20240115_block_member_for_all
import Simplex.Chat.Migrations.M20240122_indexes
import Simplex.Chat.Migrations.M20240214_redirect_file_id
import Simplex.Chat.Migrations.M20240222_app_settings
import Simplex.Chat.Migrations.M20240226_users_restrict
import Simplex.Chat.Migrations.M20240228_pq
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@@ -197,7 +200,10 @@ schemaMigrations =
("20240104_members_profile_update", m20240104_members_profile_update, Just down_m20240104_members_profile_update),
("20240115_block_member_for_all", m20240115_block_member_for_all, Just down_m20240115_block_member_for_all),
("20240122_indexes", m20240122_indexes, Just down_m20240122_indexes),
("20240214_redirect_file_id", m20240214_redirect_file_id, Just down_m20240214_redirect_file_id)
("20240214_redirect_file_id", m20240214_redirect_file_id, Just down_m20240214_redirect_file_id),
("20240222_app_settings", m20240222_app_settings, Just down_m20240222_app_settings),
("20240226_users_restrict", m20240226_users_restrict, Just down_m20240226_users_restrict),
("20240228_pq", m20240228_pq, Just down_m20240228_pq)
]
-- | The list of migrations in ascending order by date
+20 -15
View File
@@ -85,6 +85,8 @@ import Simplex.Messaging.Agent.Protocol (ACorrId, ConnId, UserId)
import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import qualified Simplex.Messaging.Crypto as C
import qualified Simplex.Messaging.Crypto.Ratchet as CR
import Simplex.Messaging.Crypto.Ratchet (PQSupport)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON)
import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI (..), SubscriptionMode)
@@ -267,7 +269,7 @@ updateUserProfile db user p'
"INSERT INTO display_names (local_display_name, ldn_base, user_id, created_at, updated_at) VALUES (?,?,?,?,?)"
(newName, newName, userId, currentTs, currentTs)
updateContactProfile_' db userId profileId p' currentTs
updateContactLDN_ db userId userContactId localDisplayName newName currentTs
updateContactLDN_ db user userContactId localDisplayName newName currentTs
pure user {localDisplayName = newName, profile, fullPreferences, userMemberProfileUpdatedAt = userMemberProfileUpdatedAt'}
where
updateUserMemberProfileUpdatedAt_ currentTs
@@ -323,37 +325,39 @@ createUserContactLink db User {userId} agentConnId cReq subMode =
"INSERT INTO user_contact_links (user_id, conn_req_contact, created_at, updated_at) VALUES (?,?,?,?)"
(userId, cReq, currentTs, currentTs)
userContactLinkId <- insertedRowId db
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode CR.PQSupportOff
getUserAddressConnections :: DB.Connection -> User -> ExceptT StoreError IO [Connection]
getUserAddressConnections db User {userId} = do
getUserAddressConnections :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ExceptT StoreError IO [Connection]
getUserAddressConnections db vr User {userId} = do
cs <- liftIO getUserAddressConnections_
if null cs then throwError SEUserContactLinkNotFound else pure cs
where
getUserAddressConnections_ :: IO [Connection]
getUserAddressConnections_ =
map toConnection
map (toConnection vr)
<$> 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.auth_err_counter,
c.peer_chat_min_version, c.peer_chat_max_version
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.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM connections c
JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id
WHERE c.user_id = ? AND uc.user_id = ? AND uc.local_display_name = '' AND uc.group_id IS NULL
|]
(userId, userId)
getUserContactLinks :: DB.Connection -> User -> IO [(Connection, UserContact)]
getUserContactLinks db User {userId} =
getUserContactLinks :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> IO [(Connection, UserContact)]
getUserContactLinks db vr User {userId} =
map toUserContactConnection
<$> 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.auth_err_counter,
c.peer_chat_min_version, c.peer_chat_max_version,
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.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
uc.user_contact_link_id, uc.conn_req_contact, uc.group_id
FROM connections c
JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id
@@ -362,7 +366,7 @@ getUserContactLinks db User {userId} =
(userId, userId)
where
toUserContactConnection :: (ConnectionRow :. (Int64, ConnReqContact, Maybe GroupId)) -> (Connection, UserContact)
toUserContactConnection (connRow :. (userContactLinkId, connReqContact, groupId)) = (toConnection connRow, UserContact {userContactLinkId, connReqContact, groupId})
toUserContactConnection (connRow :. (userContactLinkId, connReqContact, groupId)) = (toConnection vr connRow, UserContact {userContactLinkId, connReqContact, groupId})
deleteUserAddress :: DB.Connection -> User -> IO ()
deleteUserAddress db user@User {userId} = do
@@ -388,6 +392,7 @@ deleteUserAddress db user@User {userId} = do
JOIN user_contact_links uc USING (user_contact_link_id)
WHERE uc.user_id = :user_id AND uc.local_display_name = '' AND uc.group_id IS NULL
)
AND local_display_name NOT IN (SELECT local_display_name FROM users WHERE user_id = :user_id)
|]
[":user_id" := userId]
DB.executeNamed
@@ -469,8 +474,8 @@ getUserContactLinkByConnReq db User {userId} (cReqSchema1, cReqSchema2) =
|]
(userId, cReqSchema1, cReqSchema2)
getContactWithoutConnViaAddress :: DB.Connection -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe Contact)
getContactWithoutConnViaAddress db user@User {userId} (cReqSchema1, cReqSchema2) = do
getContactWithoutConnViaAddress :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe Contact)
getContactWithoutConnViaAddress db vr user@User {userId} (cReqSchema1, cReqSchema2) = do
ctId_ <-
maybeFirstRow fromOnly $
DB.query
@@ -483,7 +488,7 @@ getContactWithoutConnViaAddress db user@User {userId} (cReqSchema1, cReqSchema2)
WHERE cp.user_id = ? AND cp.contact_link IN (?,?) AND c.connection_id IS NULL
|]
(userId, cReqSchema1, cReqSchema2)
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db user) ctId_
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getContact db vr user) ctId_
updateUserAddressAutoAccept :: DB.Connection -> User -> Maybe AutoAccept -> ExceptT StoreError IO UserContactLink
updateUserAddressAutoAccept db user@User {userId} autoAccept = do
+155 -30
View File
@@ -4,6 +4,7 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
@@ -36,6 +37,8 @@ import Simplex.Messaging.Agent.Protocol (ConnId, UserId)
import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..))
import qualified Simplex.Messaging.Crypto.Ratchet as CR
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Util (allFinally)
@@ -92,6 +95,8 @@ data StoreError
| SEUniqueID
| SELargeMsg
| SEInternalError {message :: String}
| SEDBException {message :: String}
| SEDBBusyError {message :: String}
| SEBadChatItem {itemId :: ChatItemId, itemTs :: Maybe ChatItemTs}
| SEChatItemNotFound {itemId :: ChatItemId}
| SEChatItemNotFoundByText {text :: Text}
@@ -111,6 +116,7 @@ data StoreError
| SERemoteHostDuplicateCA
| SERemoteCtrlNotFound {remoteCtrlId :: RemoteCtrlId}
| SERemoteCtrlDuplicateCA
| SEProhibitedDeleteUser {userId :: UserId, contactId :: ContactId}
deriving (Show, Exception)
$(J.deriveJSON (sumTypeJSON $ dropPrefix "SE") ''StoreError)
@@ -147,17 +153,38 @@ toFileInfo (fileId, fileStatus, filePath) = CIFileInfo {fileId, fileStatus, file
type EntityIdsRow = (Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64)
type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, Bool, Maybe GroupLinkId, Maybe Int64, ConnStatus, ConnType, Bool, LocalAlias) :. EntityIdsRow :. (UTCTime, Maybe Text, Maybe UTCTime, Int, Version, Version)
type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, Bool, Maybe GroupLinkId, Maybe Int64, ConnStatus, ConnType, Bool, LocalAlias) :. EntityIdsRow :. (UTCTime, Maybe Text, Maybe UTCTime, PQSupport, PQEncryption, Maybe PQEncryption, Maybe PQEncryption, Int, Maybe VersionChat, VersionChat, VersionChat)
type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe Int64, Maybe Bool, Maybe GroupLinkId, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Bool, Maybe LocalAlias) :. EntityIdsRow :. (Maybe UTCTime, Maybe Text, Maybe UTCTime, Maybe Int, Maybe Version, Maybe Version)
type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe Int64, Maybe Bool, Maybe GroupLinkId, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Bool, Maybe LocalAlias) :. EntityIdsRow :. (Maybe UTCTime, Maybe Text, Maybe UTCTime, Maybe PQSupport, Maybe PQEncryption, Maybe PQEncryption, Maybe PQEncryption, Maybe Int, Maybe VersionChat, Maybe VersionChat, Maybe VersionChat)
toConnection :: ConnectionRow -> Connection
toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, authErrCounter, minVer, maxVer)) =
let entityId = entityId_ connType
connectionCode = SecurityCode <$> code_ <*> verifiedAt_
peerChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
in Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias, entityId, connectionCode, authErrCounter, createdAt}
toConnection :: (PQSupport -> VersionRangeChat) -> ConnectionRow -> Connection
toConnection vr ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled, pqRcvEnabled, authErrCounter, chatV, minVer, maxVer)) =
Connection
{ connId,
agentConnId = AgentConnId acId,
connChatVersion = fromMaybe (vr pqSupport `peerConnChatVersion` peerChatVRange) chatV,
peerChatVRange = peerChatVRange,
connLevel,
viaContact,
viaUserContactLink,
viaGroupLink,
groupLinkId,
customUserProfileId,
connStatus,
connType,
contactConnInitiated,
localAlias,
entityId = entityId_ connType,
connectionCode = SecurityCode <$> code_ <*> verifiedAt_,
pqSupport,
pqEncryption,
pqSndEnabled,
pqRcvEnabled,
authErrCounter,
createdAt
}
where
peerChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
entityId_ :: ConnType -> Maybe Int64
entityId_ ConnContact = contactId
entityId_ ConnMember = groupMemberId
@@ -165,13 +192,13 @@ toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroup
entityId_ ConnSndFile = sndFileId
entityId_ ConnUserContact = userContactLinkId
toMaybeConnection :: MaybeConnectionRow -> Maybe Connection
toMaybeConnection ((Just connId, Just agentConnId, Just connLevel, viaContact, viaUserContactLink, Just viaGroupLink, groupLinkId, customUserProfileId, Just connStatus, Just connType, Just contactConnInitiated, Just localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (Just createdAt, code_, verifiedAt_, Just authErrCounter, Just minVer, Just maxVer)) =
Just $ toConnection ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, authErrCounter, minVer, maxVer))
toMaybeConnection _ = Nothing
toMaybeConnection :: (PQSupport -> VersionRangeChat) -> MaybeConnectionRow -> Maybe Connection
toMaybeConnection vr ((Just connId, Just agentConnId, Just connLevel, viaContact, viaUserContactLink, Just viaGroupLink, groupLinkId, customUserProfileId, Just connStatus, Just connType, Just contactConnInitiated, Just localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (Just createdAt, code_, verifiedAt_, Just pqSupport, Just pqEncryption, pqSndEnabled_, pqRcvEnabled_, Just authErrCounter, connChatVersion, Just minVer, Just maxVer)) =
Just $ toConnection vr ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled_, pqRcvEnabled_, authErrCounter, connChatVersion, minVer, maxVer))
toMaybeConnection _ _ = Nothing
createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> VersionRange -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> SubscriptionMode -> IO Connection
createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange minV maxV) viaContact viaUserContactLink customUserProfileId connLevel currentTs subMode = do
createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> VersionChat -> VersionRangeChat -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> SubscriptionMode -> PQSupport -> IO Connection
createConnection_ db userId connType entityId acId connChatVersion peerChatVRange@(VersionRange minV maxV) viaContact viaUserContactLink customUserProfileId connLevel currentTs subMode pqSup = do
viaLinkGroupId :: Maybe Int64 <- fmap join . forM viaUserContactLink $ \ucLinkId ->
maybeFirstRow fromOnly $ DB.query db "SELECT group_id FROM user_contact_links WHERE user_id = ? AND user_contact_link_id = ? AND group_id IS NOT NULL" (userId, ucLinkId)
let viaGroupLink = isJust viaLinkGroupId
@@ -181,15 +208,39 @@ createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange
INSERT INTO connections (
user_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, custom_user_profile_id, conn_status, conn_type,
contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version, to_subscribe
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
conn_chat_version, peer_chat_min_version, peer_chat_max_version, to_subscribe, pq_support, pq_encryption
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, customUserProfileId, ConnNew, connType)
:. (ent ConnContact, ent ConnMember, ent ConnSndFile, ent ConnRcvFile, ent ConnUserContact, currentTs, currentTs)
:. (minV, maxV, subMode == SMOnlyCreate)
:. (connChatVersion, minV, maxV, subMode == SMOnlyCreate, pqSup, pqSup)
)
connId <- insertedRowId db
pure Connection {connId, agentConnId = AgentConnId acId, peerChatVRange = JVersionRange peerChatVRange, connType, contactConnInitiated = False, entityId, viaContact, viaUserContactLink, viaGroupLink, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}
pure
Connection
{ connId,
agentConnId = AgentConnId acId,
connChatVersion,
peerChatVRange,
connType,
contactConnInitiated = False,
entityId,
viaContact,
viaUserContactLink,
viaGroupLink,
groupLinkId = Nothing,
customUserProfileId,
connLevel,
connStatus = ConnNew,
localAlias = "",
createdAt = currentTs,
connectionCode = Nothing,
pqSupport = pqSup,
pqEncryption = CR.pqSupportToEnc pqSup,
pqSndEnabled = Nothing,
pqRcvEnabled = Nothing,
authErrCounter = 0
}
where
ent ct = if connType == ct then entityId else Nothing
@@ -204,18 +255,62 @@ createIncognitoProfile_ db userId createdAt Profile {displayName, fullName, imag
(displayName, fullName, image, userId, Just True, createdAt, createdAt)
insertedRowId db
setPeerChatVRange :: DB.Connection -> Int64 -> VersionRange -> IO ()
setPeerChatVRange db connId (VersionRange minVer maxVer) =
updateConnSupportPQ :: DB.Connection -> Int64 -> PQSupport -> PQEncryption -> IO ()
updateConnSupportPQ db connId pqSup pqEnc =
DB.execute
db
[sql|
UPDATE connections
SET peer_chat_min_version = ?, peer_chat_max_version = ?
SET pq_support = ?, pq_encryption = ?
WHERE connection_id = ?
|]
(minVer, maxVer, connId)
(pqSup, pqEnc, connId)
setMemberChatVRange :: DB.Connection -> GroupMemberId -> VersionRange -> IO ()
updateConnPQSndEnabled :: DB.Connection -> Int64 -> PQEncryption -> IO ()
updateConnPQSndEnabled db connId pqSndEnabled =
DB.execute
db
[sql|
UPDATE connections
SET pq_snd_enabled = ?
WHERE connection_id = ?
|]
(pqSndEnabled, connId)
updateConnPQRcvEnabled :: DB.Connection -> Int64 -> PQEncryption -> IO ()
updateConnPQRcvEnabled db connId pqRcvEnabled =
DB.execute
db
[sql|
UPDATE connections
SET pq_rcv_enabled = ?
WHERE connection_id = ?
|]
(pqRcvEnabled, connId)
updateConnPQEnabledCON :: DB.Connection -> Int64 -> PQEncryption -> IO ()
updateConnPQEnabledCON db connId pqEnabled =
DB.execute
db
[sql|
UPDATE connections
SET pq_snd_enabled = ?, pq_rcv_enabled = ?
WHERE connection_id = ?
|]
(pqEnabled, pqEnabled, connId)
setPeerChatVRange :: DB.Connection -> Int64 -> VersionChat -> VersionRangeChat -> IO ()
setPeerChatVRange db connId chatV (VersionRange minVer maxVer) =
DB.execute
db
[sql|
UPDATE connections
SET conn_chat_version = ?, peer_chat_min_version = ?, peer_chat_max_version = ?
WHERE connection_id = ?
|]
(chatV, minVer, maxVer, connId)
setMemberChatVRange :: DB.Connection -> GroupMemberId -> VersionRangeChat -> IO ()
setMemberChatVRange db mId (VersionRange minVer maxVer) =
DB.execute
db
@@ -278,10 +373,10 @@ deleteUnusedIncognitoProfileById_ db User {userId} profileId =
type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool, ContactStatus) :. (Maybe MsgFilter, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)
toContact :: User -> ContactRow :. MaybeConnectionRow -> Contact
toContact user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) =
toContact :: (PQSupport -> VersionRangeChat) -> User -> ContactRow :. MaybeConnectionRow -> Contact
toContact vr user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
activeConn = toMaybeConnection connRow
activeConn = toMaybeConnection vr connRow
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
incognito = maybe False connIncognito activeConn
mergedPreferences = contactUserPreferences user userPreferences preferences incognito
@@ -302,13 +397,13 @@ getProfileById db userId profileId =
toProfile :: (ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences) -> LocalProfile
toProfile (displayName, fullName, image, contactLink, localAlias, preferences) = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact) :. (Maybe XContactId, Maybe Preferences, UTCTime, UTCTime, Version, Version)
type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact) :. (Maybe XContactId, PQSupport, Maybe Preferences, UTCTime, UTCTime, VersionChat, VersionChat)
toContactRequest :: ContactRequestRow -> UserContactRequest
toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image, contactLink) :. (xContactId, preferences, createdAt, updatedAt, minVer, maxVer)) = do
toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image, contactLink) :. (xContactId, pqSupport, preferences, createdAt, updatedAt, minVer, maxVer)) = do
let profile = Profile {displayName, fullName, image, contactLink, preferences}
cReqChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
in UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, cReqChatVRange, localDisplayName, profileId, profile, xContactId, createdAt, updatedAt}
cReqChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
in UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, cReqChatVRange, localDisplayName, profileId, profile, xContactId, pqSupport, createdAt, updatedAt}
userQuery :: Query
userQuery =
@@ -402,3 +497,33 @@ createWithRandomBytes' size gVar create = tryCreate 3
encodedRandomBytes :: TVar ChaChaDRG -> Int -> IO ByteString
encodedRandomBytes gVar n = atomically $ B64.encode <$> C.randomBytes n gVar
assertNotUser :: DB.Connection -> User -> Contact -> ExceptT StoreError IO ()
assertNotUser db User {userId} Contact {contactId, localDisplayName} = do
r :: (Maybe Int64) <-
-- This query checks that the foreign keys in the users table
-- are not referencing the contact about to be deleted.
-- With the current schema it would cause cascade delete of user,
-- with mofified schema (in v5.6.0-beta.0) it would cause foreign key violation error.
liftIO . maybeFirstRow fromOnly $
DB.query
db
[sql|
SELECT 1 FROM users
WHERE (user_id = ? AND local_display_name = ?)
OR contact_id = ?
LIMIT 1
|]
(userId, localDisplayName, contactId)
when (isJust r) $ throwError $ SEProhibitedDeleteUser userId contactId
safeDeleteLDN :: DB.Connection -> User -> ContactName -> IO ()
safeDeleteLDN db User {userId} localDisplayName = do
DB.execute
db
[sql|
DELETE FROM display_names
WHERE user_id = ? AND local_display_name = ?
AND local_display_name NOT IN (SELECT local_display_name FROM users WHERE user_id = ?)
|]
(userId, localDisplayName, userId)