core: do not subscribe to new connections from iOS NSE (subscribe=off flag), subscribe in app when it activates (#3016)

* Trace auto-subs flag

* Replace Bool with SubscriptionMode

* Add subscriptionMode to chat controller

* Start using subscriptionMode in event handlers

* Add need_subs to chat connections

* Add onlyNeeded to subscribeUserConnections

* Post-rebase fixes

* Pass onlyNeeded to Store functions

* Drop needs_sub for connections registered with agent

* update simplexmq, fix activate

* fix rebase, reduce diff

* fix rebase, tests

* fix rebase, executeMany, always subscribe on activate

* test

* update queries

* Update src/Simplex/Chat.hs

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

* unset connections to subscribe on start

* update simplexmq

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
This commit is contained in:
Alexander Bondarenko 2023-09-10 22:40:15 +03:00 committed by GitHub
parent 7b582b2cf9
commit 2dff6c8859
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
16 changed files with 286 additions and 137 deletions

View File

@ -9,7 +9,7 @@ constraints: zip +disable-bzip2 +disable-zstd
source-repository-package
type: git
location: https://github.com/simplex-chat/simplexmq.git
tag: 351f42650c57f310fc1ea858ff9b7178823f1fd4
tag: 0cabe0690beee90f460ad7bada72294222e7e109
source-repository-package
type: git

View File

@ -1,5 +1,5 @@
{
"https://github.com/simplex-chat/simplexmq.git"."351f42650c57f310fc1ea858ff9b7178823f1fd4" = "12r13yc0qk9dkii58808862wraqrk66rzmkrgyp6lg1xrazrd0d2";
"https://github.com/simplex-chat/simplexmq.git"."0cabe0690beee90f460ad7bada72294222e7e109" = "1yfcrifb2l59wgl14q56ywlil2g2zs57ic62s617whh3w2mnh0kz";
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
"https://github.com/kazu-yamamoto/http2.git"."b5a1b7200cf5bc7044af34ba325284271f6dff25" = "0dqb50j57an64nf4qcf5vcz4xkd1vzvghvf8bk529c1k30r9nfzb";
"https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";

View File

@ -110,6 +110,7 @@ library
Simplex.Chat.Migrations.M20230814_indexes
Simplex.Chat.Migrations.M20230827_file_encryption
Simplex.Chat.Migrations.M20230829_connections_chat_vrange
Simplex.Chat.Migrations.M20230903_connections_to_subscribe
Simplex.Chat.Mobile
Simplex.Chat.Mobile.File
Simplex.Chat.Mobile.Shared

View File

@ -89,7 +89,7 @@ import qualified Simplex.Messaging.Crypto.File as CF
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (base64P)
import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), EntityId, ErrorType (..), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolTypeI, SProtocolType (..), UserProtocol, userProtocol)
import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), EntityId, ErrorType (..), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolTypeI, SProtocolType (..), SubscriptionMode (..), UserProtocol, userProtocol)
import qualified Simplex.Messaging.Protocol as SMP
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Transport.Client (defaultSocksProxy)
@ -194,6 +194,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
inputQ <- newTBQueueIO tbqSize
outputQ <- newTBQueueIO tbqSize
notifyQ <- newTBQueueIO tbqSize
subscriptionMode <- newTVarIO SMSubscribe
chatLock <- newEmptyTMVarIO
sndFiles <- newTVarIO M.empty
rcvFiles <- newTVarIO M.empty
@ -207,7 +208,7 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
showLiveItems <- newTVarIO False
userXFTPFileConfig <- newTVarIO $ xftpFileConfig cfg
tempDirectory <- newTVarIO tempDir
pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems, userXFTPFileConfig, tempDirectory, logFilePath = logFile}
pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, subscriptionMode, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, filesFolder, expireCIThreads, expireCIFlags, cleanupManagerAsync, timedItemThreads, showLiveItems, userXFTPFileConfig, tempDirectory, logFilePath = logFile}
where
configServers :: DefaultAgentServers
configServers =
@ -246,6 +247,8 @@ cfgServers = \case
startChatController :: forall m. ChatMonad' m => Bool -> Bool -> Bool -> m (Async ())
startChatController subConns enableExpireCIs startXFTPWorkers = do
asks smpAgent >>= resumeAgentClient
unless subConns $
chatWriteVar subscriptionMode SMOnlyCreate
users <- fromRight [] <$> runExceptT (withStoreCtx' (Just "startChatController, getUsers") getUsers)
restoreCalls
s <- asks agentAsync
@ -255,7 +258,7 @@ startChatController subConns enableExpireCIs startXFTPWorkers = do
a1 <- async $ race_ notificationSubscriber agentSubscriber
a2 <-
if subConns
then Just <$> async (subscribeUsers users)
then Just <$> async (subscribeUsers False users)
else pure Nothing
atomically . writeTVar s $ Just (a1, a2)
when startXFTPWorkers $ do
@ -283,14 +286,14 @@ startChatController subConns enableExpireCIs startXFTPWorkers = do
startExpireCIThread user
setExpireCIFlag user True
subscribeUsers :: forall m. ChatMonad' m => [User] -> m ()
subscribeUsers users = do
subscribeUsers :: forall m. ChatMonad' m => Bool -> [User] -> m ()
subscribeUsers onlyNeeded users = do
let (us, us') = partition activeUser users
subscribe us
subscribe us'
where
subscribe :: [User] -> m ()
subscribe = mapM_ $ runExceptT . subscribeUserConnections Agent.subscribeConnections
subscribe = mapM_ $ runExceptT . subscribeUserConnections onlyNeeded Agent.subscribeConnections
startFilesToReceive :: forall m. ChatMonad' m => [User] -> m ()
startFilesToReceive users = do
@ -464,14 +467,16 @@ processChatCommand = \case
APIActivateChat -> withUser $ \_ -> do
restoreCalls
withAgent foregroundAgent
withStoreCtx' (Just "APIActivateChat, getUsers") getUsers >>= void . forkIO . startFilesToReceive
users <- withStoreCtx' (Just "APIActivateChat, getUsers") getUsers
void . forkIO $ subscribeUsers True users
void . forkIO $ startFilesToReceive users
setAllExpireCIFlags True
ok_
APISuspendChat t -> do
setAllExpireCIFlags False
withAgent (`suspendAgent` t)
ok_
ResubscribeAllConnections -> withStoreCtx' (Just "ResubscribeAllConnections, getUsers") getUsers >>= subscribeUsers >> ok_
ResubscribeAllConnections -> withStoreCtx' (Just "ResubscribeAllConnections, getUsers") getUsers >>= subscribeUsers False >> ok_
-- has to be called before StartChat
SetTempFolder tf -> do
createDirectoryIfMissing True tf
@ -567,15 +572,16 @@ processChatCommand = \case
smpSndFileTransfer :: CryptoFile -> Integer -> Maybe InlineFileMode -> m (FileInvitation, CIFile 'MDSnd, FileTransferMeta)
smpSndFileTransfer (CryptoFile _ (Just _)) _ _ = throwChatError $ CEFileInternal "locally encrypted files can't be sent via SMP" -- can only happen if XFTP is disabled
smpSndFileTransfer (CryptoFile file Nothing) fileSize fileInline = do
subMode <- chatReadVar subscriptionMode
(agentConnId_, fileConnReq) <-
if isJust fileInline
then pure (Nothing, Nothing)
else bimap Just Just <$> withAgent (\a -> createConnection a (aUserId user) True SCMInvitation Nothing)
else bimap Just Just <$> withAgent (\a -> createConnection a (aUserId user) True SCMInvitation Nothing subMode)
let fileName = takeFileName file
fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
chSize <- asks $ fileChunkSize . config
withStore' $ \db -> do
ft@FileTransferMeta {fileId} <- createSndDirectFileTransfer db userId ct file fileInvitation agentConnId_ chSize
ft@FileTransferMeta {fileId} <- createSndDirectFileTransfer db userId ct file fileInvitation agentConnId_ chSize subMode
fileStatus <- case fileInline of
Just IFMSent -> createSndDirectInlineFT db ct ft $> CIFSSndTransfer 0 1
_ -> pure CIFSSndStored
@ -1273,8 +1279,9 @@ processChatCommand = \case
APIAddContact userId incognito -> withUserId userId $ \user -> withChatLock "addContact" . procCmd $ do
-- [incognito] generate profile for connection
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
(connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing
conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnNew incognitoProfile
subMode <- chatReadVar subscriptionMode
(connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing subMode
conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnNew incognitoProfile subMode
toView $ CRNewContactConnection user conn
pure $ CRInvitation user cReq conn
AddContact incognito -> withUser $ \User {userId} ->
@ -1295,12 +1302,13 @@ processChatCommand = \case
Just conn' -> pure $ CRConnectionIncognitoUpdated user conn'
Nothing -> throwChatError CEConnectionIncognitoChangeProhibited
APIConnect userId incognito (Just (ACR SCMInvitation cReq)) -> withUserId userId $ \user -> withChatLock "connect" . procCmd $ do
subMode <- chatReadVar subscriptionMode
-- [incognito] generate profile to send
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
let profileToSend = userProfileToSend user incognitoProfile Nothing
dm <- directMessage $ XInfo profileToSend
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm
conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined $ incognitoProfile $> profileToSend
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm subMode
conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined (incognitoProfile $> profileToSend) subMode
toView $ CRNewContactConnection user conn
pure $ CRSentConfirmation user
APIConnect userId incognito (Just (ACR SCMContact cReq)) -> withUserId userId $ \user -> connectViaContact user incognito cReq
@ -1317,8 +1325,9 @@ processChatCommand = \case
ListContacts -> withUser $ \User {userId} ->
processChatCommand $ APIListContacts userId
APICreateMyAddress userId -> withUserId userId $ \user -> withChatLock "createMyAddress" . procCmd $ do
(connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact Nothing
withStore $ \db -> createUserContactLink db user connId cReq
subMode <- chatReadVar subscriptionMode
(connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact Nothing subMode
withStore $ \db -> createUserContactLink db user connId cReq subMode
pure $ CRUserContactLinkCreated user cReq
CreateMyAddress -> withUser $ \User {userId} ->
processChatCommand $ APICreateMyAddress userId
@ -1423,8 +1432,9 @@ processChatCommand = \case
case contactMember contact members of
Nothing -> do
gVar <- asks idsDrg
(agentConnId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing
member <- withStore $ \db -> createNewContactMember db gVar user groupId contact memRole agentConnId cReq
subMode <- chatReadVar subscriptionMode
(agentConnId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing subMode
member <- withStore $ \db -> createNewContactMember db gVar user groupId contact memRole agentConnId cReq subMode
sendInvitation member cReq
pure $ CRSentGroupInvitation user gInfo contact member
Just member@GroupMember {groupMemberId, memberStatus, memberRole = mRole}
@ -1443,10 +1453,11 @@ processChatCommand = \case
let ReceivedGroupInvitation {fromMember, connRequest, groupInfo = g@GroupInfo {membership}} = invitation
Contact {activeConn = Connection {peerChatVRange}} = ct
withChatLock "joinGroup" . procCmd $ do
subMode <- chatReadVar subscriptionMode
dm <- directMessage $ XGrpAcpt (memberId (membership :: GroupMember))
agentConnId <- withAgent $ \a -> joinConnection a (aUserId user) True connRequest dm
agentConnId <- withAgent $ \a -> joinConnection a (aUserId user) True connRequest dm subMode
withStore' $ \db -> do
createMemberConnection db userId fromMember agentConnId peerChatVRange
createMemberConnection db userId fromMember agentConnId peerChatVRange subMode
updateGroupMemberStatus db userId fromMember GSMemAccepted
updateGroupMemberStatus db userId membership GSMemAccepted
updateCIGroupInvitationStatus user
@ -1557,9 +1568,10 @@ processChatCommand = \case
assertUserGroupRole gInfo GRAdmin
when (mRole > GRMember) $ throwChatError $ CEGroupMemberInitialRole gInfo mRole
groupLinkId <- GroupLinkId <$> drgRandomBytes 16
subMode <- chatReadVar subscriptionMode
let crClientData = encodeJSON $ CRDataGroup groupLinkId
(connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact $ Just crClientData
withStore $ \db -> createGroupLink db user gInfo connId cReq groupLinkId mRole
(connId, cReq) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact (Just crClientData) subMode
withStore $ \db -> createGroupLink db user gInfo connId cReq groupLinkId mRole subMode
pure $ CRGroupLinkCreated user gInfo cReq mRole
APIGroupLinkMemberRole groupId mRole' -> withUser $ \user -> withChatLock "groupLinkMemberRole " $ do
gInfo <- withStore $ \db -> getGroupInfo db user groupId
@ -1845,13 +1857,14 @@ processChatCommand = \case
(_, xContactId_) -> procCmd $ do
let randomXContactId = XContactId <$> drgRandomBytes 16
xContactId <- maybe randomXContactId pure xContactId_
subMode <- chatReadVar subscriptionMode
-- [incognito] generate profile to send
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
let profileToSend = userProfileToSend user incognitoProfile Nothing
dm <- directMessage (XContact profileToSend $ Just xContactId)
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm subMode
let groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli
conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId
conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode
toView $ CRNewContactConnection user conn
pure $ CRSentInvitation user incognitoProfile
contactMember :: Contact -> [GroupMember] -> Maybe GroupMember
@ -2240,9 +2253,11 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI
case (xftpRcvFile, fileConnReq) of
-- direct file protocol
(Nothing, Just connReq) -> do
connIds <- joinAgentConnectionAsync user True connReq =<< directMessage (XFileAcpt fName)
subMode <- chatReadVar subscriptionMode
dm <- directMessage $ XFileAcpt fName
connIds <- joinAgentConnectionAsync user True connReq dm subMode
filePath <- getRcvFilePath fileId filePath_ fName True
withStoreCtx (Just "acceptFileReceive, acceptRcvFileTransfer") $ \db -> acceptRcvFileTransfer db user fileId connIds ConnJoined filePath
withStoreCtx (Just "acceptFileReceive, acceptRcvFileTransfer") $ \db -> acceptRcvFileTransfer db user fileId connIds ConnJoined filePath subMode
-- XFTP
(Just XFTPRcvFile {cryptoArgs}, _) -> do
filePath <- getRcvFilePath fileId filePath_ fName False
@ -2283,8 +2298,9 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI
| fileInline == Just IFMSent -> throwChatError $ CEFileAlreadyReceiving fName
| otherwise -> do
-- accepting via a new connection
connIds <- createAgentConnectionAsync user cmdFunction True SCMInvitation
withStoreCtx (Just "acceptFile, acceptRcvFileTransfer") $ \db -> acceptRcvFileTransfer db user fileId connIds ConnNew filePath
subMode <- chatReadVar subscriptionMode
connIds <- createAgentConnectionAsync user cmdFunction True SCMInvitation subMode
withStoreCtx (Just "acceptFile, acceptRcvFileTransfer") $ \db -> acceptRcvFileTransfer db user fileId connIds ConnNew filePath subMode
receiveInline :: m Bool
receiveInline = do
ChatConfig {fileChunkSize, inlineFiles = InlineFilesConfig {receiveChunks, offerChunks}} <- asks config
@ -2356,17 +2372,19 @@ getRcvFilePath fileId fPath_ fn keepHandle = case fPath_ of
acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> m Contact
acceptContactRequest user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = cp, userContactLinkId, xContactId} incognitoProfile = do
subMode <- chatReadVar subscriptionMode
let profileToSend = profileToSendOnAccept user incognitoProfile
dm <- directMessage $ XInfo profileToSend
acId <- withAgent $ \a -> acceptContact a True invId dm
withStore' $ \db -> createAcceptedContact db user acId cReqChatVRange cName profileId cp userContactLinkId xContactId incognitoProfile
acId <- withAgent $ \a -> acceptContact a True invId dm subMode
withStore' $ \db -> createAcceptedContact db user acId cReqChatVRange cName profileId cp userContactLinkId xContactId incognitoProfile subMode
acceptContactRequestAsync :: ChatMonad m => User -> UserContactRequest -> Maybe IncognitoProfile -> m Contact
acceptContactRequestAsync user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile = do
subMode <- chatReadVar subscriptionMode
let profileToSend = profileToSendOnAccept user incognitoProfile
(cmdId, acId) <- agentAcceptContactAsync user True invId $ XInfo profileToSend
(cmdId, acId) <- agentAcceptContactAsync user True invId (XInfo profileToSend) subMode
withStore' $ \db -> do
ct@Contact {activeConn = Connection {connId}} <- createAcceptedContact db user acId cReqChatVRange cName profileId p userContactLinkId xContactId incognitoProfile
ct@Contact {activeConn = Connection {connId}} <- createAcceptedContact db user acId cReqChatVRange cName profileId p userContactLinkId xContactId incognitoProfile subMode
setCommandConnId db user cmdId connId
pure ct
@ -2413,18 +2431,28 @@ agentSubscriber = do
type AgentBatchSubscribe m = AgentClient -> [ConnId] -> ExceptT AgentErrorType m (Map ConnId (Either AgentErrorType ()))
subscribeUserConnections :: forall m. ChatMonad m => AgentBatchSubscribe m -> User -> m ()
subscribeUserConnections agentBatchSubscribe user@User {userId} = do
subscribeUserConnections :: forall m. ChatMonad m => Bool -> AgentBatchSubscribe m -> User -> m ()
subscribeUserConnections onlyNeeded agentBatchSubscribe user@User {userId} = do
-- get user connections
ce <- asks $ subscriptionEvents . config
(ctConns, cts) <- getContactConns
(ucConns, ucs) <- getUserContactLinkConns
(gs, mConns, ms) <- getGroupMemberConns
(sftConns, sfts) <- getSndFileTransferConns
(rftConns, rfts) <- getRcvFileTransferConns
(pcConns, pcs) <- getPendingContactConns
(conns, cts, ucs, gs, ms, sfts, rfts, pcs) <-
if onlyNeeded
then do
(conns, entities) <- withStore' getConnectionsToSubscribe
let (cts, ucs, ms, sfts, rfts, pcs) = foldl' addEntity (M.empty, M.empty, M.empty, M.empty, M.empty, M.empty) entities
pure (conns, cts, ucs, [], ms, sfts, rfts, pcs)
else do
withStore' unsetConnectionToSubscribe
(ctConns, cts) <- getContactConns
(ucConns, ucs) <- getUserContactLinkConns
(gs, mConns, ms) <- getGroupMemberConns
(sftConns, sfts) <- getSndFileTransferConns
(rftConns, rfts) <- getRcvFileTransferConns
(pcConns, pcs) <- getPendingContactConns
let conns = concat [ctConns, ucConns, mConns, sftConns, rftConns, pcConns]
pure (conns, cts, ucs, gs, ms, sfts, rfts, pcs)
-- subscribe using batched commands
rs <- withAgent (`agentBatchSubscribe` concat [ctConns, ucConns, mConns, sftConns, rftConns, pcConns])
rs <- withAgent $ \a -> agentBatchSubscribe a conns
-- send connection events to view
contactSubsToView rs cts ce
contactLinkSubsToView rs ucs
@ -2433,6 +2461,29 @@ subscribeUserConnections agentBatchSubscribe user@User {userId} = do
rcvFileSubsToView rs rfts
pendingConnSubsToView rs pcs
where
addEntity (cts, ucs, ms, sfts, rfts, pcs) = \case
RcvDirectMsgConnection c (Just ct) -> let cts' = addConn c ct cts in (cts', ucs, ms, sfts, rfts, pcs)
RcvDirectMsgConnection c Nothing -> let pcs' = addConn c (toPCC c) pcs in (cts, ucs, ms, sfts, rfts, pcs')
RcvGroupMsgConnection c _g m -> let ms' = addConn c m ms in (cts, ucs, ms', sfts, rfts, pcs)
SndFileConnection c sft -> let sfts' = addConn c sft sfts in (cts, ucs, ms, sfts', rfts, pcs)
RcvFileConnection c rft -> let rfts' = addConn c rft rfts in (cts, ucs, ms, sfts, rfts', pcs)
UserContactConnection c uc -> let ucs' = addConn c uc ucs in (cts, ucs', ms, sfts, rfts, pcs)
addConn :: Connection -> a -> Map ConnId a -> Map ConnId a
addConn = M.insert . aConnId
toPCC Connection {connId, agentConnId, connStatus, viaUserContactLink, groupLinkId, customUserProfileId, localAlias, createdAt} =
PendingContactConnection
{ pccConnId = connId,
pccAgentConnId = agentConnId,
pccConnStatus = connStatus,
viaContactUri = False,
viaUserContactLink,
groupLinkId,
customUserProfileId,
connReqInv = Nothing,
localAlias,
createdAt,
updatedAt = createdAt
}
getContactConns :: m ([ConnId], Map ConnId Contact)
getContactConns = do
cts <- withStore_ ("subscribeUserConnections " <> show userId <> ", getUserContacts") getUserContacts
@ -2971,9 +3022,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc)
toView $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci)
forM_ groupId_ $ \groupId -> do
subMode <- chatReadVar subscriptionMode
gVar <- asks idsDrg
groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation
withStore $ \db -> createNewContactMemberAsync db gVar user groupId ct gLinkMemRole groupConnIds peerChatVRange
groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode
withStore $ \db -> createNewContactMemberAsync db gVar user groupId ct gLinkMemRole groupConnIds peerChatVRange subMode
_ -> pure ()
Just (gInfo@GroupInfo {membership}, m@GroupMember {activeConn}) ->
when (maybe False ((== ConnReady) . connStatus) activeConn) $ do
@ -3920,8 +3972,10 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
then unless cancelled $ case fileConnReq_ of
-- receiving via a separate connection
Just fileConnReq -> do
connIds <- joinAgentConnectionAsync user True fileConnReq =<< directMessage XOk
withStore' $ \db -> createSndDirectFTConnection db user fileId connIds
subMode <- chatReadVar subscriptionMode
dm <- directMessage XOk
connIds <- joinAgentConnectionAsync user True fileConnReq dm subMode
withStore' $ \db -> createSndDirectFTConnection db user fileId connIds subMode
-- receiving inline
_ -> do
event <- withStore $ \db -> do
@ -4015,10 +4069,12 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
if fName == fileName
then unless cancelled $ case (fileConnReq_, activeConn) of
(Just fileConnReq, _) -> do
subMode <- chatReadVar subscriptionMode
-- receiving via a separate connection
-- [async agent commands] no continuation needed, but command should be asynchronous for stability
connIds <- joinAgentConnectionAsync user True fileConnReq =<< directMessage XOk
withStore' $ \db -> createSndGroupFileTransferConnection db user fileId connIds m
dm <- directMessage XOk
connIds <- joinAgentConnectionAsync user True fileConnReq dm subMode
withStore' $ \db -> createSndGroupFileTransferConnection db user fileId connIds m subMode
(_, Just conn) -> do
-- receiving inline
event <- withStore $ \db -> do
@ -4049,9 +4105,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
(gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership = membership@GroupMember {groupMemberId, memberId}}, hostId) <- withStore $ \db -> createGroupInvitation db user ct inv customUserProfileId
if sameGroupLinkId groupLinkId groupLinkId'
then do
connIds <- joinAgentConnectionAsync user True connRequest =<< directMessage (XGrpAcpt memberId)
subMode <- chatReadVar subscriptionMode
dm <- directMessage $ XGrpAcpt memberId
connIds <- joinAgentConnectionAsync user True connRequest dm subMode
withStore' $ \db -> do
createMemberConnectionAsync db user hostId connIds peerChatVRange
createMemberConnectionAsync db user hostId connIds peerChatVRange subMode
updateGroupMemberStatusById db userId hostId GSMemAccepted
updateGroupMemberStatus db userId membership GSMemAccepted
toView $ CRUserAcceptedGroupSent user gInfo {membership = membership {memberStatus = GSMemAccepted}} (Just ct)
@ -4285,18 +4343,19 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
then messageWarning "x.grp.mem.intro ignored: member already exists"
else do
when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole c)
subMode <- chatReadVar subscriptionMode
-- [async agent commands] commands should be asynchronous, continuation is to send XGrpMemInv - have to remember one has completed and process on second
groupConnIds <- createConn
groupConnIds <- createConn subMode
directConnIds <- case memberChatVRange of
Nothing -> Just <$> createConn
Nothing -> Just <$> createConn subMode
Just mcvr
| isCompatibleRange (fromChatVRange mcvr) groupNoDirectVRange -> Just <$> createConn -- pure Nothing
| otherwise -> Just <$> createConn
| isCompatibleRange (fromChatVRange mcvr) groupNoDirectVRange -> Just <$> createConn subMode -- pure Nothing
| otherwise -> Just <$> createConn subMode
let customUserProfileId = if memberIncognito membership then Just (localProfileId $ memberProfile membership) else Nothing
void $ withStore $ \db -> createIntroReMember db user gInfo m memInfo groupConnIds directConnIds customUserProfileId
void $ withStore $ \db -> createIntroReMember db user gInfo m memInfo groupConnIds directConnIds customUserProfileId subMode
_ -> messageError "x.grp.mem.intro can be only sent by host member"
where
createConn = createAgentConnectionAsync user CFCreateConnGrpMemInv enableNtfs SCMInvitation
createConn subMode = createAgentConnectionAsync user CFCreateConnGrpMemInv enableNtfs SCMInvitation subMode
sendXGrpMemInv :: Int64 -> Maybe ConnReqInvitation -> XGrpMemIntroCont -> m ()
sendXGrpMemInv hostConnId directConnReq XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq} = do
@ -4330,14 +4389,15 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
Nothing -> withStore $ \db -> createNewGroupMember db user gInfo memInfo GCPostMember GSMemAnnounced
Just m' -> pure m'
withStore' $ \db -> saveMemberInvitation db toMember introInv
subMode <- chatReadVar subscriptionMode
-- [incognito] send membership incognito profile, create direct connection as incognito
dm <- directMessage $ XGrpMemInfo (memberId (membership :: GroupMember)) (fromLocalProfile $ memberProfile membership)
-- [async agent commands] no continuation needed, but commands should be asynchronous for stability
groupConnIds <- joinAgentConnectionAsync user enableNtfs groupConnReq dm
directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user enableNtfs dcr dm
groupConnIds <- joinAgentConnectionAsync user enableNtfs groupConnReq dm subMode
directConnIds <- forM directConnReq $ \dcr -> joinAgentConnectionAsync user enableNtfs dcr dm subMode
let customUserProfileId = if memberIncognito membership then Just (localProfileId $ memberProfile membership) else Nothing
mcvr = maybe chatInitialVRange fromChatVRange memberChatVRange
withStore' $ \db -> createIntroToMemberContact db user m toMember mcvr groupConnIds directConnIds customUserProfileId
withStore' $ \db -> createIntroToMemberContact db user m toMember mcvr groupConnIds directConnIds customUserProfileId subMode
xGrpMemRole :: GroupInfo -> GroupMember -> MemberId -> GroupMemberRole -> RcvMessage -> MsgMeta -> m ()
xGrpMemRole gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId memRole msg msgMeta
@ -4838,16 +4898,16 @@ cancelCIFile user file_ =
fileAgentConnIds <- cancelFile' user (mkCIFileInfo file) True
deleteAgentConnectionsAsync user fileAgentConnIds
createAgentConnectionAsync :: forall m c. (ChatMonad m, ConnectionModeI c) => User -> CommandFunction -> Bool -> SConnectionMode c -> m (CommandId, ConnId)
createAgentConnectionAsync user cmdFunction enableNtfs cMode = do
createAgentConnectionAsync :: forall m c. (ChatMonad m, ConnectionModeI c) => User -> CommandFunction -> Bool -> SConnectionMode c -> SubscriptionMode -> m (CommandId, ConnId)
createAgentConnectionAsync user cmdFunction enableNtfs cMode subMode = do
cmdId <- withStore' $ \db -> createCommand db user Nothing cmdFunction
connId <- withAgent $ \a -> createConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cMode
connId <- withAgent $ \a -> createConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cMode subMode
pure (cmdId, connId)
joinAgentConnectionAsync :: ChatMonad m => User -> Bool -> ConnectionRequestUri c -> ConnInfo -> m (CommandId, ConnId)
joinAgentConnectionAsync user enableNtfs cReqUri cInfo = do
joinAgentConnectionAsync :: ChatMonad m => User -> Bool -> ConnectionRequestUri c -> ConnInfo -> SubscriptionMode -> m (CommandId, ConnId)
joinAgentConnectionAsync user enableNtfs cReqUri cInfo subMode = do
cmdId <- withStore' $ \db -> createCommand db user Nothing CFJoinConn
connId <- withAgent $ \a -> joinConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cReqUri cInfo
connId <- withAgent $ \a -> joinConnectionAsync a (aUserId user) (aCorrId cmdId) enableNtfs cReqUri cInfo subMode
pure (cmdId, connId)
allowAgentConnectionAsync :: (MsgEncodingI e, ChatMonad m) => User -> Connection -> ConfirmationId -> ChatMsgEvent e -> m ()
@ -4857,11 +4917,11 @@ allowAgentConnectionAsync user conn@Connection {connId} confId msg = do
withAgent $ \a -> allowConnectionAsync a (aCorrId cmdId) (aConnId conn) confId dm
withStore' $ \db -> updateConnectionStatus db conn ConnAccepted
agentAcceptContactAsync :: (MsgEncodingI e, ChatMonad m) => User -> Bool -> InvitationId -> ChatMsgEvent e -> m (CommandId, ConnId)
agentAcceptContactAsync user enableNtfs invId msg = do
agentAcceptContactAsync :: (MsgEncodingI e, ChatMonad m) => User -> Bool -> InvitationId -> ChatMsgEvent e -> SubscriptionMode -> m (CommandId, ConnId)
agentAcceptContactAsync user enableNtfs invId msg subMode = do
cmdId <- withStore' $ \db -> createCommand db user Nothing CFAcceptContact
dm <- directMessage msg
connId <- withAgent $ \a -> acceptContactAsync a (aCorrId cmdId) enableNtfs invId dm
connId <- withAgent $ \a -> acceptContactAsync a (aCorrId cmdId) enableNtfs invId dm subMode
pure (cmdId, connId)
deleteAgentConnectionAsync :: ChatMonad m => User -> ConnId -> m ()

View File

@ -62,7 +62,7 @@ import qualified Simplex.Messaging.Crypto.File as CF
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus)
import Simplex.Messaging.Parsers (dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType, CorrId, MsgFlags, NtfServer, ProtoServerWithAuth, ProtocolTypeI, QueueId, SProtocolType, UserProtocol, XFTPServerWithAuth)
import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType, CorrId, MsgFlags, NtfServer, ProtoServerWithAuth, ProtocolTypeI, QueueId, SProtocolType, SubscriptionMode (..), UserProtocol, XFTPServerWithAuth)
import Simplex.Messaging.TMap (TMap)
import Simplex.Messaging.Transport (simplexMQVersion)
import Simplex.Messaging.Transport.Client (TransportHost)
@ -176,6 +176,7 @@ data ChatController = ChatController
outputQ :: TBQueue (Maybe CorrId, ChatResponse),
notifyQ :: TBQueue Notification,
sendNotification :: Notification -> IO (),
subscriptionMode :: TVar SubscriptionMode,
chatLock :: Lock,
sndFiles :: TVar (Map Int64 Handle),
rcvFiles :: TVar (Map Int64 Handle),
@ -960,6 +961,14 @@ type ChatMonad' m = (MonadUnliftIO m, MonadReader ChatController m)
type ChatMonad m = (ChatMonad' m, MonadError ChatError m)
chatReadVar :: ChatMonad' m => (ChatController -> TVar a) -> m a
chatReadVar f = asks f >>= readTVarIO
{-# INLINE chatReadVar #-}
chatWriteVar :: ChatMonad' m => (ChatController -> TVar a) -> a -> m ()
chatWriteVar f value = asks f >>= atomically . (`writeTVar` value)
{-# INLINE chatWriteVar #-}
tryChatError :: ChatMonad m => m a -> m (Either ChatError a)
tryChatError = tryAllErrors mkChatError
{-# INLINE tryChatError #-}

View File

@ -0,0 +1,20 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20230903_connections_to_subscribe where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20230903_connections_to_subscribe :: Query
m20230903_connections_to_subscribe =
[sql|
ALTER TABLE connections ADD COLUMN to_subscribe INTEGER DEFAULT 0 NOT NULL;
CREATE INDEX idx_connections_to_subscribe ON connections(to_subscribe);
|]
down_m20230903_connections_to_subscribe :: Query
down_m20230903_connections_to_subscribe =
[sql|
DROP INDEX idx_connections_to_subscribe;
ALTER TABLE connections DROP COLUMN to_subscribe;
|]

View File

@ -287,6 +287,7 @@ CREATE TABLE connections(
auth_err_counter INTEGER DEFAULT 0 CHECK(auth_err_counter NOT NULL),
peer_chat_min_version INTEGER NOT NULL DEFAULT 1,
peer_chat_max_version INTEGER NOT NULL DEFAULT 1,
to_subscribe INTEGER DEFAULT 0 NOT NULL,
FOREIGN KEY(snd_file_id, connection_id)
REFERENCES snd_files(file_id, connection_id)
ON DELETE CASCADE
@ -711,3 +712,4 @@ CREATE INDEX idx_chat_items_user_id_item_status ON chat_items(
user_id,
item_status
);
CREATE INDEX idx_connections_to_subscribe ON connections(to_subscribe);

View File

@ -1,4 +1,5 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
@ -6,25 +7,30 @@
module Simplex.Chat.Store.Connections
( getConnectionEntity,
getConnectionsToSubscribe,
unsetConnectionToSubscribe,
)
where
import Control.Applicative ((<|>))
import Control.Monad.Except
import Data.Int (Int64)
import Data.Maybe (fromMaybe)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Text (Text)
import Data.Time.Clock (UTCTime (..))
import Database.SQLite.Simple ((:.) (..))
import Database.SQLite.Simple (Only (..), (:.) (..))
import Database.SQLite.Simple.QQ (sql)
import Simplex.Chat.Store.Files
import Simplex.Chat.Store.Groups
import Simplex.Chat.Store.Profiles
import Simplex.Chat.Store.Shared
import Simplex.Chat.Protocol
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Messaging.Agent.Protocol (ConnId)
import Simplex.Messaging.Agent.Store.SQLite (firstRow, firstRow')
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Util (eitherToMaybe)
getConnectionEntity :: DB.Connection -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity
getConnectionEntity db user@User {userId, userContactId} agentConnId = do
@ -142,3 +148,17 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
userContact_ :: [(ConnReqContact, Maybe GroupId)] -> Either StoreError UserContact
userContact_ [(cReq, groupId)] = Right UserContact {userContactLinkId, connReqContact = cReq, groupId}
userContact_ _ = Left SEUserContactLinkNotFound
getConnectionsToSubscribe :: DB.Connection -> IO ([ConnId], [ConnectionEntity])
getConnectionsToSubscribe db = do
aConnIds <- map fromOnly <$> DB.query_ db "SELECT agent_conn_id FROM connections where to_subscribe = 1"
entities <- forM aConnIds $ \acId -> do
getUserByAConnId db acId >>= \case
Just user -> eitherToMaybe <$> runExceptT (getConnectionEntity db user acId)
Nothing -> pure Nothing
unsetConnectionToSubscribe db
let connIds = map (\(AgentConnId connId) -> connId) aConnIds
pure (connIds, catMaybes entities)
unsetConnectionToSubscribe :: DB.Connection -> IO ()
unsetConnectionToSubscribe db = DB.execute_ db "UPDATE connections SET to_subscribe = 0 WHERE to_subscribe = 1"

View File

@ -75,6 +75,7 @@ import Simplex.Chat.Types.Preferences
import Simplex.Messaging.Agent.Protocol (ConnId, InvitationId, UserId)
import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Version
getPendingContactConnection :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO PendingContactConnection
@ -109,8 +110,8 @@ deletePendingContactConnection db userId connId =
|]
(userId, connId, ConnContact)
createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> IO PendingContactConnection
createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId = do
createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> IO PendingContactConnection
createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId subMode = do
createdAt <- getCurrentTime
customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile
let pccConnStatus = ConnJoined
@ -119,10 +120,10 @@ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile grou
[sql|
INSERT INTO connections (
user_id, agent_conn_id, conn_status, conn_type,
via_contact_uri_hash, xcontact_id, custom_user_profile_id, via_group_link, group_link_id, created_at, updated_at
) VALUES (?,?,?,?,?,?,?,?,?,?,?)
via_contact_uri_hash, xcontact_id, custom_user_profile_id, via_group_link, group_link_id, created_at, updated_at, to_subscribe
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)
|]
((userId, acId, pccConnStatus, ConnContact, cReqHash, xContactId) :. (customUserProfileId, isJust groupLinkId, groupLinkId, createdAt, createdAt))
((userId, acId, pccConnStatus, ConnContact, cReqHash, xContactId) :. (customUserProfileId, isJust groupLinkId, groupLinkId, createdAt, createdAt, subMode == SMOnlyCreate))
pccConnId <- insertedRowId db
pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = True, viaUserContactLink = Nothing, groupLinkId, customUserProfileId, connReqInv = Nothing, localAlias = "", createdAt, updatedAt = createdAt}
@ -162,17 +163,17 @@ getConnReqContactXContactId db user@User {userId} cReqHash = do
"SELECT xcontact_id FROM connections WHERE user_id = ? AND via_contact_uri_hash = ? LIMIT 1"
(userId, cReqHash)
createDirectConnection :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> ConnStatus -> Maybe Profile -> IO PendingContactConnection
createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile = do
createDirectConnection :: DB.Connection -> User -> ConnId -> ConnReqInvitation -> ConnStatus -> Maybe Profile -> SubscriptionMode -> IO PendingContactConnection
createDirectConnection db User {userId} acId cReq pccConnStatus incognitoProfile subMode = do
createdAt <- getCurrentTime
customUserProfileId <- mapM (createIncognitoProfile_ db userId createdAt) incognitoProfile
DB.execute
db
[sql|
INSERT INTO connections
(user_id, agent_conn_id, conn_req_inv, conn_status, conn_type, custom_user_profile_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)
(user_id, agent_conn_id, conn_req_inv, conn_status, conn_type, custom_user_profile_id, created_at, updated_at, to_subscribe) VALUES (?,?,?,?,?,?,?,?,?)
|]
(userId, acId, cReq, pccConnStatus, ConnContact, customUserProfileId, createdAt, createdAt)
(userId, acId, cReq, pccConnStatus, ConnContact, customUserProfileId, createdAt, createdAt, subMode == SMOnlyCreate)
pccConnId <- insertedRowId db
pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = False, viaUserContactLink = Nothing, groupLinkId = Nothing, customUserProfileId, connReqInv = Just cReq, localAlias = "", createdAt, updatedAt = createdAt}
@ -587,8 +588,8 @@ deleteContactRequest db User {userId} contactRequestId = do
(userId, userId, contactRequestId)
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ?" (userId, contactRequestId)
createAcceptedContact :: DB.Connection -> User -> ConnId -> VersionRange -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> IO Contact
createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}} agentConnId cReqChatVRange localDisplayName profileId profile userContactLinkId xContactId incognitoProfile = do
createAcceptedContact :: DB.Connection -> User -> ConnId -> VersionRange -> ContactName -> ProfileId -> Profile -> Int64 -> Maybe XContactId -> Maybe IncognitoProfile -> SubscriptionMode -> IO Contact
createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}} agentConnId cReqChatVRange localDisplayName profileId profile userContactLinkId xContactId incognitoProfile subMode = do
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
createdAt <- getCurrentTime
customUserProfileId <- forM incognitoProfile $ \case
@ -600,7 +601,7 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences}
"INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, created_at, updated_at, chat_ts, xcontact_id) VALUES (?,?,?,?,?,?,?,?,?)"
(userId, localDisplayName, profileId, True, userPreferences, createdAt, createdAt, createdAt, xContactId)
contactId <- insertedRowId db
activeConn <- createConnection_ db userId ConnContact (Just contactId) agentConnId cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt
activeConn <- createConnection_ db userId ConnContact (Just contactId) agentConnId cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode
let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn
pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn, viaGroup = Nothing, contactUsed = False, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt}
@ -616,7 +617,7 @@ getContact_ :: DB.Connection -> User -> Int64 -> Bool -> ExceptT StoreError IO C
getContact_ db user@User {userId} contactId deleted =
ExceptT . fmap join . firstRow (toContactOrError user) (SEContactNotFound contactId) $
DB.query
db
db
[sql|
SELECT
-- Contact

View File

@ -100,6 +100,7 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
import qualified Simplex.Messaging.Crypto.File as CF
import Simplex.Messaging.Protocol (SubscriptionMode (..))
getLiveSndFileTransfers :: DB.Connection -> User -> IO [SndFileTransfer]
getLiveSndFileTransfers db User {userId} = do
@ -156,8 +157,8 @@ getPendingSndChunks db fileId connId =
|]
(fileId, connId)
createSndDirectFileTransfer :: DB.Connection -> UserId -> Contact -> FilePath -> FileInvitation -> Maybe ConnId -> Integer -> IO FileTransferMeta
createSndDirectFileTransfer db userId Contact {contactId} filePath FileInvitation {fileName, fileSize, fileInline} acId_ chunkSize = do
createSndDirectFileTransfer :: DB.Connection -> UserId -> Contact -> FilePath -> FileInvitation -> Maybe ConnId -> Integer -> SubscriptionMode -> IO FileTransferMeta
createSndDirectFileTransfer db userId Contact {contactId} filePath FileInvitation {fileName, fileSize, fileInline} acId_ chunkSize subMode = do
currentTs <- getCurrentTime
DB.execute
db
@ -165,7 +166,7 @@ createSndDirectFileTransfer db userId Contact {contactId} filePath FileInvitatio
((userId, contactId, fileName, filePath, fileSize, chunkSize) :. (fileInline, CIFSSndStored, FPSMP, currentTs, currentTs))
fileId <- insertedRowId db
forM_ acId_ $ \acId -> do
Connection {connId} <- createSndFileConnection_ db userId fileId acId
Connection {connId} <- createSndFileConnection_ db userId fileId acId subMode
let fileStatus = FSNew
DB.execute
db
@ -173,10 +174,10 @@ createSndDirectFileTransfer db userId Contact {contactId} filePath FileInvitatio
(fileId, fileStatus, fileInline, connId, currentTs, currentTs)
pure FileTransferMeta {fileId, xftpSndFile = Nothing, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
createSndDirectFTConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> IO ()
createSndDirectFTConnection db user@User {userId} fileId (cmdId, acId) = do
createSndDirectFTConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> SubscriptionMode -> IO ()
createSndDirectFTConnection db user@User {userId} fileId (cmdId, acId) subMode = do
currentTs <- getCurrentTime
Connection {connId} <- createSndFileConnection_ db userId fileId acId
Connection {connId} <- createSndFileConnection_ db userId fileId acId subMode
setCommandConnId db user cmdId connId
DB.execute
db
@ -193,10 +194,10 @@ createSndGroupFileTransfer db userId GroupInfo {groupId} filePath FileInvitation
fileId <- insertedRowId db
pure FileTransferMeta {fileId, xftpSndFile = Nothing, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
createSndGroupFileTransferConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> GroupMember -> IO ()
createSndGroupFileTransferConnection db user@User {userId} fileId (cmdId, acId) GroupMember {groupMemberId} = do
createSndGroupFileTransferConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> GroupMember -> SubscriptionMode -> IO ()
createSndGroupFileTransferConnection db user@User {userId} fileId (cmdId, acId) GroupMember {groupMemberId} subMode = do
currentTs <- getCurrentTime
Connection {connId} <- createSndFileConnection_ db userId fileId acId
Connection {connId} <- createSndFileConnection_ db userId fileId acId subMode
setCommandConnId db user cmdId connId
DB.execute
db
@ -422,10 +423,10 @@ getChatRefByFileId db User {userId} fileId =
|]
(userId, fileId)
createSndFileConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> IO Connection
createSndFileConnection_ db userId fileId agentConnId = do
createSndFileConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> SubscriptionMode -> IO Connection
createSndFileConnection_ db userId fileId agentConnId subMode = do
currentTs <- getCurrentTime
createConnection_ db userId ConnSndFile (Just fileId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs
createConnection_ db userId ConnSndFile (Just fileId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode
updateSndFileStatus :: DB.Connection -> SndFileTransfer -> FileStatus -> IO ()
updateSndFileStatus db SndFileTransfer {fileId, connId} status = do
@ -644,14 +645,14 @@ getRcvFileTransfer db User {userId} fileId = do
_ -> pure Nothing
cancelled = fromMaybe False cancelled_
acceptRcvFileTransfer :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> ConnStatus -> FilePath -> ExceptT StoreError IO AChatItem
acceptRcvFileTransfer db user@User {userId} fileId (cmdId, acId) connStatus filePath = ExceptT $ do
acceptRcvFileTransfer :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> ConnStatus -> FilePath -> SubscriptionMode -> ExceptT StoreError IO AChatItem
acceptRcvFileTransfer db user@User {userId} fileId (cmdId, acId) connStatus filePath subMode = ExceptT $ do
currentTs <- getCurrentTime
acceptRcvFT_ db user fileId filePath Nothing currentTs
DB.execute
db
"INSERT INTO connections (agent_conn_id, conn_status, conn_type, rcv_file_id, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
(acId, connStatus, ConnRcvFile, fileId, userId, currentTs, currentTs)
"INSERT INTO connections (agent_conn_id, conn_status, conn_type, rcv_file_id, user_id, created_at, updated_at, to_subscribe) VALUES (?,?,?,?,?,?,?,?)"
(acId, connStatus, ConnRcvFile, fileId, userId, currentTs, currentTs, subMode == SMOnlyCreate)
connId <- insertedRowId db
setCommandConnId db user cmdId connId
runExceptT $ getChatItemByFileId db user fileId

View File

@ -105,6 +105,7 @@ import Simplex.Messaging.Agent.Protocol (ConnId, UserId)
import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Protocol (SubscriptionMode)
import Simplex.Messaging.Util (eitherToMaybe)
import Simplex.Messaging.Version
import UnliftIO.STM
@ -135,8 +136,8 @@ toMaybeGroupMember userContactId ((Just groupMemberId, Just groupId, Just member
Just $ toGroupMember userContactId ((groupMemberId, groupId, memberId, memberRole, memberCategory, memberStatus) :. (invitedById, localDisplayName, memberContactId, memberContactProfileId, profileId, displayName, fullName, image, contactLink, localAlias, contactPreferences))
toMaybeGroupMember _ _ = Nothing
createGroupLink :: DB.Connection -> User -> GroupInfo -> ConnId -> ConnReqContact -> GroupLinkId -> GroupMemberRole -> ExceptT StoreError IO ()
createGroupLink db User {userId} groupInfo@GroupInfo {groupId, localDisplayName} agentConnId cReq groupLinkId memberRole =
createGroupLink :: DB.Connection -> User -> GroupInfo -> ConnId -> ConnReqContact -> GroupLinkId -> GroupMemberRole -> SubscriptionMode -> ExceptT StoreError IO ()
createGroupLink db User {userId} groupInfo@GroupInfo {groupId, localDisplayName} agentConnId cReq groupLinkId memberRole subMode =
checkConstraint (SEDuplicateGroupLink groupInfo) . liftIO $ do
currentTs <- getCurrentTime
DB.execute
@ -144,7 +145,7 @@ createGroupLink db User {userId} groupInfo@GroupInfo {groupId, localDisplayName}
"INSERT INTO user_contact_links (user_id, group_id, group_link_id, local_display_name, conn_req_contact, group_link_member_role, auto_accept, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
(userId, groupId, groupLinkId, "group_link_" <> localDisplayName, cReq, memberRole, True, currentTs, currentTs)
userContactLinkId <- insertedRowId db
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode
getGroupLinkConnection :: DB.Connection -> User -> GroupInfo -> ExceptT StoreError IO Connection
getGroupLinkConnection db User {userId} groupInfo@GroupInfo {groupId} =
@ -536,7 +537,7 @@ groupMemberQuery =
LEFT JOIN connections c ON c.connection_id = (
SELECT max(cc.connection_id)
FROM connections cc
where cc.user_id = ? AND cc.group_member_id = m.group_member_id
WHERE cc.user_id = ? AND cc.group_member_id = m.group_member_id
)
|]
@ -614,12 +615,12 @@ getGroupInvitation db user groupId =
firstRow fromOnly (SEGroupNotFound groupId) $
DB.query db "SELECT g.inv_queue_info FROM groups g WHERE g.group_id = ? AND g.user_id = ?" (groupId, userId)
createNewContactMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupId -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> ExceptT StoreError IO GroupMember
createNewContactMember db gVar User {userId, userContactId} groupId Contact {contactId, localDisplayName, profile, activeConn = Connection {peerChatVRange}} memberRole agentConnId connRequest =
createNewContactMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupId -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> SubscriptionMode -> ExceptT StoreError IO GroupMember
createNewContactMember db gVar User {userId, userContactId} groupId Contact {contactId, localDisplayName, profile, activeConn = Connection {peerChatVRange}} memberRole agentConnId connRequest subMode =
createWithRandomId gVar $ \memId -> do
createdAt <- liftIO getCurrentTime
member@GroupMember {groupMemberId} <- createMember_ (MemberId memId) createdAt
void $ createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 createdAt
void $ createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 createdAt subMode
pure member
where
createMember_ memberId createdAt = do
@ -654,13 +655,13 @@ createNewContactMember db gVar User {userId, userContactId} groupId Contact {con
:. (userId, localDisplayName, contactId, localProfileId profile, connRequest, createdAt, createdAt)
)
createNewContactMemberAsync :: DB.Connection -> TVar ChaChaDRG -> User -> GroupId -> Contact -> GroupMemberRole -> (CommandId, ConnId) -> VersionRange -> ExceptT StoreError IO ()
createNewContactMemberAsync db gVar user@User {userId, userContactId} groupId Contact {contactId, localDisplayName, profile} memberRole (cmdId, agentConnId) peerChatVRange =
createNewContactMemberAsync :: DB.Connection -> TVar ChaChaDRG -> User -> GroupId -> Contact -> GroupMemberRole -> (CommandId, ConnId) -> VersionRange -> SubscriptionMode -> ExceptT StoreError IO ()
createNewContactMemberAsync db gVar user@User {userId, userContactId} groupId Contact {contactId, localDisplayName, profile} memberRole (cmdId, agentConnId) peerChatVRange subMode =
createWithRandomId gVar $ \memId -> do
createdAt <- liftIO getCurrentTime
insertMember_ (MemberId memId) createdAt
groupMemberId <- liftIO $ insertedRowId db
Connection {connId} <- createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 createdAt
Connection {connId} <- createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 createdAt subMode
setCommandConnId db user cmdId connId
where
insertMember_ memberId createdAt =
@ -713,15 +714,15 @@ getMemberInvitation db User {userId} groupMemberId =
fmap join . maybeFirstRow fromOnly $
DB.query db "SELECT sent_inv_queue_info FROM group_members WHERE group_member_id = ? AND user_id = ?" (groupMemberId, userId)
createMemberConnection :: DB.Connection -> UserId -> GroupMember -> ConnId -> VersionRange -> IO ()
createMemberConnection db userId GroupMember {groupMemberId} agentConnId peerChatVRange = do
createMemberConnection :: DB.Connection -> UserId -> GroupMember -> ConnId -> VersionRange -> SubscriptionMode -> IO ()
createMemberConnection db userId GroupMember {groupMemberId} agentConnId peerChatVRange subMode = do
currentTs <- getCurrentTime
void $ createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 currentTs
void $ createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 currentTs subMode
createMemberConnectionAsync :: DB.Connection -> User -> GroupMemberId -> (CommandId, ConnId) -> VersionRange -> IO ()
createMemberConnectionAsync db user@User {userId} groupMemberId (cmdId, agentConnId) peerChatVRange = do
createMemberConnectionAsync :: DB.Connection -> User -> GroupMemberId -> (CommandId, ConnId) -> VersionRange -> SubscriptionMode -> IO ()
createMemberConnectionAsync db user@User {userId} groupMemberId (cmdId, agentConnId) peerChatVRange subMode = do
currentTs <- getCurrentTime
Connection {connId} <- createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 currentTs
Connection {connId} <- createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange Nothing 0 currentTs subMode
setCommandConnId db user cmdId connId
updateGroupMemberStatus :: DB.Connection -> UserId -> GroupMember -> GroupMemberStatus -> IO ()
@ -920,14 +921,14 @@ getIntroduction_ db reMember toMember = ExceptT $ do
in Right GroupMemberIntro {introId, reMember, toMember, introStatus, introInvitation}
toIntro _ = Left SEIntroNotFound
createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> ExceptT StoreError IO GroupMember
createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupMember {memberContactId, activeConn} memInfo@(MemberInfo _ _ memberChatVRange memberProfile) (groupCmdId, groupAgentConnId) directConnIds customUserProfileId = do
createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> ExceptT StoreError IO GroupMember
createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupMember {memberContactId, activeConn} memInfo@(MemberInfo _ _ memberChatVRange memberProfile) (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do
let mcvr = maybe chatInitialVRange fromChatVRange memberChatVRange
cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn
currentTs <- liftIO getCurrentTime
newMember <- case directConnIds of
Just (directCmdId, directAgentConnId) -> do
Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId mcvr memberContactId Nothing customUserProfileId cLevel currentTs
Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId mcvr memberContactId Nothing customUserProfileId cLevel currentTs subMode
liftIO $ setCommandConnId db user directCmdId directConnId
(localDisplayName, contactId, memProfileId) <- createContact_ db userId directConnId memberProfile "" (Just groupId) currentTs Nothing
pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, localDisplayName, memContactId = Just contactId, memProfileId}
@ -936,18 +937,18 @@ createIntroReMember db user@User {userId} gInfo@GroupInfo {groupId} _host@GroupM
pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memInvitedBy = IBUnknown, localDisplayName, memContactId = Nothing, memProfileId}
liftIO $ do
member <- createNewMember_ db user gInfo newMember currentTs
conn@Connection {connId = groupConnId} <- createMemberConnection_ db userId (groupMemberId' member) groupAgentConnId mcvr memberContactId cLevel currentTs
conn@Connection {connId = groupConnId} <- createMemberConnection_ db userId (groupMemberId' member) groupAgentConnId mcvr memberContactId cLevel currentTs subMode
liftIO $ setCommandConnId db user groupCmdId groupConnId
pure (member :: GroupMember) {activeConn = Just conn}
createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionRange -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> IO ()
createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = viaContactId, activeConn} _to@GroupMember {groupMemberId, localDisplayName} mcvr (groupCmdId, groupAgentConnId) directConnIds customUserProfileId = do
createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionRange -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> IO ()
createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = viaContactId, activeConn} _to@GroupMember {groupMemberId, localDisplayName} mcvr (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do
let cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn
currentTs <- getCurrentTime
Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId mcvr viaContactId cLevel currentTs
Connection {connId = groupConnId} <- createMemberConnection_ db userId groupMemberId groupAgentConnId mcvr viaContactId cLevel currentTs subMode
setCommandConnId db user groupCmdId groupConnId
forM_ directConnIds $ \(directCmdId, directAgentConnId) -> do
Connection {connId = directConnId} <- createConnection_ db userId ConnContact Nothing directAgentConnId mcvr viaContactId Nothing customUserProfileId cLevel currentTs
Connection {connId = directConnId} <- createConnection_ db userId ConnContact Nothing directAgentConnId mcvr viaContactId Nothing customUserProfileId cLevel currentTs subMode
setCommandConnId db user directCmdId directConnId
contactId <- createMemberContact_ directConnId currentTs
updateMember_ contactId currentTs
@ -977,7 +978,7 @@ createIntroToMemberContact db user@User {userId} GroupMember {memberContactId =
|]
[":contact_id" := contactId, ":updated_at" := ts, ":group_member_id" := groupMemberId]
createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> VersionRange -> Maybe Int64 -> Int -> UTCTime -> IO Connection
createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> VersionRange -> Maybe Int64 -> Int -> UTCTime -> SubscriptionMode -> IO Connection
createMemberConnection_ db userId groupMemberId agentConnId peerChatVRange viaContact = createConnection_ db userId ConnMember (Just groupMemberId) agentConnId peerChatVRange viaContact Nothing Nothing
getViaGroupMember :: DB.Connection -> User -> Contact -> IO (Maybe (GroupInfo, GroupMember))

View File

@ -78,6 +78,7 @@ import Simplex.Chat.Migrations.M20230721_group_snd_item_statuses
import Simplex.Chat.Migrations.M20230814_indexes
import Simplex.Chat.Migrations.M20230827_file_encryption
import Simplex.Chat.Migrations.M20230829_connections_chat_vrange
import Simplex.Chat.Migrations.M20230903_connections_to_subscribe
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@ -155,7 +156,8 @@ schemaMigrations =
("20230721_group_snd_item_statuses", m20230721_group_snd_item_statuses, Just down_m20230721_group_snd_item_statuses),
("20230814_indexes", m20230814_indexes, Just down_m20230814_indexes),
("20230827_file_encryption", m20230827_file_encryption, Just down_m20230827_file_encryption),
("20230829_connections_chat_vrange", m20230829_connections_chat_vrange, Just down_m20230829_connections_chat_vrange)
("20230829_connections_chat_vrange", m20230829_connections_chat_vrange, Just down_m20230829_connections_chat_vrange),
("20230903_connections_to_subscribe", m20230903_connections_to_subscribe, Just down_m20230903_connections_to_subscribe)
]
-- | The list of migrations in ascending order by date

View File

@ -80,7 +80,7 @@ import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI (..))
import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolTypeI (..), SubscriptionMode)
import Simplex.Messaging.Transport.Client (TransportHost)
import Simplex.Messaging.Util (safeDecodeUtf8)
@ -293,8 +293,8 @@ getUserContactProfiles db User {userId} =
toContactProfile :: (ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences) -> (Profile)
toContactProfile (displayName, fullName, image, contactLink, preferences) = Profile {displayName, fullName, image, contactLink, preferences}
createUserContactLink :: DB.Connection -> User -> ConnId -> ConnReqContact -> ExceptT StoreError IO ()
createUserContactLink db User {userId} agentConnId cReq =
createUserContactLink :: DB.Connection -> User -> ConnId -> ConnReqContact -> SubscriptionMode -> ExceptT StoreError IO ()
createUserContactLink db User {userId} agentConnId cReq subMode =
checkConstraint SEDuplicateContactLink . liftIO $ do
currentTs <- getCurrentTime
DB.execute
@ -302,7 +302,7 @@ createUserContactLink db User {userId} agentConnId cReq =
"INSERT INTO user_contact_links (user_id, conn_req_contact, created_at, updated_at) VALUES (?,?,?,?)"
(userId, cReq, currentTs, currentTs)
userContactLinkId <- insertedRowId db
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs
void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId chatInitialVRange Nothing Nothing Nothing 0 currentTs subMode
getUserAddressConnections :: DB.Connection -> User -> ExceptT StoreError IO [Connection]
getUserAddressConnections db User {userId} = do

View File

@ -36,6 +36,7 @@ import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, UserId)
import Simplex.Messaging.Agent.Store.SQLite (firstRow, maybeFirstRow)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
import Simplex.Messaging.Protocol (SubscriptionMode (..))
import Simplex.Messaging.Util (allFinally)
import Simplex.Messaging.Version
import UnliftIO.STM
@ -158,8 +159,8 @@ toMaybeConnection ((Just connId, Just agentConnId, Just connLevel, viaContact, v
Just $ toConnection ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, authErrCounter, minVer, maxVer))
toMaybeConnection _ = Nothing
createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> VersionRange -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> IO Connection
createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange minV maxV) viaContact viaUserContactLink customUserProfileId connLevel currentTs = do
createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> VersionRange -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> SubscriptionMode -> IO Connection
createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange minV maxV) viaContact viaUserContactLink customUserProfileId connLevel currentTs subMode = do
viaLinkGroupId :: Maybe Int64 <- fmap join . forM viaUserContactLink $ \ucLinkId ->
maybeFirstRow fromOnly $ DB.query db "SELECT group_id FROM user_contact_links WHERE user_id = ? AND user_contact_link_id = ? AND group_id IS NOT NULL" (userId, ucLinkId)
let viaGroupLink = isJust viaLinkGroupId
@ -169,12 +170,12 @@ createConnection_ db userId connType entityId acId peerChatVRange@(VersionRange
INSERT INTO connections (
user_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, custom_user_profile_id, conn_status, conn_type,
contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
peer_chat_min_version, peer_chat_max_version, to_subscribe
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, customUserProfileId, ConnNew, connType)
:. (ent ConnContact, ent ConnMember, ent ConnSndFile, ent ConnRcvFile, ent ConnUserContact, currentTs, currentTs)
:. (minV, maxV)
:. (minV, maxV, subMode == SMOnlyCreate)
)
connId <- insertedRowId db
pure Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType, entityId, viaContact, viaUserContactLink, viaGroupLink, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0}

View File

@ -49,7 +49,7 @@ extra-deps:
# - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
# - ../simplexmq
- github: simplex-chat/simplexmq
commit: 351f42650c57f310fc1ea858ff9b7178823f1fd4
commit: 0cabe0690beee90f460ad7bada72294222e7e109
- github: kazu-yamamoto/http2
commit: b5a1b7200cf5bc7044af34ba325284271f6dff25
# - ../direct-sqlcipher

View File

@ -57,6 +57,8 @@ chatDirectTests = do
it "start/stop/export/import chat" testMaintenanceMode
it "export/import chat with files" testMaintenanceModeWithFiles
it "encrypt/decrypt database" testDatabaseEncryption
describe "coordination between app and NSE" $ do
it "should not subscribe in NSE and subscribe in the app" testSubscribeAppNSE
describe "mute/unmute messages" $ do
it "mute/unmute contact" testMuteContact
it "mute/unmute group" testMuteGroup
@ -970,6 +972,35 @@ testDatabaseEncryption tmp = do
withTestChat tmp "alice" $ \alice -> do
testChatWorking alice bob
testSubscribeAppNSE :: HasCallStack => FilePath -> IO ()
testSubscribeAppNSE tmp =
withNewTestChat tmp "bob" bobProfile $ \bob -> do
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
withTestChatOpts tmp testOpts {maintenance = True} "alice" $ \nseAlice -> do
alice ##> "/_app suspend 1"
alice <## "ok"
alice <## "chat suspended"
nseAlice ##> "/_start subscribe=off expire=off xftp=off"
nseAlice <## "chat started"
nseAlice ##> "/ad"
cLink <- getContactLink nseAlice True
bob ##> ("/c " <> cLink)
bob <## "connection request sent!"
(nseAlice </)
alice ##> "/_app activate"
alice <## "ok"
alice <## "Your address is active! To show: /sa"
alice <## "bob (Bob) wants to connect to you!"
alice <## "to accept: /ac bob"
alice <## "to reject: /rc bob (the sender will NOT be notified)"
alice ##> "/ac bob"
alice <## "bob (Bob): accepting contact request..."
concurrently_
(bob <## "alice (Alice): contact is connected")
(alice <## "bob (Bob): contact is connected")
threadDelay 100000
alice <##> bob
testMuteContact :: HasCallStack => FilePath -> IO ()
testMuteContact =
testChat2 aliceProfile bobProfile $