From a170f8892402ebd81e85ed74dcefb858dea86829 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Mon, 13 Apr 2026 22:21:55 +0000 Subject: [PATCH] implement, tests --- simplex-chat.cabal | 1 + src/Simplex/Chat/Library/Commands.hs | 13 +++++- src/Simplex/Chat/Library/Subscriber.hs | 10 ++-- src/Simplex/Chat/Store/Groups.hs | 7 +++ src/Simplex/Chat/Store/Postgres/Migrations.hs | 4 +- .../Migrations/M20260413_chat_hidden.hs | 21 +++++++++ src/Simplex/Chat/View.hs | 20 +++++++- tests/ChatTests/ChatRelays.hs | 46 +++++++++++++++++-- 8 files changed, 110 insertions(+), 12 deletions(-) create mode 100644 src/Simplex/Chat/Store/Postgres/Migrations/M20260413_chat_hidden.hs diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 7e83f8d5f7..096a229749 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -130,6 +130,7 @@ library Simplex.Chat.Store.Postgres.Migrations.M20260122_has_link Simplex.Chat.Store.Postgres.Migrations.M20260222_chat_relays Simplex.Chat.Store.Postgres.Migrations.M20260403_item_viewed + Simplex.Chat.Store.Postgres.Migrations.M20260413_chat_hidden else exposed-modules: Simplex.Chat.Archive diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 5b8b4e67f1..a26d630d3d 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -2499,14 +2499,14 @@ processChatCommand vr nm = \case g <- getGroupInfo db vr user toGroupId ms <- liftIO $ getGroupMembers db vr user g pure (g, ms) + unless (groupFeatureUserAllowed SGFSimplexLinks toGInfo) $ throwCmdError "simplex links not allowed in this group" let inv = PublicGroupInvitation {groupProfile, groupOwner = Nothing, groupSize} msg <- sendGroupMessage user toGInfo scope members $ XGrpInvPub inv sendInv Nothing msg (CDGroupSnd toGInfo Nothing) (GroupChat toGInfo Nothing) _ -> throwCmdError "unsupported chat type" APIRevealPublicGroup groupId -> withUser $ \user -> do withStore' $ \db -> setGroupChatHidden db user groupId False - gInfo <- withFastStore $ \db -> getGroupInfo db vr user groupId - pure $ CRSentPublicGroupInvitation user gInfo -- reusing response, just returns group info + ok user APIAddMember groupId contactId memRole -> withUser $ \user -> withGroupLock "addMember" groupId $ do -- TODO for large groups: no need to load all members to determine if contact is a member (group, contact) <- withFastStore $ \db -> (,) <$> getGroup db vr user groupId <*> getContact db vr user contactId @@ -4599,6 +4599,8 @@ cleanupManager = do liftIO $ threadDelay' stepDelay cleanupInProgressGroups user `catchAllErrors` eToView liftIO $ threadDelay' stepDelay + cleanupHiddenGroups user `catchAllErrors` eToView + liftIO $ threadDelay' stepDelay cleanupStaleRelayTestConns user `catchAllErrors` eToView liftIO $ threadDelay' stepDelay cleanupTimedItems cleanupInterval user = do @@ -4620,6 +4622,13 @@ cleanupManager = do inProgressGroups <- withStore' $ \db -> getInProgressGroups db vr user cutoffTs forM_ inProgressGroups $ \gInfo -> deleteInProgressGroup user gInfo `catchAllErrors` eToView + cleanupHiddenGroups user = do + vr <- chatVersionRange + ts <- liftIO getCurrentTime + let cutoffTs = addUTCTime (-86400) ts -- older than 24 hours + hiddenGroups <- withStore' $ \db -> getHiddenGroups db vr user cutoffTs + forM_ hiddenGroups $ \gInfo -> + deleteInProgressGroup user gInfo `catchAllErrors` eToView cleanupStaleRelayTestConns user = do ts <- liftIO getCurrentTime let cutoffTs = addUTCTime (-300) ts diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 7593452bcd..c8995ec9e0 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -2320,9 +2320,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = receiveInlineChunk ft chunk meta processPublicGroupInvitationGroup :: GroupInfo -> GroupMember -> Connection -> PublicGroupInvitation -> RcvMessage -> UTCTime -> CM () - processPublicGroupInvitationGroup g m conn inv msg brokerTs = do - (gInfo, _) <- rcvPublicGroupInvitation conn inv msg brokerTs (CDGroupRcv g Nothing m) (GroupChat g Nothing) - toView $ CEvtReceivedPublicGroupInvitation {user, sharedGroupInfo = gInfo, contact_ = Nothing, fromGroupInfo_ = Just g, fromMember_ = Just m} + processPublicGroupInvitationGroup g m conn inv msg brokerTs + | not (groupFeatureMemberAllowed SGFSimplexLinks m g) = messageError "x.grp.inv.pub: simplex links not allowed" + | otherwise = do + (gInfo, _) <- rcvPublicGroupInvitation conn inv msg brokerTs (CDGroupRcv g Nothing m) (GroupChat g Nothing) + toView $ CEvtReceivedPublicGroupInvitation {user, sharedGroupInfo = gInfo, contact_ = Nothing, fromGroupInfo_ = Just g, fromMember_ = Just m} bFileChunkGroup :: GroupInfo -> SharedMsgId -> FileChunk -> MsgMeta -> CM () bFileChunkGroup GroupInfo {groupId} sharedMsgId chunk meta = do @@ -2466,7 +2468,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = PublicGroupProfile {publicGroupId = B64UrlByteString pgId} <- maybe (Left "no public group profile") Right (publicGroup gp) unless (linkEntityId == Just pgId) $ Left "group identity mismatch" unless (bd == adHash) $ Left "binding data mismatch" - OwnerAuth {ownerKey} <- maybe (Left "unknown member ID") Right $ + OwnerAuth {ownerKey} <- maybe (Left $ "unknown member ID: " <> show (unMemberId mId) <> " not in " <> show (map (\OwnerAuth {ownerId} -> ownerId) owners)) Right $ find (\OwnerAuth {ownerId} -> ownerId == unMemberId mId) owners sig <- C.decodeSignature sigBytes let invBody = encodeUtf8 $ encodeJSON gp diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index bf4c4b7a0b..d6a51ad524 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -44,6 +44,7 @@ module Simplex.Chat.Store.Groups setGroupOwnerSig, getGroupOwnerSig, getHiddenGroupByPublicGroupId, + getHiddenGroups, getGroup, getGroupInfoByUserContactLinkConnReq, getGroupInfoViaUserShortLink, @@ -904,6 +905,12 @@ getHiddenGroupByPublicGroupId db userId pgId = maybeFirstRow fromOnly $ DB.query db "SELECT g.group_id FROM groups g JOIN group_profiles gp ON gp.group_profile_id = g.group_profile_id WHERE g.user_id = ? AND g.chat_hidden = 1 AND gp.public_group_id = ?" (userId, pgId) +getHiddenGroups :: DB.Connection -> VersionRangeChat -> User -> UTCTime -> IO [GroupInfo] +getHiddenGroups db vr user@User {userId} createdAtCutoff = do + groupIds <- map fromOnly <$> + DB.query db "SELECT group_id FROM groups WHERE user_id = ? AND chat_hidden = 1 AND created_at <= ?" (userId, createdAtCutoff) + rights <$> mapM (runExceptT . getGroupInfo db vr user) groupIds + -- TODO return the last connection that is ready, not any last connection -- requires updating connection status getGroup :: DB.Connection -> VersionRangeChat -> User -> GroupId -> ExceptT StoreError IO Group diff --git a/src/Simplex/Chat/Store/Postgres/Migrations.hs b/src/Simplex/Chat/Store/Postgres/Migrations.hs index 06efcdc17a..e8c10f6d7c 100644 --- a/src/Simplex/Chat/Store/Postgres/Migrations.hs +++ b/src/Simplex/Chat/Store/Postgres/Migrations.hs @@ -28,6 +28,7 @@ import Simplex.Chat.Store.Postgres.Migrations.M20260108_chat_indices import Simplex.Chat.Store.Postgres.Migrations.M20260122_has_link import Simplex.Chat.Store.Postgres.Migrations.M20260222_chat_relays import Simplex.Chat.Store.Postgres.Migrations.M20260403_item_viewed +import Simplex.Chat.Store.Postgres.Migrations.M20260413_chat_hidden import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Text, Maybe Text)] @@ -55,7 +56,8 @@ schemaMigrations = ("20260108_chat_indices", m20260108_chat_indices, Just down_m20260108_chat_indices), ("20260122_has_link", m20260122_has_link, Just down_m20260122_has_link), ("20260222_chat_relays", m20260222_chat_relays, Just down_m20260222_chat_relays), - ("20260403_item_viewed", m20260403_item_viewed, Just down_m20260403_item_viewed) + ("20260403_item_viewed", m20260403_item_viewed, Just down_m20260403_item_viewed), + ("20260413_chat_hidden", m20260413_chat_hidden, Just down_m20260413_chat_hidden) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/M20260413_chat_hidden.hs b/src/Simplex/Chat/Store/Postgres/Migrations/M20260413_chat_hidden.hs new file mode 100644 index 0000000000..43abea263d --- /dev/null +++ b/src/Simplex/Chat/Store/Postgres/Migrations/M20260413_chat_hidden.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Store.Postgres.Migrations.M20260413_chat_hidden where + +import Data.Text (Text) +import Text.RawString.QQ (r) + +m20260413_chat_hidden :: Text +m20260413_chat_hidden = + [r| +ALTER TABLE groups ADD COLUMN chat_hidden SMALLINT NOT NULL DEFAULT 0; +ALTER TABLE groups ADD COLUMN owner_sig TEXT; +|] + +down_m20260413_chat_hidden :: Text +down_m20260413_chat_hidden = + [r| +ALTER TABLE groups DROP COLUMN chat_hidden; +ALTER TABLE groups DROP COLUMN owner_sig; +|] diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 46b602f159..3c49fd10cb 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -670,6 +670,8 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, forwa DirectChat c -> case chatDir of CIDirectSnd -> case content of CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to context mc + CISndGroupInvitation gi _ + | isPublicGroupInv gi -> sentWithTime_ ts tz [to <> plain (invItemText gi) <> ownerSigStr gi] meta CISndGroupEvent {} -> showSndItemProhibited to _ -> showSndItem to where @@ -678,6 +680,8 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, forwa CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from context mc CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta CIRcvMsgError err -> viewRcvMsgError from err ts tz meta + CIRcvGroupInvitation gi _ + | isPublicGroupInv gi -> receivedWithTime_ ts tz from [] meta [plain (invItemText gi) <> ownerSigStr gi] False CIRcvGroupEvent {} -> showRcvItemProhibited from _ -> showRcvItem from where @@ -691,7 +695,8 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, forwa GroupChat g scopeInfo -> case chatDir of CIGroupSnd -> case content of CISndMsgContent mc -> hideLive meta $ withSndFile to $ sndMsg to context mc - CISndGroupInvitation {} -> showSndItemProhibited to + CISndGroupInvitation gi _ + | isPublicGroupInv gi -> sentWithTime_ ts tz [to <> plain (invItemText gi) <> ownerSigStr gi] meta _ -> showSndItem to where to = ttyToGroup g scopeInfo @@ -702,7 +707,8 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, forwa CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from context mc CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta CIRcvMsgError err -> viewRcvMsgError from err ts tz meta - CIRcvGroupInvitation {} | isJust m_ -> showRcvItemProhibited from + CIRcvGroupInvitation gi _ + | isPublicGroupInv gi -> receivedWithTime_ ts tz from [] meta [plain (invItemText gi) <> ownerSigStr gi] False CIRcvModerated {} -> receivedWithTime_ ts tz (ttyFromGroup g scopeInfo m_) context meta [plainContent content] False CIRcvBlocked {} -> receivedWithTime_ ts tz (ttyFromGroup g scopeInfo m_) context meta [plainContent content] False _ -> showRcvItem from @@ -749,6 +755,16 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {itemForwarded, forwa ("", Just _, []) -> [] ("", Just CIFile {fileName}, _) -> view dir context (MCText $ T.pack fileName) ts tz meta _ -> view dir context mc ts tz meta + isPublicGroupInv CIGroupInvitation {groupProfile = GroupProfile {publicGroup}} = isJust publicGroup + invItemText CIGroupInvitation {groupProfile = GroupProfile {displayName}, status} = + (case status of + CIGISAccepted -> "joined " + _ -> "invitation to join ") <> displayName + ownerSigStr CIGroupInvitation {ownerSigStatus} = case ownerSigStatus of + Just OSSVerified -> styled (colored Green) (" (owner verified)" :: String) + Just OSSPending -> styled (colored Yellow) (" (verifying...)" :: String) + Just (OSSFailed reason) -> styled (colored Red) (" (verification failed: " <> T.unpack reason <> ")") + Nothing -> "" showSndItem to = showItem $ sentWithTime_ ts tz [to <> plainContent content <> sigStatusStr msgSigned] meta showRcvItem from = showItem $ receivedWithTime_ ts tz from [] meta [plainContent content <> sigStatusStr msgSigned] False showSndItemProhibited to = showItem $ sentWithTime_ ts tz [to <> plainContent content <> " " <> prohibited] meta diff --git a/tests/ChatTests/ChatRelays.hs b/tests/ChatTests/ChatRelays.hs index 98f40c9d0f..c07047eac9 100644 --- a/tests/ChatTests/ChatRelays.hs +++ b/tests/ChatTests/ChatRelays.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + module ChatTests.ChatRelays where import ChatClient @@ -17,6 +19,8 @@ chatRelayTests = do describe "public group invitations" $ do it "share public group in direct chat" testSharePublicGroupDirect it "share public group in group chat" testSharePublicGroupInGroup + it "share public group twice reuses hidden group" testSharePublicGroupDedup + it "cannot share non-public group" testShareNonPublicGroupFails testGetSetChatRelays :: HasCallStack => TestParams -> IO () testGetSetChatRelays ps = @@ -180,9 +184,12 @@ testSharePublicGroupDirect ps = createChannelWithRelay "team" alice bob connectUsers alice cath alice ##> "/share #team @cath" - alice <## "shared public group #team" + alice <### [WithTime "@cath invitation to join team (owner verified)", "shared public group #team"] + cath <# "alice> invitation to join team (verifying...)" cath <## "alice (Alice) shared public group #team" - -- wait for async verification + -- TODO: async verification currently fails because groupLinkData (Internal.hs:1336) + -- overwrites owners=[] when updating link data after relay joins. + -- Once fixed, verify: cath ##> "/tail @alice 1"; cath <# "alice> invitation to join team (owner verified)" threadDelay 1000000 testSharePublicGroupInGroup :: HasCallStack => TestParams -> IO () @@ -198,9 +205,42 @@ testSharePublicGroupInGroup ps = -- create a regular group with alice and cath createGroup2 "friends" alice cath alice ##> "/share #team #friends" - alice <## "shared public group #team" + alice <### [WithTime "#friends invitation to join team", "shared public group #team"] + cath <# "#friends alice> invitation to join team" cath <## "#friends: alice shared public group #team" +testSharePublicGroupDedup :: HasCallStack => TestParams -> IO () +testSharePublicGroupDedup ps = + withNewTestChat ps "alice" aliceProfile $ \alice -> + withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> do + bob ##> "/ad" + (bobSLink, _cLink) <- getContactLinks bob True + alice ##> ("/relays name=bob_relay " <> bobSLink) + alice <## "ok" + createChannelWithRelay "team" alice bob + connectUsers alice cath + -- share twice, second reuses hidden group + alice ##> "/share #team @cath" + alice <### [WithTime "@cath invitation to join team (owner verified)", "shared public group #team"] + cath <# "alice> invitation to join team (verifying...)" + cath <## "alice (Alice) shared public group #team" + alice ##> "/share #team @cath" + alice <### [WithTime "@cath invitation to join team (owner verified)", "shared public group #team"] + cath <# "alice> invitation to join team (verifying...)" + cath <## "alice (Alice) shared public group #team" + threadDelay 1000000 + +testShareNonPublicGroupFails :: HasCallStack => TestParams -> IO () +testShareNonPublicGroupFails = + testChat2 aliceProfile bobProfile $ \alice bob -> do + connectUsers alice bob + alice ##> "/g team" + alice <## "group #team is created" + alice <## "to add members use /a team or /create link #team" + alice ##> "/share #team @bob" + alice <## "bad chat command: not a public group" + -- Create a public group with relay=1, wait for relay to join createChannelWithRelay :: HasCallStack => String -> TestCC -> TestCC -> IO () createChannelWithRelay gName owner relay = do