mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-24 23:55:50 +00:00
core (pq): further integrate agent api (#3874)
* core (pq): further integrate agent api * update both pq support and ecnryption * update * fix * corrections * corrections 2 * corrections 3
This commit is contained in:
spaced4ndy
@@ -1834,7 +1834,7 @@ func processReceivedMsg(_ res: ChatResponse) async {
|
||||
case let .contactPQEnabled(user, contact, _):
|
||||
if active(user) {
|
||||
await MainActor.run {
|
||||
m.updateContact(contact) // or updateContactConnectionStats?
|
||||
m.updateContact(contact)
|
||||
}
|
||||
}
|
||||
default:
|
||||
|
||||
+1
-1
@@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/simplex-chat/simplexmq.git
|
||||
tag: 11288866f90bafb0892701b0e0679eddb030b5df
|
||||
tag: 5e23fa6cfc60c5efd561f9131a9528b9ccb9782d
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
{
|
||||
"https://github.com/simplex-chat/simplexmq.git"."00ae2cb6e134e3cd7c8089e30f95a9430d3c4e3d" = "1dvghlsrf0dw8g279gnb4m2s7jrj9bwdibcq61hkkb9h5975f93d";
|
||||
"https://github.com/simplex-chat/simplexmq.git"."5e23fa6cfc60c5efd561f9131a9528b9ccb9782d" = "1h2cxnyn2z2qscny7gsz0zpvmnpn1h668ic4za36l43swddwwb7s";
|
||||
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
|
||||
"https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
|
||||
"https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";
|
||||
|
||||
+68
-55
@@ -604,11 +604,11 @@ processChatCommand' vr = \case
|
||||
Just conn@Connection {connId, pqEncryption} -> case pqEncryption of
|
||||
PQEncOn -> pure $ chatCmdError (Just user) "already allowed"
|
||||
PQEncOff -> do
|
||||
-- TODO PQ add / change database field(s)
|
||||
withStore' $ \db -> allowConnEnablePQ db connId
|
||||
let conn' = conn {pqSupport = PQSupportOn, pqEncryption = PQEncOn} :: Connection
|
||||
ct' = ct {activeConn = Just conn'} :: Contact
|
||||
pure $ CRContactPQAllowed user ct'
|
||||
-- TODO PQ add / change database field(s)
|
||||
withStore' $ \db -> updateConnSupportPQ db connId PQSupportOn
|
||||
let conn' = conn {pqSupport = PQSupportOn, pqEncryption = PQEncOn} :: Connection
|
||||
ct' = ct {activeConn = Just conn'} :: Contact
|
||||
pure $ CRContactPQAllowed user ct'
|
||||
Nothing -> throwChatError $ CEContactNotActive ct
|
||||
APIExportArchive cfg -> checkChatStopped $ exportArchive cfg >> ok_
|
||||
ExportArchive -> do
|
||||
@@ -1431,15 +1431,13 @@ processChatCommand' vr = \case
|
||||
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
|
||||
let profileToSend = userProfileToSend user incognitoProfile Nothing False
|
||||
pqSup <- chatReadVar pqExperimentalEnabled
|
||||
-- TODO PQ connRequestPQSupport
|
||||
-- connRequestPQSupport :: AgentMonad' m => PQSupport -> ConnectionRequestUri c -> m (Maybe PQSupport)
|
||||
-- connRequestPQSupport pqSup cReq
|
||||
-- or if you know support of another side alread (e.g. in REQ) use:
|
||||
-- pqSupportAnd :: PQSupport -> PQSupport -> PQSupport
|
||||
dm <- encodeConnInfoPQ pqSup $ XInfo profileToSend
|
||||
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm pqSup subMode
|
||||
conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined (incognitoProfile $> profileToSend) subMode pqSup
|
||||
pure $ CRSentConfirmation user conn
|
||||
withAgent' (\a -> connRequestPQSupport a pqSup cReq) >>= \case
|
||||
Nothing -> throwChatError CEInvalidConnReq
|
||||
Just pqSup' -> do
|
||||
dm <- encodeConnInfoPQ pqSup' $ XInfo profileToSend
|
||||
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm pqSup' subMode
|
||||
conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined (incognitoProfile $> profileToSend) subMode pqSup'
|
||||
pure $ CRSentConfirmation user conn
|
||||
APIConnect userId incognito (Just (ACR SCMContact cReq)) -> withUserId userId $ \user -> connectViaContact user incognito cReq
|
||||
APIConnect _ _ Nothing -> throwChatError CEInvalidConnReq
|
||||
Connect incognito aCReqUri@(Just cReqUri) -> withUser $ \user@User {userId} -> do
|
||||
@@ -2166,32 +2164,36 @@ processChatCommand' vr = \case
|
||||
where
|
||||
connect' groupLinkId cReqHash xContactId inGroup = do
|
||||
pqSup <- if inGroup then pure PQSupportOff else chatReadVar pqExperimentalEnabled
|
||||
(connId, incognitoProfile, subMode) <- requestContact user incognito cReq xContactId inGroup pqSup
|
||||
conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode pqSup
|
||||
(connId, incognitoProfile, subMode, pqSup') <- requestContact user incognito cReq xContactId inGroup pqSup
|
||||
conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode pqSup'
|
||||
pure $ CRSentInvitation user conn incognitoProfile
|
||||
connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> ConnectionRequestUri 'CMContact -> m ChatResponse
|
||||
connectContactViaAddress user incognito ct cReq =
|
||||
withChatLock "connectViaContact" $ do
|
||||
newXContactId <- XContactId <$> drgRandomBytes 16
|
||||
pqSup <- chatReadVar pqExperimentalEnabled
|
||||
(connId, incognitoProfile, subMode) <- requestContact user incognito cReq newXContactId False pqSup
|
||||
(connId, incognitoProfile, subMode, pqSup') <- requestContact user incognito cReq newXContactId False pqSup
|
||||
let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
|
||||
ct' <- withStore $ \db -> createAddressContactConnection db user ct connId cReqHash newXContactId incognitoProfile subMode pqSup
|
||||
ct' <- withStore $ \db -> createAddressContactConnection db user ct connId cReqHash newXContactId incognitoProfile subMode pqSup'
|
||||
pure $ CRSentInvitationToContact user ct' incognitoProfile
|
||||
requestContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> XContactId -> Bool -> PQSupport -> m (ConnId, Maybe Profile, SubscriptionMode)
|
||||
requestContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> XContactId -> Bool -> PQSupport -> m (ConnId, Maybe Profile, SubscriptionMode, PQSupport)
|
||||
requestContact user incognito cReq xContactId inGroup pqSup = do
|
||||
-- [incognito] generate profile to send
|
||||
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
|
||||
let profileToSend = userProfileToSend user incognitoProfile Nothing inGroup
|
||||
-- TODO PQ connecting via address
|
||||
-- 0) toggle disabled - PQSupportOff
|
||||
-- 1) toggle enabled, address supports PQ (connRequestPQSupport returns Just True) - PQSupportOn, enable support with compression
|
||||
-- 2) toggle enabled, address doesn't support PQ - PQSupportOn but without compression, with version range indicating support
|
||||
-- see joinContactInitialKeys: PQSupportOn -> IKUsePQ - I will change to IKNoPQ PQSupportOn
|
||||
dm <- encodeConnInfoPQ pqSup (XContact profileToSend $ Just xContactId)
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm pqSup subMode
|
||||
pure (connId, incognitoProfile, subMode)
|
||||
withAgent' (\a -> connRequestPQSupport a pqSup cReq) >>= \case
|
||||
Nothing -> throwChatError CEInvalidConnReq
|
||||
Just pqCompress -> do
|
||||
let (pqSup', pqCompress') = case pqSup of
|
||||
PQSupportOff -> (PQSupportOff, PQSupportOff)
|
||||
PQSupportOn -> (PQSupportOn, pqCompress)
|
||||
dm <- encodeConnInfoPQ pqCompress' (XContact profileToSend $ Just xContactId)
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm pqSup' subMode
|
||||
pure (connId, incognitoProfile, subMode, pqSup')
|
||||
contactMember :: Contact -> [GroupMember] -> Maybe GroupMember
|
||||
contactMember Contact {contactId} =
|
||||
find $ \GroupMember {memberContactId = cId, memberStatus = s} ->
|
||||
@@ -2883,14 +2885,14 @@ getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of
|
||||
getTmpHandle fPath = openFile fPath AppendMode `catchThrow` (ChatError . CEFileInternal . show)
|
||||
|
||||
acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> Bool -> m Contact
|
||||
acceptContactRequest user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = cp, userContactLinkId, xContactId} incognitoProfile contactUsed = do
|
||||
acceptContactRequest user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = cp, userContactLinkId, xContactId, pqSupport} incognitoProfile contactUsed = do
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
let profileToSend = profileToSendOnAccept user incognitoProfile False
|
||||
pqSup <- chatReadVar pqExperimentalEnabled
|
||||
-- TODO combine pqSup with pqSupport from UserContactRequest
|
||||
dm <- encodeConnInfoPQ pqSup $ XInfo profileToSend
|
||||
acId <- withAgent $ \a -> acceptContact a True invId dm pqSup subMode
|
||||
withStore' $ \db -> createAcceptedContact db user acId (fromJVersionRange cReqChatVRange) cName profileId cp userContactLinkId xContactId incognitoProfile subMode pqSup contactUsed
|
||||
let pqSup' = pqSup `CR.pqSupportAnd` pqSupport
|
||||
dm <- encodeConnInfoPQ pqSup' $ XInfo profileToSend
|
||||
acId <- withAgent $ \a -> acceptContact a True invId dm pqSup' subMode
|
||||
withStore' $ \db -> createAcceptedContact db user acId (fromJVersionRange cReqChatVRange) cName profileId cp userContactLinkId xContactId incognitoProfile subMode pqSup' contactUsed
|
||||
|
||||
acceptContactRequestAsync :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> Bool -> PQSupport -> m Contact
|
||||
acceptContactRequestAsync user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile contactUsed pqSup = do
|
||||
@@ -2924,7 +2926,7 @@ acceptGroupJoinRequestAsync
|
||||
groupSize = Just currentMemCount
|
||||
}
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
connIds <- agentAcceptContactAsync user True invId msg subMode (PQSupport False)
|
||||
connIds <- agentAcceptContactAsync user True invId msg subMode PQSupportOff
|
||||
withStore $ \db -> do
|
||||
liftIO $ createAcceptedMemberConnection db user connIds ucr groupMemberId subMode
|
||||
getGroupMemberById db user groupMemberId
|
||||
@@ -3510,20 +3512,33 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
CON _ -> Just ConnReady
|
||||
_ -> Nothing
|
||||
|
||||
processCONFpqSupport :: Connection -> PQSupport -> m Connection
|
||||
processCONFpqSupport conn@Connection {connId, pqSupport = pq} pq'
|
||||
| pq == PQSupportOn && pq' == PQSupportOff = do
|
||||
withStore' $ \db -> updateConnSupportPQ db connId pq'
|
||||
pure (conn {pqSupport = pq', pqEncryption = CR.pqSupportToEnc pq'} :: Connection)
|
||||
| pq /= pq' = do
|
||||
messageWarning "processCONFpqSupport: unexpected pqSupport change"
|
||||
pure conn
|
||||
| otherwise = pure conn
|
||||
|
||||
processINFOpqSupport :: Connection -> PQSupport -> m ()
|
||||
processINFOpqSupport Connection {pqSupport = pq} pq' =
|
||||
when (pq /= pq') $ messageWarning "processINFOpqSupport: unexpected pqSupport change"
|
||||
|
||||
processDirectMessage :: ACommand 'Agent e -> ConnectionEntity -> Connection -> Maybe Contact -> m ()
|
||||
processDirectMessage agentMsg connEntity conn@Connection {connId, peerChatVRange, viaUserContactLink, customUserProfileId, connectionCode} = \case
|
||||
Nothing -> case agentMsg of
|
||||
-- TODO PQ if connection was created with PQSupportOn and CONF has PQSupportOff, then disable it in connection (store in DB, update connection object, pass PQSupportOff)
|
||||
-- if the opposite, ignore or log warning
|
||||
CONF confId pqSupport _ connInfo -> do
|
||||
conn' <- processCONFpqSupport conn pqSupport
|
||||
-- [incognito] send saved profile
|
||||
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId)
|
||||
let profileToSend = userProfileToSend user (fromLocalProfile <$> incognitoProfile) Nothing False
|
||||
conn' <- saveConnInfo conn connInfo
|
||||
conn'' <- saveConnInfo conn' connInfo
|
||||
-- [async agent commands] no continuation needed, but command should be asynchronous for stability
|
||||
allowAgentConnectionAsync user conn' confId $ XInfo profileToSend
|
||||
-- TODO PQ if connection has pqSupport different from pqSupport in INFO log warning, ignore
|
||||
allowAgentConnectionAsync user conn'' confId $ XInfo profileToSend
|
||||
INFO pqSupport connInfo -> do
|
||||
processINFOpqSupport conn pqSupport
|
||||
_conn' <- saveConnInfo conn connInfo
|
||||
pure ()
|
||||
MSG meta _msgFlags msgBody -> do
|
||||
@@ -3601,27 +3616,27 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
RCVD msgMeta msgRcpt ->
|
||||
withAckMessage' agentConnId conn msgMeta $
|
||||
directMsgReceived ct conn msgMeta msgRcpt
|
||||
-- TODO PQ this will happen with members and with contact cards - same as above
|
||||
CONF confId pqSupport _ connInfo -> do
|
||||
ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo
|
||||
conn' <- updatePeerChatVRange conn chatVRange
|
||||
conn' <- processCONFpqSupport conn pqSupport
|
||||
ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn' connInfo
|
||||
conn'' <- updatePeerChatVRange conn' chatVRange
|
||||
case chatMsgEvent of
|
||||
-- confirming direct connection with a member
|
||||
XGrpMemInfo _memId _memProfile -> do
|
||||
-- TODO check member ID
|
||||
-- TODO update member profile
|
||||
-- [async agent commands] no continuation needed, but command should be asynchronous for stability
|
||||
allowAgentConnectionAsync user conn' confId XOk
|
||||
allowAgentConnectionAsync user conn'' confId XOk
|
||||
XInfo profile -> do
|
||||
ct' <- processContactProfileUpdate ct profile False `catchChatError` const (pure ct)
|
||||
-- [incognito] send incognito profile
|
||||
incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId
|
||||
let p = userProfileToSend user (fromLocalProfile <$> incognitoProfile) (Just ct') False
|
||||
allowAgentConnectionAsync user conn' confId $ XInfo p
|
||||
allowAgentConnectionAsync user conn'' confId $ XInfo p
|
||||
void $ withStore' $ \db -> resetMemberContactFields db ct'
|
||||
_ -> messageError "CONF for existing contact must have x.grp.mem.info or x.info"
|
||||
INFO pqSupport connInfo -> do
|
||||
-- TODO PQ log warning same above
|
||||
processINFOpqSupport conn pqSupport
|
||||
ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo
|
||||
_conn' <- updatePeerChatVRange conn chatVRange
|
||||
case chatMsgEvent of
|
||||
@@ -4276,11 +4291,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
processUserContactRequest :: ACommand 'Agent e -> ConnectionEntity -> Connection -> UserContact -> m ()
|
||||
processUserContactRequest agentMsg connEntity conn UserContact {userContactLinkId} = case agentMsg of
|
||||
REQ invId pqSupport _ connInfo -> do
|
||||
-- TODO PQ this pqSupport needs to be combined with user's choice in toggle, then enable PQ support
|
||||
ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo
|
||||
case chatMsgEvent of
|
||||
XContact p xContactId_ -> profileContactRequest invId chatVRange p xContactId_
|
||||
XInfo p -> profileContactRequest invId chatVRange p Nothing
|
||||
XContact p xContactId_ -> profileContactRequest invId chatVRange p xContactId_ pqSupport
|
||||
XInfo p -> profileContactRequest invId chatVRange p Nothing pqSupport
|
||||
-- TODO show/log error, other events in contact request
|
||||
_ -> pure ()
|
||||
MERR _ err -> do
|
||||
@@ -4292,9 +4306,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
-- TODO add debugging output
|
||||
_ -> pure ()
|
||||
where
|
||||
profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> m ()
|
||||
profileContactRequest invId chatVRange p xContactId_ = do
|
||||
withStore (\db -> createOrUpdateContactRequest db user userContactLinkId invId chatVRange p xContactId_) >>= \case
|
||||
profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> m ()
|
||||
profileContactRequest invId chatVRange p xContactId_ reqPQSup = do
|
||||
withStore (\db -> createOrUpdateContactRequest db user userContactLinkId invId chatVRange p xContactId_ reqPQSup) >>= \case
|
||||
CORContact contact -> toView $ CRContactRequestAlreadyAccepted user contact
|
||||
CORRequest cReq -> do
|
||||
ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId
|
||||
@@ -4305,8 +4319,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
-- [incognito] generate profile to send, create connection with incognito profile
|
||||
incognitoProfile <- if acceptIncognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
|
||||
pqSup <- chatReadVar pqExperimentalEnabled
|
||||
-- TODO PQ combine pqSup with pqSupport in REQ
|
||||
ct <- acceptContactRequestAsync user cReq incognitoProfile True pqSup
|
||||
let pqSup' = pqSup `CR.pqSupportAnd` reqPQSup
|
||||
ct <- acceptContactRequestAsync user cReq incognitoProfile True pqSup'
|
||||
toView $ CRAcceptingContactRequest user ct
|
||||
Just groupId -> do
|
||||
gInfo <- withStore $ \db -> getGroupInfo db vr user groupId
|
||||
@@ -6124,13 +6138,12 @@ encodeConnInfoPQ pqSup chatMsgEvent = do
|
||||
r = encodeChatMessage maxConnInfoLength ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent}
|
||||
case r of
|
||||
ECMEncoded encodedBody
|
||||
| shouldCompress -> compressedBatchMsgBody encodedBody
|
||||
| shouldCompress -> liftIO $ compressedBatchMsgBody encodedBody
|
||||
| otherwise -> pure encodedBody
|
||||
ECMLarge -> throwChatError $ CEException "large message"
|
||||
where
|
||||
compressedBatchMsgBody msgBody =
|
||||
liftEitherError (ChatError . CEException . mappend "compressedBatchMsgBody: ") $
|
||||
withCompressCtx (B.length msgBody) (`compressedBatchMsgBody_` msgBody)
|
||||
withCompressCtx (toEnum $ B.length msgBody) (`compressedBatchMsgBody_` msgBody)
|
||||
|
||||
deliverMessage :: ChatMonad m => Connection -> CMEventTag e -> MsgBody -> MessageId -> m (Int64, PQEncryption)
|
||||
deliverMessage conn cmEventTag msgBody msgId = do
|
||||
@@ -6155,13 +6168,13 @@ deliverMessagesB msgReqs = do
|
||||
void $ withStoreBatch' $ \db -> map (updatePQSndEnabled db) (rights . L.toList $ sent)
|
||||
withStoreBatch $ \db -> L.map (bindRight $ createDelivery db) sent
|
||||
where
|
||||
compressBodies = liftIO $ withCompressCtx maxRawMsgLength $ \cctx ->
|
||||
compressBodies = liftIO $ withCompressCtx (toEnum maxRawMsgLength) $ \cctx ->
|
||||
forM msgReqs $ \case
|
||||
-- TODO PQ combine pqSupport and pqEncryption to one type:
|
||||
-- data PQMode = PQDisabled | PQSupported PQEncryption
|
||||
mr@(Right (conn@Connection {pqSupport, pqEncryption}, msgFlags, msgBody, msgId)) -> case pqSupport `CR.pqSupportOrEnc` pqEncryption of
|
||||
PQSupportOn ->
|
||||
bimap (ChatError . CEException) (\cBody -> (conn, msgFlags, cBody, msgId)) <$> compressedBatchMsgBody_ cctx msgBody
|
||||
Right . (\cBody -> (conn, msgFlags, cBody, msgId)) <$> compressedBatchMsgBody_ cctx msgBody
|
||||
PQSupportOff -> pure mr
|
||||
skip -> pure skip
|
||||
toAgent = \case
|
||||
|
||||
@@ -11,11 +11,15 @@ m20240228_pq =
|
||||
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;
|
||||
|
||||
ALTER TABLE contact_requests ADD COLUMN pq_support INTEGER NOT NULL DEFAULT 0;
|
||||
|]
|
||||
|
||||
down_m20240228_pq :: Query
|
||||
down_m20240228_pq =
|
||||
[sql|
|
||||
ALTER TABLE contact_requests DROP COLUMN pq_support;
|
||||
|
||||
ALTER TABLE connections DROP COLUMN enable_pq;
|
||||
ALTER TABLE connections DROP COLUMN pq_snd_enabled;
|
||||
ALTER TABLE connections DROP COLUMN pq_rcv_enabled;
|
||||
|
||||
@@ -315,6 +315,7 @@ CREATE TABLE contact_requests(
|
||||
xcontact_id BLOB,
|
||||
peer_chat_min_version INTEGER NOT NULL DEFAULT 1,
|
||||
peer_chat_max_version INTEGER NOT NULL DEFAULT 1,
|
||||
pq_support INTEGER NOT NULL DEFAULT 0,
|
||||
FOREIGN KEY(user_id, local_display_name)
|
||||
REFERENCES display_names(user_id, local_display_name)
|
||||
ON UPDATE CASCADE
|
||||
|
||||
@@ -564,8 +564,8 @@ parseChatMessages s = case B.head s of
|
||||
Left e -> [Left e]
|
||||
Right compressed -> concatMap (either (pure . Left) parseChatMessages) . L.toList $ decompressBatch maxRawMsgLength compressed
|
||||
|
||||
compressedBatchMsgBody_ :: CompressCtx -> MsgBody -> IO (Either String ByteString)
|
||||
compressedBatchMsgBody_ ctx msgBody = markCompressedBatch . smpEncode . (L.:| []) <$$> compress ctx msgBody
|
||||
compressedBatchMsgBody_ :: CompressCtx -> MsgBody -> IO ByteString
|
||||
compressedBatchMsgBody_ ctx msgBody = markCompressedBatch . smpEncode . (L.:| []) <$> compress ctx msgBody
|
||||
|
||||
markCompressedBatch :: ByteString -> ByteString
|
||||
markCompressedBatch = B.cons 'X'
|
||||
|
||||
@@ -531,8 +531,8 @@ 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 -> 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_ =
|
||||
createOrUpdateContactRequest :: DB.Connection -> User -> Int64 -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> ExceptT StoreError IO ContactOrRequest
|
||||
createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (VersionRange minV maxV) Profile {displayName, fullName, image, contactLink, preferences} xContactId_ pqSup =
|
||||
liftIO (maybeM getContact' xContactId_) >>= \case
|
||||
Just contact -> pure $ CORContact contact
|
||||
Nothing -> CORRequest <$> createOrUpdate_
|
||||
@@ -561,10 +561,13 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO contact_requests
|
||||
(user_contact_link_id, agent_invitation_id, peer_chat_min_version, peer_chat_max_version, contact_profile_id, local_display_name, user_id, created_at, updated_at, xcontact_id)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?)
|
||||
(user_contact_link_id, agent_invitation_id, peer_chat_min_version, peer_chat_max_version, contact_profile_id, local_display_name, user_id,
|
||||
created_at, updated_at, xcontact_id, pq_support)
|
||||
VALUES (?,?,?,?,?,?,?,?,?,?,?)
|
||||
|]
|
||||
(userContactLinkId, invId, minV, maxV, profileId, ldn, userId, currentTs, currentTs, xContactId_)
|
||||
( (userContactLinkId, invId, minV, maxV, profileId, ldn, userId)
|
||||
:. (currentTs, currentTs, xContactId_, pqSup)
|
||||
)
|
||||
insertedRowId db
|
||||
getContact' :: XContactId -> IO (Maybe Contact)
|
||||
getContact' xContactId =
|
||||
@@ -596,7 +599,7 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers
|
||||
[sql|
|
||||
SELECT
|
||||
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id,
|
||||
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, p.preferences, cr.created_at, cr.updated_at,
|
||||
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, cr.pq_support, p.preferences, cr.created_at, cr.updated_at,
|
||||
cr.peer_chat_min_version, cr.peer_chat_max_version
|
||||
FROM contact_requests cr
|
||||
JOIN connections c USING (user_contact_link_id)
|
||||
@@ -617,20 +620,20 @@ createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (Vers
|
||||
db
|
||||
[sql|
|
||||
UPDATE contact_requests
|
||||
SET agent_invitation_id = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, updated_at = ?
|
||||
SET agent_invitation_id = ?, pq_support = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, updated_at = ?
|
||||
WHERE user_id = ? AND contact_request_id = ?
|
||||
|]
|
||||
(invId, minV, maxV, currentTs, userId, cReqId)
|
||||
(invId, pqSup, minV, maxV, currentTs, userId, cReqId)
|
||||
else withLocalDisplayName db userId displayName $ \ldn ->
|
||||
Right <$> do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE contact_requests
|
||||
SET agent_invitation_id = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, local_display_name = ?, updated_at = ?
|
||||
SET agent_invitation_id = ?, pq_support = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, local_display_name = ?, updated_at = ?
|
||||
WHERE user_id = ? AND contact_request_id = ?
|
||||
|]
|
||||
(invId, minV, maxV, ldn, currentTs, userId, cReqId)
|
||||
(invId, pqSup, minV, maxV, ldn, currentTs, userId, cReqId)
|
||||
safeDeleteLDN db user oldLdn
|
||||
where
|
||||
updateProfile currentTs =
|
||||
@@ -665,7 +668,7 @@ getContactRequest db User {userId} contactRequestId =
|
||||
[sql|
|
||||
SELECT
|
||||
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id,
|
||||
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, p.preferences, cr.created_at, cr.updated_at,
|
||||
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, cr.pq_support, p.preferences, cr.created_at, cr.updated_at,
|
||||
cr.peer_chat_min_version, cr.peer_chat_max_version
|
||||
FROM contact_requests cr
|
||||
JOIN connections c USING (user_contact_link_id)
|
||||
|
||||
@@ -856,7 +856,7 @@ getContactRequestChatPreviews_ db User {userId} pagination clq = case clq of
|
||||
( [sql|
|
||||
SELECT
|
||||
cr.contact_request_id, cr.local_display_name, cr.agent_invitation_id, cr.user_contact_link_id,
|
||||
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, p.preferences,
|
||||
c.agent_conn_id, cr.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, cr.xcontact_id, cr.pq_support, p.preferences,
|
||||
cr.created_at, cr.updated_at as ts,
|
||||
cr.peer_chat_min_version, cr.peer_chat_max_version
|
||||
FROM contact_requests cr
|
||||
|
||||
@@ -253,16 +253,16 @@ createIncognitoProfile_ db userId createdAt Profile {displayName, fullName, imag
|
||||
(displayName, fullName, image, userId, Just True, createdAt, createdAt)
|
||||
insertedRowId db
|
||||
|
||||
allowConnEnablePQ :: DB.Connection -> Int64 -> IO ()
|
||||
allowConnEnablePQ db connId =
|
||||
updateConnSupportPQ :: DB.Connection -> Int64 -> PQSupport -> IO ()
|
||||
updateConnSupportPQ db connId pqSup =
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
UPDATE connections
|
||||
SET enable_pq = 1
|
||||
SET enable_pq = ?
|
||||
WHERE connection_id = ?
|
||||
|]
|
||||
(Only connId)
|
||||
(pqSup, connId)
|
||||
|
||||
-- TODO PQ possibly combine all functions
|
||||
updateConnPQSndEnabled :: DB.Connection -> Int64 -> PQEncryption -> IO ()
|
||||
@@ -396,13 +396,13 @@ getProfileById db userId profileId =
|
||||
toProfile :: (ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Preferences) -> LocalProfile
|
||||
toProfile (displayName, fullName, image, contactLink, localAlias, preferences) = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias}
|
||||
|
||||
type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact) :. (Maybe XContactId, Maybe Preferences, UTCTime, UTCTime, VersionChat, VersionChat)
|
||||
type ContactRequestRow = (Int64, ContactName, AgentInvId, Int64, AgentConnId, Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact) :. (Maybe XContactId, PQSupport, Maybe Preferences, UTCTime, UTCTime, VersionChat, VersionChat)
|
||||
|
||||
toContactRequest :: ContactRequestRow -> UserContactRequest
|
||||
toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image, contactLink) :. (xContactId, preferences, createdAt, updatedAt, minVer, maxVer)) = do
|
||||
toContactRequest ((contactRequestId, localDisplayName, agentInvitationId, userContactLinkId, agentContactConnId, profileId, displayName, fullName, image, contactLink) :. (xContactId, pqSupport, preferences, createdAt, updatedAt, minVer, maxVer)) = do
|
||||
let profile = Profile {displayName, fullName, image, contactLink, preferences}
|
||||
cReqChatVRange = JVersionRange $ fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer
|
||||
in UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, cReqChatVRange, localDisplayName, profileId, profile, xContactId, createdAt, updatedAt}
|
||||
in UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, cReqChatVRange, localDisplayName, profileId, profile, xContactId, pqSupport, createdAt, updatedAt}
|
||||
|
||||
userQuery :: Query
|
||||
userQuery =
|
||||
|
||||
@@ -335,9 +335,8 @@ data UserContactRequest = UserContactRequest
|
||||
profile :: Profile,
|
||||
createdAt :: UTCTime,
|
||||
updatedAt :: UTCTime,
|
||||
xContactId :: Maybe XContactId
|
||||
-- TODO PQ save pqSupport from REQ to database
|
||||
-- pqSupport :: PQSupport
|
||||
xContactId :: Maybe XContactId,
|
||||
pqSupport :: PQSupport
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user