mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
core: enable PQ encryption for contacts (#4049)
* 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
GitHub
@@ -76,7 +76,7 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile (..))
|
||||
import qualified Simplex.Messaging.Crypto.File as CF
|
||||
import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport (..))
|
||||
import Simplex.Messaging.Crypto.Ratchet (PQEncryption)
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus)
|
||||
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
|
||||
@@ -126,7 +126,7 @@ coreVersionInfo simplexmqCommit =
|
||||
|
||||
data ChatConfig = ChatConfig
|
||||
{ agentConfig :: AgentConfig,
|
||||
chatVRange :: PQSupport -> VersionRangeChat,
|
||||
chatVRange :: VersionRangeChat,
|
||||
confirmMigrations :: MigrationConfirmation,
|
||||
defaultServers :: DefaultAgentServers,
|
||||
tbqSize :: Natural,
|
||||
@@ -230,8 +230,7 @@ data ChatController = ChatController
|
||||
encryptLocalFiles :: TVar Bool,
|
||||
tempDirectory :: TVar (Maybe FilePath),
|
||||
logFilePath :: Maybe FilePath,
|
||||
contactMergeEnabled :: TVar Bool,
|
||||
pqExperimentalEnabled :: TVar PQSupport -- TODO v5.7 remove
|
||||
contactMergeEnabled :: TVar Bool
|
||||
}
|
||||
|
||||
data HelpSection = HSMain | HSFiles | HSGroups | HSContacts | HSMyAddress | HSIncognito | HSMarkdown | HSMessages | HSRemote | HSSettings | HSDatabase
|
||||
@@ -268,9 +267,6 @@ data ChatCommand
|
||||
| SetRemoteHostsFolder FilePath
|
||||
| APISetEncryptLocalFiles Bool
|
||||
| SetContactMergeEnabled Bool
|
||||
| APISetPQEncryption PQSupport
|
||||
| APISetContactPQ ContactId PQEncryption
|
||||
| SetContactPQ ContactName PQEncryption
|
||||
| APIExportArchive ArchiveConfig
|
||||
| ExportArchive
|
||||
| APIImportArchive ArchiveConfig
|
||||
@@ -736,7 +732,6 @@ data ChatResponse
|
||||
| CRRemoteCtrlSessionCode {remoteCtrl_ :: Maybe RemoteCtrlInfo, sessionCode :: Text}
|
||||
| CRRemoteCtrlConnected {remoteCtrl :: RemoteCtrlInfo}
|
||||
| CRRemoteCtrlStopped {rcsState :: RemoteCtrlSessionState, rcStopReason :: RemoteCtrlStopReason}
|
||||
| CRContactPQAllowed {user :: User, contact :: Contact, pqEncryption :: PQEncryption}
|
||||
| CRContactPQEnabled {user :: User, contact :: Contact, pqEnabled :: PQEncryption}
|
||||
| CRSQLResult {rows :: [Text]}
|
||||
| CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]}
|
||||
|
||||
@@ -49,7 +49,6 @@ import Simplex.Chat.Types.Shared
|
||||
import Simplex.Chat.Types.Util
|
||||
import Simplex.Messaging.Agent.Protocol (VersionSMPA, pqdrSMPAgentVersion)
|
||||
import Simplex.Messaging.Compression (compress1, decompressBatch)
|
||||
import Simplex.Messaging.Crypto.Ratchet (PQSupport (..), pattern PQSupportOff, pattern PQSupportOn)
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
|
||||
@@ -70,14 +69,11 @@ import Simplex.Messaging.Version hiding (version)
|
||||
-- This indirection is needed for backward/forward compatibility testing.
|
||||
-- Testing with real app versions is still needed, as tests use the current code with different version ranges, not the old code.
|
||||
currentChatVersion :: VersionChat
|
||||
currentChatVersion = VersionChat 7
|
||||
currentChatVersion = VersionChat 8
|
||||
|
||||
-- This should not be used directly in code, instead use `chatVRange` from ChatConfig (see comment above)
|
||||
-- TODO remove parameterization in 5.7
|
||||
supportedChatVRange :: PQSupport -> VersionRangeChat
|
||||
supportedChatVRange pq = mkVersionRange initialChatVersion $ case pq of
|
||||
PQSupportOn -> pqEncryptionCompressionVersion
|
||||
PQSupportOff -> currentChatVersion
|
||||
supportedChatVRange :: VersionRangeChat
|
||||
supportedChatVRange = mkVersionRange initialChatVersion currentChatVersion
|
||||
{-# INLINE supportedChatVRange #-}
|
||||
|
||||
-- version range that supports skipping establishing direct connections in a group and establishing direct connection via x.grp.direct.inv
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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_ <-
|
||||
|
||||
@@ -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 $
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -342,7 +342,6 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
|
||||
CRRemoteCtrlConnected RemoteCtrlInfo {remoteCtrlId = rcId, ctrlDeviceName} ->
|
||||
["remote controller " <> sShow rcId <> " session started with " <> plain ctrlDeviceName]
|
||||
CRRemoteCtrlStopped {} -> ["remote controller stopped"]
|
||||
CRContactPQAllowed u c (CR.PQEncryption pqOn) -> ttyUser u [ttyContact' c <> ": enable " <> (if pqOn then "quantum resistant" else "standard") <> " end-to-end encryption"]
|
||||
CRContactPQEnabled u c (CR.PQEncryption pqOn) -> ttyUser u [ttyContact' c <> ": " <> (if pqOn then "quantum resistant" else "standard") <> " end-to-end encryption enabled"]
|
||||
CRSQLResult rows -> map plain rows
|
||||
CRSlowSQLQueries {chatQueries, agentQueries} ->
|
||||
|
||||
Reference in New Issue
Block a user