directory: periodically update subscriber counts for registered channels and re-verify links and ownership (#6879)

* directory: update subscriber counts for registered channels and re-verify links and ownership * refactor * rename * mapM_ * refactor * refactor * refactor more * more * different approach * rename * test * bot api types --------- Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
2026-06-06 12:41:37 +00:00 · 2026-04-25 10:20:26 +01:00
parent a845bfb89b
commit 53a225a0c9
11 changed files with 251 additions and 51 deletions
@@ -49,6 +49,7 @@ data DirectoryEvent
  | DEGroupInvitation {contact :: Contact, groupInfo :: GroupInfo, fromMemberRole :: GroupMemberRole, memberRole :: GroupMemberRole}
  | DEServiceJoinedGroup {contactId :: ContactId, groupInfo :: GroupInfo, hostMember :: GroupMember}
  | DEGroupUpdated {member :: GroupMember, fromGroup :: GroupInfo, toGroup :: GroupInfo}
+  | DEGroupLinkCheck GroupInfo
  | DEPendingMember GroupInfo GroupMember
  | DEPendingMemberMsg GroupInfo GroupMember ChatItemId Text
  | DEContactRoleChanged GroupInfo ContactId GroupMemberRole -- contactId here is the contact whose role changed
@@ -42,6 +42,7 @@ data DirectoryOpts = DirectoryOpts
    runCLI :: Bool,
    searchResults :: Int,
    webFolder :: Maybe FilePath,
+    linkCheckInterval :: Int,
    testing :: Bool
  }

@@ -162,6 +163,14 @@ directoryOpts appDir defaultDbName = do
            <> metavar "WEB_FOLDER"
            <> help "Folder to store static web assets"
        )
+  linkCheckInterval <-
+    option
+      auto
+      ( long "link-check-interval"
+          <> metavar "SECONDS"
+          <> help "Interval in seconds to check public group link data (default: 1800)"
+          <> value 1800
+      )
  pure
    DirectoryOpts
      { coreOptions,
@@ -182,6 +191,7 @@ directoryOpts appDir defaultDbName = do
        runCLI,
        searchResults = 10,
        webFolder,
+        linkCheckInterval,
        testing = False
      }

@@ -18,8 +18,7 @@ module Directory.Service
  )
 where

-import Control.Concurrent (forkIO)
-import Control.Concurrent.Async (race_)
+import Control.Concurrent (forkIO, threadDelay)
 import Control.Concurrent.STM
 import Control.Exception (SomeException, try)
 import Control.Logger.Simple
@@ -66,9 +65,10 @@ import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
 import Simplex.Chat.View (serializeChatError, serializeChatResponse, simplexChatContact, viewContactName, viewGroupName)
-import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), ACreatedConnLink (..), ConnectionLink (..), CreatedConnLink (..), SConnectionMode (..), sameConnReqContact, sameShortLinkContact)
+import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), ACreatedConnLink (..), AgentErrorType (..), ConnectionLink (..), CreatedConnLink (..), SConnectionMode (..), sameConnReqContact, sameShortLinkContact)
 import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Protocol (ErrorType (..))
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (eitherToMaybe, raceAny_, safeDecodeUtf8, tshow, unlessM, (<$$>))
@@ -100,7 +100,9 @@ data ServiceState = ServiceState
  { searchRequests :: TMap ContactId SearchRequest,
    blockedWordsCfg :: BlockedWordsConfig,
    pendingCaptchas :: TMap GroupMemberId PendingCaptcha,
-    updateListingsJob :: TMVar ChatController
+    serviceCC :: TMVar ChatController,
+    eventQ :: TQueue DirectoryEvent,
+    updateListingsJob :: TMVar ()
  }

 data CaptchaMode = CMText | CMAudio
@@ -126,8 +128,10 @@ newServiceState opts = do
  searchRequests <- TM.emptyIO
  blockedWordsCfg <- readBlockedWordsConfig opts
  pendingCaptchas <- TM.emptyIO
+  serviceCC <- newEmptyTMVarIO
+  eventQ <- newTQueueIO
  updateListingsJob <- newEmptyTMVarIO
-  pure ServiceState {searchRequests, blockedWordsCfg, pendingCaptchas, updateListingsJob}
+  pure ServiceState {searchRequests, blockedWordsCfg, pendingCaptchas, serviceCC, eventQ, updateListingsJob}

 welcomeGetOpts :: IO DirectoryOpts
 welcomeGetOpts = do
@@ -151,9 +155,8 @@ welcomeGetOpts = do

 directoryServiceCLI :: DirectoryLog -> DirectoryOpts -> IO ()
 directoryServiceCLI st opts = do
-  env <- newServiceState opts
-  eventQ <- newTQueueIO
-  let eventHook cc resp = atomically $ resp <$ writeTQueue eventQ (cc, resp)
+  env@ServiceState {eventQ} <- newServiceState opts
+  let eventHook _cc resp = atomically $ resp <$ mapM_ (writeTQueue eventQ) (crDirectoryEvent resp)
      chatHooks =
        defaultChatHooks
          { preStartHook = Just $ directoryPreStartHook opts,
@@ -163,14 +166,18 @@ directoryServiceCLI st opts = do
          }
  raceAny_ $
    [ simplexChatCLI' terminalChatConfig {chatHooks} (mkChatOpts opts) Nothing,
-      processEvents eventQ env
+      processEvents env
    ]
      <> maybeToList (updateListingsThread_ opts env)
+      <> maybeToList (linkCheckThread_ opts env)
  where
-    processEvents eventQ env = forever $ do
-      (cc, resp) <- atomically $ readTQueue eventQ
+    processEvents env@ServiceState {eventQ} = do
+      cc <- atomically $ readTMVar $ serviceCC env
      u_ <- readTVarIO (currentUser cc)
-      forM_ u_ $ \user -> directoryServiceEvent st opts env user cc resp
+      forM_ u_ $ \user ->
+        forever $ do
+          event <- atomically $ readTQueue eventQ
+          directoryServiceEvent st opts env user cc event

 updateListingDelay :: Int
 updateListingDelay = 5 * 60 * 1000000 -- update every 5 minutes
@@ -179,15 +186,30 @@ updateListingsThread_ :: DirectoryOpts -> ServiceState -> Maybe (IO ())
 updateListingsThread_ opts env = updateListingsThread <$> webFolder opts
  where
    updateListingsThread f = do
-      cc <- atomically $ takeTMVar $ updateListingsJob env
+      cc <- atomically $ readTMVar $ serviceCC env
      forever $ do
        u <- readTVarIO $ currentUser cc
        forM_ u $ \user -> updateGroupListingFiles cc user f
        delay <- registerDelay updateListingDelay
        atomically $ void (takeTMVar $ updateListingsJob env) `orElse` unlessM (readTVar delay) retry

-listingsUpdated :: ServiceState -> ChatController -> IO ()
-listingsUpdated env = void . atomically . tryPutTMVar (updateListingsJob env)
+listingsUpdated :: ServiceState -> IO ()
+listingsUpdated env = void $ atomically $ tryPutTMVar (updateListingsJob env) ()
+
+linkCheckThread_ :: DirectoryOpts -> ServiceState -> Maybe (IO ())
+linkCheckThread_ opts env@ServiceState {eventQ}
+  | linkCheckInterval opts > 0 = Just $ do
+      cc <- atomically $ readTMVar $ serviceCC env
+      forever $ do
+        threadDelay $ linkCheckInterval opts * 1000000
+        u <- readTVarIO $ currentUser cc
+        forM_ u $ \user ->
+          withDB' "linkCheckThread" cc (\db -> getAllGroupRegs_ db user) >>= \case
+            Left e -> logError $ "linkCheckThread error: " <> T.pack e
+            Right grs -> forM_ grs $ \(gInfo, gr) ->
+              unless (groupRemoved $ groupRegStatus gr) $
+                atomically $ writeTQueue eventQ $ DEGroupLinkCheck gInfo
+  | otherwise = Nothing

 directoryPreStartHook :: DirectoryOpts -> ChatController -> IO ()
 directoryPreStartHook opts ChatController {config, chatStore} = runDirectoryMigrations opts config chatStore
@@ -198,7 +220,8 @@ directoryPostStartHook opts@DirectoryOpts {noAddress, testing} env cc =
    Nothing -> putStrLn "No current user" >> exitFailure
    Just User {userId, profile = p@LocalProfile {preferences}} -> do
      unless noAddress $ initializeBotAddress' (not testing) cc
-      listingsUpdated env cc
+      void $ atomically $ tryPutTMVar (serviceCC env) cc
+      listingsUpdated env
      let cmds = fromMaybe [] $ preferences >>= commands_
      unless (cmds == directoryCommands) $ do
        let prefs = (fromMaybe emptyChatPrefs preferences) {files = Just FilesPreference {allow = FANo}, commands = Just directoryCommands} :: Preferences
@@ -227,7 +250,7 @@ directoryCommands =

 directoryService :: DirectoryLog -> DirectoryOpts -> ChatConfig -> IO ()
 directoryService st opts cfg = do
-  env <- newServiceState opts
+  env@ServiceState {eventQ} <- newServiceState opts
  let chatHooks =
        defaultChatHooks
          { preStartHook = Just $ directoryPreStartHook opts,
@@ -235,10 +258,16 @@ directoryService st opts cfg = do
            acceptMember = Just $ acceptMemberHook opts env
          }
  simplexChatCore cfg {chatHooks} (mkChatOpts opts) $ \user cc ->
-    maybe id race_ (updateListingsThread_ opts env) $
-      forever $ do
-        (_, resp) <- atomically . readTBQueue $ outputQ cc
-        directoryServiceEvent st opts env user cc resp
+    raceAny_ $
+      [ forever $ do
+          (_, resp) <- atomically . readTBQueue $ outputQ cc
+          mapM_ (atomically . writeTQueue eventQ) $ crDirectoryEvent resp,
+        forever $ do
+          event <- atomically $ readTQueue eventQ
+          directoryServiceEvent st opts env user cc event
+      ]
+        <> maybeToList (updateListingsThread_ opts env)
+        <> maybeToList (linkCheckThread_ opts env)

 acceptMemberHook :: DirectoryOpts -> ServiceState -> GroupInfo -> GroupLinkInfo -> Profile -> IO (Either GroupRejectionReason (GroupAcceptance, GroupMemberRole))
 acceptMemberHook
@@ -281,13 +310,13 @@ readBlockedWordsConfig DirectoryOpts {blockedFragmentsFile, blockedWordsFile, na
  unless testing $ putStrLn $ "Blocked fragments: " <> show (length blockedFragments) <> ", blocked words: " <> show (length blockedWords) <> ", spelling rules: " <> show (M.size spelling)
  pure BlockedWordsConfig {blockedFragments, blockedWords, extensionRules, spelling}

-directoryServiceEvent :: DirectoryLog -> DirectoryOpts -> ServiceState -> User -> ChatController -> Either ChatError ChatEvent -> IO ()
-directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName, ownersGroup, searchResults} env@ServiceState {searchRequests} user@User {userId} cc event =
-  forM_ (crDirectoryEvent event) $ \case
+directoryServiceEvent :: DirectoryLog -> DirectoryOpts -> ServiceState -> User -> ChatController -> DirectoryEvent -> IO ()
+directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName, ownersGroup, searchResults} env@ServiceState {searchRequests} user@User {userId} cc = \case
    DEContactConnected ct -> deContactConnected ct
    DEGroupInvitation {contact = ct, groupInfo = g, fromMemberRole, memberRole} -> deGroupInvitation ct g fromMemberRole memberRole
    DEServiceJoinedGroup ctId g owner -> deServiceJoinedGroup ctId g owner
    DEGroupUpdated {member, fromGroup, toGroup} -> deGroupUpdated member fromGroup toGroup
+    DEGroupLinkCheck g -> deGroupLinkCheck g
    DEPendingMember g m -> dePendingMember g m
    DEPendingMemberMsg g m ciId t -> dePendingMemberMsg g m ciId t
    DEContactRoleChanged g ctId role -> deContactRoleChanged g ctId role
@@ -762,6 +791,47 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
        let approveCmd = MCText $ "/approve " <> tshow groupId <> ":" <> viewName displayName <> " " <> tshow gaId <> if promoted then " promote=on" else ""
        sendComposedMessages cc (SRDirect cId) [msg, approveCmd]

+    deGroupLinkCheck :: GroupInfo -> IO ()
+    deGroupLinkCheck gInfo@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup = pg_}, groupSummary = summary} =
+      withGroupReg gInfo "link check" $ \gr@GroupReg {groupRegStatus, dbOwnerMemberId} ->
+        forM_ pg_ $ \pg@PublicGroupProfile {groupLink} ->
+          when (groupRegStatus == GRSActive || pendingApproval groupRegStatus) $ do
+            let link = ACL SCMContact $ CLShort groupLink
+            sendChatCmd cc (APIConnectPlan userId (Just link) True Nothing) >>= \case
+              Right (CRConnectionPlan _ _ (CPGroupLink (GLPKnown {groupInfo = g', groupUpdated = BoolDef updated, linkOwners = ListDef owners}))) ->
+                checkValidOwner dbOwnerMemberId owners $ do
+                  when updated $ reapprove pg gr groupRegStatus g'
+                  when (updated || summary /= groupSummary g') $ listingsUpdated env
+              Left (ChatErrorAgent {agentError = SMP _ err}) | linkDeleted err ->
+                setGroupStatus logError st env cc groupId GRSRemoved $ \gr' ->
+                  notifyOwner gr' "The channel link is no longer valid.\nThe channel is removed from the directory."
+              _ -> pure ()
+      where
+        linkDeleted = \case
+          AUTH -> True
+          BLOCKED {} -> True
+          _ -> False
+        checkValidOwner dbOwnerMemberId owners onValid = case dbOwnerMemberId of
+          Just ownerGMId ->
+            withDB "checkGroupLink" cc (\db -> withExceptT show $ getGroupMember db (vr cc) user groupId ownerGMId) >>= \case
+              Right GroupMember {memberId, memberPubKey}
+                | any (\GroupLinkOwner {memberId = mId, memberKey} -> memberId == mId && memberPubKey == Just memberKey) owners -> onValid
+              _ -> setGroupStatus logError st env cc groupId GRSSuspendedBadRoles $ \gr' ->
+                notifyOwner gr' "The registration owner is no longer a channel owner.\nThe channel is no longer listed in the directory."
+          Nothing -> onValid
+        reapprove pg gr groupRegStatus g' = do
+          let gt = groupTypeStr' pg
+              groupRef = groupReference gInfo
+          notifyAdminUsers $ "The " <> gt <> " " <> groupRef <> " profile changed."
+          case groupRegStatus of
+            GRSActive ->
+              setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval 1) $ \gr' -> do
+                notifyOwner gr' $ "The " <> gt <> " profile has changed.\nIt is hidden from the directory until approved."
+                sendToApprove g' gr' 1
+            GRSPendingApproval n ->
+              sendToApprove g' gr (n + 1)
+            _ -> pure ()
+
    deContactRoleChanged :: GroupInfo -> ContactId -> GroupMemberRole -> IO ()
    deContactRoleChanged g@GroupInfo {groupId, membership = GroupMember {memberRole = serviceRole}} ctId contactRole = do
      logInfo $ "contact ID " <> tshow ctId <> " role changed in group " <> viewGroupName g <> " to " <> tshow contactRole
@@ -893,8 +963,8 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
          (_, Just (OVFailed reason)) -> sendMessage cc ct $ "Link signature verification failed: " <> reason <> ".\nYou must be the " <> gt <> " owner to register it."
          (Nothing, _) -> sendMessage cc ct $ "Error: no " <> gt <> " information available via the link."
          _ -> sendMessage cc ct $ "Error: could not verify " <> gt <> " ownership. Please report it to directory admins."
-        GLPKnown {groupInfo = g, groupUpdated, ownerVerification} -> case ownerVerification of
-          Just OVVerified -> deReregistration ct g groupUpdated ownerSig
+        GLPKnown {groupInfo = g, groupUpdated = BoolDef updated, ownerVerification} -> case ownerVerification of
+          Just OVVerified -> deReregistration ct g updated ownerSig
          Just (OVFailed reason) -> sendMessage cc ct $ "Link signature verification failed: " <> reason <> ".\nYou must be the " <> gt <> " owner to register it."
          Nothing -> sendMessage cc ct $ "Error: could not verify " <> gt <> " ownership."
        GLPConnectingProhibit _ -> sendMessage cc ct $ "Already connecting to this " <> gt <> "."
@@ -1408,7 +1478,7 @@ setGroupStatusPromo sendReply st env cc GroupReg {dbGroupId = gId} grStatus' grP
    Left e -> sendReply $ "Error updating group " <> tshow gId <> " status: " <> T.pack e
    Right (status, grPromoted) -> do
      when ((status == DSListed || status' == DSListed) && (status /= status' || grPromoted /= grPromoted')) $
-        listingsUpdated env cc
+        listingsUpdated env
      logGUpdateStatus st gId grStatus'
      logGUpdatePromotion st gId grPromoted'
      continue
@@ -1428,7 +1498,7 @@ setGroupStatus sendMsg st env cc gId grStatus' continue = do
    Left e -> sendMsg $ "Error updating group " <> tshow gId <> " status: " <> T.pack e
    Right (grStatus, gr) -> do
      let status = grDirectoryStatus grStatus
-      when ((status == DSListed || status' == DSListed) && status /= status') $ listingsUpdated env cc
+      when ((status == DSListed || status' == DSListed) && status /= status') $ listingsUpdated env
      logGUpdateStatus st gId grStatus'
      continue gr

@@ -1437,7 +1507,7 @@ setGroupPromoted sendReply st env cc GroupReg {dbGroupId = gId} grPromoted' cont
  setGroupPromotedStore cc gId grPromoted' >>= \case
    Left e -> sendReply $ "Error updating group " <> tshow gId <> " status: " <> T.pack e
    Right (status, grPromoted) -> do
-      when (status == DSListed && grPromoted' /= grPromoted) $ listingsUpdated env cc
+      when (status == DSListed && grPromoted' /= grPromoted) $ listingsUpdated env
      logGUpdatePromotion st gId grPromoted'
      continue

@@ -95,6 +95,7 @@ This file is generated automatically.
 - [GroupInfo](#groupinfo)
 - [GroupKeys](#groupkeys)
 - [GroupLink](#grouplink)
+- [GroupLinkOwner](#grouplinkowner)
 - [GroupLinkPlan](#grouplinkplan)
 - [GroupMember](#groupmember)
 - [GroupMemberAdmission](#groupmemberadmission)
@@ -2264,6 +2265,15 @@ MemberSupport:
 - acceptMemberRole: [GroupMemberRole](#groupmemberrole)


+---
+
+## GroupLinkOwner
+
+**Record type**:
+- memberId: string
+- memberKey: string
+
+
 ---

 ## GroupLinkPlan
@@ -2292,6 +2302,7 @@ Known:
 - groupInfo: [GroupInfo](#groupinfo)
 - groupUpdated: bool
 - ownerVerification: [OwnerVerification](#ownerverification)?
+- linkOwners: [[GroupLinkOwner](#grouplinkowner)]

 NoRelays:
 - type: "noRelays"
@@ -278,6 +278,7 @@ chatTypesDocsData =
    (sti @GroupKeys, STRecord, "", [], "", ""),
    (sti @GroupRootKey, STUnion, "GRK", [], "", ""),
    (sti @GroupLink, STRecord, "", [], "", ""),
+    (sti @GroupLinkOwner, STRecord, "", [], "", ""),
    (sti @GroupLinkPlan, STUnion, "GLP", [], "", ""),
    (sti @GroupMember, STRecord, "", [], "", ""),
    (sti @GroupMemberAdmission, STRecord, "", [], "", ""),
@@ -482,6 +483,7 @@ deriving instance Generic GroupInfo
 deriving instance Generic GroupKeys
 deriving instance Generic GroupRootKey
 deriving instance Generic GroupLink
+deriving instance Generic GroupLinkOwner
 deriving instance Generic GroupLinkPlan
 deriving instance Generic GroupMember
 deriving instance Generic GroupMemberAdmission
@@ -2565,6 +2565,11 @@ export interface GroupLink {
  acceptMemberRole: GroupMemberRole
 }

+export interface GroupLinkOwner {
+  memberId: string
+  memberKey: string
+}
+
 export type GroupLinkPlan = 
  | GroupLinkPlan.Ok
  | GroupLinkPlan.OwnLink
@@ -2612,6 +2617,7 @@ export namespace GroupLinkPlan {
    groupInfo: GroupInfo
    groupUpdated: boolean
    ownerVerification?: OwnerVerification
+    linkOwners: GroupLinkOwner[]
  }

  export interface NoRelays extends Interface {
@@ -1037,10 +1037,16 @@ data GroupLinkPlan
  | GLPOwnLink {groupInfo :: GroupInfo}
  | GLPConnectingConfirmReconnect
  | GLPConnectingProhibit {groupInfo_ :: Maybe GroupInfo}
-  | GLPKnown {groupInfo :: GroupInfo, groupUpdated :: Bool, ownerVerification :: Maybe OwnerVerification}
+  | GLPKnown {groupInfo :: GroupInfo, groupUpdated :: BoolDef, ownerVerification :: Maybe OwnerVerification, linkOwners :: ListDef GroupLinkOwner}
  | GLPNoRelays {groupSLinkData_ :: Maybe GroupShortLinkData}
  deriving (Show)

+data GroupLinkOwner = GroupLinkOwner
+  { memberId :: MemberId,
+    memberKey :: C.PublicKeyEd25519
+  }
+  deriving (Show)
+
 data OwnerVerification
  = OVVerified
  | OVFailed {reason :: Text}
@@ -1662,6 +1668,8 @@ $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CAP") ''ContactAddressPlan)

 $(JQ.deriveJSON defaultJSON ''GroupShortLinkInfo)

+$(JQ.deriveJSON defaultJSON ''GroupLinkOwner)
+
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "GLP") ''GroupLinkPlan)

 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "FC") ''ForwardConfirmation)
@@ -1772,15 +1772,14 @@ processChatCommand vr nm = \case
  APIGroupInfo gId -> withUser $ \user ->
    CRGroupInfo user <$> withFastStore (\db -> getGroupInfo db vr user gId)
  APIGetUpdatedGroupLinkData groupId -> withUser $ \user -> do
-    gInfo@GroupInfo {groupProfile = GroupProfile {publicGroup}} <- withFastStore $ \db -> getGroupInfo db vr user groupId
-    case publicGroup of
-      Just PublicGroupProfile {groupLink = sLnk} | useRelays' gInfo -> do
+    gInfo@GroupInfo {groupProfile = p, groupSummary = GroupSummary {publicMemberCount = localCount}} <- withFastStore $ \db -> getGroupInfo db vr user groupId
+    case p of
+      GroupProfile {publicGroup = Just PublicGroupProfile {groupLink = sLnk}} | useRelays' gInfo -> do
        (_, cData) <- getShortLinkConnReq nm user sLnk
        groupSLinkData_ <- liftIO $ decodeLinkUserData cData
-        let publicGroupData_ = groupSLinkData_ >>= \GroupShortLinkData {publicGroupData} -> publicGroupData
-            publicMemberCount_ = (\PublicGroupData {publicMemberCount} -> publicMemberCount) <$> publicGroupData_
-        gInfo' <- fromMaybe gInfo
-          <$> forM publicMemberCount_ (\count -> withFastStore $ \db -> setPublicMemberCount db vr user gInfo count)
+        gInfo' <- case groupSLinkData_ of
+          Just sLinkData -> fst <$> updateGroupFromLinkData user gInfo sLinkData
+          _ -> pure gInfo
        pure $ CRGroupInfo user gInfo'
      _ -> throwCmdError "group link data not available"
  APIGroupMemberInfo gId gMemberId -> withUser $ \user -> do
@@ -4037,10 +4036,10 @@ processChatCommand vr nm = \case
        where
          l' = serverShortLink l
          con cReq = ACCL SCMContact $ CCLink cReq (Just l')
-          gPlan (cReq, g) = if memberRemoved (membership g) then Nothing else Just (con cReq, CPGroupLink (GLPKnown g False Nothing))
+          gPlan (cReq, g) = if memberRemoved (membership g) then Nothing else Just (con cReq, CPGroupLink (GLPKnown g (BoolDef False) Nothing (ListDef [])))
          groupShortLinkPlan =
            knownLinkPlans >>= \case
-              Just (_, CPGroupLink (GLPKnown g _ _))
+              Just (_, CPGroupLink (GLPKnown g _ _ _))
                | resolveKnown -> resolveKnownGroup g
              Just r -> pure r
              Nothing -> do
@@ -4065,15 +4064,15 @@ processChatCommand vr nm = \case
                liftIO (getGroupInfoViaUserShortLink db vr user l') >>= \case
                  Just (cReq, g) -> pure $ Just (con cReq, CPGroupLink (GLPOwnLink g))
                  Nothing -> (gPlan =<<) <$> getGroupViaShortLinkToConnect db vr user l'
-              resolveKnownGroup g@GroupInfo {groupProfile = p} = do
+              resolveKnownGroup g = do
                (fd@FixedLinkData {rootKey = rk}, cData@(ContactLinkData _ UserContactData {owners})) <- getShortLinkConnReq' nm user l'
                groupSLinkData_ <- liftIO $ decodeLinkUserData cData
                let ov = verifyLinkOwner rk owners l' sig_
+                    glOwners = map (\OwnerAuth {ownerId, ownerKey} -> GroupLinkOwner {memberId = MemberId ownerId, memberKey = ownerKey}) owners
                (g', updated) <- case groupSLinkData_ of
-                  Just GroupShortLinkData {groupProfile}
-                    | p /= groupProfile -> (,True) <$> withStore (\db -> updateGroupProfile db user g groupProfile)
+                  Just sLinkData -> updateGroupFromLinkData user g sLinkData
                  _ -> pure (g, False)
-                pure (con (linkConnReq fd), CPGroupLink (GLPKnown g' updated ov))
+                pure (con (linkConnReq fd), CPGroupLink (GLPKnown g' (BoolDef updated) ov (ListDef glOwners)))
    connectWithPlan :: User -> IncognitoEnabled -> ACreatedConnLink -> ConnectionPlan -> CM ChatResponse
    connectWithPlan user@User {userId} incognito ccLink plan
      | connectionPlanProceed plan = do
@@ -4153,10 +4152,10 @@ processChatCommand vr nm = \case
            (Just gInfo, _) -> groupPlan gInfo linkInfo gld ov
    groupPlan :: GroupInfo -> Maybe GroupShortLinkInfo -> Maybe GroupShortLinkData -> Maybe OwnerVerification -> CM ConnectionPlan
    groupPlan gInfo@GroupInfo {membership} linkInfo gld ov
-      | memberStatus membership == GSMemRejected = pure $ CPGroupLink (GLPKnown gInfo False ov)
+      | memberStatus membership == GSMemRejected = pure $ CPGroupLink (GLPKnown gInfo (BoolDef False) ov (ListDef []))
      | not (memberActive membership) && not (memberRemoved membership) =
          pure $ CPGroupLink (GLPConnectingProhibit $ Just gInfo)
-      | memberActive membership = pure $ CPGroupLink (GLPKnown gInfo False ov)
+      | memberActive membership = pure $ CPGroupLink (GLPKnown gInfo (BoolDef False) ov (ListDef []))
      | otherwise = pure $ CPGroupLink (GLPOk linkInfo gld ov)
    contactCReqSchemas :: ConnReqUriData -> (ConnReqContact, ConnReqContact)
    contactCReqSchemas crData =
@@ -1328,6 +1328,24 @@ updatePublicGroupData user gInfo
      pure gInfo'
  | otherwise = pure gInfo

+updateGroupFromLinkData :: User -> GroupInfo -> GroupShortLinkData -> CM (GroupInfo, Bool)
+updateGroupFromLinkData user gInfo@GroupInfo {groupProfile = p, groupSummary = GroupSummary {publicMemberCount = localCount}} GroupShortLinkData {groupProfile, publicGroupData}
+  | profileChanged || countChanged = do
+      vr <- chatVersionRange
+      withStore $ \db -> do
+        g <- if profileChanged then updateGroupProfile db user gInfo groupProfile else pure gInfo
+        g' <- case publicGroupData of
+          Just PublicGroupData {publicMemberCount} | countChanged ->
+            setPublicMemberCount db vr user g publicMemberCount
+          _ -> pure g
+        pure (g', profileChanged)
+  | otherwise = pure (gInfo, False)
+  where
+    profileChanged = p /= groupProfile
+    countChanged = case publicGroupData of
+      Just PublicGroupData {publicMemberCount} -> Just publicMemberCount /= localCount
+      _ -> False
+
 -- TODO [relays] owner: set owners on updating link data (multi-owner)
 groupLinkData :: GroupInfo -> GroupLink -> [GroupRelay] -> (UserConnLinkData 'CMContact, CRClientData)
 groupLinkData gInfo@GroupInfo {groupProfile, groupSummary = GroupSummary {publicMemberCount}, membership = GroupMember {memberId}, groupKeys} GroupLink {groupLinkId} groupRelays =
@@ -2103,7 +2103,7 @@ viewConnectionPlan ChatConfig {logLevel, testView} _connLink = \case
    GLPConnectingConfirmReconnect -> [grpLink "connecting, allowed to reconnect"]
    GLPConnectingProhibit Nothing -> [grpLink "connecting"]
    GLPConnectingProhibit (Just g) -> connecting g
-    GLPKnown g@GroupInfo {preparedGroup, membership = m} _ _ -> case preparedGroup of
+    GLPKnown g@GroupInfo {preparedGroup, membership = m} _ _ _ -> case preparedGroup of
      Just PreparedGroup {connLinkStartedConnection} -> case memberStatus m of
        GSMemUnknown
          | connLinkStartedConnection -> connecting g
@@ -93,6 +93,7 @@ directoryServiceTests = do
    it "should reject card shared by non-owner" testNonOwnerSharesCard
    it "should delete channel registration and leave" testDeleteChannelRegistration
    it "should handle re-registration when already listed" testReregistrationAlreadyListed
+    it "should update subscriber count periodically" testLinkCheckUpdatesCount

 directoryProfile :: Profile
 directoryProfile = Profile {displayName = "SimpleX Directory", fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences = Nothing}
@@ -128,6 +129,7 @@ mkDirectoryOpts TestParams {tmpPath = ps} superUsers ownersGroup webFolder =
      runCLI = False,
      searchResults = 3,
      webFolder,
+      linkCheckInterval = 0,
      testing = True
    }

@@ -1976,7 +1978,7 @@ testRegisterChannelViaCard ps =
        superUser <## "news"
        superUser <##. "Link to join channel: "
        superUser <## "You need SimpleX Chat app v6.5 to join."
-        superUser <## "2 subscribers"
+        superUser <## "1 subscribers"
        superUser <## ""
        superUser <## "To approve send:"
        superUser <# "'SimpleX Directory'> /approve 1:news 1"
@@ -1999,7 +2001,7 @@ testRegisterChannelViaCard ps =
        superUser <## "news (News and Updates)"
        superUser <##. "Link to join channel: "
        superUser <## "You need SimpleX Chat app v6.5 to join."
-        superUser <## "3 subscribers"
+        superUser <## "2 subscribers"
        superUser <## ""
        superUser <## "To approve send:"
        superUser <# "'SimpleX Directory'> /approve 1:news 1"
@@ -2074,7 +2076,7 @@ testDeleteChannelRegistration ps =
        superUser <## "news"
        superUser <##. "Link to join channel: "
        superUser <## "You need SimpleX Chat app v6.5 to join."
-        superUser <## "2 subscribers"
+        superUser <## "1 subscribers"
        superUser <## ""
        superUser <## "To approve send:"
        superUser <# "'SimpleX Directory'> /approve 1:news 1"
@@ -2118,7 +2120,7 @@ testReregistrationAlreadyListed ps =
        superUser <## "news"
        superUser <##. "Link to join channel: "
        superUser <## "You need SimpleX Chat app v6.5 to join."
-        superUser <## "2 subscribers"
+        superUser <## "1 subscribers"
        superUser <## ""
        superUser <## "To approve send:"
        superUser <# "'SimpleX Directory'> /approve 1:news 1"
@@ -2135,7 +2137,7 @@ testReregistrationAlreadyListed ps =
        bob <# "'SimpleX Directory'> news"
        bob <##. "Link to join channel: "
        bob <## "You need SimpleX Chat app v6.5 to join."
-        bob <## "3 subscribers"
+        bob <## "1 subscribers"
        -- owner re-shares card while already listed
        bob ##> "/share chat #news @'SimpleX Directory'"
        bob <# "@'SimpleX Directory' link to join channel #news (signed):"
@@ -2143,6 +2145,79 @@ testReregistrationAlreadyListed ps =
        _ <- getTermLine bob -- ownerSig JSON
        bob <# "'SimpleX Directory'> Channel is already listed in the directory."

+testLinkCheckUpdatesCount :: HasCallStack => TestParams -> IO ()
+testLinkCheckUpdatesCount ps = do
+  dsLink <-
+    withNewTestChatCfg ps testCfg serviceDbPrefix directoryProfile $ \ds ->
+      withNewTestChatCfg ps testCfg "super_user" aliceProfile $ \superUser -> do
+        connectUsers ds superUser
+        ds ##> "/ad"
+        getContactLink ds True
+  let opts = (mkDirectoryOpts ps [KnownContact 2 "alice"] Nothing Nothing) {linkCheckInterval = 1}
+  runDirectory testCfg opts $
+    withTestChatCfg ps testCfg "super_user" $ \superUser -> do
+      superUser <## "subscribed 1 connections on server localhost"
+      withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob ->
+        withRelay ps $ \relay ->
+          withNewTestChatCfg ps testCfg "cath" cathProfile $ \cath -> do
+            bob `connectVia` dsLink
+            (shortLink, fullLink) <- prepareChannel1Relay "news" bob relay
+            -- register and approve
+            bob ##> "/share chat #news @'SimpleX Directory'"
+            bob <# "@'SimpleX Directory' link to join channel #news (signed):"
+            _ <- getTermLine bob -- short link
+            _ <- getTermLine bob -- ownerSig JSON
+            bob <# "'SimpleX Directory'> Joining the channel news…"
+            concurrentlyN_
+              [ do
+                  relay <## "'SimpleX Directory': accepting request to join group #news..."
+                  relay <## "#news: 'SimpleX Directory' joined the group",
+                bob <## "#news: relay added 'SimpleX Directory_1' to the group"
+              ]
+            bob <# "'SimpleX Directory'> Joined the channel news. Registration is pending approval — it may take up to 48 hours."
+            superUser <# "'SimpleX Directory'> bob submitted the channel ID 1:"
+            superUser <## "news"
+            superUser <##. "Link to join channel: "
+            superUser <## "You need SimpleX Chat app v6.5 to join."
+            superUser <## "1 subscribers"
+            superUser <## ""
+            superUser <## "To approve send:"
+            superUser <# "'SimpleX Directory'> /approve 1:news 1"
+            let approve = "/approve 1:news 1"
+            superUser #> ("@'SimpleX Directory' " <> approve)
+            superUser <# ("'SimpleX Directory'> > " <> approve)
+            superUser <## "      Channel approved!"
+            bob <# ("'SimpleX Directory'> The channel ID 1 (news) is approved and listed in directory - please moderate it!")
+            bob <## "Please note: if you change the channel profile it will be hidden from directory until it is re-approved."
+            -- search shows initial count
+            bob #> "@'SimpleX Directory' news"
+            bob <# "'SimpleX Directory'> > news"
+            bob <## "      Found 1 group(s)."
+            bob <# "'SimpleX Directory'> news"
+            bob <##. "Link to join channel: "
+            bob <## "You need SimpleX Chat app v6.5 to join."
+            bob <## "1 subscribers"
+            -- link check updates count (bot joined)
+            threadDelay 1000000
+            bob #> "@'SimpleX Directory' news"
+            bob <# "'SimpleX Directory'> > news"
+            bob <## "      Found 1 group(s)."
+            bob <# "'SimpleX Directory'> news"
+            bob <##. "Link to join channel: "
+            bob <## "You need SimpleX Chat app v6.5 to join."
+            bob <## "2 subscribers"
+            -- second subscriber joins
+            memberJoinChannel "news" [relay] [bob] shortLink fullLink cath
+            -- link check updates count again
+            threadDelay 1000000
+            bob #> "@'SimpleX Directory' news"
+            bob <# "'SimpleX Directory'> > news"
+            bob <## "      Found 1 group(s)."
+            bob <# "'SimpleX Directory'> news"
+            bob <##. "Link to join channel: "
+            bob <## "You need SimpleX Chat app v6.5 to join."
+            bob <## "3 subscribers"
+
 testGetCaptchaStr :: HasCallStack => TestParams -> IO ()
 testGetCaptchaStr _ps = do
  s0 <- getCaptchaStr 0 ""