implement, tests

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

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

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

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

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

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;
+|]

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

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 <name> 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