Merge remote-tracking branch 'origin/master' into ab/debug-subs

This commit is contained in:
IC Rainbow
2024-05-06 13:34:41 +03:00
60 changed files with 1118 additions and 369 deletions
+24 -13
View File
@@ -1500,8 +1500,9 @@ processChatCommand' vr = \case
Just (agentV, pqSup') -> do
let chatV = agentToChatVersion agentV
dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm pqSup' subMode
connId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup'
conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined (incognitoProfile $> profileToSend) subMode chatV pqSup'
void . withAgent $ \a -> joinConnection a (aUserId user) (Just connId) True cReq dm pqSup' subMode
pure $ CRSentConfirmation user conn
APIConnect userId incognito (Just (ACR SCMContact cReq)) -> withUserId userId $ \user -> connectViaContact user incognito cReq
APIConnect _ _ Nothing -> throwChatError CEInvalidConnReq
@@ -1754,12 +1755,13 @@ processChatCommand' vr = \case
Just Connection {peerChatVRange} -> do
subMode <- chatReadVar subscriptionMode
dm <- encodeConnInfo $ XGrpAcpt membershipMemId
agentConnId <- withAgent $ \a -> joinConnection a (aUserId user) True connRequest dm PQSupportOff subMode
agentConnId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True connRequest PQSupportOff
let chatV = vr `peerConnChatVersion` peerChatVRange
withStore' $ \db -> do
createMemberConnection db userId fromMember agentConnId chatV peerChatVRange subMode
updateGroupMemberStatus db userId fromMember GSMemAccepted
updateGroupMemberStatus db userId membership GSMemAccepted
void . withAgent $ \a -> joinConnection a (aUserId user) (Just agentConnId) True connRequest dm PQSupportOff subMode
updateCIGroupInvitationStatus user g CIGISAccepted `catchChatError` \_ -> pure ()
pure $ CRUserAcceptedGroupSent user g {membership = membership {memberStatus = GSMemAccepted}} Nothing
Nothing -> throwChatError $ CEContactNotActive ct
@@ -2337,23 +2339,28 @@ processChatCommand' vr = \case
where
connect' groupLinkId cReqHash xContactId inGroup = do
let pqSup = if inGroup then PQSupportOff else PQSupportOn
(connId, incognitoProfile, subMode, chatV) <- requestContact user incognito cReq xContactId inGroup pqSup
(connId, chatV) <- prepareContact user cReq pqSup
-- [incognito] generate profile to send
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
subMode <- chatReadVar subscriptionMode
conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode chatV pqSup
joinContact user connId cReq incognitoProfile xContactId inGroup pqSup chatV
pure $ CRSentInvitation user conn incognitoProfile
connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> ConnectionRequestUri 'CMContact -> CM ChatResponse
connectContactViaAddress user incognito ct cReq =
withInvitationLock "connectContactViaAddress" (strEncode cReq) $ do
newXContactId <- XContactId <$> drgRandomBytes 16
let pqSup = PQSupportOn
(connId, incognitoProfile, subMode, chatV) <- requestContact user incognito cReq newXContactId False pqSup
(connId, chatV) <- prepareContact user cReq pqSup
let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
-- [incognito] generate profile to send
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
subMode <- chatReadVar subscriptionMode
ct' <- withStore $ \db -> createAddressContactConnection db vr user ct connId cReqHash newXContactId incognitoProfile subMode chatV pqSup
joinContact user connId cReq incognitoProfile newXContactId False pqSup chatV
pure $ CRSentInvitationToContact user ct' incognitoProfile
requestContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> XContactId -> Bool -> PQSupport -> CM (ConnId, Maybe Profile, SubscriptionMode, VersionChat)
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
prepareContact :: User -> ConnectionRequestUri 'CMContact -> PQSupport -> CM (ConnId, VersionChat)
prepareContact user cReq pqSup = do
-- 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
@@ -2361,10 +2368,14 @@ processChatCommand' vr = \case
Nothing -> throwChatError CEInvalidConnReq
Just (agentV, _) -> do
let chatV = agentToChatVersion agentV
dm <- encodeConnInfoPQ pqSup chatV (XContact profileToSend $ Just xContactId)
subMode <- chatReadVar subscriptionMode
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm pqSup subMode
pure (connId, incognitoProfile, subMode, chatV)
connId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup
pure (connId, chatV)
joinContact :: User -> ConnId -> ConnectionRequestUri 'CMContact -> Maybe Profile -> XContactId -> Bool -> PQSupport -> VersionChat -> CM ()
joinContact user connId cReq incognitoProfile xContactId inGroup pqSup chatV = do
let profileToSend = userProfileToSend user incognitoProfile Nothing inGroup
dm <- encodeConnInfoPQ pqSup chatV (XContact profileToSend $ Just xContactId)
subMode <- chatReadVar subscriptionMode
void . withAgent $ \a -> joinConnection a (aUserId user) (Just connId) True cReq dm pqSup subMode
contactMember :: Contact -> [GroupMember] -> Maybe GroupMember
contactMember Contact {contactId} =
find $ \GroupMember {memberContactId = cId, memberStatus = s} ->