From 8497d4ff483341a4c710ad015701ec94d09f0d44 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Fri, 3 Oct 2025 11:05:30 +0000 Subject: [PATCH] core: update group short link data on receiving x.grp.info (#6328) --- src/Simplex/Chat/Library/Commands.hs | 51 ++-------------------- src/Simplex/Chat/Library/Internal.hs | 58 +++++++++++++++++++++++++- src/Simplex/Chat/Library/Subscriber.hs | 4 +- tests/ChatTests/Profiles.hs | 39 +++++++++++++++++ 4 files changed, 102 insertions(+), 50 deletions(-) diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 47a4546698..47c4dbe46d 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -17,7 +17,6 @@ module Simplex.Chat.Library.Commands where -import qualified Codec.Compression.Zstd as Z1 import Control.Applicative (optional, (<|>)) import Control.Concurrent.STM (retry) import Control.Logger.Simple @@ -97,7 +96,6 @@ import Simplex.Messaging.Agent.Store.Shared (upMigration) import qualified Simplex.Messaging.Agent.Store.DB as DB import Simplex.Messaging.Agent.Store.Interface (getCurrentMigrations) import Simplex.Messaging.Client (NetworkConfig (..), NetworkRequestMode (..), NetworkTimeout (..), SMPWebPortServers (..), SocksMode (SMAlways), textToHostMode) -import Simplex.Messaging.Compression (compressionLevel) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) import qualified Simplex.Messaging.Crypto.File as CF @@ -2645,7 +2643,8 @@ processChatCommand vr nm = \case gInfo <- getGroupInfo db vr user groupId gLink <- getGroupLink db user gInfo pure (gInfo, gLink) - setGroupLinkData user gInfo gLink + gLink' <- setGroupLinkData nm user gInfo gLink + pure $ CRGroupLink user gInfo gLink' APICreateMemberContact gId gMemberId -> withUser $ \user -> do (g, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user gId <*> getGroupMember db vr user gId gMemberId assertUserGroupRole g GRAuthor @@ -3319,7 +3318,7 @@ processChatCommand vr nm = \case recipients = filter memberCurrentOrPending newMs sendGroupMessage user gInfo' Nothing recipients $ XGrpPrefs ps' Nothing -> do - setGroupLinkData' + setGroupLinkData' nm user gInfo' recipients <- getRecipients sendGroupMessage user gInfo' Nothing recipients (XGrpInfo p') where @@ -3328,26 +3327,12 @@ processChatCommand vr nm = \case | otherwise = do ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo' pure $ filter memberCurrentOrPending ms - setGroupLinkData' :: CM () - setGroupLinkData' = - withFastStore' (\db -> runExceptT $ getGroupLink db user gInfo') >>= \case - Right gLink@GroupLink {shortLinkDataSet} - | shortLinkDataSet -> void $ setGroupLinkData user gInfo' gLink - _ -> pure () let cd = CDGroupSnd gInfo' Nothing unless (sameGroupProfileInfo p p') $ do ci <- saveSndChatItem user cd msg (CISndGroupEvent $ SGEGroupUpdated p') toView $ CEvtNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo' Nothing) ci] createGroupFeatureChangedItems user cd CISndGroupFeature gInfo gInfo' pure $ CRGroupUpdated user gInfo gInfo' Nothing - setGroupLinkData :: User -> GroupInfo -> GroupLink -> CM ChatResponse - setGroupLinkData user gInfo@GroupInfo {groupProfile} gLink@GroupLink {groupLinkId} = do - conn <- withFastStore $ \db -> getGroupLinkConnection db vr user gInfo - let userData = encodeShortLinkData $ GroupShortLinkData groupProfile - crClientData = encodeJSON $ CRDataGroup groupLinkId - sLnk <- shortenShortLink' . toShortGroupLink =<< withAgent (\a -> setConnShortLink a nm (aConnId conn) SCMContact userData (Just crClientData)) - gLink' <- withFastStore' $ \db -> setGroupLinkShortLink db gLink sLnk - pure $ CRGroupLink user gInfo gLink' checkValidName :: GroupName -> CM () checkValidName displayName = do when (T.null displayName) $ throwChatError CEInvalidDisplayName {displayName, validName = ""} @@ -3717,41 +3702,11 @@ processChatCommand vr nm = \case business = maybe False businessAddress settings contactData = ContactShortLinkData p msg business in encodeShortLinkData contactData - encodeShortLinkData :: J.ToJSON a => a -> UserLinkData - encodeShortLinkData d = - let s = LB.toStrict $ J.encode d - -- 10kb size limit for compression to be used is based on 13784 limit for link data - -- and the space reserved for the other fields in ConnLinkData encoding (most of these fields are currently unused). - s' - | B.length s > 10240 = B.cons 'X' $ Z1.compress compressionLevel s - | otherwise = s - in UserLinkData s' - decodeShortLinkData :: J.FromJSON a => ConnLinkData c -> IO (Maybe a) - decodeShortLinkData cData - | B.null s = pure Nothing - | B.head s == 'X' = case Z1.decompress $ B.drop 1 s of - Z1.Error e -> Nothing <$ logError ("Error decompressing link data: " <> tshow e) - Z1.Skip -> pure Nothing - Z1.Decompress s' -> decode s' - | otherwise = decode s - where - decode s' = case J.eitherDecodeStrict s' of - Right d -> pure $ Just d - Left e -> Nothing <$ logError ("Error decoding link data: " <> tshow e) - s = linkUserData' cData updatePCCShortLinkData :: PendingContactConnection -> Profile -> CM (Maybe ShortLinkInvitation) updatePCCShortLinkData conn@PendingContactConnection {connLinkInv} profile = forM (connShortLink =<< connLinkInv) $ \_ -> do let userData = contactShortLinkData profile Nothing shortenShortLink' =<< withAgent (\a -> setConnShortLink a nm (aConnId' conn) SCMInvitation userData Nothing) - shortenShortLink' :: ConnShortLink m -> CM (ConnShortLink m) - shortenShortLink' l = (`shortenShortLink` l) <$> asks (shortLinkPresetServers . config) - shortenCreatedLink :: CreatedConnLink m -> CM (CreatedConnLink m) - shortenCreatedLink (CCLink cReq sLnk) = CCLink cReq <$> mapM shortenShortLink' sLnk - createdGroupLink :: CreatedLinkContact -> CreatedLinkContact - createdGroupLink (CCLink cReq shortLink) = CCLink cReq (toShortGroupLink <$> shortLink) - toShortGroupLink :: ShortLinkContact -> ShortLinkContact - toShortGroupLink (CSLContact sch _ srv k) = CSLContact sch CCTGroup srv k updateCIGroupInvitationStatus :: User -> GroupInfo -> CIGroupInvitationStatus -> CM () updateCIGroupInvitationStatus user GroupInfo {groupId} newStatus = do AChatItem _ _ cInfo ChatItem {content, meta = CIMeta {itemId}} <- withFastStore $ \db -> getChatItemByGroupId db vr user groupId diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index a36e943fd5..4177dc6984 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -18,6 +18,7 @@ module Simplex.Chat.Library.Internal where +import qualified Codec.Compression.Zstd as Z1 import Control.Applicative ((<|>)) import Control.Concurrent.STM (retry) import Control.Logger.Simple @@ -26,9 +27,11 @@ import Control.Monad.Except import Control.Monad.IO.Unlift import Control.Monad.Reader import Crypto.Random (ChaChaDRG) +import qualified Data.Aeson as J import Data.Bifunctor (first) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy.Char8 as LB import Data.Char (isDigit) import Data.Containers.ListUtils (nubOrd) import Data.Either (partitionEithers, rights) @@ -84,7 +87,8 @@ import Simplex.Messaging.Agent.Lock (withLock) import Simplex.Messaging.Agent.Protocol import qualified Simplex.Messaging.Agent.Protocol as AP (AgentErrorType (..)) import qualified Simplex.Messaging.Agent.Store.DB as DB -import Simplex.Messaging.Client (NetworkConfig (..), NetworkRequestMode) +import Simplex.Messaging.Client (NetworkConfig (..), NetworkRequestMode (..)) +import Simplex.Messaging.Compression (compressionLevel) import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) import qualified Simplex.Messaging.Crypto.File as CF import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) @@ -1188,6 +1192,58 @@ splitFileDescr partSize rfdText = splitParts 1 rfdText then fileDescr :| [] else fileDescr <| splitParts (partNo + 1) rest +setGroupLinkData' :: NetworkRequestMode -> User -> GroupInfo -> CM () +setGroupLinkData' nm user gInfo = + withFastStore' (\db -> runExceptT $ getGroupLink db user gInfo) >>= \case + Right gLink@GroupLink {shortLinkDataSet} + | shortLinkDataSet -> void $ setGroupLinkData nm user gInfo gLink + _ -> pure () + +setGroupLinkData :: NetworkRequestMode -> User -> GroupInfo -> GroupLink -> CM GroupLink +setGroupLinkData nm user gInfo@GroupInfo {groupProfile} gLink@GroupLink {groupLinkId} = do + vr <- chatVersionRange + conn <- withFastStore $ \db -> getGroupLinkConnection db vr user gInfo + let userData = encodeShortLinkData $ GroupShortLinkData groupProfile + crClientData = encodeJSON $ CRDataGroup groupLinkId + sLnk <- shortenShortLink' . toShortGroupLink =<< withAgent (\a -> setConnShortLink a nm (aConnId conn) SCMContact userData (Just crClientData)) + withFastStore' $ \db -> setGroupLinkShortLink db gLink sLnk + +encodeShortLinkData :: J.ToJSON a => a -> UserLinkData +encodeShortLinkData d = + let s = LB.toStrict $ J.encode d + -- 10kb size limit for compression to be used is based on 13784 limit for link data + -- and the space reserved for the other fields in ConnLinkData encoding (most of these fields are currently unused). + s' + | B.length s > 10240 = B.cons 'X' $ Z1.compress compressionLevel s + | otherwise = s + in UserLinkData s' + +decodeShortLinkData :: J.FromJSON a => ConnLinkData c -> IO (Maybe a) +decodeShortLinkData cData + | B.null s = pure Nothing + | B.head s == 'X' = case Z1.decompress $ B.drop 1 s of + Z1.Error e -> Nothing <$ logError ("Error decompressing link data: " <> tshow e) + Z1.Skip -> pure Nothing + Z1.Decompress s' -> decode s' + | otherwise = decode s + where + decode s' = case J.eitherDecodeStrict s' of + Right d -> pure $ Just d + Left e -> Nothing <$ logError ("Error decoding link data: " <> tshow e) + s = linkUserData' cData + +shortenShortLink' :: ConnShortLink m -> CM (ConnShortLink m) +shortenShortLink' l = (`shortenShortLink` l) <$> asks (shortLinkPresetServers . config) + +shortenCreatedLink :: CreatedConnLink m -> CM (CreatedConnLink m) +shortenCreatedLink (CCLink cReq sLnk) = CCLink cReq <$> mapM shortenShortLink' sLnk + +createdGroupLink :: CreatedLinkContact -> CreatedLinkContact +createdGroupLink (CCLink cReq shortLink) = CCLink cReq (toShortGroupLink <$> shortLink) + +toShortGroupLink :: ShortLinkContact -> ShortLinkContact +toShortGroupLink (CSLContact sch _ srv k) = CSLContact sch CCTGroup srv k + deleteGroupLink' :: User -> GroupInfo -> CM () deleteGroupLink' user gInfo = do vr <- chatVersionRange diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index fd2e41be07..15980ce585 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -75,7 +75,7 @@ import Simplex.Messaging.Agent.Env.SQLite (Worker (..)) import Simplex.Messaging.Agent.Protocol import qualified Simplex.Messaging.Agent.Protocol as AP (AgentErrorType (..)) import qualified Simplex.Messaging.Agent.Store.DB as DB -import Simplex.Messaging.Client (ProxyClientError (..)) +import Simplex.Messaging.Client (ProxyClientError (..), NetworkRequestMode (..)) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..)) import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) @@ -89,6 +89,7 @@ import Simplex.Messaging.Util import Simplex.Messaging.Version import qualified System.FilePath as FP import Text.Read (readMaybe) +import UnliftIO.Concurrent (forkIO) import UnliftIO.Directory import UnliftIO.STM @@ -2869,6 +2870,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = (ci, cInfo) <- saveRcvChatItemNoParse user cd msg brokerTs (CIRcvGroupEvent $ RGEGroupUpdated p') groupMsgToView cInfo ci createGroupFeatureChangedItems user cd CIRcvGroupFeature g g'' + void $ forkIO $ setGroupLinkData' NRMBackground user g'' Just _ -> updateGroupPrefs_ g m $ fromMaybe defaultBusinessGroupPrefs $ groupPreferences p' pure $ Just DJSGroup {jobSpec = DJDeliveryJob {includePending = True}} diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index c09440ff89..73e6fc8f07 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -142,6 +142,7 @@ shortLinkTests = do it "changing profile should update address short link data" testShortLinkAddressChangeProfile it "changing auto-reply message should update address short link data" testShortLinkAddressChangeAutoReply it "changing group profile should update short link data" testShortLinkGroupChangeProfile + it "receiving group profile update should update short link data" testShortLinkGroupChangeProfileReceived testUpdateProfile :: HasCallStack => TestParams -> IO () testUpdateProfile = @@ -4149,3 +4150,41 @@ testShortLinkGroupChangeProfile = testChat3 aliceProfile bobProfile cathProfile [alice, cath] *<# "#club bob> 2" cath #> "#club 3" [alice, bob] *<# "#club cath> 3" + +testShortLinkGroupChangeProfileReceived :: HasCallStack => TestParams -> IO () +testShortLinkGroupChangeProfileReceived = testChat3 aliceProfile bobProfile cathProfile test + where + test alice bob cath = do + createGroup2' "team" alice (cath, GROwner) True + alice ##> "/create link #team" + (shortLink, fullLink) <- getGroupLinks alice "team" GRMember True + + cath ##> "/gp team club" + cath <## "changed to #club" + alice <## "cath updated group #team:" + alice <## "changed to #club" + + bob ##> ("/_connect plan 1 " <> shortLink) + bob <## "group link: ok to connect" + groupSLinkData <- getTermLine bob + bob ##> ("/_prepare group 1 " <> fullLink <> " " <> shortLink <> " " <> groupSLinkData) + bob <## "#club: group is prepared" + bob ##> "/_connect group #1" + bob <## "#club: connection started" + alice <## "bob (Bob): accepting request to join group #club..." + concurrentlyN_ + [ alice <## "#club: bob joined the group", + do + bob <## "#club: joining the group..." + bob <## "#club: you joined the group" + bob <## "#club: member cath (Catherine) is connected", + do + cath <## "#club: alice added bob (Bob) to the group (connecting...)" + cath <## "#club: new member bob is connected" + ] + alice #> "#club 1" + [bob, cath] *<# "#club alice> 1" + bob #> "#club 2" + [alice, cath] *<# "#club bob> 2" + cath #> "#club 3" + [alice, bob] *<# "#club cath> 3"