mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-10 17:18:31 +00:00
core (pq): integrate agent api, create e2ee info items (#3859)
This commit is contained in:
spaced4ndy
@@ -80,7 +80,6 @@ import Simplex.Messaging.TMap (TMap)
|
||||
import Simplex.Messaging.Transport (TLS, simplexMQVersion)
|
||||
import Simplex.Messaging.Transport.Client (TransportHost)
|
||||
import Simplex.Messaging.Util (allFinally, catchAllErrors, liftEitherError, tryAllErrors, (<$$>))
|
||||
import Simplex.Messaging.Version
|
||||
import Simplex.RemoteControl.Client
|
||||
import Simplex.RemoteControl.Invitation (RCSignedInvitation, RCVerifiedInvitation)
|
||||
import Simplex.RemoteControl.Types
|
||||
@@ -122,7 +121,7 @@ coreVersionInfo simplexmqCommit =
|
||||
|
||||
data ChatConfig = ChatConfig
|
||||
{ agentConfig :: AgentConfig,
|
||||
chatVRange :: VersionRange,
|
||||
chatVRange :: VersionRangeChat,
|
||||
confirmMigrations :: MigrationConfirmation,
|
||||
defaultServers :: DefaultAgentServers,
|
||||
tbqSize :: Natural,
|
||||
@@ -207,7 +206,7 @@ data ChatController = ChatController
|
||||
tempDirectory :: TVar (Maybe FilePath),
|
||||
logFilePath :: Maybe FilePath,
|
||||
contactMergeEnabled :: TVar Bool,
|
||||
pqExperimentalEnabled :: TVar Bool -- TODO remove in 5.7
|
||||
pqExperimentalEnabled :: TVar PQFlag -- TODO remove in 5.7
|
||||
}
|
||||
|
||||
data HelpSection = HSMain | HSFiles | HSGroups | HSContacts | HSMyAddress | HSIncognito | HSMarkdown | HSMessages | HSRemote | HSSettings | HSDatabase
|
||||
|
||||
@@ -343,6 +343,9 @@ sndConnEventToText = \case
|
||||
SPSecured -> "secured new address" <> forMember m <> "..."
|
||||
SPCompleted -> "you changed address" <> forMember m
|
||||
SCERatchetSync syncStatus m -> ratchetSyncStatusToText syncStatus <> forMember m
|
||||
SCEPQEnabled enabled
|
||||
| enabled -> "post-quantum encryption enabled"
|
||||
| otherwise -> "post-quantum encryption disabled"
|
||||
where
|
||||
forMember member_ =
|
||||
maybe "" (\GroupMemberRef {profile = Profile {displayName}} -> " for " <> displayName) member_
|
||||
|
||||
@@ -48,6 +48,7 @@ data RcvConnEvent
|
||||
data SndConnEvent
|
||||
= SCESwitchQueue {phase :: SwitchPhase, member :: Maybe GroupMemberRef}
|
||||
| SCERatchetSync {syncStatus :: RatchetSyncState, member :: Maybe GroupMemberRef}
|
||||
| SCEPQEnabled {enabled :: Bool}
|
||||
deriving (Show)
|
||||
|
||||
data RcvDirectEvent
|
||||
|
||||
@@ -8,11 +8,15 @@ import Database.SQLite.Simple.QQ (sql)
|
||||
m20240228_pq :: Query
|
||||
m20240228_pq =
|
||||
[sql|
|
||||
ALTER TABLE connections ADD COLUMN pq_enabled INTEGER;
|
||||
ALTER TABLE connections ADD COLUMN enable_pq INTEGER;
|
||||
ALTER TABLE connections ADD COLUMN pq_snd_enabled INTEGER;
|
||||
ALTER TABLE connections ADD COLUMN pq_rcv_enabled INTEGER;
|
||||
|]
|
||||
|
||||
down_m20240228_pq :: Query
|
||||
down_m20240228_pq =
|
||||
[sql|
|
||||
ALTER TABLE connections DROP COLUMN pq_enabled;
|
||||
ALTER TABLE connections DROP COLUMN enable_pq;
|
||||
ALTER TABLE connections DROP COLUMN pq_snd_enabled;
|
||||
ALTER TABLE connections DROP COLUMN pq_rcv_enabled;
|
||||
|]
|
||||
|
||||
@@ -277,7 +277,9 @@ CREATE TABLE connections(
|
||||
peer_chat_max_version INTEGER NOT NULL DEFAULT 1,
|
||||
to_subscribe INTEGER DEFAULT 0 NOT NULL,
|
||||
contact_conn_initiated INTEGER NOT NULL DEFAULT 0,
|
||||
pq_enabled INTEGER,
|
||||
enable_pq INTEGER,
|
||||
pq_snd_enabled INTEGER,
|
||||
pq_rcv_enabled INTEGER,
|
||||
FOREIGN KEY(snd_file_id, connection_id)
|
||||
REFERENCES snd_files(file_id, connection_id)
|
||||
ON DELETE CASCADE
|
||||
|
||||
@@ -53,40 +53,40 @@ import Simplex.Messaging.Version hiding (version)
|
||||
-- This should not be used directly in code, instead use `maxVersion chatVRange` from ChatConfig.
|
||||
-- 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 :: Version
|
||||
currentChatVersion = 7
|
||||
currentChatVersion :: VersionChat
|
||||
currentChatVersion = VersionChat 7
|
||||
|
||||
-- This should not be used directly in code, instead use `chatVRange` from ChatConfig (see comment above)
|
||||
supportedChatVRange :: VersionRange
|
||||
supportedChatVRange = mkVersionRange 1 currentChatVersion
|
||||
supportedChatVRange :: VersionRangeChat
|
||||
supportedChatVRange = mkVersionRange (VersionChat 1) currentChatVersion
|
||||
|
||||
-- version range that supports skipping establishing direct connections in a group
|
||||
groupNoDirectVRange :: VersionRange
|
||||
groupNoDirectVRange = mkVersionRange 2 currentChatVersion
|
||||
groupNoDirectVRange :: VersionRangeChat
|
||||
groupNoDirectVRange = mkVersionRange (VersionChat 2) currentChatVersion
|
||||
|
||||
-- version range that supports establishing direct connection via x.grp.direct.inv with a group member
|
||||
xGrpDirectInvVRange :: VersionRange
|
||||
xGrpDirectInvVRange = mkVersionRange 2 currentChatVersion
|
||||
xGrpDirectInvVRange :: VersionRangeChat
|
||||
xGrpDirectInvVRange = mkVersionRange (VersionChat 2) currentChatVersion
|
||||
|
||||
-- version range that supports joining group via group link without creating direct contact
|
||||
groupLinkNoContactVRange :: VersionRange
|
||||
groupLinkNoContactVRange = mkVersionRange 3 currentChatVersion
|
||||
groupLinkNoContactVRange :: VersionRangeChat
|
||||
groupLinkNoContactVRange = mkVersionRange (VersionChat 3) currentChatVersion
|
||||
|
||||
-- version range that supports group forwarding
|
||||
groupForwardVRange :: VersionRange
|
||||
groupForwardVRange = mkVersionRange 4 currentChatVersion
|
||||
groupForwardVRange :: VersionRangeChat
|
||||
groupForwardVRange = mkVersionRange (VersionChat 4) currentChatVersion
|
||||
|
||||
-- version range that supports batch sending in groups
|
||||
batchSendVRange :: VersionRange
|
||||
batchSendVRange = mkVersionRange 5 currentChatVersion
|
||||
batchSendVRange :: VersionRangeChat
|
||||
batchSendVRange = mkVersionRange (VersionChat 5) currentChatVersion
|
||||
|
||||
-- version range that supports sending group welcome message in group history
|
||||
groupHistoryIncludeWelcomeVRange :: VersionRange
|
||||
groupHistoryIncludeWelcomeVRange = mkVersionRange 6 currentChatVersion
|
||||
groupHistoryIncludeWelcomeVRange :: VersionRangeChat
|
||||
groupHistoryIncludeWelcomeVRange = mkVersionRange (VersionChat 6) currentChatVersion
|
||||
|
||||
-- version range that supports sending member profile updates to groups
|
||||
memberProfileUpdateVRange :: VersionRange
|
||||
memberProfileUpdateVRange = mkVersionRange 7 currentChatVersion
|
||||
memberProfileUpdateVRange :: VersionRangeChat
|
||||
memberProfileUpdateVRange = mkVersionRange (VersionChat 7) currentChatVersion
|
||||
|
||||
data ConnectionEntity
|
||||
= RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact}
|
||||
@@ -217,7 +217,7 @@ instance ToJSON LinkContent where
|
||||
$(JQ.deriveJSON defaultJSON ''LinkPreview)
|
||||
|
||||
data ChatMessage e = ChatMessage
|
||||
{ chatVRange :: VersionRange,
|
||||
{ chatVRange :: VersionRangeChat,
|
||||
msgId :: Maybe SharedMsgId,
|
||||
chatMsgEvent :: ChatMsgEvent e
|
||||
}
|
||||
|
||||
@@ -35,9 +35,8 @@ 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.Util (eitherToMaybe)
|
||||
import Simplex.Messaging.Version (VersionRange)
|
||||
|
||||
getConnectionEntity :: DB.Connection -> VersionRange -> 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
|
||||
@@ -61,7 +60,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
|
||||
[sql|
|
||||
SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, custom_user_profile_id,
|
||||
conn_status, conn_type, contact_conn_initiated, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id,
|
||||
created_at, security_code, security_code_verified_at, pq_enabled, auth_err_counter,
|
||||
created_at, security_code, security_code_verified_at, enable_pq, pq_snd_enabled, pq_rcv_enabled, auth_err_counter,
|
||||
peer_chat_min_version, peer_chat_max_version
|
||||
FROM connections
|
||||
WHERE user_id = ? AND agent_conn_id = ?
|
||||
@@ -158,7 +157,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
|
||||
userContact_ [(cReq, groupId)] = Right UserContact {userContactLinkId, connReqContact = cReq, groupId}
|
||||
userContact_ _ = Left SEUserContactLinkNotFound
|
||||
|
||||
getConnectionEntityByConnReq :: DB.Connection -> VersionRange -> User -> (ConnReqInvitation, ConnReqInvitation) -> IO (Maybe ConnectionEntity)
|
||||
getConnectionEntityByConnReq :: DB.Connection -> VersionRangeChat -> User -> (ConnReqInvitation, ConnReqInvitation) -> IO (Maybe ConnectionEntity)
|
||||
getConnectionEntityByConnReq db vr user@User {userId} (cReqSchema1, cReqSchema2) = do
|
||||
connId_ <-
|
||||
maybeFirstRow fromOnly $
|
||||
@@ -169,7 +168,7 @@ getConnectionEntityByConnReq db vr user@User {userId} (cReqSchema1, cReqSchema2)
|
||||
-- multiple connections can have same via_contact_uri_hash if request was repeated;
|
||||
-- this function searches for latest connection with contact so that "known contact" plan would be chosen;
|
||||
-- deleted connections are filtered out to allow re-connecting via same contact address
|
||||
getContactConnEntityByConnReqHash :: DB.Connection -> VersionRange -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe ConnectionEntity)
|
||||
getContactConnEntityByConnReqHash :: DB.Connection -> VersionRangeChat -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe ConnectionEntity)
|
||||
getContactConnEntityByConnReqHash db vr user@User {userId} (cReqHash1, cReqHash2) = do
|
||||
connId_ <-
|
||||
maybeFirstRow fromOnly $
|
||||
@@ -189,7 +188,7 @@ getContactConnEntityByConnReqHash db vr user@User {userId} (cReqHash1, cReqHash2
|
||||
(userId, cReqHash1, cReqHash2, ConnDeleted)
|
||||
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db vr user) connId_
|
||||
|
||||
getConnectionsToSubscribe :: DB.Connection -> VersionRange -> IO ([ConnId], [ConnectionEntity])
|
||||
getConnectionsToSubscribe :: DB.Connection -> 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
|
||||
|
||||
@@ -124,14 +124,14 @@ deletePendingContactConnection db userId connId =
|
||||
|]
|
||||
(userId, connId, ConnContact)
|
||||
|
||||
createAddressContactConnection :: DB.Connection -> User -> Contact -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> SubscriptionMode -> ExceptT StoreError IO Contact
|
||||
createAddressContactConnection db user@User {userId} Contact {contactId} acId cReqHash xContactId incognitoProfile subMode = do
|
||||
PendingContactConnection {pccConnId} <- liftIO $ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile Nothing subMode
|
||||
createAddressContactConnection :: DB.Connection -> User -> Contact -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> SubscriptionMode -> PQFlag -> ExceptT StoreError IO Contact
|
||||
createAddressContactConnection db user@User {userId} Contact {contactId} acId cReqHash xContactId incognitoProfile subMode enablePQ = do
|
||||
PendingContactConnection {pccConnId} <- liftIO $ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile Nothing subMode enablePQ
|
||||
liftIO $ DB.execute db "UPDATE connections SET contact_id = ? WHERE connection_id = ?" (contactId, pccConnId)
|
||||
getContact db user contactId
|
||||
|
||||
createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> IO PendingContactConnection
|
||||
createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId subMode = do
|
||||
createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> PQFlag -> IO PendingContactConnection
|
||||
createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId subMode enablePQ = do
|
||||
createdAt <- getCurrentTime
|
||||
customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile
|
||||
let pccConnStatus = ConnJoined
|
||||
@@ -140,10 +140,14 @@ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile grou
|
||||
[sql|
|
||||
INSERT INTO connections (
|
||||
user_id, agent_conn_id, conn_status, conn_type, contact_conn_initiated,
|
||||
via_contact_uri_hash, xcontact_id, custom_user_profile_id, via_group_link, group_link_id, created_at, updated_at, to_subscribe
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
via_contact_uri_hash, xcontact_id, custom_user_profile_id, via_group_link, group_link_id,
|
||||
created_at, updated_at, to_subscribe, enable_pq
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
((userId, acId, pccConnStatus, ConnContact, True, cReqHash, xContactId) :. (customUserProfileId, isJust groupLinkId, groupLinkId, createdAt, createdAt, subMode == SMOnlyCreate))
|
||||
( (userId, acId, pccConnStatus, ConnContact, True, cReqHash, xContactId)
|
||||
:. (customUserProfileId, isJust groupLinkId, groupLinkId)
|
||||
:. (createdAt, createdAt, subMode == SMOnlyCreate, enablePQ)
|
||||
)
|
||||
pccConnId <- insertedRowId db
|
||||
pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = True, viaUserContactLink = Nothing, groupLinkId, customUserProfileId, connReqInv = Nothing, localAlias = "", createdAt, updatedAt = createdAt}
|
||||
|
||||
@@ -173,7 +177,7 @@ getContactByConnReqHash db user@User {userId} cReqHash =
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_enabled, c.auth_err_counter,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.enable_pq, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM contacts ct
|
||||
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
|
||||
@@ -184,8 +188,8 @@ getContactByConnReqHash db user@User {userId} cReqHash =
|
||||
|]
|
||||
(userId, cReqHash, CSActive)
|
||||
|
||||
createDirectConnection :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> ConnStatus -> Maybe Profile -> SubscriptionMode -> IO PendingContactConnection
|
||||
createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile subMode = do
|
||||
createDirectConnection :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> ConnStatus -> Maybe Profile -> SubscriptionMode -> PQFlag -> IO PendingContactConnection
|
||||
createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile subMode enablePQ = do
|
||||
createdAt <- getCurrentTime
|
||||
customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile
|
||||
let contactConnInitiated = pccConnStatus == ConnNew
|
||||
@@ -193,9 +197,13 @@ createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO connections
|
||||
(user_id, agent_conn_id, conn_req_inv, conn_status, conn_type, contact_conn_initiated, custom_user_profile_id, created_at, updated_at, to_subscribe) VALUES (?,?,?,?,?,?,?,?,?,?)
|
||||
(user_id, agent_conn_id, conn_req_inv, conn_status, conn_type, contact_conn_initiated, custom_user_profile_id,
|
||||
created_at, updated_at, to_subscribe, enable_pq)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
(userId, acId, cReq, pccConnStatus, ConnContact, contactConnInitiated, customUserProfileId, createdAt, createdAt, subMode == SMOnlyCreate)
|
||||
( (userId, acId, cReq, pccConnStatus, ConnContact, contactConnInitiated, customUserProfileId)
|
||||
:. (createdAt, createdAt, subMode == SMOnlyCreate, enablePQ)
|
||||
)
|
||||
pccConnId <- insertedRowId db
|
||||
pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = False, viaUserContactLink = Nothing, groupLinkId = Nothing, customUserProfileId, connReqInv = Just cReq, localAlias = "", createdAt, updatedAt = createdAt}
|
||||
|
||||
@@ -522,7 +530,7 @@ getUserContacts db user@User {userId} = do
|
||||
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.Connection -> User -> Int64 -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> ExceptT StoreError IO ContactOrRequest
|
||||
createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (VersionRange minV maxV) Profile {displayName, fullName, image, contactLink, preferences} xContactId_ =
|
||||
liftIO (maybeM getContact' xContactId_) >>= \case
|
||||
Just contact -> pure $ CORContact contact
|
||||
@@ -569,7 +577,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_enabled, c.auth_err_counter,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.enable_pq, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM contacts ct
|
||||
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
|
||||
@@ -697,8 +705,8 @@ deleteContactRequest db User {userId} contactRequestId = do
|
||||
(userId, userId, contactRequestId, userId)
|
||||
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId)
|
||||
|
||||
createAcceptedContact :: DB.Connection -> User -> ConnId -> VersionRange -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> Bool -> IO Contact
|
||||
createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}} agentConnId cReqChatVRange localDisplayName profileId profile userContactLinkId xContactId incognitoProfile subMode contactUsed = do
|
||||
createAcceptedContact :: DB.Connection -> User -> ConnId -> VersionRangeChat -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> PQFlag -> Bool -> IO Contact
|
||||
createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}} agentConnId cReqChatVRange localDisplayName profileId profile userContactLinkId xContactId incognitoProfile subMode enablePQ contactUsed = do
|
||||
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
|
||||
createdAt <- getCurrentTime
|
||||
customUserProfileId <- forM incognitoProfile $ \case
|
||||
@@ -710,7 +718,7 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}
|
||||
"INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, created_at, updated_at, chat_ts, xcontact_id, contact_used) VALUES (?,?,?,?,?,?,?,?,?,?)"
|
||||
(userId, localDisplayName, profileId, True, userPreferences, createdAt, createdAt, createdAt, xContactId, contactUsed)
|
||||
contactId <- insertedRowId db
|
||||
conn <- createConnection_ db userId ConnContact (Just contactId) agentConnId cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode
|
||||
conn <- createConnection_ db userId ConnContact (Just contactId) agentConnId cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode enablePQ
|
||||
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn
|
||||
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn = Just conn, viaGroup = Nothing, contactUsed, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False}
|
||||
|
||||
@@ -734,7 +742,7 @@ getContact_ db user@User {userId} contactId deleted =
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_enabled, c.auth_err_counter,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.enable_pq, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM contacts ct
|
||||
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
|
||||
@@ -788,7 +796,7 @@ getContactConnections db userId Contact {contactId} =
|
||||
[sql|
|
||||
SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_enabled, c.auth_err_counter,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.enable_pq, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM connections c
|
||||
JOIN contacts ct ON ct.contact_id = c.contact_id
|
||||
@@ -806,7 +814,7 @@ getConnectionById db User {userId} connId = ExceptT $ do
|
||||
[sql|
|
||||
SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, custom_user_profile_id,
|
||||
conn_status, conn_type, contact_conn_initiated, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id,
|
||||
created_at, security_code, security_code_verified_at, pq_enabled, auth_err_counter,
|
||||
created_at, security_code, security_code_verified_at, enable_pq, pq_snd_enabled, pq_rcv_enabled, auth_err_counter,
|
||||
peer_chat_min_version, peer_chat_max_version
|
||||
FROM connections
|
||||
WHERE user_id = ? AND connection_id = ?
|
||||
|
||||
@@ -115,7 +115,6 @@ import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
|
||||
import qualified Simplex.Messaging.Crypto.File as CF
|
||||
import Simplex.Messaging.Protocol (SubscriptionMode (..))
|
||||
import Simplex.Messaging.Version (VersionRange)
|
||||
import System.FilePath (takeFileName)
|
||||
|
||||
getLiveSndFileTransfers :: DB.Connection -> User -> IO [SndFileTransfer]
|
||||
@@ -431,7 +430,7 @@ lookupChatRefByFileId db User {userId} fileId =
|
||||
createSndFileConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> SubscriptionMode -> IO Connection
|
||||
createSndFileConnection_ db userId fileId agentConnId subMode = do
|
||||
currentTs <- getCurrentTime
|
||||
createConnection_ db userId ConnSndFile (Just fileId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode
|
||||
createConnection_ db userId ConnSndFile (Just fileId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode False
|
||||
|
||||
updateSndFileStatus :: DB.Connection -> SndFileTransfer -> FileStatus -> IO ()
|
||||
updateSndFileStatus db SndFileTransfer {fileId, connId} status = do
|
||||
@@ -693,7 +692,7 @@ getRcvFileTransfer_ db userId fileId = do
|
||||
_ -> pure Nothing
|
||||
cancelled = fromMaybe False cancelled_
|
||||
|
||||
acceptRcvFileTransfer :: DB.Connection -> VersionRange -> User -> Int64 -> (CommandId, ConnId) -> ConnStatus -> FilePath -> SubscriptionMode -> ExceptT StoreError IO AChatItem
|
||||
acceptRcvFileTransfer :: DB.Connection -> 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
|
||||
@@ -714,7 +713,7 @@ getContactByFileId db 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 -> VersionRange -> 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
|
||||
@@ -723,7 +722,7 @@ startRcvInlineFT :: DB.Connection -> User -> RcvFileTransfer -> FilePath -> Mayb
|
||||
startRcvInlineFT db user RcvFileTransfer {fileId} filePath rcvFileInline =
|
||||
acceptRcvFT_ db user fileId filePath rcvFileInline =<< getCurrentTime
|
||||
|
||||
xftpAcceptRcvFT :: DB.Connection -> VersionRange -> User -> FileTransferId -> FilePath -> ExceptT StoreError IO AChatItem
|
||||
xftpAcceptRcvFT :: DB.Connection -> 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
|
||||
@@ -998,7 +997,7 @@ getLocalCryptoFile db userId fileId sent =
|
||||
pure $ CryptoFile filePath fileCryptoArgs
|
||||
_ -> throwError $ SEFileNotFound fileId
|
||||
|
||||
updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> VersionRange -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem
|
||||
updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> 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
|
||||
|
||||
@@ -148,11 +148,11 @@ import UnliftIO.STM
|
||||
|
||||
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Maybe ImageData, Maybe ProfileId, Maybe MsgFilter, Maybe Bool, Bool, Maybe GroupPreferences) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. GroupMemberRow
|
||||
|
||||
type GroupMemberRow = ((Int64, Int64, MemberId, Version, Version, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
|
||||
type GroupMemberRow = ((Int64, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId, ProfileId, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences))
|
||||
|
||||
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe Version, Maybe Version, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
|
||||
type MaybeGroupMemberRow = ((Maybe Int64, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe Bool, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId, Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe ImageData, Maybe ConnReqContact, Maybe LocalAlias, Maybe Preferences))
|
||||
|
||||
toGroupInfo :: VersionRange -> Int64 -> GroupInfoRow -> GroupInfo
|
||||
toGroupInfo :: VersionRangeChat -> Int64 -> GroupInfoRow -> GroupInfo
|
||||
toGroupInfo vr userContactId ((groupId, localDisplayName, displayName, fullName, description, image, hostConnCustomUserProfileId, enableNtfs_, sendRcpts, favorite, groupPreferences) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. userMemberRow) =
|
||||
let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = JVersionRange vr}
|
||||
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite}
|
||||
@@ -184,7 +184,7 @@ createGroupLink db User {userId} groupInfo@GroupInfo {groupId, localDisplayName}
|
||||
"INSERT INTO user_contact_links (user_id, group_id, group_link_id, local_display_name, conn_req_contact, group_link_member_role, auto_accept, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
|
||||
(userId, groupId, groupLinkId, "group_link_" <> localDisplayName, cReq, memberRole, True, currentTs, currentTs)
|
||||
userContactLinkId <- insertedRowId db
|
||||
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode
|
||||
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode False
|
||||
|
||||
getGroupLinkConnection :: DB.Connection -> User -> GroupInfo -> ExceptT StoreError IO Connection
|
||||
getGroupLinkConnection db User {userId} groupInfo@GroupInfo {groupId} =
|
||||
@@ -194,7 +194,7 @@ getGroupLinkConnection db User {userId} groupInfo@GroupInfo {groupId} =
|
||||
[sql|
|
||||
SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_enabled, c.auth_err_counter,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.enable_pq, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM connections c
|
||||
JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id
|
||||
@@ -259,7 +259,7 @@ setGroupLinkMemberRole :: DB.Connection -> User -> Int64 -> GroupMemberRole -> I
|
||||
setGroupLinkMemberRole db User {userId} userContactLinkId memberRole =
|
||||
DB.execute db "UPDATE user_contact_links SET group_link_member_role = ? WHERE user_id = ? AND user_contact_link_id = ?" (memberRole, userId, userContactLinkId)
|
||||
|
||||
getGroupAndMember :: DB.Connection -> User -> Int64 -> VersionRange -> ExceptT StoreError IO (GroupInfo, GroupMember)
|
||||
getGroupAndMember :: DB.Connection -> User -> Int64 -> VersionRangeChat -> ExceptT StoreError IO (GroupInfo, GroupMember)
|
||||
getGroupAndMember db User {userId, userContactId} groupMemberId vr =
|
||||
ExceptT . firstRow toGroupAndMember (SEInternalError "referenced group member not found") $
|
||||
DB.query
|
||||
@@ -280,7 +280,7 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr =
|
||||
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_enabled, c.auth_err_counter,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.enable_pq, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
@@ -304,7 +304,7 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr =
|
||||
in (groupInfo, (member :: GroupMember) {activeConn = toMaybeConnection connRow})
|
||||
|
||||
-- | creates completely new group with a single member - the current user
|
||||
createNewGroup :: DB.Connection -> VersionRange -> TVar ChaChaDRG -> User -> GroupProfile -> Maybe Profile -> ExceptT StoreError IO GroupInfo
|
||||
createNewGroup :: DB.Connection -> 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
|
||||
@@ -346,7 +346,7 @@ createNewGroup db vr gVar user@User {userId} groupProfile incognitoProfile = Exc
|
||||
}
|
||||
|
||||
-- | creates a new group record for the group the current user was invited to, or returns an existing one
|
||||
createGroupInvitation :: DB.Connection -> VersionRange -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId)
|
||||
createGroupInvitation :: DB.Connection -> 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
|
||||
@@ -417,7 +417,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 -> VersionRange -> 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 memberChatVRange@(VersionRange minV maxV) = do
|
||||
incognitoProfile <- forM incognitoProfileId $ \profileId -> getProfileById db userId profileId
|
||||
(localDisplayName, memberProfile) <- case (incognitoProfile, incognitoProfileId) of
|
||||
@@ -480,7 +480,7 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe
|
||||
)
|
||||
pure $ Right incognitoLdn
|
||||
|
||||
createGroupInvitedViaLink :: DB.Connection -> VersionRange -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
|
||||
createGroupInvitedViaLink :: DB.Connection -> VersionRangeChat -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
|
||||
createGroupInvitedViaLink
|
||||
db
|
||||
vr
|
||||
@@ -551,7 +551,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 -> VersionRange -> 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 user gInfo
|
||||
@@ -606,12 +606,12 @@ deleteGroupProfile_ db userId groupId =
|
||||
|]
|
||||
(userId, groupId)
|
||||
|
||||
getUserGroups :: DB.Connection -> VersionRange -> 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 -> VersionRange -> 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
|
||||
@@ -634,7 +634,7 @@ getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ =
|
||||
where
|
||||
search = fromMaybe "" search_
|
||||
|
||||
getUserGroupsWithSummary :: DB.Connection -> VersionRange -> User -> Maybe ContactId -> Maybe String -> IO [(GroupInfo, GroupSummary)]
|
||||
getUserGroupsWithSummary :: DB.Connection -> 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)
|
||||
@@ -675,7 +675,7 @@ checkContactHasGroups :: DB.Connection -> User -> Contact -> IO (Maybe GroupId)
|
||||
checkContactHasGroups db User {userId} Contact {contactId} =
|
||||
maybeFirstRow fromOnly $ DB.query db "SELECT group_id FROM group_members WHERE user_id = ? AND contact_id = ? LIMIT 1" (userId, contactId)
|
||||
|
||||
getGroupInfoByName :: DB.Connection -> VersionRange -> User -> GroupName -> ExceptT StoreError IO GroupInfo
|
||||
getGroupInfoByName :: DB.Connection -> VersionRangeChat -> User -> GroupName -> ExceptT StoreError IO GroupInfo
|
||||
getGroupInfoByName db vr user gName = do
|
||||
gId <- getGroupIdByName db user gName
|
||||
getGroupInfo db vr user gId
|
||||
@@ -688,7 +688,7 @@ groupMemberQuery =
|
||||
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_enabled, c.auth_err_counter,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.enable_pq, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
@@ -765,7 +765,7 @@ getGroupCurrentMembersCount db User {userId} GroupInfo {groupId} = do
|
||||
(groupId, userId)
|
||||
pure $ length $ filter memberCurrent' statuses
|
||||
|
||||
getGroupInvitation :: DB.Connection -> VersionRange -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation
|
||||
getGroupInvitation :: DB.Connection -> VersionRangeChat -> User -> GroupId -> ExceptT StoreError IO ReceivedGroupInvitation
|
||||
getGroupInvitation db vr user groupId =
|
||||
getConnRec_ user >>= \case
|
||||
Just connRequest -> do
|
||||
@@ -830,7 +830,7 @@ createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId,
|
||||
:. (minV, maxV)
|
||||
)
|
||||
|
||||
createNewContactMemberAsync :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> Contact -> GroupMemberRole -> (CommandId, ConnId) -> VersionRange -> SubscriptionMode -> ExceptT StoreError IO ()
|
||||
createNewContactMemberAsync :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> Contact -> GroupMemberRole -> (CommandId, ConnId) -> VersionRangeChat -> SubscriptionMode -> ExceptT StoreError IO ()
|
||||
createNewContactMemberAsync db gVar user@User {userId, userContactId} GroupInfo {groupId, membership} Contact {contactId, localDisplayName, profile} memberRole (cmdId, agentConnId) peerChatVRange subMode =
|
||||
createWithRandomId gVar $ \memId -> do
|
||||
createdAt <- liftIO getCurrentTime
|
||||
@@ -896,7 +896,7 @@ createAcceptedMemberConnection
|
||||
groupMemberId
|
||||
subMode = do
|
||||
createdAt <- liftIO getCurrentTime
|
||||
Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId (fromJVersionRange cReqChatVRange) Nothing (Just userContactLinkId) Nothing 0 createdAt subMode
|
||||
Connection {connId} <- createConnection_ db userId ConnMember (Just groupMemberId) agentConnId (fromJVersionRange cReqChatVRange) Nothing (Just userContactLinkId) Nothing 0 createdAt subMode False
|
||||
setCommandConnId db user cmdId connId
|
||||
|
||||
getContactViaMember :: DB.Connection -> User -> GroupMember -> ExceptT StoreError IO Contact
|
||||
@@ -926,12 +926,12 @@ getMemberInvitation db User {userId} groupMemberId =
|
||||
fmap join . maybeFirstRow fromOnly $
|
||||
DB.query db "SELECT sent_inv_queue_info FROM group_members WHERE group_member_id = ? AND user_id = ?" (groupMemberId, userId)
|
||||
|
||||
createMemberConnection :: DB.Connection -> UserId -> GroupMember -> ConnId -> VersionRange -> SubscriptionMode -> IO ()
|
||||
createMemberConnection :: DB.Connection -> UserId -> GroupMember -> ConnId -> VersionRangeChat -> SubscriptionMode -> IO ()
|
||||
createMemberConnection db userId GroupMember {groupMemberId} agentConnId peerChatVRange subMode = do
|
||||
currentTs <- getCurrentTime
|
||||
void $ createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 currentTs subMode
|
||||
|
||||
createMemberConnectionAsync :: DB.Connection -> User -> GroupMemberId -> (CommandId, ConnId) -> VersionRange -> SubscriptionMode -> IO ()
|
||||
createMemberConnectionAsync :: DB.Connection -> User -> GroupMemberId -> (CommandId, ConnId) -> VersionRangeChat -> SubscriptionMode -> IO ()
|
||||
createMemberConnectionAsync db user@User {userId} groupMemberId (cmdId, agentConnId) peerChatVRange subMode = do
|
||||
currentTs <- getCurrentTime
|
||||
Connection {connId} <- createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 currentTs subMode
|
||||
@@ -1065,7 +1065,7 @@ updateGroupMemberRole :: DB.Connection -> User -> GroupMember -> GroupMemberRole
|
||||
updateGroupMemberRole db User {userId} GroupMember {groupMemberId} memRole =
|
||||
DB.execute db "UPDATE group_members SET member_role = ? WHERE user_id = ? AND group_member_id = ?" (memRole, userId, groupMemberId)
|
||||
|
||||
createIntroductions :: DB.Connection -> Version -> [GroupMember] -> GroupMember -> IO [GroupMemberIntro]
|
||||
createIntroductions :: DB.Connection -> VersionChat -> [GroupMember] -> GroupMember -> IO [GroupMemberIntro]
|
||||
createIntroductions db chatV members toMember = do
|
||||
let reMembers = filter (\m -> memberCurrent m && groupMemberId' m /= groupMemberId' toMember) members
|
||||
if null reMembers
|
||||
@@ -1218,7 +1218,7 @@ createIntroReMember
|
||||
currentTs <- liftIO getCurrentTime
|
||||
newMember <- case directConnIds of
|
||||
Just (directCmdId, directAgentConnId) -> do
|
||||
Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId mcvr memberContactId Nothing customUserProfileId cLevel currentTs subMode
|
||||
Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId mcvr memberContactId Nothing customUserProfileId cLevel currentTs subMode False
|
||||
liftIO $ setCommandConnId db user directCmdId directConnId
|
||||
(localDisplayName, contactId, memProfileId) <- createContact_ db userId memberProfile "" (Just groupId) currentTs False
|
||||
liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, directConnId)
|
||||
@@ -1232,14 +1232,14 @@ createIntroReMember
|
||||
liftIO $ setCommandConnId db user groupCmdId groupConnId
|
||||
pure (member :: GroupMember) {activeConn = Just conn}
|
||||
|
||||
createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionRange -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> IO ()
|
||||
createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionRangeChat -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> IO ()
|
||||
createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = viaContactId, activeConn} _to@GroupMember {groupMemberId, localDisplayName} mcvr (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do
|
||||
let cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn
|
||||
currentTs <- getCurrentTime
|
||||
Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId mcvr viaContactId cLevel currentTs subMode
|
||||
setCommandConnId db user groupCmdId groupConnId
|
||||
forM_ directConnIds $ \(directCmdId, directAgentConnId) -> do
|
||||
Connection {connId = directConnId} <- createConnection_ db userId ConnContact Nothing directAgentConnId mcvr viaContactId Nothing customUserProfileId cLevel currentTs subMode
|
||||
Connection {connId = directConnId} <- createConnection_ db userId ConnContact Nothing directAgentConnId mcvr viaContactId Nothing customUserProfileId cLevel currentTs subMode False
|
||||
setCommandConnId db user directCmdId directConnId
|
||||
contactId <- createMemberContact_ directConnId currentTs
|
||||
updateMember_ contactId currentTs
|
||||
@@ -1269,10 +1269,11 @@ createIntroToMemberContact db user@User {userId} GroupMember {memberContactId =
|
||||
|]
|
||||
[":contact_id" := contactId, ":updated_at" := ts, ":group_member_id" := groupMemberId]
|
||||
|
||||
createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> VersionRange -> Maybe Int64 -> Int -> UTCTime -> SubscriptionMode -> IO Connection
|
||||
createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange viaContact = createConnection_ db userId ConnMember (Just groupMemberId) agentConnId peerChatVRange viaContact Nothing Nothing
|
||||
createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> VersionRangeChat -> Maybe Int64 -> Int -> UTCTime -> SubscriptionMode -> IO Connection
|
||||
createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange viaContact connLevel currentTs subMode =
|
||||
createConnection_ db userId ConnMember (Just groupMemberId) agentConnId peerChatVRange viaContact Nothing Nothing connLevel currentTs subMode False
|
||||
|
||||
getViaGroupMember :: DB.Connection -> VersionRange -> 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
|
||||
@@ -1293,7 +1294,7 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} =
|
||||
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_enabled, c.auth_err_counter,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.enable_pq, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM group_members m
|
||||
JOIN contacts ct ON ct.contact_id = m.contact_id
|
||||
@@ -1368,7 +1369,7 @@ updateGroupProfile db user@User {userId} g@GroupInfo {groupId, localDisplayName,
|
||||
(ldn, currentTs, userId, groupId)
|
||||
safeDeleteLDN db user localDisplayName
|
||||
|
||||
getGroupInfo :: DB.Connection -> VersionRange -> 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
|
||||
@@ -1391,7 +1392,7 @@ getGroupInfo db vr User {userId, userContactId} groupId =
|
||||
|]
|
||||
(groupId, userId, userContactId)
|
||||
|
||||
getGroupInfoByUserContactLinkConnReq :: DB.Connection -> VersionRange -> 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 $
|
||||
@@ -1405,7 +1406,7 @@ getGroupInfoByUserContactLinkConnReq db vr user@User {userId} (cReqSchema1, cReq
|
||||
(userId, cReqSchema1, cReqSchema2)
|
||||
maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getGroupInfo db vr user) groupId_
|
||||
|
||||
getGroupInfoByGroupLinkHash :: DB.Connection -> VersionRange -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe GroupInfo)
|
||||
getGroupInfoByGroupLinkHash :: DB.Connection -> VersionRangeChat -> User -> (ConnReqUriHash, ConnReqUriHash) -> IO (Maybe GroupInfo)
|
||||
getGroupInfoByGroupLinkHash db vr user@User {userId, userContactId} (groupLinkHash1, groupLinkHash2) = do
|
||||
groupId_ <-
|
||||
maybeFirstRow fromOnly $
|
||||
@@ -1432,7 +1433,7 @@ getGroupMemberIdByName db User {userId} groupId groupMemberName =
|
||||
ExceptT . firstRow fromOnly (SEGroupMemberNameNotFound groupId groupMemberName) $
|
||||
DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND local_display_name = ?" (userId, groupId, groupMemberName)
|
||||
|
||||
getActiveMembersByName :: DB.Connection -> VersionRange -> User -> ContactName -> ExceptT StoreError IO [(GroupInfo, GroupMember)]
|
||||
getActiveMembersByName :: DB.Connection -> VersionRangeChat -> User -> ContactName -> ExceptT StoreError IO [(GroupInfo, GroupMember)]
|
||||
getActiveMembersByName db vr user@User {userId} groupMemberName = do
|
||||
groupMemberIds :: [(GroupId, GroupMemberId)] <-
|
||||
liftIO $
|
||||
@@ -1931,13 +1932,15 @@ createMemberContact
|
||||
localAlias = "",
|
||||
createdAt = currentTs,
|
||||
connectionCode = Nothing,
|
||||
pqEnabled = Nothing,
|
||||
enablePQ = False,
|
||||
pqSndEnabled = Nothing,
|
||||
pqRcvEnabled = Nothing,
|
||||
authErrCounter = 0
|
||||
}
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
|
||||
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False}
|
||||
|
||||
getMemberContact :: DB.Connection -> VersionRange -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
|
||||
getMemberContact :: DB.Connection -> VersionRangeChat -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation)
|
||||
getMemberContact db vr user contactId = do
|
||||
ct <- getContact db user contactId
|
||||
let Contact {contactGroupMemberId, activeConn} = ct
|
||||
@@ -2060,7 +2063,9 @@ createMemberContactConn_
|
||||
localAlias = "",
|
||||
createdAt = currentTs,
|
||||
connectionCode = Nothing,
|
||||
pqEnabled = Nothing,
|
||||
enablePQ = False,
|
||||
pqSndEnabled = Nothing,
|
||||
pqRcvEnabled = Nothing,
|
||||
authErrCounter = 0
|
||||
}
|
||||
|
||||
@@ -2113,7 +2118,7 @@ setXGrpLinkMemReceived db mId xGrpLinkMemReceived = do
|
||||
"UPDATE group_members SET xgrplinkmem_received = ?, updated_at = ? WHERE group_member_id = ?"
|
||||
(xGrpLinkMemReceived, currentTs, mId)
|
||||
|
||||
createNewUnknownGroupMember :: DB.Connection -> VersionRange -> User -> GroupInfo -> MemberId -> Text -> ExceptT StoreError IO GroupMember
|
||||
createNewUnknownGroupMember :: DB.Connection -> 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
|
||||
|
||||
@@ -147,7 +147,6 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
|
||||
import Simplex.Messaging.Util (eitherToMaybe)
|
||||
import Simplex.Messaging.Version (VersionRange)
|
||||
import UnliftIO.STM
|
||||
|
||||
deleteContactCIs :: DB.Connection -> User -> Contact -> IO ()
|
||||
@@ -482,7 +481,7 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
|
||||
ciQuoteGroup [] = ciQuote Nothing $ CIQGroupRcv Nothing
|
||||
ciQuoteGroup ((Only itemId :. memberRow) : _) = ciQuote itemId . CIQGroupRcv . Just $ toGroupMember userContactId memberRow
|
||||
|
||||
getChatPreviews :: DB.Connection -> VersionRange -> User -> Bool -> PaginationByTime -> ChatListQuery -> IO [Either StoreError AChat]
|
||||
getChatPreviews :: DB.Connection -> 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
|
||||
@@ -715,7 +714,7 @@ findGroupChatPreviews_ db User {userId} pagination clq =
|
||||
)
|
||||
([":user_id" := userId, ":rcv_new" := CISRcvNew, ":search" := search] <> pagParams)
|
||||
|
||||
getGroupChatPreview_ :: DB.Connection -> VersionRange -> User -> ChatPreviewData 'CTGroup -> ExceptT StoreError IO AChat
|
||||
getGroupChatPreview_ :: DB.Connection -> 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
|
||||
@@ -1040,7 +1039,7 @@ getDirectChatBefore_ db user@User {userId} ct@Contact {contactId} beforeChatItem
|
||||
|]
|
||||
(userId, contactId, search, beforeChatItemId, count)
|
||||
|
||||
getGroupChat :: DB.Connection -> VersionRange -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTGroup)
|
||||
getGroupChat :: DB.Connection -> 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
|
||||
@@ -1506,7 +1505,7 @@ toGroupChatItem currentTs userContactId (((itemId, itemTs, AMsgDirection msgDir,
|
||||
ciTimed :: Maybe CITimed
|
||||
ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt}
|
||||
|
||||
getAllChatItems :: DB.Connection -> VersionRange -> User -> ChatPagination -> Maybe String -> ExceptT StoreError IO [AChatItem]
|
||||
getAllChatItems :: DB.Connection -> 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
|
||||
@@ -2150,7 +2149,7 @@ deleteLocalChatItem db User {userId} NoteFolder {noteFolderId} ci = do
|
||||
|]
|
||||
(userId, noteFolderId, itemId)
|
||||
|
||||
getChatItemByFileId :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO AChatItem
|
||||
getChatItemByFileId :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO AChatItem
|
||||
getChatItemByFileId db vr user@User {userId} fileId = do
|
||||
(chatRef, itemId) <-
|
||||
ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByFileId fileId) $
|
||||
@@ -2166,13 +2165,13 @@ getChatItemByFileId db vr user@User {userId} fileId = do
|
||||
(userId, fileId)
|
||||
getAChatItem db vr user chatRef itemId
|
||||
|
||||
lookupChatItemByFileId :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO (Maybe AChatItem)
|
||||
lookupChatItemByFileId :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO (Maybe AChatItem)
|
||||
lookupChatItemByFileId db vr user fileId = do
|
||||
fmap Just (getChatItemByFileId db vr user fileId) `catchError` \case
|
||||
SEChatItemNotFoundByFileId {} -> pure Nothing
|
||||
e -> throwError e
|
||||
|
||||
getChatItemByGroupId :: DB.Connection -> VersionRange -> User -> GroupId -> ExceptT StoreError IO AChatItem
|
||||
getChatItemByGroupId :: DB.Connection -> VersionRangeChat -> User -> GroupId -> ExceptT StoreError IO AChatItem
|
||||
getChatItemByGroupId db vr user@User {userId} groupId = do
|
||||
(chatRef, itemId) <-
|
||||
ExceptT . firstRow' toChatItemRef (SEChatItemNotFoundByGroupId groupId) $
|
||||
@@ -2198,7 +2197,7 @@ getChatRefViaItemId db User {userId} itemId = do
|
||||
(Nothing, Just groupId) -> Right $ ChatRef CTGroup groupId
|
||||
(_, _) -> Left $ SEBadChatItem itemId Nothing
|
||||
|
||||
getAChatItem :: DB.Connection -> VersionRange -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem
|
||||
getAChatItem :: DB.Connection -> VersionRangeChat -> User -> ChatRef -> ChatItemId -> ExceptT StoreError IO AChatItem
|
||||
getAChatItem db vr user chatRef itemId = case chatRef of
|
||||
ChatRef CTDirect contactId -> do
|
||||
ct <- getContact db user contactId
|
||||
|
||||
@@ -323,7 +323,7 @@ createUserContactLink db User {userId} agentConnId cReq subMode =
|
||||
"INSERT INTO user_contact_links (user_id, conn_req_contact, created_at, updated_at) VALUES (?,?,?,?)"
|
||||
(userId, cReq, currentTs, currentTs)
|
||||
userContactLinkId <- insertedRowId db
|
||||
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode
|
||||
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode False
|
||||
|
||||
getUserAddressConnections :: DB.Connection -> User -> ExceptT StoreError IO [Connection]
|
||||
getUserAddressConnections db User {userId} = do
|
||||
@@ -338,7 +338,7 @@ getUserAddressConnections db User {userId} = do
|
||||
[sql|
|
||||
SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_enabled, c.auth_err_counter,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.enable_pq, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM connections c
|
||||
JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id
|
||||
@@ -354,7 +354,7 @@ getUserContactLinks db User {userId} =
|
||||
[sql|
|
||||
SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_enabled, c.auth_err_counter,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.enable_pq, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
uc.user_contact_link_id, uc.conn_req_contact, uc.group_id
|
||||
FROM connections c
|
||||
|
||||
@@ -148,12 +148,12 @@ toFileInfo (fileId, fileStatus, filePath) = CIFileInfo {fileId, fileStatus, file
|
||||
|
||||
type EntityIdsRow = (Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64)
|
||||
|
||||
type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, Bool, Maybe GroupLinkId, Maybe Int64, ConnStatus, ConnType, Bool, LocalAlias) :. EntityIdsRow :. (UTCTime, Maybe Text, Maybe UTCTime, Maybe Bool, Int, Version, Version)
|
||||
type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, Bool, Maybe GroupLinkId, Maybe Int64, ConnStatus, ConnType, Bool, LocalAlias) :. EntityIdsRow :. (UTCTime, Maybe Text, Maybe UTCTime, Maybe PQFlag, Maybe PQFlag, Maybe PQFlag, Int, VersionChat, VersionChat)
|
||||
|
||||
type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe Int64, Maybe Bool, Maybe GroupLinkId, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Bool, Maybe LocalAlias) :. EntityIdsRow :. (Maybe UTCTime, Maybe Text, Maybe UTCTime, Maybe Bool, Maybe Int, Maybe Version, Maybe Version)
|
||||
type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe Int64, Maybe Bool, Maybe GroupLinkId, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Bool, Maybe LocalAlias) :. EntityIdsRow :. (Maybe UTCTime, Maybe Text, Maybe UTCTime, Maybe PQFlag, Maybe PQFlag, Maybe PQFlag, Maybe Int, Maybe VersionChat, Maybe VersionChat)
|
||||
|
||||
toConnection :: ConnectionRow -> Connection
|
||||
toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqEnabled, authErrCounter, minVer, maxVer)) =
|
||||
toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, enablePQ_, pqSndEnabled, pqRcvEnabled, authErrCounter, minVer, maxVer)) =
|
||||
Connection
|
||||
{ connId,
|
||||
agentConnId = AgentConnId acId,
|
||||
@@ -170,7 +170,9 @@ toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroup
|
||||
localAlias,
|
||||
entityId = entityId_ connType,
|
||||
connectionCode = SecurityCode <$> code_ <*> verifiedAt_,
|
||||
pqEnabled,
|
||||
enablePQ = fromMaybe False enablePQ_,
|
||||
pqSndEnabled,
|
||||
pqRcvEnabled,
|
||||
authErrCounter,
|
||||
createdAt
|
||||
}
|
||||
@@ -183,12 +185,12 @@ toConnection ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroup
|
||||
entityId_ ConnUserContact = userContactLinkId
|
||||
|
||||
toMaybeConnection :: MaybeConnectionRow -> Maybe Connection
|
||||
toMaybeConnection ((Just connId, Just agentConnId, Just connLevel, viaContact, viaUserContactLink, Just viaGroupLink, groupLinkId, customUserProfileId, Just connStatus, Just connType, Just contactConnInitiated, Just localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (Just createdAt, code_, verifiedAt_, pqEnabled_, Just authErrCounter, Just minVer, Just maxVer)) =
|
||||
Just $ toConnection ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqEnabled_, authErrCounter, minVer, maxVer))
|
||||
toMaybeConnection ((Just connId, Just agentConnId, Just connLevel, viaContact, viaUserContactLink, Just viaGroupLink, groupLinkId, customUserProfileId, Just connStatus, Just connType, Just contactConnInitiated, Just localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (Just createdAt, code_, verifiedAt_, enablePQ_, pqSndEnabled_, pqRcvEnabled_, Just authErrCounter, Just minVer, Just maxVer)) =
|
||||
Just $ toConnection ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, enablePQ_, pqSndEnabled_, pqRcvEnabled_, authErrCounter, minVer, maxVer))
|
||||
toMaybeConnection _ = Nothing
|
||||
|
||||
createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> VersionRange -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> SubscriptionMode -> IO Connection
|
||||
createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange minV maxV) viaContact viaUserContactLink customUserProfileId connLevel currentTs subMode = do
|
||||
createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> VersionRangeChat -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> SubscriptionMode -> PQFlag -> IO Connection
|
||||
createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange minV maxV) viaContact viaUserContactLink customUserProfileId connLevel currentTs subMode enablePQ = do
|
||||
viaLinkGroupId :: Maybe Int64 <- fmap join . forM viaUserContactLink $ \ucLinkId ->
|
||||
maybeFirstRow fromOnly $ DB.query db "SELECT group_id FROM user_contact_links WHERE user_id = ? AND user_contact_link_id = ? AND group_id IS NOT NULL" (userId, ucLinkId)
|
||||
let viaGroupLink = isJust viaLinkGroupId
|
||||
@@ -198,12 +200,12 @@ createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange
|
||||
INSERT INTO connections (
|
||||
user_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, custom_user_profile_id, conn_status, conn_type,
|
||||
contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at, updated_at,
|
||||
peer_chat_min_version, peer_chat_max_version, to_subscribe
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
peer_chat_min_version, peer_chat_max_version, to_subscribe, enable_pq
|
||||
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
( (userId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, customUserProfileId, ConnNew, connType)
|
||||
:. (ent ConnContact, ent ConnMember, ent ConnSndFile, ent ConnRcvFile, ent ConnUserContact, currentTs, currentTs)
|
||||
:. (minV, maxV, subMode == SMOnlyCreate)
|
||||
:. (minV, maxV, subMode == SMOnlyCreate, enablePQ)
|
||||
)
|
||||
connId <- insertedRowId db
|
||||
pure
|
||||
@@ -224,7 +226,9 @@ createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange
|
||||
localAlias = "",
|
||||
createdAt = currentTs,
|
||||
connectionCode = Nothing,
|
||||
pqEnabled = Nothing,
|
||||
enablePQ,
|
||||
pqSndEnabled = Nothing,
|
||||
pqRcvEnabled = Nothing,
|
||||
authErrCounter = 0
|
||||
}
|
||||
where
|
||||
@@ -241,18 +245,40 @@ createIncognitoProfile_ db userId createdAt Profile {displayName, fullName, imag
|
||||
(displayName, fullName, image, userId, Just True, createdAt, createdAt)
|
||||
insertedRowId db
|
||||
|
||||
updateConnPQEnabled :: DB.Connection -> Int64 -> Bool -> IO ()
|
||||
updateConnPQEnabled db connId pqEnabled =
|
||||
updateConnPQSndEnabled :: DB.Connection -> Int64 -> PQFlag -> IO ()
|
||||
updateConnPQSndEnabled db connId pqSndEnabled =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE connections
|
||||
SET pq_enabled = ?
|
||||
SET pq_snd_enabled = ?
|
||||
WHERE connection_id = ?
|
||||
|]
|
||||
(pqEnabled, connId)
|
||||
(pqSndEnabled, connId)
|
||||
|
||||
setPeerChatVRange :: DB.Connection -> Int64 -> VersionRange -> IO ()
|
||||
updateConnPQRcvEnabled :: DB.Connection -> Int64 -> PQFlag -> IO ()
|
||||
updateConnPQRcvEnabled db connId pqRcvEnabled =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE connections
|
||||
SET pq_rcv_enabled = ?
|
||||
WHERE connection_id = ?
|
||||
|]
|
||||
(pqRcvEnabled, connId)
|
||||
|
||||
updateConnPQEnabledCON :: DB.Connection -> Int64 -> PQFlag -> IO ()
|
||||
updateConnPQEnabledCON db connId pqEnabled =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE connections
|
||||
SET pq_snd_enabled = ?, pq_rcv_enabled = ?
|
||||
WHERE connection_id = ?
|
||||
|]
|
||||
(pqEnabled, pqEnabled, connId)
|
||||
|
||||
setPeerChatVRange :: DB.Connection -> Int64 -> VersionRangeChat -> IO ()
|
||||
setPeerChatVRange db connId (VersionRange minVer maxVer) =
|
||||
DB.execute
|
||||
db
|
||||
@@ -263,7 +289,7 @@ setPeerChatVRange db connId (VersionRange minVer maxVer) =
|
||||
|]
|
||||
(minVer, maxVer, connId)
|
||||
|
||||
setMemberChatVRange :: DB.Connection -> GroupMemberId -> VersionRange -> IO ()
|
||||
setMemberChatVRange :: DB.Connection -> GroupMemberId -> VersionRangeChat -> IO ()
|
||||
setMemberChatVRange db mId (VersionRange minVer maxVer) =
|
||||
DB.execute
|
||||
db
|
||||
@@ -350,7 +376,7 @@ getProfileById db userId profileId =
|
||||
toProfile :: (ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences) -> LocalProfile
|
||||
toProfile (displayName, fullName, image, contactLink, localAlias, preferences) = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
|
||||
|
||||
type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact) :. (Maybe XContactId, Maybe Preferences, UTCTime, UTCTime, Version, Version)
|
||||
type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact) :. (Maybe XContactId, Maybe Preferences, UTCTime, UTCTime, VersionChat, VersionChat)
|
||||
|
||||
toContactRequest :: ContactRequestRow -> UserContactRequest
|
||||
toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image, contactLink) :. (xContactId, preferences, createdAt, updatedAt, minVer, maxVer)) = do
|
||||
|
||||
@@ -38,6 +38,7 @@ import qualified Data.Text as T
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.Time.Clock (UTCTime)
|
||||
import Data.Typeable (Typeable)
|
||||
import Data.Word (Word16)
|
||||
import Database.SQLite.Simple (ResultError (..), SQLData (..))
|
||||
import Database.SQLite.Simple.FromField (FromField (..), returnError)
|
||||
import Database.SQLite.Simple.Internal (Field (..))
|
||||
@@ -53,6 +54,58 @@ import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextFie
|
||||
import Simplex.Messaging.Protocol (ProtoServerWithAuth, ProtocolTypeI)
|
||||
import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>))
|
||||
import Simplex.Messaging.Version
|
||||
import Simplex.Messaging.Version.Internal
|
||||
|
||||
-- TODO PQ replace with actual instances
|
||||
instance Eq (ConnectionRequestUri m) where _ == _ = True
|
||||
|
||||
instance Eq (APartyCmdTag p) where
|
||||
t1 == t2 = case (t1, t2) of
|
||||
(APCT SAEConn NEW_, APCT SAEConn NEW_) -> True
|
||||
(APCT SAEConn INV_, APCT SAEConn INV_) -> True
|
||||
(APCT SAEConn JOIN_, APCT SAEConn JOIN_) -> True
|
||||
(APCT SAEConn CONF_, APCT SAEConn CONF_) -> True
|
||||
(APCT SAEConn LET_, APCT SAEConn LET_) -> True
|
||||
(APCT SAEConn REQ_, APCT SAEConn REQ_) -> True
|
||||
(APCT SAEConn ACPT_, APCT SAEConn ACPT_) -> True
|
||||
(APCT SAEConn RJCT_, APCT SAEConn RJCT_) -> True
|
||||
(APCT SAEConn INFO_, APCT SAEConn INFO_) -> True
|
||||
(APCT SAEConn CON_, APCT SAEConn CON_) -> True
|
||||
(APCT SAEConn SUB_, APCT SAEConn SUB_) -> True
|
||||
(APCT SAEConn END_, APCT SAEConn END_) -> True
|
||||
(APCT SAENone CONNECT_, APCT SAENone CONNECT_) -> True
|
||||
(APCT SAENone DISCONNECT_, APCT SAENone DISCONNECT_) -> True
|
||||
(APCT SAENone DOWN_, APCT SAENone DOWN_) -> True
|
||||
(APCT SAENone UP_, APCT SAENone UP_) -> True
|
||||
(APCT SAEConn SWITCH_, APCT SAEConn SWITCH_) -> True
|
||||
(APCT SAEConn RSYNC_, APCT SAEConn RSYNC_) -> True
|
||||
(APCT SAEConn SEND_, APCT SAEConn SEND_) -> True
|
||||
(APCT SAEConn MID_, APCT SAEConn MID_) -> True
|
||||
(APCT SAEConn SENT_, APCT SAEConn SENT_) -> True
|
||||
(APCT SAEConn MERR_, APCT SAEConn MERR_) -> True
|
||||
(APCT SAEConn MERRS_, APCT SAEConn MERRS_) -> True
|
||||
(APCT SAEConn MSG_, APCT SAEConn MSG_) -> True
|
||||
(APCT SAEConn MSGNTF_, APCT SAEConn MSGNTF_) -> True
|
||||
(APCT SAEConn ACK_, APCT SAEConn ACK_) -> True
|
||||
(APCT SAEConn RCVD_, APCT SAEConn RCVD_) -> True
|
||||
(APCT SAEConn SWCH_, APCT SAEConn SWCH_) -> True
|
||||
(APCT SAEConn OFF_, APCT SAEConn OFF_) -> True
|
||||
(APCT SAEConn DEL_, APCT SAEConn DEL_) -> True
|
||||
(APCT SAEConn DEL_RCVQ_, APCT SAEConn DEL_RCVQ_) -> True
|
||||
(APCT SAEConn DEL_CONN_, APCT SAEConn DEL_CONN_) -> True
|
||||
(APCT SAENone DEL_USER_, APCT SAENone DEL_USER_) -> True
|
||||
(APCT SAEConn CHK_, APCT SAEConn CHK_) -> True
|
||||
(APCT SAEConn STAT_, APCT SAEConn STAT_) -> True
|
||||
(APCT SAEConn OK_, APCT SAEConn OK_) -> True
|
||||
(APCT SAEConn ERR_, APCT SAEConn ERR_) -> True
|
||||
(APCT SAENone SUSPENDED_, APCT SAENone SUSPENDED_) -> True
|
||||
(APCT SAERcvFile RFDONE_, APCT SAERcvFile RFDONE_) -> True
|
||||
(APCT SAERcvFile RFPROG_, APCT SAERcvFile RFPROG_) -> True
|
||||
(APCT SAERcvFile RFERR_, APCT SAERcvFile RFERR_) -> True
|
||||
(APCT SAESndFile SFPROG_, APCT SAESndFile SFPROG_) -> True
|
||||
(APCT SAESndFile SFDONE_, APCT SAESndFile SFDONE_) -> True
|
||||
(APCT SAESndFile SFERR_, APCT SAESndFile SFERR_) -> True
|
||||
_ -> False
|
||||
|
||||
class IsContact a where
|
||||
contactId' :: a -> ContactId
|
||||
@@ -212,9 +265,7 @@ contactSecurityCode :: Contact -> Maybe SecurityCode
|
||||
contactSecurityCode Contact {activeConn} = connectionCode =<< activeConn
|
||||
|
||||
contactPQEnabled :: Contact -> Bool
|
||||
contactPQEnabled Contact {activeConn} = case activeConn of
|
||||
Just Connection {pqEnabled} -> pqEnabled == Just True
|
||||
Nothing -> False
|
||||
contactPQEnabled Contact {activeConn} = maybe False connPQEnabled activeConn
|
||||
|
||||
data ContactStatus
|
||||
= CSActive
|
||||
@@ -706,7 +757,7 @@ memberConn GroupMember {activeConn} = activeConn
|
||||
memberConnId :: GroupMember -> Maybe ConnId
|
||||
memberConnId GroupMember {activeConn} = aConnId <$> activeConn
|
||||
|
||||
memberChatVRange' :: GroupMember -> VersionRange
|
||||
memberChatVRange' :: GroupMember -> VersionRangeChat
|
||||
memberChatVRange' GroupMember {activeConn, memberChatVRange} =
|
||||
fromJVersionRange $ case activeConn of
|
||||
Just Connection {peerChatVRange} -> peerChatVRange
|
||||
@@ -1302,7 +1353,9 @@ data Connection = Connection
|
||||
localAlias :: Text,
|
||||
entityId :: Maybe Int64, -- contact, group member, file ID or user contact ID
|
||||
connectionCode :: Maybe SecurityCode,
|
||||
pqEnabled :: Maybe PQFlag,
|
||||
enablePQ :: PQFlag,
|
||||
pqSndEnabled :: Maybe PQFlag,
|
||||
pqRcvEnabled :: Maybe PQFlag,
|
||||
authErrCounter :: Int,
|
||||
createdAt :: UTCTime
|
||||
}
|
||||
@@ -1337,6 +1390,10 @@ aConnId Connection {agentConnId = AgentConnId cId} = cId
|
||||
connIncognito :: Connection -> Bool
|
||||
connIncognito Connection {customUserProfileId} = isJust customUserProfileId
|
||||
|
||||
connPQEnabled :: Connection -> Bool
|
||||
connPQEnabled Connection {pqSndEnabled, pqRcvEnabled} =
|
||||
pqSndEnabled == Just True && pqRcvEnabled == Just True
|
||||
|
||||
data PendingContactConnection = PendingContactConnection
|
||||
{ pccConnId :: Int64,
|
||||
pccAgentConnId :: AgentConnId,
|
||||
@@ -1625,10 +1682,24 @@ data ServerCfg p = ServerCfg
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
newtype ChatVersionRange = ChatVersionRange {fromChatVRange :: VersionRange} deriving (Eq, Show)
|
||||
data ChatVersion
|
||||
|
||||
chatInitialVRange :: VersionRange
|
||||
chatInitialVRange = versionToRange 1
|
||||
instance VersionScope ChatVersion
|
||||
|
||||
type VersionChat = Version ChatVersion
|
||||
|
||||
type VersionRangeChat = VersionRange ChatVersion
|
||||
|
||||
pattern VersionChat :: Word16 -> VersionChat
|
||||
pattern VersionChat v = Version v
|
||||
|
||||
newtype ChatVersionRange = ChatVersionRange {fromChatVRange :: VersionRangeChat} deriving (Eq, Show)
|
||||
|
||||
initialChatVersion :: VersionChat
|
||||
initialChatVersion = VersionChat 1
|
||||
|
||||
chatInitialVRange :: VersionRangeChat
|
||||
chatInitialVRange = versionToRange initialChatVersion
|
||||
|
||||
instance FromJSON ChatVersionRange where
|
||||
parseJSON v = ChatVersionRange <$> strParseJSON "ChatVersionRange" v
|
||||
@@ -1637,7 +1708,7 @@ instance ToJSON ChatVersionRange where
|
||||
toJSON (ChatVersionRange vr) = strToJSON vr
|
||||
toEncoding (ChatVersionRange vr) = strToJEncoding vr
|
||||
|
||||
newtype JVersionRange = JVersionRange {fromJVersionRange :: VersionRange} deriving (Eq, Show)
|
||||
newtype JVersionRange = JVersionRange {fromJVersionRange :: VersionRangeChat} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON JVersionRange where
|
||||
parseJSON = J.withObject "JVersionRange" $ \o -> do
|
||||
|
||||
@@ -49,7 +49,7 @@ import Simplex.Chat.Store (AutoAccept (..), StoreError (..), UserContactLink (..
|
||||
import Simplex.Chat.Styled
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Preferences
|
||||
import qualified Simplex.FileTransfer.Protocol as XFTP
|
||||
import qualified Simplex.FileTransfer.Transport as XFTPTransport
|
||||
import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), SubscriptionsInfo (..))
|
||||
import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..))
|
||||
import Simplex.Messaging.Agent.Protocol
|
||||
@@ -1134,7 +1134,7 @@ viewServerTestResult (AProtoServerWithAuth p _) = \case
|
||||
Just ProtocolTestFailure {testStep, testError} ->
|
||||
result
|
||||
<> [pName <> " server requires authorization to create queues, check password" | testStep == TSCreateQueue && testError == SMP SMP.AUTH]
|
||||
<> [pName <> " server requires authorization to upload files, check password" | testStep == TSCreateFile && testError == XFTP XFTP.AUTH]
|
||||
<> [pName <> " server requires authorization to upload files, check password" | testStep == TSCreateFile && testError == XFTP XFTPTransport.AUTH]
|
||||
<> ["Possibly, certificate fingerprint in " <> pName <> " server address is incorrect" | testStep == TSConnect && brokerErr]
|
||||
where
|
||||
result = [pName <> " server test failed at " <> plain (drop 2 $ show testStep) <> ", error: " <> plain (strEncode testError)]
|
||||
|
||||
Reference in New Issue
Block a user