From 429ec9d21a0ab24ddd19240c52023f1b3bec3b43 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Thu, 18 Sep 2025 17:52:47 +0100
Subject: [PATCH] directory: listings for web pages (#6281)

* directory: listings for web pages

* refactor

* tests
---
 apps/simplex-directory-service/Main.hs        |   8 +-
 .../src/Directory/Events.hs                   |  14 +-
 .../src/Directory/Listing.hs                  |  97 +++++++++
 .../src/Directory/Options.hs                  |   9 +
 .../src/Directory/Service.hs                  | 185 +++++++++++-------
 .../src/Directory/Store.hs                    | 144 +++++++++-----
 .../src/Directory/Util.hs                     |  31 +++
 simplex-chat.cabal                            |   6 +
 tests/Bots/DirectoryTests.hs                  |  83 ++++++--
 9 files changed, 437 insertions(+), 140 deletions(-)
 create mode 100644 apps/simplex-directory-service/src/Directory/Listing.hs
 create mode 100644 apps/simplex-directory-service/src/Directory/Util.hs

diff --git a/apps/simplex-directory-service/Main.hs b/apps/simplex-directory-service/Main.hs
index 2091ab444b..e2b96f5677 100644
--- a/apps/simplex-directory-service/Main.hs
+++ b/apps/simplex-directory-service/Main.hs
@@ -17,5 +17,9 @@ main = do
     then directoryServiceCLI st opts
     else do
       env <- newServiceState opts
-      let cfg = terminalChatConfig {chatHooks = defaultChatHooks {acceptMember = Just $ acceptMemberHook opts env}}
-      simplexChatCore cfg (mkChatOpts opts) $ directoryService st opts env
+      let chatHooks =
+            defaultChatHooks
+              { postStartHook = Just $ directoryStartHook st opts,
+                acceptMember = Just $ acceptMemberHook opts env
+              }
+      simplexChatCore (terminalChatConfig {chatHooks}) (mkChatOpts opts) $ directoryService st opts env
diff --git a/apps/simplex-directory-service/src/Directory/Events.hs b/apps/simplex-directory-service/src/Directory/Events.hs
index 8ae7f60b3d..1f075c677c 100644
--- a/apps/simplex-directory-service/src/Directory/Events.hs
+++ b/apps/simplex-directory-service/src/Directory/Events.hs
@@ -135,6 +135,7 @@ data DirectoryCmdTag (r :: DirectoryRole) where
   DCInviteOwnerToGroup_ :: DirectoryCmdTag 'DRAdmin
   -- DCAddBlockedWord_ :: DirectoryCmdTag 'DRAdmin
   -- DCRemoveBlockedWord_ :: DirectoryCmdTag 'DRAdmin
+  DCPromoteGroup_ :: DirectoryCmdTag 'DRSuperUser
   DCExecuteCommand_ :: DirectoryCmdTag 'DRSuperUser
 
 deriving instance Show (DirectoryCmdTag r)
@@ -157,7 +158,7 @@ data DirectoryCmd (r :: DirectoryRole) where
   DCMemberRole :: UserGroupRegId -> Maybe GroupName -> Maybe GroupMemberRole -> DirectoryCmd 'DRUser
   DCGroupFilter :: UserGroupRegId -> Maybe GroupName -> Maybe DirectoryMemberAcceptance -> DirectoryCmd 'DRUser
   DCShowUpgradeGroupLink :: GroupId -> Maybe GroupName -> DirectoryCmd 'DRUser
-  DCApproveGroup :: {groupId :: GroupId, displayName :: GroupName, groupApprovalId :: GroupApprovalId} -> DirectoryCmd 'DRAdmin
+  DCApproveGroup :: {groupId :: GroupId, displayName :: GroupName, groupApprovalId :: GroupApprovalId, promote :: Maybe Bool} -> DirectoryCmd 'DRAdmin
   DCRejectGroup :: GroupId -> GroupName -> DirectoryCmd 'DRAdmin
   DCSuspendGroup :: GroupId -> GroupName -> DirectoryCmd 'DRAdmin
   DCResumeGroup :: GroupId -> GroupName -> DirectoryCmd 'DRAdmin
@@ -167,6 +168,7 @@ data DirectoryCmd (r :: DirectoryRole) where
   DCInviteOwnerToGroup :: GroupId -> GroupName -> DirectoryCmd 'DRAdmin
   -- DCAddBlockedWord :: Text -> DirectoryCmd 'DRAdmin
   -- DCRemoveBlockedWord :: Text -> DirectoryCmd 'DRAdmin
+  DCPromoteGroup :: GroupId -> GroupName -> Bool -> DirectoryCmd 'DRSuperUser
   DCExecuteCommand :: String -> DirectoryCmd 'DRSuperUser
   DCUnknownCommand :: DirectoryCmd 'DRUser
   DCCommandError :: DirectoryCmdTag r -> DirectoryCmd r
@@ -211,6 +213,7 @@ directoryCmdP =
         "invite" -> au DCInviteOwnerToGroup_
         -- "block_word" -> au DCAddBlockedWord_
         -- "unblock_word" -> au DCRemoveBlockedWord_
+        "promote" -> su DCPromoteGroup_
         "exec" -> su DCExecuteCommand_
         "x" -> su DCExecuteCommand_
         _ -> fail "bad command tag"
@@ -270,7 +273,8 @@ directoryCmdP =
       DCApproveGroup_ -> do
         (groupId, displayName) <- gc (,)
         groupApprovalId <- A.space *> A.decimal
-        pure DCApproveGroup {groupId, displayName, groupApprovalId}
+        promote <- Just <$> (" promote=" *> onOffP) <|> pure Nothing
+        pure DCApproveGroup {groupId, displayName, groupApprovalId, promote}
       DCRejectGroup_ -> gc DCRejectGroup
       DCSuspendGroup_ -> gc DCSuspendGroup
       DCResumeGroup_ -> gc DCResumeGroup
@@ -283,12 +287,17 @@ directoryCmdP =
       DCInviteOwnerToGroup_ -> gc DCInviteOwnerToGroup
       -- DCAddBlockedWord_ -> DCAddBlockedWord <$> wordP
       -- DCRemoveBlockedWord_ -> DCRemoveBlockedWord <$> wordP
+      DCPromoteGroup_ -> do
+        (groupId, displayName) <- gc (,)
+        promote <- A.space *> onOffP
+        pure $ DCPromoteGroup groupId displayName promote
       DCExecuteCommand_ -> DCExecuteCommand . T.unpack <$> (spacesP *> A.takeText)
       where
         gc f = f <$> (spacesP *> A.decimal) <*> (A.char ':' *> displayNameTextP)
         gc_ f = f <$> (spacesP *> A.decimal) <*> optional (A.char ':' *> displayNameTextP)
         -- wordP = spacesP *> A.takeTill isSpace
         spacesP = A.takeWhile1 isSpace
+        onOffP = (A.string "on" $> True) <|> (A.string "off" $> False)
 
 directoryCmdTag :: DirectoryCmd r -> Text
 directoryCmdTag = \case
@@ -314,6 +323,7 @@ directoryCmdTag = \case
   DCInviteOwnerToGroup {} -> "invite"
   -- DCAddBlockedWord _ -> "block_word"
   -- DCRemoveBlockedWord _ -> "unblock_word"
+  DCPromoteGroup {} -> "promote"
   DCExecuteCommand _ -> "exec"
   DCUnknownCommand -> "unknown"
   DCCommandError _ -> "error"
diff --git a/apps/simplex-directory-service/src/Directory/Listing.hs b/apps/simplex-directory-service/src/Directory/Listing.hs
new file mode 100644
index 0000000000..a05e82285d
--- /dev/null
+++ b/apps/simplex-directory-service/src/Directory/Listing.hs
@@ -0,0 +1,97 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
+
+module Directory.Listing where
+
+import Control.Applicative ((<|>))
+import Control.Concurrent.STM
+import Control.Monad
+import qualified Data.Aeson as J
+import qualified Data.Aeson.TH as JQ
+import Data.ByteString (ByteString)
+import Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Lazy as LB
+import Data.Maybe (fromMaybe)
+import qualified Data.Set as S
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
+import Directory.Store
+import Simplex.Chat.Types
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, taggedObjectJSON)
+import System.Directory
+import System.FilePath
+
+listingFileName :: String
+listingFileName = "listing.json"
+
+promotedFileName :: String
+promotedFileName = "promoted.json"
+
+listingImageFolder :: String
+listingImageFolder = "images"
+
+data DirectoryEntryType = DETGroup
+  { admission :: Maybe GroupMemberAdmission,
+    summary :: GroupSummary
+  }
+
+$(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "DET") ''DirectoryEntryType)
+
+data DirectoryEntry = DirectoryEntry
+  { entryType :: DirectoryEntryType,
+    displayName :: Text,
+    shortDescr :: Maybe Text,
+    welcomeMessage :: Maybe Text,
+    imageFile :: Maybe String
+  }
+
+$(JQ.deriveJSON defaultJSON ''DirectoryEntry)
+
+data DirectoryListing = DirectoryListing {entries :: [DirectoryEntry]}
+
+$(JQ.deriveJSON defaultJSON ''DirectoryListing)
+
+type ImageFileData = ByteString
+
+groupDirectoryEntry :: GroupInfoSummary -> (DirectoryEntry, Maybe (FilePath, ImageFileData))
+groupDirectoryEntry (GIS GroupInfo {groupId, groupProfile} summary) =
+  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)
+  where
+    imgFileData (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
+       in case B64.decode $ encodeUtf8 img' of
+            Right img'' -> Just (imgFile, img'')
+            Left _ -> Nothing
+
+generateListing :: DirectoryStore -> FilePath -> [GroupInfoSummary] -> IO ()
+generateListing st dir gs = do
+  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''
+  where
+    saveListing f = LB.writeFile (dir </> 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
diff --git a/apps/simplex-directory-service/src/Directory/Options.hs b/apps/simplex-directory-service/src/Directory/Options.hs
index 7ad3512fe9..e0052b3b1e 100644
--- a/apps/simplex-directory-service/src/Directory/Options.hs
+++ b/apps/simplex-directory-service/src/Directory/Options.hs
@@ -33,6 +33,7 @@ data DirectoryOpts = DirectoryOpts
     serviceName :: T.Text,
     runCLI :: Bool,
     searchResults :: Int,
+    webFolder :: Maybe FilePath,
     testing :: Bool
   }
 
@@ -124,6 +125,13 @@ directoryOpts appDir defaultDbName = do
       ( long "run-cli"
           <> help "Run directory service as CLI"
       )
+  webFolder <-
+    optional $
+      strOption
+        ( long "web-folder"
+            <> metavar "WEB_FOLDER"
+            <> help "Folder to store static web assets"
+        )
   pure
     DirectoryOpts
       { coreOptions,
@@ -140,6 +148,7 @@ directoryOpts appDir defaultDbName = do
         serviceName = T.pack serviceName,
         runCLI,
         searchResults = 10,
+        webFolder,
         testing = False
       }
 
diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs
index f95b04dee1..7bbe4e43a4 100644
--- a/apps/simplex-directory-service/src/Directory/Service.hs
+++ b/apps/simplex-directory-service/src/Directory/Service.hs
@@ -15,14 +15,14 @@ module Directory.Service
     directoryService,
     directoryServiceCLI,
     newServiceState,
-    acceptMemberHook
+    directoryStartHook,
+    acceptMemberHook,
   )
 where
 
 import Control.Concurrent (forkIO)
 import Control.Concurrent.Async
 import Control.Concurrent.STM
-import qualified Control.Exception as E
 import Control.Logger.Simple
 import Control.Monad
 import Control.Monad.Except
@@ -41,20 +41,22 @@ import Data.Time.LocalTime (getCurrentTimeZone)
 import Directory.BlockedWords
 import Directory.Captcha
 import Directory.Events
+import Directory.Listing
 import Directory.Options
 import Directory.Search
 import Directory.Store
+import Directory.Util
 import Simplex.Chat.Bot
 import Simplex.Chat.Bot.KnownContacts
 import Simplex.Chat.Controller
 import Simplex.Chat.Core
-import Simplex.Chat.Markdown (FormattedText (..), Format (..), parseMaybeMarkdownList, viewName)
+import Simplex.Chat.Markdown (Format (..), FormattedText (..), parseMaybeMarkdownList, viewName)
 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, setGroupCustomData)
+import Simplex.Chat.Store.Groups (getGroupInfo, getGroupLink, getGroupSummary, getUserGroupsWithSummary, setGroupCustomData)
 import Simplex.Chat.Store.Profiles (GroupLinkInfo (..), getGroupLinkInfo)
 import Simplex.Chat.Store.Shared (StoreError (..))
 import Simplex.Chat.Terminal (terminalChatConfig)
@@ -63,14 +65,11 @@ 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 (..), ConnectionLink (..), CreatedConnLink (..))
-import Simplex.Messaging.Agent.Store.Common (withTransaction)
-import Simplex.Messaging.Agent.Protocol (SConnectionMode (..), sameConnReqContact, sameShortLinkContact)
-import qualified Simplex.Messaging.Agent.Store.DB as DB
+import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), ConnectionLink (..), CreatedConnLink (..), SConnectionMode (..), sameConnReqContact, sameShortLinkContact)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (safeDecodeUtf8, tshow, ($>>=), (<$$>))
+import Simplex.Messaging.Util (safeDecodeUtf8, tshow, unlessM, whenM, ($>>=), (<$$>))
 import System.Directory (getAppUserDataDirectory)
 import System.Exit (exitFailure)
 import System.Process (readProcess)
@@ -147,7 +146,7 @@ directoryServiceCLI st opts = do
   env <- newServiceState opts
   eventQ <- newTQueueIO
   let eventHook cc resp = atomically $ resp <$ writeTQueue eventQ (cc, resp)
-      chatHooks = defaultChatHooks {postStartHook = Just postStartHook, eventHook = Just eventHook, acceptMember = Just $ acceptMemberHook opts env}
+      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)
@@ -156,18 +155,22 @@ directoryServiceCLI st opts = do
       (cc, resp) <- atomically $ readTQueue eventQ
       u_ <- readTVarIO (currentUser cc)
       forM_ u_ $ \user -> directoryServiceEvent st opts env user cc resp
-    postStartHook cc =
-      readTVarIO (currentUser cc) >>= \case
-        Nothing -> putStrLn "No current user" >> exitFailure
-        Just User {userId, profile = p@LocalProfile {preferences}} -> do
-          let cmds = fromMaybe [] $ preferences >>= commands_
-          unless (cmds == directoryCommands) $ do
-            let prefs = (fromMaybe emptyChatPrefs preferences) {files = Just FilesPreference {allow = FANo}, commands = Just directoryCommands} :: Preferences
-                p' = (fromLocalProfile p) {displayName = serviceName opts, peerType = Just CPTBot, preferences = Just prefs} :: Profile
-            liftIO $ sendChatCmd cc (APIUpdateProfile userId p') >>= \case
-              Right CRUserProfileUpdated {} -> putStrLn "Updated directory commands"
-              Right r -> putStrLn ("Error: unexpected response " <> show r) >> exitFailure
-              Left e -> putStrLn ("Error: " <> show e) >> exitFailure
+
+directoryStartHook :: DirectoryStore -> DirectoryOpts -> ChatController -> IO ()
+directoryStartHook st opts 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
+      let cmds = fromMaybe [] $ preferences >>= commands_
+      unless (cmds == directoryCommands) $ do
+        let prefs = (fromMaybe emptyChatPrefs preferences) {files = Just FilesPreference {allow = FANo}, commands = Just directoryCommands} :: Preferences
+            p' = (fromLocalProfile p) {displayName = serviceName opts, peerType = Just CPTBot, preferences = Just prefs} :: Profile
+        liftIO $
+          sendChatCmd cc (APIUpdateProfile userId p') >>= \case
+            Right CRUserProfileUpdated {} -> putStrLn "Updated directory commands"
+            Right r -> putStrLn ("Error: unexpected response " <> show r) >> exitFailure
+            Left e -> putStrLn ("Error: " <> show e) >> exitFailure
 
 directoryCommands :: [ChatBotCommand]
 directoryCommands =
@@ -323,7 +326,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
       void $ addGroupReg st ct g GRSProposed
       r <- sendChatCmd cc $ APIJoinGroup groupId MFNone
       sendMessage cc ct $ case r of
-        Right  CRUserAcceptedGroupSent {} -> "Joining the group " <> displayName <> "…"
+        Right CRUserAcceptedGroupSent {} -> "Joining the group " <> displayName <> "…"
         _ -> "Error joining group " <> displayName <> ", please re-send the invitation!"
 
     deContactConnected :: Contact -> IO ()
@@ -392,7 +395,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 gr GRSPendingUpdate
+              setGroupStatus st opts cc user gr GRSPendingUpdate
               notifyOwner
                 gr
                 "Created the public link to join the group via this directory service that is always online.\n\n\
@@ -431,7 +434,9 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
                 GPServiceLinkError -> do
                   notifyOwner gr $
                     ("Error: " <> serviceName <> " has no group link for " <> userGroupRef)
-                      <> " after profile was updated" <> byMember <> ". Please report the error to the developers."
+                      <> " after profile was updated"
+                      <> byMember
+                      <> ". Please report the error to the developers."
                   logError $ "Error: no group link for " <> userGroupRef
             GRSPendingApproval n -> processProfileChange gr byMember False $ n + 1
             GRSActive -> processProfileChange gr byMember True 1
@@ -451,7 +456,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
             Just DGReserved -> notifyOwner gr $ groupAlreadyListed toGroup
             _ -> do
               let gaId = 1
-              setGroupStatus st gr $ GRSPendingApproval gaId
+              setGroupStatus st opts cc user 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."
@@ -461,18 +466,18 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
               groupRef = groupReference toGroup
           groupProfileUpdate >>= \case
             GPNoServiceLink -> do
-              setGroupStatus st gr GRSPendingUpdate
+              setGroupStatus st opts cc user 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 gr GRSPendingUpdate
+              setGroupStatus st opts cc user 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 gr $ GRSPendingApproval n'
+              setGroupStatus st opts cc user gr $ GRSPendingApproval n'
               notifyOwner gr $
                 ("The group link is added to " <> userGroupRef <> byMember)
                   <> "!\nIt is hidden from the directory until approved."
@@ -485,7 +490,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 gr $ GRSPendingApproval n'
+                  setGroupStatus st opts cc user gr $ GRSPendingApproval n'
                   notifyOwner gr $
                     ("The group " <> userGroupRef <> " is updated" <> byMember)
                       <> "!\nIt is hidden from the directory until approved."
@@ -523,7 +528,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
             Just Nothing -> sendToApprove toGroup gr gaId
 
     dePendingMember :: GroupInfo -> GroupMember -> IO ()
-    dePendingMember g@GroupInfo {groupProfile = GroupProfile {displayName}}  m
+    dePendingMember g@GroupInfo {groupProfile = GroupProfile {displayName}} m
       | memberRequiresCaptcha a m = sendMemberCaptcha g m Nothing captchaNotice 0
       | otherwise = approvePendingMember a g m
       where
@@ -600,7 +605,8 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
       useMemberFilter image $ passCaptcha a
 
     sendToApprove :: GroupInfo -> GroupReg -> GroupApprovalId -> IO ()
-    sendToApprove GroupInfo {groupProfile = p@GroupProfile {displayName, image = image'}} GroupReg {dbGroupId, dbContactId} gaId = do
+    sendToApprove GroupInfo {groupProfile = p@GroupProfile {displayName, image = image'}} GroupReg {dbGroupId, dbContactId, promoted} gaId = do
+      -- TODO account for promotion
       ct_ <- getContact' cc user dbContactId
       gr_ <- getGroupAndSummary cc user dbGroupId
       let membersStr = maybe "" (\(_, s) -> "_" <> tshow (currentMembers s) <> " members_\n") gr_
@@ -608,9 +614,10 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
             maybe ("The group ID " <> tshow dbGroupId <> " submitted: ") (\c -> localDisplayName' c <> " submitted the group ID " <> tshow dbGroupId <> ": ") ct_
               <> ("\n" <> groupInfoText p <> "\n" <> membersStr <> "\nTo approve send:")
           msg = maybe (MCText text) (\image -> MCImage {text, image}) image'
+      promote <- readTVarIO promoted
       withAdminUsers $ \cId -> do
         sendComposedMessage' cc cId Nothing msg
-        sendMessage' cc cId $ "/approve " <> tshow dbGroupId <> ":" <> viewName displayName <> " " <> tshow gaId
+        sendMessage' cc cId $ "/approve " <> tshow dbGroupId <> ":" <> viewName displayName <> " " <> tshow gaId <> if promote then " promote=on" else ""
 
     deContactRoleChanged :: GroupInfo -> ContactId -> GroupMemberRole -> IO ()
     deContactRoleChanged g@GroupInfo {membership = GroupMember {memberRole = serviceRole}} ctId contactRole = do
@@ -621,14 +628,14 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
         when (ctId `isOwner` gr) $ do
           readTVarIO (groupRegStatus gr) >>= \case
             GRSSuspendedBadRoles -> when (rStatus == GRSOk) $ do
-              setGroupStatus st gr GRSActive
+              setGroupStatus st opts cc user 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 gr GRSSuspendedBadRoles
+              setGroupStatus st opts cc user gr GRSSuspendedBadRoles
               notifyOwner gr $ uCtRole <> ".\n\nThe group is no longer listed in the directory."
               notifyAdminUsers $ "The group " <> groupRef <> " is de-listed " <> suCtRole
             _ -> pure ()
@@ -647,7 +654,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
         readTVarIO (groupRegStatus gr) >>= \case
           GRSSuspendedBadRoles -> when (serviceRole == GRAdmin) $
             whenContactIsOwner gr $ do
-              setGroupStatus st gr GRSActive
+              setGroupStatus st opts cc user 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) $
@@ -655,7 +662,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 gr GRSSuspendedBadRoles
+            setGroupStatus st opts cc user gr GRSSuspendedBadRoles
             notifyOwner gr $ uSrvRole <> ".\n\nThe group is no longer listed in the directory."
             notifyAdminUsers $ "The group " <> groupRef <> " is de-listed " <> suSrvRole
           _ -> pure ()
@@ -672,7 +679,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 gr GRSRemoved
+          setGroupStatus st opts cc user 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)."
 
@@ -681,7 +688,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 gr GRSRemoved
+          setGroupStatus st opts cc user 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)."
 
@@ -689,7 +696,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 gr GRSRemoved
+        setGroupStatus st opts cc user 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)."
 
@@ -697,7 +704,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
     deGroupDeleted g = do
       logInfo $ "group removed " <> viewGroupName g
       withGroupReg g "group removed" $ \gr -> do
-        setGroupStatus st gr GRSRemoved
+        setGroupStatus st opts cc user 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)."
 
@@ -817,12 +824,13 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
           withGroupLinkResult groupRef (sendChatCmd cc $ APIGetGroupLink groupId) $
             \GroupLink {connLinkContact = gLink@(CCLink _ sLnk_), acceptMemberRole, shortLinkDataSet, shortLinkLargeDataSet = BoolDef slLargeDataSet} -> do
               let shouldBeUpgraded = isNothing sLnk_ || not shortLinkDataSet || not slLargeDataSet
-              sendReply $ T.unlines $
-                [ "The link to join the group " <> groupRef <> ":",
-                  groupLinkText gLink,
-                  "New member role: " <> strEncodeTxt acceptMemberRole
-                ]
-                  <> ["The link is being upgraded..." | shouldBeUpgraded]
+              sendReply $
+                T.unlines $
+                  [ "The link to join the group " <> groupRef <> ":",
+                    groupLinkText gLink,
+                    "New member role: " <> strEncodeTxt acceptMemberRole
+                  ]
+                    <> ["The link is being upgraded..." | shouldBeUpgraded]
               when shouldBeUpgraded $ do
                 let send = sendComposedMessage cc ct Nothing . MCText . T.unlines
                 withGroupLinkResult groupRef (sendChatCmd cc $ APIAddGroupShortLink groupId) $
@@ -830,13 +838,16 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
                     (Just _, Just _) ->
                       send ["The group link is upgraded for: " <> groupRef, "No changes to group needed."]
                     (Nothing, Just sLnk) ->
-                      sendComposedMessages cc (SRDirect $ contactId' ct)
-                        [ MCText $ T.unlines
-                            [ "Please replace the old link in welcome message of your group " <> groupRef,
-                              "If this is the only change, the group will remain listed in directory without re-approval.",
-                              "",
-                              "The new link:"
-                            ],
+                      sendComposedMessages
+                        cc
+                        (SRDirect $ contactId' ct)
+                        [ MCText $
+                            T.unlines
+                              [ "Please replace the old link in welcome message of your group " <> groupRef,
+                                "If this is the only change, the group will remain listed in directory without re-approval.",
+                                "",
+                                "The new link:"
+                              ],
                           MCText $ strEncodeTxt sLnk
                         ]
                     (_, Nothing) ->
@@ -924,8 +935,8 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
     deAdminCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRAdmin -> IO ()
     deAdminCommand ct ciId cmd
       | knownCt `elem` adminUsers || knownCt `elem` superUsers = case cmd of
-          DCApproveGroup {groupId, displayName = n, groupApprovalId} ->
-            withGroupAndReg sendReply groupId n $ \g gr@GroupReg {userGroupRegId = ugrId} ->
+          DCApproveGroup {groupId, displayName = n, groupApprovalId, promote} ->
+            withGroupAndReg sendReply groupId n $ \g gr@GroupReg {userGroupRegId = ugrId, promoted} ->
               readTVarIO (groupRegStatus gr) >>= \case
                 GRSPendingApproval gaId
                   | gaId == groupApprovalId -> do
@@ -935,7 +946,17 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
                         _ -> do
                           getGroupRolesStatus g gr >>= \case
                             Just GRSOk -> do
-                              setGroupStatus st gr GRSActive
+                              setGroupStatus st opts cc user 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
+                                        else sendReply "You cannot promote groups"
+                                  else do
+                                    whenM (readTVarIO promoted) $ setGroupPromoted st opts cc user gr False
+                                    notifyOtherSuperUsers $ "Group promotion is disabled for " <> groupRef
                               let approved = "The group " <> userGroupReference' gr n <> " is approved"
                               notifyOwner gr $
                                 (approved <> " and listed in directory - please moderate it!\n")
@@ -970,7 +991,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
             withGroupAndReg sendReply groupId gName $ \_ gr ->
               readTVarIO (groupRegStatus gr) >>= \case
                 GRSActive -> do
-                  setGroupStatus st gr GRSSuspended
+                  setGroupStatus st opts cc user 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!"
@@ -981,7 +1002,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
             withGroupAndReg sendReply groupId gName $ \_ gr ->
               readTVarIO (groupRegStatus gr) >>= \case
                 GRSSuspended -> do
-                  setGroupStatus st gr GRSActive
+                  setGroupStatus st opts cc user gr GRSActive
                   let groupStr = "The group " <> userGroupReference' gr gName
                   notifyOwner gr $ groupStr <> " is listed in the directory again!"
                   sendReply "Group listing resumed!"
@@ -1002,7 +1023,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
                   Right () -> do
                     let groupRef = groupReference' groupId gName
                     owner <- groupOwnerInfo groupRef ctId
-                    let invited =  " invited " <> owner <> " to owners' group " <> viewName ogName
+                    let invited = " invited " <> owner <> " to owners' group " <> viewName ogName
                     notifyOtherSuperUsers $ viewName (localDisplayName' ct) <> invited
                     sendReply $ "you" <> invited
                   Left err -> sendReply err
@@ -1039,7 +1060,7 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
                     r -> contErr r
             r -> contErr r
           where
-            alreadyMember = isJust . find ((Just ctId == ) . memberContactId)
+            alreadyMember = isJust . find ((Just ctId ==) . memberContactId)
             contErr r = do
               let err = "error inviting contact ID " <> tshow ctId <> " to owners' group: " <> tshow r
               putStrLn $ T.unpack err
@@ -1053,6 +1074,15 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName
     deSuperUserCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRSuperUser -> IO ()
     deSuperUserCommand ct ciId cmd
       | knownContact ct `elem` superUsers = case cmd of
+          DCPromoteGroup groupId gName promote' ->
+            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'
+              let msg =
+                    "Group promotion "
+                      <> (if promote' then "enabled" <> (if status == GRSActive then "." else ", but the group is not listed.") else "disabled.")
+              sendReply msg
           DCExecuteCommand cmdStr ->
             sendChatCmdStr cc cmdStr >>= \case
               Right r -> do
@@ -1102,30 +1132,35 @@ 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
+  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
+
+setGroupPromoted :: DirectoryStore -> DirectoryOpts -> ChatController -> User -> GroupReg -> Bool -> IO ()
+setGroupPromoted st opts cc u gr grPromoted' = do
+  (status, grPromoted) <- setGroupPromotedStore st gr grPromoted'
+  forM_ (webFolder opts) $ \dir ->
+    when (status == DSListed && grPromoted' /= grPromoted) $ updateGroupListingFiles cc st u dir
+
+updateGroupListingFiles :: ChatController -> DirectoryStore -> User -> FilePath -> IO ()
+updateGroupListingFiles cc st u dir =
+  withDB' "generateListing" cc (\db -> getUserGroupsWithSummary db (vr cc) u Nothing Nothing) >>= \case
+    Just gs -> generateListing st dir gs
+    Nothing -> putStrLn "generateListing error: failed to read groups"
+
 getContact' :: ChatController -> User -> ContactId -> IO (Maybe Contact)
 getContact' cc user ctId = withDB "getContact" cc $ \db -> getContact db (vr cc) user ctId
 
 getGroup :: ChatController -> User -> GroupId -> IO (Maybe GroupInfo)
 getGroup cc user gId = withDB "getGroupInfo" cc $ \db -> getGroupInfo db (vr cc) user gId
 
-withDB' :: Text -> ChatController -> (DB.Connection -> IO a) -> IO (Maybe a)
-withDB' cxt cc a = withDB cxt cc $ ExceptT . fmap Right . a
-
-withDB :: Text -> ChatController -> (DB.Connection -> ExceptT StoreError IO a) -> IO (Maybe a)
-withDB cxt ChatController {chatStore} action = do
-  r_ :: Either ChatError a <- withTransaction chatStore (runExceptT . withExceptT ChatErrorStore . action) `E.catches` handleDBErrors
-  case r_ of
-    Right r -> pure $ Just r
-    Left e -> Nothing <$ logError ("Database error: " <> cxt <> " " <> tshow e)
-
 getGroupAndSummary :: ChatController -> User -> GroupId -> IO (Maybe (GroupInfo, GroupSummary))
 getGroupAndSummary cc user gId =
   withDB "getGroupAndSummary" cc $ \db -> (,) <$> getGroupInfo db (vr cc) user gId <*> liftIO (getGroupSummary db user gId)
 
-vr :: ChatController -> VersionRangeChat
-vr ChatController {config = ChatConfig {chatVRange}} = chatVRange
-{-# INLINE vr #-}
-
 getGroupLink' :: ChatController -> User -> GroupInfo -> IO (Maybe GroupLink)
 getGroupLink' cc user gInfo =
   withDB "getGroupLink" cc $ \db -> getGroupLink db user gInfo
diff --git a/apps/simplex-directory-service/src/Directory/Store.hs b/apps/simplex-directory-service/src/Directory/Store.hs
index 9498fedf95..16f047202f 100644
--- a/apps/simplex-directory-service/src/Directory/Store.hs
+++ b/apps/simplex-directory-service/src/Directory/Store.hs
@@ -13,11 +13,14 @@ module Directory.Store
     GroupApprovalId,
     DirectoryGroupData (..),
     DirectoryMemberAcceptance (..),
+    DirectoryStatus (..),
     ProfileCondition (..),
     restoreDirectoryStore,
     addGroupReg,
     delGroupReg,
-    setGroupStatus,
+    setGroupStatusStore,
+    setGroupPromotedStore,
+    grDirectoryStatus,
     setGroupRegOwner,
     getGroupReg,
     getUserGroupReg,
@@ -31,13 +34,14 @@ module Directory.Store
     noJoinFilter,
     basicJoinFilter,
     moderateJoinFilter,
-    strongJoinFilter
+    strongJoinFilter,
   )
 where
 
+import Control.Applicative ((<|>))
 import Control.Concurrent.STM
 import Control.Monad
-import Data.Aeson ((.=), (.:))
+import Data.Aeson ((.:), (.=))
 import qualified Data.Aeson.KeyMap as JM
 import qualified Data.Aeson.TH as JQ
 import qualified Data.Aeson.Types as JT
@@ -55,23 +59,32 @@ import Data.Text (Text)
 import Simplex.Chat.Types
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)
-import Simplex.Messaging.Util (ifM)
-import System.Directory (doesFileExist, renameFile)
+import Simplex.Messaging.Util (ifM, whenM)
+import System.Directory
 import System.IO (BufferMode (..), Handle, IOMode (..), hSetBuffering, openFile)
 
 data DirectoryStore = DirectoryStore
-  { groupRegs :: TVar [GroupReg],
-    listedGroups :: TVar (Set GroupId),
+  { groupRegs :: TVar [GroupReg], -- most recent first, reversed when listed
+    listedGroups :: TVar (Set GroupId), -- includes promoted
+    promotedGroups :: TVar (Set GroupId),
     reservedGroups :: TVar (Set GroupId),
     directoryLogFile :: Maybe Handle
   }
 
+data DirectoryStoreData = DirectoryStoreData
+  { groupRegs_ :: [GroupReg],
+    listedGroups_ :: Set GroupId,
+    promotedGroups_ :: Set GroupId,
+    reservedGroups_ :: Set GroupId
+  }
+
 data GroupReg = GroupReg
   { dbGroupId :: GroupId,
     userGroupRegId :: UserGroupRegId,
     dbContactId :: ContactId,
     dbOwnerMemberId :: TVar (Maybe GroupMemberId),
-    groupRegStatus :: TVar GroupRegStatus
+    groupRegStatus :: TVar GroupRegStatus,
+    promoted :: TVar Bool
   }
 
 data GroupRegData = GroupRegData
@@ -79,7 +92,8 @@ data GroupRegData = GroupRegData
     userGroupRegId_ :: UserGroupRegId,
     dbContactId_ :: ContactId,
     dbOwnerMemberId_ :: Maybe GroupMemberId,
-    groupRegStatus_ :: GroupRegStatus
+    groupRegStatus_ :: GroupRegStatus,
+    promoted_ :: Bool
   }
 
 data DirectoryGroupData = DirectoryGroupData
@@ -140,7 +154,7 @@ data GroupRegStatus
   | GRSSuspended
   | GRSSuspendedBadRoles
   | GRSRemoved
-  deriving (Show)
+  deriving (Eq, Show)
 
 pendingApproval :: GroupRegStatus -> Bool
 pendingApproval = \case
@@ -153,6 +167,7 @@ groupRemoved = \case
   _ -> False
 
 data DirectoryStatus = DSListed | DSReserved | DSRegistered | DSRemoved
+  deriving (Eq)
 
 groupRegStatusText :: GroupRegStatus -> Text
 groupRegStatusText = \case
@@ -195,7 +210,7 @@ addGroupReg st ct GroupInfo {groupId} grStatus = do
   pure $ userGroupRegId_ grData
   where
     addGroupReg_ = do
-      let grData = GroupRegData {dbGroupId_ = groupId, userGroupRegId_ = 1, dbContactId_ = ctId, dbOwnerMemberId_ = Nothing, groupRegStatus_ = grStatus}
+      let grData = GroupRegData {dbGroupId_ = groupId, userGroupRegId_ = 1, dbContactId_ = ctId, dbOwnerMemberId_ = Nothing, groupRegStatus_ = grStatus, promoted_ = False}
       gr <- dataToGroupReg grData
       atomically $ stateTVar (groupRegs st) $ \grs ->
         let ugrId = 1 + foldl' maxUgrId 0 grs
@@ -208,25 +223,38 @@ addGroupReg st ct GroupInfo {groupId} grStatus = do
       | otherwise = mx
 
 delGroupReg :: DirectoryStore -> GroupReg -> IO ()
-delGroupReg st GroupReg {dbGroupId = gId, groupRegStatus} = do
+delGroupReg st gr@GroupReg {dbGroupId = gId, groupRegStatus} = do
   logGDelete st gId
   atomically $ writeTVar groupRegStatus GRSRemoved
-  atomically $ unlistGroup st gId
+  atomically $ unlistGroup st gr
   atomically $ modifyTVar' (groupRegs st) $ filter ((gId /=) . dbGroupId)
 
-setGroupStatus :: DirectoryStore -> GroupReg -> GroupRegStatus -> IO ()
-setGroupStatus st gr grStatus = do
-  logGUpdateStatus st (dbGroupId gr) grStatus
+setGroupStatusStore :: DirectoryStore -> GroupReg -> GroupRegStatus -> IO DirectoryStatus
+setGroupStatusStore st gr grStatus' = do
+  logGUpdateStatus st (dbGroupId gr) grStatus'
   atomically $ do
-    writeTVar (groupRegStatus gr) grStatus
-    updateListing st $ dbGroupId gr
+    grStatus <- swapTVar (groupRegStatus gr) grStatus'
+    updateListing st gr
+    pure $ grDirectoryStatus grStatus
   where
-    updateListing = case grDirectoryStatus grStatus of
+    status' = grDirectoryStatus grStatus'
+    updateListing = case status' of
       DSListed -> listGroup
       DSReserved -> reserveGroup
       DSRegistered -> unlistGroup
       DSRemoved -> unlistGroup
 
+setGroupPromotedStore :: DirectoryStore -> GroupReg -> Bool -> IO (DirectoryStatus, Bool)
+setGroupPromotedStore st gr grPromoted' = do
+  let gId = dbGroupId gr
+  logGUpdatePromotion st gId grPromoted'
+  atomically $ do
+    grPromoted <- swapTVar (promoted gr) grPromoted'
+    status <- grDirectoryStatus <$> readTVar (groupRegStatus gr)
+    let update = if status == DSListed && grPromoted' then S.insert else S.delete
+    modifyTVar' (promotedGroups st) $ update gId
+    pure (status, grPromoted)
+
 setGroupRegOwner :: DirectoryStore -> GroupReg -> GroupMember -> IO ()
 setGroupRegOwner st gr owner = do
   let memberId = groupMemberId' owner
@@ -247,31 +275,39 @@ filterListedGroups st gs = do
   lgs <- readTVarIO $ listedGroups st
   pure $ filter (\(GIS GroupInfo {groupId} _) -> groupId `S.member` lgs) gs
 
-listGroup :: DirectoryStore -> GroupId -> STM ()
-listGroup st gId = do
+listGroup :: DirectoryStore -> GroupReg -> STM ()
+listGroup st gr = do
+  let gId = dbGroupId gr
   modifyTVar' (listedGroups st) $ S.insert gId
+  whenM (readTVar $ promoted gr) $ modifyTVar' (promotedGroups st) $ S.insert gId
   modifyTVar' (reservedGroups st) $ S.delete gId
 
-reserveGroup :: DirectoryStore -> GroupId -> STM ()
-reserveGroup st gId = do
+reserveGroup :: DirectoryStore -> GroupReg -> STM ()
+reserveGroup st gr = do
+  let gId = dbGroupId gr
   modifyTVar' (listedGroups st) $ S.delete gId
+  modifyTVar' (promotedGroups st) $ S.delete gId
   modifyTVar' (reservedGroups st) $ S.insert gId
 
-unlistGroup :: DirectoryStore -> GroupId -> STM ()
-unlistGroup st gId = do
+unlistGroup :: DirectoryStore -> GroupReg -> STM ()
+unlistGroup st gr = do
+  let gId = dbGroupId gr
   modifyTVar' (listedGroups st) $ S.delete gId
+  modifyTVar' (promotedGroups st) $ S.delete gId
   modifyTVar' (reservedGroups st) $ S.delete gId
 
 data DirectoryLogRecord
   = GRCreate GroupRegData
   | GRDelete GroupId
   | GRUpdateStatus GroupId GroupRegStatus
+  | GRUpdatePromotion GroupId Bool
   | GRUpdateOwner GroupId GroupMemberId
 
 data DLRTag
   = GRCreate_
   | GRDelete_
   | GRUpdateStatus_
+  | GRUpdatePromotion_
   | GRUpdateOwner_
 
 logDLR :: DirectoryStore -> DirectoryLogRecord -> IO ()
@@ -286,6 +322,9 @@ logGDelete st = logDLR st . GRDelete
 logGUpdateStatus :: DirectoryStore -> GroupId -> GroupRegStatus -> IO ()
 logGUpdateStatus st gId = logDLR st . GRUpdateStatus gId
 
+logGUpdatePromotion :: DirectoryStore -> GroupId -> Bool -> IO ()
+logGUpdatePromotion st gId = logDLR st . GRUpdatePromotion gId
+
 logGUpdateOwner :: DirectoryStore -> GroupId -> GroupMemberId -> IO ()
 logGUpdateOwner st gId = logDLR st . GRUpdateOwner gId
 
@@ -294,12 +333,14 @@ instance StrEncoding DLRTag where
     GRCreate_ -> "GCREATE"
     GRDelete_ -> "GDELETE"
     GRUpdateStatus_ -> "GSTATUS"
+    GRUpdatePromotion_ -> "GPROMOTE"
     GRUpdateOwner_ -> "GOWNER"
   strP =
     A.takeTill (== ' ') >>= \case
       "GCREATE" -> pure GRCreate_
       "GDELETE" -> pure GRDelete_
       "GSTATUS" -> pure GRUpdateStatus_
+      "GPROMOTE" -> pure GRUpdatePromotion_
       "GOWNER" -> pure GRUpdateOwner_
       _ -> fail "invalid DLRTag"
 
@@ -308,30 +349,34 @@ instance StrEncoding DirectoryLogRecord where
     GRCreate gr -> strEncode (GRCreate_, gr)
     GRDelete gId -> strEncode (GRDelete_, gId)
     GRUpdateStatus gId grStatus -> strEncode (GRUpdateStatus_, gId, grStatus)
+    GRUpdatePromotion gId promoted -> strEncode (GRUpdatePromotion_, gId, promoted)
     GRUpdateOwner gId grOwnerId -> strEncode (GRUpdateOwner_, gId, grOwnerId)
   strP =
     strP_ >>= \case
       GRCreate_ -> GRCreate <$> strP
       GRDelete_ -> GRDelete <$> strP
       GRUpdateStatus_ -> GRUpdateStatus <$> A.decimal <*> _strP
+      GRUpdatePromotion_ -> GRUpdatePromotion <$> A.decimal <*> _strP
       GRUpdateOwner_ -> GRUpdateOwner <$> A.decimal <* A.space <*> A.decimal
 
 instance StrEncoding GroupRegData where
-  strEncode GroupRegData {dbGroupId_, userGroupRegId_, dbContactId_, dbOwnerMemberId_, groupRegStatus_} =
-    B.unwords
+  strEncode GroupRegData {dbGroupId_, userGroupRegId_, dbContactId_, dbOwnerMemberId_, groupRegStatus_, promoted_} =
+    B.unwords $
       [ "group_id=" <> strEncode dbGroupId_,
         "user_group_id=" <> strEncode userGroupRegId_,
         "contact_id=" <> strEncode dbContactId_,
         "owner_member_id=" <> strEncode dbOwnerMemberId_,
         "status=" <> strEncode groupRegStatus_
       ]
+        <> ["promoted=" <> strEncode promoted_ | promoted_]
   strP = do
     dbGroupId_ <- "group_id=" *> strP_
     userGroupRegId_ <- "user_group_id=" *> strP_
     dbContactId_ <- "contact_id=" *> strP_
     dbOwnerMemberId_ <- "owner_member_id=" *> strP_
     groupRegStatus_ <- "status=" *> strP
-    pure GroupRegData {dbGroupId_, userGroupRegId_, dbContactId_, dbOwnerMemberId_, groupRegStatus_}
+    promoted_ <- (" promoted=" *> strP) <|> pure False
+    pure GroupRegData {dbGroupId_, userGroupRegId_, dbContactId_, dbOwnerMemberId_, groupRegStatus_, promoted_}
 
 instance StrEncoding GroupRegStatus where
   strEncode = \case
@@ -356,16 +401,18 @@ instance StrEncoding GroupRegStatus where
       _ -> fail "invalid GroupRegStatus"
 
 dataToGroupReg :: GroupRegData -> IO GroupReg
-dataToGroupReg GroupRegData {dbGroupId_, userGroupRegId_, dbContactId_, dbOwnerMemberId_, groupRegStatus_} = do
+dataToGroupReg GroupRegData {dbGroupId_, userGroupRegId_, dbContactId_, dbOwnerMemberId_, groupRegStatus_, promoted_} = do
   dbOwnerMemberId <- newTVarIO dbOwnerMemberId_
   groupRegStatus <- newTVarIO groupRegStatus_
+  promoted <- newTVarIO promoted_
   pure
     GroupReg
       { dbGroupId = dbGroupId_,
         userGroupRegId = userGroupRegId_,
         dbContactId = dbContactId_,
         dbOwnerMemberId,
-        groupRegStatus
+        groupRegStatus,
+        promoted
       }
 
 restoreDirectoryStore :: Maybe FilePath -> IO DirectoryStore
@@ -383,8 +430,8 @@ restoreDirectoryStore = \case
       h <- writeDirectoryData f grs -- compact
       mkDirectoryStore h grs
 
-emptyStoreData :: ([GroupReg], Set GroupId, Set GroupId)
-emptyStoreData = ([], S.empty, S.empty)
+emptyStoreData :: DirectoryStoreData
+emptyStoreData = DirectoryStoreData [] S.empty S.empty S.empty
 
 newDirectoryStore :: Maybe Handle -> IO DirectoryStore
 newDirectoryStore = (`mkDirectoryStore_` emptyStoreData)
@@ -393,21 +440,27 @@ mkDirectoryStore :: Handle -> [GroupRegData] -> IO DirectoryStore
 mkDirectoryStore h groups =
   foldM addGroupRegData emptyStoreData groups >>= mkDirectoryStore_ (Just h)
   where
-    addGroupRegData (!grs, !listed, !reserved) gr@GroupRegData {dbGroupId_ = gId} = do
+    addGroupRegData d gr@GroupRegData {dbGroupId_ = gId} = do
       gr' <- dataToGroupReg gr
-      let grs' = gr' : grs
+      let !grs' = gr' : groupRegs_ d
       pure $ case grDirectoryStatus $ groupRegStatus_ gr of
-        DSListed -> (grs', S.insert gId listed, reserved)
-        DSReserved -> (grs', listed, S.insert gId reserved)
-        DSRegistered -> (grs', listed, reserved)
-        DSRemoved -> (grs, listed, reserved)
+        DSListed ->
+          let !listed = S.insert gId $ listedGroups_ d
+              !promoted = (if promoted_ gr then S.insert gId else id) $ promotedGroups_ d
+           in d {groupRegs_ = grs', listedGroups_ = listed, promotedGroups_ = promoted}
+        DSReserved ->
+          let !reserved = S.insert gId $ reservedGroups_ d
+           in d {groupRegs_ = grs', reservedGroups_ = reserved}
+        DSRegistered -> d {groupRegs_ = grs'}
+        DSRemoved -> d
 
-mkDirectoryStore_ :: Maybe Handle -> ([GroupReg], Set GroupId, Set GroupId) -> IO DirectoryStore
-mkDirectoryStore_ h (grs, listed, reserved) = do
-  groupRegs <- newTVarIO grs
-  listedGroups <- newTVarIO listed
-  reservedGroups <- newTVarIO reserved
-  pure DirectoryStore {groupRegs, listedGroups, reservedGroups, directoryLogFile = h}
+mkDirectoryStore_ :: Maybe Handle -> DirectoryStoreData -> IO DirectoryStore
+mkDirectoryStore_ h d = do
+  groupRegs <- newTVarIO $ groupRegs_ d
+  listedGroups <- newTVarIO $ listedGroups_ d
+  promotedGroups <- newTVarIO $ promotedGroups_ d
+  reservedGroups <- newTVarIO $ reservedGroups_ d
+  pure DirectoryStore {groupRegs, listedGroups, promotedGroups, reservedGroups, directoryLogFile = h}
 
 readDirectoryData :: FilePath -> IO [GroupRegData]
 readDirectoryData f =
@@ -429,6 +482,9 @@ readDirectoryData f =
         GRUpdateStatus gId groupRegStatus_ -> case M.lookup gId m of
           Just gr -> pure $ M.insert gId gr {groupRegStatus_} m
           Nothing -> m <$ putStrLn ("Warning: no group with ID " <> show gId <> ", status update ignored.")
+        GRUpdatePromotion gId promoted_ -> case M.lookup gId m of
+          Just gr -> pure $ M.insert gId gr {promoted_} m
+          Nothing -> m <$ putStrLn ("Warning: no group with ID " <> show gId <> ", promotion update ignored.")
         GRUpdateOwner gId grOwnerId -> case M.lookup gId m of
           Just gr -> pure $ M.insert gId gr {dbOwnerMemberId_ = Just grOwnerId} m
           Nothing -> m <$ putStrLn ("Warning: no group with ID " <> show gId <> ", owner update ignored.")
diff --git a/apps/simplex-directory-service/src/Directory/Util.hs b/apps/simplex-directory-service/src/Directory/Util.hs
new file mode 100644
index 0000000000..379da73003
--- /dev/null
+++ b/apps/simplex-directory-service/src/Directory/Util.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Directory.Util where
+
+import qualified Control.Exception as E
+import Control.Logger.Simple
+import Control.Monad.Except
+import Data.Text (Text)
+import Simplex.Chat.Controller
+import Simplex.Chat.Store.Shared (StoreError (..))
+import Simplex.Chat.Types
+import Simplex.Messaging.Agent.Store.Common (withTransaction)
+import qualified Simplex.Messaging.Agent.Store.DB as DB
+import Simplex.Messaging.Util (tshow)
+
+vr :: ChatController -> VersionRangeChat
+vr ChatController {config = ChatConfig {chatVRange}} = chatVRange
+{-# INLINE vr #-}
+
+withDB' :: Text -> ChatController -> (DB.Connection -> IO a) -> IO (Maybe a)
+withDB' cxt cc a = withDB cxt cc $ ExceptT . fmap Right . a
+
+withDB :: Text -> ChatController -> (DB.Connection -> ExceptT StoreError IO a) -> IO (Maybe a)
+withDB cxt ChatController {chatStore} action = do
+  r_ :: Either ChatError a <- withTransaction chatStore (runExceptT . withExceptT ChatErrorStore . action) `E.catches` handleDBErrors
+  case r_ of
+    Right r -> pure $ Just r
+    Left e -> Nothing <$ logError ("Database error: " <> cxt <> " " <> tshow e)
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index fd8a089193..7a9dd3a92d 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -457,10 +457,12 @@ executable simplex-directory-service
       Directory.BlockedWords
       Directory.Captcha
       Directory.Events
+      Directory.Listing
       Directory.Options
       Directory.Search
       Directory.Service
       Directory.Store
+      Directory.Util
       Paths_simplex_chat
   ghc-options: -O2 -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=missing-methods -Werror=incomplete-uni-patterns -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -threaded
   build-depends:
@@ -468,9 +470,11 @@ executable simplex-directory-service
     , async ==2.2.*
     , attoparsec ==0.14.*
     , base >=4.7 && <5
+    , base64-bytestring >=1.0 && <1.3
     , composition ==1.0.*
     , containers ==0.6.*
     , directory ==1.3.*
+    , filepath ==1.4.*
     , mtl >=2.3.1 && <3.0
     , optparse-applicative >=0.15 && <0.17
     , process >=1.6 && <1.6.18
@@ -539,10 +543,12 @@ test-suite simplex-chat-test
       Directory.BlockedWords
       Directory.Captcha
       Directory.Events
+      Directory.Listing
       Directory.Options
       Directory.Search
       Directory.Service
       Directory.Store
+      Directory.Util
       Paths_simplex_chat
   if flag(client_postgres)
       other-modules:
diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs
index 3f59863f25..168fd7bfca 100644
--- a/tests/Bots/DirectoryTests.hs
+++ b/tests/Bots/DirectoryTests.hs
@@ -12,8 +12,10 @@ import ChatTests.Utils
 import Control.Concurrent (forkIO, killThread, threadDelay)
 import Control.Exception (finally)
 import Control.Monad (forM_, when)
+import qualified Data.Aeson as J
 import qualified Data.Text as T
 import Directory.Captcha
+import Directory.Listing
 import Directory.Options
 import Directory.Service
 import Directory.Store
@@ -65,8 +67,8 @@ directoryServiceTests = do
     it "should prohibit confirmation if a duplicate group is listed" testDuplicateProhibitConfirmation
     it "should prohibit when profile is updated and not send for approval" testDuplicateProhibitWhenUpdated
     it "should prohibit approval if a duplicate group is listed" testDuplicateProhibitApproval
-  describe "list groups" $ do
-    it "should list user's groups" testListUserGroups
+  describe "list and promote groups" $ do
+    it "should list and promote user's groups" $ testListUserGroups True
   describe "member admission" $ do
     it "should ask member to pass captcha screen" testCapthaScreening
   describe "store log" $ do
@@ -77,8 +79,8 @@ directoryServiceTests = do
 directoryProfile :: Profile
 directoryProfile = Profile {displayName = "SimpleX Directory", fullName = "", shortDescr = Nothing, image = Nothing, contactLink = Nothing, peerType = Just CPTBot, preferences = Nothing}
 
-mkDirectoryOpts :: TestParams -> [KnownContact] -> Maybe KnownGroup -> DirectoryOpts
-mkDirectoryOpts TestParams {tmpPath = ps} superUsers ownersGroup =
+mkDirectoryOpts :: TestParams -> [KnownContact] -> Maybe KnownGroup -> Maybe FilePath -> DirectoryOpts
+mkDirectoryOpts TestParams {tmpPath = ps} superUsers ownersGroup webFolder =
   DirectoryOpts
     { coreOptions =
         testCoreOpts
@@ -104,6 +106,7 @@ mkDirectoryOpts TestParams {tmpPath = ps} superUsers ownersGroup =
       serviceName = "SimpleX Directory",
       runCLI = False,
       searchResults = 3,
+      webFolder,
       testing = True
     }
 
@@ -531,7 +534,7 @@ testSearchGroups ps =
 
 testInviteToOwnersGroup :: HasCallStack => TestParams -> IO ()
 testInviteToOwnersGroup ps =
-  withDirectoryServiceCfgOwnersGroup ps testCfg True $ \superUser dsLink ->
+  withDirectoryServiceCfgOwnersGroup ps testCfg True Nothing $ \superUser dsLink ->
     withNewTestChatCfg ps testCfg "bob" bobProfile $ \bob -> do
       bob `connectVia` dsLink
       registerGroupId superUser bob "privacy" "Privacy" 2 1
@@ -1060,14 +1063,15 @@ testDuplicateProhibitApproval ps =
         superUser <# ("'SimpleX Directory'> > " <> approve)
         superUser <## "      The group ID 2 (privacy) is already listed in the directory."
 
-testListUserGroups :: HasCallStack => TestParams -> IO ()
-testListUserGroups ps =
-  withDirectoryService ps $ \superUser dsLink ->
+testListUserGroups :: HasCallStack => Bool -> TestParams -> IO ()
+testListUserGroups promote ps =
+  withDirectoryServiceCfgOwnersGroup ps testCfg False (Just "./tests/tmp/web") $ \superUser dsLink ->
     withNewTestChat ps "bob" bobProfile $ \bob ->
       withNewTestChat ps "cath" cathProfile $ \cath -> do
         bob `connectVia` dsLink
         cath `connectVia` dsLink
         registerGroup superUser bob "privacy" "Privacy"
+        checkListings ["privacy"] []
         connectUsers bob cath
         fullAddMember "privacy" "Privacy" bob cath GRMember
         joinGroup "privacy" cath bob
@@ -1075,7 +1079,9 @@ testListUserGroups ps =
         cath <## "contact and member are merged: 'SimpleX Directory', #privacy 'SimpleX Directory_1'"
         cath <## "use @'SimpleX Directory' <message> to send messages"
         registerGroupId superUser bob "security" "Security" 2 2
+        checkListings ["privacy", "security"] []
         registerGroupId superUser cath "anonymity" "Anonymity" 3 1
+        checkListings ["privacy", "security", "anonymity"] []
         listUserGroup cath "anonymity" "Anonymity"
         -- with de-listed group
         groupFound cath "anonymity"
@@ -1085,8 +1091,51 @@ testListUserGroups ps =
         cath <## ""
         cath <## "The group is no longer listed in the directory."
         superUser <# "'SimpleX Directory'> The group ID 3 (anonymity) is de-listed (SimpleX Directory role is changed to member)."
+        checkListings ["privacy", "security"] []
         groupNotFound cath "anonymity"
         listGroups superUser bob cath
+        when promote $ do
+          superUser #> "@'SimpleX Directory' /promote 1:privacy on"
+          superUser <# "'SimpleX Directory'> > /promote 1:privacy on"
+          superUser <## "      Group promotion enabled."
+          checkListings ["privacy", "security"] ["privacy"]
+          bob ##> "/gp privacy privacy"
+          bob <## "description removed"
+          bob <# "'SimpleX Directory'> The group ID 1 (privacy) is updated!"
+          bob <## "It is hidden from the directory until approved."
+          cath <## "bob updated group #privacy:"
+          cath <## "description removed"
+          superUser <# "'SimpleX Directory'> The group ID 1 (privacy) is updated."
+          superUser <# "'SimpleX Directory'> bob submitted the group ID 1:"
+          superUser <## "privacy"
+          superUser <## "Welcome message:"
+          superUser <##. "Link to join the group privacy: https://localhost/g#"
+          superUser <## "3 members"
+          superUser <## ""
+          superUser <## "To approve send:"
+          superUser <# "'SimpleX Directory'> /approve 1:privacy 1 promote=on"
+          checkListings ["security"] []
+          superUser #> "@'SimpleX Directory' /approve 1:privacy 1"
+          superUser <# "'SimpleX Directory'> > /approve 1:privacy 1"
+          superUser <## "      Group approved!"
+          bob <# "'SimpleX Directory'> The group ID 1 (privacy) is approved and listed in directory - please moderate it!"
+          bob <## "Please note: if you change the group profile it will be hidden from directory until it is re-approved."
+          bob <## ""
+          bob <## "Supported commands:"
+          bob <## "/'filter 1' - to configure anti-spam filter."
+          bob <## "/'role 1' - to set default member role."
+          bob <## "/'link 1' - to view/upgrade group link."
+          checkListings ["privacy", "security"] ["privacy"]
+
+checkListings :: [T.Text] -> [T.Text] -> IO ()
+checkListings listed promoted = do
+  checkListing listingFileName listed
+  checkListing promotedFileName promoted
+  where
+    checkListing f expected = do
+      Just (DirectoryListing gs) <- J.decodeFileStrict $ "./tests/tmp/web" </> f
+      map groupName gs `shouldBe` expected
+    groupName DirectoryEntry {displayName} = displayName
 
 testCapthaScreening :: HasCallStack => TestParams -> IO ()
 testCapthaScreening ps =
@@ -1176,7 +1225,7 @@ testCapthaScreening ps =
 
 testRestoreDirectory :: HasCallStack => TestParams -> IO ()
 testRestoreDirectory ps = do
-  testListUserGroups ps
+  testListUserGroups False ps
   restoreDirectoryService ps 3 3 $ \superUser _dsLink ->
     withTestChat ps "bob" $ \bob ->
       withTestChat ps "cath" $ \cath -> do
@@ -1294,10 +1343,10 @@ withDirectoryService :: HasCallStack => TestParams -> (TestCC -> String -> IO ()
 withDirectoryService ps = withDirectoryServiceCfg ps testCfg
 
 withDirectoryServiceCfg :: HasCallStack => TestParams -> ChatConfig -> (TestCC -> String -> IO ()) -> IO ()
-withDirectoryServiceCfg ps cfg = withDirectoryServiceCfgOwnersGroup ps cfg False
+withDirectoryServiceCfg ps cfg = withDirectoryServiceCfgOwnersGroup ps cfg False Nothing
 
-withDirectoryServiceCfgOwnersGroup :: HasCallStack => TestParams -> ChatConfig -> Bool -> (TestCC -> String -> IO ()) -> IO ()
-withDirectoryServiceCfgOwnersGroup ps cfg createOwnersGroup test = do
+withDirectoryServiceCfgOwnersGroup :: HasCallStack => TestParams -> ChatConfig -> Bool -> Maybe FilePath -> (TestCC -> String -> IO ()) -> IO ()
+withDirectoryServiceCfgOwnersGroup ps cfg createOwnersGroup webFolder test = do
   dsLink <-
     withNewTestChatCfg ps cfg serviceDbPrefix directoryProfile $ \ds ->
       withNewTestChatCfg ps cfg "super_user" aliceProfile $ \superUser -> do
@@ -1315,7 +1364,7 @@ withDirectoryServiceCfgOwnersGroup ps cfg createOwnersGroup test = do
           superUser <## "#owners: 'SimpleX Directory' joined the group"
         ds ##> "/ad"
         getContactLink ds True
-  withDirectoryOwnersGroup ps cfg dsLink createOwnersGroup test
+  withDirectoryOwnersGroup ps cfg dsLink createOwnersGroup webFolder test
 
 restoreDirectoryService :: HasCallStack => TestParams -> Int -> Int -> (TestCC -> String -> IO ()) -> IO ()
 restoreDirectoryService ps ctCount grCount test = do
@@ -1332,11 +1381,11 @@ restoreDirectoryService ps ctCount grCount test = do
   withDirectory ps testCfg dsLink test
 
 withDirectory :: HasCallStack => TestParams -> ChatConfig -> String -> (TestCC -> String -> IO ()) -> IO ()
-withDirectory ps cfg dsLink = withDirectoryOwnersGroup ps cfg dsLink False
+withDirectory ps cfg dsLink = withDirectoryOwnersGroup ps cfg dsLink False Nothing
 
-withDirectoryOwnersGroup :: HasCallStack => TestParams -> ChatConfig -> String -> Bool -> (TestCC -> String -> IO ()) -> IO ()
-withDirectoryOwnersGroup ps cfg dsLink createOwnersGroup test = do
-  let opts = mkDirectoryOpts ps [KnownContact 2 "alice"] $ if createOwnersGroup then Just $ KnownGroup 1 "owners" else Nothing
+withDirectoryOwnersGroup :: HasCallStack => TestParams -> ChatConfig -> String -> Bool -> Maybe FilePath -> (TestCC -> String -> IO ()) -> IO ()
+withDirectoryOwnersGroup ps cfg dsLink createOwnersGroup webFolder test = do
+  let opts = mkDirectoryOpts ps [KnownContact 2 "alice"] (if createOwnersGroup then Just $ KnownGroup 1 "owners" else Nothing) webFolder
   runDirectory cfg opts $
     withTestChatCfg ps cfg "super_user" $ \superUser -> do
       superUser <## "1 contacts connected (use /cs for the list)"