mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-10-23 12:53:18 +00:00
core: support contact addresses with DR keys, service requests (#7310)
* core: use double ratchet keys in contact address (#7278) * core: use double ratchet keys in contact address * use PQ from the first message * query plans * update simplexmq * api to rotate keys, option to show full links in CLI * shorter description * ui: add error parameters * disable DR in addresses * core: parameter for create address command to configure ratchet keys * add pqRatchet param to address-related commands * query plan * fix parser * fix kotlin --------- Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com> * core: contact request rejection and service requests (#7292) * update simplexmq * implement service requests and rejections * tests * migration * fix migration * add api event and response * bot api, postgres migration * nix shas * bot types, rename property * update bot type * sign service requests * update bots api * query plan * update plan * update simplexmq * fix test, update bot api * fix bot api * resolve name for service request * refactor --------- Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com> * update simplexmq * update simplexmq * test delays --------- Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
This commit is contained in:
EvgenyandEvgeny @ SimpleX Chat authored and GitHub committed
1 parent
61012d208e
commit
e1a349b90f
55 files changed
+1229
-248
No files matched your search
@@ -102,12 +102,12 @@ import Simplex.Messaging.Agent.Store.Interface (execSQL)
|
||||
import Simplex.Messaging.Agent.Store.Shared (upMigration)
|
||||
import qualified Simplex.Messaging.Agent.Store.DB as DB
|
||||
import Simplex.Messaging.Agent.Store.Interface (getCurrentMigrations)
|
||||
import Simplex.Messaging.Client (NetworkConfig (..), NetworkRequestMode (..), NetworkTimeout (..), SMPWebPortServers (..), SocksMode (SMAlways), textToHostMode)
|
||||
import Simplex.Messaging.Client (NetworkConfig (..), NetworkRequestMode (..), NetworkTimeout (..), SMPWebPortServers (..), SocksMode (SMAlways), pattern NRMInteractive, textToHostMode)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import qualified Simplex.Messaging.Crypto.ShortLink as SL
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
|
||||
import qualified Simplex.Messaging.Crypto.File as CF
|
||||
import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern IKPQOn, pattern PQSupportOff, pattern PQSupportOn)
|
||||
import Simplex.Messaging.Crypto.Ratchet (E2ERatchetParamsUri (..), InitialKeys (..), PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern IKPQOn, pattern PQSupportOff, pattern PQSupportOn)
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (base64P)
|
||||
@@ -216,9 +216,10 @@ videoFilePrefix :: String
|
||||
videoFilePrefix = "video_"
|
||||
|
||||
-- enableSndFiles has no effect when mainApp is True
|
||||
startChatController :: Bool -> Bool -> CM' (Async ())
|
||||
startChatController mainApp enableSndFiles = do
|
||||
startChatController :: Bool -> Bool -> Bool -> CM' (Async ())
|
||||
startChatController mainApp enableSndFiles serviceRequests = do
|
||||
asks smpAgent >>= liftIO . resumeAgentClient
|
||||
chatWriteVar' processServiceRequests serviceRequests
|
||||
unless mainApp $ chatWriteVar' subscriptionMode SMOnlyCreate
|
||||
users <- fromRight [] <$> runExceptT (withFastStore' getUsers)
|
||||
runExceptT (syncConnections' users) >>= \case
|
||||
@@ -548,10 +549,10 @@ processChatCommand cxt nm = \case
|
||||
checkDeleteChatUser user'
|
||||
withChatLock "deleteUser" $ deleteChatUser user' delSMPQueues
|
||||
DeleteUser uName delSMPQueues viewPwd_ -> withUserName uName $ \userId -> APIDeleteUser userId delSMPQueues viewPwd_
|
||||
StartChat {mainApp, enableSndFiles} -> withUser' $ \_ ->
|
||||
StartChat {mainApp, enableSndFiles, serviceRequests} -> withUser' $ \_ ->
|
||||
asks agentAsync >>= readTVarIO >>= \case
|
||||
Just _ -> pure CRChatRunning
|
||||
_ -> checkStoreNotChanged . lift $ startChatController mainApp enableSndFiles $> CRChatStarted
|
||||
_ -> checkStoreNotChanged . lift $ startChatController mainApp enableSndFiles serviceRequests $> CRChatStarted
|
||||
CheckChatRunning -> maybe CRChatStopped (const CRChatRunning) <$> chatReadVar agentAsync
|
||||
APIStopChat -> do
|
||||
ask >>= liftIO . stopChatController
|
||||
@@ -1429,24 +1430,49 @@ processChatCommand cxt nm = \case
|
||||
(msg, _) <- sendDirectContactMessage user ct $ XMsgNew $ mcSimple mc
|
||||
ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc)
|
||||
toView $ CEvtNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct) ci]
|
||||
APIRejectContact connReqId -> withUser $ \user -> do
|
||||
APIRejectContact connReqId notify -> withUser $ \user -> do
|
||||
uclId_ <- withFastStore $ \db -> getUserContactLinkIdByCReq db connReqId
|
||||
withContactRequestLock "rejectContact" connReqId $ case uclId_ of
|
||||
Nothing -> rejectCReq user -- address was deleted
|
||||
Just uclId -> withUserContactLock "rejectContact" uclId $ rejectCReq user
|
||||
where
|
||||
rejectCReq user = do
|
||||
(cReq@UserContactRequest {agentInvitationId = AgentInvId invId}, ct_) <-
|
||||
cReq@UserContactRequest {agentInvitationId = AgentInvId invId, contactId_} <-
|
||||
withFastStore $ \db -> getContactRequest db user connReqId
|
||||
withAgent $ \a -> rejectContact a NRMInteractive (aUserId user) invId (if notify then Just (strEncode CRRUserRejected) else Nothing)
|
||||
ct_ <-
|
||||
withFastStore $ \db -> do
|
||||
cReq@UserContactRequest {contactId_} <- getContactRequest db user connReqId
|
||||
ct_ <- forM contactId_ $ \contactId -> do
|
||||
ct <- getContact db cxt user contactId
|
||||
deleteContact db user ct
|
||||
pure ct
|
||||
liftIO $ deleteContactRequest db user connReqId
|
||||
pure (cReq, ct_)
|
||||
withAgent (`rejectContact` invId)
|
||||
pure ct_
|
||||
pure $ CRContactRequestRejected user cReq ct_
|
||||
APISendServiceRequest userId sendTarget requestTimeout signKey request -> withUserId userId $ \user -> do
|
||||
cReq <- resolveServiceTarget user sendTarget
|
||||
respData <- withAgent $ \a -> sendServiceRequestAsync a (aUserId user) cReq requestTimeout (C.unStored <$> signKey) (LB.toStrict $ J.encode request)
|
||||
resp <- either (const $ throwCmdError "invalid service response") pure $ J.eitherDecodeStrict' respData
|
||||
pure $ CRServiceResponse user resp
|
||||
where
|
||||
resolveServiceTarget user = \case
|
||||
CTFullContact cReq -> pure cReq
|
||||
CTShortContact (CTLink sLnk) -> resolveShortLink sLnk
|
||||
CTShortContact (CTName SimplexNameInfo {nameType, nameDomain}) -> case nameType of
|
||||
NTContact -> resolveDomain nameDomain
|
||||
_ -> throwCmdError "service request target must be a contact"
|
||||
CTDomain d -> resolveDomain d
|
||||
where
|
||||
resolveDomain d = do
|
||||
nr <- withAgent $ \a -> resolveSimplexName a nm (aUserId user) d
|
||||
case firstNameLink CCTContact (nrSimplexContact nr) of
|
||||
Just sLnk -> resolveShortLink sLnk
|
||||
Nothing -> throwChatError $ CESimplexDomainNotReady d SDENoValidLink
|
||||
resolveShortLink sLnk = (\(_, _, cReq) -> cReq) <$> getShortLinkConnReq nm user sLnk
|
||||
APISendServiceResponse userId requestId responseData -> withUserId userId $ \user -> do
|
||||
let AgentInvId invId = requestId
|
||||
connId <- withAgent $ \a -> sendServiceReplyAsync a "" (aUserId user) invId (LB.toStrict $ J.encode responseData)
|
||||
pure $ CRServiceReplyAccepted user (AgentConnId connId)
|
||||
APISendCallInvitation contactId callType -> withUser $ \user -> do
|
||||
-- party initiating call
|
||||
ct <- withFastStore $ \db -> getContact db cxt user contactId
|
||||
@@ -1658,7 +1684,7 @@ processChatCommand cxt nm = \case
|
||||
r <- tryAllErrors $ getShortLinkConnReq nm user address
|
||||
case r of
|
||||
Left e -> failAt RTSGetLink e
|
||||
Right (FixedLinkData {rootKey, linkConnReq = cReq}, cData) -> do
|
||||
Right (FixedLinkData {rootKey}, cData, cReq) -> do
|
||||
relayProfile_ <- liftIO $ decodeLinkUserData cData
|
||||
case relayProfile_ of
|
||||
Nothing -> failAt RTSDecodeLink (ChatError $ CERelayTestError "no relay address link data")
|
||||
@@ -1903,7 +1929,7 @@ processChatCommand cxt nm = \case
|
||||
gInfo@GroupInfo {groupProfile = p} <- withFastStore $ \db -> getGroupInfo db cxt user groupId
|
||||
case p of
|
||||
GroupProfile {publicGroup = Just PublicGroupProfile {groupLink = sLnk}} | useRelays' gInfo -> do
|
||||
(_, cData@(ContactLinkData _ UserContactData {relays = currentRelayLinks})) <- getShortLinkConnReq' nm user sLnk
|
||||
(_, cData@(ContactLinkData _ UserContactData {relays = currentRelayLinks}), _) <- getShortLinkConnReq' nm user sLnk
|
||||
groupSLinkData_ <- liftIO $ decodeLinkUserData cData
|
||||
gInfo' <- case groupSLinkData_ of
|
||||
Just sLinkData -> fst <$> updateGroupFromLinkData user gInfo sLinkData Nothing
|
||||
@@ -2071,7 +2097,7 @@ processChatCommand cxt nm = \case
|
||||
linkProfile <- presentUserBadge user incognitoProfile $ userProfileDirect user incognitoProfile Nothing True
|
||||
let userData = contactShortLinkData linkProfile {contactDomain = Nothing} Nothing
|
||||
userLinkData = UserInvLinkData userData
|
||||
(connId, ccLink) <- withAgent $ \a -> createConnection a nm (aUserId user) True False SCMInvitation (Just userLinkData) Nothing IKPQOn subMode
|
||||
(connId, ccLink) <- withAgent $ \a -> createConnection a nm (aUserId user) True False SCMInvitation (Just userLinkData) Nothing IKUsePQ True subMode
|
||||
ccLink' <- shortenCreatedLink ccLink
|
||||
-- TODO PQ pass minVersion from the current range
|
||||
conn <- withFastStore' $ \db -> createDirectConnection db user connId ccLink' Nothing ConnNew incognitoProfile subMode initialChatVersion PQSupportOn
|
||||
@@ -2113,7 +2139,7 @@ processChatCommand cxt nm = \case
|
||||
if short
|
||||
then Just . UserInvLinkData . (`contactShortLinkData` Nothing) <$> presentUserBadge newUser Nothing (userProfileDirect newUser Nothing Nothing True)
|
||||
else pure Nothing
|
||||
(agConnId, ccLink) <- withAgent $ \a -> createConnection a nm (aUserId newUser) True False SCMInvitation userLinkData_ Nothing IKPQOn subMode
|
||||
(agConnId, ccLink) <- withAgent $ \a -> createConnection a nm (aUserId newUser) True False SCMInvitation userLinkData_ Nothing IKPQOn True subMode
|
||||
ccLink' <- shortenCreatedLink ccLink
|
||||
conn' <- withFastStore' $ \db -> do
|
||||
deleteConnectionRecord db user connId
|
||||
@@ -2249,7 +2275,7 @@ processChatCommand cxt nm = \case
|
||||
sLnk <- case connShortLink' connLinkToConnect of
|
||||
Just sl -> pure sl
|
||||
Nothing -> throwChatError $ CEException "failed to retrieve relays: no short link"
|
||||
(FixedLinkData {linkConnReq = mainCReq@(CRContactUri crData), linkEntityId, rootKey}, cData@(ContactLinkData _ UserContactData {owners, relays})) <- getShortLinkConnReq nm user sLnk
|
||||
(FixedLinkData {linkEntityId, rootKey}, cData@(ContactLinkData _ UserContactData {owners, relays}), mainCReq@(CRContactUri crData e2e)) <- getShortLinkConnReq nm user sLnk
|
||||
groupSLinkData_ <- liftIO $ decodeLinkUserData cData
|
||||
-- Validate link entity ID matches group profile's publicGroupId (relay groups must have both)
|
||||
case groupSLinkData_ of
|
||||
@@ -2261,7 +2287,7 @@ processChatCommand cxt nm = \case
|
||||
-- Prepare group record once before connecting to relays (updatePreparedRelayedGroup):
|
||||
-- set group link info and incognito profile, generate and store membership keys
|
||||
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
|
||||
let cReqHash = contactCReqHash $ CRContactUri crData {crScheme = SSSimplex}
|
||||
let cReqHash = contactCReqHash $ CRContactUri crData {crScheme = SSSimplex} e2e
|
||||
gVar <- asks random
|
||||
(_, memberPrivKey) <- liftIO $ atomically $ C.generateKeyPair gVar
|
||||
gInfo' <- withFastStore $ \db -> do
|
||||
@@ -2381,7 +2407,7 @@ processChatCommand cxt nm = \case
|
||||
ccLink <- case contactLink of
|
||||
Just (CLFull cReq) -> pure $ CCLink cReq Nothing
|
||||
Just (CLShort sLnk) -> do
|
||||
(FixedLinkData {linkConnReq = cReq}, _cData) <- getShortLinkConnReq nm user sLnk
|
||||
(_, _, cReq) <- getShortLinkConnReq nm user sLnk
|
||||
pure $ CCLink cReq $ Just sLnk
|
||||
Nothing -> throwCmdError "no address in contact profile"
|
||||
connectContactViaAddress user incognito ct ccLink `catchAllErrors` \e -> do
|
||||
@@ -2399,7 +2425,7 @@ processChatCommand cxt nm = \case
|
||||
CRContactsList user <$> withFastStore' (\db -> getUserContacts db cxt user)
|
||||
ListContacts -> withUser $ \User {userId} ->
|
||||
processChatCommand cxt nm $ APIListContacts userId
|
||||
APICreateMyAddress userId server_ -> withUserId userId $ \user@User {userChatRelay} -> do
|
||||
APICreateMyAddress userId server_ pqRatchet_ -> withUserId userId $ \user@User {userChatRelay} -> do
|
||||
withFastStore' (\db -> runExceptT $ getUserAddress db user) >>= \case
|
||||
Left SEUserContactLinkNotFound -> pure ()
|
||||
Left e -> throwError $ ChatErrorStore e
|
||||
@@ -2408,20 +2434,25 @@ processChatCommand cxt nm = \case
|
||||
gVar <- asks random
|
||||
rootKey@(rootPubKey, rootPrivKey) <- liftIO $ atomically $ C.generateKeyPair gVar
|
||||
let entityId = C.sha256Hash $ C.pubKeyBytes rootPubKey
|
||||
(ccLink, preparedParams) <- withAgent $ \a -> prepareConnectionLink a (aUserId user) rootKey entityId True Nothing server_
|
||||
-- TODO [address DR] remove this option and switch to IKUsePQ True
|
||||
let (pqInitKeys, useDR) = case pqRatchet_ of
|
||||
Just True -> (IKUsePQ, True)
|
||||
Just False -> (IKPQOn, True)
|
||||
Nothing -> (IKPQOn, False)
|
||||
(ccLink, preparedParams) <- withAgent $ \a -> prepareConnectionLink a (aUserId user) rootKey entityId True Nothing pqInitKeys useDR server_
|
||||
ccLink' <- shortenCreatedLink ccLink
|
||||
-- TODO [relays] relay: add identity, key to link data?
|
||||
userData <-
|
||||
if isTrue userChatRelay
|
||||
then pure $ relayShortLinkData (userProfileDirect user Nothing Nothing True)
|
||||
else (`contactShortLinkData` Nothing) <$> presentUserBadge user Nothing (userProfileDirect user Nothing Nothing True)
|
||||
let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData}
|
||||
connId <- withAgent $ \a -> createConnectionForLink a nm (aUserId user) True ccLink preparedParams userLinkData IKPQOn subMode
|
||||
let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
|
||||
connId <- withAgent $ \a -> createConnectionForLink a nm (aUserId user) True ccLink preparedParams userLinkData subMode
|
||||
let ccLink'' = if isTrue userChatRelay then setShortLinkType CCTRelay ccLink' else ccLink'
|
||||
withFastStore $ \db -> createUserContactLink db user connId ccLink'' subMode rootPrivKey
|
||||
pure $ CRUserContactLinkCreated user ccLink''
|
||||
CreateMyAddress -> withUser $ \User {userId} ->
|
||||
processChatCommand cxt nm $ APICreateMyAddress userId Nothing
|
||||
CreateMyAddress ratchetKeys_ -> withUser $ \User {userId} ->
|
||||
processChatCommand cxt nm $ APICreateMyAddress userId Nothing ratchetKeys_
|
||||
APIDeleteMyAddress userId -> withUserId userId $ \user@User {profile = p} -> do
|
||||
conn <- withFastStore $ \db -> getUserAddressConnection db cxt user
|
||||
withChatLock "deleteMyAddress" $ do
|
||||
@@ -2439,8 +2470,12 @@ processChatCommand cxt nm = \case
|
||||
CRUserContactLink user <$> withFastStore (`getUserAddress` user)
|
||||
ShowMyAddress -> withUser' $ \User {userId} ->
|
||||
processChatCommand cxt nm $ APIShowMyAddress userId
|
||||
APIAddMyAddressShortLink userId -> withUserId' userId $ \user ->
|
||||
CRUserContactLink user <$> (withFastStore (`getUserAddress` user) >>= setMyAddressData user)
|
||||
APIAddMyAddressShortLink userId pqRatchet_ -> withUserId' userId $ \user -> do
|
||||
-- TODO [address DR] remove the option, and use IKUsePQ
|
||||
let pqInitKeys = (\case True -> IKUsePQ; False -> IKPQOn) <$> pqRatchet_
|
||||
CRUserContactLink user <$> (withFastStore (`getUserAddress` user) >>= setMyAddressData False pqInitKeys user)
|
||||
APIRotateAddressRatchetKeys userId -> withUserId' userId $ \user ->
|
||||
CRUserContactLink user <$> (withFastStore (`getUserAddress` user) >>= setMyAddressData True (Just IKUsePQ) user)
|
||||
APISetProfileAddress userId False -> withUserId userId $ \user@User {profile = p} -> do
|
||||
let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing}
|
||||
updateProfile_ user p' True $ withFastStore' $ \db -> setUserProfileContactLink db user Nothing
|
||||
@@ -2451,7 +2486,7 @@ processChatCommand cxt nm = \case
|
||||
updateProfile_ user p' True $ withFastStore' $ \db -> setUserProfileContactLink db user $ Just ucl
|
||||
SetProfileAddress onOff -> withUser $ \User {userId} ->
|
||||
processChatCommand cxt nm $ APISetProfileAddress userId onOff
|
||||
APISetAddressSettings userId settings@AddressSettings {businessAddress, autoAccept} -> withUserId userId $ \user -> do
|
||||
APISetAddressSettings userId pqRatchet_ settings@AddressSettings {businessAddress, autoAccept} -> withUserId userId $ \user -> do
|
||||
ucl@UserContactLink {userContactLinkId, shortLinkDataSet, addressSettings} <- withFastStore (`getUserAddress` user)
|
||||
forM_ autoAccept $ \AutoAccept {acceptIncognito} -> do
|
||||
when (shortLinkDataSet && acceptIncognito) $ throwCmdError "incognito not allowed for address with short link data"
|
||||
@@ -2460,17 +2495,18 @@ processChatCommand cxt nm = \case
|
||||
then pure $ CRUserContactLinkUpdated user ucl
|
||||
else do
|
||||
let ucl' = ucl {addressSettings = settings}
|
||||
ucl'' <- if shortLinkDataSet then setMyAddressData user ucl' else pure ucl'
|
||||
pqInitKeys = (\case True -> IKUsePQ; False -> IKPQOn) <$> pqRatchet_
|
||||
ucl'' <- if shortLinkDataSet then setMyAddressData False pqInitKeys user ucl' else pure ucl'
|
||||
withFastStore' $ \db -> updateUserAddressSettings db userContactLinkId settings
|
||||
pure $ CRUserContactLinkUpdated user ucl''
|
||||
SetAddressSettings settings -> withUser $ \User {userId} ->
|
||||
processChatCommand cxt nm $ APISetAddressSettings userId settings
|
||||
SetAddressSettings pqRatchet_ settings -> withUser $ \User {userId} ->
|
||||
processChatCommand cxt nm $ APISetAddressSettings userId pqRatchet_ settings
|
||||
AcceptContact incognito cName -> withUser $ \User {userId} -> do
|
||||
connReqId <- withFastStore $ \db -> getContactRequestIdByName db userId cName
|
||||
processChatCommand cxt nm $ APIAcceptContact incognito connReqId
|
||||
RejectContact cName -> withUser $ \User {userId} -> do
|
||||
RejectContact cName notify -> withUser $ \User {userId} -> do
|
||||
connReqId <- withFastStore $ \db -> getContactRequestIdByName db userId cName
|
||||
processChatCommand cxt nm $ APIRejectContact connReqId
|
||||
processChatCommand cxt nm $ APIRejectContact connReqId notify
|
||||
ForwardMessage toChatName fromContactName forwardedMsg -> withUser $ \user -> do
|
||||
contactId <- withFastStore $ \db -> getContactIdByName db user fromContactName
|
||||
forwardedItemId <- withFastStore $ \db -> getDirectChatItemIdByText' db user contactId forwardedMsg
|
||||
@@ -2679,7 +2715,7 @@ processChatCommand cxt nm = \case
|
||||
let entityId = C.sha256Hash $ C.pubKeyBytes rootPubKey
|
||||
crClientData = encodeJSON $ CRDataGroup groupLinkId
|
||||
-- prepare link with entityId as linkEntityId (no server request)
|
||||
(ccLink, preparedParams) <- withAgent $ \a -> prepareConnectionLink a (aUserId user) rootKey entityId True (Just crClientData) Nothing
|
||||
(ccLink, preparedParams) <- withAgent $ \a -> prepareConnectionLink a (aUserId user) rootKey entityId True (Just crClientData) IKPQOff False Nothing
|
||||
ccLink' <- setShortLinkType CCTChannel <$> shortenCreatedLink ccLink
|
||||
sLnk <- case connShortLink' ccLink' of
|
||||
Just sl -> pure sl
|
||||
@@ -2690,9 +2726,9 @@ processChatCommand cxt nm = \case
|
||||
-- TODO [channel web] pass publicGroupAccess from owner's profile
|
||||
let groupProfile' = (groupProfile :: GroupProfile) {publicGroup = Just PublicGroupProfile {groupType = GTChannel, groupLink = sLnk, publicGroupId = B64UrlByteString entityId, publicGroupAccess = Nothing}}
|
||||
userData = encodeShortLinkData $ GroupShortLinkData {groupProfile = groupProfile', publicGroupData = Just (PublicGroupData 1)}
|
||||
userLinkData = UserContactLinkData UserContactData {direct = False, owners = [ownerAuth], relays = [], userData}
|
||||
userLinkData = UserContactLinkData UserContactData {direct = False, owners = [ownerAuth], relays = [], userData, ratchetKeys = Nothing}
|
||||
-- create connection with prepared link (single network call)
|
||||
connId <- withAgent $ \a -> createConnectionForLink a nm (aUserId user) True ccLink preparedParams userLinkData IKPQOff subMode
|
||||
connId <- withAgent $ \a -> createConnectionForLink a nm (aUserId user) True ccLink preparedParams userLinkData subMode
|
||||
let groupKeys = GroupKeys {publicGroupId = B64UrlByteString entityId, groupRootKey = GRKPrivate rootPrivKey, memberPrivKey}
|
||||
setupLink gInfo = do
|
||||
-- TODO [relays] starting role should be communicated in protocol from owner to relays
|
||||
@@ -2758,7 +2794,7 @@ processChatCommand cxt nm = \case
|
||||
Nothing -> do
|
||||
gVar <- asks random
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
(agentConnId, CCLink cReq _) <- withAgent $ \a -> createConnection a nm (aUserId user) True False SCMInvitation Nothing Nothing IKPQOff subMode
|
||||
(agentConnId, CCLink cReq _) <- withAgent $ \a -> createConnection a nm (aUserId user) True False SCMInvitation Nothing Nothing IKPQOff True subMode
|
||||
member <- withFastStore $ \db -> createNewContactMember db gVar user gInfo contact memRole agentConnId cReq subMode
|
||||
sendInvitation member cReq
|
||||
pure $ CRSentGroupInvitation user gInfo contact member
|
||||
@@ -3245,9 +3281,9 @@ processChatCommand cxt nm = \case
|
||||
groupLinkId <- GroupLinkId <$> drgRandomBytes 16
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
let userData = encodeShortLinkData $ GroupShortLinkData {groupProfile, publicGroupData = Nothing}
|
||||
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData}
|
||||
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
|
||||
crClientData = encodeJSON $ CRDataGroup groupLinkId
|
||||
(connId, ccLink) <- withAgent $ \a -> createConnection a nm (aUserId user) True True SCMContact (Just userLinkData) (Just crClientData) IKPQOff subMode
|
||||
(connId, ccLink) <- withAgent $ \a -> createConnection a nm (aUserId user) True True SCMContact (Just userLinkData) (Just crClientData) IKPQOff False subMode
|
||||
ccLink' <- setShortLinkType CCTGroup <$> shortenCreatedLink ccLink
|
||||
gVar <- asks random
|
||||
gLink <- withFastStore $ \db -> createGroupLink db gVar user gInfo connId ccLink' groupLinkId mRole subMode
|
||||
@@ -3287,7 +3323,7 @@ processChatCommand cxt nm = \case
|
||||
when (isJust $ memberContactId m) $ throwCmdError "member contact already exists"
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
-- TODO PQ should negotitate contact connection with PQSupportOn?
|
||||
(connId, CCLink cReq _) <- withAgent $ \a -> createConnection a nm (aUserId user) True False SCMInvitation Nothing Nothing IKPQOff subMode
|
||||
(connId, CCLink cReq _) <- withAgent $ \a -> createConnection a nm (aUserId user) True False SCMInvitation Nothing Nothing IKPQOff True subMode
|
||||
-- [incognito] reuse membership incognito profile
|
||||
ct <- withFastStore' $ \db -> createMemberContact db user connId cReq g m mConn subMode
|
||||
void $ createChatItem user (CDDirectSnd ct) False CIChatBanner Nothing Nothing (Just epochStart)
|
||||
@@ -3757,7 +3793,7 @@ processChatCommand cxt nm = \case
|
||||
CRInvitationUri crData {crScheme = simplexChat} e2e
|
||||
)
|
||||
connectViaContact :: User -> Maybe PreparedChatEntity -> IncognitoEnabled -> CreatedLinkContact -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> CM ConnectViaContactResult
|
||||
connectViaContact user@User {userId} preparedEntity_ incognito (CCLink cReq@(CRContactUri crData@ConnReqUriData {crClientData}) sLnk) welcomeSharedMsgId msg_ = withInvitationLock "connectViaContact" (strEncode cReq) $ do
|
||||
connectViaContact user@User {userId} preparedEntity_ incognito (CCLink cReq@(CRContactUri crData@ConnReqUriData {crClientData} e2e) sLnk) welcomeSharedMsgId msg_ = withInvitationLock "connectViaContact" (strEncode cReq) $ do
|
||||
let groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli
|
||||
-- groupLinkId is Nothing for business chats
|
||||
when (isJust msg_ && isJust groupLinkId) $ throwChatError CEConnReqMessageProhibited
|
||||
@@ -3789,8 +3825,8 @@ processChatCommand cxt nm = \case
|
||||
Just Connection {xContactId} -> connect' groupLinkId xContactId (groupLinkId $> Nothing)
|
||||
Nothing -> connect' groupLinkId Nothing (groupLinkId $> Nothing)
|
||||
where
|
||||
cReqHash1 = contactCReqHash $ CRContactUri crData {crScheme = SSSimplex}
|
||||
cReqHash2 = contactCReqHash $ CRContactUri crData {crScheme = simplexChat}
|
||||
cReqHash1 = contactCReqHash $ CRContactUri crData {crScheme = SSSimplex} e2e
|
||||
cReqHash2 = contactCReqHash $ CRContactUri crData {crScheme = simplexChat} e2e
|
||||
-- relay-group joins (only via connectToRelay) carry the target relay member in preparedEntity_;
|
||||
-- its memberId binds the join signature so a sibling relay can't replay it
|
||||
relayMemberId_ = case preparedEntity_ of
|
||||
@@ -3830,7 +3866,7 @@ processChatCommand cxt nm = \case
|
||||
-- [incognito] generate profile to send
|
||||
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
|
||||
let cReqHash = contactCReqHash cReq
|
||||
conn <- withFastStore' $ \db -> createConnReqConnection db userId connId (Just $ PCEContact ct) cReq cReqHash shortLink newXContactId (NewIncognito <$> incognitoProfile) Nothing subMode chatV pqSup
|
||||
void $ joinContact user conn cReq incognitoProfile newXContactId Nothing Nothing Nothing Nothing pqSup
|
||||
ct' <- withStore $ \db -> getContact db cxt user contactId
|
||||
@@ -3851,15 +3887,14 @@ processChatCommand cxt nm = \case
|
||||
-- Save relayLink to re-use relay member record on retry (check by relayLink)
|
||||
relayMember <- withFastStore $ \db -> getCreateRelayForMember db cxt gVar user gInfo relayLink
|
||||
r <- tryAllErrors $ do
|
||||
(fd@FixedLinkData {rootKey = relayKey, linkEntityId}, cData) <- getShortLinkConnReq nm user relayLink
|
||||
(FixedLinkData {rootKey = relayKey, linkEntityId}, cData, cReq) <- getShortLinkConnReq nm user relayLink
|
||||
relayLinkData_ <- liftIO $ decodeLinkUserData cData
|
||||
relayMemberId <- case (relayLinkData_, linkEntityId) of
|
||||
(Just RelayShortLinkData {relayProfile = p}, Just entityId) -> do
|
||||
withFastStore $ \db -> updateRelayMemberData db cxt user relayMember (MemberId entityId) (MemberKey relayKey) p
|
||||
pure $ MemberId entityId
|
||||
_ -> throwChatError $ CEException "relay link: no relay link data or entity id"
|
||||
let cReq = linkConnReq fd
|
||||
relayLinkToConnect = CCLink cReq (Just relayLink)
|
||||
let relayLinkToConnect = CCLink cReq (Just relayLink)
|
||||
void $ connectViaContact user (Just $ PCEGroup gInfo (relayMember {memberId = relayMemberId})) (incognitoMembership gInfo) relayLinkToConnect Nothing Nothing
|
||||
relayMember' <- withFastStore $ \db -> getGroupMember db cxt user (groupId' gInfo) (groupMemberId' relayMember)
|
||||
pure (relayLink, relayMember', r)
|
||||
@@ -3943,8 +3978,10 @@ processChatCommand cxt nm = \case
|
||||
setMyAddressData' :: User -> CM ()
|
||||
setMyAddressData' user' =
|
||||
withFastStore' (\db -> runExceptT $ getUserAddress db user) >>= \case
|
||||
Right ucl@UserContactLink {shortLinkDataSet}
|
||||
| shortLinkDataSet -> void $ setMyAddressData user' ucl
|
||||
Right ucl@UserContactLink {shortLinkDataSet, connLinkContact = CCLink {connFullLink = CRContactUri _ e2e}}
|
||||
| shortLinkDataSet ->
|
||||
let pqInitKeys = (\(_, E2ERatchetParamsUri _ _ _ pq) -> if isJust pq then IKUsePQ else IKPQOn) <$> e2e
|
||||
in void $ setMyAddressData False pqInitKeys user' ucl
|
||||
_ -> pure ()
|
||||
sendUpdateToContacts :: User -> [Contact] -> CM UserProfileUpdateSummary
|
||||
sendUpdateToContacts user' contacts = do
|
||||
@@ -3985,16 +4022,17 @@ processChatCommand cxt nm = \case
|
||||
ctMsgReq ChangedProfileContact {conn} =
|
||||
fmap $ \SndMessage {msgId, msgBody} ->
|
||||
(conn, MsgFlags {notification = hasNotification XInfo_}, (vrValue msgBody, [msgId]))
|
||||
setMyAddressData :: User -> UserContactLink -> CM UserContactLink
|
||||
setMyAddressData user@User {userChatRelay} ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink _, addressSettings} = do
|
||||
setMyAddressData :: Bool -> Maybe InitialKeys -> User -> UserContactLink -> CM UserContactLink
|
||||
setMyAddressData rotateKeys pqInitKeys user@User {userChatRelay} ucl@UserContactLink {userContactLinkId, connLinkContact = CCLink connFullLink _, addressSettings} = do
|
||||
conn <- withFastStore $ \db -> getUserAddressConnection db cxt user
|
||||
shortLinkProfile <- presentUserBadge user Nothing (userProfileDirect user Nothing Nothing True)
|
||||
-- TODO [short links] do not save address to server if data did not change, spinners, error handling
|
||||
let userData
|
||||
| isTrue userChatRelay = relayShortLinkData shortLinkProfile
|
||||
| otherwise = contactShortLinkData shortLinkProfile $ Just addressSettings
|
||||
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData}
|
||||
sLnk <- shortenShortLink' =<< withAgent (\a -> setConnShortLink a nm (aConnId conn) SCMContact userLinkData Nothing)
|
||||
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
|
||||
-- TODO [address DR] remove parameter and switch to (Just IKUsePQ) after rotateKeys
|
||||
sLnk <- shortenShortLink' =<< withAgent (\a -> setConnShortLink a nm (aConnId conn) SCMContact userLinkData Nothing rotateKeys pqInitKeys)
|
||||
withFastStore' $ \db -> setUserContactLinkShortLink db userContactLinkId sLnk
|
||||
let autoAccept' = (\aa -> aa {acceptIncognito = False}) <$> autoAccept addressSettings
|
||||
ucl' = (ucl :: UserContactLink) {connLinkContact = CCLink connFullLink (Just sLnk), shortLinkDataSet = True, shortLinkLargeDataSet = BoolDef True, addressSettings = addressSettings {autoAccept = autoAccept'}}
|
||||
@@ -4212,7 +4250,7 @@ processChatCommand cxt nm = \case
|
||||
where
|
||||
addRelay :: UserChatRelay -> CM (UserChatRelay, Either ChatError GroupRelay)
|
||||
addRelay relay@UserChatRelay {address} = fmap (relay,) . tryAllErrors $ do
|
||||
(FixedLinkData {linkConnReq = cReq}, _cData) <- getShortLinkConnReq nm user address
|
||||
(_, _, cReq) <- getShortLinkConnReq nm user address
|
||||
lift (withAgent' $ \a -> connRequestPQSupport a PQSupportOff cReq) >>= \case
|
||||
Nothing -> throwChatError CEInvalidConnReq
|
||||
Just _ -> do
|
||||
@@ -4311,7 +4349,7 @@ processChatCommand cxt nm = \case
|
||||
knownLinkPlans l' >>= \case
|
||||
Just (createdLink, p) -> pure (createdLink, Nothing, Nothing, p)
|
||||
Nothing -> do
|
||||
(FixedLinkData {linkConnReq = cReq, rootKey}, cData) <- getShortLinkConnReq nm user l'
|
||||
(FixedLinkData {rootKey}, cData, cReq) <- getShortLinkConnReq nm user l'
|
||||
contactSLinkData_ <- mapM linkDataBadge =<< liftIO (decodeLinkUserData cData)
|
||||
let ov = verifyLinkOwner rootKey [] l sig_
|
||||
invitationReqAndPlan cReq (Just l') contactSLinkData_ ov
|
||||
@@ -4365,7 +4403,7 @@ processChatCommand cxt nm = \case
|
||||
Nothing -> do
|
||||
when (resolveMode == PRMNever) $ throwChatError CENotResolvedLocally
|
||||
l' <- resolveSLink
|
||||
(FixedLinkData {linkConnReq = cReq, rootKey}, cData) <- getShortLinkConnReq nm user l'
|
||||
(FixedLinkData {rootKey}, cData, cReq) <- getShortLinkConnReq nm user l'
|
||||
contactSLinkData_ <- mapM linkDataBadge =<< liftIO (decodeLinkUserData cData)
|
||||
let linkProfile_ = (\ContactShortLinkData {profile} -> profile) <$> contactSLinkData_
|
||||
linkDomain_ = linkProfile_ >>= \Profile {contactDomain} -> claimDomain <$> contactDomain
|
||||
@@ -4425,13 +4463,13 @@ processChatCommand cxt nm = \case
|
||||
Nothing -> do
|
||||
when (resolveMode == PRMNever) $ throwChatError CENotResolvedLocally
|
||||
l' <- resolveSLink
|
||||
(fd, cData@(ContactLinkData _ UserContactData {direct, owners, relays})) <- getShortLinkConnReq' nm user l'
|
||||
(fd, cData@(ContactLinkData _ UserContactData {direct, owners, relays}), cReq) <- getShortLinkConnReq' nm user l'
|
||||
groupSLinkData_ <- liftIO $ decodeLinkUserData cData
|
||||
if
|
||||
| not direct && unsupportedGroupType groupSLinkData_ -> pure (con l' (linkConnReq fd), CPGroupLink (GLPUpdateRequired groupSLinkData_))
|
||||
| not direct && null relays -> pure (con l' (linkConnReq fd), CPGroupLink (GLPNoRelays groupSLinkData_))
|
||||
| not direct && unsupportedGroupType groupSLinkData_ -> pure (con l' cReq, CPGroupLink (GLPUpdateRequired groupSLinkData_))
|
||||
| not direct && null relays -> pure (con l' cReq, CPGroupLink (GLPNoRelays groupSLinkData_))
|
||||
| otherwise -> do
|
||||
let FixedLinkData {linkConnReq = cReq, linkEntityId, rootKey} = fd
|
||||
let FixedLinkData {linkEntityId, rootKey} = fd
|
||||
linkInfo = GroupShortLinkInfo {direct, groupRelays = relays, publicGroupId = B64UrlByteString <$> linkEntityId}
|
||||
let profilePGId = groupSLinkData_ >>= \GroupShortLinkData {groupProfile = GroupProfile {publicGroup}} ->
|
||||
fmap (\PublicGroupProfile {publicGroupId} -> publicGroupId) publicGroup
|
||||
@@ -4470,14 +4508,14 @@ processChatCommand cxt nm = \case
|
||||
Nothing -> (gPlan =<<) <$> getGroupToConnect db cxt user nl'
|
||||
resolveKnownGroup g = do
|
||||
l' <- resolveSLink
|
||||
(fd@FixedLinkData {rootKey = rk}, cData@(ContactLinkData _ UserContactData {owners})) <- getShortLinkConnReq' nm user l'
|
||||
(FixedLinkData {rootKey = rk}, cData@(ContactLinkData _ UserContactData {owners}), cReq) <- getShortLinkConnReq' nm user l'
|
||||
groupSLinkData_ <- liftIO $ decodeLinkUserData cData
|
||||
let ov = verifyLinkOwner rk owners l' sig_
|
||||
glOwners = map (\OwnerAuth {ownerId, ownerKey} -> GroupLinkOwner {memberId = MemberId ownerId, memberKey = ownerKey}) owners
|
||||
(g', updated) <- case groupSLinkData_ of
|
||||
Just sLinkData -> updateGroupFromLinkData user g sLinkData Nothing
|
||||
_ -> pure (g, False)
|
||||
pure (con l' (linkConnReq fd), CPGroupLink (GLPKnown g' updated ov (ListDef glOwners)))
|
||||
pure (con l' cReq, CPGroupLink (GLPKnown g' updated ov (ListDef glOwners)))
|
||||
-- resolve a name to its first contact/channel short link
|
||||
resolveNameLink :: SimplexNameInfo -> CM (ConnShortLink 'CMContact)
|
||||
resolveNameLink SimplexNameInfo {nameType, nameDomain} = do
|
||||
@@ -4544,15 +4582,14 @@ processChatCommand cxt nm = \case
|
||||
| otherwise -> CPInvitationLink (ILPConnecting Nothing)
|
||||
_ -> CPError $ ChatError $ CECommandError "found connection entity is not RcvDirectMsgConnection"
|
||||
contactOrGroupRequestPlan :: User -> ConnReqContact -> CM ConnectionPlan
|
||||
contactOrGroupRequestPlan user cReq@(CRContactUri crData) = do
|
||||
let ConnReqUriData {crClientData} = crData
|
||||
groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli
|
||||
contactOrGroupRequestPlan user cReq@(CRContactUri ConnReqUriData {crClientData} _) = do
|
||||
let groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli
|
||||
case groupLinkId of
|
||||
Nothing -> contactRequestPlan user cReq Nothing Nothing
|
||||
Just _ -> groupJoinRequestPlan user cReq Nothing Nothing Nothing []
|
||||
contactRequestPlan :: User -> ConnReqContact -> Maybe ContactShortLinkData -> Maybe OwnerVerification -> CM ConnectionPlan
|
||||
contactRequestPlan user (CRContactUri crData) cld ov = do
|
||||
let cReqSchemas = contactCReqSchemas crData
|
||||
contactRequestPlan user cReq cld ov = do
|
||||
let cReqSchemas = contactCReqSchemas cReq
|
||||
cReqHashes = bimap contactCReqHash contactCReqHash cReqSchemas
|
||||
plan p = pure $ CPContactAddress p
|
||||
withFastStore' (\db -> getUserContactLinkByConnReq db user cReqSchemas) >>= \case
|
||||
@@ -4574,8 +4611,8 @@ processChatCommand cxt nm = \case
|
||||
Just (RcvGroupMsgConnection _ gInfo _) -> groupPlan gInfo Nothing Nothing Nothing []
|
||||
Just _ -> throwCmdError "found connection entity is not RcvDirectMsgConnection or RcvGroupMsgConnection"
|
||||
groupJoinRequestPlan :: User -> ConnReqContact -> Maybe GroupShortLinkInfo -> Maybe GroupShortLinkData -> Maybe OwnerVerification -> [GroupLinkOwner] -> CM ConnectionPlan
|
||||
groupJoinRequestPlan user (CRContactUri crData) linkInfo gld ov glOwners = do
|
||||
let cReqSchemas = contactCReqSchemas crData
|
||||
groupJoinRequestPlan user cReq linkInfo gld ov glOwners = do
|
||||
let cReqSchemas = contactCReqSchemas cReq
|
||||
cReqHashes = bimap contactCReqHash contactCReqHash cReqSchemas
|
||||
plan p = pure $ CPGroupLink p
|
||||
withFastStore' (\db -> getGroupInfoByUserContactLinkConnReq db cxt user cReqSchemas) >>= \case
|
||||
@@ -4601,10 +4638,10 @@ processChatCommand cxt nm = \case
|
||||
| otherwise = plan $ GLPOk linkInfo gld ov
|
||||
where
|
||||
plan p = pure $ CPGroupLink p
|
||||
contactCReqSchemas :: ConnReqUriData -> (ConnReqContact, ConnReqContact)
|
||||
contactCReqSchemas crData =
|
||||
( CRContactUri crData {crScheme = SSSimplex},
|
||||
CRContactUri crData {crScheme = simplexChat}
|
||||
contactCReqSchemas :: ConnReqContact -> (ConnReqContact, ConnReqContact)
|
||||
contactCReqSchemas (CRContactUri crData e2e) =
|
||||
( CRContactUri crData {crScheme = SSSimplex} e2e,
|
||||
CRContactUri crData {crScheme = simplexChat} e2e
|
||||
)
|
||||
-- This function is needed, as UI uses simplex:/ schema in message view, so that the links can be handled without browser,
|
||||
-- and short links are stored with server hostname schema, so they wouldn't match without it.
|
||||
@@ -4655,7 +4692,7 @@ processChatCommand cxt nm = \case
|
||||
forM (connShortLink' =<< connLinkInv) $ \_ -> do
|
||||
let userData = contactShortLinkData profile Nothing
|
||||
userLinkData = UserInvLinkData userData
|
||||
shortenShortLink' =<< withAgent (\a -> setConnShortLink a nm (aConnId' conn) SCMInvitation userLinkData Nothing)
|
||||
shortenShortLink' =<< withAgent (\a -> setConnShortLink a nm (aConnId' conn) SCMInvitation userLinkData Nothing False Nothing)
|
||||
updateCIGroupInvitationStatus :: User -> GroupInfo -> CIGroupInvitationStatus -> CM ()
|
||||
updateCIGroupInvitationStatus user GroupInfo {groupId} newStatus = do
|
||||
AChatItem _ _ cInfo ChatItem {content, meta = CIMeta {itemId}} <- withFastStore $ \db -> getChatItemByGroupId db cxt user groupId
|
||||
@@ -5004,7 +5041,7 @@ verifyEntityDomain user nm nameType SimplexDomainClaim {domain = StrJSON domain,
|
||||
where
|
||||
verifyDomainProof :: SimplexDomainProof -> ShortLinkContact -> CM Bool
|
||||
verifyDomainProof SimplexDomainProof {linkOwnerId, presHeader, signature} sLnk@(CSLContact _ ct srv key) = do
|
||||
(FixedLinkData {rootKey}, ContactLinkData _ UserContactData {owners}) <- getShortLinkConnReq nm user sLnk
|
||||
(FixedLinkData {rootKey}, ContactLinkData _ UserContactData {owners}, _) <- getShortLinkConnReq nm user sLnk
|
||||
let ownerKey_ = case linkOwnerId of
|
||||
Nothing -> Just rootKey
|
||||
Just (StrJSON oid) -> ownerKey <$> find (\OwnerAuth {ownerId} -> ownerId == oid) owners
|
||||
@@ -5286,7 +5323,7 @@ runRelayGroupLinkChecks user = do
|
||||
forM_ relayGroups $ \gInfo@GroupInfo {groupProfile = gp} -> flip catchAllErrors eToView $ do
|
||||
case publicGroup gp of
|
||||
Just PublicGroupProfile {groupLink = sLnk} -> do
|
||||
(_, ContactLinkData _ UserContactData {relays = relayLinks}) <-
|
||||
(_, ContactLinkData _ UserContactData {relays = relayLinks}, _) <-
|
||||
getShortLinkConnReq' NRMBackground user sLnk
|
||||
gLink_ <- withStore' $ \db -> runExceptT $ getGroupLink db user gInfo
|
||||
case gLink_ of
|
||||
@@ -5404,8 +5441,9 @@ chatCommandP =
|
||||
"/_start " *> do
|
||||
mainApp <- "main=" *> onOffP
|
||||
enableSndFiles <- " snd_files=" *> onOffP <|> pure mainApp
|
||||
pure StartChat {mainApp, enableSndFiles},
|
||||
"/_start" $> StartChat {mainApp = True, enableSndFiles = True},
|
||||
serviceRequests <- " service_requests=" *> onOffP <|> pure False
|
||||
pure StartChat {mainApp, enableSndFiles, serviceRequests},
|
||||
"/_start" $> StartChat {mainApp = True, enableSndFiles = True, serviceRequests = False},
|
||||
"/_check running" $> CheckChatRunning,
|
||||
"/_stop" $> APIStopChat,
|
||||
"/_app activate restore=" *> (APIActivateChat <$> onOffP),
|
||||
@@ -5478,7 +5516,9 @@ chatCommandP =
|
||||
"/_delete " *> (APIDeleteChat <$> chatRefP <*> chatDeleteMode),
|
||||
"/_clear chat " *> (APIClearChat <$> chatRefP),
|
||||
"/_accept" *> (APIAcceptContact <$> incognitoOnOffP <* A.space <*> A.decimal),
|
||||
"/_reject " *> (APIRejectContact <$> A.decimal),
|
||||
"/_reject " *> (APIRejectContact <$> A.decimal <*> (" notify=" *> onOffP <|> pure False)),
|
||||
"/_service_request " *> (APISendServiceRequest <$> A.decimal <* A.space <*> strP <*> optional (" timeout=" *> (realToFrac <$> A.double)) <*> optional (" sign_key=" *> strP) <* A.space <*> jsonP),
|
||||
"/_service_response " *> (APISendServiceResponse <$> A.decimal <* A.space <*> strP <* A.space <*> jsonP),
|
||||
"/_call invite @" *> (APISendCallInvitation <$> A.decimal <* A.space <*> jsonP),
|
||||
"/call " *> char_ '@' *> (SendCallInvitation <$> displayNameP <*> pure defaultCallType),
|
||||
"/_call reject @" *> (APIRejectCall <$> A.decimal),
|
||||
@@ -5697,19 +5737,20 @@ chatCommandP =
|
||||
("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal),
|
||||
"/_connect contact " *> (APIConnectContactViaAddress <$> A.decimal <*> incognitoOnOffP <* A.space <*> A.decimal),
|
||||
"/simplex" *> (ConnectSimplex <$> incognitoP),
|
||||
"/_address " *> (APICreateMyAddress <$> A.decimal <*> optional (A.space *> strP)),
|
||||
("/address" <|> "/ad") $> CreateMyAddress,
|
||||
"/_address " *> (APICreateMyAddress <$> A.decimal <*> optional (A.space *> strP) <*> optional (" pq_ratchet=" *> onOffP)),
|
||||
("/address" <|> "/ad") *> (CreateMyAddress <$> optional (" pq_ratchet=" *> onOffP)),
|
||||
"/_delete_address " *> (APIDeleteMyAddress <$> A.decimal),
|
||||
("/delete_address" <|> "/da") $> DeleteMyAddress,
|
||||
"/_show_address " *> (APIShowMyAddress <$> A.decimal),
|
||||
("/show_address" <|> "/sa") $> ShowMyAddress,
|
||||
"/_short_link_address " *> (APIAddMyAddressShortLink <$> A.decimal),
|
||||
"/_short_link_address " *> (APIAddMyAddressShortLink <$> A.decimal <*> optional (" pq_ratchet=" *> onOffP)),
|
||||
"/_rotate_address_keys " *> (APIRotateAddressRatchetKeys <$> A.decimal),
|
||||
"/_profile_address " *> (APISetProfileAddress <$> A.decimal <* A.space <*> onOffP),
|
||||
("/profile_address " <|> "/pa ") *> (SetProfileAddress <$> onOffP),
|
||||
"/_address_settings " *> (APISetAddressSettings <$> A.decimal <* A.space <*> jsonP),
|
||||
"/auto_accept " *> (SetAddressSettings <$> autoAcceptP),
|
||||
"/_address_settings " *> (APISetAddressSettings <$> A.decimal <*> optional (" pq_ratchet=" *> onOffP) <* A.space <*> jsonP),
|
||||
"/auto_accept" *> (SetAddressSettings <$> optional (" pq_ratchet=" *> onOffP) <* A.space <*> autoAcceptP),
|
||||
("/accept" <|> "/ac") *> (AcceptContact <$> incognitoP <* A.space <* char_ '@' <*> displayNameP),
|
||||
("/reject " <|> "/rc ") *> char_ '@' *> (RejectContact <$> displayNameP),
|
||||
("/reject " <|> "/rc ") *> char_ '@' *> (RejectContact <$> displayNameP <*> (" notify" $> True <|> pure False)),
|
||||
("/markdown" <|> "/m") $> ChatHelp HSMarkdown,
|
||||
("/welcome" <|> "/w") $> Welcome,
|
||||
"/set profile image file " *> (UpdateProfileImageFromFile <$> filePath),
|
||||
|
||||
@@ -1459,7 +1459,7 @@ setGroupLinkData nm user gInfo gLink = do
|
||||
(,) <$> getGroupLinkConnection db cxt user gInfo <*> liftIO (getPublishableGroupRelays db cxt user gInfo)
|
||||
let (userLinkData, crClientData) = groupLinkData gInfo gLink groupRelays
|
||||
linkType = if useRelays' gInfo then CCTChannel else CCTGroup
|
||||
sLnk <- shortenShortLink' . setShortLinkType_ linkType =<< withAgent (\a -> setConnShortLink a nm (aConnId conn) SCMContact userLinkData (Just crClientData))
|
||||
sLnk <- shortenShortLink' . setShortLinkType_ linkType =<< withAgent (\a -> setConnShortLink a nm (aConnId conn) SCMContact userLinkData (Just crClientData) False Nothing)
|
||||
withFastStore' $ \db -> setGroupLinkShortLink db gLink sLnk
|
||||
|
||||
setGroupLinkDataAsync :: User -> GroupInfo -> GroupLink -> CM ()
|
||||
@@ -1547,28 +1547,26 @@ groupLinkData gInfo@GroupInfo {groupProfile, groupSummary = GroupSummary {public
|
||||
authOwnerSig = C.sign' rootPrivKey (ownerId <> C.encodePubKey ownerKey)
|
||||
in [OwnerAuth {ownerId, ownerKey, authOwnerSig}]
|
||||
_ -> []
|
||||
userLinkData = UserContactLinkData UserContactData {direct, owners, relays, userData}
|
||||
userLinkData = UserContactLinkData UserContactData {direct, owners, relays, userData, ratchetKeys = Nothing}
|
||||
crClientData = encodeJSON $ CRDataGroup groupLinkId
|
||||
in (userLinkData, crClientData)
|
||||
|
||||
restoreShortLink' :: ConnShortLink m -> CM (ConnShortLink m)
|
||||
restoreShortLink' l = (`restoreShortLink` l) <$> asks (shortLinkPresetServers . config)
|
||||
|
||||
getShortLinkConnReq' :: NetworkRequestMode -> User -> ConnShortLink m -> CM (FixedLinkData m, ConnLinkData m)
|
||||
getShortLinkConnReq' :: NetworkRequestMode -> User -> ConnShortLink m -> CM (FixedLinkData m, ConnLinkData m, ConnectionRequestUri m)
|
||||
getShortLinkConnReq' nm user l = do
|
||||
l' <- restoreShortLink' l
|
||||
withAgent $ \a -> getConnShortLink a nm (aUserId user) l'
|
||||
|
||||
getShortLinkConnReq :: NetworkRequestMode -> User -> ConnShortLink m -> CM (FixedLinkData m, ConnLinkData m)
|
||||
getShortLinkConnReq :: NetworkRequestMode -> User -> ConnShortLink m -> CM (FixedLinkData m, ConnLinkData m, ConnectionRequestUri m)
|
||||
getShortLinkConnReq nm user l = do
|
||||
(fd, cData) <- getShortLinkConnReq' nm user l
|
||||
r@(_, cData, _) <- getShortLinkConnReq' nm user l
|
||||
case cData of
|
||||
ContactLinkData _ UserContactData {direct, relays}
|
||||
| not supported -> throwChatError CEUnsupportedConnReq
|
||||
where
|
||||
supported = direct || not (null relays)
|
||||
| not direct && null relays -> throwChatError CEUnsupportedConnReq
|
||||
_ -> pure ()
|
||||
pure (fd, cData)
|
||||
pure r
|
||||
|
||||
encodeShortLinkData :: J.ToJSON a => a -> UserLinkData
|
||||
encodeShortLinkData d =
|
||||
@@ -2821,7 +2819,7 @@ msgContentHasLink mc ft_ = case msgContentTag mc of
|
||||
MCLink_ -> True
|
||||
_ -> maybe False hasLinks ft_
|
||||
|
||||
prepareAgentCreation :: ConnectionModeI c => User -> CommandFunction -> Bool -> SConnectionMode c -> CM (CommandId, ConnId)
|
||||
prepareAgentCreation :: User -> CommandFunction -> Bool -> SConnectionMode c -> CM (CommandId, ConnId)
|
||||
prepareAgentCreation user cmdFunction enableNtfs cMode = do
|
||||
cmdId <- withStore' $ \db -> createCommand db user Nothing cmdFunction
|
||||
connId <- withAgent $ \a -> prepareConnectionToCreate a (aUserId user) enableNtfs cMode PQSupportOff
|
||||
@@ -2835,7 +2833,7 @@ prepareAgentJoin user conn_ enableNtfs cReqUri = do
|
||||
Nothing -> withAgent $ \a -> prepareConnectionToJoin a (aUserId user) enableNtfs cReqUri PQSupportOff
|
||||
pure (cmdId, connId)
|
||||
|
||||
joinAgentConnectionAsync :: ConnectionModeI c => CommandId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> CM ()
|
||||
joinAgentConnectionAsync :: CommandId -> Bool -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> CM ()
|
||||
joinAgentConnectionAsync cmdId updateConn connId enableNtfs cReqUri cInfo subMode =
|
||||
withAgent $ \a -> joinConnectionAsync a (aCorrId cmdId) updateConn connId enableNtfs cReqUri cInfo PQSupportOff subMode
|
||||
|
||||
@@ -2939,9 +2937,11 @@ agentXFTPDeleteSndFilesRemote user sndFiles = do
|
||||
|
||||
connRequestPQEncryption :: ConnectionRequestUri c -> Maybe PQEncryption
|
||||
connRequestPQEncryption = \case
|
||||
CRContactUri _ -> Nothing
|
||||
CRInvitationUri _ (CR.E2ERatchetParamsUri vr' _ _ pq) ->
|
||||
Just $ PQEncryption $ maxVersion vr' >= CR.pqRatchetE2EEncryptVersion && isJust pq
|
||||
CRContactUri _ rks -> pqEnc . snd <$> rks
|
||||
CRInvitationUri _ e2e -> Just $ pqEnc e2e
|
||||
where
|
||||
pqEnc (CR.E2ERatchetParamsUri vr' _ _ pq) =
|
||||
PQEncryption $ maxVersion vr' >= CR.pqRatchetE2EEncryptVersion && isJust pq
|
||||
|
||||
createRcvFeatureItems :: User -> Contact -> Contact -> CM' ()
|
||||
createRcvFeatureItems user ct ct' =
|
||||
@@ -3195,7 +3195,7 @@ adminContactReq =
|
||||
either error id $ strDecode "simplex:/contact#/?v=1&smp=smp%3A%2F%2FPQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo%3D%40smp6.simplex.im%2FK1rslx-m5bpXVIdMZg9NLUZ_8JBm8xTt%23MCowBQYDK2VuAyEALDeVe-sG8mRY22LsXlPgiwTNs9dbiLrNuA7f3ZMAJ2w%3D"
|
||||
|
||||
contactCReqHash :: ConnReqContact -> ConnReqUriHash
|
||||
contactCReqHash = ConnReqUriHash . C.sha256Hash . strEncode
|
||||
contactCReqHash (CRContactUri crData _) = ConnReqUriHash . C.sha256Hash . strEncode $ CRContactUri crData Nothing
|
||||
|
||||
simplexChatImage :: ImageData
|
||||
simplexChatImage = ImageData "data:image/jpg;base64,/9j/4AAQSkZJRgABAgAAAQABAAD/2wBDAAUDBAQEAwUEBAQFBQUGBwwIBwcHBw8KCwkMEQ8SEhEPERATFhwXExQaFRARGCEYGhwdHx8fExciJCIeJBweHx7/2wBDAQUFBQcGBw4ICA4eFBEUHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh7/wAARCAETARMDASIAAhEBAxEB/8QAHwAAAQUBAQEBAQEAAAAAAAAAAAECAwQFBgcICQoL/8QAtRAAAgEDAwIEAwUFBAQAAAF9AQIDAAQRBRIhMUEGE1FhByJxFDKBkaEII0KxwRVS0fAkM2JyggkKFhcYGRolJicoKSo0NTY3ODk6Q0RFRkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqDhIWGh4iJipKTlJWWl5iZmqKjpKWmp6ipqrKztLW2t7i5usLDxMXGx8jJytLT1NXW19jZ2uHi4+Tl5ufo6erx8vP09fb3+Pn6/8QAHwEAAwEBAQEBAQEBAQAAAAAAAAECAwQFBgcICQoL/8QAtREAAgECBAQDBAcFBAQAAQJ3AAECAxEEBSExBhJBUQdhcRMiMoEIFEKRobHBCSMzUvAVYnLRChYkNOEl8RcYGRomJygpKjU2Nzg5OkNERUZHSElKU1RVVldYWVpjZGVmZ2hpanN0dXZ3eHl6goOEhYaHiImKkpOUlZaXmJmaoqOkpaanqKmqsrO0tba3uLm6wsPExcbHyMnK0tPU1dbX2Nna4uPk5ebn6Onq8vP09fb3+Pn6/9oADAMBAAIRAxEAPwD7LooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiivP/iF4yFvv0rSpAZek0yn7v+yPeunC4WpiqihBf8A8rOc5w2UYZ4jEPTourfZDvH3jL7MW03SpR53SWUfw+w96veA/F0erRLY3zKl6owD2k/8Ar15EWLEljknqadDK8MqyxMUdTlWB5Br66WS0Hh/ZLfv1ufiNLj7Mo5m8ZJ3g9OTpy+Xn5/pofRdFcd4B8XR6tEthfMEvVHyk9JB/jXY18fiMPUw9R06i1P3PK80w2aYaOIw8rxf3p9n5hRRRWB6AUUVDe3UFlavc3MixxIMsxppNuyJnOMIuUnZIL26gsrV7m5kWOJBlmNeU+I/Gd9e6sk1hI8FvA2Y1z973NVPGnimfXLoxRFo7JD8if3vc1zefevr8syiNKPtKyvJ9Ox+F8Ycb1cdU+rYCTjTi/iWjk1+nbue3eEPEdtrtoMER3SD95Hn9R7Vu18+6bf3On3kd1aSmOVDkEd/Y17J4P8SW2vWY6R3aD97F/Ue1eVmmVPDP2lP4fyPtODeMoZrBYXFO1Zf+Tf8AB7r5o3qKKK8Q/QgooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAqavbTXmmz20Fw1vJIhVZB1FeDa3p15pWoSWl6hWQHr2YeoNfQlY3izw9Z6/YGGZQky8xSgcqf8K9jKcyWEnyzXuv8D4njLhZ51RVSi7VYLRdGu3k+z+88HzRuq1rWmXmkX8lnexFHU8Hsw9RVLNfcxlGcVKLumfgFahUozdOorSWjT6E0M0kMqyxOyOpyrKcEGvXPAPjCPVolsb9wl6owGPAkH+NeO5p8M0kMqyxOyOpyrA4INcWPy+njKfLLfoz2+HuIMTkmI9pT1i/ij0a/wA+zPpGiuM+H/jCPV4lsL91S+QfKTwJR/jXW3t1BZWslzcyLHFGMsxNfB4jC1aFX2U1r+fof0Rl2bYXMMKsVRl7vXy7p9rBfXVvZWr3NzKscSDLMTXjnjbxVPrtyYoiY7JD8if3vc0zxv4ruNeujFEWjsoz8if3vc1zOa+synKFh0qtVe9+X/BPxvjLjKWZSeEwjtSW7/m/4H5kmaM1HmlB54r3bH51YkzXo3wz8MXMc0es3ZeED/VR5wW9z7VB8O/BpnMerarEREDuhhb+L3Pt7V6cAAAAAAOgFfL5xmqs6FH5v9D9a4H4MlzQzHGq1tYR/KT/AEXzCiiivlj9hCiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAKKKKACiiigAooooAxfFvh208QWBhmASdRmKUdVP+FeH63pl5pGoSWV5EUdTwezD1HtX0VWL4t8O2fiHTzBONk6g+TKByp/wr28pzZ4WXs6msH+B8NxdwhTzeDxGHVqy/8m8n59n954FmjNW9b0y80fUHsr2MpIp4PZh6iqWfevuYyjOKlF3TPwetQnRm6dRWktGmSwzSQyrLE7I6nKsDgg1teIPFOqa3a29vdy4jiUAheN7f3jWBmjNROhTnJTkrtbGtLF4ijSnRpzajPddHbuP3e9Lmo80ua0scth+a9E+HXgw3Hl6tqsZEX3oYmH3vc+1J8OPBZnKavq0eIhzDCw+9/tH29q9SAAAAGAOgr5bOM35b0KD16v8ARH6twXwXz8uPx0dN4xfXzf6IFAUAAAAdBRRRXyZ+wBRRRQAUUUUAFFFFABRRRQAUUUUAFFFFABRRRQAUUUUAFFB4GTXyj+1p+0ONJjufA3ga6DX7qU1DUY24gB4McZH8Xqe38tqFCdefLETaSufQ3h/4geEde8Uah4a0rWra51Ow/wBfCrD8ceuO+OldRX5I+GfEWseG/ENvr2j30ttqFvJ5iSqxyT3z6g96/RH9nD41aT8U9AWGcx2fiK1QC7tC33/+mieqn07V14zL3QXNHVEQnc9dooorzjQKKKKACiis7xHrel+HdGudY1m8is7K2QvLLI2AAP600m3ZAYfxUg8Pr4VutT1+7isYbSMuLp/4Pb3z6V8++HNd0zxDpq6hpVys8DHGRwVPoR2NeIftJ/G7VPifrbWVk8lp4btZD9mtwcGU/wDPR/c9h2rgfh34z1LwdrAurV2ktZCBcW5PyyD/AB9DX2WTyqYWny1Ho+nY+C4t4Wp5tF16CtVX/k3k/Ps/vPr/ADRmsjwx4g07xFpMWpaZOJInHI/iQ9wR61qbq+mVmro/D6tCdGbp1FZrdEma6/4XafpWoa7jUpV3oA0MLdJD/ntXG5p8E0kMqyxOyOhyrKcEGsMTRlWpShGVm+p1ZbiYYPFQr1IKai72fU+nFAUAKAAOABRXEfDnxpFrMK6fqDhL9BhSeko9frXb1+a4rDVMNUdOotT+k8szLD5lh44jDu8X968n5hRRRXOegFFFFABUGoXlvYWkl1dSrHFGMliaL+7t7C0kuruVYoYxlmNeI+OvFtx4huzHFuisYz+7jz97/aNenluW1MbU00it2fM8S8SUMkoXetR/DH9X5fmeteF/E+m+IFkFoxSWMnMb9cev0rbr5t0vULrTb6K8s5TFNGcgj+R9q9w8E+KbXxDYjlY7xB+9i/qPaurNsneE/eUtYfkeTwlxjHNV9XxVo1V90vTz8vmjoqKKK8I+8CiiigAooooAKKKKACiiigD5V/a8+P0mgvdeAvCUskepFdl9eDjyQR9xPfHeviiR3lkaSR2d2OWZjkk+tfoj+058CtP+Jektq2jxRWnie2T91KMKLlR/yzf+h7V+fOuaVqGiarcaXqtpLaXls5jlikXDKRX0mWSpOlaG/U56l76lKtPwtr+reGNetdb0S8ls761cPHJG2D9D6g9MVmUV6TSasyD9Jf2cfjXpPxR0MW9w0dp4gtkAubYnHmf7aeo/lXr1fkh4W1/V/DGuW2taHey2d9bOHjkjP6H1HtX6Jfs5fGvR/inoQgmeOz8RWqD7XaE439vMT1U+navnMfgHRfPD4fyN4Tvoz12iis7xJremeHdEutZ1i7jtLK1jLyyucAAf1rzUm3ZGgeJNb0vw7otzrOs3kVpZWyF5ZZDgAD+Z9q/PL9pP436r8UNZaxs2ks/Dlq5+z24ODMf77+p9B2o/aU+N2p/FDXDZ2LS2fhy1ci3t84Mx/wCej+/oO1eNV9DgMAqS55/F+RhOd9EFFFABJwBkmvUMzqPh34y1Lwjq63FszSWshAntyeHHt719Z2EstzpVlqD2txbR3kCzxLPGUbawyODXK/slfs8nUpbXx144tGFkhElhp8q4849pHB/h9B3r608X+GLDxBpX2WRFiljX9xIowUPYfT2rGnnkMPWVJ6x6vt/XU+P4o4SjmtN4igrVV/5N5Pz7P7z56zRmrmvaVe6LqMljexMkiHg9mHqKoZr6uEozipRd0z8Rq0J0ZunUVmtGmTwTSQTJNC7JIhyrKcEGvZvhz41j1mJdP1GRUv0GFY8CX/69eJZqSCaWCVZYXZHU5VlOCDXDmGXU8bT5ZaPo+x7WQZ9iMlxHtKesX8UejX+fZn1FRXDfDbxtHrUKadqDqmoIuAx4EoHf613NfnWKwtTC1HTqKzR/QGW5lh8yw8cRh3eL+9Ps/MKr6heW1hZyXd3KsUUYyzGjUby20+zku7yZYoY13MzGvDPHvi+48RXpjiZorCM/u4/73+0feuvLMsqY6pZaRW7/AK6nlcScR0MloXetR/DH9X5D/Hni648Q3nlxlo7GM/u48/e9zXL7qZmjNfodDDwoU1TpqyR+AY7G18dXlXryvJ/19w/dVvSdRutMvo7yzlaOVDkY7+xqkDmvTPhn4HMxj1jV4v3Y+aCFh97/AGjWGPxNHDUXKrt27+R15JlWLzHFxp4XSS1v/L53PQ/C+oXGqaJb3t1bNbyyLkoe/v8AQ1p0AAAAAADoBRX5nUkpSbiLine truncated
|
||||
|
||||
@@ -107,6 +107,7 @@ import Text.Read (readMaybe)
|
||||
import UnliftIO.Concurrent (ThreadId, forkIO, mkWeakThreadId)
|
||||
import UnliftIO.Directory
|
||||
import UnliftIO.STM
|
||||
import qualified Data.Aeson as J
|
||||
|
||||
smallGroupsRcptsMemLimit :: Int
|
||||
smallGroupsRcptsMemLimit = 20
|
||||
@@ -127,6 +128,8 @@ processAgentMessage _ _ (DEL_CONNS connIds) =
|
||||
toView $ CEvtAgentConnsDeleted $ L.map AgentConnId connIds
|
||||
processAgentMessage _ "" (ERR e) =
|
||||
eToView $ chatErrorAgent e
|
||||
processAgentMessage _ connId (SSENT _ _) =
|
||||
toView $ CEvtServiceReplySent (AgentConnId connId)
|
||||
processAgentMessage corrId connId msg = do
|
||||
lockEntity <- critical connId (withStore (`getChatLockEntity` AgentConnId connId))
|
||||
withEntityLock "processAgentMessage" lockEntity $ do
|
||||
@@ -515,7 +518,10 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
|
||||
withCompletedCommand conn agentMsg $ \_ ->
|
||||
case cReq of
|
||||
CRInvitationUri _ _ -> withStore' $ \db -> setConnConnReqInv db user connId cReq
|
||||
CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type"
|
||||
CRContactUri _ _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type"
|
||||
RJCT reason -> do
|
||||
ct' <- withStore' $ \db -> updateContactStatus db user ct CSRejected
|
||||
toView $ CEvtContactRequestRejected user ct' (either (const Nothing) Just $ strDecode reason)
|
||||
MSG msgMeta _msgFlags msgBody -> do
|
||||
tags <- newTVarIO []
|
||||
withAckMessage "contact msg" agentConnId msgMeta True (Just tags) $ \eInfo -> do
|
||||
@@ -740,7 +746,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
|
||||
getHostConnId db user groupId
|
||||
sendXGrpMemInv hostConnId Nothing XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq}
|
||||
_ -> throwChatError $ CECommandError "unexpected cmdFunction"
|
||||
CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type"
|
||||
CRContactUri _ _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type"
|
||||
CONF confId _pqSupport _ connInfo -> do
|
||||
ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo
|
||||
conn' <- updatePeerChatVRange conn chatVRange
|
||||
@@ -1179,7 +1185,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
|
||||
forM_ mc_ $ \mc -> do
|
||||
connReq_ <- withStore' $ \db -> getBusinessContactRequest db user groupId
|
||||
sendGroupAutoReply mc connReq_
|
||||
LDATA FixedLinkData {linkConnReq = cReq, rootKey = relayKey, linkEntityId} cData ->
|
||||
LDATA FixedLinkData {rootKey = relayKey, linkEntityId} cData cReq ->
|
||||
withCompletedCommand conn agentMsg $ \CommandData {cmdFunction} ->
|
||||
case cmdFunction of
|
||||
CFGetRelayDataJoin -> do
|
||||
@@ -1191,14 +1197,14 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
|
||||
pure $ MemberId entityId
|
||||
_ -> throwChatError $ CEException "relay link: no relay link data or entity id"
|
||||
case cReq of
|
||||
CRContactUri crData@ConnReqUriData {crClientData} -> do
|
||||
CRContactUri crData@ConnReqUriData {crClientData} e2e -> do
|
||||
let pqSup = PQSupportOff
|
||||
lift (withAgent' $ \a -> connRequestPQSupport a pqSup cReq) >>= \case
|
||||
Nothing -> throwChatError CEInvalidConnReq
|
||||
Just _ -> do
|
||||
let chatV = initialChatVersion
|
||||
groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli
|
||||
cReqHash = contactCReqHash $ CRContactUri crData {crScheme = SSSimplex}
|
||||
cReqHash = contactCReqHash $ CRContactUri crData {crScheme = SSSimplex} e2e
|
||||
-- Update connection with data derived from cReq, now available after getConnShortLinkAsync
|
||||
withStore' $ \db -> updateConnLinkData db user conn cReq cReqHash groupLinkId chatV pqSup
|
||||
let incognitoProfile = fromLocalProfile <$> incognitoMembershipProfile gInfo
|
||||
@@ -1346,16 +1352,24 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
|
||||
|
||||
processContactConnMessage :: AEvent e -> ConnectionEntity -> Connection -> UserContact -> CM ()
|
||||
processContactConnMessage agentMsg connEntity conn UserContact {userContactLinkId = uclId, groupId = ucGroupId_} = case agentMsg of
|
||||
REQ invId pqSupport _ connInfo -> do
|
||||
REQ invId pqSupport _ connInfo rejectionSupported -> do
|
||||
(signedMsg_, ChatMessage {chatVRange, chatMsgEvent}) <- parseChatMessage' conn connInfo
|
||||
case chatMsgEvent of
|
||||
XContact p xContactId_ welcomeMsgId_ requestMsg_ -> profileContactRequest invId chatVRange p xContactId_ welcomeMsgId_ requestMsg_ pqSupport
|
||||
XContact p xContactId_ welcomeMsgId_ requestMsg_ -> profileContactRequest invId chatVRange p xContactId_ welcomeMsgId_ requestMsg_ pqSupport rejectionSupported
|
||||
XMember p joiningMemberId joiningMemberKey viaRelay -> memberJoinRequestViaRelay invId chatVRange signedMsg_ p joiningMemberId joiningMemberKey viaRelay
|
||||
XInfo p -> profileContactRequest invId chatVRange p Nothing Nothing Nothing pqSupport
|
||||
XInfo p -> profileContactRequest invId chatVRange p Nothing Nothing Nothing pqSupport rejectionSupported
|
||||
XGrpRelayInv groupRelayInv -> xGrpRelayInv invId chatVRange groupRelayInv
|
||||
XGrpRelayTest challenge _ -> xGrpRelayTest invId chatVRange challenge
|
||||
-- TODO show/log error, other events in contact request
|
||||
_ -> pure ()
|
||||
SREQ invId sigKey_ payload ->
|
||||
chatReadVar processServiceRequests >>= \case
|
||||
True -> case J.eitherDecodeStrict' payload of
|
||||
Right request -> toView $ CEvtServiceRequest user (AgentInvId invId) sigKey_ request
|
||||
Left _ -> dropSReq
|
||||
False -> dropSReq
|
||||
where
|
||||
dropSReq = withAgent $ \a -> rejectServiceRequest a NRMBackground (aUserId user) invId Nothing
|
||||
LINK _link auData ->
|
||||
withCompletedCommand conn agentMsg $ \CommandData {cmdFunction} ->
|
||||
case cmdFunction of
|
||||
@@ -1417,8 +1431,8 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
|
||||
-- TODO add debugging output
|
||||
_ -> pure ()
|
||||
where
|
||||
profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> PQSupport -> CM ()
|
||||
profileContactRequest invId chatVRange p@Profile {displayName} xContactId_ welcomeMsgId_ requestMsg_ reqPQSup = do
|
||||
profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> PQSupport -> Bool -> CM ()
|
||||
profileContactRequest invId chatVRange p@Profile {displayName} xContactId_ welcomeMsgId_ requestMsg_ reqPQSup rejectionSupported = do
|
||||
(ucl, gLinkInfo_) <- withStore $ \db -> getUserContactLinkById db userId uclId
|
||||
let v = maxVersion chatVRange
|
||||
case gLinkInfo_ of
|
||||
@@ -1428,7 +1442,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
|
||||
AddressSettings {autoAccept} = addressSettings
|
||||
isSimplexTeam = sameConnReqContact connReq adminContactReq
|
||||
gVar <- asks random
|
||||
withStore (\db -> createOrUpdateContactRequest db gVar cxt user uclId ucl isSimplexTeam invId chatVRange p xContactId_ welcomeMsgId_ requestMsg_ reqPQSup) >>= \case
|
||||
withStore (\db -> createOrUpdateContactRequest db gVar cxt user uclId ucl isSimplexTeam invId chatVRange p xContactId_ welcomeMsgId_ requestMsg_ reqPQSup rejectionSupported) >>= \case
|
||||
RSAcceptedRequest _ucr re -> case re of
|
||||
REContact ct ->
|
||||
-- TODO [short links] update request msg
|
||||
@@ -3176,7 +3190,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
|
||||
void $ withStore $ \db -> do
|
||||
reMember <- createIntroReMember db cxt user gInfo memInfo memRestrictions
|
||||
createIntroReMemberConn db user m reMember chatV memInfo groupConnIds subMode
|
||||
withAgent $ \a -> createConnectionAsync a (aCorrId cmdId) connId (chatHasNtfs chatSettings) SCMInvitation CR.IKPQOff subMode
|
||||
withAgent $ \a -> createConnectionAsync a (aCorrId cmdId) connId (chatHasNtfs chatSettings) SCMInvitation CR.IKPQOff True subMode
|
||||
_ -> messageError "x.grp.mem.intro can be only sent by host member"
|
||||
|
||||
sendXGrpMemInv :: Int64 -> Maybe ConnReqInvitation -> XGrpMemIntroCont -> CM ()
|
||||
@@ -4392,7 +4406,7 @@ runRelayRequestWorker a Worker {doWork} = do
|
||||
where
|
||||
getLinkDataCreateRelayLink :: RelayRequestData -> GroupInfo -> CM (GroupInfo, ShortLinkContact)
|
||||
getLinkDataCreateRelayLink RelayRequestData {reqGroupLink} gInfo = do
|
||||
(FixedLinkData {linkEntityId, rootKey}, cData@(ContactLinkData _ UserContactData {owners})) <- getShortLinkConnReq' NRMBackground user reqGroupLink
|
||||
(FixedLinkData {linkEntityId, rootKey}, cData@(ContactLinkData _ UserContactData {owners}), _) <- getShortLinkConnReq' NRMBackground user reqGroupLink
|
||||
liftIO (decodeLinkUserData cData) >>= \case
|
||||
Nothing -> throwChatError $ CEException "getLinkDataCreateRelayLink: no group link data"
|
||||
Just GroupShortLinkData {groupProfile = gp@GroupProfile {publicGroup}} -> do
|
||||
@@ -4422,15 +4436,15 @@ runRelayRequestWorker a Worker {doWork} = do
|
||||
sigKeys <- liftIO $ atomically $ C.generateKeyPair gVar
|
||||
let crClientData = encodeJSON $ CRDataGroup groupLinkId
|
||||
-- prepare link with relayMemId as linkEntityId (no server request)
|
||||
(ccLink, preparedParams) <- withAgent $ \a' -> prepareConnectionLink a' (aUserId user) sigKeys relayMemId True (Just crClientData) Nothing
|
||||
(ccLink, preparedParams) <- withAgent $ \a' -> prepareConnectionLink a' (aUserId user) sigKeys relayMemId True (Just crClientData) CR.IKPQOff False Nothing
|
||||
ccLink' <- setShortLinkType CCTGroup <$> shortenCreatedLink ccLink
|
||||
sLnk <- case connShortLink' ccLink' of
|
||||
Just sl -> pure sl
|
||||
Nothing -> throwChatError $ CEException "failed to create relay link: no short link"
|
||||
let userData = encodeShortLinkData $ RelayShortLinkData {relayProfile = fromLocalProfile p}
|
||||
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData}
|
||||
userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
|
||||
-- create connection with prepared link (single network call)
|
||||
connId <- withAgent $ \a' -> createConnectionForLink a' NRMBackground (aUserId user) True ccLink preparedParams userLinkData CR.IKPQOff subMode
|
||||
connId <- withAgent $ \a' -> createConnectionForLink a' NRMBackground (aUserId user) True ccLink preparedParams userLinkData subMode
|
||||
-- TODO [relays] starting role should be communicated in protocol from owner to relays
|
||||
subRole <- asks $ channelSubscriberRole . config
|
||||
void $ withFastStore $ \db -> createGroupLink db gVar user gi connId ccLink' groupLinkId subRole subMode
|
||||
|
||||
Reference in new issue
Block a user