dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-05-14 03:55:20 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: update simplexmq

Browse Source
This commit is contained in:
Evgeny Poberezkin
2025-06-09 18:23:53 +01:00
parent cd47b409c8
commit 3c2391dc32
7 changed files with 60 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files
cabal.project
+1 -1
View File
@@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
source-repository-package
type: git
location: https://github.com/simplex-chat/simplexmq.git
tag: 8e86c97a1334e0627640192e215865187ba2a263
tag: 1e82104224e2e63c18a9d50d8e0b253f4842512c
source-repository-package
type: git
scripts/nix/sha256map.nix
+1 -1
View File
@@ -1,5 +1,5 @@
{
"https://github.com/simplex-chat/simplexmq.git"."8e86c97a1334e0627640192e215865187ba2a263" = "1h4933527x4jyjqlns91550g1kh8h5l7x1zkjqja5ra4hc29846y";
"https://github.com/simplex-chat/simplexmq.git"."1e82104224e2e63c18a9d50d8e0b253f4842512c" = "0qi8zxj94zch07h500980fyqqh5vjhvyy8i2swda2w5ky5jxljhy";
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
"https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
"https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";
src/Simplex/Chat/Controller.hs
+1 -1
View File
@@ -737,7 +737,7 @@ data ChatResponse
| CRArchiveImported {archiveErrors :: [ArchiveError]}
| CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]}
#endif
| CRDebugLocks {chatLockName :: Maybe String, chatEntityLocks :: Map String String, agentLocks :: AgentLocks}
| CRDebugLocks {chatLockName :: Maybe Text, chatEntityLocks :: Map Text Text, agentLocks :: AgentLocks}
| CRAgentSubsTotal {user :: User, subsTotal :: SMPServerSubs, hasSession :: Bool}
| CRAgentServersSummary {user :: User, serversSummary :: PresentedServersSummary}
| CRAgentWorkersDetails {agentWorkersDetails :: AgentWorkersDetails}
src/Simplex/Chat/Library/Commands.hs
+28 -21
View File
@@ -1667,7 +1667,8 @@ processChatCommand' vr = \case
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
subMode <- chatReadVar subscriptionMode
let userData = shortLinkUserData short
(connId, ccLink) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation userData Nothing IKPQOn subMode
-- TODO [certs rcv]
(connId, (ccLink, _serviceId)) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation userData Nothing IKPQOn subMode
ccLink' <- shortenCreatedLink ccLink
-- TODO PQ pass minVersion from the current range
conn <- withFastStore' $ \db -> createDirectConnection db user connId ccLink' ConnNew incognitoProfile subMode initialChatVersion PQSupportOn
@@ -1717,7 +1718,8 @@ processChatCommand' vr = \case
recreateConn user conn@PendingContactConnection {customUserProfileId, connLinkInv} newUser = do
subMode <- chatReadVar subscriptionMode
let userData = shortLinkUserData $ isJust $ connShortLink =<< connLinkInv
(agConnId, ccLink) <- withAgent $ \a -> createConnection a (aUserId newUser) True SCMInvitation userData Nothing IKPQOn subMode
-- TODO [certs rcv]
(agConnId, (ccLink, _serviceId)) <- withAgent $ \a -> createConnection a (aUserId newUser) True SCMInvitation userData Nothing IKPQOn subMode
ccLink' <- shortenCreatedLink ccLink
conn' <- withFastStore' $ \db -> do
deleteConnectionRecord db user connId
@@ -1790,7 +1792,8 @@ processChatCommand' vr = \case
APICreateMyAddress userId short -> withUserId userId $ \user -> procCmd $ do
subMode <- chatReadVar subscriptionMode
let userData = shortLinkUserData short
(connId, ccLink) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact userData Nothing IKPQOn subMode
-- TODO [certs rcv]
(connId, (ccLink, _serviceId)) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact userData Nothing IKPQOn subMode
ccLink' <- shortenCreatedLink ccLink
withFastStore $ \db -> createUserContactLink db user connId ccLink' subMode
pure $ CRUserContactLinkCreated user ccLink'
@@ -2007,7 +2010,8 @@ processChatCommand' vr = \case
Nothing -> do
gVar <- asks random
subMode <- chatReadVar subscriptionMode
(agentConnId, CCLink cReq _) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing Nothing IKPQOff subMode
-- TODO [certs rcv]
(agentConnId, (CCLink cReq _, _serviceId)) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing Nothing IKPQOff subMode
member <- withFastStore $ \db -> createNewContactMember db gVar user gInfo contact memRole agentConnId cReq subMode
sendInvitation member cReq
pure $ CRSentGroupInvitation user gInfo contact member
@@ -2396,7 +2400,8 @@ processChatCommand' vr = \case
subMode <- chatReadVar subscriptionMode
let crClientData = encodeJSON $ CRDataGroup groupLinkId
userData = shortLinkUserData short
(connId, ccLink) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact userData (Just crClientData) IKPQOff subMode
-- TODO [certs rcv]
(connId, (ccLink, _serviceId)) <- withAgent $ \a -> createConnection a (aUserId user) True SCMContact userData (Just crClientData) IKPQOff subMode
ccLink' <- createdGroupLink <$> shortenCreatedLink ccLink
withFastStore $ \db -> createGroupLink db user gInfo connId ccLink' groupLinkId mRole subMode
pure $ CRGroupLinkCreated user gInfo ccLink' mRole
@@ -2437,7 +2442,8 @@ processChatCommand' vr = \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 (aUserId user) True SCMInvitation Nothing Nothing IKPQOff subMode
-- TODO [certs rcv]
(connId, (CCLink cReq _, _serviceId)) <- withAgent $ \a -> createConnection a (aUserId user) True SCMInvitation Nothing Nothing IKPQOff subMode
-- [incognito] reuse membership incognito profile
ct <- withFastStore' $ \db -> createMemberContact db user connId cReq g m mConn subMode
-- TODO not sure it is correct to set connections status here?
@@ -2689,12 +2695,12 @@ processChatCommand' vr = \case
where
getLocks ls = atomically $ M.mapKeys enityLockString . M.mapMaybe id <$> (mapM tryReadTMVar =<< readTVar ls)
enityLockString cle = case cle of
CLInvitation bs -> "Invitation " <> B.unpack bs
CLConnection connId -> "Connection " <> show connId
CLContact ctId -> "Contact " <> show ctId
CLGroup gId -> "Group " <> show gId
CLUserContact ucId -> "UserContact " <> show ucId
CLFile fId -> "File " <> show fId
CLInvitation bs -> "Invitation " <> safeDecodeUtf8 bs
CLConnection connId -> "Connection " <> tshow connId
CLContact ctId -> "Contact " <> tshow ctId
CLGroup gId -> "Group " <> tshow gId
CLUserContact ucId -> "UserContact " <> tshow ucId
CLFile fId -> "File " <> tshow fId
DebugEvent event -> toView event >> ok_
GetAgentSubsTotal userId -> withUserId userId $ \user -> do
users <- withStore' $ \db -> getUsers db
@@ -3719,8 +3725,9 @@ agentSubscriber = do
where
run action = action `catchChatError'` (eToView')
type AgentBatchSubscribe = AgentClient -> [ConnId] -> ExceptT AgentErrorType IO (Map ConnId (Either AgentErrorType ()))
type AgentBatchSubscribe = AgentClient -> [ConnId] -> ExceptT AgentErrorType IO (Map ConnId (Either AgentErrorType (Maybe ClientServiceId)))
-- TODO [certs rcv]
subscribeUserConnections :: VersionRangeChat -> Bool -> AgentBatchSubscribe -> User -> CM ()
subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do
-- get user connections
@@ -3814,7 +3821,7 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do
pcs <- withStore_ getPendingContactConnections
let connIds = map aConnId' pcs
pure (connIds, M.fromList $ zip connIds pcs)
contactSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId Contact -> Bool -> CM ()
contactSubsToView :: Map ConnId (Either AgentErrorType (Maybe ClientServiceId)) -> Map ConnId Contact -> Bool -> CM ()
contactSubsToView rs cts ce = do
chatModifyVar connNetworkStatuses $ M.union (M.fromList statuses)
ifM (asks $ coreApi . config) (notifyAPI statuses) notifyCLI
@@ -3840,9 +3847,9 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do
ChatErrorAgent (SMP _ SMP.AUTH) _ -> "contact deleted"
e -> show e
-- TODO possibly below could be replaced with less noisy events for API
contactLinkSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId UserContact -> CM ()
contactLinkSubsToView :: Map ConnId (Either AgentErrorType (Maybe ClientServiceId)) -> Map ConnId UserContact -> CM ()
contactLinkSubsToView rs = toView . CEvtUserContactSubSummary user . map (uncurry UserContactSubStatus) . resultsFor rs
groupSubsToView :: Map ConnId (Either AgentErrorType ()) -> [ShortGroup] -> Map ConnId ShortGroupMember -> Bool -> CM ()
groupSubsToView :: Map ConnId (Either AgentErrorType (Maybe ClientServiceId)) -> [ShortGroup] -> Map ConnId ShortGroupMember -> Bool -> CM ()
groupSubsToView rs gs ms ce = do
mapM_ groupSub $
sortOn (\(ShortGroup ShortGroupInfo {groupName = g} _) -> g) gs
@@ -3864,7 +3871,7 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do
| membershipStatus == GSMemInvited = TEGroupInvitation user g
| null members = TEGroupEmpty user g
| otherwise = TEGroupSubscribed user g
sndFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId SndFileTransfer -> CM ()
sndFileSubsToView :: Map ConnId (Either AgentErrorType (Maybe ClientServiceId)) -> Map ConnId SndFileTransfer -> CM ()
sndFileSubsToView rs sfts = do
let sftRs = resultsFor rs sfts
forM_ sftRs $ \(ft@SndFileTransfer {fileId, fileStatus}, err_) -> do
@@ -3873,20 +3880,20 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do
threadDelay 1000000
when (fileStatus == FSConnected) . unlessM (isFileActive fileId sndFiles) . withChatLock "subscribe sendFileChunk" $
sendFileChunk user ft
rcvFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId RcvFileTransfer -> CM ()
rcvFileSubsToView :: Map ConnId (Either AgentErrorType (Maybe ClientServiceId)) -> Map ConnId RcvFileTransfer -> CM ()
rcvFileSubsToView rs = mapM_ (toViewTE . uncurry (TERcvFileSubError user)) . filterErrors . resultsFor rs
pendingConnSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId PendingContactConnection -> CM ()
pendingConnSubsToView :: Map ConnId (Either AgentErrorType (Maybe ClientServiceId)) -> Map ConnId PendingContactConnection -> CM ()
pendingConnSubsToView rs = toViewTE . TEPendingSubSummary user . map (uncurry PendingSubStatus) . resultsFor rs
withStore_ :: (DB.Connection -> User -> IO [a]) -> CM [a]
withStore_ a = withStore' (`a` user) `catchChatError` \e -> eToView e $> []
filterErrors :: [(a, Maybe ChatError)] -> [(a, ChatError)]
filterErrors = mapMaybe (\(a, e_) -> (a,) <$> e_)
resultsFor :: Map ConnId (Either AgentErrorType ()) -> Map ConnId a -> [(a, Maybe ChatError)]
resultsFor :: Map ConnId (Either AgentErrorType (Maybe ClientServiceId)) -> Map ConnId a -> [(a, Maybe ChatError)]
resultsFor rs = M.foldrWithKey' addResult []
where
addResult :: ConnId -> a -> [(a, Maybe ChatError)] -> [(a, Maybe ChatError)]
addResult connId = (:) . (,resultErr connId rs)
resultErr :: ConnId -> Map ConnId (Either AgentErrorType ()) -> Maybe ChatError
resultErr :: ConnId -> Map ConnId (Either AgentErrorType (Maybe ClientServiceId)) -> Maybe ChatError
resultErr connId rs = case M.lookup connId rs of
Just (Left e) -> Just $ ChatErrorAgent e Nothing
Just _ -> Nothing
src/Simplex/Chat/Library/Internal.hs
+10 -9
View File
@@ -111,37 +111,37 @@ maxRcvMentions = 5
maxSndMentions :: Int
maxSndMentions = 3
withChatLock :: String -> CM a -> CM a
withChatLock :: Text -> CM a -> CM a
withChatLock name action = asks chatLock >>= \l -> withLock l name action
withEntityLock :: String -> ChatLockEntity -> CM a -> CM a
withEntityLock :: Text -> ChatLockEntity -> CM a -> CM a
withEntityLock name entity action = do
chatLock <- asks chatLock
ls <- asks entityLocks
atomically $ unlessM (isEmptyTMVar chatLock) retry
withLockMap ls entity name action
withInvitationLock :: String -> ByteString -> CM a -> CM a
withInvitationLock :: Text -> ByteString -> CM a -> CM a
withInvitationLock name = withEntityLock name . CLInvitation
{-# INLINE withInvitationLock #-}
withConnectionLock :: String -> Int64 -> CM a -> CM a
withConnectionLock :: Text -> Int64 -> CM a -> CM a
withConnectionLock name = withEntityLock name . CLConnection
{-# INLINE withConnectionLock #-}
withContactLock :: String -> ContactId -> CM a -> CM a
withContactLock :: Text -> ContactId -> CM a -> CM a
withContactLock name = withEntityLock name . CLContact
{-# INLINE withContactLock #-}
withGroupLock :: String -> GroupId -> CM a -> CM a
withGroupLock :: Text -> GroupId -> CM a -> CM a
withGroupLock name = withEntityLock name . CLGroup
{-# INLINE withGroupLock #-}
withUserContactLock :: String -> Int64 -> CM a -> CM a
withUserContactLock :: Text -> Int64 -> CM a -> CM a
withUserContactLock name = withEntityLock name . CLUserContact
{-# INLINE withUserContactLock #-}
withFileLock :: String -> Int64 -> CM a -> CM a
withFileLock :: Text -> Int64 -> CM a -> CM a
withFileLock name = withEntityLock name . CLFile
{-# INLINE withFileLock #-}
@@ -889,7 +889,8 @@ acceptContactRequest user@User {userId} UserContactRequest {agentInvitationId =
pure (ct, conn, ExistingIncognito <$> incognitoProfile)
let profileToSend = profileToSendOnAccept user incognitoProfile False
dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend
(ct,conn,) <$> withAgent (\a -> acceptContact a (aConnId conn) True invId dm pqSup' subMode)
-- TODO [certs rcv]
(ct,conn,) . fst <$> withAgent (\a -> acceptContact a (aConnId conn) True invId dm pqSup' subMode)
acceptContactRequestAsync :: User -> UserContactRequest -> Maybe IncognitoProfile -> PQSupport -> CM Contact
acceptContactRequestAsync user cReq@UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile pqSup = do
src/Simplex/Chat/Library/Subscriber.hs
+17 -9
View File
@@ -385,7 +385,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
agentMsgConnStatus :: AEvent e -> Maybe ConnStatus
agentMsgConnStatus = \case
JOINED True -> Just ConnSndReady
JOINED True _ -> Just ConnSndReady
CONF {} -> Just ConnRequested
INFO {} -> Just ConnSndReady
CON _ -> Just ConnReady
@@ -430,7 +430,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
OK ->
-- [async agent commands] continuation on receiving OK
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
JOINED _ ->
-- TODO [certs rcv]
JOINED _ _serviceId ->
-- [async agent commands] continuation on receiving JOINED
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
QCONT ->
@@ -449,7 +450,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
-- TODO add debugging output
_ -> pure ()
Just ct@Contact {contactId} -> case agentMsg of
INV (ACR _ cReq) ->
-- TODO [certs rcv]
INV (ACR _ cReq) _serviceId ->
-- [async agent commands] XGrpMemIntro continuation on receiving INV
withCompletedCommand conn agentMsg $ \_ ->
case cReq of
@@ -638,7 +640,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
OK ->
-- [async agent commands] continuation on receiving OK
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
JOINED sqSecured ->
-- TODO [certs rcv]
JOINED sqSecured _serviceId ->
-- [async agent commands] continuation on receiving JOINED
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData ->
when (directOrUsed ct && sqSecured) $ do
@@ -676,7 +679,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
processGroupMessage :: AEvent e -> ConnectionEntity -> Connection -> GroupInfo -> GroupMember -> CM ()
processGroupMessage agentMsg connEntity conn@Connection {connId, connChatVersion, connectionCode} gInfo@GroupInfo {groupId, groupProfile, membership, chatSettings} m = case agentMsg of
INV (ACR _ cReq) ->
-- TODO [certs rcv]
INV (ACR _ cReq) _serviceId ->
withCompletedCommand conn agentMsg $ \CommandData {cmdFunction} ->
case cReq of
groupConnReq@(CRInvitationUri _ _) -> case cmdFunction of
@@ -981,7 +985,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
OK ->
-- [async agent commands] continuation on receiving OK
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
JOINED sqSecured ->
-- TODO [certs rcv]
JOINED sqSecured _serviceId ->
-- [async agent commands] continuation on receiving JOINED
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData ->
when (sqSecured && connChatVersion >= batchSend2Version) sendGroupAutoReply
@@ -1095,7 +1100,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
OK ->
-- [async agent commands] continuation on receiving OK
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
JOINED _ ->
-- TODO [certs rcv]
JOINED _ _serviceId->
-- [async agent commands] continuation on receiving JOINED
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
ERR err -> do
@@ -1107,7 +1113,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
processRcvFileConn :: AEvent e -> ConnectionEntity -> Connection -> RcvFileTransfer -> CM ()
processRcvFileConn agentMsg connEntity conn ft@RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}, grpMemberId} =
case agentMsg of
INV (ACR _ cReq) ->
-- TODO [certs rcv]
INV (ACR _ cReq) _serviceId ->
withCompletedCommand conn agentMsg $ \CommandData {cmdFunction} ->
case cReq of
fileInvConnReq@(CRInvitationUri _ _) -> case cmdFunction of
@@ -1144,7 +1151,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
OK ->
-- [async agent commands] continuation on receiving OK
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
JOINED _ ->
-- TODO [certs rcv]
JOINED _ _serviceId ->
-- [async agent commands] continuation on receiving JOINED
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
MERR _ err -> do
tests/ChatClient.hs
+2 -2
View File
@@ -529,7 +529,7 @@ smpServerCfg =
pendingENDInterval = 500000,
ntfDeliveryInterval = 200000,
smpServerVRange = supportedServerSMPRelayVRange,
transportConfig = mkTransportServerConfig True $ Just alpnSupportedSMPHandshakes,
transportConfig = mkTransportServerConfig True (Just alpnSupportedSMPHandshakes) True,
smpHandshakeTimeout = 1000000,
controlPort = Nothing,
smpAgentCfg = defaultSMPClientAgentConfig,
@@ -582,7 +582,7 @@ xftpServerConfig =
serverStatsLogFile = "tests/tmp/xftp-server-stats.daily.log",
serverStatsBackupFile = Nothing,
controlPort = Nothing,
transportConfig = mkTransportServerConfig True $ Just alpnSupportedXFTPhandshakes,
transportConfig = mkTransportServerConfig True (Just alpnSupportedXFTPhandshakes) False,
responseDelay = 0
}