website: directory page (#6283)

* website: directory page * core: use markdown in directory entries * render markdown on directory page * update markdown * toggle secrets on click * update listings asynchronously * add group links to the listing * cleanup * better directory layout with pagination * script to run website * update page navigation * search * readable markdown colors, better "read less" * core: atomic update of directory listings, to avoid files unavailable * fix symlink, sort entries on page with new first * update listings every 15 min, add activeAt time * fix sorting in the page and listing url * replace simplex:/ links on desktop
2026-06-06 01:23:11 +00:00 · 2025-09-20 19:47:50 +01:00
parent 429ec9d21a
commit a190d4ea9b
22 changed files with 994 additions and 191 deletions
@@ -1,9 +1,11 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}

 module Directory.Listing where
@@ -11,23 +13,36 @@ module Directory.Listing where
 import Control.Applicative ((<|>))
 import Control.Concurrent.STM
 import Control.Monad
+import Crypto.Hash (Digest, MD5)
+import qualified Crypto.Hash as CH
 import qualified Data.Aeson as J
 import qualified Data.Aeson.TH as JQ
+import qualified Data.ByteArray as BA
 import Data.ByteString (ByteString)
-import Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Base64.URL as B64URL
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as LB
-import Data.Maybe (fromMaybe)
+import Data.List (isPrefixOf)
+import Data.Maybe (catMaybes, fromMaybe)
 import qualified Data.Set as S
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
+import Data.Time.Clock (UTCTime, getCurrentTime)
+import Data.Time.Format.ISO8601 (iso8601Show)
 import Directory.Store
+import Simplex.Chat.Markdown
 import Simplex.Chat.Types
+import Simplex.Messaging.Agent.Protocol
+import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, taggedObjectJSON)
 import System.Directory
 import System.FilePath

+directoryDataPath :: String
+directoryDataPath = "data"
+
 listingFileName :: String
 listingFileName = "listing.json"

@@ -47,9 +62,12 @@ $(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "DET") ''DirectoryEntryType)
 data DirectoryEntry = DirectoryEntry
  { entryType :: DirectoryEntryType,
    displayName :: Text,
-    shortDescr :: Maybe Text,
-    welcomeMessage :: Maybe Text,
-    imageFile :: Maybe String
+    groupLink :: CreatedLinkContact,
+    shortDescr :: Maybe MarkdownList,
+    welcomeMessage :: Maybe MarkdownList,
+    imageFile :: Maybe String,
+    activeAt :: UTCTime,
+    createdAt :: UTCTime
  }

 $(JQ.deriveJSON defaultJSON ''DirectoryEntry)
@@ -60,38 +78,67 @@ $(JQ.deriveJSON defaultJSON ''DirectoryListing)

 type ImageFileData = ByteString

-groupDirectoryEntry :: GroupInfoSummary -> (DirectoryEntry, Maybe (FilePath, ImageFileData))
-groupDirectoryEntry (GIS GroupInfo {groupId, groupProfile} summary) =
+groupDirectoryEntry :: GroupInfoSummary -> Maybe (DirectoryEntry, Maybe (FilePath, ImageFileData))
+groupDirectoryEntry (GIS GroupInfo {groupProfile, chatTs, createdAt} summary gLink_) =
  let GroupProfile {displayName, shortDescr, description, image, memberAdmission} = groupProfile
      entryType = DETGroup memberAdmission summary
-      imgData = imgFileData =<< image
-   in (DirectoryEntry {entryType, displayName, shortDescr, welcomeMessage = description, imageFile = fst <$> imgData}, imgData)
+      entry groupLink =
+        let de =
+              DirectoryEntry
+                { entryType,
+                  displayName,
+                  groupLink,
+                  shortDescr = toFormattedText <$> shortDescr,
+                  welcomeMessage = toFormattedText <$> description,
+                  imageFile = fst <$> imgData,
+                  activeAt = fromMaybe createdAt chatTs,
+                  createdAt
+                }
+            imgData = imgFileData groupLink =<< image
+         in (de, imgData)
+   in (entry . connLinkContact) <$> gLink_
  where
-    imgFileData (ImageData img) =
+    imgFileData :: CreatedConnLink 'CMContact -> ImageData -> Maybe (FilePath, ByteString)
+    imgFileData groupLink (ImageData img) =
      let (img', imgExt) =
            fromMaybe (img, ".jpg") $
              (,".jpg") <$> T.stripPrefix "data:image/jpg;base64," img
                <|> (,".png") <$> T.stripPrefix "data:image/png;base64," img
-          imgFile = listingImageFolder </> show groupId <> imgExt
+          imgName = B.unpack $ B64URL.encodeUnpadded $ BA.convert $ (CH.hash :: ByteString -> Digest MD5) $ strEncode (connFullLink groupLink)
+          imgFile = listingImageFolder </> imgName <> imgExt
       in case B64.decode $ encodeUtf8 img' of
            Right img'' -> Just (imgFile, img'')
            Left _ -> Nothing

 generateListing :: DirectoryStore -> FilePath -> [GroupInfoSummary] -> IO ()
 generateListing st dir gs = do
+  createDirectoryIfMissing True dir
+  oldDirs <- filter ((directoryDataPath <> ".") `isPrefixOf`) <$> listDirectory dir
+  ts <- getCurrentTime
+  let newDirPath = directoryDataPath <> "." <> iso8601Show ts <> "/"
+      newDir = dir </> newDirPath
  gs' <- filterListedGroups st gs
-  removePathForcibly (dir </> listingImageFolder)
-  createDirectoryIfMissing True (dir </> listingImageFolder)
-  gs'' <- forM gs' $ \g@(GIS GroupInfo {groupId} _) -> do
-    let (g', img) = groupDirectoryEntry g
-    forM_ img $ \(imgFile, imgData) -> B.writeFile (dir </> imgFile) imgData
-    pure (groupId, g')
-  saveListing listingFileName gs''
-  saveListing promotedFileName =<< filterPromotedGroups st gs''
+  createDirectoryIfMissing True (newDir </> listingImageFolder)
+  gs'' <-
+    fmap catMaybes $ forM gs' $ \g@(GIS GroupInfo {groupId} _ _) ->
+      forM (groupDirectoryEntry g) $ \(g', img) -> do
+        forM_ img $ \(imgFile, imgData) -> B.writeFile (newDir </> imgFile) imgData
+        pure (groupId, g')
+  saveListing newDir listingFileName gs''
+  saveListing newDir promotedFileName =<< filterPromotedGroups st gs''
+  -- atomically update the link
+  let newSymLink = newDir <> ".link"
+      symLink = dir </> directoryDataPath
+  createDirectoryLink newDirPath newSymLink
+  renamePath newSymLink symLink
+  mapM_ (removePathForcibly . (dir </>)) oldDirs
  where
-    saveListing f = LB.writeFile (dir </> f) . J.encode . DirectoryListing . map snd
+    saveListing newDir f = LB.writeFile (newDir </> f) . J.encode . DirectoryListing . map snd

 filterPromotedGroups :: DirectoryStore -> [(GroupId, DirectoryEntry)] -> IO [(GroupId, DirectoryEntry)]
 filterPromotedGroups st gs = do
  pgs <- readTVarIO $ promotedGroups st
  pure $ filter (\g -> fst g `S.member` pgs) gs
+
+toFormattedText :: Text -> MarkdownList
+toFormattedText t = fromMaybe [FormattedText Nothing t] $ parseMaybeMarkdownList t
@@ -20,13 +20,13 @@ data SearchRequest = SearchRequest
 data SearchType = STAll | STRecent | STSearch Text

 takeTop :: Int -> [GroupInfoSummary] -> [GroupInfoSummary]
-takeTop n = take n . sortOn (\(GIS _ GroupSummary {currentMembers}) -> Down currentMembers)
+takeTop n = take n . sortOn (\(GIS _ GroupSummary {currentMembers} _) -> Down currentMembers)

 takeRecent :: Int -> [GroupInfoSummary] -> [GroupInfoSummary]
-takeRecent n = take n . sortOn (\(GIS GroupInfo {createdAt} _) -> Down createdAt)
+takeRecent n = take n . sortOn (\(GIS GroupInfo {createdAt} _ _) -> Down createdAt)

 groupIds :: [GroupInfoSummary] -> Set GroupId
-groupIds = S.fromList . map (\(GIS GroupInfo {groupId} _) -> groupId)
+groupIds = S.fromList . map (\(GIS GroupInfo {groupId} _ _) -> groupId)

 filterNotSent :: Set GroupId -> [GroupInfoSummary] -> [GroupInfoSummary]
-filterNotSent sentGroups = filter (\(GIS GroupInfo {groupId} _) -> groupId `S.notMember` sentGroups)
+filterNotSent sentGroups = filter (\(GIS GroupInfo {groupId} _ _) -> groupId `S.notMember` sentGroups)
@@ -21,7 +21,6 @@ module Directory.Service
 where

 import Control.Concurrent (forkIO)
-import Control.Concurrent.Async
 import Control.Concurrent.STM
 import Control.Logger.Simple
 import Control.Monad
@@ -54,7 +53,6 @@ import Simplex.Chat.Markdown (Format (..), FormattedText (..), parseMaybeMarkdow
 import Simplex.Chat.Messages
 import Simplex.Chat.Options
 import Simplex.Chat.Protocol (MsgContent (..))
-import Simplex.Chat.Store (GroupLink (..))
 import Simplex.Chat.Store.Direct (getContact)
 import Simplex.Chat.Store.Groups (getGroupInfo, getGroupLink, getGroupSummary, getUserGroupsWithSummary, setGroupCustomData)
 import Simplex.Chat.Store.Profiles (GroupLinkInfo (..), getGroupLinkInfo)
@@ -69,7 +67,7 @@ import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), ConnectionLink (.
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (safeDecodeUtf8, tshow, unlessM, whenM, ($>>=), (<$$>))
+import Simplex.Messaging.Util (raceAny_, safeDecodeUtf8, tshow, unlessM, whenM, ($>>=), (<$$>))
 import System.Directory (getAppUserDataDirectory)
 import System.Exit (exitFailure)
 import System.Process (readProcess)
@@ -96,7 +94,8 @@ data GroupRolesStatus
 data ServiceState = ServiceState
  { searchRequests :: TMap ContactId SearchRequest,
    blockedWordsCfg :: BlockedWordsConfig,
-    pendingCaptchas :: TMap GroupMemberId PendingCaptcha
+    pendingCaptchas :: TMap GroupMemberId PendingCaptcha,
+    updateListingsJob :: TMVar ChatController
  }

 data PendingCaptcha = PendingCaptcha
@@ -119,7 +118,8 @@ newServiceState opts = do
  searchRequests <- TM.emptyIO
  blockedWordsCfg <- readBlockedWordsConfig opts
  pendingCaptchas <- TM.emptyIO
-  pure ServiceState {searchRequests, blockedWordsCfg, pendingCaptchas}
+  updateListingsJob <- newEmptyTMVarIO
+  pure ServiceState {searchRequests, blockedWordsCfg, pendingCaptchas, updateListingsJob}

 welcomeGetOpts :: IO DirectoryOpts
 welcomeGetOpts = do
@@ -146,22 +146,41 @@ directoryServiceCLI st opts = do
  env <- newServiceState opts
  eventQ <- newTQueueIO
  let eventHook cc resp = atomically $ resp <$ writeTQueue eventQ (cc, resp)
-      chatHooks = defaultChatHooks {postStartHook = Just $ directoryStartHook st opts, eventHook = Just eventHook, acceptMember = Just $ acceptMemberHook opts env}
-  race_
-    (simplexChatCLI' terminalChatConfig {chatHooks} (mkChatOpts opts) Nothing)
-    (processEvents eventQ env)
+      chatHooks = defaultChatHooks {postStartHook = Just $ directoryStartHook opts env, eventHook = Just eventHook, acceptMember = Just $ acceptMemberHook opts env}
+  raceAny_ $
+    [ simplexChatCLI' terminalChatConfig {chatHooks} (mkChatOpts opts) Nothing,
+      processEvents eventQ env
+    ]
+      <> updateListingsThread_ st opts env
  where
    processEvents eventQ env = forever $ do
      (cc, resp) <- atomically $ readTQueue eventQ
      u_ <- readTVarIO (currentUser cc)
      forM_ u_ $ \user -> directoryServiceEvent st opts env user cc resp

-directoryStartHook :: DirectoryStore -> DirectoryOpts -> ChatController -> IO ()
-directoryStartHook st opts cc =
+updateListingDelay :: Int
+updateListingDelay = 15 * 60 * 1000000 -- update every 15 minutes
+
+updateListingsThread_ :: DirectoryStore -> DirectoryOpts -> ServiceState -> [IO ()]
+updateListingsThread_ st opts env = maybe [] (\f -> [updateListingsThread f]) $ webFolder opts
+  where
+    updateListingsThread f = do
+      cc <- atomically $ takeTMVar $ updateListingsJob env
+      forever $ do
+        u <- readTVarIO $ currentUser cc
+        forM_ u $ \user -> updateGroupListingFiles cc st 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)
+
+directoryStartHook :: DirectoryOpts -> ServiceState -> ChatController -> IO ()
+directoryStartHook opts env cc =
  readTVarIO (currentUser cc) >>= \case
    Nothing -> putStrLn "No current user" >> exitFailure
-    Just user@User {userId, profile = p@LocalProfile {preferences}} -> do
-      forM_ (webFolder opts) $ updateGroupListingFiles cc st user
+    Just User {userId, profile = p@LocalProfile {preferences}} -> do
+      listingsUpdated env cc
      let cmds = fromMaybe [] $ preferences >>= commands_
      unless (cmds == directoryCommands) $ do
        let prefs = (fromMaybe emptyChatPrefs preferences) {files = Just FilesPreference {allow = FANo}, commands = Just directoryCommands} :: Preferences
@@ -188,12 +207,23 @@ directoryCommands =
  where
    idParam = Just "<ID>"

-directoryService :: DirectoryStore -> DirectoryOpts -> ServiceState -> User -> ChatController -> IO ()
-directoryService st opts@DirectoryOpts {testing} env user cc = do
-  initializeBotAddress' (not testing) cc
-  race_ (forever $ void getLine) . forever $ do
-    (_, resp) <- atomically . readTBQueue $ outputQ cc
-    directoryServiceEvent st opts env user cc resp
+directoryService :: DirectoryStore -> DirectoryOpts -> ChatConfig -> IO ()
+directoryService st opts@DirectoryOpts {testing} cfg = do
+  env <- newServiceState opts
+  let chatHooks =
+        defaultChatHooks
+          { postStartHook = Just $ directoryStartHook opts env,
+            acceptMember = Just $ acceptMemberHook opts env
+          }
+  simplexChatCore cfg {chatHooks} (mkChatOpts opts) $ \user cc -> do
+    initializeBotAddress' (not testing) cc
+    raceAny_ $
+      [ forever $ void getLine,
+        forever $ do
+          (_, resp) <- atomically . readTBQueue $ outputQ cc
+          directoryServiceEvent st opts env user cc resp
+      ]
+        <> updateListingsThread_ st opts env

 acceptMemberHook :: DirectoryOpts -> ServiceState -> GroupInfo -> GroupLinkInfo -> Profile -> IO (Either GroupRejectionReason (GroupAcceptance, GroupMemberRole))
 acceptMemberHook
@@ -301,7 +331,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
    getDuplicateGroup GroupInfo {groupId, groupProfile = GroupProfile {displayName, fullName}} =
      getGroups fullName >>= mapM duplicateGroup
      where
-        sameGroupNotRemoved (GIS g@GroupInfo {groupId = gId, groupProfile = GroupProfile {displayName = n, fullName = fn}} _) =
+        sameGroupNotRemoved (GIS g@GroupInfo {groupId = gId, groupProfile = GroupProfile {displayName = n, fullName = fn}} _ _) =
          gId /= groupId && n == displayName && fn == fullName && not (memberRemoved $ membership g)
        duplicateGroup [] = pure DGUnique
        duplicateGroup groups = do
@@ -310,13 +340,13 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
            then pure DGUnique
            else do
              (lgs, rgs) <- atomically $ (,) <$> readTVar (listedGroups st) <*> readTVar (reservedGroups st)
-              let reserved = any (\(GIS GroupInfo {groupId = gId} _) -> gId `S.member` lgs || gId `S.member` rgs) gs
+              let reserved = any (\(GIS GroupInfo {groupId = gId} _ _) -> gId `S.member` lgs || gId `S.member` rgs) gs
              if reserved
                then pure DGReserved
                else do
                  removed <- foldM (\r -> fmap (r &&) . isGroupRemoved) True gs
                  pure $ if removed then DGUnique else DGRegistered
-        isGroupRemoved (GIS GroupInfo {groupId = gId} _) =
+        isGroupRemoved (GIS GroupInfo {groupId = gId} _ _) =
          getGroupReg st gId >>= \case
            Just GroupReg {groupRegStatus} -> groupRemoved <$> readTVarIO groupRegStatus
            Nothing -> pure True
@@ -395,7 +425,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
          notifyOwner gr $ "Joined the group " <> displayName <> ", creating the link…"
          sendChatCmd cc (APICreateGroupLink groupId GRMember) >>= \case
            Right CRGroupLinkCreated {groupLink = GroupLink {connLinkContact = gLink}} -> do
-              setGroupStatus st opts cc user gr GRSPendingUpdate
+              setGroupStatus st env cc gr GRSPendingUpdate
              notifyOwner
                gr
                "Created the public link to join the group via this directory service that is always online.\n\n\
@@ -456,7 +486,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
            Just DGReserved -> notifyOwner gr $ groupAlreadyListed toGroup
            _ -> do
              let gaId = 1
-              setGroupStatus st opts cc user gr $ GRSPendingApproval gaId
+              setGroupStatus st env cc gr $ GRSPendingApproval gaId
              notifyOwner gr $
                ("Thank you! The group link for " <> userGroupReference gr toGroup <> " is added to the welcome message" <> byMember)
                  <> ".\nYou will be notified once the group is added to the directory - it may take up to 48 hours."
@@ -466,18 +496,18 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
              groupRef = groupReference toGroup
          groupProfileUpdate >>= \case
            GPNoServiceLink -> do
-              setGroupStatus st opts cc user gr GRSPendingUpdate
+              setGroupStatus st env cc gr GRSPendingUpdate
              notifyOwner gr $
                ("The group profile is updated for " <> userGroupRef <> byMember <> ", but no link is added to the welcome message.\n\n")
                  <> "The group will remain hidden from the directory until the group link is added and the group is re-approved."
            GPServiceLinkRemoved -> do
-              setGroupStatus st opts cc user gr GRSPendingUpdate
+              setGroupStatus st env cc gr GRSPendingUpdate
              notifyOwner gr $
                ("The group link for " <> userGroupRef <> " is removed from the welcome message" <> byMember)
                  <> ".\n\nThe group is hidden from the directory until the group link is added and the group is re-approved."
              notifyAdminUsers $ "The group link is removed from " <> groupRef <> ", de-listed."
            GPServiceLinkAdded _ -> do
-              setGroupStatus st opts cc user gr $ GRSPendingApproval n'
+              setGroupStatus st env cc gr $ GRSPendingApproval n'
              notifyOwner gr $
                ("The group link is added to " <> userGroupRef <> byMember)
                  <> "!\nIt is hidden from the directory until approved."
@@ -490,7 +520,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
                      <> "!\nThe group is listed in directory."
                  notifyAdminUsers $ "The group " <> groupRef <> " is updated" <> byMember <> " - only link or whitespace changes.\nThe group remained listed in directory."
              | otherwise -> do
-                  setGroupStatus st opts cc user gr $ GRSPendingApproval n'
+                  setGroupStatus st env cc gr $ GRSPendingApproval n'
                  notifyOwner gr $
                    ("The group " <> userGroupRef <> " is updated" <> byMember)
                      <> "!\nIt is hidden from the directory until approved."
@@ -628,14 +658,14 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
        when (ctId `isOwner` gr) $ do
          readTVarIO (groupRegStatus gr) >>= \case
            GRSSuspendedBadRoles -> when (rStatus == GRSOk) $ do
-              setGroupStatus st opts cc user gr GRSActive
+              setGroupStatus st env cc gr GRSActive
              notifyOwner gr $ uCtRole <> ".\n\nThe group is listed in the directory again."
              notifyAdminUsers $ "The group " <> groupRef <> " is listed " <> suCtRole
            GRSPendingApproval gaId -> when (rStatus == GRSOk) $ do
              sendToApprove g gr gaId
              notifyOwner gr $ uCtRole <> ".\n\nThe group is submitted for approval."
            GRSActive -> when (rStatus /= GRSOk) $ do
-              setGroupStatus st opts cc user gr GRSSuspendedBadRoles
+              setGroupStatus st env cc gr GRSSuspendedBadRoles
              notifyOwner gr $ uCtRole <> ".\n\nThe group is no longer listed in the directory."
              notifyAdminUsers $ "The group " <> groupRef <> " is de-listed " <> suCtRole
            _ -> pure ()
@@ -654,7 +684,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
        readTVarIO (groupRegStatus gr) >>= \case
          GRSSuspendedBadRoles -> when (serviceRole == GRAdmin) $
            whenContactIsOwner gr $ do
-              setGroupStatus st opts cc user gr GRSActive
+              setGroupStatus st env cc gr GRSActive
              notifyOwner gr $ uSrvRole <> ".\n\nThe group is listed in the directory again."
              notifyAdminUsers $ "The group " <> groupRef <> " is listed " <> suSrvRole
          GRSPendingApproval gaId -> when (serviceRole == GRAdmin) $
@@ -662,7 +692,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
              sendToApprove g gr gaId
              notifyOwner gr $ uSrvRole <> ".\n\nThe group is submitted for approval."
          GRSActive -> when (serviceRole /= GRAdmin) $ do
-            setGroupStatus st opts cc user gr GRSSuspendedBadRoles
+            setGroupStatus st env cc gr GRSSuspendedBadRoles
            notifyOwner gr $ uSrvRole <> ".\n\nThe group is no longer listed in the directory."
            notifyAdminUsers $ "The group " <> groupRef <> " is de-listed " <> suSrvRole
          _ -> pure ()
@@ -679,7 +709,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
      logInfo $ "contact ID " <> tshow ctId <> " removed from group " <> viewGroupName g
      withGroupReg g "contact removed" $ \gr -> do
        when (ctId `isOwner` gr) $ do
-          setGroupStatus st opts cc user gr GRSRemoved
+          setGroupStatus st env cc gr GRSRemoved
          notifyOwner gr $ "You are removed from the group " <> userGroupReference gr g <> ".\n\nThe group is no longer listed in the directory."
          notifyAdminUsers $ "The group " <> groupReference g <> " is de-listed (group owner is removed)."

@@ -688,7 +718,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
      logInfo $ "contact ID " <> tshow ctId <> " left group " <> viewGroupName g
      withGroupReg g "contact left" $ \gr -> do
        when (ctId `isOwner` gr) $ do
-          setGroupStatus st opts cc user gr GRSRemoved
+          setGroupStatus st env cc gr GRSRemoved
          notifyOwner gr $ "You left the group " <> userGroupReference gr g <> ".\n\nThe group is no longer listed in the directory."
          notifyAdminUsers $ "The group " <> groupReference g <> " is de-listed (group owner left)."

@@ -696,7 +726,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
    deServiceRemovedFromGroup g = do
      logInfo $ "service removed from group " <> viewGroupName g
      withGroupReg g "service removed" $ \gr -> do
-        setGroupStatus st opts cc user gr GRSRemoved
+        setGroupStatus st env cc gr GRSRemoved
        notifyOwner gr $ serviceName <> " is removed from the group " <> userGroupReference gr g <> ".\n\nThe group is no longer listed in the directory."
        notifyAdminUsers $ "The group " <> groupReference g <> " is de-listed (directory service is removed)."

@@ -704,7 +734,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
    deGroupDeleted g = do
      logInfo $ "group removed " <> viewGroupName g
      withGroupReg g "group removed" $ \gr -> do
-        setGroupStatus st opts cc user gr GRSRemoved
+        setGroupStatus st env cc gr GRSRemoved
        notifyOwner gr $ "The group " <> userGroupReference gr g <> " is deleted.\n\nThe group is no longer listed in the directory."
        notifyAdminUsers $ "The group " <> groupReference g <> " is de-listed (group is deleted)."

@@ -925,7 +955,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
          where
            msgs = replyMsg :| map foundGroup gs <> [moreMsg | moreGroups > 0]
            replyMsg = (Just ciId, MCText reply)
-            foundGroup (GIS GroupInfo {groupId, groupProfile = p@GroupProfile {image = image_}} GroupSummary {currentMembers}) =
+            foundGroup (GIS GroupInfo {groupId, groupProfile = p@GroupProfile {image = image_}} GroupSummary {currentMembers} _) =
              let membersStr = "_" <> tshow currentMembers <> " members_"
                  showId = if isAdmin then tshow groupId <> ". " else ""
                  text = showId <> groupInfoText p <> "\n" <> membersStr
@@ -946,16 +976,16 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
                        _ -> do
                          getGroupRolesStatus g gr >>= \case
                            Just GRSOk -> do
-                              setGroupStatus st opts cc user gr GRSActive
+                              setGroupStatus st env cc gr GRSActive
                              forM_ promote $ \promo ->
                                if promo -- admins can unpromote, only super-user can promote when approving
                                  then
                                    unlessM (readTVarIO promoted) $
                                      if knownCt `elem` superUsers
-                                        then setGroupPromoted st opts cc user gr True
+                                        then setGroupPromoted st env cc gr True
                                        else sendReply "You cannot promote groups"
                                  else do
-                                    whenM (readTVarIO promoted) $ setGroupPromoted st opts cc user gr False
+                                    whenM (readTVarIO promoted) $ setGroupPromoted st env cc gr False
                                    notifyOtherSuperUsers $ "Group promotion is disabled for " <> groupRef
                              let approved = "The group " <> userGroupReference' gr n <> " is approved"
                              notifyOwner gr $
@@ -991,7 +1021,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
            withGroupAndReg sendReply groupId gName $ \_ gr ->
              readTVarIO (groupRegStatus gr) >>= \case
                GRSActive -> do
-                  setGroupStatus st opts cc user gr GRSSuspended
+                  setGroupStatus st env cc gr GRSSuspended
                  let suspended = "The group " <> userGroupReference' gr gName <> " is suspended"
                  notifyOwner gr $ suspended <> " and hidden from directory. Please contact the administrators."
                  sendReply "Group suspended!"
@@ -1002,7 +1032,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
            withGroupAndReg sendReply groupId gName $ \_ gr ->
              readTVarIO (groupRegStatus gr) >>= \case
                GRSSuspended -> do
-                  setGroupStatus st opts cc user gr GRSActive
+                  setGroupStatus st env cc gr GRSActive
                  let groupStr = "The group " <> userGroupReference' gr gName
                  notifyOwner gr $ groupStr <> " is listed in the directory again!"
                  sendReply "Group listing resumed!"
@@ -1078,7 +1108,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
            withGroupAndReg sendReply groupId gName $ \_ gr@GroupReg {groupRegStatus, promoted} -> do
              status <- readTVarIO groupRegStatus
              promote <- readTVarIO promoted
-              when (promote' /= promote) $ setGroupPromoted st opts cc user gr promote'
+              when (promote' /= promote) $ setGroupPromoted st env cc gr promote'
              let msg =
                    "Group promotion "
                      <> (if promote' then "enabled" <> (if status == GRSActive then "." else ", but the group is not listed.") else "disabled.")
@@ -1132,18 +1162,16 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
          let text = T.unlines $ [tshow useGroupId <> ". Error: getGroup. Please notify the developers."] <> maybeToList ownerStr_ <> [statusStr]
          sendComposedMessage cc ct Nothing $ MCText text

-setGroupStatus :: DirectoryStore -> DirectoryOpts -> ChatController -> User -> GroupReg -> GroupRegStatus -> IO ()
-setGroupStatus st opts cc u gr grStatus' = do
+setGroupStatus :: DirectoryStore -> ServiceState -> ChatController -> GroupReg -> GroupRegStatus -> IO ()
+setGroupStatus st env cc gr grStatus' = do
  let status' = grDirectoryStatus grStatus'
  status <- setGroupStatusStore st gr grStatus'
-  forM_ (webFolder opts) $ \dir ->
-    when ((status == DSListed || status' == DSListed) && status /= status') $ updateGroupListingFiles cc st u dir
+  when ((status == DSListed || status' == DSListed) && status /= status') $ listingsUpdated env cc

-setGroupPromoted :: DirectoryStore -> DirectoryOpts -> ChatController -> User -> GroupReg -> Bool -> IO ()
-setGroupPromoted st opts cc u gr grPromoted' = do
+setGroupPromoted :: DirectoryStore -> ServiceState -> ChatController -> GroupReg -> Bool -> IO ()
+setGroupPromoted st env cc gr grPromoted' = do
  (status, grPromoted) <- setGroupPromotedStore st gr grPromoted'
-  forM_ (webFolder opts) $ \dir ->
-    when (status == DSListed && grPromoted' /= grPromoted) $ updateGroupListingFiles cc st u dir
+  when (status == DSListed && grPromoted' /= grPromoted) $ listingsUpdated env cc

 updateGroupListingFiles :: ChatController -> DirectoryStore -> User -> FilePath -> IO ()
 updateGroupListingFiles cc st u dir =
@@ -273,7 +273,7 @@ getUserGroupRegs st ctId = filter ((ctId ==) . dbContactId) <$> readTVarIO (grou
 filterListedGroups :: DirectoryStore -> [GroupInfoSummary] -> IO [GroupInfoSummary]
 filterListedGroups st gs = do
  lgs <- readTVarIO $ listedGroups st
-  pure $ filter (\(GIS GroupInfo {groupId} _) -> groupId `S.member` lgs) gs
+  pure $ filter (\(GIS GroupInfo {groupId} _ _) -> groupId `S.member` lgs) gs

 listGroup :: DirectoryStore -> GroupReg -> STM ()
 listGroup st gr = do