From 3c2391dc32a09e17ed21b5cfafb61428cf5c5f51 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Mon, 9 Jun 2025 18:23:53 +0100 Subject: [PATCH] core: update simplexmq --- cabal.project | 2 +- scripts/nix/sha256map.nix | 2 +- src/Simplex/Chat/Controller.hs | 2 +- src/Simplex/Chat/Library/Commands.hs | 49 +++++++++++++++----------- src/Simplex/Chat/Library/Internal.hs | 19 +++++----- src/Simplex/Chat/Library/Subscriber.hs | 26 +++++++++----- tests/ChatClient.hs | 4 +-- 7 files changed, 60 insertions(+), 44 deletions(-) diff --git a/cabal.project b/cabal.project index c28777408c..212f0ef2c7 100644 --- a/cabal.project +++ b/cabal.project @@ -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 diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 49560e8a4a..cdaec76116 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -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"; diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 016a7f3dd2..92fc6ed19f 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -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} diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 5d1709a468..78c2d1cc4f 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -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 diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index bdc5e4b920..0f33c18a35 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -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 diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 80e287f414..42c4cbc4f8 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -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 diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 40dc2fee3d..9330e14aef 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -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 }