blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

core: enable PQ encryption for contacts (#4049)

Browse Source 
* wip

* migration

* remove migration

* remove flag wip

* Revert "remove migration"

This reverts commit 9e64663f9d.

* wip

* remove vrange parameterization

* tests mostly pass

* more tests pass

* enable for upgraded contacts

* remove migration

* core: test large messages (#4061)

* update simplexmq, fix tests

* test test

* another test

* enable tests

* empty

* empty
This commit is contained in:
spaced4ndy
2024-04-22 20:46:48 +04:00
committed by GitHub
parent 529ba7a0e7
commit 7567791866
20 changed files with 321 additions and 582 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Store/Connections.hs
+4 -5
View File
@@ -36,7 +36,6 @@ 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)
getChatLockEntity :: DB.Connection -> AgentConnId -> ExceptT StoreError IO ChatLockEntity
@@ -64,7 +63,7 @@ getChatLockEntity db agentConnId = do
ExceptT . firstRow fromOnly (SEInternalError "group member connection group_id not found") $
DB.query db "SELECT group_id FROM group_members WHERE group_member_id = ?" (Only groupMemberId)
getConnectionEntity :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity
getConnectionEntity :: DB.Connection -> VersionRangeChat -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity
getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
c@Connection {connType, entityId} <- getConnection_
case entityId of
@@ -185,7 +184,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 -> (PQSupport -> VersionRangeChat) -> User -> (ConnReqInvitation, ConnReqInvitation) -> IO (Maybe ConnectionEntity)
getConnectionEntityByConnReq :: DB.Connection -> VersionRangeChat -> User -> (ConnReqInvitation, ConnReqInvitation) -> IO (Maybe ConnectionEntity)
getConnectionEntityByConnReq db vr user@User {userId} (cReqSchema1, cReqSchema2) = do
connId_ <-
maybeFirstRow fromOnly $
@@ -196,7 +195,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 -> (PQSupport -> VersionRangeChat) -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe ConnectionEntity)
getContactConnEntityByConnReqHash :: DB.Connection -> VersionRangeChat -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe ConnectionEntity)
getContactConnEntityByConnReqHash db vr user@User {userId} (cReqHash1, cReqHash2) = do
connId_ <-
maybeFirstRow fromOnly $
@@ -216,7 +215,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 -> (PQSupport -> VersionRangeChat) -> IO ([ConnId], [ConnectionEntity])
getConnectionsToSubscribe :: DB.Connection -> 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
src/Simplex/Chat/Store/Direct.hs
+12 -12
View File
@@ -126,7 +126,7 @@ deletePendingContactConnection db userId connId =
|]
(userId, connId, ConnContact)
createAddressContactConnection :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Contact -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> ExceptT StoreError IO Contact
createAddressContactConnection :: DB.Connection -> 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)
@@ -153,7 +153,7 @@ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile grou
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 -> (PQSupport -> VersionRangeChat) -> User -> ConnReqUriHash -> IO (Maybe Contact, Maybe XContactId)
getConnReqContactXContactId :: DB.Connection -> VersionRangeChat -> User -> ConnReqUriHash -> IO (Maybe Contact, Maybe XContactId)
getConnReqContactXContactId db vr user@User {userId} cReqHash = do
getContactByConnReqHash db vr user cReqHash >>= \case
c@(Just _) -> pure (c, Nothing)
@@ -167,7 +167,7 @@ getConnReqContactXContactId db vr 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 -> (PQSupport -> VersionRangeChat) -> User -> ConnReqUriHash -> IO (Maybe Contact)
getContactByConnReqHash :: DB.Connection -> VersionRangeChat -> User -> ConnReqUriHash -> IO (Maybe Contact)
getContactByConnReqHash db vr user@User {userId} cReqHash =
maybeFirstRow (toContact vr user) $
DB.query
@@ -279,12 +279,12 @@ setContactDeleted db user@User {userId} ct@Contact {contactId} = 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 -> (PQSupport -> VersionRangeChat) -> User -> IO [Contact]
getDeletedContacts :: DB.Connection -> VersionRangeChat -> User -> IO [Contact]
getDeletedContacts db vr user@User {userId} = do
contactIds <- map fromOnly <$> DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND deleted = 1" (Only userId)
rights <$> mapM (runExceptT . getDeletedContact db vr user) contactIds
getDeletedContact :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ExceptT StoreError IO Contact
getDeletedContact :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Contact
getDeletedContact db vr user contactId = getContact_ db vr user contactId True
deleteContactProfile_ :: DB.Connection -> UserId -> ContactId -> IO ()
@@ -521,18 +521,18 @@ updateContactLDN_ db user@User {userId} contactId displayName newName updatedAt
(newName, updatedAt, userId, contactId)
safeDeleteLDN db user displayName
getContactByName :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ContactName -> ExceptT StoreError IO Contact
getContactByName :: DB.Connection -> VersionRangeChat -> User -> ContactName -> ExceptT StoreError IO Contact
getContactByName db vr user localDisplayName = do
cId <- getContactIdByName db user localDisplayName
getContact db vr user cId
getUserContacts :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> IO [Contact]
getUserContacts :: DB.Connection -> VersionRangeChat -> User -> IO [Contact]
getUserContacts db vr user@User {userId} = do
contactIds <- map fromOnly <$> DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND deleted = 0" (Only userId)
contacts <- rights <$> mapM (runExceptT . getContact db vr user) contactIds
pure $ filter (\Contact {activeConn} -> isJust activeConn) contacts
createOrUpdateContactRequest :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> ExceptT StoreError IO ContactOrRequest
createOrUpdateContactRequest :: DB.Connection -> 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
@@ -732,10 +732,10 @@ 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 -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ExceptT StoreError IO Contact
getContact :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Contact
getContact db vr user contactId = getContact_ db vr user contactId False
getContact_ :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> Bool -> ExceptT StoreError IO Contact
getContact_ :: DB.Connection -> 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
@@ -791,7 +791,7 @@ getPendingContactConnections db User {userId} = do
|]
[":user_id" := userId, ":conn_type" := ConnContact]
getContactConnections :: DB.Connection -> (PQSupport -> VersionRangeChat) -> UserId -> Contact -> IO [Connection]
getContactConnections :: DB.Connection -> VersionRangeChat -> UserId -> Contact -> IO [Connection]
getContactConnections db vr userId Contact {contactId} =
connections =<< liftIO getConnections_
where
@@ -811,7 +811,7 @@ getContactConnections db vr userId Contact {contactId} =
connections [] = pure []
connections rows = pure $ map (toConnection vr) rows
getConnectionById :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ExceptT StoreError IO Connection
getConnectionById :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Connection
getConnectionById db vr User {userId} connId = ExceptT $ do
firstRow (toConnection vr) (SEConnectionNotFoundById connId) $
DB.query
src/Simplex/Chat/Store/Files.hs
+9 -9
View File
@@ -174,7 +174,7 @@ getPendingSndChunks db fileId connId =
|]
(fileId, connId)
createSndDirectFTConnection :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> (CommandId, ConnId) -> SubscriptionMode -> IO ()
createSndDirectFTConnection :: DB.Connection -> VersionRangeChat -> User -> Int64 -> (CommandId, ConnId) -> SubscriptionMode -> IO ()
createSndDirectFTConnection db vr user@User {userId} fileId (cmdId, acId) subMode = do
currentTs <- getCurrentTime
Connection {connId} <- createSndFileConnection_ db vr userId fileId acId subMode
@@ -194,7 +194,7 @@ 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 -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> (CommandId, ConnId) -> GroupMember -> SubscriptionMode -> IO ()
createSndGroupFileTransferConnection :: DB.Connection -> 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 vr userId fileId acId subMode
@@ -430,10 +430,10 @@ lookupChatRefByFileId db User {userId} fileId =
(userId, fileId)
-- TODO v6.0 remove
createSndFileConnection_ :: DB.Connection -> (PQSupport -> VersionRangeChat) -> UserId -> Int64 -> ConnId -> SubscriptionMode -> IO Connection
createSndFileConnection_ :: DB.Connection -> VersionRangeChat -> UserId -> Int64 -> ConnId -> SubscriptionMode -> IO Connection
createSndFileConnection_ db vr userId fileId agentConnId subMode = do
currentTs <- getCurrentTime
createConnection_ db userId ConnSndFile (Just fileId) agentConnId (minVersion $ vr PQSupportOff) chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode CR.PQSupportOff
createConnection_ db userId ConnSndFile (Just fileId) agentConnId (minVersion vr) chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode CR.PQSupportOff
updateSndFileStatus :: DB.Connection -> SndFileTransfer -> FileStatus -> IO ()
updateSndFileStatus db SndFileTransfer {fileId, connId} status = do
@@ -695,7 +695,7 @@ getRcvFileTransfer_ db userId fileId = do
_ -> pure Nothing
cancelled = fromMaybe False cancelled_
acceptRcvFileTransfer :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> (CommandId, ConnId) -> ConnStatus -> FilePath -> SubscriptionMode -> ExceptT StoreError IO AChatItem
acceptRcvFileTransfer :: DB.Connection -> 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
@@ -707,7 +707,7 @@ 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 -> (PQSupport -> VersionRangeChat) -> User -> FileTransferId -> ExceptT StoreError IO Contact
getContactByFileId :: DB.Connection -> VersionRangeChat -> User -> FileTransferId -> ExceptT StoreError IO Contact
getContactByFileId db vr user@User {userId} fileId = do
cId <- getContactIdByFileId
getContact db vr user cId
@@ -716,7 +716,7 @@ getContactByFileId db vr user@User {userId} fileId = do
ExceptT . firstRow fromOnly (SEContactNotFoundByFileId fileId) $
DB.query db "SELECT contact_id FROM files WHERE user_id = ? AND file_id = ?" (userId, fileId)
acceptRcvInlineFT :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
acceptRcvInlineFT :: DB.Connection -> 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
@@ -725,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 -> (PQSupport -> VersionRangeChat) -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
xftpAcceptRcvFT :: DB.Connection -> 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
@@ -1000,7 +1000,7 @@ getLocalCryptoFile db userId fileId sent =
pure $ CryptoFile filePath fileCryptoArgs
_ -> throwError $ SEFileNotFound fileId
updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem
updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> 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
src/Simplex/Chat/Store/Groups.hs
+48 -48
View File
@@ -145,7 +145,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.Crypto.Ratchet (pattern PQEncOff, pattern PQSupportOff)
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Util (eitherToMaybe, ($>>=), (<$$>))
import Simplex.Messaging.Version
@@ -157,9 +157,9 @@ type GroupMemberRow = ((Int64, Int64, MemberId, VersionChat, VersionChat, GroupM
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 :: (PQSupport -> VersionRangeChat) -> Int64 -> GroupInfoRow -> GroupInfo
toGroupInfo :: VersionRangeChat -> Int64 -> GroupInfoRow -> GroupInfo
toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt, customData) :. userMemberRow) =
let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr PQSupportOff}
let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
fullGroupPreferences = mergeGroupPreferences groupPreferences
groupProfile = GroupProfile {displayName, fullName, description, image, groupPreferences}
@@ -191,7 +191,7 @@ createGroupLink db User {userId} groupInfo@GroupInfo {groupId, localDisplayName}
userContactLinkId <- insertedRowId db
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode PQSupportOff
getGroupLinkConnection :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupInfo -> ExceptT StoreError IO Connection
getGroupLinkConnection :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> ExceptT StoreError IO Connection
getGroupLinkConnection db vr User {userId} groupInfo@GroupInfo {groupId} =
ExceptT . firstRow (toConnection vr) (SEGroupLinkNotFound groupInfo) $
DB.query
@@ -264,7 +264,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 -> (PQSupport -> VersionRangeChat) -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember :: DB.Connection -> User -> Int64 -> VersionRangeChat -> ExceptT StoreError IO (GroupInfo, GroupMember)
getGroupAndMember db User {userId, userContactId} groupMemberId vr =
ExceptT . firstRow toGroupAndMember (SEInternalError "referenced group member not found") $
DB.query
@@ -309,7 +309,7 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr =
in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection vr connRow})
-- | creates completely new group with a single member - the current user
createNewGroup :: DB.Connection -> (PQSupport -> VersionRangeChat) -> TVar ChaChaDRG -> User -> GroupProfile -> Maybe Profile -> ExceptT StoreError IO GroupInfo
createNewGroup :: DB.Connection -> 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
@@ -352,7 +352,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 -> (PQSupport -> VersionRangeChat) -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId)
createGroupInvitation :: DB.Connection -> 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
@@ -397,7 +397,7 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ
|]
(profileId, localDisplayName, connRequest, customUserProfileId, userId, True, currentTs, currentTs, currentTs, currentTs)
insertedRowId db
let hostVRange = const $ adjustedMemberVRange vr peerChatVRange
let hostVRange = 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}
@@ -419,9 +419,9 @@ 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)
adjustedMemberVRange :: VersionRangeChat -> VersionRangeChat -> VersionRangeChat
adjustedMemberVRange chatVR vr@(VersionRange minV maxV) =
let maxV' = min maxV (maxVersion chatVR)
in fromMaybe vr $ safeVersionRange minV (max minV maxV')
getHostMemberId_ :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO GroupMemberId
@@ -429,7 +429,7 @@ 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 -> (PQSupport -> VersionRangeChat) -> ExceptT StoreError IO GroupMember
createContactMemberInv_ :: IsContact a => DB.Connection -> User -> GroupId -> Maybe GroupMemberId -> a -> MemberIdRole -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> Maybe ProfileId -> UTCTime -> 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
@@ -457,7 +457,7 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe
memberChatVRange
}
where
memberChatVRange@(VersionRange minV maxV) = vr PQSupportOff
memberChatVRange@(VersionRange minV maxV) = vr
insertMember_ :: IO ContactName
insertMember_ = do
let localDisplayName = localDisplayName' userOrContact
@@ -493,7 +493,7 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe
)
pure $ Right incognitoLdn
createGroupInvitedViaLink :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupInvitedViaLink :: DB.Connection -> VersionRangeChat -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
createGroupInvitedViaLink
db
vr
@@ -564,7 +564,7 @@ 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 -> (PQSupport -> VersionRangeChat) -> User -> GroupId -> ExceptT StoreError IO Group
getGroup :: DB.Connection -> VersionRangeChat -> User -> GroupId -> ExceptT StoreError IO Group
getGroup db vr user groupId = do
gInfo <- getGroupInfo db vr user groupId
members <- liftIO $ getGroupMembers db vr user gInfo
@@ -619,12 +619,12 @@ deleteGroupProfile_ db userId groupId =
|]
(userId, groupId)
getUserGroups :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> IO [Group]
getUserGroups :: DB.Connection -> 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 -> (PQSupport -> VersionRangeChat) -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfo]
getUserGroupDetails :: DB.Connection -> VersionRangeChat -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfo]
getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ =
map (toGroupInfo vr userContactId)
<$> DB.query
@@ -647,7 +647,7 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ =
where
search = fromMaybe "" search_
getUserGroupsWithSummary :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Maybe ContactId -> Maybe String -> IO [(GroupInfo, GroupSummary)]
getUserGroupsWithSummary :: DB.Connection -> 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)
@@ -688,7 +688,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 -> (PQSupport -> VersionRangeChat) -> User -> GroupName -> ExceptT StoreError IO GroupInfo
getGroupInfoByName :: DB.Connection -> VersionRangeChat -> User -> GroupName -> ExceptT StoreError IO GroupInfo
getGroupInfoByName db vr user gName = do
gId <- getGroupIdByName db user gName
getGroupInfo db vr user gId
@@ -712,7 +712,7 @@ groupMemberQuery =
)
|]
getGroupMember :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO GroupMember
getGroupMember :: DB.Connection -> 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
@@ -720,7 +720,7 @@ getGroupMember db vr user@User {userId} groupId groupMemberId =
(groupMemberQuery <> " WHERE m.group_id = ? AND m.group_member_id = ? AND m.user_id = ?")
(userId, groupId, groupMemberId, userId)
getGroupMemberById :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMemberId -> ExceptT StoreError IO GroupMember
getGroupMemberById :: DB.Connection -> VersionRangeChat -> User -> GroupMemberId -> ExceptT StoreError IO GroupMember
getGroupMemberById db vr user@User {userId} groupMemberId =
ExceptT . firstRow (toContactMember vr user) (SEGroupMemberNotFound groupMemberId) $
DB.query
@@ -728,7 +728,7 @@ getGroupMemberById db vr user@User {userId} groupMemberId =
(groupMemberQuery <> " WHERE m.group_member_id = ? AND m.user_id = ?")
(userId, groupMemberId, userId)
getGroupMemberByMemberId :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupInfo -> MemberId -> ExceptT StoreError IO GroupMember
getGroupMemberByMemberId :: DB.Connection -> 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
@@ -736,7 +736,7 @@ getGroupMemberByMemberId db vr user@User {userId} GroupInfo {groupId} memberId =
(groupMemberQuery <> " WHERE m.group_id = ? AND m.member_id = ?")
(userId, groupId, memberId)
getGroupMembers :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupInfo -> IO [GroupMember]
getGroupMembers :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupMembers db vr user@User {userId, userContactId} GroupInfo {groupId} = do
map (toContactMember vr user)
<$> DB.query
@@ -744,7 +744,7 @@ getGroupMembers db vr user@User {userId, userContactId} GroupInfo {groupId} = do
(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 -> (PQSupport -> VersionRangeChat) -> User -> GroupInfo -> IO [GroupMember]
getGroupMembersForExpiration :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupMembersForExpiration db vr user@User {userId, userContactId} GroupInfo {groupId} = do
map (toContactMember vr user)
<$> DB.query
@@ -760,7 +760,7 @@ getGroupMembersForExpiration db vr user@User {userId, userContactId} GroupInfo {
)
(userId, groupId, userId, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted, GSMemUnknown)
toContactMember :: (PQSupport -> VersionRangeChat) -> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
toContactMember :: VersionRangeChat -> User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember
toContactMember vr User {userContactId} (memberRow :. connRow) =
(toGroupMember userContactId memberRow) {activeConn = toMaybeConnection vr connRow}
@@ -778,7 +778,7 @@ getGroupCurrentMembersCount db User {userId} GroupInfo {groupId} = do
(groupId, userId)
pure $ length $ filter memberCurrent' statuses
getGroupInvitation :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation
getGroupInvitation :: DB.Connection -> VersionRangeChat -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation
getGroupInvitation db vr user groupId =
getConnRec_ user >>= \case
Just connRequest -> do
@@ -913,7 +913,7 @@ createAcceptedMemberConnection
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 -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> ExceptT StoreError IO Contact
getContactViaMember :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> ExceptT StoreError IO Contact
getContactViaMember db vr user@User {userId} GroupMember {groupMemberId} = do
contactId <-
ExceptT $
@@ -1174,7 +1174,7 @@ getIntroduction db reMember toMember = ExceptT $ do
in Right GroupMemberIntro {introId, reMember, toMember, introStatus, introInvitation}
toIntro _ = Left SEIntroNotFound
getForwardIntroducedMembers :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> Bool -> IO [GroupMember]
getForwardIntroducedMembers :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> Bool -> IO [GroupMember]
getForwardIntroducedMembers db vr user invitee highlyAvailable = do
memberIds <- map fromOnly <$> query
filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db vr user) memberIds
@@ -1194,7 +1194,7 @@ getForwardIntroducedMembers db vr user invitee highlyAvailable = do
WHERE to_group_member_id = ? AND intro_status NOT IN (?,?,?)
|]
getForwardInvitedMembers :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> Bool -> IO [GroupMember]
getForwardInvitedMembers :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> Bool -> IO [GroupMember]
getForwardInvitedMembers db vr user forwardMember highlyAvailable = do
memberIds <- map fromOnly <$> query
filter memberCurrent . rights <$> mapM (runExceptT . getGroupMemberById db vr user) memberIds
@@ -1288,7 +1288,7 @@ createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> Version
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 -> (PQSupport -> VersionRangeChat) -> User -> Contact -> IO (Maybe (GroupInfo, GroupMember))
getViaGroupMember :: DB.Connection -> VersionRangeChat -> User -> Contact -> IO (Maybe (GroupInfo, GroupMember))
getViaGroupMember db vr User {userId, userContactId} Contact {contactId} =
maybeFirstRow toGroupAndMember $
DB.query
@@ -1333,7 +1333,7 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} =
member = toGroupMember userContactId memberRow
in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection vr connRow})
getViaGroupContact :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> IO (Maybe Contact)
getViaGroupContact :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> IO (Maybe Contact)
getViaGroupContact db vr user@User {userId} GroupMember {groupMemberId} = do
contactId_ <-
maybeFirstRow fromOnly $
@@ -1384,7 +1384,7 @@ updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName,
(ldn, currentTs, userId, groupId)
safeDeleteLDN db user localDisplayName
getGroupInfo :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ExceptT StoreError IO GroupInfo
getGroupInfo :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO GroupInfo
getGroupInfo db vr User {userId, userContactId} groupId =
ExceptT . firstRow (toGroupInfo vr userContactId) (SEGroupNotFound groupId) $
DB.query
@@ -1407,7 +1407,7 @@ getGroupInfo db vr User {userId, userContactId} groupId =
|]
(groupId, userId, userContactId)
getGroupInfoByUserContactLinkConnReq :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe GroupInfo)
getGroupInfoByUserContactLinkConnReq :: DB.Connection -> VersionRangeChat -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe GroupInfo)
getGroupInfoByUserContactLinkConnReq db vr user@User {userId} (cReqSchema1, cReqSchema2) = do
groupId_ <-
maybeFirstRow fromOnly $
@@ -1421,7 +1421,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 -> (PQSupport -> VersionRangeChat) -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe GroupInfo)
getGroupInfoByGroupLinkHash :: DB.Connection -> VersionRangeChat -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe GroupInfo)
getGroupInfoByGroupLinkHash db vr user@User {userId, userContactId} (groupLinkHash1, groupLinkHash2) = do
groupId_ <-
maybeFirstRow fromOnly $
@@ -1448,7 +1448,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 -> (PQSupport -> VersionRangeChat) -> User -> ContactName -> ExceptT StoreError IO [(GroupInfo, GroupMember)]
getActiveMembersByName :: DB.Connection -> VersionRangeChat -> User -> ContactName -> ExceptT StoreError IO [(GroupInfo, GroupMember)]
getActiveMembersByName db vr user@User {userId} groupMemberName = do
groupMemberIds :: [(GroupId, GroupMemberId)] <-
liftIO $
@@ -1469,7 +1469,7 @@ getActiveMembersByName db vr user@User {userId} groupMemberName = do
where
ts GroupInfo {chatTs, updatedAt} = fromMaybe updatedAt chatTs
getMatchingContacts :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Contact -> IO [Contact]
getMatchingContacts :: DB.Connection -> 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
@@ -1489,7 +1489,7 @@ getMatchingContacts db vr user@User {userId} Contact {contactId, profile = Local
AND p.display_name = ? AND p.full_name = ?
|]
getMatchingMembers :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Contact -> IO [GroupMember]
getMatchingMembers :: DB.Connection -> VersionRangeChat -> User -> Contact -> IO [GroupMember]
getMatchingMembers db vr user@User {userId} Contact {profile = LocalProfile {displayName, fullName, image}} = do
memberIds <-
map fromOnly <$> case image of
@@ -1508,7 +1508,7 @@ getMatchingMembers db vr user@User {userId} Contact {profile = LocalProfile {dis
AND p.display_name = ? AND p.full_name = ?
|]
getMatchingMemberContacts :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> IO [Contact]
getMatchingMemberContacts :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> IO [Contact]
getMatchingMemberContacts _ _ _ GroupMember {memberContactId = Just _} = pure []
getMatchingMemberContacts db vr user@User {userId} GroupMember {memberProfile = LocalProfile {displayName, fullName, image}} = do
contactIds <-
@@ -1547,7 +1547,7 @@ 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 -> (PQSupport -> VersionRangeChat) -> User -> ContactOrMember -> Probe -> IO [ContactOrMember]
matchReceivedProbe :: DB.Connection -> VersionRangeChat -> User -> ContactOrMember -> Probe -> IO [ContactOrMember]
matchReceivedProbe db vr user@User {userId} from (Probe probe) = do
let probeHash = C.sha256Hash probe
cgmIds <-
@@ -1579,7 +1579,7 @@ matchReceivedProbe db vr user@User {userId} from (Probe probe) = do
(x : _) -> [x]
ctIds' <> memIds
matchReceivedProbeHash :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ContactOrMember -> ProbeHash -> IO (Maybe (ContactOrMember, Probe))
matchReceivedProbeHash :: DB.Connection -> VersionRangeChat -> User -> ContactOrMember -> ProbeHash -> IO (Maybe (ContactOrMember, Probe))
matchReceivedProbeHash db vr user@User {userId} from (ProbeHash probeHash) = do
probeIds <-
maybeFirstRow id $
@@ -1602,7 +1602,7 @@ matchReceivedProbeHash db vr user@User {userId} from (ProbeHash probeHash) = do
(ctId, gmId, probeHash, userId, currentTs, currentTs)
pure probeIds $>>= \(Only probe :. cgmIds) -> (,Probe probe) <$$> getContactOrMember_ db vr user cgmIds
matchSentProbe :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ContactOrMember -> Probe -> IO (Maybe ContactOrMember)
matchSentProbe :: DB.Connection -> VersionRangeChat -> User -> ContactOrMember -> Probe -> IO (Maybe ContactOrMember)
matchSentProbe db vr user@User {userId} _from (Probe probe) = do
cgmIds $>>= getContactOrMember_ db vr user
where
@@ -1623,7 +1623,7 @@ matchSentProbe db vr user@User {userId} _from (Probe probe) = do
|]
(userId, probe, ctId, gmId)
getContactOrMember_ :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> (Maybe ContactId, Maybe GroupId, Maybe GroupMemberId) -> IO (Maybe ContactOrMember)
getContactOrMember_ :: DB.Connection -> 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 vr user ctId
@@ -1631,7 +1631,7 @@ getContactOrMember_ db vr user ids =
_ -> throwError $ SEInternalError ""
-- if requested merge direction is overruled (toFromContacts), keepLDN is kept
mergeContactRecords :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Contact -> Contact -> ExceptT StoreError IO Contact
mergeContactRecords :: DB.Connection -> 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
@@ -1721,7 +1721,7 @@ associateMemberWithContactRecord
when (memProfileId /= profileId) $ deleteUnusedProfile_ db userId memProfileId
when (memLDN /= localDisplayName) $ deleteUnusedDisplayName_ db userId memLDN
associateContactWithMemberRecord :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> Contact -> ExceptT StoreError IO Contact
associateContactWithMemberRecord :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> Contact -> ExceptT StoreError IO Contact
associateContactWithMemberRecord
db
vr
@@ -1958,7 +1958,7 @@ createMemberContact
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, customData = Nothing}
getMemberContact :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
getMemberContact :: DB.Connection -> VersionRangeChat -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
getMemberContact db vr user contactId = do
ct <- getContact db vr user contactId
let Contact {contactGroupMemberId, activeConn} = ct
@@ -2138,7 +2138,7 @@ setXGrpLinkMemReceived db mId xGrpLinkMemReceived = do
"UPDATE group_members SET xgrplinkmem_received = ?, updated_at = ? WHERE group_member_id = ?"
(xGrpLinkMemReceived, currentTs, mId)
createNewUnknownGroupMember :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupInfo -> MemberId -> Text -> ExceptT StoreError IO GroupMember
createNewUnknownGroupMember :: DB.Connection -> 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
@@ -2160,9 +2160,9 @@ createNewUnknownGroupMember db vr user@User {userId, userContactId} GroupInfo {g
insertedRowId db
getGroupMemberById db vr user groupMemberId
where
VersionRange minV maxV = vr PQSupportOff
VersionRange minV maxV = vr
updateUnknownMemberAnnounced :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupMember -> GroupMember -> MemberInfo -> ExceptT StoreError IO GroupMember
updateUnknownMemberAnnounced :: DB.Connection -> 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
src/Simplex/Chat/Store/Messages.hs
+11 -11
View File
@@ -484,7 +484,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 -> (PQSupport -> VersionRangeChat) -> User -> Bool -> PaginationByTime -> ChatListQuery -> IO [Either StoreError AChat]
getChatPreviews :: DB.Connection -> 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
@@ -621,7 +621,7 @@ findDirectChatPreviews_ db User {userId} pagination clq =
)
([":user_id" := userId, ":rcv_new" := CISRcvNew, ":search" := search] <> pagParams)
getDirectChatPreview_ :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ChatPreviewData 'CTDirect -> ExceptT StoreError IO AChat
getDirectChatPreview_ :: DB.Connection -> 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
@@ -717,7 +717,7 @@ findGroupChatPreviews_ db User {userId} pagination clq =
)
([":user_id" := userId, ":rcv_new" := CISRcvNew, ":search" := search] <> pagParams)
getGroupChatPreview_ :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ChatPreviewData 'CTGroup -> ExceptT StoreError IO AChat
getGroupChatPreview_ :: DB.Connection -> 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
@@ -923,7 +923,7 @@ 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 -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChat :: DB.Connection -> 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 vr user contactId
@@ -1043,7 +1043,7 @@ getDirectChatBefore_ db user@User {userId} ct@Contact {contactId} beforeChatItem
|]
(userId, contactId, search, beforeChatItemId, count)
getGroupChat :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTGroup)
getGroupChat :: DB.Connection -> 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
@@ -1526,7 +1526,7 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
ciTimed :: Maybe CITimed
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
getAllChatItems :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem]
getAllChatItems :: DB.Connection -> 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
@@ -2179,7 +2179,7 @@ deleteLocalChatItem db User {userId} NoteFolder {noteFolderId} ci = do
|]
(userId, noteFolderId, itemId)
getChatItemByFileId :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ExceptT StoreError IO AChatItem
getChatItemByFileId :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO AChatItem
getChatItemByFileId db vr user@User {userId} fileId = do
(chatRef, itemId) <-
ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByFileId fileId) $
@@ -2195,13 +2195,13 @@ getChatItemByFileId db vr user@User {userId} fileId = do
(userId, fileId)
getAChatItem db vr user chatRef itemId
lookupChatItemByFileId :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> Int64 -> ExceptT StoreError IO (Maybe AChatItem)
lookupChatItemByFileId :: DB.Connection -> 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 -> (PQSupport -> VersionRangeChat) -> User -> GroupId -> ExceptT StoreError IO AChatItem
getChatItemByGroupId :: DB.Connection -> VersionRangeChat -> User -> GroupId -> ExceptT StoreError IO AChatItem
getChatItemByGroupId db vr user@User {userId} groupId = do
(chatRef, itemId) <-
ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByGroupId groupId) $
@@ -2227,7 +2227,7 @@ getChatRefViaItemId db User {userId} itemId = do
(Nothing, Just groupId) -> Right $ ChatRef CTGroup groupId
(_, _) -> Left $ SEBadChatItem itemId Nothing
getAChatItem :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem
getAChatItem :: DB.Connection -> VersionRangeChat -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem
getAChatItem db vr user chatRef itemId = case chatRef of
ChatRef CTDirect contactId -> do
ct <- getContact db vr user contactId
@@ -2476,7 +2476,7 @@ createCIModeration db GroupInfo {groupId} moderatorMember itemMemberId itemShare
|]
(groupId, groupMemberId' moderatorMember, itemMemberId, itemSharedMId, msgId, moderatedAtTs)
getCIModeration :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> GroupInfo -> MemberId -> Maybe SharedMsgId -> IO (Maybe CIModeration)
getCIModeration :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> MemberId -> Maybe SharedMsgId -> IO (Maybe CIModeration)
getCIModeration _ _ _ _ _ Nothing = pure Nothing
getCIModeration db vr user GroupInfo {groupId} itemMemberId (Just sharedMsgId) = do
r_ <-
src/Simplex/Chat/Store/Profiles.hs
+3 -3
View File
@@ -328,7 +328,7 @@ createUserContactLink db User {userId} agentConnId cReq subMode =
userContactLinkId <- insertedRowId db
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId initialChatVersion chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode CR.PQSupportOff
getUserAddressConnections :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> ExceptT StoreError IO [Connection]
getUserAddressConnections :: DB.Connection -> VersionRangeChat -> User -> ExceptT StoreError IO [Connection]
getUserAddressConnections db vr User {userId} = do
cs <- liftIO getUserAddressConnections_
if null cs then throwError SEUserContactLinkNotFound else pure cs
@@ -349,7 +349,7 @@ getUserAddressConnections db vr User {userId} = do
|]
(userId, userId)
getUserContactLinks :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> IO [(Connection, UserContact)]
getUserContactLinks :: DB.Connection -> VersionRangeChat -> User -> IO [(Connection, UserContact)]
getUserContactLinks db vr User {userId} =
map toUserContactConnection
<$> DB.query
@@ -475,7 +475,7 @@ getUserContactLinkByConnReq db User {userId} (cReqSchema1, cReqSchema2) =
|]
(userId, cReqSchema1, cReqSchema2)
getContactWithoutConnViaAddress :: DB.Connection -> (PQSupport -> VersionRangeChat) -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe Contact)
getContactWithoutConnViaAddress :: DB.Connection -> VersionRangeChat -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe Contact)
getContactWithoutConnViaAddress db vr user@User {userId} (cReqSchema1, cReqSchema2) = do
ctId_ <-
maybeFirstRow fromOnly $
src/Simplex/Chat/Store/Shared.hs
+4 -4
View File
@@ -166,12 +166,12 @@ type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, Bool, Maybe
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 :: (PQSupport -> VersionRangeChat) -> ConnectionRow -> Connection
toConnection :: 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,
connChatVersion = fromMaybe (vr `peerConnChatVersion` peerChatVRange) chatV,
peerChatVRange = peerChatVRange,
connLevel,
viaContact,
@@ -201,7 +201,7 @@ toConnection vr ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGr
entityId_ ConnSndFile = sndFileId
entityId_ ConnUserContact = userContactLinkId
toMaybeConnection :: (PQSupport -> VersionRangeChat) -> MaybeConnectionRow -> Maybe Connection
toMaybeConnection :: 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
@@ -382,7 +382,7 @@ 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, Maybe CustomData)
toContact :: (PQSupport -> VersionRangeChat) -> User -> ContactRow :. MaybeConnectionRow -> Contact
toContact :: 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, customData)) :. connRow) =
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
activeConn = toMaybeConnection vr connRow