mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
Merge branch 'master' into remote-desktop
This commit is contained in:
Evgeny Poberezkin
@@ -488,7 +488,7 @@ data ChatResponse
|
||||
| CRServerTestResult {user :: User, testServer :: AProtoServerWithAuth, testFailure :: Maybe ProtocolTestFailure}
|
||||
| CRChatItemTTL {user :: User, chatItemTTL :: Maybe Int64}
|
||||
| CRNetworkConfig {networkConfig :: NetworkConfig}
|
||||
| CRContactInfo {user :: User, contact :: Contact, connectionStats :: ConnectionStats, customUserProfile :: Maybe Profile}
|
||||
| CRContactInfo {user :: User, contact :: Contact, connectionStats_ :: Maybe ConnectionStats, customUserProfile :: Maybe Profile}
|
||||
| CRGroupInfo {user :: User, groupInfo :: GroupInfo, groupSummary :: GroupSummary}
|
||||
| CRGroupMemberInfo {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionStats_ :: Maybe ConnectionStats}
|
||||
| CRContactSwitchStarted {user :: User, contact :: Contact, connectionStats :: ConnectionStats}
|
||||
@@ -1103,7 +1103,8 @@ chatModifyVar f newValue = asks f >>= atomically . (`modifyTVar'` newValue)
|
||||
{-# INLINE chatModifyVar #-}
|
||||
|
||||
setContactNetworkStatus :: ChatMonad' m => Contact -> NetworkStatus -> m ()
|
||||
setContactNetworkStatus ct = chatModifyVar connNetworkStatuses . M.insert (contactAgentConnId ct)
|
||||
setContactNetworkStatus Contact {activeConn = Nothing} _ = pure ()
|
||||
setContactNetworkStatus Contact {activeConn = Just Connection {agentConnId}} status = chatModifyVar connNetworkStatuses $ M.insert agentConnId status
|
||||
|
||||
tryChatError :: ChatMonad m => m a -> m (Either ChatError a)
|
||||
tryChatError = tryAllErrors mkChatError
|
||||
|
||||
@@ -80,7 +80,7 @@ $(JQ.deriveJSON (sumTypeJSON fstToLower) ''ConnectionEntity)
|
||||
|
||||
updateEntityConnStatus :: ConnectionEntity -> ConnStatus -> ConnectionEntity
|
||||
updateEntityConnStatus connEntity connStatus = case connEntity of
|
||||
RcvDirectMsgConnection c ct_ -> RcvDirectMsgConnection (st c) ((\ct -> (ct :: Contact) {activeConn = st c}) <$> ct_)
|
||||
RcvDirectMsgConnection c ct_ -> RcvDirectMsgConnection (st c) ((\ct -> (ct :: Contact) {activeConn = Just $ st c}) <$> ct_)
|
||||
RcvGroupMsgConnection c gInfo m@GroupMember {activeConn = c'} -> RcvGroupMsgConnection (st c) gInfo m {activeConn = st <$> c'}
|
||||
SndFileConnection c ft -> SndFileConnection (st c) ft
|
||||
RcvFileConnection c ft -> RcvFileConnection (st c) ft
|
||||
|
||||
@@ -81,10 +81,11 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
|
||||
|]
|
||||
(userId, contactId)
|
||||
toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool, ContactStatus) :. (Maybe MsgFilter, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)] -> Either StoreError Contact
|
||||
toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)] =
|
||||
toContact' contactId conn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)] =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
|
||||
activeConn = Just conn
|
||||
in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent}
|
||||
toContact' _ _ _ = Left $ SEInternalError "referenced contact not found"
|
||||
getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember)
|
||||
|
||||
@@ -194,13 +194,13 @@ createIncognitoProfile db User {userId} p = do
|
||||
createIncognitoProfile_ db userId createdAt p
|
||||
|
||||
createDirectContact :: DB.Connection -> User -> Connection -> Profile -> ExceptT StoreError IO Contact
|
||||
createDirectContact db user@User {userId} activeConn@Connection {connId, localAlias} p@Profile {preferences} = do
|
||||
createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p@Profile {preferences} = do
|
||||
createdAt <- liftIO getCurrentTime
|
||||
(localDisplayName, contactId, profileId) <- createContact_ db userId connId p localAlias Nothing createdAt (Just createdAt)
|
||||
let profile = toLocalProfile profileId p localAlias
|
||||
userPreferences = emptyChatPrefs
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
|
||||
pure $ Contact {contactId, localDisplayName, profile, activeConn, viaGroup = Nothing, contactUsed = False, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False}
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
|
||||
pure $ Contact {contactId, localDisplayName, profile, activeConn = Just conn, viaGroup = Nothing, contactUsed = False, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False}
|
||||
|
||||
deleteContactConnectionsAndFiles :: DB.Connection -> UserId -> Contact -> IO ()
|
||||
deleteContactConnectionsAndFiles db userId Contact {contactId} = do
|
||||
@@ -218,7 +218,7 @@ deleteContactConnectionsAndFiles db userId Contact {contactId} = do
|
||||
DB.execute db "DELETE FROM files WHERE user_id = ? AND contact_id = ?" (userId, contactId)
|
||||
|
||||
deleteContact :: DB.Connection -> User -> Contact -> IO ()
|
||||
deleteContact db user@User {userId} Contact {contactId, localDisplayName, activeConn = Connection {customUserProfileId}} = do
|
||||
deleteContact db user@User {userId} Contact {contactId, localDisplayName, activeConn} = do
|
||||
DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (userId, contactId)
|
||||
ctMember :: (Maybe ContactId) <- maybeFirstRow fromOnly $ DB.query db "SELECT contact_id FROM group_members WHERE user_id = ? AND contact_id = ? LIMIT 1" (userId, contactId)
|
||||
if isNothing ctMember
|
||||
@@ -229,16 +229,20 @@ deleteContact db user@User {userId} Contact {contactId, localDisplayName, active
|
||||
currentTs <- getCurrentTime
|
||||
DB.execute db "UPDATE group_members SET contact_id = NULL, updated_at = ? WHERE user_id = ? AND contact_id = ?" (currentTs, userId, contactId)
|
||||
DB.execute db "DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId)
|
||||
forM_ customUserProfileId $ \profileId -> deleteUnusedIncognitoProfileById_ db user profileId
|
||||
forM_ activeConn $ \Connection {customUserProfileId} ->
|
||||
forM_ customUserProfileId $ \profileId ->
|
||||
deleteUnusedIncognitoProfileById_ db user profileId
|
||||
|
||||
-- should only be used if contact is not member of any groups
|
||||
deleteContactWithoutGroups :: DB.Connection -> User -> Contact -> IO ()
|
||||
deleteContactWithoutGroups db user@User {userId} Contact {contactId, localDisplayName, activeConn = Connection {customUserProfileId}} = do
|
||||
deleteContactWithoutGroups db user@User {userId} Contact {contactId, localDisplayName, activeConn} = do
|
||||
DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (userId, contactId)
|
||||
deleteContactProfile_ db userId contactId
|
||||
DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
|
||||
DB.execute db "DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId)
|
||||
forM_ customUserProfileId $ \profileId -> deleteUnusedIncognitoProfileById_ db user profileId
|
||||
forM_ activeConn $ \Connection {customUserProfileId} ->
|
||||
forM_ customUserProfileId $ \profileId ->
|
||||
deleteUnusedIncognitoProfileById_ db user profileId
|
||||
|
||||
setContactDeleted :: DB.Connection -> User -> Contact -> IO ()
|
||||
setContactDeleted db User {userId} Contact {contactId} = do
|
||||
@@ -307,19 +311,19 @@ updateContactProfile db user@User {userId} c p'
|
||||
updateContact_ db userId contactId localDisplayName ldn currentTs
|
||||
pure $ Right c {localDisplayName = ldn, profile, mergedPreferences}
|
||||
where
|
||||
Contact {contactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias}, activeConn, userPreferences} = c
|
||||
Contact {contactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias}, userPreferences} = c
|
||||
Profile {displayName = newName, preferences} = p'
|
||||
profile = toLocalProfile profileId p' localAlias
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ contactConnIncognito c
|
||||
|
||||
updateContactUserPreferences :: DB.Connection -> User -> Contact -> Preferences -> IO Contact
|
||||
updateContactUserPreferences db user@User {userId} c@Contact {contactId, activeConn} userPreferences = do
|
||||
updateContactUserPreferences db user@User {userId} c@Contact {contactId} userPreferences = do
|
||||
updatedAt <- getCurrentTime
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE contacts SET user_preferences = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?"
|
||||
(userPreferences, updatedAt, userId, contactId)
|
||||
let mergedPreferences = contactUserPreferences user userPreferences (preferences' c) $ connIncognito activeConn
|
||||
let mergedPreferences = contactUserPreferences user userPreferences (preferences' c) $ contactConnIncognito c
|
||||
pure $ c {mergedPreferences, userPreferences}
|
||||
|
||||
updateContactAlias :: DB.Connection -> UserId -> Contact -> LocalAlias -> IO Contact
|
||||
@@ -453,7 +457,8 @@ getContactByName db user localDisplayName = do
|
||||
getUserContacts :: DB.Connection -> User -> IO [Contact]
|
||||
getUserContacts db user@User {userId} = do
|
||||
contactIds <- map fromOnly <$> DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND deleted = 0" (Only userId)
|
||||
rights <$> mapM (runExceptT . getContact db user) contactIds
|
||||
contacts <- rights <$> mapM (runExceptT . getContact db user) contactIds
|
||||
pure $ filter (\Contact {activeConn} -> isJust activeConn) contacts
|
||||
|
||||
createOrUpdateContactRequest :: DB.Connection -> User -> Int64 -> InvitationId -> VersionRange -> Profile -> Maybe XContactId -> ExceptT StoreError IO ContactOrRequest
|
||||
createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (VersionRange minV maxV) Profile {displayName, fullName, image, contactLink, preferences} xContactId_ =
|
||||
@@ -642,9 +647,9 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}
|
||||
"INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, created_at, updated_at, chat_ts, xcontact_id) VALUES (?,?,?,?,?,?,?,?,?)"
|
||||
(userId, localDisplayName, profileId, True, userPreferences, createdAt, createdAt, createdAt, xContactId)
|
||||
contactId <- insertedRowId db
|
||||
activeConn <- createConnection_ db userId ConnContact (Just contactId) agentConnId cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode
|
||||
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
|
||||
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn, viaGroup = Nothing, contactUsed = False, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False}
|
||||
conn <- createConnection_ db userId ConnContact (Just contactId) agentConnId cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode
|
||||
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
|
||||
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn = Just conn, viaGroup = Nothing, contactUsed = False, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False}
|
||||
|
||||
getContactIdByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Int64
|
||||
getContactIdByName db User {userId} cName =
|
||||
@@ -656,7 +661,7 @@ getContact db user contactId = getContact_ db user contactId False
|
||||
|
||||
getContact_ :: DB.Connection -> User -> Int64 -> Bool -> ExceptT StoreError IO Contact
|
||||
getContact_ db user@User {userId} contactId deleted =
|
||||
ExceptT . fmap join . firstRow (toContactOrError user) (SEContactNotFound contactId) $
|
||||
ExceptT . firstRow (toContact user) (SEContactNotFound contactId) $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
|
||||
@@ -209,8 +209,9 @@ createSndGroupFileTransferConnection db user@User {userId} fileId (cmdId, acId)
|
||||
"INSERT INTO snd_files (file_id, file_status, connection_id, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
|
||||
(fileId, FSAccepted, connId, groupMemberId, currentTs, currentTs)
|
||||
|
||||
createSndDirectInlineFT :: DB.Connection -> Contact -> FileTransferMeta -> IO SndFileTransfer
|
||||
createSndDirectInlineFT db Contact {localDisplayName = n, activeConn = Connection {connId, agentConnId}} FileTransferMeta {fileId, fileName, filePath, fileSize, chunkSize, fileInline} = do
|
||||
createSndDirectInlineFT :: DB.Connection -> Contact -> FileTransferMeta -> ExceptT StoreError IO SndFileTransfer
|
||||
createSndDirectInlineFT _ Contact {localDisplayName, activeConn = Nothing} _ = throwError $ SEContactNotReady localDisplayName
|
||||
createSndDirectInlineFT db Contact {localDisplayName = n, activeConn = Just Connection {connId, agentConnId}} FileTransferMeta {fileId, fileName, filePath, fileSize, chunkSize, fileInline} = liftIO $ do
|
||||
currentTs <- getCurrentTime
|
||||
let fileStatus = FSConnected
|
||||
fileInline' = Just $ fromMaybe IFMOffer fileInline
|
||||
@@ -231,8 +232,9 @@ createSndGroupInlineFT db GroupMember {groupMemberId, localDisplayName = n} Conn
|
||||
(fileId, fileStatus, fileInline', connId, groupMemberId, currentTs, currentTs)
|
||||
pure SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName = n, connId, agentConnId, groupMemberId = Just groupMemberId, fileStatus, fileDescrId = Nothing, fileInline = fileInline'}
|
||||
|
||||
updateSndDirectFTDelivery :: DB.Connection -> Contact -> FileTransferMeta -> Int64 -> IO ()
|
||||
updateSndDirectFTDelivery db Contact {activeConn = Connection {connId}} FileTransferMeta {fileId} msgDeliveryId =
|
||||
updateSndDirectFTDelivery :: DB.Connection -> Contact -> FileTransferMeta -> Int64 -> ExceptT StoreError IO ()
|
||||
updateSndDirectFTDelivery _ Contact {localDisplayName, activeConn = Nothing} _ _ = throwError $ SEContactNotReady localDisplayName
|
||||
updateSndDirectFTDelivery db Contact {activeConn = Just Connection {connId}} FileTransferMeta {fileId} msgDeliveryId = liftIO $
|
||||
DB.execute
|
||||
db
|
||||
"UPDATE snd_files SET last_inline_msg_delivery_id = ? WHERE connection_id = ? AND file_id = ? AND file_inline IS NOT NULL"
|
||||
|
||||
@@ -314,7 +314,8 @@ createNewGroup db gVar user@User {userId} groupProfile incognitoProfile = Except
|
||||
|
||||
-- | creates a new group record for the group the current user was invited to, or returns an existing one
|
||||
createGroupInvitation :: DB.Connection -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId)
|
||||
createGroupInvitation db user@User {userId} contact@Contact {contactId, activeConn = Connection {customUserProfileId}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do
|
||||
createGroupInvitation _ _ Contact {localDisplayName, activeConn = Nothing} _ _ = throwError $ SEContactNotReady localDisplayName
|
||||
createGroupInvitation db user@User {userId} contact@Contact {contactId, activeConn = Just Connection {customUserProfileId}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do
|
||||
liftIO getInvitationGroupId_ >>= \case
|
||||
Nothing -> createGroupInvitation_
|
||||
Just gId -> do
|
||||
@@ -705,7 +706,8 @@ getGroupInvitation db user groupId =
|
||||
DB.query db "SELECT g.inv_queue_info FROM groups g WHERE g.group_id = ? AND g.user_id = ?" (groupId, userId)
|
||||
|
||||
createNewContactMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupId -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> SubscriptionMode -> ExceptT StoreError IO GroupMember
|
||||
createNewContactMember db gVar User {userId, userContactId} groupId Contact {contactId, localDisplayName, profile, activeConn = Connection {peerChatVRange}} memberRole agentConnId connRequest subMode =
|
||||
createNewContactMember _ _ _ _ Contact {localDisplayName, activeConn = Nothing} _ _ _ _ = throwError $ SEContactNotReady localDisplayName
|
||||
createNewContactMember db gVar User {userId, userContactId} groupId Contact {contactId, localDisplayName, profile, activeConn = Just Connection {peerChatVRange}} memberRole agentConnId connRequest subMode =
|
||||
createWithRandomId gVar $ \memId -> do
|
||||
createdAt <- liftIO getCurrentTime
|
||||
member@GroupMember {groupMemberId} <- createMember_ (MemberId memId) createdAt
|
||||
@@ -1725,15 +1727,15 @@ createMemberContact
|
||||
connId <- insertedRowId db
|
||||
let ctConn = Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType = ConnContact, contactConnInitiated = True, entityId = Just contactId, viaContact = Nothing, viaUserContactLink = Nothing, viaGroupLink = False, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
|
||||
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False}
|
||||
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False}
|
||||
|
||||
getMemberContact :: DB.Connection -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
|
||||
getMemberContact db user contactId = do
|
||||
ct <- getContact db user contactId
|
||||
let Contact {contactGroupMemberId, activeConn = Connection {connId}} = ct
|
||||
cReq <- getConnReqInv db connId
|
||||
case contactGroupMemberId of
|
||||
Just groupMemberId -> do
|
||||
let Contact {contactGroupMemberId, activeConn} = ct
|
||||
case (activeConn, contactGroupMemberId) of
|
||||
(Just Connection {connId}, Just groupMemberId) -> do
|
||||
cReq <- getConnReqInv db connId
|
||||
m@GroupMember {groupId} <- getGroupMemberById db user groupMemberId
|
||||
g <- getGroupInfo db user groupId
|
||||
pure (g, m, ct, cReq)
|
||||
@@ -1762,7 +1764,7 @@ createMemberContactInvited
|
||||
contactId <- createContactUpdateMember currentTs userPreferences
|
||||
ctConn <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode
|
||||
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
|
||||
mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False}
|
||||
mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False}
|
||||
m' = m {memberContactId = Just contactId}
|
||||
pure (mCt', m')
|
||||
where
|
||||
@@ -1786,13 +1788,14 @@ createMemberContactInvited
|
||||
(contactId, currentTs, groupMemberId)
|
||||
pure contactId
|
||||
|
||||
updateMemberContactInvited :: DB.Connection -> User -> (CommandId, ConnId) -> GroupInfo -> Connection -> Contact -> SubscriptionMode -> IO Contact
|
||||
updateMemberContactInvited db user connIds gInfo mConn ct@Contact {contactId, activeConn = oldContactConn} subMode = do
|
||||
updateMemberContactInvited :: DB.Connection -> User -> (CommandId, ConnId) -> GroupInfo -> Connection -> Contact -> SubscriptionMode -> ExceptT StoreError IO Contact
|
||||
updateMemberContactInvited _ _ _ _ _ Contact {localDisplayName, activeConn = Nothing} _ = throwError $ SEContactNotReady localDisplayName
|
||||
updateMemberContactInvited db user connIds gInfo mConn ct@Contact {contactId, activeConn = Just oldContactConn} subMode = liftIO $ do
|
||||
updateConnectionStatus db oldContactConn ConnDeleted
|
||||
activeConn <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode
|
||||
activeConn' <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode
|
||||
ct' <- updateContactStatus db user ct CSActive
|
||||
ct'' <- resetMemberContactFields db ct'
|
||||
pure (ct'' :: Contact) {activeConn}
|
||||
pure (ct'' :: Contact) {activeConn = Just activeConn'}
|
||||
|
||||
resetMemberContactFields :: DB.Connection -> Contact -> IO Contact
|
||||
resetMemberContactFields db ct@Contact {contactId} = do
|
||||
|
||||
@@ -497,7 +497,7 @@ getDirectChatPreviews_ db user@User {userId} = do
|
||||
ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent
|
||||
FROM contacts ct
|
||||
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
|
||||
JOIN connections c ON c.contact_id = ct.contact_id
|
||||
LEFT JOIN connections c ON c.contact_id = ct.contact_id
|
||||
LEFT JOIN (
|
||||
SELECT contact_id, MAX(chat_item_id) AS MaxId
|
||||
FROM chat_items
|
||||
@@ -514,25 +514,31 @@ getDirectChatPreviews_ db user@User {userId} = do
|
||||
) ChatStats ON ChatStats.contact_id = ct.contact_id
|
||||
LEFT JOIN chat_items ri ON ri.user_id = i.user_id AND ri.contact_id = i.contact_id AND ri.shared_msg_id = i.quoted_shared_msg_id
|
||||
WHERE ct.user_id = ?
|
||||
AND ((c.conn_level = 0 AND c.via_group_link = 0) OR ct.contact_used = 1)
|
||||
AND ct.is_user = 0
|
||||
AND ct.deleted = 0
|
||||
AND c.connection_id = (
|
||||
SELECT cc_connection_id FROM (
|
||||
SELECT
|
||||
cc.connection_id AS cc_connection_id,
|
||||
cc.created_at AS cc_created_at,
|
||||
(CASE WHEN cc.conn_status = ? OR cc.conn_status = ? THEN 1 ELSE 0 END) AS cc_conn_status_ord
|
||||
FROM connections cc
|
||||
WHERE cc.user_id = ct.user_id AND cc.contact_id = ct.contact_id
|
||||
ORDER BY cc_conn_status_ord DESC, cc_created_at DESC
|
||||
LIMIT 1
|
||||
AND (
|
||||
(
|
||||
((c.conn_level = 0 AND c.via_group_link = 0) OR ct.contact_used = 1)
|
||||
AND c.connection_id = (
|
||||
SELECT cc_connection_id FROM (
|
||||
SELECT
|
||||
cc.connection_id AS cc_connection_id,
|
||||
cc.created_at AS cc_created_at,
|
||||
(CASE WHEN cc.conn_status = ? OR cc.conn_status = ? THEN 1 ELSE 0 END) AS cc_conn_status_ord
|
||||
FROM connections cc
|
||||
WHERE cc.user_id = ct.user_id AND cc.contact_id = ct.contact_id
|
||||
ORDER BY cc_conn_status_ord DESC, cc_created_at DESC
|
||||
LIMIT 1
|
||||
)
|
||||
)
|
||||
)
|
||||
OR c.connection_id IS NULL
|
||||
)
|
||||
ORDER BY i.item_ts DESC
|
||||
|]
|
||||
(CISRcvNew, userId, ConnReady, ConnSndReady)
|
||||
where
|
||||
toDirectChatPreview :: UTCTime -> ContactRow :. ConnectionRow :. ChatStatsRow :. MaybeChatItemRow :. QuoteRow -> AChat
|
||||
toDirectChatPreview :: UTCTime -> ContactRow :. MaybeConnectionRow :. ChatStatsRow :. MaybeChatItemRow :. QuoteRow -> AChat
|
||||
toDirectChatPreview currentTs (contactRow :. connRow :. statsRow :. ciRow_) =
|
||||
let contact = toContact user $ contactRow :. connRow
|
||||
ci_ = toDirectChatItemList currentTs ciRow_
|
||||
|
||||
@@ -253,24 +253,15 @@ deleteUnusedIncognitoProfileById_ db User {userId} profileId =
|
||||
|
||||
type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool, ContactStatus) :. (Maybe MsgFilter, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)
|
||||
|
||||
toContact :: User -> ContactRow :. ConnectionRow -> Contact
|
||||
toContact :: User -> ContactRow :. MaybeConnectionRow -> Contact
|
||||
toContact user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
|
||||
activeConn = toConnection connRow
|
||||
activeConn = toMaybeConnection connRow
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
|
||||
incognito = maybe False connIncognito activeConn
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences incognito
|
||||
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent}
|
||||
|
||||
toContactOrError :: User -> ContactRow :. MaybeConnectionRow -> Either StoreError Contact
|
||||
toContactOrError user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) =
|
||||
let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
|
||||
in case toMaybeConnection connRow of
|
||||
Just activeConn ->
|
||||
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
|
||||
in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent}
|
||||
_ -> Left $ SEContactNotReady localDisplayName
|
||||
|
||||
getProfileById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalProfile
|
||||
getProfileById db userId profileId =
|
||||
ExceptT . firstRow toProfile (SEProfileNotFound profileId) $
|
||||
|
||||
+11
-12
@@ -160,7 +160,7 @@ data Contact = Contact
|
||||
{ contactId :: ContactId,
|
||||
localDisplayName :: ContactName,
|
||||
profile :: LocalProfile,
|
||||
activeConn :: Connection,
|
||||
activeConn :: Maybe Connection,
|
||||
viaGroup :: Maybe Int64,
|
||||
contactUsed :: Bool,
|
||||
contactStatus :: ContactStatus,
|
||||
@@ -175,32 +175,31 @@ data Contact = Contact
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
contactConn :: Contact -> Connection
|
||||
contactConn :: Contact -> Maybe Connection
|
||||
contactConn Contact {activeConn} = activeConn
|
||||
|
||||
contactAgentConnId :: Contact -> AgentConnId
|
||||
contactAgentConnId Contact {activeConn = Connection {agentConnId}} = agentConnId
|
||||
|
||||
contactConnId :: Contact -> ConnId
|
||||
contactConnId = aConnId . contactConn
|
||||
contactConnId :: Contact -> Maybe ConnId
|
||||
contactConnId c = aConnId <$> contactConn c
|
||||
|
||||
type IncognitoEnabled = Bool
|
||||
|
||||
contactConnIncognito :: Contact -> IncognitoEnabled
|
||||
contactConnIncognito = connIncognito . contactConn
|
||||
contactConnIncognito = maybe False connIncognito . contactConn
|
||||
|
||||
contactDirect :: Contact -> Bool
|
||||
contactDirect Contact {activeConn = Connection {connLevel, viaGroupLink}} = connLevel == 0 && not viaGroupLink
|
||||
contactDirect Contact {activeConn} = maybe True direct activeConn
|
||||
where
|
||||
direct Connection {connLevel, viaGroupLink} = connLevel == 0 && not viaGroupLink
|
||||
|
||||
directOrUsed :: Contact -> Bool
|
||||
directOrUsed ct@Contact {contactUsed} =
|
||||
contactDirect ct || contactUsed
|
||||
|
||||
anyDirectOrUsed :: Contact -> Bool
|
||||
anyDirectOrUsed Contact {contactUsed, activeConn = Connection {connLevel}} = connLevel == 0 || contactUsed
|
||||
anyDirectOrUsed Contact {contactUsed, activeConn} = ((\c -> c.connLevel) <$> activeConn) == Just 0 || contactUsed
|
||||
|
||||
contactReady :: Contact -> Bool
|
||||
contactReady Contact {activeConn} = connReady activeConn
|
||||
contactReady Contact {activeConn} = maybe False connReady activeConn
|
||||
|
||||
contactActive :: Contact -> Bool
|
||||
contactActive Contact {contactStatus} = contactStatus == CSActive
|
||||
@@ -209,7 +208,7 @@ contactDeleted :: Contact -> Bool
|
||||
contactDeleted Contact {contactStatus} = contactStatus == CSDeleted
|
||||
|
||||
contactSecurityCode :: Contact -> Maybe SecurityCode
|
||||
contactSecurityCode Contact {activeConn} = connectionCode activeConn
|
||||
contactSecurityCode Contact {activeConn} = connectionCode =<< activeConn
|
||||
|
||||
data ContactStatus
|
||||
= CSActive
|
||||
|
||||
@@ -145,9 +145,11 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
|
||||
CRGroupsList u gs -> ttyUser u $ viewGroupsList gs
|
||||
CRSentGroupInvitation u g c _ ->
|
||||
ttyUser u $
|
||||
if viaGroupLink . contactConn $ c
|
||||
then [ttyContact' c <> " invited to group " <> ttyGroup' g <> " via your group link"]
|
||||
else ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c]
|
||||
case contactConn c of
|
||||
Just Connection {viaGroupLink}
|
||||
| viaGroupLink -> [ttyContact' c <> " invited to group " <> ttyGroup' g <> " via your group link"]
|
||||
| otherwise -> ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c]
|
||||
Nothing -> []
|
||||
CRFileTransferStatus u ftStatus -> ttyUser u $ viewFileTransferStatus ftStatus
|
||||
CRFileTransferStatusXFTP u ci -> ttyUser u $ viewFileTransferStatusXFTP ci
|
||||
CRUserProfile u p -> ttyUser u $ viewUserProfile p
|
||||
@@ -359,7 +361,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
|
||||
testViewChats chats = [sShow $ map toChatView chats]
|
||||
where
|
||||
toChatView :: AChat -> (Text, Text, Maybe ConnStatus)
|
||||
toChatView (AChat _ (Chat (DirectChat Contact {localDisplayName, activeConn}) items _)) = ("@" <> localDisplayName, toCIPreview items Nothing, Just $ connStatus activeConn)
|
||||
toChatView (AChat _ (Chat (DirectChat Contact {localDisplayName, activeConn}) items _)) = ("@" <> localDisplayName, toCIPreview items Nothing, connStatus <$> activeConn)
|
||||
toChatView (AChat _ (Chat (GroupChat GroupInfo {membership, localDisplayName}) items _)) = ("#" <> localDisplayName, toCIPreview items (Just membership), Nothing)
|
||||
toChatView (AChat _ (Chat (ContactRequest UserContactRequest {localDisplayName}) items _)) = ("<@" <> localDisplayName, toCIPreview items Nothing, Nothing)
|
||||
toChatView (AChat _ (Chat (ContactConnection PendingContactConnection {pccConnId, pccConnStatus}) items _)) = (":" <> T.pack (show pccConnId), toCIPreview items Nothing, Just pccConnStatus)
|
||||
@@ -1072,10 +1074,10 @@ viewNetworkConfig NetworkConfig {socksProxy, tcpTimeout} =
|
||||
"use " <> highlight' "/network socks=<on/off/[ipv4]:port>[ timeout=<seconds>]" <> " to change settings"
|
||||
]
|
||||
|
||||
viewContactInfo :: Contact -> ConnectionStats -> Maybe Profile -> [StyledString]
|
||||
viewContactInfo :: Contact -> Maybe ConnectionStats -> Maybe Profile -> [StyledString]
|
||||
viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink}, activeConn} stats incognitoProfile =
|
||||
["contact ID: " <> sShow contactId]
|
||||
<> viewConnectionStats stats
|
||||
<> maybe [] viewConnectionStats stats
|
||||
<> maybe [] (\l -> ["contact address: " <> (plain . strEncode) (simplexChatContact l)]) contactLink
|
||||
<> maybe
|
||||
["you've shared main profile with this contact"]
|
||||
@@ -1083,7 +1085,7 @@ viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, conta
|
||||
incognitoProfile
|
||||
<> ["alias: " <> plain localAlias | localAlias /= ""]
|
||||
<> [viewConnectionVerified (contactSecurityCode ct)]
|
||||
<> [viewPeerChatVRange (peerChatVRange activeConn)]
|
||||
<> maybe [] (\ac -> [viewPeerChatVRange (peerChatVRange ac)]) activeConn
|
||||
|
||||
viewGroupInfo :: GroupInfo -> GroupSummary -> [StyledString]
|
||||
viewGroupInfo GroupInfo {groupId} s =
|
||||
|
||||
Reference in New Issue
Block a user