From 2b69103055108424b601bbd3565875b5c2df20ce Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Tue, 1 Aug 2023 20:54:51 +0100
Subject: [PATCH 1/5] SimpleX Directory Service (#2766)

* SimpleX Directory Service

* more events

* update events

* fix

* Apply suggestions from code review

metavar

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

* metavar 2

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

* process events

* remove command serialization

* update

* update

* process group profile update

* basic group registration flow

* search works

* better messages

* improve messages

* test broadcast bot

* test for directory service

* better processing of group profile change, test

* refactor

* de-list group when owner or service is removed from the group, tests

* fix: removing any member or any member leaving should not delist the group

* refactor

* more tests, fixes

* disable bot tests in CI

* remove comment

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
---
 apps/simplex-broadcast-bot/Main.hs            |  69 +--
 .../src/Broadcast/Bot.hs                      |  71 +++
 .../{ => src/Broadcast}/Options.hs            |  42 +-
 apps/simplex-chat/Main.hs                     |   2 +-
 apps/simplex-directory-service/Main.hs        |  15 +
 apps/simplex-directory-service/README.md      |   5 +
 .../src/Directory/Events.hs                   | 139 ++++++
 .../src/Directory/Options.hs                  |  77 +++
 .../src/Directory/Service.hs                  | 331 +++++++++++++
 .../src/Directory/Store.hs                    |  90 ++++
 package.yaml                                  |  18 +-
 simplex-chat.cabal                            |  71 ++-
 src/Simplex/Chat.hs                           |  27 +-
 src/Simplex/Chat/Bot.hs                       |  35 +-
 src/Simplex/Chat/Bot/KnownContacts.hs         |  33 ++
 src/Simplex/Chat/Controller.hs                |   7 +-
 src/Simplex/Chat/Core.hs                      |   7 +-
 src/Simplex/Chat/Store/Groups.hs              |   9 +-
 src/Simplex/Chat/View.hs                      |   7 +-
 tests/Bots/BroadcastTests.hs                  |  76 +++
 tests/Bots/DirectoryTests.hs                  | 456 ++++++++++++++++++
 tests/ChatTests/Utils.hs                      |  23 +-
 tests/Test.hs                                 |   5 +
 23 files changed, 1473 insertions(+), 142 deletions(-)
 create mode 100644 apps/simplex-broadcast-bot/src/Broadcast/Bot.hs
 rename apps/simplex-broadcast-bot/{ => src/Broadcast}/Options.hs (69%)
 create mode 100644 apps/simplex-directory-service/Main.hs
 create mode 100644 apps/simplex-directory-service/README.md
 create mode 100644 apps/simplex-directory-service/src/Directory/Events.hs
 create mode 100644 apps/simplex-directory-service/src/Directory/Options.hs
 create mode 100644 apps/simplex-directory-service/src/Directory/Service.hs
 create mode 100644 apps/simplex-directory-service/src/Directory/Store.hs
 create mode 100644 src/Simplex/Chat/Bot/KnownContacts.hs
 create mode 100644 tests/Bots/BroadcastTests.hs
 create mode 100644 tests/Bots/DirectoryTests.hs

diff --git a/apps/simplex-broadcast-bot/Main.hs b/apps/simplex-broadcast-bot/Main.hs
index 966971633f..15bb743b56 100644
--- a/apps/simplex-broadcast-bot/Main.hs
+++ b/apps/simplex-broadcast-bot/Main.hs
@@ -1,76 +1,11 @@
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
 module Main where
 
-import Control.Concurrent (forkIO)
-import Control.Concurrent.Async
-import Control.Concurrent.STM
-import Control.Monad.Reader
-import qualified Data.Text as T
-import Options
-import Simplex.Chat.Bot
-import Simplex.Chat.Controller
+import Broadcast.Bot
+import Broadcast.Options
 import Simplex.Chat.Core
-import Simplex.Chat.Messages
-import Simplex.Chat.Messages.CIContent
-import Simplex.Chat.Options
-import Simplex.Chat.Protocol (MsgContent (..))
 import Simplex.Chat.Terminal (terminalChatConfig)
-import Simplex.Chat.Types
-import System.Directory (getAppUserDataDirectory)
 
 main :: IO ()
 main = do
   opts <- welcomeGetOpts
   simplexChatCore terminalChatConfig (mkChatOpts opts) Nothing $ broadcastBot opts
-
-welcomeGetOpts :: IO BroadcastBotOpts
-welcomeGetOpts = do
-  appDir <- getAppUserDataDirectory "simplex"
-  opts@BroadcastBotOpts {coreOptions = CoreChatOpts {dbFilePrefix}} <- getBroadcastBotOpts appDir "simplex_status_bot"
-  putStrLn $ "SimpleX Chat Bot v" ++ versionNumber
-  putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
-  pure opts
-
-broadcastBot :: BroadcastBotOpts -> User -> ChatController -> IO ()
-broadcastBot BroadcastBotOpts {publishers, welcomeMessage, prohibitedMessage} _user cc = do
-  initializeBotAddress cc
-  race_ (forever $ void getLine) . forever $ do
-    (_, resp) <- atomically . readTBQueue $ outputQ cc
-    case resp of
-      CRContactConnected _ ct _ -> do
-        contactConnected ct
-        sendMessage cc ct welcomeMessage
-      CRNewChatItem _ (AChatItem _ SMDRcv (DirectChat ct) ci@ChatItem {content = CIRcvMsgContent mc})
-        | publisher `elem` publishers ->
-          if allowContent mc
-            then do
-              sendChatCmd cc "/contacts" >>= \case
-                CRContactsList _ cts -> void . forkIO $ do
-                  let cts' = filter broadcastTo cts
-                  forM_ cts' $ \ct' -> sendComposedMessage cc ct' Nothing mc
-                  sendReply $ "Forwarded to " <> show (length cts') <> " contact(s)"
-                r -> putStrLn $ "Error getting contacts list: " <> show r
-            else sendReply "!1 Message is not supported!"
-        | otherwise -> do
-          sendReply prohibitedMessage
-          deleteMessage cc ct $ chatItemId' ci
-        where
-          sendReply = sendComposedMessage cc ct (Just $ chatItemId' ci) . textMsgContent
-          publisher = Publisher {contactId = contactId' ct, localDisplayName = localDisplayName' ct}
-          allowContent = \case
-            MCText _ -> True
-            MCLink {} -> True
-            MCImage {} -> True
-            _ -> False
-          broadcastTo ct'@Contact {activeConn = conn@Connection {connStatus}} =
-            (connStatus == ConnSndReady || connStatus == ConnReady)
-              && not (connDisabled conn)
-              && contactId' ct' /= contactId' ct
-      _ -> pure ()
-  where
-    contactConnected ct = putStrLn $ T.unpack (localDisplayName' ct) <> " connected"
diff --git a/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs b/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs
new file mode 100644
index 0000000000..3a1be2ae08
--- /dev/null
+++ b/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Broadcast.Bot where
+
+import Control.Concurrent (forkIO)
+import Control.Concurrent.Async
+import Control.Concurrent.STM
+import Control.Monad.Reader
+import qualified Data.Text as T
+import Broadcast.Options
+import Simplex.Chat.Bot
+import Simplex.Chat.Bot.KnownContacts
+import Simplex.Chat.Controller
+import Simplex.Chat.Core
+import Simplex.Chat.Messages
+import Simplex.Chat.Messages.CIContent
+import Simplex.Chat.Options
+import Simplex.Chat.Protocol (MsgContent (..))
+import Simplex.Chat.Types
+import System.Directory (getAppUserDataDirectory)
+
+welcomeGetOpts :: IO BroadcastBotOpts
+welcomeGetOpts = do
+  appDir <- getAppUserDataDirectory "simplex"
+  opts@BroadcastBotOpts {coreOptions = CoreChatOpts {dbFilePrefix}} <- getBroadcastBotOpts appDir "simplex_status_bot"
+  putStrLn $ "SimpleX Chat Bot v" ++ versionNumber
+  putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
+  pure opts
+
+broadcastBot :: BroadcastBotOpts -> User -> ChatController -> IO ()
+broadcastBot BroadcastBotOpts {publishers, welcomeMessage, prohibitedMessage} _user cc = do
+  initializeBotAddress cc
+  race_ (forever $ void getLine) . forever $ do
+    (_, resp) <- atomically . readTBQueue $ outputQ cc
+    case resp of
+      CRContactConnected _ ct _ -> do
+        contactConnected ct
+        sendMessage cc ct welcomeMessage
+      CRNewChatItem _ (AChatItem _ SMDRcv (DirectChat ct) ci@ChatItem {content = CIRcvMsgContent mc})
+        | publisher `elem` publishers ->
+          if allowContent mc
+            then do
+              sendChatCmd cc ListContacts >>= \case
+                CRContactsList _ cts -> void . forkIO $ do
+                  let cts' = filter broadcastTo cts
+                  forM_ cts' $ \ct' -> sendComposedMessage cc ct' Nothing mc
+                  sendReply $ "Forwarded to " <> show (length cts') <> " contact(s)"
+                r -> putStrLn $ "Error getting contacts list: " <> show r
+            else sendReply "!1 Message is not supported!"
+        | otherwise -> do
+          sendReply prohibitedMessage
+          deleteMessage cc ct $ chatItemId' ci
+        where
+          sendReply = sendComposedMessage cc ct (Just $ chatItemId' ci) . textMsgContent
+          publisher = KnownContact {contactId = contactId' ct, localDisplayName = localDisplayName' ct}
+          allowContent = \case
+            MCText _ -> True
+            MCLink {} -> True
+            MCImage {} -> True
+            _ -> False
+          broadcastTo ct'@Contact {activeConn = conn@Connection {connStatus}} =
+            (connStatus == ConnSndReady || connStatus == ConnReady)
+              && not (connDisabled conn)
+              && contactId' ct' /= contactId' ct
+      _ -> pure ()
+  where
+    contactConnected ct = putStrLn $ T.unpack (localDisplayName' ct) <> " connected"
diff --git a/apps/simplex-broadcast-bot/Options.hs b/apps/simplex-broadcast-bot/src/Broadcast/Options.hs
similarity index 69%
rename from apps/simplex-broadcast-bot/Options.hs
rename to apps/simplex-broadcast-bot/src/Broadcast/Options.hs
index 994884760d..76b349a499 100644
--- a/apps/simplex-broadcast-bot/Options.hs
+++ b/apps/simplex-broadcast-bot/src/Broadcast/Options.hs
@@ -4,48 +4,33 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module Options where
+module Broadcast.Options where
 
-import qualified Data.Attoparsec.ByteString.Char8 as A
-import Data.Int (Int64)
 import Data.Maybe (fromMaybe)
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
 import Options.Applicative
+import Simplex.Chat.Bot.KnownContacts
 import Simplex.Chat.Controller (updateStr, versionNumber, versionString)
 import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts, coreChatOptsP)
-import Simplex.Messaging.Parsers (parseAll)
-import Simplex.Messaging.Util (safeDecodeUtf8)
-
-data Publisher = Publisher
-  { contactId :: Int64,
-    localDisplayName :: Text
-  }
-  deriving (Eq)
 
 data BroadcastBotOpts = BroadcastBotOpts
   { coreOptions :: CoreChatOpts,
-    publishers :: [Publisher],
+    publishers :: [KnownContact],
     welcomeMessage :: String,
     prohibitedMessage :: String
   }
 
-defaultWelcomeMessage :: [Publisher] -> String
-defaultWelcomeMessage ps = "Hello! I am a broadcast bot.\nI broadcast messages to all connected users from " <> publisherNames ps <> "."
+defaultWelcomeMessage :: [KnownContact] -> String
+defaultWelcomeMessage ps = "Hello! I am a broadcast bot.\nI broadcast messages to all connected users from " <> knownContactNames ps <> "."
 
-defaultProhibitedMessage :: [Publisher] -> String
-defaultProhibitedMessage ps = "Sorry, only these users can broadcast messages: " <> publisherNames ps <> ". Your message is deleted."
-
-publisherNames :: [Publisher] -> String
-publisherNames = T.unpack . T.intercalate ", " . map (("@" <>) . localDisplayName)
+defaultProhibitedMessage :: [KnownContact] -> String
+defaultProhibitedMessage ps = "Sorry, only these users can broadcast messages: " <> knownContactNames ps <> ". Your message is deleted."
 
 broadcastBotOpts :: FilePath -> FilePath -> Parser BroadcastBotOpts
 broadcastBotOpts appDir defaultDbFileName = do
   coreOptions <- coreChatOptsP appDir defaultDbFileName
   publishers <-
     option
-      parsePublishers
+      parseKnownContacts
       ( long "publishers"
           <> metavar "PUBLISHERS"
           <> help "Comma-separated list of publishers in the format CONTACT_ID:DISPLAY_NAME whose messages will be broadcasted"
@@ -74,17 +59,6 @@ broadcastBotOpts appDir defaultDbFileName = do
         prohibitedMessage = fromMaybe (defaultProhibitedMessage publishers) prohibitedMessage_
       }
 
-parsePublishers :: ReadM [Publisher]
-parsePublishers = eitherReader $ parseAll publishersP . encodeUtf8 . T.pack
-
-publishersP :: A.Parser [Publisher]
-publishersP = publisherP `A.sepBy1` A.char ','
-  where
-    publisherP = do
-      contactId <- A.decimal <* A.char ':'
-      localDisplayName <- safeDecodeUtf8 <$> A.takeTill (A.inClass ", ")
-      pure Publisher {contactId, localDisplayName}
-
 getBroadcastBotOpts :: FilePath -> FilePath -> IO BroadcastBotOpts
 getBroadcastBotOpts appDir defaultDbFileName =
   execParser $
diff --git a/apps/simplex-chat/Main.hs b/apps/simplex-chat/Main.hs
index b16bbd8ee2..8dd02623e2 100644
--- a/apps/simplex-chat/Main.hs
+++ b/apps/simplex-chat/Main.hs
@@ -28,7 +28,7 @@ main = do
         t <- withTerminal pure
         simplexChatTerminal terminalChatConfig opts t
     else simplexChatCore terminalChatConfig opts Nothing $ \user cc -> do
-      r <- sendChatCmd cc chatCmd
+      r <- sendChatCmdStr cc chatCmd
       ts <- getCurrentTime
       tz <- getCurrentTimeZone
       putStrLn $ serializeChatResponse (Just user) ts tz r
diff --git a/apps/simplex-directory-service/Main.hs b/apps/simplex-directory-service/Main.hs
new file mode 100644
index 0000000000..103f382461
--- /dev/null
+++ b/apps/simplex-directory-service/Main.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Main where
+
+import Directory.Options
+import Directory.Service
+import Directory.Store
+import Simplex.Chat.Core
+import Simplex.Chat.Terminal (terminalChatConfig)
+
+main :: IO ()
+main = do
+  opts@DirectoryOpts {directoryLog} <- welcomeGetOpts
+  st <- getDirectoryStore directoryLog
+  simplexChatCore terminalChatConfig (mkChatOpts opts) Nothing $ directoryService st opts
diff --git a/apps/simplex-directory-service/README.md b/apps/simplex-directory-service/README.md
new file mode 100644
index 0000000000..b64e018adb
--- /dev/null
+++ b/apps/simplex-directory-service/README.md
@@ -0,0 +1,5 @@
+# SimpleX Directory Service
+
+The service is currently a chat bot that allows to register and search for groups.
+
+Superusers are configured via CLI options.
diff --git a/apps/simplex-directory-service/src/Directory/Events.hs b/apps/simplex-directory-service/src/Directory/Events.hs
new file mode 100644
index 0000000000..01bb181f84
--- /dev/null
+++ b/apps/simplex-directory-service/src/Directory/Events.hs
@@ -0,0 +1,139 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module Directory.Events where
+
+import Control.Applicative ((<|>))
+import Data.Attoparsec.Text (Parser)
+import qualified Data.Attoparsec.Text as A
+import Data.Text (Text)
+import qualified Data.Text as T
+import Directory.Store
+import Simplex.Chat.Controller
+import Simplex.Chat.Messages
+import Simplex.Chat.Messages.CIContent
+import Simplex.Chat.Protocol (MsgContent (..))
+import Simplex.Chat.Types
+import Data.Char (isSpace)
+import Data.Either (fromRight)
+
+data DirectoryEvent
+  = DEContactConnected Contact
+  | DEGroupInvitation {contact :: Contact, groupInfo :: GroupInfo, fromMemberRole :: GroupMemberRole, memberRole :: GroupMemberRole}
+  | DEServiceJoinedGroup ContactId GroupInfo
+  | DEGroupUpdated {contactId :: ContactId, fromGroup :: GroupInfo, toGroup :: GroupInfo}
+  | DEContactRoleChanged ContactId GroupInfo GroupMemberRole
+  | DEServiceRoleChanged GroupInfo GroupMemberRole
+  | DEContactRemovedFromGroup ContactId GroupInfo
+  | DEContactLeftGroup ContactId GroupInfo
+  | DEServiceRemovedFromGroup GroupInfo
+  | DEGroupDeleted GroupInfo
+  | DEUnsupportedMessage Contact ChatItemId
+  | DEItemEditIgnored Contact
+  | DEItemDeleteIgnored Contact
+  | DEContactCommand Contact ChatItemId ADirectoryCmd
+
+crDirectoryEvent :: ChatResponse -> Maybe DirectoryEvent
+crDirectoryEvent = \case
+  CRContactConnected {contact} -> Just $ DEContactConnected contact
+  CRReceivedGroupInvitation {contact, groupInfo, fromMemberRole, memberRole} -> Just $ DEGroupInvitation {contact, groupInfo, fromMemberRole, memberRole}
+  CRUserJoinedGroup {groupInfo, hostMember} -> (`DEServiceJoinedGroup` groupInfo) <$> memberContactId hostMember
+  CRGroupUpdated {fromGroup, toGroup, member_} -> (\contactId -> DEGroupUpdated {contactId, fromGroup, toGroup}) <$> (memberContactId =<< member_)
+  CRMemberRole {groupInfo, member, toRole} -> (\ctId -> DEContactRoleChanged ctId groupInfo toRole) <$> memberContactId member
+  CRMemberRoleUser {groupInfo, toRole} -> Just $ DEServiceRoleChanged groupInfo toRole
+  CRDeletedMember {groupInfo, deletedMember} -> (`DEContactRemovedFromGroup` groupInfo) <$> memberContactId deletedMember
+  CRLeftMember {groupInfo, member} -> (`DEContactLeftGroup` groupInfo) <$> memberContactId member
+  CRDeletedMemberUser {groupInfo} -> Just $ DEServiceRemovedFromGroup groupInfo
+  CRGroupDeleted {groupInfo} -> Just $ DEGroupDeleted groupInfo
+  CRChatItemUpdated {chatItem = AChatItem _ SMDRcv (DirectChat ct) _} -> Just $ DEItemEditIgnored ct
+  CRChatItemDeleted {deletedChatItem = AChatItem _ SMDRcv (DirectChat ct) _, byUser = False} -> Just $ DEItemDeleteIgnored ct
+  CRNewChatItem {chatItem = AChatItem _ SMDRcv (DirectChat ct) ci@ChatItem {content = CIRcvMsgContent mc, meta = CIMeta {itemLive}}} ->
+    Just $ case (mc, itemLive) of
+      (MCText t, Nothing) -> DEContactCommand ct ciId $ fromRight err $ A.parseOnly directoryCmdP $ T.dropWhileEnd isSpace t
+      _ -> DEUnsupportedMessage ct ciId
+    where
+      ciId = chatItemId' ci
+      err = ADC SDRUser DCUnknownCommand
+  _ -> Nothing
+
+data DirectoryRole = DRUser | DRSuperUser
+
+data SDirectoryRole (r :: DirectoryRole) where
+  SDRUser :: SDirectoryRole 'DRUser
+  SDRSuperUser :: SDirectoryRole 'DRSuperUser
+
+data DirectoryCmdTag (r :: DirectoryRole) where
+  DCHelp_ :: DirectoryCmdTag 'DRUser
+  DCConfirmDuplicateGroup_ :: DirectoryCmdTag 'DRUser
+  DCListUserGroups_ :: DirectoryCmdTag 'DRUser
+  DCDeleteGroup_ :: DirectoryCmdTag 'DRUser
+  DCApproveGroup_ :: DirectoryCmdTag 'DRSuperUser
+  DCRejectGroup_ :: DirectoryCmdTag 'DRSuperUser
+  DCSuspendGroup_ :: DirectoryCmdTag 'DRSuperUser
+  DCResumeGroup_ :: DirectoryCmdTag 'DRSuperUser
+  DCListGroups_ :: DirectoryCmdTag 'DRSuperUser
+
+deriving instance Show (DirectoryCmdTag r)
+
+data ADirectoryCmdTag = forall r. ADCT (SDirectoryRole r) (DirectoryCmdTag r)
+
+data DirectoryCmd (r :: DirectoryRole) where
+  DCHelp :: DirectoryCmd 'DRUser
+  DCSearchGroup :: Text -> DirectoryCmd 'DRUser
+  DCConfirmDuplicateGroup :: UserGroupRegId -> GroupName -> DirectoryCmd 'DRUser
+  DCListUserGroups :: DirectoryCmd 'DRUser
+  DCDeleteGroup :: UserGroupRegId -> GroupName -> DirectoryCmd 'DRUser
+  DCApproveGroup :: {groupId :: GroupId, localDisplayName :: GroupName, groupApprovalId :: GroupApprovalId} -> DirectoryCmd 'DRSuperUser
+  DCRejectGroup :: GroupId -> GroupName -> DirectoryCmd 'DRSuperUser
+  DCSuspendGroup :: GroupId -> GroupName -> DirectoryCmd 'DRSuperUser
+  DCResumeGroup :: GroupId -> GroupName -> DirectoryCmd 'DRSuperUser
+  DCListGroups :: DirectoryCmd 'DRSuperUser
+  DCUnknownCommand :: DirectoryCmd 'DRUser
+  DCCommandError :: DirectoryCmdTag r -> DirectoryCmd r
+
+data ADirectoryCmd = forall r. ADC (SDirectoryRole r) (DirectoryCmd r)
+
+directoryCmdP :: Parser ADirectoryCmd
+directoryCmdP =
+  (A.char '/' *> cmdStrP) <|> (ADC SDRUser . DCSearchGroup <$> A.takeText)
+  where
+    cmdStrP =
+      (tagP >>= \(ADCT u t) -> ADC u <$> (cmdP t <|> pure (DCCommandError t)))
+        <|> pure (ADC SDRUser DCUnknownCommand)
+    tagP = A.takeTill (== ' ') >>= \case
+      "help" -> u DCHelp_
+      "h" -> u DCHelp_
+      "confim" -> u DCConfirmDuplicateGroup_
+      "list" -> u DCListUserGroups_
+      "delete" -> u DCDeleteGroup_
+      "approve" -> su DCApproveGroup_
+      "reject" -> su DCRejectGroup_
+      "suspend" -> su DCSuspendGroup_
+      "resume" -> su DCResumeGroup_
+      "all" -> su DCListGroups_
+      _ -> fail "bad command tag"
+      where
+        u = pure . ADCT SDRUser
+        su = pure . ADCT SDRSuperUser
+    cmdP :: DirectoryCmdTag r -> Parser (DirectoryCmd r)
+    cmdP = \case
+      DCHelp_ -> pure DCHelp
+      DCConfirmDuplicateGroup_ -> gc DCConfirmDuplicateGroup
+      DCListUserGroups_ -> pure DCListUserGroups
+      DCDeleteGroup_ -> gc DCDeleteGroup
+      DCApproveGroup_ -> do
+        (groupId, localDisplayName) <- gc (,)
+        groupApprovalId <- A.space *> A.decimal
+        pure $ DCApproveGroup {groupId, localDisplayName, groupApprovalId}
+      DCRejectGroup_ -> gc DCRejectGroup
+      DCSuspendGroup_ -> gc DCSuspendGroup
+      DCResumeGroup_ -> gc DCResumeGroup
+      DCListGroups_ -> pure DCListGroups
+      where
+        gc f = f <$> (A.space *> A.decimal <* A.char ':') <*> A.takeTill (== ' ')
diff --git a/apps/simplex-directory-service/src/Directory/Options.hs b/apps/simplex-directory-service/src/Directory/Options.hs
new file mode 100644
index 0000000000..1bdde35923
--- /dev/null
+++ b/apps/simplex-directory-service/src/Directory/Options.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Directory.Options where
+
+import Options.Applicative
+import Simplex.Chat.Bot.KnownContacts
+import Simplex.Chat.Controller (updateStr, versionNumber, versionString)
+import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts, coreChatOptsP)
+
+data DirectoryOpts = DirectoryOpts
+  { coreOptions :: CoreChatOpts,
+    superUsers :: [KnownContact],
+    directoryLog :: FilePath,
+    serviceName :: String
+  }
+
+directoryOpts :: FilePath -> FilePath -> Parser DirectoryOpts
+directoryOpts appDir defaultDbFileName = do
+  coreOptions <- coreChatOptsP appDir defaultDbFileName
+  superUsers <-
+    option
+      parseKnownContacts
+      ( long "super-users"
+          <> metavar "SUPER_USERS"
+          <> help "Comma-separated list of super-users in the format CONTACT_ID:DISPLAY_NAME who will be allowed to manage the directory"
+          <> value []
+      )
+  directoryLog <-
+    strOption
+      ( long "directory-file"
+          <> metavar "DIRECTORY_FILE"
+          <> help "Append only log for directory state"
+      )
+  serviceName <-
+    strOption
+      ( long "service-name"
+          <> metavar "SERVICE_NAME"
+          <> help "The display name of the directory service bot, without *'s and spaces (SimpleX-Directory)"
+          <> value "SimpleX-Directory"
+      )
+  pure
+    DirectoryOpts
+      { coreOptions,
+        superUsers,
+        directoryLog,
+        serviceName
+      }
+
+getDirectoryOpts :: FilePath -> FilePath -> IO DirectoryOpts
+getDirectoryOpts appDir defaultDbFileName =
+  execParser $
+    info
+      (helper <*> versionOption <*> directoryOpts appDir defaultDbFileName)
+      (header versionStr <> fullDesc <> progDesc "Start SimpleX Directory Service with DB_FILE, DIRECTORY_FILE and SUPER_USERS options")
+  where
+    versionStr = versionString versionNumber
+    versionOption = infoOption versionAndUpdate (long "version" <> short 'v' <> help "Show version")
+    versionAndUpdate = versionStr <> "\n" <> updateStr
+
+mkChatOpts :: DirectoryOpts -> ChatOpts
+mkChatOpts DirectoryOpts {coreOptions} =
+  ChatOpts
+    { coreOptions,
+      chatCmd = "",
+      chatCmdDelay = 3,
+      chatServerPort = Nothing,
+      optFilesFolder = Nothing,
+      showReactions = False,
+      allowInstantFiles = True,
+      autoAcceptFileSize = 0,
+      muteNotifications = True,
+      maintenance = False
+    }
diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs
new file mode 100644
index 0000000000..07cd9203e9
--- /dev/null
+++ b/apps/simplex-directory-service/src/Directory/Service.hs
@@ -0,0 +1,331 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE MultiWayIf #-}
+
+module Directory.Service
+  ( welcomeGetOpts,
+    directoryService,
+  )
+where
+
+import Control.Concurrent (forkIO)
+import Control.Concurrent.Async
+import Control.Concurrent.STM
+import Control.Monad.Reader
+import qualified Data.ByteString.Char8 as B
+import Data.Maybe (fromMaybe)
+import qualified Data.Text as T
+import Directory.Events
+import Directory.Options
+import Directory.Store
+import Simplex.Chat.Bot
+import Simplex.Chat.Bot.KnownContacts
+import Simplex.Chat.Controller
+import Simplex.Chat.Core
+import Simplex.Chat.Messages
+-- import Simplex.Chat.Messages.CIContent
+import Simplex.Chat.Options
+import Simplex.Chat.Protocol (MsgContent (..))
+import Simplex.Chat.Types
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
+import System.Directory (getAppUserDataDirectory)
+
+data GroupProfileUpdate = GPNoServiceLink | GPServiceLinkAdded | GPServiceLinkRemoved | GPHasServiceLink | GPServiceLinkError
+
+welcomeGetOpts :: IO DirectoryOpts
+welcomeGetOpts = do
+  appDir <- getAppUserDataDirectory "simplex"
+  opts@DirectoryOpts {coreOptions = CoreChatOpts {dbFilePrefix}} <- getDirectoryOpts appDir "simplex_directory_service"
+  putStrLn $ "SimpleX Directory Service Bot v" ++ versionNumber
+  putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
+  pure opts
+
+directoryService :: DirectoryStore -> DirectoryOpts -> User -> ChatController -> IO ()
+directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = do
+  initializeBotAddress cc
+  race_ (forever $ void getLine) . forever $ do
+    (_, resp) <- atomically . readTBQueue $ outputQ cc
+    forM_ (crDirectoryEvent resp) $ \case
+      DEContactConnected ct -> deContactConnected ct
+      DEGroupInvitation {contact = ct, groupInfo = g, fromMemberRole, memberRole} -> deGroupInvitation ct g fromMemberRole memberRole
+      DEServiceJoinedGroup ctId g -> deServiceJoinedGroup ctId g
+      DEGroupUpdated {contactId, fromGroup, toGroup} -> deGroupUpdated contactId fromGroup toGroup
+      DEContactRoleChanged ctId g role -> deContactRoleChanged ctId g role
+      DEServiceRoleChanged g role -> deServiceRoleChanged g role
+      DEContactRemovedFromGroup ctId g -> deContactRemovedFromGroup ctId g
+      DEContactLeftGroup ctId g -> deContactLeftGroup ctId g
+      DEServiceRemovedFromGroup g -> deServiceRemovedFromGroup g
+      DEGroupDeleted _g -> pure ()
+      DEUnsupportedMessage _ct _ciId -> pure ()
+      DEItemEditIgnored _ct -> pure ()
+      DEItemDeleteIgnored _ct -> pure ()
+      DEContactCommand ct ciId aCmd -> case aCmd of
+        ADC SDRUser cmd -> deUserCommand ct ciId cmd
+        ADC SDRSuperUser cmd -> deSuperUserCommand ct ciId cmd
+  where
+    withSuperUsers action = void . forkIO $ forM_ superUsers $ \KnownContact {contactId} -> action contactId
+    notifySuperUsers s = withSuperUsers $ \contactId -> sendMessage' cc contactId s
+    -- withContact ctId GroupInfo {localDisplayName} err action = do
+    --   getContact cc ctId >>= \case
+    --     Just ct -> action ct
+    --     Nothing -> putStrLn $ T.unpack $ "Error: " <> err <> ", group: " <> localDisplayName <> ", can't find contact ID " <> tshow ctId
+    notifyOwner GroupReg {dbContactId} = sendMessage' cc dbContactId
+    ctId `isOwner` GroupReg {dbContactId} = ctId == dbContactId
+    withGroupReg GroupInfo {groupId, localDisplayName} err action = do
+      atomically (getGroupReg st groupId) >>= \case
+        Just gr -> action gr
+        Nothing -> putStrLn $ T.unpack $ "Error: " <> err <> ", group: " <> localDisplayName <> ", can't find group registration ID " <> tshow groupId
+    setGroupInactive GroupReg {groupRegStatus, dbGroupId} grStatus = atomically $ do
+      writeTVar groupRegStatus grStatus
+      unlistGroup st dbGroupId
+
+    groupInfoText GroupProfile {displayName = n, fullName = fn, description = d} =
+      n <> (if n == fn || T.null fn then "" else " (" <> fn <> ")") <> maybe "" ("\nWelcome message:\n" <>) d
+    groupReference GroupInfo {groupId, groupProfile = p'@GroupProfile {displayName}} =
+      "ID " <> show groupId <> " (" <> T.unpack displayName <> ")"
+
+    deContactConnected :: Contact -> IO ()
+    deContactConnected ct = do
+      putStrLn $ T.unpack (localDisplayName' ct) <> " connected"
+      sendMessage cc ct $
+        "Welcome to " <> serviceName <> " service!\n\
+        \Send a search string to find groups or */help* to learn how to add groups to directory.\n\n\
+        \For example, send _privacy_ to find groups about privacy."
+
+    deGroupInvitation :: Contact -> GroupInfo -> GroupMemberRole -> GroupMemberRole -> IO ()
+    deGroupInvitation ct g fromMemberRole memberRole =
+      case badInvitation fromMemberRole memberRole of
+        -- TODO check duplicate group name and ask to confirm
+        Just msg -> sendMessage cc ct msg
+        Nothing -> do
+          let GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = g
+          atomically $ addGroupReg st ct g
+          r <- sendChatCmd cc $ APIJoinGroup groupId
+          sendMessage cc ct $ T.unpack $ case r of
+            CRUserAcceptedGroupSent {} -> "Joining the group #" <> displayName <> "…"
+            _ -> "Error joining group " <> displayName <> ", please re-send the invitation!"
+
+    deServiceJoinedGroup :: ContactId -> GroupInfo -> IO ()
+    deServiceJoinedGroup ctId g =
+      withGroupReg g "joined group" $ \gr ->
+        when (ctId `isOwner` gr) $ do
+          let GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = g
+          notifyOwner gr $ T.unpack $ "Joined the group #" <> displayName <> ", creating the link…"
+          sendChatCmd cc (APICreateGroupLink groupId GRMember) >>= \case
+            CRGroupLinkCreated {connReqContact} -> do
+              setGroupInactive gr GRSPendingUpdate
+              notifyOwner gr
+                "Created the public link to join the group via this directory service that is always online.\n\n\
+                \Please add it to the group welcome message.\n\
+                \For example, add:"
+              notifyOwner gr $ "Link to join the group " <> T.unpack displayName <> ": " <> B.unpack (strEncode connReqContact)
+            CRChatCmdError _ (ChatError e) -> case e of
+              CEGroupUserRole {} -> notifyOwner gr "Failed creating group link, as service is no longer an admin."
+              CEGroupMemberUserRemoved -> notifyOwner gr "Failed creating group link, as service is removed from the group."
+              CEGroupNotJoined _ -> notifyOwner gr $ unexpectedError "group not joined"
+              CEGroupMemberNotActive -> notifyOwner gr $ unexpectedError "service membership is not active"
+              _ -> notifyOwner gr $ unexpectedError "can't create group link"
+            _ -> notifyOwner gr $ unexpectedError "can't create group link"
+
+    deGroupUpdated :: ContactId -> GroupInfo -> GroupInfo -> IO ()
+    deGroupUpdated ctId fromGroup toGroup =
+      unless (sameProfile p p') $ do
+        atomically $ unlistGroup st groupId
+        withGroupReg toGroup "group updated" $ \gr -> do
+          readTVarIO (groupRegStatus gr) >>= \case
+            GRSPendingConfirmation -> pure ()
+            GRSProposed -> pure ()
+            GRSPendingUpdate -> groupProfileUpdate >>= \case
+              GPNoServiceLink ->
+                when (ctId `isOwner` gr) $ notifyOwner gr $ "The profile updated for " <> groupRef <> ", but the group link is not added to the welcome message."
+              GPServiceLinkAdded
+                | ctId `isOwner` gr -> groupLinkAdded gr
+                | otherwise -> notifyOwner gr "The group link is added by another group member, your registration will not be processed.\n\nPlease update the group profile yourself."
+              GPServiceLinkRemoved -> when (ctId `isOwner` gr) $ notifyOwner gr $ "The group link of " <> groupRef <> " is removed from the welcome message, please add it."
+              GPHasServiceLink -> when (ctId `isOwner` gr) $ groupLinkAdded gr
+              GPServiceLinkError -> do
+                when (ctId `isOwner` gr) $ notifyOwner gr $ "Error: " <> serviceName <> " has no group link for " <> groupRef <> ". Please report the error to the developers."
+                putStrLn $ "Error: no group link for " <> groupRef
+            GRSPendingApproval n -> processProfileChange gr $ n + 1
+            GRSActive -> processProfileChange gr 1
+            GRSSuspended -> processProfileChange gr 1
+            GRSRemoved -> pure ()
+      where
+        isInfix l d_ = l `T.isInfixOf` fromMaybe "" d_
+        GroupInfo {groupId, groupProfile = p} = fromGroup
+        GroupInfo {localDisplayName, groupProfile = p'@GroupProfile {image = image'}} = toGroup
+        groupRef = groupReference toGroup
+        sameProfile
+          GroupProfile {displayName = n, fullName = fn, image = i, description = d}
+          GroupProfile {displayName = n', fullName = fn', image = i', description = d'} =
+            n == n' && fn == fn' && i == i' && d == d'
+        groupLinkAdded gr = do
+          notifyOwner gr $ "Thank you! The group link for " <> groupRef <> " is added to the welcome message.\nYou will be notified once the group is added to the directory - it may take up to 24 hours."
+          let gaId = 1
+          setGroupInactive gr $ GRSPendingApproval gaId
+          sendForApproval gr gaId
+        processProfileChange gr n' = groupProfileUpdate >>= \case
+          GPNoServiceLink -> do
+            setGroupInactive gr GRSPendingUpdate
+            notifyOwner gr $ "The group profile is updated " <> groupRef <> ", but no link is added to the welcome message.\n\nThe group will remain hidden from the directory until the group link is added and the group is re-approved."
+          GPServiceLinkRemoved -> do
+            setGroupInactive gr GRSPendingUpdate
+            notifyOwner gr $ "The group link for " <> groupRef <> " is removed from the welcome message.\n\nThe group is hidden from the directory until the group link is added and the group is re-approved."
+            notifySuperUsers $ "The group link is removed from " <> groupRef <> ", de-listed."
+          GPServiceLinkAdded -> do
+            setGroupInactive gr $ GRSPendingApproval n'
+            notifyOwner gr $ "The group link is added to " <> groupRef <> "!\nIt is hidden from the directory until approved."
+            notifySuperUsers $ "The group link is added to " <> groupRef <> "."
+            sendForApproval gr n'
+          GPHasServiceLink -> do
+            setGroupInactive gr $ GRSPendingApproval n'
+            notifyOwner gr $ "The group " <> groupRef <> " is updated!\nIt is hidden from the directory until approved."
+            notifySuperUsers $ "The group " <> groupRef <> " is updated."
+            sendForApproval gr n'
+          GPServiceLinkError -> putStrLn $ "Error: no group link for " <> groupRef <> " pending approval."
+        groupProfileUpdate = profileUpdate <$> sendChatCmd cc (APIGetGroupLink groupId)
+          where
+            profileUpdate = \case
+              CRGroupLink {connReqContact} ->
+                let groupLink = safeDecodeUtf8 $ strEncode connReqContact
+                    hadLinkBefore = groupLink `isInfix` description p
+                    hasLinkNow = groupLink `isInfix` description p'
+                in if
+                      | hadLinkBefore && hasLinkNow -> GPHasServiceLink
+                      | hadLinkBefore -> GPServiceLinkRemoved
+                      | hasLinkNow -> GPServiceLinkAdded
+                      | otherwise -> GPNoServiceLink
+              _ -> GPServiceLinkError
+        sendForApproval GroupReg {dbGroupId, dbContactId} gaId = do
+          ct_ <-  getContact cc dbContactId
+          let text = maybe ("The group ID " <> tshow dbGroupId <> " submitted: ") (\c -> localDisplayName' c <> " submitted the group ID " <> tshow dbGroupId <> ": ") ct_
+                      <> groupInfoText p' <> "\n\nTo approve send:"
+              msg = maybe (MCText text) (\image -> MCImage {text, image}) image'
+          withSuperUsers $ \cId -> do
+            sendComposedMessage' cc cId Nothing msg
+            sendMessage' cc cId $ "/approve " <> show dbGroupId <> ":" <> T.unpack localDisplayName <> " " <> show gaId
+
+    deContactRoleChanged :: ContactId -> GroupInfo -> GroupMemberRole -> IO ()
+    deContactRoleChanged ctId g role = undefined
+
+    deServiceRoleChanged :: GroupInfo -> GroupMemberRole -> IO ()
+    deServiceRoleChanged g role = undefined
+
+    deContactRemovedFromGroup :: ContactId -> GroupInfo -> IO ()
+    deContactRemovedFromGroup ctId g =
+      withGroupReg g "contact removed" $ \gr -> do
+        when (ctId `isOwner` gr) $ do
+          setGroupInactive gr GRSRemoved
+          let groupRef = groupReference g
+          notifyOwner gr $ "You are removed from the group " <> groupRef <> ".\n\nGroup is no longer listed in the directory."
+          notifySuperUsers $ "The group " <> groupRef <> " is de-listed (group owner is removed)."
+
+    deContactLeftGroup :: ContactId -> GroupInfo -> IO ()
+    deContactLeftGroup ctId g =
+      withGroupReg g "contact left" $ \gr -> do
+        when (ctId `isOwner` gr) $ do
+          setGroupInactive gr GRSRemoved
+          let groupRef = groupReference g
+          notifyOwner gr $ "You left the group " <> groupRef <> ".\n\nGroup is no longer listed in the directory."
+          notifySuperUsers $ "The group " <> groupRef <> " is de-listed (group owner left)."
+
+    deServiceRemovedFromGroup :: GroupInfo -> IO ()
+    deServiceRemovedFromGroup g =
+      withGroupReg g "service removed" $ \gr -> do
+        setGroupInactive gr GRSRemoved
+        let groupRef = groupReference g
+        notifyOwner gr $ serviceName <> " is removed from the group " <> groupRef <> ".\n\nGroup is no longer listed in the directory."
+        notifySuperUsers $ "The group " <> groupRef <> " is de-listed (directory service is removed)."
+
+    deUserCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRUser -> IO ()
+    deUserCommand ct ciId = \case
+      DCHelp ->
+        sendMessage cc ct $
+          "You must be the owner to add the group to the directory:\n\
+          \1. Invite " <> serviceName <> " bot to your group as *admin*.\n\
+          \2. " <> serviceName <> " bot will create a public group link for the new members to join even when you are offline.\n\
+          \3. You will then need to add this link to the group welcome message.\n\
+          \4. Once the link is added, service admins will approve the group (it can take up to 24 hours), and everybody will be able to find it in directory.\n\n\
+          \Start from inviting the bot to your group as admin - it will guide you through the process"
+      DCSearchGroup s -> do
+        sendChatCmd cc (APIListGroups userId Nothing $ Just $ T.unpack s) >>= \case
+          CRGroupsList {groups} ->
+            atomically (filterListedGroups st groups) >>= \case
+              [] -> sendReply "No groups found"
+              gs -> do
+                sendReply $ "Found " <> show (length gs) <> " group(s)"
+                void . forkIO $ forM_ gs $ \GroupInfo {groupProfile = p@GroupProfile {image = image_}} -> do
+                  let text = groupInfoText p
+                      msg = maybe (MCText text) (\image -> MCImage {text, image}) image_
+                  sendComposedMessage cc ct Nothing msg
+          _ -> sendReply "Unexpected error"
+      DCConfirmDuplicateGroup _ugrId _gName -> pure ()
+      DCListUserGroups -> pure ()
+      DCDeleteGroup _ugrId _gName -> pure ()
+      DCUnknownCommand -> sendReply "Unknown command"
+      DCCommandError tag -> sendReply $ "Command error: " <> show tag
+      where
+        sendReply = sendComposedMessage cc ct (Just ciId) . textMsgContent
+
+    deSuperUserCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRSuperUser -> IO ()
+    deSuperUserCommand ct ciId cmd
+      | superUser `elem` superUsers = case cmd of
+        DCApproveGroup {groupId, localDisplayName = n, groupApprovalId} ->
+          atomically (getGroupReg st groupId) >>= \case
+            Nothing -> sendMessage cc ct $ "Group ID " <> show groupId <> " not found"
+            Just GroupReg {dbContactId, groupRegStatus} -> do
+              readTVarIO groupRegStatus >>= \case
+                GRSPendingApproval gaId
+                  | gaId == groupApprovalId -> do
+                    getGroup cc groupId >>= \case
+                      Just GroupInfo {localDisplayName = n'}
+                        | n == n' -> do
+                          atomically $ do
+                            writeTVar groupRegStatus GRSActive
+                            listGroup st groupId
+                          sendReply "Group approved!"
+                          sendMessage' cc dbContactId $ "The group ID " <> show groupId <> " (" <> T.unpack n <> ") is approved and listed in directory!\nPlease note: if you change the group profile it will be hidden from directory until it is re-approved."
+                        | otherwise -> sendReply "Incorrect group name"
+                      Nothing -> pure ()
+                  | otherwise -> sendReply "Incorrect approval code"
+                _ -> sendReply $ "Error: the group ID " <> show groupId <> " (" <> T.unpack n <> ") is not pending approval."
+        DCRejectGroup _gaId _gName -> pure ()
+        DCSuspendGroup _gId _gName -> pure ()
+        DCResumeGroup _gId _gName -> pure ()
+        DCListGroups -> pure ()
+        DCCommandError tag -> sendReply $ "Command error: " <> show tag
+      | otherwise = sendReply "You are not allowed to use this command"
+      where
+        superUser = KnownContact {contactId = contactId' ct, localDisplayName = localDisplayName' ct}
+        sendReply = sendComposedMessage cc ct (Just ciId) . textMsgContent
+
+badInvitation :: GroupMemberRole -> GroupMemberRole -> Maybe String
+badInvitation contactRole serviceRole = case (contactRole, serviceRole) of
+  (GROwner, GRAdmin) -> Nothing
+  (_, GRAdmin) -> Just "You must have a group *owner* role to register the group"
+  (GROwner, _) -> Just "You must grant directory service *admin* role to register the group"
+  _ -> Just "You must have a group *owner* role and you must grant directory service *admin* role to register the group"
+
+getContact :: ChatController -> ContactId -> IO (Maybe Contact)
+getContact cc ctId = resp <$> sendChatCmd cc (APIGetChat (ChatRef CTDirect ctId) (CPLast 0) Nothing)
+  where
+    resp :: ChatResponse -> Maybe Contact
+    resp = \case
+      CRApiChat _ (AChat SCTDirect Chat {chatInfo = DirectChat ct}) -> Just ct
+      _ -> Nothing
+
+getGroup :: ChatController -> GroupId -> IO (Maybe GroupInfo)
+getGroup cc gId = resp <$> sendChatCmd cc (APIGetChat (ChatRef CTGroup gId) (CPLast 0) Nothing)
+  where
+    resp :: ChatResponse -> Maybe GroupInfo
+    resp = \case
+      CRApiChat _ (AChat SCTGroup Chat {chatInfo = GroupChat g}) -> Just g
+      _ -> Nothing
+
+unexpectedError :: String -> String
+unexpectedError err = "Unexpected error: " <> err <> ", please notify the developers."
diff --git a/apps/simplex-directory-service/src/Directory/Store.hs b/apps/simplex-directory-service/src/Directory/Store.hs
new file mode 100644
index 0000000000..f41a487e28
--- /dev/null
+++ b/apps/simplex-directory-service/src/Directory/Store.hs
@@ -0,0 +1,90 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Directory.Store where
+
+import Control.Concurrent.STM
+import Data.Int (Int64)
+import Data.Set (Set)
+import Simplex.Chat.Types
+import Data.List (find)
+import qualified Data.Set as S
+
+data DirectoryStore = DirectoryStore
+  { groupRegs :: TVar [GroupReg],
+    listedGroups :: TVar (Set GroupId)
+  }
+
+data GroupReg = GroupReg
+  { userGroupRegId :: UserGroupRegId,
+    dbGroupId :: GroupId,
+    dbContactId :: ContactId,
+    groupRegStatus :: TVar GroupRegStatus
+  }
+
+type GroupRegId = Int64
+
+type UserGroupRegId = Int64
+
+type GroupApprovalId = Int64
+
+data GroupRegStatus
+  = GRSPendingConfirmation
+  | GRSProposed
+  | GRSPendingUpdate
+  | GRSPendingApproval GroupApprovalId
+  | GRSActive
+  | GRSSuspended
+  | GRSRemoved
+
+addGroupReg :: DirectoryStore -> Contact -> GroupInfo -> STM ()
+addGroupReg st ct GroupInfo {groupId} = do
+  groupRegStatus <- newTVar GRSProposed
+  let gr = GroupReg {userGroupRegId = groupId, dbGroupId = groupId, dbContactId = contactId' ct, groupRegStatus}
+  modifyTVar' (groupRegs st) (gr :)
+
+getGroupReg :: DirectoryStore -> GroupRegId -> STM (Maybe GroupReg)
+getGroupReg st gId = find ((gId ==) . dbGroupId) <$> readTVar (groupRegs st)
+
+getUserGroupRegId :: DirectoryStore -> ContactId -> UserGroupRegId -> STM (Maybe GroupReg)
+getUserGroupRegId st ctId ugrId = find (\r -> ctId == dbContactId r && ugrId == userGroupRegId r) <$> readTVar (groupRegs st)
+
+getContactGroupRegs :: DirectoryStore -> ContactId -> STM [GroupReg]
+getContactGroupRegs st ctId = filter ((ctId ==) . dbContactId) <$> readTVar (groupRegs st)
+
+filterListedGroups :: DirectoryStore -> [GroupInfo] -> STM [GroupInfo]
+filterListedGroups st gs = do
+  lgs <- readTVar $ listedGroups st
+  pure $ filter (\GroupInfo {groupId} -> groupId `S.member` lgs) gs
+
+listGroup :: DirectoryStore -> GroupId -> STM ()
+listGroup st gId = modifyTVar' (listedGroups st) $ S.insert gId
+
+unlistGroup :: DirectoryStore -> GroupId -> STM ()
+unlistGroup st gId = modifyTVar' (listedGroups st) $ S.delete gId
+
+data DirectoryLogRecord
+  = CreateGroupReg GroupReg
+  | UpdateGroupRegStatus GroupRegId GroupRegStatus
+
+getDirectoryStore :: FilePath -> IO DirectoryStore
+getDirectoryStore path = do
+  groupRegs <- readDirectoryState path
+  st <- atomically newDirectoryStore
+  atomically $ mapM_ (add st) groupRegs
+  pure st
+  where
+    add :: DirectoryStore -> GroupReg -> STM ()
+    add st gr = modifyTVar' (groupRegs st) (gr :) -- TODO set listedGroups
+
+newDirectoryStore :: STM DirectoryStore
+newDirectoryStore = do
+  groupRegs <- newTVar []
+  listedGroups <- newTVar mempty
+  pure DirectoryStore {groupRegs, listedGroups}
+
+readDirectoryState :: FilePath -> IO [GroupReg]
+readDirectoryState _ = pure []
+
+writeDirectoryState :: FilePath -> [GroupReg] -> IO ()
+writeDirectoryState _ _ = pure ()
diff --git a/package.yaml b/package.yaml
index 9b588b1bac..f1aadc926e 100644
--- a/package.yaml
+++ b/package.yaml
@@ -10,6 +10,7 @@ copyright: 2020-22 simplex.chat
 category: Web, System, Services, Cryptography
 extra-source-files:
   - README.md
+  - cabal.project
 
 dependencies:
   - aeson == 2.0.*
@@ -91,8 +92,16 @@ executables:
       - -threaded
 
   simplex-broadcast-bot:
-    source-dirs: apps/simplex-broadcast-bot
-    main: Main.hs
+    source-dirs: apps/simplex-broadcast-bot/src
+    main: ../Main.hs
+    dependencies:
+      - simplex-chat
+    ghc-options:
+      - -threaded
+
+  simplex-directory-service:
+    source-dirs: apps/simplex-directory-service/src
+    main: ../Main.hs
     dependencies:
       - simplex-chat
     ghc-options:
@@ -100,7 +109,10 @@ executables:
 
 tests:
   simplex-chat-test:
-    source-dirs: tests
+    source-dirs:
+      - tests
+      - apps/simplex-broadcast-bot/src
+      - apps/simplex-directory-service/src
     main: Test.hs
     dependencies:
       - simplex-chat
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index f2ff5f8cc6..0c713cd3f6 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -28,6 +28,7 @@ library
       Simplex.Chat
       Simplex.Chat.Archive
       Simplex.Chat.Bot
+      Simplex.Chat.Bot.KnownContacts
       Simplex.Chat.Call
       Simplex.Chat.Controller
       Simplex.Chat.Core
@@ -275,12 +276,13 @@ executable simplex-bot-advanced
     cpp-options: -DswiftJSON
 
 executable simplex-broadcast-bot
-  main-is: Main.hs
+  main-is: ../Main.hs
   other-modules:
-      Options
+      Broadcast.Bot
+      Broadcast.Options
       Paths_simplex_chat
   hs-source-dirs:
-      apps/simplex-broadcast-bot
+      apps/simplex-broadcast-bot/src
   ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
       aeson ==2.0.*
@@ -375,10 +377,65 @@ executable simplex-chat
   if flag(swift)
     cpp-options: -DswiftJSON
 
+executable simplex-directory-service
+  main-is: ../Main.hs
+  other-modules:
+      Directory.Events
+      Directory.Options
+      Directory.Service
+      Directory.Store
+      Paths_simplex_chat
+  hs-source-dirs:
+      apps/simplex-directory-service/src
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
+  build-depends:
+      aeson ==2.0.*
+    , ansi-terminal >=0.10 && <0.12
+    , async ==2.2.*
+    , attoparsec ==0.14.*
+    , base >=4.7 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.10.*
+    , composition ==1.0.*
+    , constraints >=0.12 && <0.14
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
+    , direct-sqlcipher ==2.3.*
+    , directory ==1.3.*
+    , email-validate ==2.3.*
+    , exceptions ==0.10.*
+    , filepath ==1.4.*
+    , http-types ==0.12.*
+    , memory ==0.15.*
+    , mtl ==2.2.*
+    , network >=3.1.2.7 && <3.2
+    , optparse-applicative >=0.15 && <0.17
+    , process ==1.6.*
+    , random >=1.1 && <1.3
+    , record-hasfield ==1.0.*
+    , simple-logger ==0.1.*
+    , simplex-chat
+    , simplexmq >=5.0
+    , socks ==0.6.*
+    , sqlcipher-simple ==0.4.*
+    , stm ==2.5.*
+    , template-haskell ==2.16.*
+    , terminal ==0.2.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , zip ==1.7.*
+  default-language: Haskell2010
+  if flag(swift)
+    cpp-options: -DswiftJSON
+
 test-suite simplex-chat-test
   type: exitcode-stdio-1.0
   main-is: Test.hs
   other-modules:
+      Bots.BroadcastTests
+      Bots.DirectoryTests
       ChatClient
       ChatTests
       ChatTests.Direct
@@ -392,9 +449,17 @@ test-suite simplex-chat-test
       SchemaDump
       ViewTests
       WebRTCTests
+      Broadcast.Bot
+      Broadcast.Options
+      Directory.Events
+      Directory.Options
+      Directory.Service
+      Directory.Store
       Paths_simplex_chat
   hs-source-dirs:
       tests
+      apps/simplex-broadcast-bot/src
+      apps/simplex-directory-service/src
   ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
   build-depends:
       aeson ==2.0.*
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 79745f198b..95343fd9a5 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -332,7 +332,13 @@ execChatCommand s = do
   u <- readTVarIO =<< asks currentUser
   case parseChatCommand s of
     Left e -> pure $ chatCmdError u e
-    Right cmd -> either (CRChatCmdError u) id <$> runExceptT (processChatCommand cmd)
+    Right cmd -> execChatCommand_ u cmd
+
+execChatCommand' :: ChatMonad' m => ChatCommand -> m ChatResponse
+execChatCommand' cmd = asks currentUser >>= readTVarIO >>= (`execChatCommand_` cmd)
+
+execChatCommand_ :: ChatMonad' m => Maybe User -> ChatCommand -> m ChatResponse
+execChatCommand_ u cmd = either (CRChatCmdError u) id <$> runExceptT (processChatCommand cmd)
 
 parseChatCommand :: ByteString -> Either String ChatCommand
 parseChatCommand = A.parseOnly chatCommandP . B.dropWhileEnd isSpace
@@ -1486,8 +1492,11 @@ processChatCommand = \case
   ListMembers gName -> withUser $ \user -> do
     groupId <- withStore $ \db -> getGroupIdByName db user gName
     processChatCommand $ APIListMembers groupId
-  ListGroups -> withUser $ \user ->
-    CRGroupsList user <$> withStore' (`getUserGroupDetails` user)
+  APIListGroups userId contactId_ search_ -> withUserId userId $ \user ->
+    CRGroupsList user <$> withStore' (\db -> getUserGroupDetails db user contactId_ search_)
+  ListGroups cName_ search_ -> withUser $ \user@User {userId} -> do
+    ct_ <- forM cName_ $ \cName -> withStore $ \db -> getContactByName db user cName
+    processChatCommand $ APIListGroups userId (contactId' <$> ct_) search_
   APIUpdateGroupProfile groupId p' -> withUser $ \user -> do
     g <- withStore $ \db -> getGroup db user groupId
     runUpdateGroupProfile user g p'
@@ -1497,6 +1506,8 @@ processChatCommand = \case
     CRGroupProfile user <$> withStore (\db -> getGroupInfoByName db user gName)
   UpdateGroupDescription gName description ->
     updateGroupProfileByName gName $ \p -> p {description}
+  ShowGroupDescription gName -> withUser $ \user ->
+    CRGroupDescription user <$> withStore (\db -> getGroupInfoByName db user gName)
   APICreateGroupLink groupId mRole -> withUser $ \user -> withChatLock "createGroupLink" $ do
     gInfo <- withStore $ \db -> getGroupInfo db user groupId
     assertUserGroupRole gInfo GRAdmin
@@ -2534,7 +2545,7 @@ expireChatItems user@User {userId} ttl sync = do
       createdAtCutoff = addUTCTime (-43200 :: NominalDiffTime) currentTs
   contacts <- withStoreCtx' (Just "expireChatItems, getUserContacts") (`getUserContacts` user)
   loop contacts $ processContact expirationDate
-  groups <- withStoreCtx' (Just "expireChatItems, getUserGroupDetails") (`getUserGroupDetails` user)
+  groups <- withStoreCtx' (Just "expireChatItems, getUserGroupDetails") (\db -> getUserGroupDetails db user Nothing Nothing)
   loop groups $ processGroup expirationDate createdAtCutoff
   where
     loop :: [a] -> (a -> m ()) -> m ()
@@ -3954,7 +3965,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
           ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta content
           withStore' $ \db -> setGroupInvitationChatItemId db user groupId (chatItemId' ci)
           toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci)
-          toView $ CRReceivedGroupInvitation user gInfo ct memRole
+          toView $ CRReceivedGroupInvitation {user, groupInfo = gInfo, contact = ct, fromMemberRole = fromRole, memberRole = memRole}          
           whenContactNtfs user ct $
             showToast ("#" <> localDisplayName <> " " <> c <> "> ") "invited you to join the group"
       where
@@ -5128,11 +5139,15 @@ chatCommandP =
       "/clear #" *> (ClearGroup <$> displayName),
       "/clear " *> char_ '@' *> (ClearContact <$> displayName),
       ("/members " <|> "/ms ") *> char_ '#' *> (ListMembers <$> displayName),
-      ("/groups" <|> "/gs") $> ListGroups,
+      "/_groups" *> (APIListGroups <$> A.decimal <*> optional (" @" *> A.decimal) <*> optional (A.space *> stringP)),
+      ("/groups" <|> "/gs") *> (ListGroups <$> optional (" @" *> displayName) <*> optional (A.space *> stringP)),
       "/_group_profile #" *> (APIUpdateGroupProfile <$> A.decimal <* A.space <*> jsonP),
       ("/group_profile " <|> "/gp ") *> char_ '#' *> (UpdateGroupNames <$> displayName <* A.space <*> groupProfile),
       ("/group_profile " <|> "/gp ") *> char_ '#' *> (ShowGroupProfile <$> displayName),
       "/group_descr " *> char_ '#' *> (UpdateGroupDescription <$> displayName <*> optional (A.space *> msgTextP)),
+      "/set welcome " *> char_ '#' *> (UpdateGroupDescription <$> displayName <* A.space <*> (Just <$> msgTextP)),
+      "/delete welcome " *> char_ '#' *> (UpdateGroupDescription <$> displayName <*> pure Nothing),
+      "/show welcome " *> char_ '#' *> (ShowGroupDescription <$> displayName),
       "/_create link #" *> (APICreateGroupLink <$> A.decimal <*> (memberRole <|> pure GRMember)),
       "/_set link role #" *> (APIGroupLinkMemberRole <$> A.decimal <*> memberRole),
       "/_delete link #" *> (APIDeleteGroupLink <$> A.decimal),
diff --git a/src/Simplex/Chat/Bot.hs b/src/Simplex/Chat/Bot.hs
index 05a755fd87..34e752ec21 100644
--- a/src/Simplex/Chat/Bot.hs
+++ b/src/Simplex/Chat/Bot.hs
@@ -9,9 +9,7 @@ module Simplex.Chat.Bot where
 import Control.Concurrent.Async
 import Control.Concurrent.STM
 import Control.Monad.Reader
-import qualified Data.Aeson as J
 import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString.Lazy.Char8 as LB
 import qualified Data.Text as T
 import Simplex.Chat.Controller
 import Simplex.Chat.Core
@@ -19,9 +17,8 @@ import Simplex.Chat.Messages
 import Simplex.Chat.Messages.CIContent
 import Simplex.Chat.Protocol (MsgContent (..))
 import Simplex.Chat.Store
-import Simplex.Chat.Types (Contact (..), IsContact (..), User (..))
+import Simplex.Chat.Types (Contact (..), ContactId, IsContact (..), User (..))
 import Simplex.Messaging.Encoding.String (strEncode)
-import Simplex.Messaging.Util (safeDecodeUtf8)
 import System.Exit (exitFailure)
 
 chatBotRepl :: String -> (Contact -> String -> IO String) -> User -> ChatController -> IO ()
@@ -32,49 +29,55 @@ chatBotRepl welcome answer _user cc = do
     case resp of
       CRContactConnected _ contact _ -> do
         contactConnected contact
-        void $ sendMsg contact welcome
+        void $ sendMessage cc contact welcome
       CRNewChatItem _ (AChatItem _ SMDRcv (DirectChat contact) ChatItem {content = mc@CIRcvMsgContent {}}) -> do
         let msg = T.unpack $ ciContentToText mc
-        void $ sendMsg contact =<< answer contact msg
+        void $ sendMessage cc contact =<< answer contact msg
       _ -> pure ()
   where
-    sendMsg Contact {contactId} msg = sendChatCmd cc $ "/_send @" <> show contactId <> " text " <> msg
     contactConnected Contact {localDisplayName} = putStrLn $ T.unpack localDisplayName <> " connected"
 
 initializeBotAddress :: ChatController -> IO ()
 initializeBotAddress cc = do
-  sendChatCmd cc "/show_address" >>= \case
+  sendChatCmd cc ShowMyAddress >>= \case
     CRUserContactLink _ UserContactLink {connReqContact} -> showBotAddress connReqContact
     CRChatCmdError _ (ChatErrorStore SEUserContactLinkNotFound) -> do
       putStrLn "No bot address, creating..."
-      sendChatCmd cc "/address" >>= \case
+      sendChatCmd cc CreateMyAddress >>= \case
         CRUserContactLinkCreated _ uri -> showBotAddress uri
         _ -> putStrLn "can't create bot address" >> exitFailure
     _ -> putStrLn "unexpected response" >> exitFailure
   where
     showBotAddress uri = do
       putStrLn $ "Bot's contact address is: " <> B.unpack (strEncode uri)
-      void $ sendChatCmd cc "/auto_accept on"
+      void $ sendChatCmd cc $ AddressAutoAccept $ Just AutoAccept {acceptIncognito = False, autoReply = Nothing}
 
 sendMessage :: ChatController -> Contact -> String -> IO ()
 sendMessage cc ct = sendComposedMessage cc ct Nothing . textMsgContent
 
+sendMessage' :: ChatController -> ContactId -> String -> IO ()
+sendMessage' cc ctId = sendComposedMessage' cc ctId Nothing . textMsgContent
+
 sendComposedMessage :: ChatController -> Contact -> Maybe ChatItemId -> MsgContent -> IO ()
-sendComposedMessage cc ct quotedItemId msgContent = do
+sendComposedMessage cc = sendComposedMessage' cc . contactId'
+
+sendComposedMessage' :: ChatController -> ContactId -> Maybe ChatItemId -> MsgContent -> IO ()
+sendComposedMessage' cc ctId quotedItemId msgContent = do
   let cm = ComposedMessage {filePath = Nothing, quotedItemId, msgContent}
-  sendChatCmd cc ("/_send @" <> show (contactId' ct) <> " json " <> jsonEncode cm) >>= \case
-    CRNewChatItem {} -> printLog cc CLLInfo $ "sent message to " <> contactInfo ct
+  sendChatCmd cc (APISendMessage (ChatRef CTDirect ctId) False Nothing cm) >>= \case
+    CRNewChatItem {} -> printLog cc CLLInfo $ "sent message to contact ID " <> show ctId
     r -> putStrLn $ "unexpected send message response: " <> show r
-  where
-    jsonEncode = T.unpack . safeDecodeUtf8 . LB.toStrict . J.encode
 
 deleteMessage :: ChatController -> Contact -> ChatItemId -> IO ()
 deleteMessage cc ct chatItemId = do
-  let cmd = "/_delete item @" <> show (contactId' ct) <> " " <> show chatItemId <> " internal"
+  let cmd = APIDeleteChatItem (contactRef ct) chatItemId CIDMInternal
   sendChatCmd cc cmd >>= \case
     CRChatItemDeleted {} -> printLog cc CLLInfo $ "deleted message from " <> contactInfo ct
     r -> putStrLn $ "unexpected delete message response: " <> show r
 
+contactRef :: Contact -> ChatRef
+contactRef = ChatRef CTDirect . contactId'
+
 textMsgContent :: String -> MsgContent
 textMsgContent = MCText . T.pack
 
diff --git a/src/Simplex/Chat/Bot/KnownContacts.hs b/src/Simplex/Chat/Bot/KnownContacts.hs
new file mode 100644
index 0000000000..c079b994a6
--- /dev/null
+++ b/src/Simplex/Chat/Bot/KnownContacts.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Simplex.Chat.Bot.KnownContacts where
+
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.Int (Int64)
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import qualified Data.Text as T
+import Options.Applicative
+import Simplex.Messaging.Parsers (parseAll)
+import Simplex.Messaging.Util (safeDecodeUtf8)
+
+data KnownContact = KnownContact
+  { contactId :: Int64,
+    localDisplayName :: Text
+  }
+  deriving (Eq)
+
+knownContactNames :: [KnownContact] -> String
+knownContactNames = T.unpack . T.intercalate ", " . map (("@" <>) . localDisplayName)
+
+parseKnownContacts :: ReadM [KnownContact]
+parseKnownContacts = eitherReader $ parseAll knownContactsP . encodeUtf8 . T.pack
+
+knownContactsP :: A.Parser [KnownContact]
+knownContactsP = contactP `A.sepBy1` A.char ','
+  where
+    contactP = do
+      contactId <- A.decimal <* A.char ':'
+      localDisplayName <- safeDecodeUtf8 <$> A.takeTill (A.inClass ", ")
+      pure KnownContact {contactId, localDisplayName}
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index 90f90fdcb6..bc60b371b6 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -362,10 +362,12 @@ data ChatCommand
   | DeleteGroup GroupName
   | ClearGroup GroupName
   | ListMembers GroupName
-  | ListGroups -- UserId (not used in UI)
+  | APIListGroups UserId (Maybe ContactId) (Maybe String)
+  | ListGroups (Maybe ContactName) (Maybe String)
   | UpdateGroupNames GroupName GroupProfile
   | ShowGroupProfile GroupName
   | UpdateGroupDescription GroupName (Maybe Text)
+  | ShowGroupDescription GroupName
   | CreateGroupLink GroupName GroupMemberRole
   | GroupLinkMemberRole GroupName GroupMemberRole
   | DeleteGroupLink GroupName
@@ -518,7 +520,7 @@ data ChatResponse
   | CRHostConnected {protocol :: AProtocolType, transportHost :: TransportHost}
   | CRHostDisconnected {protocol :: AProtocolType, transportHost :: TransportHost}
   | CRGroupInvitation {user :: User, groupInfo :: GroupInfo}
-  | CRReceivedGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, memberRole :: GroupMemberRole}
+  | CRReceivedGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, fromMemberRole :: GroupMemberRole, memberRole :: GroupMemberRole}
   | CRUserJoinedGroup {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember}
   | CRJoinedGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
   | CRJoinedGroupMemberConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember, member :: GroupMember}
@@ -533,6 +535,7 @@ data ChatResponse
   | CRGroupDeleted {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
   | CRGroupUpdated {user :: User, fromGroup :: GroupInfo, toGroup :: GroupInfo, member_ :: Maybe GroupMember}
   | CRGroupProfile {user :: User, groupInfo :: GroupInfo}
+  | CRGroupDescription {user :: User, groupInfo :: GroupInfo} -- only used in CLI
   | CRGroupLinkCreated {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact, memberRole :: GroupMemberRole}
   | CRGroupLink {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact, memberRole :: GroupMemberRole}
   | CRGroupLinkDeleted {user :: User, groupInfo :: GroupInfo}
diff --git a/src/Simplex/Chat/Core.hs b/src/Simplex/Chat/Core.hs
index e23dbc5a96..2ec6ddb7f9 100644
--- a/src/Simplex/Chat/Core.hs
+++ b/src/Simplex/Chat/Core.hs
@@ -39,5 +39,8 @@ runSimplexChat ChatOpts {maintenance} u cc chat
     a2 <- async $ chat u cc
     waitEither_ a1 a2
 
-sendChatCmd :: ChatController -> String -> IO ChatResponse
-sendChatCmd cc s = runReaderT (execChatCommand . encodeUtf8 $ T.pack s) cc
+sendChatCmdStr :: ChatController -> String -> IO ChatResponse
+sendChatCmdStr cc s = runReaderT (execChatCommand . encodeUtf8 $ T.pack s) cc
+
+sendChatCmd :: ChatController -> ChatCommand -> IO ChatResponse
+sendChatCmd cc cmd = runReaderT (execChatCommand' cmd) cc
diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs
index c3c62d52da..7b54e642ed 100644
--- a/src/Simplex/Chat/Store/Groups.hs
+++ b/src/Simplex/Chat/Store/Groups.hs
@@ -448,8 +448,8 @@ getUserGroups db user@User {userId} = do
   groupIds <- map fromOnly <$> DB.query db "SELECT group_id FROM groups WHERE user_id = ?" (Only userId)
   rights <$> mapM (runExceptT . getGroup db user) groupIds
 
-getUserGroupDetails :: DB.Connection -> User -> IO [GroupInfo]
-getUserGroupDetails db User {userId, userContactId} =
+getUserGroupDetails :: DB.Connection -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfo]
+getUserGroupDetails db User {userId, userContactId} _contactId_ search_ =
   map (toGroupInfo userContactId)
     <$> DB.query
       db
@@ -462,8 +462,11 @@ getUserGroupDetails db User {userId, userContactId} =
         JOIN group_members mu USING (group_id)
         JOIN contact_profiles pu ON pu.contact_profile_id = COALESCE(mu.member_profile_id, mu.contact_profile_id)
         WHERE g.user_id = ? AND mu.contact_id = ?
+          AND (gp.display_name LIKE '%' || ? || '%' OR gp.full_name LIKE '%' || ? || '%' OR gp.description LIKE '%' || ? || '%')
       |]
-      (userId, userContactId)
+      (userId, userContactId, search, search, search)
+  where
+    search = fromMaybe "" search_
 
 getContactGroupPreferences :: DB.Connection -> User -> Contact -> IO [FullGroupPreferences]
 getContactGroupPreferences db User {userId} Contact {contactId} = do
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index d6e443401d..2e7232c1ef 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -200,7 +200,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
       addressSS UserContactSubStatus {userContactError} = maybe ("Your address is active! To show: " <> highlight' "/sa") (\e -> "User address error: " <> sShow e <> ", to delete your address: " <> highlight' "/da") userContactError
       (groupLinkErrors, groupLinksSubscribed) = partition (isJust . userContactError) groupLinks
   CRGroupInvitation u g -> ttyUser u [groupInvitation' g]
-  CRReceivedGroupInvitation u g c role -> ttyUser u $ viewReceivedGroupInvitation g c role
+  CRReceivedGroupInvitation {user = u, groupInfo = g, contact = c, memberRole = r} -> ttyUser u $ viewReceivedGroupInvitation g c r
   CRUserJoinedGroup u g _ -> ttyUser u $ viewUserJoinedGroup g
   CRJoinedGroupMember u g m -> ttyUser u $ viewJoinedGroupMember g m
   CRHostConnected p h -> [plain $ "connected to " <> viewHostEvent p h]
@@ -217,6 +217,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
   CRGroupDeleted u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> groupName' g) <> " to delete the local copy of the group"]
   CRGroupUpdated u g g' m -> ttyUser u $ viewGroupUpdated g g' m
   CRGroupProfile u g -> ttyUser u $ viewGroupProfile g
+  CRGroupDescription u g -> ttyUser u $ viewGroupDescription g
   CRGroupLinkCreated u g cReq mRole -> ttyUser u $ groupLink_ "Group link is created!" g cReq mRole
   CRGroupLink u g cReq mRole -> ttyUser u $ groupLink_ "Group link:" g cReq mRole
   CRGroupLinkDeleted u g -> ttyUser u $ viewGroupLinkDeleted g
@@ -1135,6 +1136,10 @@ viewGroupProfile g@GroupInfo {groupProfile = GroupProfile {description, image, g
       where
         pref = getGroupPreference f . mergeGroupPreferences
 
+viewGroupDescription :: GroupInfo -> [StyledString]
+viewGroupDescription GroupInfo {groupProfile = GroupProfile {description}} =
+  maybe ["No welcome message!"] ((bold' "Welcome message:" :) . map plain . T.lines) description
+
 bold' :: String -> StyledString
 bold' = styled Bold
 
diff --git a/tests/Bots/BroadcastTests.hs b/tests/Bots/BroadcastTests.hs
new file mode 100644
index 0000000000..69ec10a7ab
--- /dev/null
+++ b/tests/Bots/BroadcastTests.hs
@@ -0,0 +1,76 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Bots.BroadcastTests where
+
+import Broadcast.Bot
+import Broadcast.Options
+import ChatClient
+import ChatTests.Utils
+import Control.Concurrent (forkIO, killThread, threadDelay)
+import Control.Exception (bracket)
+import Simplex.Chat.Bot.KnownContacts
+import Simplex.Chat.Core
+import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts (..))
+import Simplex.Chat.Types (Profile (..))
+import System.FilePath ((</>))
+import Test.Hspec
+
+broadcastBotTests :: SpecWith FilePath
+broadcastBotTests = do
+  it "should broadcast message" testBroadcastMessages
+
+withBroadcastBot :: BroadcastBotOpts -> IO () -> IO ()
+withBroadcastBot opts test =
+  bracket (forkIO bot) killThread (\_ -> threadDelay 500000 >> test)
+  where
+    bot = simplexChatCore testCfg (mkChatOpts opts) Nothing $ broadcastBot opts
+
+broadcastBotProfile :: Profile
+broadcastBotProfile = Profile {displayName = "broadcast_bot", fullName = "Broadcast Bot", image = Nothing, contactLink = Nothing, preferences = Nothing}
+
+mkBotOpts :: FilePath -> [KnownContact] -> BroadcastBotOpts
+mkBotOpts tmp publishers =
+  BroadcastBotOpts
+    { coreOptions = (coreOptions (testOpts :: ChatOpts)) {dbFilePrefix = tmp </> botDbPrefix},
+      publishers,
+      welcomeMessage = defaultWelcomeMessage publishers,
+      prohibitedMessage = defaultWelcomeMessage publishers
+    }
+
+botDbPrefix :: FilePath
+botDbPrefix = "broadcast_bot"
+
+testBroadcastMessages :: HasCallStack => FilePath -> IO ()
+testBroadcastMessages tmp = do
+  botLink <-
+    withNewTestChat tmp botDbPrefix broadcastBotProfile $ \bc_bot ->
+      withNewTestChat tmp "alice" aliceProfile $ \alice -> do
+        connectUsers bc_bot alice
+        bc_bot ##> "/ad"
+        getContactLink bc_bot True
+  let botOpts = mkBotOpts tmp [KnownContact 2 "alice"]
+  withBroadcastBot botOpts $
+    withTestChat tmp "alice" $ \alice ->
+      withNewTestChat tmp "bob" bobProfile $ \bob ->
+        withNewTestChat tmp "cath" cathProfile $ \cath -> do
+          alice <## "1 contacts connected (use /cs for the list)"
+          bob `connectVia` botLink
+          bob #> "@broadcast_bot hello"
+          bob <# "broadcast_bot> > hello"
+          bob <## "      Hello! I am a broadcast bot."
+          bob <## "I broadcast messages to all connected users from @alice."
+          cath `connectVia` botLink
+          alice #> "@broadcast_bot hello all!"
+          bob <# "broadcast_bot> hello all!"
+          cath <# "broadcast_bot> hello all!"
+          alice <# "broadcast_bot> > hello all!"
+          alice <## "      Forwarded to 2 contact(s)"
+  where
+    cc `connectVia` botLink = do
+      cc ##> ("/c " <> botLink)
+      cc <## "connection request sent!"
+      cc <## "broadcast_bot (Broadcast Bot): contact is connected"
+      cc <# "broadcast_bot> Hello! I am a broadcast bot."
+      cc <## "I broadcast messages to all connected users from @alice."
diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs
new file mode 100644
index 0000000000..eb3926df69
--- /dev/null
+++ b/tests/Bots/DirectoryTests.hs
@@ -0,0 +1,456 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PostfixOperators #-}
+
+module Bots.DirectoryTests where
+
+import ChatClient
+import ChatTests.Utils
+import Control.Concurrent (forkIO, killThread, threadDelay)
+import Control.Exception (finally)
+import Directory.Options
+import Directory.Service
+import Directory.Store
+import Simplex.Chat.Bot.KnownContacts
+import Simplex.Chat.Core
+import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts (..))
+import Simplex.Chat.Types (Profile (..), GroupMemberRole (GROwner))
+import System.FilePath ((</>))
+import Test.Hspec
+
+directoryServiceTests :: SpecWith FilePath
+directoryServiceTests = do
+  it "should register group" testDirectoryService
+  describe "de-listing the group" $ do
+    it "should de-list if owner leaves the group" testDelistedOwnerLeaves
+    it "should de-list if owner is removed from the group" testDelistedOwnerRemoved
+    it "should NOT de-list if another member leaves the group" testNotDelistedMemberLeaves
+    it "should NOT de-list if another member is removed from the group" testNotDelistedMemberRemoved
+    it "should de-list if service is removed from the group" testDelistedServiceRemoved
+  describe "should require re-approval if profile is changed by" $ do
+    it "the registration owner" testRegOwnerChangedProfile
+    it "another owner" testAnotherOwnerChangedProfile
+  describe "should require profile update if group link is removed by " $ do
+    it "the registration owner" testRegOwnerRemovedLink
+    it "another owner" testAnotherOwnerRemovedLink
+
+directoryProfile :: Profile
+directoryProfile = Profile {displayName = "SimpleX-Directory", fullName = "", image = Nothing, contactLink = Nothing, preferences = Nothing}
+
+mkDirectoryOpts :: FilePath -> [KnownContact] -> DirectoryOpts
+mkDirectoryOpts tmp superUsers =
+  DirectoryOpts
+    { coreOptions = (coreOptions (testOpts :: ChatOpts)) {dbFilePrefix = tmp </> serviceDbPrefix},
+      superUsers,
+      directoryLog = tmp </> "directory_service.log",
+      serviceName = "SimpleX-Directory"
+    }
+
+serviceDbPrefix :: FilePath
+serviceDbPrefix = "directory_service"
+
+testDirectoryService :: HasCallStack => FilePath -> IO ()
+testDirectoryService tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        bob #> "@SimpleX-Directory privacy"
+        bob <# "SimpleX-Directory> > privacy"
+        bob <## "      No groups found"
+        putStrLn "*** create a group"
+        bob ##> "/g PSA Privacy, Security & Anonymity"
+        bob <## "group #PSA (Privacy, Security & Anonymity) is created"
+        bob <## "to add members use /a PSA <name> or /create link #PSA"
+        bob ##> "/a PSA SimpleX-Directory member"
+        bob <## "invitation to join the group #PSA sent to SimpleX-Directory"
+        bob <# "SimpleX-Directory> You must grant directory service admin role to register the group"
+        bob ##> "/mr PSA SimpleX-Directory admin"
+        putStrLn "*** discover service joins group and creates the link for profile"
+        bob <## "#PSA: you changed the role of SimpleX-Directory from member to admin"
+        bob <# "SimpleX-Directory> Joining the group #PSA…"
+        bob <## "#PSA: SimpleX-Directory joined the group"
+        bob <# "SimpleX-Directory> Joined the group #PSA, creating the link…"
+        bob <# "SimpleX-Directory> Created the public link to join the group via this directory service that is always online."
+        bob <## ""
+        bob <## "Please add it to the group welcome message."
+        bob <## "For example, add:"
+        welcomeWithLink <- dropStrPrefix "SimpleX-Directory> " . dropTime <$> getTermLine bob
+        putStrLn "*** update profile without link"
+        updateGroupProfile bob "Welcome!"
+        bob <# "SimpleX-Directory> The profile updated for ID 1 (PSA), but the group link is not added to the welcome message."
+        (superUser </)
+        putStrLn "*** update profile so that it has link"
+        updateGroupProfile bob welcomeWithLink
+        bob <# "SimpleX-Directory> Thank you! The group link for ID 1 (PSA) is added to the welcome message."
+        bob <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
+        approvalRequested superUser welcomeWithLink (1 :: Int)
+        putStrLn "*** update profile so that it still has link"
+        let welcomeWithLink' = "Welcome! " <> welcomeWithLink
+        updateGroupProfile bob welcomeWithLink'
+        bob <# "SimpleX-Directory> The group ID 1 (PSA) is updated!"
+        bob <## "It is hidden from the directory until approved."
+        superUser <# "SimpleX-Directory> The group ID 1 (PSA) is updated."
+        approvalRequested superUser welcomeWithLink' (2 :: Int)
+        putStrLn "*** try approving with the old registration code"
+        superUser #> "@SimpleX-Directory /approve 1:PSA 1"
+        superUser <# "SimpleX-Directory> > /approve 1:PSA 1"
+        superUser <## "      Incorrect approval code"
+        putStrLn "*** update profile so that it has no link"
+        updateGroupProfile bob "Welcome!"
+        bob <# "SimpleX-Directory> The group link for ID 1 (PSA) is removed from the welcome message."
+        bob <## ""
+        bob <## "The group is hidden from the directory until the group link is added and the group is re-approved."
+        superUser <# "SimpleX-Directory> The group link is removed from ID 1 (PSA), de-listed."
+        superUser #> "@SimpleX-Directory /approve 1:PSA 2"
+        superUser <# "SimpleX-Directory> > /approve 1:PSA 2"
+        superUser <## "      Error: the group ID 1 (PSA) is not pending approval."
+        putStrLn "*** update profile so that it has link again"
+        updateGroupProfile bob welcomeWithLink'
+        bob <# "SimpleX-Directory> Thank you! The group link for ID 1 (PSA) is added to the welcome message."
+        bob <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
+        approvalRequested superUser welcomeWithLink' (1 :: Int)
+        superUser #> "@SimpleX-Directory /approve 1:PSA 1"
+        superUser <# "SimpleX-Directory> > /approve 1:PSA 1"
+        superUser <## "      Group approved!"
+        bob <# "SimpleX-Directory> The group ID 1 (PSA) is approved and listed in directory!"
+        bob <## "Please note: if you change the group profile it will be hidden from directory until it is re-approved."
+        search bob "privacy" welcomeWithLink'
+        search bob "security" welcomeWithLink'
+        cath `connectVia` dsLink
+        search cath "privacy" welcomeWithLink'
+  where
+    search u s welcome = do
+      u #> ("@SimpleX-Directory " <> s)
+      u <# ("SimpleX-Directory> > " <> s)
+      u <## "      Found 1 group(s)"
+      u <# "SimpleX-Directory> PSA (Privacy, Security & Anonymity)"
+      u <## "Welcome message:"
+      u <## welcome
+    updateGroupProfile u welcome = do
+      u ##> ("/set welcome #PSA " <> welcome)
+      u <## "description changed to:"
+      u <## welcome
+    approvalRequested su welcome grId = do
+      su <# "SimpleX-Directory> bob submitted the group ID 1: PSA (Privacy, Security & Anonymity)"
+      su <## "Welcome message:"
+      su <## welcome
+      su <## ""
+      su <## "To approve send:"
+      su <# ("SimpleX-Directory> /approve 1:PSA " <> show grId)
+
+testDelistedOwnerLeaves :: HasCallStack => FilePath -> IO ()
+testDelistedOwnerLeaves tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        registerGroup superUser bob "privacy" "Privacy"
+        addCathAsOwner bob cath
+        leaveGroup "privacy" bob
+        cath <## "#privacy: bob left the group"
+        bob <# "SimpleX-Directory> You left the group ID 1 (privacy)."
+        bob <## ""
+        bob <## "Group is no longer listed in the directory."
+        superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (group owner left)."
+        groupNotFound cath "privacy"
+
+testDelistedOwnerRemoved :: HasCallStack => FilePath -> IO ()
+testDelistedOwnerRemoved tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        registerGroup superUser bob "privacy" "Privacy"
+        addCathAsOwner bob cath
+        removeMember "privacy" cath bob
+        bob <# "SimpleX-Directory> You are removed from the group ID 1 (privacy)."
+        bob <## ""
+        bob <## "Group is no longer listed in the directory."
+        superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (group owner is removed)."
+        groupNotFound cath "privacy"
+
+testNotDelistedMemberLeaves :: HasCallStack => FilePath -> IO ()
+testNotDelistedMemberLeaves tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        registerGroup superUser bob "privacy" "Privacy"
+        addCathAsOwner bob cath
+        leaveGroup "privacy" cath
+        bob <## "#privacy: cath left the group"
+        (superUser </)
+        groupFound cath "privacy"
+
+testNotDelistedMemberRemoved :: HasCallStack => FilePath -> IO ()
+testNotDelistedMemberRemoved tmp = 
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        registerGroup superUser bob "privacy" "Privacy"
+        addCathAsOwner bob cath
+        removeMember "privacy" bob cath
+        (superUser </)
+        groupFound cath "privacy"
+
+testDelistedServiceRemoved :: HasCallStack => FilePath -> IO ()
+testDelistedServiceRemoved tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        registerGroup superUser bob "privacy" "Privacy"
+        addCathAsOwner bob cath
+        bob ##> "/rm #privacy SimpleX-Directory"
+        bob <## "#privacy: you removed SimpleX-Directory from the group"
+        cath <## "#privacy: bob removed SimpleX-Directory from the group"
+        bob <# "SimpleX-Directory> SimpleX-Directory is removed from the group ID 1 (privacy)."
+        bob <## ""
+        bob <## "Group is no longer listed in the directory."
+        superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (directory service is removed)."
+        groupNotFound cath "privacy"
+
+testRegOwnerChangedProfile :: HasCallStack => FilePath -> IO ()
+testRegOwnerChangedProfile tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        registerGroup superUser bob "privacy" "Privacy"
+        addCathAsOwner bob cath
+        bob ##> "/gp privacy privacy Privacy and Security"
+        bob <## "full name changed to: Privacy and Security"
+        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 <## "full name changed to: Privacy and Security"
+        groupNotFound cath "privacy"
+        superUser <# "SimpleX-Directory> The group ID 1 (privacy) is updated."
+        reapproveGroup superUser bob
+        groupFound cath "privacy"
+
+testAnotherOwnerChangedProfile :: HasCallStack => FilePath -> IO ()
+testAnotherOwnerChangedProfile tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        registerGroup superUser bob "privacy" "Privacy"
+        addCathAsOwner bob cath
+        cath ##> "/gp privacy privacy Privacy and Security"
+        cath <## "full name changed to: Privacy and Security"
+        bob <## "cath updated group #privacy:"
+        bob <## "full name changed to: Privacy and Security"
+        bob <# "SimpleX-Directory> The group ID 1 (privacy) is updated!"
+        bob <## "It is hidden from the directory until approved."
+        groupNotFound cath "privacy"
+        superUser <# "SimpleX-Directory> The group ID 1 (privacy) is updated."
+        reapproveGroup superUser bob
+        groupFound cath "privacy"
+
+testRegOwnerRemovedLink :: HasCallStack => FilePath -> IO ()
+testRegOwnerRemovedLink tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+  withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "cath" cathProfile $ \cath -> do
+      bob `connectVia` dsLink
+      registerGroup superUser bob "privacy" "Privacy"
+      addCathAsOwner bob cath
+      bob ##> "/show welcome #privacy"
+      bob <## "Welcome message:"
+      welcomeWithLink <- getTermLine bob
+      bob ##> "/set welcome #privacy Welcome!"
+      bob <## "description changed to:"
+      bob <## "Welcome!"
+      bob <# "SimpleX-Directory> The group link for ID 1 (privacy) is removed from the welcome message."
+      bob <## ""
+      bob <## "The group is hidden from the directory until the group link is added and the group is re-approved."
+      cath <## "bob updated group #privacy:"
+      cath <## "description changed to:"
+      cath <## "Welcome!"
+      superUser <# "SimpleX-Directory> The group link is removed from ID 1 (privacy), de-listed."
+      groupNotFound cath "privacy"
+      bob ##> ("/set welcome #privacy " <> welcomeWithLink)
+      bob <## "description changed to:"
+      bob <## welcomeWithLink
+      bob <# "SimpleX-Directory> Thank you! The group link for ID 1 (privacy) is added to the welcome message."
+      bob <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
+      cath <## "bob updated group #privacy:"
+      cath <## "description changed to:"
+      cath <## welcomeWithLink
+      reapproveGroup superUser bob
+      groupFound cath "privacy"
+
+testAnotherOwnerRemovedLink :: HasCallStack => FilePath -> IO ()
+testAnotherOwnerRemovedLink tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+  withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "cath" cathProfile $ \cath -> do
+      bob `connectVia` dsLink
+      registerGroup superUser bob "privacy" "Privacy"
+      addCathAsOwner bob cath
+      bob ##> "/show welcome #privacy"
+      bob <## "Welcome message:"
+      welcomeWithLink <- getTermLine bob
+      cath ##> "/set welcome #privacy Welcome!"
+      cath <## "description changed to:"
+      cath <## "Welcome!"
+      bob <## "cath updated group #privacy:"
+      bob <## "description changed to:"
+      bob <## "Welcome!"
+      bob <# "SimpleX-Directory> The group link for ID 1 (privacy) is removed from the welcome message."
+      bob <## ""
+      bob <## "The group is hidden from the directory until the group link is added and the group is re-approved."
+      superUser <# "SimpleX-Directory> The group link is removed from ID 1 (privacy), de-listed."
+      groupNotFound cath "privacy"
+      cath ##> ("/set welcome #privacy " <> welcomeWithLink)
+      cath <## "description changed to:"
+      cath <## welcomeWithLink
+      bob <## "cath updated group #privacy:"
+      bob <## "description changed to:"
+      bob <## welcomeWithLink
+      bob <# "SimpleX-Directory> The group link is added by another group member, your registration will not be processed."
+      bob <## ""
+      bob <## "Please update the group profile yourself."
+      bob ##> ("/set welcome #privacy " <> welcomeWithLink <> " - welcome!")
+      bob <## "description changed to:"
+      bob <## (welcomeWithLink <> " - welcome!")
+      bob <# "SimpleX-Directory> Thank you! The group link for ID 1 (privacy) is added to the welcome message."
+      bob <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
+      cath <## "bob updated group #privacy:"
+      cath <## "description changed to:"
+      cath <## (welcomeWithLink <> " - welcome!")
+      reapproveGroup superUser bob
+      groupFound cath "privacy"
+
+reapproveGroup :: HasCallStack => TestCC -> TestCC -> IO ()
+reapproveGroup superUser bob = do
+  superUser <#. "SimpleX-Directory> bob submitted the group ID 1: privacy ("
+  superUser <## "Welcome message:"
+  superUser <##. "Link to join the group privacy: "
+  superUser <## ""
+  superUser <## "To approve send:"
+  superUser <# "SimpleX-Directory> /approve 1:privacy 1"
+  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!"
+  bob <## "Please note: if you change the group profile it will be hidden from directory until it is re-approved."
+
+addCathAsOwner :: HasCallStack => TestCC -> TestCC -> IO ()
+addCathAsOwner bob cath = do
+  connectUsers bob cath
+  fullAddMember "privacy" "Privacy" bob cath GROwner
+  joinGroup "privacy" cath bob
+  cath <## "#privacy: member SimpleX-Directory is connected"
+
+withDirectoryService :: HasCallStack => FilePath -> (TestCC -> String -> IO ()) -> IO ()
+withDirectoryService tmp test = do
+  dsLink <-
+    withNewTestChat tmp serviceDbPrefix directoryProfile $ \ds ->
+      withNewTestChat tmp "super_user" aliceProfile $ \superUser -> do
+        connectUsers ds superUser
+        ds ##> "/ad"
+        getContactLink ds True
+  let opts = mkDirectoryOpts tmp [KnownContact 2 "alice"]
+  withDirectory opts $
+    withTestChat tmp "super_user" $ \superUser -> do
+      superUser <## "1 contacts connected (use /cs for the list)"
+      test superUser dsLink
+  where
+    withDirectory :: DirectoryOpts -> IO () -> IO ()
+    withDirectory opts@DirectoryOpts {directoryLog} action = do
+      st <- getDirectoryStore directoryLog
+      t <- forkIO $ bot st
+      threadDelay 500000
+      action `finally` killThread t
+      where
+        bot st = simplexChatCore testCfg (mkChatOpts opts) Nothing $ directoryService st opts
+
+registerGroup :: TestCC -> TestCC -> String -> String -> IO ()
+registerGroup su u n fn = do
+  u ##> ("/g " <> n <> " " <> fn)
+  u <## ("group #" <> n <> " (" <> fn <> ") is created")
+  u <## ("to add members use /a " <> n <> " <name> or /create link #" <> n)
+  u ##> ("/a " <> n <> " SimpleX-Directory admin")
+  u <## ("invitation to join the group #" <> n <> " sent to SimpleX-Directory")
+  u <# ("SimpleX-Directory> Joining the group #" <> n <> "…")
+  u <## ("#" <> n <> ": SimpleX-Directory joined the group")
+  u <# ("SimpleX-Directory> Joined the group #" <> n <> ", creating the link…")
+  u <# "SimpleX-Directory> Created the public link to join the group via this directory service that is always online."
+  u <## ""
+  u <## "Please add it to the group welcome message."
+  u <## "For example, add:"
+  welcomeWithLink <- dropStrPrefix "SimpleX-Directory> " . dropTime <$> getTermLine u
+  u ##> ("/set welcome " <> n <> " " <> welcomeWithLink)
+  u <## "description changed to:"
+  u <## welcomeWithLink
+  u <# ("SimpleX-Directory> Thank you! The group link for ID 1 (" <> n <> ") is added to the welcome message.")
+  u <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
+  su <# ("SimpleX-Directory> bob submitted the group ID 1: " <> n <> " (" <> fn <> ")")
+  su <## "Welcome message:"
+  su <## welcomeWithLink
+  su <## ""
+  su <## "To approve send:"
+  let approve = "/approve 1:" <> n <> " 1"
+  su <# ("SimpleX-Directory> " <> approve)
+  su #> ("@SimpleX-Directory " <> approve)
+  su <# ("SimpleX-Directory> > " <> approve)
+  su <## "      Group approved!"
+  u <# ("SimpleX-Directory> The group ID 1 (" <> n <> ") is approved and listed in directory!")
+  u <## "Please note: if you change the group profile it will be hidden from directory until it is re-approved."
+
+connectVia :: TestCC -> String -> IO ()
+u `connectVia` dsLink = do
+  u ##> ("/c " <> dsLink)
+  u <## "connection request sent!"
+  u <## "SimpleX-Directory: contact is connected"
+  u <# "SimpleX-Directory> Welcome to SimpleX-Directory service!"
+  u <## "Send a search string to find groups or /help to learn how to add groups to directory."
+  u <## ""
+  u <## "For example, send privacy to find groups about privacy."
+
+joinGroup :: String -> TestCC -> TestCC -> IO ()
+joinGroup gName member host = do
+  let gn = "#" <> gName
+  memberName <- userName member
+  hostName <- userName host
+  member ##> ("/j " <> gName)
+  member <## (gn <> ": you joined the group")
+  member <#. (gn <> " " <> hostName <> "> Link to join the group " <> gName <> ": ")
+  host <## (gn <> ": " <> memberName <> " joined the group")
+
+leaveGroup :: String -> TestCC -> IO ()
+leaveGroup gName member = do
+  let gn = "#" <> gName
+  member ##> ("/l " <> gName)
+  member <## (gn <> ": you left the group")
+  member <## ("use /d " <> gn <> " to delete the group")
+
+removeMember :: String -> TestCC -> TestCC -> IO ()
+removeMember gName admin removed = do
+  let gn = "#" <> gName
+  adminName <- userName admin
+  removedName <- userName removed
+  admin ##> ("/rm " <> gName <> " " <> removedName)
+  admin <## (gn <> ": you removed " <> removedName <> " from the group")
+  removed <## (gn <> ": " <> adminName <> " removed you from the group")
+  removed <## ("use /d " <> gn <> " to delete the group")
+
+groupFound :: TestCC -> String -> IO ()
+groupFound u s = do
+  u #> ("@SimpleX-Directory " <> s)
+  u <# ("SimpleX-Directory> > " <> s)
+  u <## "      Found 1 group(s)"
+  u <#. "SimpleX-Directory> privacy ("
+  u <## "Welcome message:"
+  u <##. "Link to join the group privacy: "
+
+groupNotFound :: TestCC -> String -> IO ()
+groupNotFound u s = do
+  u #> ("@SimpleX-Directory " <> s)
+  u <# ("SimpleX-Directory> > " <> s)
+  u <## "      No groups found"
diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs
index c4b7e16c58..694ef847c0 100644
--- a/tests/ChatTests/Utils.hs
+++ b/tests/ChatTests/Utils.hs
@@ -48,9 +48,15 @@ xit' :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
 xit' = if os == "linux" then xit else it
 
 xit'' :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
-xit'' d t = do
+xit'' = ifCI xit it
+
+xdescribe'' :: HasCallStack => String -> SpecWith a -> SpecWith a
+xdescribe'' = ifCI xdescribe describe
+
+ifCI :: HasCallStack => (HasCallStack => String -> a -> SpecWith b) -> (HasCallStack => String -> a -> SpecWith b) -> String -> a -> SpecWith b
+ifCI xrun run d t = do
   ci <- runIO $ lookupEnv "CI"
-  (if ci == Just "true" then xit else it) d t
+  (if ci == Just "true" then xrun else run) d t
 
 versionTestMatrix2 :: (HasCallStack => TestCC -> TestCC -> IO ()) -> SpecWith FilePath
 versionTestMatrix2 runTest = do
@@ -349,6 +355,11 @@ dropTime_ msg = case splitAt 6 msg of
     if all isDigit [m, m', s, s'] then Just text else Nothing
   _ -> Nothing
 
+dropStrPrefix :: HasCallStack => String -> String -> String
+dropStrPrefix pfx s = 
+  let (p, rest) = splitAt (length pfx) s
+   in if p == pfx then rest else error $ "no prefix " <> pfx <> " in string : " <> s
+
 dropReceipt :: HasCallStack => String -> String
 dropReceipt msg = fromMaybe err $ dropReceipt_ msg
   where
@@ -475,14 +486,18 @@ createGroup3 gName cc1 cc2 cc3 = do
     ]
 
 addMember :: HasCallStack => String -> TestCC -> TestCC -> GroupMemberRole -> IO ()
-addMember gName inviting invitee role = do
+addMember gName = fullAddMember gName ""
+
+fullAddMember :: HasCallStack => String -> String -> TestCC -> TestCC -> GroupMemberRole -> IO ()
+fullAddMember gName fullName inviting invitee role = do
   name1 <- userName inviting
   memName <- userName invitee
   inviting ##> ("/a " <> gName <> " " <> memName <> " " <> B.unpack (strEncode role))
+  let fullName' = if null fullName || fullName == gName then "" else " (" <> fullName <> ")"
   concurrentlyN_
     [ inviting <## ("invitation to join the group #" <> gName <> " sent to " <> memName),
       do
-        invitee <## ("#" <> gName <> ": " <> name1 <> " invites you to join the group as " <> B.unpack (strEncode role))
+        invitee <## ("#" <> gName <> fullName' <> ": " <> name1 <> " invites you to join the group as " <> B.unpack (strEncode role))
         invitee <## ("use /j " <> gName <> " to accept")
     ]
 
diff --git a/tests/Test.hs b/tests/Test.hs
index 9010aefa0f..d9d36d472b 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -1,5 +1,8 @@
+import Bots.BroadcastTests
+import Bots.DirectoryTests
 import ChatClient
 import ChatTests
+import ChatTests.Utils (xdescribe'')
 import Control.Logger.Simple
 import Data.Time.Clock.System
 import MarkdownTests
@@ -23,6 +26,8 @@ main = do
     around testBracket $ do
       describe "Mobile API Tests" mobileTests
       describe "SimpleX chat client" chatTests
+      xdescribe'' "SimpleX Broadcast bot" broadcastBotTests
+      xdescribe'' "SimpleX Directory service bot" directoryServiceTests
   where
     testBracket test = do
       t <- getSystemTime

From 497275646df344e6e918ad30452a1f0e3a35b664 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Thu, 3 Aug 2023 09:21:48 +0100
Subject: [PATCH 2/5] directory: registration of duplicate groups (#2840)

* directory: confirm registration of duplicate groups

* do not send duplicate groups for approval

* add test
---
 .../src/Directory/Events.hs                   |   8 +-
 .../src/Directory/Service.hs                  | 146 +++++---
 .../src/Directory/Store.hs                    |   6 +-
 tests/Bots/DirectoryTests.hs                  | 315 +++++++++++++-----
 4 files changed, 337 insertions(+), 138 deletions(-)

diff --git a/apps/simplex-directory-service/src/Directory/Events.hs b/apps/simplex-directory-service/src/Directory/Events.hs
index 01bb181f84..95216dffcf 100644
--- a/apps/simplex-directory-service/src/Directory/Events.hs
+++ b/apps/simplex-directory-service/src/Directory/Events.hs
@@ -89,7 +89,7 @@ data DirectoryCmd (r :: DirectoryRole) where
   DCConfirmDuplicateGroup :: UserGroupRegId -> GroupName -> DirectoryCmd 'DRUser
   DCListUserGroups :: DirectoryCmd 'DRUser
   DCDeleteGroup :: UserGroupRegId -> GroupName -> DirectoryCmd 'DRUser
-  DCApproveGroup :: {groupId :: GroupId, localDisplayName :: GroupName, groupApprovalId :: GroupApprovalId} -> DirectoryCmd 'DRSuperUser
+  DCApproveGroup :: {groupId :: GroupId, displayName :: GroupName, groupApprovalId :: GroupApprovalId} -> DirectoryCmd 'DRSuperUser
   DCRejectGroup :: GroupId -> GroupName -> DirectoryCmd 'DRSuperUser
   DCSuspendGroup :: GroupId -> GroupName -> DirectoryCmd 'DRSuperUser
   DCResumeGroup :: GroupId -> GroupName -> DirectoryCmd 'DRSuperUser
@@ -109,7 +109,7 @@ directoryCmdP =
     tagP = A.takeTill (== ' ') >>= \case
       "help" -> u DCHelp_
       "h" -> u DCHelp_
-      "confim" -> u DCConfirmDuplicateGroup_
+      "confirm" -> u DCConfirmDuplicateGroup_
       "list" -> u DCListUserGroups_
       "delete" -> u DCDeleteGroup_
       "approve" -> su DCApproveGroup_
@@ -128,9 +128,9 @@ directoryCmdP =
       DCListUserGroups_ -> pure DCListUserGroups
       DCDeleteGroup_ -> gc DCDeleteGroup
       DCApproveGroup_ -> do
-        (groupId, localDisplayName) <- gc (,)
+        (groupId, displayName) <- gc (,)
         groupApprovalId <- A.space *> A.decimal
-        pure $ DCApproveGroup {groupId, localDisplayName, groupApprovalId}
+        pure $ DCApproveGroup {groupId, displayName, groupApprovalId}
       DCRejectGroup_ -> gc DCRejectGroup
       DCSuspendGroup_ -> gc DCSuspendGroup
       DCResumeGroup_ -> gc DCResumeGroup
diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs
index 07cd9203e9..116440b91a 100644
--- a/apps/simplex-directory-service/src/Directory/Service.hs
+++ b/apps/simplex-directory-service/src/Directory/Service.hs
@@ -18,6 +18,8 @@ import Control.Concurrent.STM
 import Control.Monad.Reader
 import qualified Data.ByteString.Char8 as B
 import Data.Maybe (fromMaybe)
+import qualified Data.Set as S
+import Data.Text (Text)
 import qualified Data.Text as T
 import Directory.Events
 import Directory.Options
@@ -37,6 +39,11 @@ import System.Directory (getAppUserDataDirectory)
 
 data GroupProfileUpdate = GPNoServiceLink | GPServiceLinkAdded | GPServiceLinkRemoved | GPHasServiceLink | GPServiceLinkError
 
+data DuplicateGroup
+  = DGUnique -- display name or full name is unique
+  | DGRegistered -- the group with the same names is registered, additional confirmation is required
+  | DGListed -- the group with the same names is listed, the registration is not allowed
+
 welcomeGetOpts :: IO DirectoryOpts
 welcomeGetOpts = do
   appDir <- getAppUserDataDirectory "simplex"
@@ -70,10 +77,6 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
   where
     withSuperUsers action = void . forkIO $ forM_ superUsers $ \KnownContact {contactId} -> action contactId
     notifySuperUsers s = withSuperUsers $ \contactId -> sendMessage' cc contactId s
-    -- withContact ctId GroupInfo {localDisplayName} err action = do
-    --   getContact cc ctId >>= \case
-    --     Just ct -> action ct
-    --     Nothing -> putStrLn $ T.unpack $ "Error: " <> err <> ", group: " <> localDisplayName <> ", can't find contact ID " <> tshow ctId
     notifyOwner GroupReg {dbContactId} = sendMessage' cc dbContactId
     ctId `isOwner` GroupReg {dbContactId} = ctId == dbContactId
     withGroupReg GroupInfo {groupId, localDisplayName} err action = do
@@ -86,8 +89,40 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
 
     groupInfoText GroupProfile {displayName = n, fullName = fn, description = d} =
       n <> (if n == fn || T.null fn then "" else " (" <> fn <> ")") <> maybe "" ("\nWelcome message:\n" <>) d
-    groupReference GroupInfo {groupId, groupProfile = p'@GroupProfile {displayName}} =
+    groupReference GroupInfo {groupId, groupProfile = GroupProfile {displayName}} =
       "ID " <> show groupId <> " (" <> T.unpack displayName <> ")"
+    groupAlreadyListed GroupInfo {groupProfile = GroupProfile {displayName, fullName}} =
+      T.unpack $ "The group " <> displayName <> " (" <> fullName <> ") is already listed in the directory, please choose another name."
+
+    getGroups :: Text -> IO (Maybe [GroupInfo])
+    getGroups search =
+      sendChatCmd cc (APIListGroups userId Nothing $ Just $ T.unpack search) >>= \case
+        CRGroupsList {groups} -> pure $ Just groups
+        _ -> pure Nothing
+
+    getDuplicateGroup :: GroupInfo -> IO (Maybe DuplicateGroup)
+    getDuplicateGroup GroupInfo {groupId, groupProfile = GroupProfile {displayName, fullName}} =
+      getGroups fullName >>= mapM duplicateGroup
+      where
+        sameGroup GroupInfo {groupId = gId, groupProfile = GroupProfile {displayName = n, fullName = fn}} =
+          gId /= groupId && n == displayName && fn == fullName
+        duplicateGroup [] = pure DGUnique
+        duplicateGroup groups = do
+          let gs = filter sameGroup groups
+          if null gs
+            then pure DGUnique
+            else do
+              lgs <- readTVarIO $ listedGroups st
+              let listed = any (\GroupInfo {groupId = gId} -> gId `S.member` lgs) gs
+              pure $ if listed then DGListed else DGRegistered
+
+    processInvitation :: Contact -> GroupInfo -> IO ()
+    processInvitation ct g@GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = do
+      atomically $ addGroupReg st ct g GRSProposed
+      r <- sendChatCmd cc $ APIJoinGroup groupId
+      sendMessage cc ct $ T.unpack $ case r of
+        CRUserAcceptedGroupSent {} -> "Joining the group " <> displayName <> "…"
+        _ -> "Error joining group " <> displayName <> ", please re-send the invitation!"
 
     deContactConnected :: Contact -> IO ()
     deContactConnected ct = do
@@ -98,24 +133,31 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
         \For example, send _privacy_ to find groups about privacy."
 
     deGroupInvitation :: Contact -> GroupInfo -> GroupMemberRole -> GroupMemberRole -> IO ()
-    deGroupInvitation ct g fromMemberRole memberRole =
+    deGroupInvitation ct g@GroupInfo {groupId, groupProfile = GroupProfile {displayName, fullName}} fromMemberRole memberRole = do
       case badInvitation fromMemberRole memberRole of
-        -- TODO check duplicate group name and ask to confirm
         Just msg -> sendMessage cc ct msg
-        Nothing -> do
-          let GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = g
-          atomically $ addGroupReg st ct g
-          r <- sendChatCmd cc $ APIJoinGroup groupId
-          sendMessage cc ct $ T.unpack $ case r of
-            CRUserAcceptedGroupSent {} -> "Joining the group #" <> displayName <> "…"
-            _ -> "Error joining group " <> displayName <> ", please re-send the invitation!"
+        Nothing -> getDuplicateGroup g >>= \case
+          Just DGUnique -> processInvitation ct g
+          Just DGRegistered -> askConfirmation
+          Just DGListed -> sendMessage cc ct $ groupAlreadyListed g
+          Nothing -> sendMessage cc ct $ "Unexpected error, please notify the developers."
+      where
+        badInvitation contactRole serviceRole = case (contactRole, serviceRole) of
+          (GROwner, GRAdmin) -> Nothing
+          (_, GRAdmin) -> Just "You must have a group *owner* role to register the group"
+          (GROwner, _) -> Just "You must grant directory service *admin* role to register the group"
+          _ -> Just "You must have a group *owner* role and you must grant directory service *admin* role to register the group"
+        askConfirmation = do
+          atomically $ addGroupReg st ct g GRSPendingConfirmation
+          sendMessage cc ct $ T.unpack $ "The group " <> displayName <> " (" <> fullName <> ") is already submitted to the directory.\nTo confirm the registration, please send:"
+          sendMessage cc ct $ "/confirm " <> show groupId <> ":" <> T.unpack displayName
 
     deServiceJoinedGroup :: ContactId -> GroupInfo -> IO ()
     deServiceJoinedGroup ctId g =
       withGroupReg g "joined group" $ \gr ->
         when (ctId `isOwner` gr) $ do
           let GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = g
-          notifyOwner gr $ T.unpack $ "Joined the group #" <> displayName <> ", creating the link…"
+          notifyOwner gr $ T.unpack $ "Joined the group " <> displayName <> ", creating the link…"
           sendChatCmd cc (APICreateGroupLink groupId GRMember) >>= \case
             CRGroupLinkCreated {connReqContact} -> do
               setGroupInactive gr GRSPendingUpdate
@@ -158,17 +200,21 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
       where
         isInfix l d_ = l `T.isInfixOf` fromMaybe "" d_
         GroupInfo {groupId, groupProfile = p} = fromGroup
-        GroupInfo {localDisplayName, groupProfile = p'@GroupProfile {image = image'}} = toGroup
+        GroupInfo {groupProfile = p'@GroupProfile {displayName = displayName', image = image'}} = toGroup
         groupRef = groupReference toGroup
         sameProfile
           GroupProfile {displayName = n, fullName = fn, image = i, description = d}
           GroupProfile {displayName = n', fullName = fn', image = i', description = d'} =
             n == n' && fn == fn' && i == i' && d == d'
         groupLinkAdded gr = do
-          notifyOwner gr $ "Thank you! The group link for " <> groupRef <> " is added to the welcome message.\nYou will be notified once the group is added to the directory - it may take up to 24 hours."
-          let gaId = 1
-          setGroupInactive gr $ GRSPendingApproval gaId
-          sendForApproval gr gaId
+          getDuplicateGroup toGroup >>= \case
+            Nothing -> notifyOwner gr "Unexpected error, please notify the developers."
+            Just DGListed -> notifyOwner gr $ groupAlreadyListed toGroup
+            _ -> do
+              notifyOwner gr $ "Thank you! The group link for " <> groupRef <> " is added to the welcome message.\nYou will be notified once the group is added to the directory - it may take up to 24 hours."
+              let gaId = 1
+              setGroupInactive gr $ GRSPendingApproval gaId
+              sendForApproval gr gaId
         processProfileChange gr n' = groupProfileUpdate >>= \case
           GPNoServiceLink -> do
             setGroupInactive gr GRSPendingUpdate
@@ -208,7 +254,7 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
               msg = maybe (MCText text) (\image -> MCImage {text, image}) image'
           withSuperUsers $ \cId -> do
             sendComposedMessage' cc cId Nothing msg
-            sendMessage' cc cId $ "/approve " <> show dbGroupId <> ":" <> T.unpack localDisplayName <> " " <> show gaId
+            sendMessage' cc cId $ "/approve " <> show dbGroupId <> ":" <> T.unpack displayName' <> " " <> show gaId
 
     deContactRoleChanged :: ContactId -> GroupInfo -> GroupMemberRole -> IO ()
     deContactRoleChanged ctId g role = undefined
@@ -252,9 +298,9 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
           \3. You will then need to add this link to the group welcome message.\n\
           \4. Once the link is added, service admins will approve the group (it can take up to 24 hours), and everybody will be able to find it in directory.\n\n\
           \Start from inviting the bot to your group as admin - it will guide you through the process"
-      DCSearchGroup s -> do
-        sendChatCmd cc (APIListGroups userId Nothing $ Just $ T.unpack s) >>= \case
-          CRGroupsList {groups} ->
+      DCSearchGroup s ->
+        getGroups s >>= \case
+          Just groups ->
             atomically (filterListedGroups st groups) >>= \case
               [] -> sendReply "No groups found"
               gs -> do
@@ -263,8 +309,23 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
                   let text = groupInfoText p
                       msg = maybe (MCText text) (\image -> MCImage {text, image}) image_
                   sendComposedMessage cc ct Nothing msg
-          _ -> sendReply "Unexpected error"
-      DCConfirmDuplicateGroup _ugrId _gName -> pure ()
+          Nothing -> sendReply "Unexpected error, please notify the developers."
+      DCConfirmDuplicateGroup ugrId gName ->
+        atomically (getGroupReg st ugrId) >>= \case
+          Nothing -> sendReply $ "Group ID " <> show ugrId <> " not found"
+          Just GroupReg {dbGroupId, groupRegStatus} -> do
+            getGroup cc dbGroupId >>= \case
+              Nothing -> sendReply $ "Group ID " <> show ugrId <> " not found"
+              Just g@GroupInfo {groupProfile = GroupProfile {displayName}}
+                | displayName == gName ->
+                  readTVarIO groupRegStatus >>= \case
+                    GRSPendingConfirmation -> do
+                      getDuplicateGroup g >>= \case
+                        Nothing -> sendMessage cc ct $ "Unexpected error, please notify the developers."
+                        Just DGListed -> sendMessage cc ct $ groupAlreadyListed g
+                        _ -> processInvitation ct g
+                    _ -> sendReply $ "Error: the group ID " <> show ugrId <> " (" <> T.unpack displayName <> ") is not pending confirmation."
+                | otherwise -> sendReply $ "Group ID " <> show ugrId <> " has the display name " <> T.unpack displayName
       DCListUserGroups -> pure ()
       DCDeleteGroup _ugrId _gName -> pure ()
       DCUnknownCommand -> sendReply "Unknown command"
@@ -275,25 +336,31 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
     deSuperUserCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRSuperUser -> IO ()
     deSuperUserCommand ct ciId cmd
       | superUser `elem` superUsers = case cmd of
-        DCApproveGroup {groupId, localDisplayName = n, groupApprovalId} ->
+        DCApproveGroup {groupId, displayName = n, groupApprovalId} ->
           atomically (getGroupReg st groupId) >>= \case
-            Nothing -> sendMessage cc ct $ "Group ID " <> show groupId <> " not found"
+            Nothing -> sendReply $ "Group ID " <> show groupId <> " not found"
             Just GroupReg {dbContactId, groupRegStatus} -> do
               readTVarIO groupRegStatus >>= \case
                 GRSPendingApproval gaId
                   | gaId == groupApprovalId -> do
                     getGroup cc groupId >>= \case
-                      Just GroupInfo {localDisplayName = n'}
-                        | n == n' -> do
-                          atomically $ do
-                            writeTVar groupRegStatus GRSActive
-                            listGroup st groupId
-                          sendReply "Group approved!"
-                          sendMessage' cc dbContactId $ "The group ID " <> show groupId <> " (" <> T.unpack n <> ") is approved and listed in directory!\nPlease note: if you change the group profile it will be hidden from directory until it is re-approved."
+                      Just g@GroupInfo {groupProfile = GroupProfile {displayName = n'}}
+                        | n == n' ->
+                          getDuplicateGroup g >>= \case
+                            Nothing -> sendReply $ "Unexpected error, please notify the developers."
+                            Just DGListed -> sendReply $ "The group " <> groupRef <> " is already listed in the directory."
+                            _ -> do
+                              atomically $ do
+                                writeTVar groupRegStatus GRSActive
+                                listGroup st groupId
+                              sendReply "Group approved!"
+                              sendMessage' cc dbContactId $ "The group " <> groupRef <> " is approved and listed in directory!\nPlease note: if you change the group profile it will be hidden from directory until it is re-approved."
                         | otherwise -> sendReply "Incorrect group name"
                       Nothing -> pure ()
                   | otherwise -> sendReply "Incorrect approval code"
-                _ -> sendReply $ "Error: the group ID " <> show groupId <> " (" <> T.unpack n <> ") is not pending approval."
+                _ -> sendReply $ "Error: the group " <> groupRef <> " is not pending approval."
+          where
+            groupRef = "ID " <> show groupId <> " (" <> T.unpack n <> ")"
         DCRejectGroup _gaId _gName -> pure ()
         DCSuspendGroup _gId _gName -> pure ()
         DCResumeGroup _gId _gName -> pure ()
@@ -304,13 +371,6 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
         superUser = KnownContact {contactId = contactId' ct, localDisplayName = localDisplayName' ct}
         sendReply = sendComposedMessage cc ct (Just ciId) . textMsgContent
 
-badInvitation :: GroupMemberRole -> GroupMemberRole -> Maybe String
-badInvitation contactRole serviceRole = case (contactRole, serviceRole) of
-  (GROwner, GRAdmin) -> Nothing
-  (_, GRAdmin) -> Just "You must have a group *owner* role to register the group"
-  (GROwner, _) -> Just "You must grant directory service *admin* role to register the group"
-  _ -> Just "You must have a group *owner* role and you must grant directory service *admin* role to register the group"
-
 getContact :: ChatController -> ContactId -> IO (Maybe Contact)
 getContact cc ctId = resp <$> sendChatCmd cc (APIGetChat (ChatRef CTDirect ctId) (CPLast 0) Nothing)
   where
diff --git a/apps/simplex-directory-service/src/Directory/Store.hs b/apps/simplex-directory-service/src/Directory/Store.hs
index f41a487e28..b4508d6b92 100644
--- a/apps/simplex-directory-service/src/Directory/Store.hs
+++ b/apps/simplex-directory-service/src/Directory/Store.hs
@@ -37,9 +37,9 @@ data GroupRegStatus
   | GRSSuspended
   | GRSRemoved
 
-addGroupReg :: DirectoryStore -> Contact -> GroupInfo -> STM ()
-addGroupReg st ct GroupInfo {groupId} = do
-  groupRegStatus <- newTVar GRSProposed
+addGroupReg :: DirectoryStore -> Contact -> GroupInfo -> GroupRegStatus -> STM ()
+addGroupReg st ct GroupInfo {groupId} grStatus = do
+  groupRegStatus <- newTVar grStatus
   let gr = GroupReg {userGroupRegId = groupId, dbGroupId = groupId, dbContactId = contactId' ct, groupRegStatus}
   modifyTVar' (groupRegs st) (gr :)
 
diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs
index eb3926df69..d1c34e7ada 100644
--- a/tests/Bots/DirectoryTests.hs
+++ b/tests/Bots/DirectoryTests.hs
@@ -34,6 +34,12 @@ directoryServiceTests = do
   describe "should require profile update if group link is removed by " $ do
     it "the registration owner" testRegOwnerRemovedLink
     it "another owner" testAnotherOwnerRemovedLink
+  describe "duplicate groups (same display name and full name)" $ do
+    it "should ask for confirmation if a duplicate group is submitted" testDuplicateAskConfirmation
+    it "should prohibit registration if a duplicate group is listed" testDuplicateProhibitRegistration
+    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
 
 directoryProfile :: Profile
 directoryProfile = Profile {displayName = "SimpleX-Directory", fullName = "", image = Nothing, contactLink = Nothing, preferences = Nothing}
@@ -59,7 +65,7 @@ testDirectoryService tmp =
         bob #> "@SimpleX-Directory privacy"
         bob <# "SimpleX-Directory> > privacy"
         bob <## "      No groups found"
-        putStrLn "*** create a group"
+        -- putStrLn "*** create a group"
         bob ##> "/g PSA Privacy, Security & Anonymity"
         bob <## "group #PSA (Privacy, Security & Anonymity) is created"
         bob <## "to add members use /a PSA <name> or /create link #PSA"
@@ -67,37 +73,37 @@ testDirectoryService tmp =
         bob <## "invitation to join the group #PSA sent to SimpleX-Directory"
         bob <# "SimpleX-Directory> You must grant directory service admin role to register the group"
         bob ##> "/mr PSA SimpleX-Directory admin"
-        putStrLn "*** discover service joins group and creates the link for profile"
+        -- putStrLn "*** discover service joins group and creates the link for profile"
         bob <## "#PSA: you changed the role of SimpleX-Directory from member to admin"
-        bob <# "SimpleX-Directory> Joining the group #PSA…"
+        bob <# "SimpleX-Directory> Joining the group PSA…"
         bob <## "#PSA: SimpleX-Directory joined the group"
-        bob <# "SimpleX-Directory> Joined the group #PSA, creating the link…"
+        bob <# "SimpleX-Directory> Joined the group PSA, creating the link…"
         bob <# "SimpleX-Directory> Created the public link to join the group via this directory service that is always online."
         bob <## ""
         bob <## "Please add it to the group welcome message."
         bob <## "For example, add:"
         welcomeWithLink <- dropStrPrefix "SimpleX-Directory> " . dropTime <$> getTermLine bob
-        putStrLn "*** update profile without link"
+        -- putStrLn "*** update profile without link"
         updateGroupProfile bob "Welcome!"
         bob <# "SimpleX-Directory> The profile updated for ID 1 (PSA), but the group link is not added to the welcome message."
         (superUser </)
-        putStrLn "*** update profile so that it has link"
+        -- putStrLn "*** update profile so that it has link"
         updateGroupProfile bob welcomeWithLink
         bob <# "SimpleX-Directory> Thank you! The group link for ID 1 (PSA) is added to the welcome message."
         bob <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
         approvalRequested superUser welcomeWithLink (1 :: Int)
-        putStrLn "*** update profile so that it still has link"
+        -- putStrLn "*** update profile so that it still has link"
         let welcomeWithLink' = "Welcome! " <> welcomeWithLink
         updateGroupProfile bob welcomeWithLink'
         bob <# "SimpleX-Directory> The group ID 1 (PSA) is updated!"
         bob <## "It is hidden from the directory until approved."
         superUser <# "SimpleX-Directory> The group ID 1 (PSA) is updated."
         approvalRequested superUser welcomeWithLink' (2 :: Int)
-        putStrLn "*** try approving with the old registration code"
+        -- putStrLn "*** try approving with the old registration code"
         superUser #> "@SimpleX-Directory /approve 1:PSA 1"
         superUser <# "SimpleX-Directory> > /approve 1:PSA 1"
         superUser <## "      Incorrect approval code"
-        putStrLn "*** update profile so that it has no link"
+        -- putStrLn "*** update profile so that it has no link"
         updateGroupProfile bob "Welcome!"
         bob <# "SimpleX-Directory> The group link for ID 1 (PSA) is removed from the welcome message."
         bob <## ""
@@ -106,7 +112,7 @@ testDirectoryService tmp =
         superUser #> "@SimpleX-Directory /approve 1:PSA 2"
         superUser <# "SimpleX-Directory> > /approve 1:PSA 2"
         superUser <## "      Error: the group ID 1 (PSA) is not pending approval."
-        putStrLn "*** update profile so that it has link again"
+        -- putStrLn "*** update profile so that it has link again"
         updateGroupProfile bob welcomeWithLink'
         bob <# "SimpleX-Directory> Thank you! The group link for ID 1 (PSA) is added to the welcome message."
         bob <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
@@ -254,77 +260,184 @@ testAnotherOwnerChangedProfile tmp =
 testRegOwnerRemovedLink :: HasCallStack => FilePath -> IO ()
 testRegOwnerRemovedLink tmp =
   withDirectoryService tmp $ \superUser dsLink ->
-  withNewTestChat tmp "bob" bobProfile $ \bob -> do
-    withNewTestChat tmp "cath" cathProfile $ \cath -> do
-      bob `connectVia` dsLink
-      registerGroup superUser bob "privacy" "Privacy"
-      addCathAsOwner bob cath
-      bob ##> "/show welcome #privacy"
-      bob <## "Welcome message:"
-      welcomeWithLink <- getTermLine bob
-      bob ##> "/set welcome #privacy Welcome!"
-      bob <## "description changed to:"
-      bob <## "Welcome!"
-      bob <# "SimpleX-Directory> The group link for ID 1 (privacy) is removed from the welcome message."
-      bob <## ""
-      bob <## "The group is hidden from the directory until the group link is added and the group is re-approved."
-      cath <## "bob updated group #privacy:"
-      cath <## "description changed to:"
-      cath <## "Welcome!"
-      superUser <# "SimpleX-Directory> The group link is removed from ID 1 (privacy), de-listed."
-      groupNotFound cath "privacy"
-      bob ##> ("/set welcome #privacy " <> welcomeWithLink)
-      bob <## "description changed to:"
-      bob <## welcomeWithLink
-      bob <# "SimpleX-Directory> Thank you! The group link for ID 1 (privacy) is added to the welcome message."
-      bob <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
-      cath <## "bob updated group #privacy:"
-      cath <## "description changed to:"
-      cath <## welcomeWithLink
-      reapproveGroup superUser bob
-      groupFound cath "privacy"
+    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        registerGroup superUser bob "privacy" "Privacy"
+        addCathAsOwner bob cath
+        bob ##> "/show welcome #privacy"
+        bob <## "Welcome message:"
+        welcomeWithLink <- getTermLine bob
+        bob ##> "/set welcome #privacy Welcome!"
+        bob <## "description changed to:"
+        bob <## "Welcome!"
+        bob <# "SimpleX-Directory> The group link for ID 1 (privacy) is removed from the welcome message."
+        bob <## ""
+        bob <## "The group is hidden from the directory until the group link is added and the group is re-approved."
+        cath <## "bob updated group #privacy:"
+        cath <## "description changed to:"
+        cath <## "Welcome!"
+        superUser <# "SimpleX-Directory> The group link is removed from ID 1 (privacy), de-listed."
+        groupNotFound cath "privacy"
+        bob ##> ("/set welcome #privacy " <> welcomeWithLink)
+        bob <## "description changed to:"
+        bob <## welcomeWithLink
+        bob <# "SimpleX-Directory> Thank you! The group link for ID 1 (privacy) is added to the welcome message."
+        bob <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
+        cath <## "bob updated group #privacy:"
+        cath <## "description changed to:"
+        cath <## welcomeWithLink
+        reapproveGroup superUser bob
+        groupFound cath "privacy"
 
 testAnotherOwnerRemovedLink :: HasCallStack => FilePath -> IO ()
 testAnotherOwnerRemovedLink tmp =
   withDirectoryService tmp $ \superUser dsLink ->
-  withNewTestChat tmp "bob" bobProfile $ \bob -> do
-    withNewTestChat tmp "cath" cathProfile $ \cath -> do
-      bob `connectVia` dsLink
-      registerGroup superUser bob "privacy" "Privacy"
-      addCathAsOwner bob cath
-      bob ##> "/show welcome #privacy"
-      bob <## "Welcome message:"
-      welcomeWithLink <- getTermLine bob
-      cath ##> "/set welcome #privacy Welcome!"
-      cath <## "description changed to:"
-      cath <## "Welcome!"
-      bob <## "cath updated group #privacy:"
-      bob <## "description changed to:"
-      bob <## "Welcome!"
-      bob <# "SimpleX-Directory> The group link for ID 1 (privacy) is removed from the welcome message."
-      bob <## ""
-      bob <## "The group is hidden from the directory until the group link is added and the group is re-approved."
-      superUser <# "SimpleX-Directory> The group link is removed from ID 1 (privacy), de-listed."
-      groupNotFound cath "privacy"
-      cath ##> ("/set welcome #privacy " <> welcomeWithLink)
-      cath <## "description changed to:"
-      cath <## welcomeWithLink
-      bob <## "cath updated group #privacy:"
-      bob <## "description changed to:"
-      bob <## welcomeWithLink
-      bob <# "SimpleX-Directory> The group link is added by another group member, your registration will not be processed."
-      bob <## ""
-      bob <## "Please update the group profile yourself."
-      bob ##> ("/set welcome #privacy " <> welcomeWithLink <> " - welcome!")
-      bob <## "description changed to:"
-      bob <## (welcomeWithLink <> " - welcome!")
-      bob <# "SimpleX-Directory> Thank you! The group link for ID 1 (privacy) is added to the welcome message."
-      bob <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
-      cath <## "bob updated group #privacy:"
-      cath <## "description changed to:"
-      cath <## (welcomeWithLink <> " - welcome!")
-      reapproveGroup superUser bob
-      groupFound cath "privacy"
+    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        registerGroup superUser bob "privacy" "Privacy"
+        addCathAsOwner bob cath
+        bob ##> "/show welcome #privacy"
+        bob <## "Welcome message:"
+        welcomeWithLink <- getTermLine bob
+        cath ##> "/set welcome #privacy Welcome!"
+        cath <## "description changed to:"
+        cath <## "Welcome!"
+        bob <## "cath updated group #privacy:"
+        bob <## "description changed to:"
+        bob <## "Welcome!"
+        bob <# "SimpleX-Directory> The group link for ID 1 (privacy) is removed from the welcome message."
+        bob <## ""
+        bob <## "The group is hidden from the directory until the group link is added and the group is re-approved."
+        superUser <# "SimpleX-Directory> The group link is removed from ID 1 (privacy), de-listed."
+        groupNotFound cath "privacy"
+        cath ##> ("/set welcome #privacy " <> welcomeWithLink)
+        cath <## "description changed to:"
+        cath <## welcomeWithLink
+        bob <## "cath updated group #privacy:"
+        bob <## "description changed to:"
+        bob <## welcomeWithLink
+        bob <# "SimpleX-Directory> The group link is added by another group member, your registration will not be processed."
+        bob <## ""
+        bob <## "Please update the group profile yourself."
+        bob ##> ("/set welcome #privacy " <> welcomeWithLink <> " - welcome!")
+        bob <## "description changed to:"
+        bob <## (welcomeWithLink <> " - welcome!")
+        bob <# "SimpleX-Directory> Thank you! The group link for ID 1 (privacy) is added to the welcome message."
+        bob <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
+        cath <## "bob updated group #privacy:"
+        cath <## "description changed to:"
+        cath <## (welcomeWithLink <> " - welcome!")
+        reapproveGroup superUser bob
+        groupFound cath "privacy"
+
+testDuplicateAskConfirmation :: HasCallStack => FilePath -> IO ()
+testDuplicateAskConfirmation tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        submitGroup bob "privacy" "Privacy"
+        _ <- groupAccepted bob "privacy"
+        cath `connectVia` dsLink
+        submitGroup cath "privacy" "Privacy"
+        cath <# "SimpleX-Directory> The group privacy (Privacy) is already submitted to the directory."
+        cath <## "To confirm the registration, please send:"
+        cath <# "SimpleX-Directory> /confirm 2:privacy"
+        cath #> "@SimpleX-Directory /confirm 2:privacy"
+        welcomeWithLink <- groupAccepted cath "privacy"
+        groupNotFound bob "privacy"
+        completeRegistration superUser cath "privacy" "Privacy" welcomeWithLink 2
+        groupFound bob "privacy"
+
+testDuplicateProhibitRegistration :: HasCallStack => FilePath -> IO ()
+testDuplicateProhibitRegistration tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        registerGroup superUser bob "privacy" "Privacy"
+        cath `connectVia` dsLink
+        groupFound cath "privacy"
+        _ <- submitGroup cath "privacy" "Privacy"
+        cath <# "SimpleX-Directory> The group privacy (Privacy) is already listed in the directory, please choose another name."
+
+testDuplicateProhibitConfirmation :: HasCallStack => FilePath -> IO ()
+testDuplicateProhibitConfirmation tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        submitGroup bob "privacy" "Privacy"
+        welcomeWithLink <- groupAccepted bob "privacy"
+        cath `connectVia` dsLink
+        submitGroup cath "privacy" "Privacy"
+        cath <# "SimpleX-Directory> The group privacy (Privacy) is already submitted to the directory."
+        cath <## "To confirm the registration, please send:"
+        cath <# "SimpleX-Directory> /confirm 2:privacy"
+        groupNotFound cath "privacy"
+        completeRegistration superUser bob "privacy" "Privacy" welcomeWithLink 1
+        groupFound cath "privacy"
+        cath #> "@SimpleX-Directory /confirm 2:privacy"
+        cath <# "SimpleX-Directory> The group privacy (Privacy) is already listed in the directory, please choose another name."
+
+testDuplicateProhibitWhenUpdated :: HasCallStack => FilePath -> IO ()
+testDuplicateProhibitWhenUpdated tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        submitGroup bob "privacy" "Privacy"
+        welcomeWithLink <- groupAccepted bob "privacy"
+        cath `connectVia` dsLink
+        submitGroup cath "privacy" "Privacy"
+        cath <# "SimpleX-Directory> The group privacy (Privacy) is already submitted to the directory."
+        cath <## "To confirm the registration, please send:"
+        cath <# "SimpleX-Directory> /confirm 2:privacy"
+        cath #> "@SimpleX-Directory /confirm 2:privacy"
+        welcomeWithLink' <- groupAccepted cath "privacy"
+        groupNotFound cath "privacy"
+        completeRegistration superUser bob "privacy" "Privacy" welcomeWithLink 1
+        groupFound cath "privacy"
+        cath ##> ("/set welcome privacy " <> welcomeWithLink')
+        cath <## "description changed to:"
+        cath <## welcomeWithLink'
+        cath <# "SimpleX-Directory> The group privacy (Privacy) is already listed in the directory, please choose another name."
+        cath ##> "/gp privacy security Security"
+        cath <## "changed to #security (Security)"
+        cath <# "SimpleX-Directory> Thank you! The group link for ID 2 (security) is added to the welcome message."
+        cath <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
+        notifySuperUser superUser cath "security" "Security" welcomeWithLink' 2
+        approveRegistration superUser cath "security" 2
+        groupFound bob "security"
+        groupFound cath "security"
+
+testDuplicateProhibitApproval :: HasCallStack => FilePath -> IO ()
+testDuplicateProhibitApproval tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        submitGroup bob "privacy" "Privacy"
+        welcomeWithLink <- groupAccepted bob "privacy"
+        cath `connectVia` dsLink
+        submitGroup cath "privacy" "Privacy"
+        cath <# "SimpleX-Directory> The group privacy (Privacy) is already submitted to the directory."
+        cath <## "To confirm the registration, please send:"
+        cath <# "SimpleX-Directory> /confirm 2:privacy"
+        cath #> "@SimpleX-Directory /confirm 2:privacy"
+        welcomeWithLink' <- groupAccepted cath "privacy"
+        updateProfileWithLink cath "privacy" welcomeWithLink' 2
+        notifySuperUser superUser cath "privacy" "Privacy" welcomeWithLink' 2
+        groupNotFound cath "privacy"
+        completeRegistration superUser bob "privacy" "Privacy" welcomeWithLink 1
+        groupFound cath "privacy"
+        -- fails at approval, as already listed
+        let approve = "/approve 2:privacy 1"
+        superUser #> ("@SimpleX-Directory " <> approve)
+        superUser <# ("SimpleX-Directory> > " <> approve)
+        superUser <## "      The group ID 2 (privacy) is already listed in the directory."
 
 reapproveGroup :: HasCallStack => TestCC -> TestCC -> IO ()
 reapproveGroup superUser bob = do
@@ -372,35 +485,61 @@ withDirectoryService tmp test = do
 
 registerGroup :: TestCC -> TestCC -> String -> String -> IO ()
 registerGroup su u n fn = do
+  submitGroup u n fn
+  welcomeWithLink <- groupAccepted u n
+  completeRegistration su u n fn welcomeWithLink 1
+
+submitGroup :: TestCC -> String -> String -> IO ()
+submitGroup u n fn = do
   u ##> ("/g " <> n <> " " <> fn)
   u <## ("group #" <> n <> " (" <> fn <> ") is created")
   u <## ("to add members use /a " <> n <> " <name> or /create link #" <> n)
   u ##> ("/a " <> n <> " SimpleX-Directory admin")
   u <## ("invitation to join the group #" <> n <> " sent to SimpleX-Directory")
-  u <# ("SimpleX-Directory> Joining the group #" <> n <> "…")
+
+groupAccepted :: TestCC -> String -> IO String
+groupAccepted u n = do
+  u <# ("SimpleX-Directory> Joining the group " <> n <> "…")
   u <## ("#" <> n <> ": SimpleX-Directory joined the group")
-  u <# ("SimpleX-Directory> Joined the group #" <> n <> ", creating the link…")
+  u <# ("SimpleX-Directory> Joined the group " <> n <> ", creating the link…")
   u <# "SimpleX-Directory> Created the public link to join the group via this directory service that is always online."
   u <## ""
   u <## "Please add it to the group welcome message."
   u <## "For example, add:"
-  welcomeWithLink <- dropStrPrefix "SimpleX-Directory> " . dropTime <$> getTermLine u
+  dropStrPrefix "SimpleX-Directory> " . dropTime <$> getTermLine u -- welcome message with link
+
+completeRegistration :: TestCC -> TestCC -> String -> String -> String -> Int -> IO ()
+completeRegistration su u n fn welcomeWithLink gId = do
+  updateProfileWithLink u n welcomeWithLink gId
+  notifySuperUser su u n fn welcomeWithLink gId
+  approveRegistration su u n gId
+
+updateProfileWithLink :: TestCC -> String -> String -> Int -> IO ()
+updateProfileWithLink u n welcomeWithLink gId = do
   u ##> ("/set welcome " <> n <> " " <> welcomeWithLink)
   u <## "description changed to:"
   u <## welcomeWithLink
-  u <# ("SimpleX-Directory> Thank you! The group link for ID 1 (" <> n <> ") is added to the welcome message.")
+  u <# ("SimpleX-Directory> Thank you! The group link for ID " <> show gId <> " (" <> n <> ") is added to the welcome message.")
   u <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
-  su <# ("SimpleX-Directory> bob submitted the group ID 1: " <> n <> " (" <> fn <> ")")
+
+notifySuperUser :: TestCC -> TestCC -> String -> String -> String -> Int -> IO ()
+notifySuperUser su u n fn welcomeWithLink gId = do
+  uName <- userName u
+  su <# ("SimpleX-Directory> " <> uName <> " submitted the group ID " <> show gId <> ": " <> n <> " (" <> fn <> ")")
   su <## "Welcome message:"
   su <## welcomeWithLink
   su <## ""
   su <## "To approve send:"
-  let approve = "/approve 1:" <> n <> " 1"
+  let approve = "/approve " <> show gId <> ":" <> n <> " 1"
   su <# ("SimpleX-Directory> " <> approve)
+
+approveRegistration :: TestCC -> TestCC -> String -> Int -> IO ()
+approveRegistration su u n gId = do
+  let approve = "/approve " <> show gId <> ":" <> n <> " 1"
   su #> ("@SimpleX-Directory " <> approve)
   su <# ("SimpleX-Directory> > " <> approve)
   su <## "      Group approved!"
-  u <# ("SimpleX-Directory> The group ID 1 (" <> n <> ") is approved and listed in directory!")
+  u <# ("SimpleX-Directory> The group ID " <> show gId <> " (" <> n <> ") is approved and listed in directory!")
   u <## "Please note: if you change the group profile it will be hidden from directory until it is re-approved."
 
 connectVia :: TestCC -> String -> IO ()
@@ -441,11 +580,11 @@ removeMember gName admin removed = do
   removed <## ("use /d " <> gn <> " to delete the group")
 
 groupFound :: TestCC -> String -> IO ()
-groupFound u s = do
-  u #> ("@SimpleX-Directory " <> s)
-  u <# ("SimpleX-Directory> > " <> s)
+groupFound u name = do
+  u #> ("@SimpleX-Directory " <> name)
+  u <# ("SimpleX-Directory> > " <> name)
   u <## "      Found 1 group(s)"
-  u <#. "SimpleX-Directory> privacy ("
+  u <#. ("SimpleX-Directory> " <> name <> " (")
   u <## "Welcome message:"
   u <##. "Link to join the group privacy: "
 

From 8f723281369dcfdf0296d088fdca86617f28544f Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Fri, 4 Aug 2023 09:23:16 +0100
Subject: [PATCH 3/5] directory: delist/relist groups when service or owner
 roles change (#2844)

* directory: delist/relist groups when service or owner roles change

* test role changes

* correction

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

* directory: suspend and resume group listing (#2848)

* directory: suspend and resume group listing

* correction

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
---
 .../src/Directory/Events.hs                   |  18 +-
 .../src/Directory/Service.hs                  | 266 +++++++++++++-----
 .../src/Directory/Store.hs                    |  24 +-
 tests/Bots/DirectoryTests.hs                  | 139 ++++++++-
 4 files changed, 361 insertions(+), 86 deletions(-)

diff --git a/apps/simplex-directory-service/src/Directory/Events.hs b/apps/simplex-directory-service/src/Directory/Events.hs
index 95216dffcf..4bde16e345 100644
--- a/apps/simplex-directory-service/src/Directory/Events.hs
+++ b/apps/simplex-directory-service/src/Directory/Events.hs
@@ -26,9 +26,9 @@ import Data.Either (fromRight)
 data DirectoryEvent
   = DEContactConnected Contact
   | DEGroupInvitation {contact :: Contact, groupInfo :: GroupInfo, fromMemberRole :: GroupMemberRole, memberRole :: GroupMemberRole}
-  | DEServiceJoinedGroup ContactId GroupInfo
+  | DEServiceJoinedGroup {contactId :: ContactId, groupInfo ::  GroupInfo, hostMember :: GroupMember}
   | DEGroupUpdated {contactId :: ContactId, fromGroup :: GroupInfo, toGroup :: GroupInfo}
-  | DEContactRoleChanged ContactId GroupInfo GroupMemberRole
+  | DEContactRoleChanged GroupInfo ContactId GroupMemberRole -- contactId here is the contact whose role changed
   | DEServiceRoleChanged GroupInfo GroupMemberRole
   | DEContactRemovedFromGroup ContactId GroupInfo
   | DEContactLeftGroup ContactId GroupInfo
@@ -38,15 +38,17 @@ data DirectoryEvent
   | DEItemEditIgnored Contact
   | DEItemDeleteIgnored Contact
   | DEContactCommand Contact ChatItemId ADirectoryCmd
+  deriving (Show)
 
 crDirectoryEvent :: ChatResponse -> Maybe DirectoryEvent
 crDirectoryEvent = \case
   CRContactConnected {contact} -> Just $ DEContactConnected contact
   CRReceivedGroupInvitation {contact, groupInfo, fromMemberRole, memberRole} -> Just $ DEGroupInvitation {contact, groupInfo, fromMemberRole, memberRole}
-  CRUserJoinedGroup {groupInfo, hostMember} -> (`DEServiceJoinedGroup` groupInfo) <$> memberContactId hostMember
+  CRUserJoinedGroup {groupInfo, hostMember} -> (\contactId -> DEServiceJoinedGroup {contactId, groupInfo, hostMember}) <$> memberContactId hostMember
   CRGroupUpdated {fromGroup, toGroup, member_} -> (\contactId -> DEGroupUpdated {contactId, fromGroup, toGroup}) <$> (memberContactId =<< member_)
-  CRMemberRole {groupInfo, member, toRole} -> (\ctId -> DEContactRoleChanged ctId groupInfo toRole) <$> memberContactId member
-  CRMemberRoleUser {groupInfo, toRole} -> Just $ DEServiceRoleChanged groupInfo toRole
+  CRMemberRole {groupInfo, member, toRole}
+    | groupMemberId' member == groupMemberId' (membership groupInfo) -> Just $ DEServiceRoleChanged groupInfo toRole
+    | otherwise -> (\ctId -> DEContactRoleChanged groupInfo ctId toRole) <$> memberContactId member
   CRDeletedMember {groupInfo, deletedMember} -> (`DEContactRemovedFromGroup` groupInfo) <$> memberContactId deletedMember
   CRLeftMember {groupInfo, member} -> (`DEContactLeftGroup` groupInfo) <$> memberContactId member
   CRDeletedMemberUser {groupInfo} -> Just $ DEServiceRemovedFromGroup groupInfo
@@ -68,6 +70,8 @@ data SDirectoryRole (r :: DirectoryRole) where
   SDRUser :: SDirectoryRole 'DRUser
   SDRSuperUser :: SDirectoryRole 'DRSuperUser
 
+deriving instance Show (SDirectoryRole r)
+
 data DirectoryCmdTag (r :: DirectoryRole) where
   DCHelp_ :: DirectoryCmdTag 'DRUser
   DCConfirmDuplicateGroup_ :: DirectoryCmdTag 'DRUser
@@ -97,8 +101,12 @@ data DirectoryCmd (r :: DirectoryRole) where
   DCUnknownCommand :: DirectoryCmd 'DRUser
   DCCommandError :: DirectoryCmdTag r -> DirectoryCmd r
 
+deriving instance Show (DirectoryCmd r)
+
 data ADirectoryCmd = forall r. ADC (SDirectoryRole r) (DirectoryCmd r)
 
+deriving instance Show (ADirectoryCmd)
+
 directoryCmdP :: Parser ADirectoryCmd
 directoryCmdP =
   (A.char '/' *> cmdStrP) <|> (ADC SDRUser . DCSearchGroup <$> A.takeText)
diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs
index 116440b91a..68d00268f2 100644
--- a/apps/simplex-directory-service/src/Directory/Service.hs
+++ b/apps/simplex-directory-service/src/Directory/Service.hs
@@ -34,7 +34,7 @@ import Simplex.Chat.Options
 import Simplex.Chat.Protocol (MsgContent (..))
 import Simplex.Chat.Types
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
+import Simplex.Messaging.Util (safeDecodeUtf8, tshow, ($>>=), (<$$>))
 import System.Directory (getAppUserDataDirectory)
 
 data GroupProfileUpdate = GPNoServiceLink | GPServiceLinkAdded | GPServiceLinkRemoved | GPHasServiceLink | GPServiceLinkError
@@ -42,7 +42,14 @@ data GroupProfileUpdate = GPNoServiceLink | GPServiceLinkAdded | GPServiceLinkRe
 data DuplicateGroup
   = DGUnique -- display name or full name is unique
   | DGRegistered -- the group with the same names is registered, additional confirmation is required
-  | DGListed -- the group with the same names is listed, the registration is not allowed
+  | DGReserved -- the group with the same names is listed, the registration is not allowed
+
+data GroupRolesStatus
+  = GRSOk
+  | GRSServiceNotAdmin
+  | GRSContactNotOwner
+  | GRSBadRoles
+  deriving (Eq)
 
 welcomeGetOpts :: IO DirectoryOpts
 welcomeGetOpts = do
@@ -60,9 +67,9 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
     forM_ (crDirectoryEvent resp) $ \case
       DEContactConnected ct -> deContactConnected ct
       DEGroupInvitation {contact = ct, groupInfo = g, fromMemberRole, memberRole} -> deGroupInvitation ct g fromMemberRole memberRole
-      DEServiceJoinedGroup ctId g -> deServiceJoinedGroup ctId g
+      DEServiceJoinedGroup ctId g owner -> deServiceJoinedGroup ctId g owner
       DEGroupUpdated {contactId, fromGroup, toGroup} -> deGroupUpdated contactId fromGroup toGroup
-      DEContactRoleChanged ctId g role -> deContactRoleChanged ctId g role
+      DEContactRoleChanged g ctId role -> deContactRoleChanged g ctId role
       DEServiceRoleChanged g role -> deServiceRoleChanged g role
       DEContactRemovedFromGroup ctId g -> deContactRemovedFromGroup ctId g
       DEContactLeftGroup ctId g -> deContactLeftGroup ctId g
@@ -83,9 +90,13 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
       atomically (getGroupReg st groupId) >>= \case
         Just gr -> action gr
         Nothing -> putStrLn $ T.unpack $ "Error: " <> err <> ", group: " <> localDisplayName <> ", can't find group registration ID " <> tshow groupId
-    setGroupInactive GroupReg {groupRegStatus, dbGroupId} grStatus = atomically $ do
+    setGroupStatus GroupReg {groupRegStatus, dbGroupId} grStatus = atomically $ do
       writeTVar groupRegStatus grStatus
-      unlistGroup st dbGroupId
+      case grStatus of
+        GRSActive -> listGroup st dbGroupId
+        GRSSuspended -> reserveGroup st dbGroupId
+        GRSSuspendedBadRoles -> reserveGroup st dbGroupId
+        _ -> unlistGroup st dbGroupId
 
     groupInfoText GroupProfile {displayName = n, fullName = fn, description = d} =
       n <> (if n == fn || T.null fn then "" else " (" <> fn <> ")") <> maybe "" ("\nWelcome message:\n" <>) d
@@ -112,9 +123,9 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
           if null gs
             then pure DGUnique
             else do
-              lgs <- readTVarIO $ listedGroups st
-              let listed = any (\GroupInfo {groupId = gId} -> gId `S.member` lgs) gs
-              pure $ if listed then DGListed else DGRegistered
+              (lgs, rgs) <- atomically $ (,) <$> readTVar (listedGroups st) <*> readTVar (reservedGroups st)
+              let reserved = any (\GroupInfo {groupId = gId} -> gId `S.member` lgs || gId `S.member` rgs) gs
+              pure $ if reserved then DGReserved else DGRegistered
 
     processInvitation :: Contact -> GroupInfo -> IO ()
     processInvitation ct g@GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = do
@@ -134,33 +145,58 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
 
     deGroupInvitation :: Contact -> GroupInfo -> GroupMemberRole -> GroupMemberRole -> IO ()
     deGroupInvitation ct g@GroupInfo {groupId, groupProfile = GroupProfile {displayName, fullName}} fromMemberRole memberRole = do
-      case badInvitation fromMemberRole memberRole of
+      case badRolesMsg $ groupRolesStatus fromMemberRole memberRole of
         Just msg -> sendMessage cc ct msg
         Nothing -> getDuplicateGroup g >>= \case
           Just DGUnique -> processInvitation ct g
           Just DGRegistered -> askConfirmation
-          Just DGListed -> sendMessage cc ct $ groupAlreadyListed g
-          Nothing -> sendMessage cc ct $ "Unexpected error, please notify the developers."
+          Just DGReserved -> sendMessage cc ct $ groupAlreadyListed g
+          Nothing -> sendMessage cc ct "Error: getDuplicateGroup. Please notify the developers."
       where
-        badInvitation contactRole serviceRole = case (contactRole, serviceRole) of
-          (GROwner, GRAdmin) -> Nothing
-          (_, GRAdmin) -> Just "You must have a group *owner* role to register the group"
-          (GROwner, _) -> Just "You must grant directory service *admin* role to register the group"
-          _ -> Just "You must have a group *owner* role and you must grant directory service *admin* role to register the group"
         askConfirmation = do
           atomically $ addGroupReg st ct g GRSPendingConfirmation
           sendMessage cc ct $ T.unpack $ "The group " <> displayName <> " (" <> fullName <> ") is already submitted to the directory.\nTo confirm the registration, please send:"
           sendMessage cc ct $ "/confirm " <> show groupId <> ":" <> T.unpack displayName
 
-    deServiceJoinedGroup :: ContactId -> GroupInfo -> IO ()
-    deServiceJoinedGroup ctId g =
+    badRolesMsg :: GroupRolesStatus -> Maybe String
+    badRolesMsg = \case
+      GRSOk -> Nothing
+      GRSServiceNotAdmin -> Just "You must have a group *owner* role to register the group" 
+      GRSContactNotOwner -> Just "You must grant directory service *admin* role to register the group"
+      GRSBadRoles -> Just "You must have a group *owner* role and you must grant directory service *admin* role to register the group"
+
+    getGroupRolesStatus :: GroupInfo -> GroupReg -> IO (Maybe GroupRolesStatus)
+    getGroupRolesStatus GroupInfo {membership = GroupMember {memberRole = serviceRole}} gr =
+      rStatus <$$> getGroupMember gr
+      where
+        rStatus GroupMember {memberRole} = groupRolesStatus memberRole serviceRole
+
+    groupRolesStatus :: GroupMemberRole -> GroupMemberRole -> GroupRolesStatus
+    groupRolesStatus contactRole serviceRole = case (contactRole, serviceRole) of
+      (GROwner, GRAdmin) -> GRSOk
+      (_, GRAdmin) -> GRSServiceNotAdmin
+      (GROwner, _) -> GRSContactNotOwner
+      _ -> GRSBadRoles
+
+    getGroupMember :: GroupReg -> IO (Maybe GroupMember)
+    getGroupMember GroupReg {dbGroupId, dbOwnerMemberId} =
+      readTVarIO dbOwnerMemberId
+        $>>= \mId -> resp <$> sendChatCmd cc (APIGroupMemberInfo dbGroupId mId)
+      where
+        resp = \case
+          CRGroupMemberInfo {member} -> Just member
+          _ -> Nothing
+
+    deServiceJoinedGroup :: ContactId -> GroupInfo -> GroupMember -> IO ()
+    deServiceJoinedGroup ctId g owner =
       withGroupReg g "joined group" $ \gr ->
         when (ctId `isOwner` gr) $ do
+          atomically $ writeTVar (dbOwnerMemberId gr) (Just $ groupMemberId' owner)
           let GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = g
           notifyOwner gr $ T.unpack $ "Joined the group " <> displayName <> ", creating the link…"
           sendChatCmd cc (APICreateGroupLink groupId GRMember) >>= \case
             CRGroupLinkCreated {connReqContact} -> do
-              setGroupInactive gr GRSPendingUpdate
+              setGroupStatus gr GRSPendingUpdate
               notifyOwner gr
                 "Created the public link to join the group via this directory service that is always online.\n\n\
                 \Please add it to the group welcome message.\n\
@@ -196,11 +232,12 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
             GRSPendingApproval n -> processProfileChange gr $ n + 1
             GRSActive -> processProfileChange gr 1
             GRSSuspended -> processProfileChange gr 1
+            GRSSuspendedBadRoles -> processProfileChange gr 1
             GRSRemoved -> pure ()
       where
         isInfix l d_ = l `T.isInfixOf` fromMaybe "" d_
         GroupInfo {groupId, groupProfile = p} = fromGroup
-        GroupInfo {groupProfile = p'@GroupProfile {displayName = displayName', image = image'}} = toGroup
+        GroupInfo {groupProfile = p'} = toGroup
         groupRef = groupReference toGroup
         sameProfile
           GroupProfile {displayName = n, fullName = fn, image = i, description = d}
@@ -208,31 +245,31 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
             n == n' && fn == fn' && i == i' && d == d'
         groupLinkAdded gr = do
           getDuplicateGroup toGroup >>= \case
-            Nothing -> notifyOwner gr "Unexpected error, please notify the developers."
-            Just DGListed -> notifyOwner gr $ groupAlreadyListed toGroup
+            Nothing -> notifyOwner gr "Error: getDuplicateGroup. Please notify the developers."
+            Just DGReserved -> notifyOwner gr $ groupAlreadyListed toGroup
             _ -> do
               notifyOwner gr $ "Thank you! The group link for " <> groupRef <> " is added to the welcome message.\nYou will be notified once the group is added to the directory - it may take up to 24 hours."
               let gaId = 1
-              setGroupInactive gr $ GRSPendingApproval gaId
-              sendForApproval gr gaId
+              setGroupStatus gr $ GRSPendingApproval gaId
+              checkRolesSendToApprove gr gaId
         processProfileChange gr n' = groupProfileUpdate >>= \case
           GPNoServiceLink -> do
-            setGroupInactive gr GRSPendingUpdate
+            setGroupStatus gr GRSPendingUpdate
             notifyOwner gr $ "The group profile is updated " <> groupRef <> ", but no link is added to the welcome message.\n\nThe group will remain hidden from the directory until the group link is added and the group is re-approved."
           GPServiceLinkRemoved -> do
-            setGroupInactive gr GRSPendingUpdate
+            setGroupStatus gr GRSPendingUpdate
             notifyOwner gr $ "The group link for " <> groupRef <> " is removed from the welcome message.\n\nThe group is hidden from the directory until the group link is added and the group is re-approved."
             notifySuperUsers $ "The group link is removed from " <> groupRef <> ", de-listed."
           GPServiceLinkAdded -> do
-            setGroupInactive gr $ GRSPendingApproval n'
+            setGroupStatus gr $ GRSPendingApproval n'
             notifyOwner gr $ "The group link is added to " <> groupRef <> "!\nIt is hidden from the directory until approved."
             notifySuperUsers $ "The group link is added to " <> groupRef <> "."
-            sendForApproval gr n'
+            checkRolesSendToApprove gr n'
           GPHasServiceLink -> do
-            setGroupInactive gr $ GRSPendingApproval n'
+            setGroupStatus gr $ GRSPendingApproval n'
             notifyOwner gr $ "The group " <> groupRef <> " is updated!\nIt is hidden from the directory until approved."
             notifySuperUsers $ "The group " <> groupRef <> " is updated."
-            sendForApproval gr n'
+            checkRolesSendToApprove gr n'
           GPServiceLinkError -> putStrLn $ "Error: no group link for " <> groupRef <> " pending approval."
         groupProfileUpdate = profileUpdate <$> sendChatCmd cc (APIGetGroupLink groupId)
           where
@@ -247,45 +284,97 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
                       | hasLinkNow -> GPServiceLinkAdded
                       | otherwise -> GPNoServiceLink
               _ -> GPServiceLinkError
-        sendForApproval GroupReg {dbGroupId, dbContactId} gaId = do
-          ct_ <-  getContact cc dbContactId
-          let text = maybe ("The group ID " <> tshow dbGroupId <> " submitted: ") (\c -> localDisplayName' c <> " submitted the group ID " <> tshow dbGroupId <> ": ") ct_
-                      <> groupInfoText p' <> "\n\nTo approve send:"
-              msg = maybe (MCText text) (\image -> MCImage {text, image}) image'
-          withSuperUsers $ \cId -> do
-            sendComposedMessage' cc cId Nothing msg
-            sendMessage' cc cId $ "/approve " <> show dbGroupId <> ":" <> T.unpack displayName' <> " " <> show gaId
+        checkRolesSendToApprove gr gaId = do
+          (badRolesMsg <$$> getGroupRolesStatus toGroup gr) >>= \case
+            Nothing -> notifyOwner gr "Error: getGroupRolesStatus. Please notify the developers."
+            Just (Just msg) -> notifyOwner gr msg
+            Just Nothing -> sendToApprove toGroup gr gaId
 
-    deContactRoleChanged :: ContactId -> GroupInfo -> GroupMemberRole -> IO ()
-    deContactRoleChanged ctId g role = undefined
+    sendToApprove :: GroupInfo -> GroupReg -> GroupApprovalId -> IO ()
+    sendToApprove GroupInfo {groupProfile = p@GroupProfile {displayName, image = image'}} GroupReg {dbGroupId, dbContactId} gaId = do
+      ct_ <-  getContact cc dbContactId
+      let text = maybe ("The group ID " <> tshow dbGroupId <> " submitted: ") (\c -> localDisplayName' c <> " submitted the group ID " <> tshow dbGroupId <> ": ") ct_
+                  <> groupInfoText p <> "\n\nTo approve send:"
+          msg = maybe (MCText text) (\image -> MCImage {text, image}) image'
+      withSuperUsers $ \cId -> do
+        sendComposedMessage' cc cId Nothing msg
+        sendMessage' cc cId $ "/approve " <> show dbGroupId <> ":" <> T.unpack displayName <> " " <> show gaId
+
+    deContactRoleChanged :: GroupInfo -> ContactId -> GroupMemberRole -> IO ()
+    deContactRoleChanged g@GroupInfo {membership = GroupMember {memberRole = serviceRole}} ctId contactRole =
+      withGroupReg g "contact role changed" $ \gr ->
+        when (ctId `isOwner` gr) $ do
+          readTVarIO (groupRegStatus gr) >>= \case
+            GRSSuspendedBadRoles -> when (rStatus == GRSOk) $ do
+              setGroupStatus gr GRSActive
+              notifyOwner gr $ uCtRole <> ".\n\nThe group is listed in the directory again."
+              notifySuperUsers $ "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 gr GRSSuspendedBadRoles
+              notifyOwner gr $ uCtRole <> ".\n\nThe group is no longer listed in the directory."
+              notifySuperUsers $ "The group " <> groupRef <> " is de-listed " <> suCtRole
+            _ -> pure ()
+      where
+        rStatus = groupRolesStatus contactRole serviceRole
+        groupRef = groupReference g
+        ctRole = "*" <> B.unpack (strEncode contactRole) <> "*"
+        uCtRole = "Your role in the group " <> groupRef <> " is changed to " <> ctRole
+        suCtRole = "(user role is set to " <> ctRole <> ")."
 
     deServiceRoleChanged :: GroupInfo -> GroupMemberRole -> IO ()
-    deServiceRoleChanged g role = undefined
+    deServiceRoleChanged g serviceRole = do
+      withGroupReg g "service role changed" $ \gr -> do
+        readTVarIO (groupRegStatus gr) >>= \case
+          GRSSuspendedBadRoles -> when (serviceRole == GRAdmin) $
+            whenContactIsOwner gr $ do
+              setGroupStatus gr GRSActive
+              notifyOwner gr $ uSrvRole <> ".\n\nThe group is listed in the directory again."
+              notifySuperUsers $ "The group " <> groupRef <> " is listed " <> suSrvRole
+          GRSPendingApproval gaId -> when (serviceRole == GRAdmin) $
+            whenContactIsOwner gr $ do
+              sendToApprove g gr gaId
+              notifyOwner gr $ uSrvRole <> ".\n\nThe group is submitted for approval."
+          GRSActive -> when (serviceRole /= GRAdmin) $ do
+            setGroupStatus gr GRSSuspendedBadRoles
+            notifyOwner gr $ uSrvRole <> ".\n\nThe group is no longer listed in the directory."
+            notifySuperUsers $ "The group " <> groupRef <> " is de-listed " <> suSrvRole
+          _ -> pure ()
+      where
+        groupRef = groupReference g
+        srvRole = "*" <> B.unpack (strEncode serviceRole) <> "*"
+        uSrvRole = serviceName <> " role in the group " <> groupRef <> " is changed to " <> srvRole
+        suSrvRole = "(" <> serviceName <> " role is changed to " <> srvRole <> ")."
+        whenContactIsOwner gr action = 
+          getGroupMember gr >>=
+            mapM_ (\cm@GroupMember {memberRole} -> when (memberRole == GROwner && memberActive cm) action)
 
     deContactRemovedFromGroup :: ContactId -> GroupInfo -> IO ()
     deContactRemovedFromGroup ctId g =
       withGroupReg g "contact removed" $ \gr -> do
         when (ctId `isOwner` gr) $ do
-          setGroupInactive gr GRSRemoved
+          setGroupStatus gr GRSRemoved
           let groupRef = groupReference g
-          notifyOwner gr $ "You are removed from the group " <> groupRef <> ".\n\nGroup is no longer listed in the directory."
+          notifyOwner gr $ "You are removed from the group " <> groupRef <> ".\n\nThe group is no longer listed in the directory."
           notifySuperUsers $ "The group " <> groupRef <> " is de-listed (group owner is removed)."
 
     deContactLeftGroup :: ContactId -> GroupInfo -> IO ()
     deContactLeftGroup ctId g =
       withGroupReg g "contact left" $ \gr -> do
         when (ctId `isOwner` gr) $ do
-          setGroupInactive gr GRSRemoved
+          setGroupStatus gr GRSRemoved
           let groupRef = groupReference g
-          notifyOwner gr $ "You left the group " <> groupRef <> ".\n\nGroup is no longer listed in the directory."
+          notifyOwner gr $ "You left the group " <> groupRef <> ".\n\nThe group is no longer listed in the directory."
           notifySuperUsers $ "The group " <> groupRef <> " is de-listed (group owner left)."
 
     deServiceRemovedFromGroup :: GroupInfo -> IO ()
     deServiceRemovedFromGroup g =
       withGroupReg g "service removed" $ \gr -> do
-        setGroupInactive gr GRSRemoved
+        setGroupStatus gr GRSRemoved
         let groupRef = groupReference g
-        notifyOwner gr $ serviceName <> " is removed from the group " <> groupRef <> ".\n\nGroup is no longer listed in the directory."
+        notifyOwner gr $ serviceName <> " is removed from the group " <> groupRef <> ".\n\nThe group is no longer listed in the directory."
         notifySuperUsers $ "The group " <> groupRef <> " is de-listed (directory service is removed)."
 
     deUserCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRUser -> IO ()
@@ -309,7 +398,7 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
                   let text = groupInfoText p
                       msg = maybe (MCText text) (\image -> MCImage {text, image}) image_
                   sendComposedMessage cc ct Nothing msg
-          Nothing -> sendReply "Unexpected error, please notify the developers."
+          Nothing -> sendReply "Error: getGroups. Please notify the developers."
       DCConfirmDuplicateGroup ugrId gName ->
         atomically (getGroupReg st ugrId) >>= \case
           Nothing -> sendReply $ "Group ID " <> show ugrId <> " not found"
@@ -321,8 +410,8 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
                   readTVarIO groupRegStatus >>= \case
                     GRSPendingConfirmation -> do
                       getDuplicateGroup g >>= \case
-                        Nothing -> sendMessage cc ct $ "Unexpected error, please notify the developers."
-                        Just DGListed -> sendMessage cc ct $ groupAlreadyListed g
+                        Nothing -> sendMessage cc ct "Error: getDuplicateGroup. Please notify the developers."
+                        Just DGReserved -> sendMessage cc ct $ groupAlreadyListed g
                         _ -> processInvitation ct g
                     _ -> sendReply $ "Error: the group ID " <> show ugrId <> " (" <> T.unpack displayName <> ") is not pending confirmation."
                 | otherwise -> sendReply $ "Group ID " <> show ugrId <> " has the display name " <> T.unpack displayName
@@ -336,34 +425,56 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
     deSuperUserCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRSuperUser -> IO ()
     deSuperUserCommand ct ciId cmd
       | superUser `elem` superUsers = case cmd of
-        DCApproveGroup {groupId, displayName = n, groupApprovalId} ->
-          atomically (getGroupReg st groupId) >>= \case
-            Nothing -> sendReply $ "Group ID " <> show groupId <> " not found"
-            Just GroupReg {dbContactId, groupRegStatus} -> do
-              readTVarIO groupRegStatus >>= \case
+        DCApproveGroup {groupId, displayName = n, groupApprovalId} -> do
+          getGroupAndReg groupId n >>= \case
+            Nothing -> sendReply $ "The group " <> groupRef <> " not found (getGroupAndReg)."
+            Just (g, gr) ->
+              readTVarIO (groupRegStatus gr) >>= \case
                 GRSPendingApproval gaId
-                  | gaId == groupApprovalId -> do
-                    getGroup cc groupId >>= \case
-                      Just g@GroupInfo {groupProfile = GroupProfile {displayName = n'}}
-                        | n == n' ->
-                          getDuplicateGroup g >>= \case
-                            Nothing -> sendReply $ "Unexpected error, please notify the developers."
-                            Just DGListed -> sendReply $ "The group " <> groupRef <> " is already listed in the directory."
-                            _ -> do
-                              atomically $ do
-                                writeTVar groupRegStatus GRSActive
-                                listGroup st groupId
-                              sendReply "Group approved!"
-                              sendMessage' cc dbContactId $ "The group " <> groupRef <> " is approved and listed in directory!\nPlease note: if you change the group profile it will be hidden from directory until it is re-approved."
-                        | otherwise -> sendReply "Incorrect group name"
-                      Nothing -> pure ()
+                  | gaId == groupApprovalId ->  do
+                    getDuplicateGroup g >>= \case
+                      Nothing -> sendReply "Error: getDuplicateGroup. Please notify the developers."
+                      Just DGReserved -> sendReply $ "The group " <> groupRef <> " is already listed in the directory."
+                      _ -> do
+                        getGroupRolesStatus g gr >>= \case
+                          Just GRSOk -> do
+                            setGroupStatus gr GRSActive
+                            sendReply "Group approved!"
+                            notifyOwner gr $ "The group " <> groupRef <> " is approved and listed in directory!\nPlease note: if you change the group profile it will be hidden from directory until it is re-approved."
+                          Just GRSServiceNotAdmin -> replyNotApproved serviceNotAdmin
+                          Just GRSContactNotOwner -> replyNotApproved "user is not an owner."
+                          Just GRSBadRoles -> replyNotApproved $ "user is not an owner, " <> serviceNotAdmin
+                          Nothing -> sendReply "Error: getGroupRolesStatus. Please notify the developers."
+                        where
+                          replyNotApproved reason = sendReply $ "Group is not approved: " <> reason
+                          serviceNotAdmin = serviceName <> " is not an admin."
                   | otherwise -> sendReply "Incorrect approval code"
                 _ -> sendReply $ "Error: the group " <> groupRef <> " is not pending approval."
           where
             groupRef = "ID " <> show groupId <> " (" <> T.unpack n <> ")"
         DCRejectGroup _gaId _gName -> pure ()
-        DCSuspendGroup _gId _gName -> pure ()
-        DCResumeGroup _gId _gName -> pure ()
+        DCSuspendGroup groupId gName -> do
+          let groupRef = "ID " <> show groupId <> " (" <> T.unpack gName <> ")"
+          getGroupAndReg groupId gName >>= \case
+            Nothing -> sendReply $ "The group " <> groupRef <> " not found (getGroupAndReg)."
+            Just (_, gr) ->
+              readTVarIO (groupRegStatus gr) >>= \case
+                GRSActive -> do
+                  setGroupStatus gr GRSSuspended
+                  notifyOwner gr $ "The group " <> groupRef <> " is suspended and hidden from directory. Please contact the administrators."
+                  sendReply "Group suspended!"
+                _ -> sendReply $ "The group " <> groupRef <> " is not active, can't be suspended."
+        DCResumeGroup groupId gName -> do
+          let groupRef = "ID " <> show groupId <> " (" <> T.unpack gName <> ")"
+          getGroupAndReg groupId gName >>= \case
+            Nothing -> sendReply $ "The group " <> groupRef <> " not found (getGroupAndReg)."
+            Just (_, gr) ->
+              readTVarIO (groupRegStatus gr) >>= \case
+                GRSSuspended -> do
+                  setGroupStatus gr GRSActive
+                  notifyOwner gr $ "The group " <> groupRef <> " is listed in the directory again!"
+                  sendReply "Group listing resumed!"
+                _ -> sendReply $ "The group " <> groupRef <> " is not suspended, can't be resumed."
         DCListGroups -> pure ()
         DCCommandError tag -> sendReply $ "Command error: " <> show tag
       | otherwise = sendReply "You are not allowed to use this command"
@@ -371,6 +482,15 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
         superUser = KnownContact {contactId = contactId' ct, localDisplayName = localDisplayName' ct}
         sendReply = sendComposedMessage cc ct (Just ciId) . textMsgContent
 
+    getGroupAndReg :: GroupId -> GroupName -> IO (Maybe (GroupInfo, GroupReg))
+    getGroupAndReg gId gName =
+      getGroup cc gId
+        $>>= \g@GroupInfo {groupProfile = GroupProfile {displayName}} ->
+          if displayName == gName
+            then atomically (getGroupReg st gId)
+                  $>>= \gr -> pure $ Just (g, gr)
+            else pure Nothing
+
 getContact :: ChatController -> ContactId -> IO (Maybe Contact)
 getContact cc ctId = resp <$> sendChatCmd cc (APIGetChat (ChatRef CTDirect ctId) (CPLast 0) Nothing)
   where
diff --git a/apps/simplex-directory-service/src/Directory/Store.hs b/apps/simplex-directory-service/src/Directory/Store.hs
index b4508d6b92..d5d00b53b5 100644
--- a/apps/simplex-directory-service/src/Directory/Store.hs
+++ b/apps/simplex-directory-service/src/Directory/Store.hs
@@ -12,13 +12,15 @@ import qualified Data.Set as S
 
 data DirectoryStore = DirectoryStore
   { groupRegs :: TVar [GroupReg],
-    listedGroups :: TVar (Set GroupId)
+    listedGroups :: TVar (Set GroupId),
+    reservedGroups :: TVar (Set GroupId)
   }
 
 data GroupReg = GroupReg
   { userGroupRegId :: UserGroupRegId,
     dbGroupId :: GroupId,
     dbContactId :: ContactId,
+    dbOwnerMemberId :: TVar (Maybe GroupMemberId),
     groupRegStatus :: TVar GroupRegStatus
   }
 
@@ -35,12 +37,14 @@ data GroupRegStatus
   | GRSPendingApproval GroupApprovalId
   | GRSActive
   | GRSSuspended
+  | GRSSuspendedBadRoles
   | GRSRemoved
 
 addGroupReg :: DirectoryStore -> Contact -> GroupInfo -> GroupRegStatus -> STM ()
 addGroupReg st ct GroupInfo {groupId} grStatus = do
+  dbOwnerMemberId <- newTVar Nothing
   groupRegStatus <- newTVar grStatus
-  let gr = GroupReg {userGroupRegId = groupId, dbGroupId = groupId, dbContactId = contactId' ct, groupRegStatus}
+  let gr = GroupReg {userGroupRegId = groupId, dbGroupId = groupId, dbContactId = contactId' ct, dbOwnerMemberId, groupRegStatus}
   modifyTVar' (groupRegs st) (gr :)
 
 getGroupReg :: DirectoryStore -> GroupRegId -> STM (Maybe GroupReg)
@@ -58,10 +62,19 @@ filterListedGroups st gs = do
   pure $ filter (\GroupInfo {groupId} -> groupId `S.member` lgs) gs
 
 listGroup :: DirectoryStore -> GroupId -> STM ()
-listGroup st gId = modifyTVar' (listedGroups st) $ S.insert gId
+listGroup st gId = do
+  modifyTVar' (listedGroups st) $ S.insert gId
+  modifyTVar' (reservedGroups st) $ S.delete gId
+
+reserveGroup :: DirectoryStore -> GroupId -> STM ()
+reserveGroup st gId = do
+  modifyTVar' (listedGroups st) $ S.delete gId
+  modifyTVar' (reservedGroups st) $ S.insert gId
 
 unlistGroup :: DirectoryStore -> GroupId -> STM ()
-unlistGroup st gId = modifyTVar' (listedGroups st) $ S.delete gId
+unlistGroup st gId = do
+  modifyTVar' (listedGroups st) $ S.delete gId
+  modifyTVar' (reservedGroups st) $ S.delete gId
 
 data DirectoryLogRecord
   = CreateGroupReg GroupReg
@@ -81,7 +94,8 @@ newDirectoryStore :: STM DirectoryStore
 newDirectoryStore = do
   groupRegs <- newTVar []
   listedGroups <- newTVar mempty
-  pure DirectoryStore {groupRegs, listedGroups}
+  reservedGroups <- newTVar mempty
+  pure DirectoryStore {groupRegs, listedGroups, reservedGroups}
 
 readDirectoryState :: FilePath -> IO [GroupReg]
 readDirectoryState _ = pure []
diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs
index d1c34e7ada..1712efbd66 100644
--- a/tests/Bots/DirectoryTests.hs
+++ b/tests/Bots/DirectoryTests.hs
@@ -22,12 +22,17 @@ import Test.Hspec
 directoryServiceTests :: SpecWith FilePath
 directoryServiceTests = do
   it "should register group" testDirectoryService
+  it "should suspend and resume group" testSuspendResume
   describe "de-listing the group" $ do
     it "should de-list if owner leaves the group" testDelistedOwnerLeaves
     it "should de-list if owner is removed from the group" testDelistedOwnerRemoved
     it "should NOT de-list if another member leaves the group" testNotDelistedMemberLeaves
     it "should NOT de-list if another member is removed from the group" testNotDelistedMemberRemoved
     it "should de-list if service is removed from the group" testDelistedServiceRemoved
+    it "should de-list/re-list when service/owner roles change" testDelistedRoleChanges
+    it "should NOT de-list if another member role changes" testNotDelistedMemberRoleChanged
+    it "should NOT send to approval if roles are incorrect" testNotSentApprovalBadRoles
+    it "should NOT allow approving if roles are incorrect" testNotApprovedBadRoles
   describe "should require re-approval if profile is changed by" $ do
     it "the registration owner" testRegOwnerChangedProfile
     it "another owner" testAnotherOwnerChangedProfile
@@ -146,6 +151,24 @@ testDirectoryService tmp =
       su <## "To approve send:"
       su <# ("SimpleX-Directory> /approve 1:PSA " <> show grId)
 
+testSuspendResume :: HasCallStack => FilePath -> IO ()
+testSuspendResume tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+      bob `connectVia` dsLink
+      registerGroup superUser bob "privacy" "Privacy"
+      groupFound bob "privacy"
+      superUser #> "@SimpleX-Directory /suspend 1:privacy"
+      superUser <# "SimpleX-Directory> > /suspend 1:privacy"
+      superUser <## "      Group suspended!"
+      bob <# "SimpleX-Directory> The group ID 1 (privacy) is suspended and hidden from directory. Please contact the administrators."
+      groupNotFound bob "privacy"
+      superUser #> "@SimpleX-Directory /resume 1:privacy"
+      superUser <# "SimpleX-Directory> > /resume 1:privacy"
+      superUser <## "      Group listing resumed!"
+      bob <# "SimpleX-Directory> The group ID 1 (privacy) is listed in the directory again!"
+      groupFound bob "privacy"
+
 testDelistedOwnerLeaves :: HasCallStack => FilePath -> IO ()
 testDelistedOwnerLeaves tmp =
   withDirectoryService tmp $ \superUser dsLink ->
@@ -158,7 +181,7 @@ testDelistedOwnerLeaves tmp =
         cath <## "#privacy: bob left the group"
         bob <# "SimpleX-Directory> You left the group ID 1 (privacy)."
         bob <## ""
-        bob <## "Group is no longer listed in the directory."
+        bob <## "The group is no longer listed in the directory."
         superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (group owner left)."
         groupNotFound cath "privacy"
 
@@ -173,7 +196,7 @@ testDelistedOwnerRemoved tmp =
         removeMember "privacy" cath bob
         bob <# "SimpleX-Directory> You are removed from the group ID 1 (privacy)."
         bob <## ""
-        bob <## "Group is no longer listed in the directory."
+        bob <## "The group is no longer listed in the directory."
         superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (group owner is removed)."
         groupNotFound cath "privacy"
 
@@ -215,10 +238,120 @@ testDelistedServiceRemoved tmp =
         cath <## "#privacy: bob removed SimpleX-Directory from the group"
         bob <# "SimpleX-Directory> SimpleX-Directory is removed from the group ID 1 (privacy)."
         bob <## ""
-        bob <## "Group is no longer listed in the directory."
+        bob <## "The group is no longer listed in the directory."
         superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (directory service is removed)."
         groupNotFound cath "privacy"
 
+testDelistedRoleChanges :: HasCallStack => FilePath -> IO ()
+testDelistedRoleChanges tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        registerGroup superUser bob "privacy" "Privacy"
+        addCathAsOwner bob cath
+        groupFound cath "privacy"
+        -- de-listed if service role changed
+        bob ##> "/mr privacy SimpleX-Directory member"
+        bob <## "#privacy: you changed the role of SimpleX-Directory from admin to member"
+        cath <## "#privacy: bob changed the role of SimpleX-Directory from admin to member"
+        bob <# "SimpleX-Directory> SimpleX-Directory role in the group ID 1 (privacy) is changed to member."
+        bob <## ""
+        bob <## "The group is no longer listed in the directory."
+        superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (SimpleX-Directory role is changed to member)."
+        groupNotFound cath "privacy"
+        -- re-listed if service role changed back without profile changes
+        cath ##> "/mr privacy SimpleX-Directory admin"
+        cath <## "#privacy: you changed the role of SimpleX-Directory from member to admin"
+        bob <## "#privacy: cath changed the role of SimpleX-Directory from member to admin"
+        bob <# "SimpleX-Directory> SimpleX-Directory role in the group ID 1 (privacy) is changed to admin."
+        bob <## ""
+        bob <## "The group is listed in the directory again."
+        superUser <# "SimpleX-Directory> The group ID 1 (privacy) is listed (SimpleX-Directory role is changed to admin)."
+        groupFound cath "privacy"
+        -- de-listed if owner role changed
+        cath ##> "/mr privacy bob admin"
+        cath <## "#privacy: you changed the role of bob from owner to admin"
+        bob <## "#privacy: cath changed your role from owner to admin"
+        bob <# "SimpleX-Directory> Your role in the group ID 1 (privacy) is changed to admin."
+        bob <## ""
+        bob <## "The group is no longer listed in the directory."
+        superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (user role is set to admin)."
+        groupNotFound cath "privacy"
+        -- re-listed if owner role changed back without profile changes
+        cath ##> "/mr privacy bob owner"
+        cath <## "#privacy: you changed the role of bob from admin to owner"
+        bob <## "#privacy: cath changed your role from admin to owner"
+        bob <# "SimpleX-Directory> Your role in the group ID 1 (privacy) is changed to owner."
+        bob <## ""
+        bob <## "The group is listed in the directory again."
+        superUser <# "SimpleX-Directory> The group ID 1 (privacy) is listed (user role is set to owner)."
+        groupFound cath "privacy"
+
+testNotDelistedMemberRoleChanged :: HasCallStack => FilePath -> IO ()
+testNotDelistedMemberRoleChanged tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        registerGroup superUser bob "privacy" "Privacy"
+        addCathAsOwner bob cath
+        groupFound cath "privacy"
+        bob ##> "/mr privacy cath member"
+        bob <## "#privacy: you changed the role of cath from owner to member"
+        cath <## "#privacy: bob changed your role from owner to member"
+        groupFound cath "privacy"
+
+testNotSentApprovalBadRoles :: HasCallStack => FilePath -> IO ()
+testNotSentApprovalBadRoles tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        cath `connectVia` dsLink
+        submitGroup bob "privacy" "Privacy"
+        welcomeWithLink <- groupAccepted bob "privacy"
+        bob ##> "/mr privacy SimpleX-Directory member"
+        bob <## "#privacy: you changed the role of SimpleX-Directory from admin to member"
+        updateProfileWithLink bob "privacy" welcomeWithLink 1
+        bob <# "SimpleX-Directory> You must grant directory service admin role to register the group"
+        bob ##> "/mr privacy SimpleX-Directory admin"
+        bob <## "#privacy: you changed the role of SimpleX-Directory from member to admin"
+        bob <# "SimpleX-Directory> SimpleX-Directory role in the group ID 1 (privacy) is changed to admin."
+        bob <## ""
+        bob <## "The group is submitted for approval."
+        notifySuperUser superUser bob "privacy" "Privacy" welcomeWithLink 1
+        groupNotFound cath "privacy"
+        approveRegistration superUser bob "privacy" 1
+        groupFound cath "privacy"
+
+testNotApprovedBadRoles :: HasCallStack => FilePath -> IO ()
+testNotApprovedBadRoles tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        cath `connectVia` dsLink
+        submitGroup bob "privacy" "Privacy"
+        welcomeWithLink <- groupAccepted bob "privacy"
+        updateProfileWithLink bob "privacy" welcomeWithLink 1
+        notifySuperUser superUser bob "privacy" "Privacy" welcomeWithLink 1
+        bob ##> "/mr privacy SimpleX-Directory member"
+        bob <## "#privacy: you changed the role of SimpleX-Directory from admin to member"
+        let approve = "/approve 1:privacy 1"
+        superUser #> ("@SimpleX-Directory " <> approve)
+        superUser <# ("SimpleX-Directory> > " <> approve)
+        superUser <## "      Group is not approved: user is not an owner."
+        groupNotFound cath "privacy"
+        bob ##> "/mr privacy SimpleX-Directory admin"
+        bob <## "#privacy: you changed the role of SimpleX-Directory from member to admin"
+        bob <# "SimpleX-Directory> SimpleX-Directory role in the group ID 1 (privacy) is changed to admin."
+        bob <## ""
+        bob <## "The group is submitted for approval."
+        notifySuperUser superUser bob "privacy" "Privacy" welcomeWithLink 1
+        approveRegistration superUser bob "privacy" 1
+        groupFound cath "privacy"
+
 testRegOwnerChangedProfile :: HasCallStack => FilePath -> IO ()
 testRegOwnerChangedProfile tmp =
   withDirectoryService tmp $ \superUser dsLink ->

From 4826a62d364a0956380604922f03583706865fc0 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sun, 6 Aug 2023 11:56:40 +0100
Subject: [PATCH 4/5] directory: list groups with group member counts (#2855)

* directory: list groups with group member counts

* list groups, test

* superuser can list all groups

* rename command

* remove type synonym

* add member count to search results

* fix test
---
 .../src/Directory/Events.hs                   |  10 +-
 .../src/Directory/Service.hs                  | 161 ++++++++------
 .../src/Directory/Store.hs                    |  47 +++--
 src/Simplex/Chat.hs                           |  10 +-
 src/Simplex/Chat/Controller.hs                |   5 +-
 src/Simplex/Chat/Store/Groups.hs              |  26 +++
 src/Simplex/Chat/Types.hs                     |   8 +
 src/Simplex/Chat/View.hs                      |  18 +-
 tests/Bots/DirectoryTests.hs                  | 197 ++++++++++++++----
 tests/ChatTests/Direct.hs                     |   4 +-
 tests/ChatTests/Groups.hs                     |   8 +-
 tests/ChatTests/Profiles.hs                   |   2 +-
 tests/ChatTests/Utils.hs                      |   3 +-
 13 files changed, 357 insertions(+), 142 deletions(-)

diff --git a/apps/simplex-directory-service/src/Directory/Events.hs b/apps/simplex-directory-service/src/Directory/Events.hs
index 4bde16e345..bdf76e80d2 100644
--- a/apps/simplex-directory-service/src/Directory/Events.hs
+++ b/apps/simplex-directory-service/src/Directory/Events.hs
@@ -81,7 +81,7 @@ data DirectoryCmdTag (r :: DirectoryRole) where
   DCRejectGroup_ :: DirectoryCmdTag 'DRSuperUser
   DCSuspendGroup_ :: DirectoryCmdTag 'DRSuperUser
   DCResumeGroup_ :: DirectoryCmdTag 'DRSuperUser
-  DCListGroups_ :: DirectoryCmdTag 'DRSuperUser
+  DCListLastGroups_ :: DirectoryCmdTag 'DRSuperUser
 
 deriving instance Show (DirectoryCmdTag r)
 
@@ -97,7 +97,7 @@ data DirectoryCmd (r :: DirectoryRole) where
   DCRejectGroup :: GroupId -> GroupName -> DirectoryCmd 'DRSuperUser
   DCSuspendGroup :: GroupId -> GroupName -> DirectoryCmd 'DRSuperUser
   DCResumeGroup :: GroupId -> GroupName -> DirectoryCmd 'DRSuperUser
-  DCListGroups :: DirectoryCmd 'DRSuperUser
+  DCListLastGroups :: Int -> DirectoryCmd 'DRSuperUser
   DCUnknownCommand :: DirectoryCmd 'DRUser
   DCCommandError :: DirectoryCmdTag r -> DirectoryCmd r
 
@@ -105,7 +105,7 @@ deriving instance Show (DirectoryCmd r)
 
 data ADirectoryCmd = forall r. ADC (SDirectoryRole r) (DirectoryCmd r)
 
-deriving instance Show (ADirectoryCmd)
+deriving instance Show ADirectoryCmd
 
 directoryCmdP :: Parser ADirectoryCmd
 directoryCmdP =
@@ -124,7 +124,7 @@ directoryCmdP =
       "reject" -> su DCRejectGroup_
       "suspend" -> su DCSuspendGroup_
       "resume" -> su DCResumeGroup_
-      "all" -> su DCListGroups_
+      "last" -> su DCListLastGroups_
       _ -> fail "bad command tag"
       where
         u = pure . ADCT SDRUser
@@ -142,6 +142,6 @@ directoryCmdP =
       DCRejectGroup_ -> gc DCRejectGroup
       DCSuspendGroup_ -> gc DCSuspendGroup
       DCResumeGroup_ -> gc DCResumeGroup
-      DCListGroups_ -> pure DCListGroups
+      DCListLastGroups_ -> DCListLastGroups <$> (A.space *> A.decimal <|> pure 10)
       where
         gc f = f <$> (A.space *> A.decimal <* A.char ':') <*> A.takeTill (== ' ')
diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs
index 68d00268f2..6f3ac92fc8 100644
--- a/apps/simplex-directory-service/src/Directory/Service.hs
+++ b/apps/simplex-directory-service/src/Directory/Service.hs
@@ -17,7 +17,7 @@ import Control.Concurrent.Async
 import Control.Concurrent.STM
 import Control.Monad.Reader
 import qualified Data.ByteString.Char8 as B
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, maybeToList)
 import qualified Data.Set as S
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -100,12 +100,14 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
 
     groupInfoText GroupProfile {displayName = n, fullName = fn, description = d} =
       n <> (if n == fn || T.null fn then "" else " (" <> fn <> ")") <> maybe "" ("\nWelcome message:\n" <>) d
-    groupReference GroupInfo {groupId, groupProfile = GroupProfile {displayName}} =
-      "ID " <> show groupId <> " (" <> T.unpack displayName <> ")"
+    userGroupReference gr GroupInfo {groupProfile = GroupProfile {displayName}} = userGroupReference' gr displayName
+    userGroupReference' GroupReg {userGroupRegId} displayName = groupReference' userGroupRegId displayName
+    groupReference GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = groupReference' groupId displayName
+    groupReference' groupId displayName = "ID " <> show groupId <> " (" <> T.unpack displayName <> ")"
     groupAlreadyListed GroupInfo {groupProfile = GroupProfile {displayName, fullName}} =
       T.unpack $ "The group " <> displayName <> " (" <> fullName <> ") is already listed in the directory, please choose another name."
 
-    getGroups :: Text -> IO (Maybe [GroupInfo])
+    getGroups :: Text -> IO (Maybe [(GroupInfo, GroupSummary)])
     getGroups search =
       sendChatCmd cc (APIListGroups userId Nothing $ Just $ T.unpack search) >>= \case
         CRGroupsList {groups} -> pure $ Just groups
@@ -115,7 +117,7 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
     getDuplicateGroup GroupInfo {groupId, groupProfile = GroupProfile {displayName, fullName}} =
       getGroups fullName >>= mapM duplicateGroup
       where
-        sameGroup GroupInfo {groupId = gId, groupProfile = GroupProfile {displayName = n, fullName = fn}} =
+        sameGroup (GroupInfo {groupId = gId, groupProfile = GroupProfile {displayName = n, fullName = fn}}, _) =
           gId /= groupId && n == displayName && fn == fullName
         duplicateGroup [] = pure DGUnique
         duplicateGroup groups = do
@@ -124,12 +126,12 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
             then pure DGUnique
             else do
               (lgs, rgs) <- atomically $ (,) <$> readTVar (listedGroups st) <*> readTVar (reservedGroups st)
-              let reserved = any (\GroupInfo {groupId = gId} -> gId `S.member` lgs || gId `S.member` rgs) gs
+              let reserved = any (\(GroupInfo {groupId = gId}, _) -> gId `S.member` lgs || gId `S.member` rgs) gs
               pure $ if reserved then DGReserved else DGRegistered
 
     processInvitation :: Contact -> GroupInfo -> IO ()
     processInvitation ct g@GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = do
-      atomically $ addGroupReg st ct g GRSProposed
+      void $ atomically $ addGroupReg st ct g GRSProposed
       r <- sendChatCmd cc $ APIJoinGroup groupId
       sendMessage cc ct $ T.unpack $ case r of
         CRUserAcceptedGroupSent {} -> "Joining the group " <> displayName <> "…"
@@ -144,7 +146,7 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
         \For example, send _privacy_ to find groups about privacy."
 
     deGroupInvitation :: Contact -> GroupInfo -> GroupMemberRole -> GroupMemberRole -> IO ()
-    deGroupInvitation ct g@GroupInfo {groupId, groupProfile = GroupProfile {displayName, fullName}} fromMemberRole memberRole = do
+    deGroupInvitation ct g@GroupInfo {groupProfile = GroupProfile {displayName, fullName}} fromMemberRole memberRole = do
       case badRolesMsg $ groupRolesStatus fromMemberRole memberRole of
         Just msg -> sendMessage cc ct msg
         Nothing -> getDuplicateGroup g >>= \case
@@ -154,9 +156,9 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
           Nothing -> sendMessage cc ct "Error: getDuplicateGroup. Please notify the developers."
       where
         askConfirmation = do
-          atomically $ addGroupReg st ct g GRSPendingConfirmation
+          ugrId <- atomically $ addGroupReg st ct g GRSPendingConfirmation
           sendMessage cc ct $ T.unpack $ "The group " <> displayName <> " (" <> fullName <> ") is already submitted to the directory.\nTo confirm the registration, please send:"
-          sendMessage cc ct $ "/confirm " <> show groupId <> ":" <> T.unpack displayName
+          sendMessage cc ct $ "/confirm " <> show ugrId <> ":" <> T.unpack displayName
 
     badRolesMsg :: GroupRolesStatus -> Maybe String
     badRolesMsg = \case
@@ -215,20 +217,21 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
       unless (sameProfile p p') $ do
         atomically $ unlistGroup st groupId
         withGroupReg toGroup "group updated" $ \gr -> do
+          let userGroupRef = userGroupReference gr toGroup
           readTVarIO (groupRegStatus gr) >>= \case
             GRSPendingConfirmation -> pure ()
             GRSProposed -> pure ()
             GRSPendingUpdate -> groupProfileUpdate >>= \case
               GPNoServiceLink ->
-                when (ctId `isOwner` gr) $ notifyOwner gr $ "The profile updated for " <> groupRef <> ", but the group link is not added to the welcome message."
+                when (ctId `isOwner` gr) $ notifyOwner gr $ "The profile updated for " <> userGroupRef <> ", but the group link is not added to the welcome message."
               GPServiceLinkAdded
                 | ctId `isOwner` gr -> groupLinkAdded gr
                 | otherwise -> notifyOwner gr "The group link is added by another group member, your registration will not be processed.\n\nPlease update the group profile yourself."
-              GPServiceLinkRemoved -> when (ctId `isOwner` gr) $ notifyOwner gr $ "The group link of " <> groupRef <> " is removed from the welcome message, please add it."
+              GPServiceLinkRemoved -> when (ctId `isOwner` gr) $ notifyOwner gr $ "The group link of " <> userGroupRef <> " is removed from the welcome message, please add it."
               GPHasServiceLink -> when (ctId `isOwner` gr) $ groupLinkAdded gr
               GPServiceLinkError -> do
-                when (ctId `isOwner` gr) $ notifyOwner gr $ "Error: " <> serviceName <> " has no group link for " <> groupRef <> ". Please report the error to the developers."
-                putStrLn $ "Error: no group link for " <> groupRef
+                when (ctId `isOwner` gr) $ notifyOwner gr $ "Error: " <> serviceName <> " has no group link for " <> userGroupRef <> ". Please report the error to the developers."
+                putStrLn $ "Error: no group link for " <> userGroupRef
             GRSPendingApproval n -> processProfileChange gr $ n + 1
             GRSActive -> processProfileChange gr 1
             GRSSuspended -> processProfileChange gr 1
@@ -238,7 +241,6 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
         isInfix l d_ = l `T.isInfixOf` fromMaybe "" d_
         GroupInfo {groupId, groupProfile = p} = fromGroup
         GroupInfo {groupProfile = p'} = toGroup
-        groupRef = groupReference toGroup
         sameProfile
           GroupProfile {displayName = n, fullName = fn, image = i, description = d}
           GroupProfile {displayName = n', fullName = fn', image = i', description = d'} =
@@ -248,29 +250,32 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
             Nothing -> notifyOwner gr "Error: getDuplicateGroup. Please notify the developers."
             Just DGReserved -> notifyOwner gr $ groupAlreadyListed toGroup
             _ -> do
-              notifyOwner gr $ "Thank you! The group link for " <> groupRef <> " is added to the welcome message.\nYou will be notified once the group is added to the directory - it may take up to 24 hours."
+              notifyOwner gr $ "Thank you! The group link for " <> userGroupReference gr toGroup <> " is added to the welcome message.\nYou will be notified once the group is added to the directory - it may take up to 24 hours."
               let gaId = 1
               setGroupStatus gr $ GRSPendingApproval gaId
               checkRolesSendToApprove gr gaId
-        processProfileChange gr n' = groupProfileUpdate >>= \case
-          GPNoServiceLink -> do
-            setGroupStatus gr GRSPendingUpdate
-            notifyOwner gr $ "The group profile is updated " <> groupRef <> ", but no link is added to the welcome message.\n\nThe group will remain hidden from the directory until the group link is added and the group is re-approved."
-          GPServiceLinkRemoved -> do
-            setGroupStatus gr GRSPendingUpdate
-            notifyOwner gr $ "The group link for " <> groupRef <> " is removed from the welcome message.\n\nThe group is hidden from the directory until the group link is added and the group is re-approved."
-            notifySuperUsers $ "The group link is removed from " <> groupRef <> ", de-listed."
-          GPServiceLinkAdded -> do
-            setGroupStatus gr $ GRSPendingApproval n'
-            notifyOwner gr $ "The group link is added to " <> groupRef <> "!\nIt is hidden from the directory until approved."
-            notifySuperUsers $ "The group link is added to " <> groupRef <> "."
-            checkRolesSendToApprove gr n'
-          GPHasServiceLink -> do
-            setGroupStatus gr $ GRSPendingApproval n'
-            notifyOwner gr $ "The group " <> groupRef <> " is updated!\nIt is hidden from the directory until approved."
-            notifySuperUsers $ "The group " <> groupRef <> " is updated."
-            checkRolesSendToApprove gr n'
-          GPServiceLinkError -> putStrLn $ "Error: no group link for " <> groupRef <> " pending approval."
+        processProfileChange gr n' = do
+          let userGroupRef = userGroupReference gr toGroup
+              groupRef = groupReference toGroup
+          groupProfileUpdate >>= \case
+            GPNoServiceLink -> do
+              setGroupStatus gr GRSPendingUpdate
+              notifyOwner gr $ "The group profile is updated " <> userGroupRef <> ", but no link is added to the welcome message.\n\nThe group will remain hidden from the directory until the group link is added and the group is re-approved."
+            GPServiceLinkRemoved -> do
+              setGroupStatus gr GRSPendingUpdate
+              notifyOwner gr $ "The group link for " <> userGroupRef <> " is removed from the welcome message.\n\nThe group is hidden from the directory until the group link is added and the group is re-approved."
+              notifySuperUsers $ "The group link is removed from " <> groupRef <> ", de-listed."
+            GPServiceLinkAdded -> do
+              setGroupStatus gr $ GRSPendingApproval n'
+              notifyOwner gr $ "The group link is added to " <> userGroupRef <> "!\nIt is hidden from the directory until approved."
+              notifySuperUsers $ "The group link is added to " <> groupRef <> "."
+              checkRolesSendToApprove gr n'
+            GPHasServiceLink -> do
+              setGroupStatus gr $ GRSPendingApproval n'
+              notifyOwner gr $ "The group " <> userGroupRef <> " is updated!\nIt is hidden from the directory until approved."
+              notifySuperUsers $ "The group " <> groupRef <> " is updated."
+              checkRolesSendToApprove gr n'
+            GPServiceLinkError -> putStrLn $ "Error: no group link for " <> groupRef <> " pending approval."
         groupProfileUpdate = profileUpdate <$> sendChatCmd cc (APIGetGroupLink groupId)
           where
             profileUpdate = \case
@@ -302,7 +307,9 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
 
     deContactRoleChanged :: GroupInfo -> ContactId -> GroupMemberRole -> IO ()
     deContactRoleChanged g@GroupInfo {membership = GroupMember {memberRole = serviceRole}} ctId contactRole =
-      withGroupReg g "contact role changed" $ \gr ->
+      withGroupReg g "contact role changed" $ \gr -> do
+        let userGroupRef = userGroupReference gr g
+            uCtRole = "Your role in the group " <> userGroupRef <> " is changed to " <> ctRole
         when (ctId `isOwner` gr) $ do
           readTVarIO (groupRegStatus gr) >>= \case
             GRSSuspendedBadRoles -> when (rStatus == GRSOk) $ do
@@ -321,12 +328,13 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
         rStatus = groupRolesStatus contactRole serviceRole
         groupRef = groupReference g
         ctRole = "*" <> B.unpack (strEncode contactRole) <> "*"
-        uCtRole = "Your role in the group " <> groupRef <> " is changed to " <> ctRole
         suCtRole = "(user role is set to " <> ctRole <> ")."
 
     deServiceRoleChanged :: GroupInfo -> GroupMemberRole -> IO ()
     deServiceRoleChanged g serviceRole = do
       withGroupReg g "service role changed" $ \gr -> do
+        let userGroupRef = userGroupReference gr g
+            uSrvRole = serviceName <> " role in the group " <> userGroupRef <> " is changed to " <> srvRole
         readTVarIO (groupRegStatus gr) >>= \case
           GRSSuspendedBadRoles -> when (serviceRole == GRAdmin) $
             whenContactIsOwner gr $ do
@@ -345,7 +353,6 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
       where
         groupRef = groupReference g
         srvRole = "*" <> B.unpack (strEncode serviceRole) <> "*"
-        uSrvRole = serviceName <> " role in the group " <> groupRef <> " is changed to " <> srvRole
         suSrvRole = "(" <> serviceName <> " role is changed to " <> srvRole <> ")."
         whenContactIsOwner gr action = 
           getGroupMember gr >>=
@@ -356,26 +363,23 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
       withGroupReg g "contact removed" $ \gr -> do
         when (ctId `isOwner` gr) $ do
           setGroupStatus gr GRSRemoved
-          let groupRef = groupReference g
-          notifyOwner gr $ "You are removed from the group " <> groupRef <> ".\n\nThe group is no longer listed in the directory."
-          notifySuperUsers $ "The group " <> groupRef <> " is de-listed (group owner is removed)."
+          notifyOwner gr $ "You are removed from the group " <> userGroupReference gr g <> ".\n\nThe group is no longer listed in the directory."
+          notifySuperUsers $ "The group " <> groupReference g <> " is de-listed (group owner is removed)."
 
     deContactLeftGroup :: ContactId -> GroupInfo -> IO ()
     deContactLeftGroup ctId g =
       withGroupReg g "contact left" $ \gr -> do
         when (ctId `isOwner` gr) $ do
           setGroupStatus gr GRSRemoved
-          let groupRef = groupReference g
-          notifyOwner gr $ "You left the group " <> groupRef <> ".\n\nThe group is no longer listed in the directory."
-          notifySuperUsers $ "The group " <> groupRef <> " is de-listed (group owner left)."
+          notifyOwner gr $ "You left the group " <> userGroupReference gr g <> ".\n\nThe group is no longer listed in the directory."
+          notifySuperUsers $ "The group " <> groupReference g <> " is de-listed (group owner left)."
 
     deServiceRemovedFromGroup :: GroupInfo -> IO ()
     deServiceRemovedFromGroup g =
       withGroupReg g "service removed" $ \gr -> do
         setGroupStatus gr GRSRemoved
-        let groupRef = groupReference g
-        notifyOwner gr $ serviceName <> " is removed from the group " <> groupRef <> ".\n\nThe group is no longer listed in the directory."
-        notifySuperUsers $ "The group " <> groupRef <> " is de-listed (directory service is removed)."
+        notifyOwner gr $ serviceName <> " is removed from the group " <> userGroupReference gr g <> ".\n\nThe group is no longer listed in the directory."
+        notifySuperUsers $ "The group " <> groupReference g <> " is de-listed (directory service is removed)."
 
     deUserCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRUser -> IO ()
     deUserCommand ct ciId = \case
@@ -394,13 +398,15 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
               [] -> sendReply "No groups found"
               gs -> do
                 sendReply $ "Found " <> show (length gs) <> " group(s)"
-                void . forkIO $ forM_ gs $ \GroupInfo {groupProfile = p@GroupProfile {image = image_}} -> do
-                  let text = groupInfoText p
-                      msg = maybe (MCText text) (\image -> MCImage {text, image}) image_
-                  sendComposedMessage cc ct Nothing msg
+                void . forkIO $ forM_ gs $
+                  \(GroupInfo {groupProfile = p@GroupProfile {image = image_}}, GroupSummary {currentMembers}) -> do
+                    let membersStr = tshow currentMembers <> " members"
+                        text = groupInfoText p <> "\n" <> membersStr
+                        msg = maybe (MCText text) (\image -> MCImage {text, image}) image_
+                    sendComposedMessage cc ct Nothing msg
           Nothing -> sendReply "Error: getGroups. Please notify the developers."
       DCConfirmDuplicateGroup ugrId gName ->
-        atomically (getGroupReg st ugrId) >>= \case
+        atomically (getUserGroupReg st (contactId' ct) ugrId) >>= \case
           Nothing -> sendReply $ "Group ID " <> show ugrId <> " not found"
           Just GroupReg {dbGroupId, groupRegStatus} -> do
             getGroup cc dbGroupId >>= \case
@@ -415,7 +421,11 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
                         _ -> processInvitation ct g
                     _ -> sendReply $ "Error: the group ID " <> show ugrId <> " (" <> T.unpack displayName <> ") is not pending confirmation."
                 | otherwise -> sendReply $ "Group ID " <> show ugrId <> " has the display name " <> T.unpack displayName
-      DCListUserGroups -> pure ()
+      DCListUserGroups ->
+        atomically (getUserGroupRegs st $ contactId' ct) >>= \grs -> do
+          sendReply $ show (length grs) <> " registered group(s)"
+          void . forkIO $ forM_ (reverse grs) $ \gr@GroupReg {userGroupRegId} ->
+            sendGroupInfo ct gr userGroupRegId Nothing
       DCDeleteGroup _ugrId _gName -> pure ()
       DCUnknownCommand -> sendReply "Unknown command"
       DCCommandError tag -> sendReply $ "Command error: " <> show tag
@@ -440,7 +450,7 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
                           Just GRSOk -> do
                             setGroupStatus gr GRSActive
                             sendReply "Group approved!"
-                            notifyOwner gr $ "The group " <> groupRef <> " is approved and listed in directory!\nPlease note: if you change the group profile it will be hidden from directory until it is re-approved."
+                            notifyOwner gr $ "The group " <> userGroupReference' gr n <> " is approved and listed in directory!\nPlease note: if you change the group profile it will be hidden from directory until it is re-approved."
                           Just GRSServiceNotAdmin -> replyNotApproved serviceNotAdmin
                           Just GRSContactNotOwner -> replyNotApproved "user is not an owner."
                           Just GRSBadRoles -> replyNotApproved $ "user is not an owner, " <> serviceNotAdmin
@@ -451,31 +461,37 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
                   | otherwise -> sendReply "Incorrect approval code"
                 _ -> sendReply $ "Error: the group " <> groupRef <> " is not pending approval."
           where
-            groupRef = "ID " <> show groupId <> " (" <> T.unpack n <> ")"
+            groupRef = groupReference' groupId n
         DCRejectGroup _gaId _gName -> pure ()
         DCSuspendGroup groupId gName -> do
-          let groupRef = "ID " <> show groupId <> " (" <> T.unpack gName <> ")"
+          let groupRef = groupReference' groupId gName
           getGroupAndReg groupId gName >>= \case
             Nothing -> sendReply $ "The group " <> groupRef <> " not found (getGroupAndReg)."
             Just (_, gr) ->
               readTVarIO (groupRegStatus gr) >>= \case
                 GRSActive -> do
                   setGroupStatus gr GRSSuspended
-                  notifyOwner gr $ "The group " <> groupRef <> " is suspended and hidden from directory. Please contact the administrators."
+                  notifyOwner gr $ "The group " <> userGroupReference' gr gName <> " is suspended and hidden from directory. Please contact the administrators."
                   sendReply "Group suspended!"
                 _ -> sendReply $ "The group " <> groupRef <> " is not active, can't be suspended."
         DCResumeGroup groupId gName -> do
-          let groupRef = "ID " <> show groupId <> " (" <> T.unpack gName <> ")"
+          let groupRef = groupReference' groupId gName
           getGroupAndReg groupId gName >>= \case
             Nothing -> sendReply $ "The group " <> groupRef <> " not found (getGroupAndReg)."
             Just (_, gr) ->
               readTVarIO (groupRegStatus gr) >>= \case
                 GRSSuspended -> do
                   setGroupStatus gr GRSActive
-                  notifyOwner gr $ "The group " <> groupRef <> " is listed in the directory again!"
+                  notifyOwner gr $ "The group " <> userGroupReference' gr gName <> " is listed in the directory again!"
                   sendReply "Group listing resumed!"
                 _ -> sendReply $ "The group " <> groupRef <> " is not suspended, can't be resumed."
-        DCListGroups -> pure ()
+        DCListLastGroups count ->
+          readTVarIO (groupRegs st) >>= \grs -> do
+            sendReply $ show (length grs) <> " registered group(s)" <> (if length grs > count then ", showing the last " <> show count else "")
+            void . forkIO $ forM_ (reverse $ take count grs) $ \gr@GroupReg {dbGroupId, dbContactId} -> do
+              ct_ <- getContact cc dbContactId
+              let ownerStr = "Owner: " <> maybe "getContact error" localDisplayName' ct_
+              sendGroupInfo ct gr dbGroupId $ Just ownerStr
         DCCommandError tag -> sendReply $ "Command error: " <> show tag
       | otherwise = sendReply "You are not allowed to use this command"
       where
@@ -491,6 +507,20 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
                   $>>= \gr -> pure $ Just (g, gr)
             else pure Nothing
 
+    sendGroupInfo :: Contact -> GroupReg -> GroupId -> Maybe Text -> IO ()
+    sendGroupInfo ct gr@GroupReg {dbGroupId} useGroupId ownerStr_ = do
+      grStatus <- readTVarIO $ groupRegStatus gr
+      let statusStr = "Status: " <> groupRegStatusText grStatus
+      getGroupAndSummary cc dbGroupId >>= \case
+        Just (GroupInfo {groupProfile = p@GroupProfile {image = image_}}, GroupSummary {currentMembers}) -> do
+          let membersStr = tshow currentMembers <> " members"
+              text = T.unlines $ [tshow useGroupId <> ". " <> groupInfoText p] <> maybeToList ownerStr_ <> [membersStr, statusStr]
+              msg = maybe (MCText text) (\image -> MCImage {text, image}) image_
+          sendComposedMessage cc ct Nothing msg
+        Nothing -> do
+          let text = T.unlines $ [tshow useGroupId <> ". Error: getGroup. Please notify the developers."] <> maybeToList ownerStr_ <> [statusStr]
+          sendComposedMessage cc ct Nothing $ MCText text
+
 getContact :: ChatController -> ContactId -> IO (Maybe Contact)
 getContact cc ctId = resp <$> sendChatCmd cc (APIGetChat (ChatRef CTDirect ctId) (CPLast 0) Nothing)
   where
@@ -500,11 +530,18 @@ getContact cc ctId = resp <$> sendChatCmd cc (APIGetChat (ChatRef CTDirect ctId)
       _ -> Nothing
 
 getGroup :: ChatController -> GroupId -> IO (Maybe GroupInfo)
-getGroup cc gId = resp <$> sendChatCmd cc (APIGetChat (ChatRef CTGroup gId) (CPLast 0) Nothing)
+getGroup cc gId = resp <$> sendChatCmd cc (APIGroupInfo gId)
   where
     resp :: ChatResponse -> Maybe GroupInfo
     resp = \case
-      CRApiChat _ (AChat SCTGroup Chat {chatInfo = GroupChat g}) -> Just g
+      CRGroupInfo {groupInfo} -> Just groupInfo
+      _ -> Nothing
+
+getGroupAndSummary :: ChatController -> GroupId -> IO (Maybe (GroupInfo, GroupSummary))
+getGroupAndSummary cc gId = resp <$> sendChatCmd cc (APIGroupInfo gId)
+  where
+    resp = \case
+      CRGroupInfo {groupInfo, groupSummary} -> Just (groupInfo, groupSummary)
       _ -> Nothing
 
 unexpectedError :: String -> String
diff --git a/apps/simplex-directory-service/src/Directory/Store.hs b/apps/simplex-directory-service/src/Directory/Store.hs
index d5d00b53b5..9a91d21e8a 100644
--- a/apps/simplex-directory-service/src/Directory/Store.hs
+++ b/apps/simplex-directory-service/src/Directory/Store.hs
@@ -1,13 +1,16 @@
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Directory.Store where
 
 import Control.Concurrent.STM
 import Data.Int (Int64)
 import Data.Set (Set)
+import Data.Text (Text)
 import Simplex.Chat.Types
-import Data.List (find)
+import Data.List (find, foldl')
 import qualified Data.Set as S
 
 data DirectoryStore = DirectoryStore
@@ -24,8 +27,6 @@ data GroupReg = GroupReg
     groupRegStatus :: TVar GroupRegStatus
   }
 
-type GroupRegId = Int64
-
 type UserGroupRegId = Int64
 
 type GroupApprovalId = Int64
@@ -40,26 +41,44 @@ data GroupRegStatus
   | GRSSuspendedBadRoles
   | GRSRemoved
 
-addGroupReg :: DirectoryStore -> Contact -> GroupInfo -> GroupRegStatus -> STM ()
+groupRegStatusText :: GroupRegStatus -> Text
+groupRegStatusText = \case
+  GRSPendingConfirmation -> "pending confirmation (duplicate names)"
+  GRSProposed -> "proposed"
+  GRSPendingUpdate -> "pending profile update"
+  GRSPendingApproval _ -> "pending admin approval"
+  GRSActive -> "active"
+  GRSSuspended -> "suspended by admin"
+  GRSSuspendedBadRoles -> "suspended because roles changed"
+  GRSRemoved -> "removed"
+
+addGroupReg :: DirectoryStore -> Contact -> GroupInfo -> GroupRegStatus -> STM UserGroupRegId
 addGroupReg st ct GroupInfo {groupId} grStatus = do
   dbOwnerMemberId <- newTVar Nothing
   groupRegStatus <- newTVar grStatus
-  let gr = GroupReg {userGroupRegId = groupId, dbGroupId = groupId, dbContactId = contactId' ct, dbOwnerMemberId, groupRegStatus}
-  modifyTVar' (groupRegs st) (gr :)
+  let gr = GroupReg {userGroupRegId = 1, dbGroupId = groupId, dbContactId = ctId, dbOwnerMemberId, groupRegStatus}
+  stateTVar (groupRegs st) $ \grs ->
+    let ugrId = 1 + foldl' maxUgrId 0 grs
+     in (ugrId, gr {userGroupRegId = ugrId} : grs)
+  where
+    ctId = contactId' ct
+    maxUgrId mx GroupReg {dbContactId, userGroupRegId}
+      | dbContactId == ctId && userGroupRegId > mx = userGroupRegId
+      | otherwise = mx
 
-getGroupReg :: DirectoryStore -> GroupRegId -> STM (Maybe GroupReg)
+getGroupReg :: DirectoryStore -> GroupId -> STM (Maybe GroupReg)
 getGroupReg st gId = find ((gId ==) . dbGroupId) <$> readTVar (groupRegs st)
 
-getUserGroupRegId :: DirectoryStore -> ContactId -> UserGroupRegId -> STM (Maybe GroupReg)
-getUserGroupRegId st ctId ugrId = find (\r -> ctId == dbContactId r && ugrId == userGroupRegId r) <$> readTVar (groupRegs st)
+getUserGroupReg :: DirectoryStore -> ContactId -> UserGroupRegId -> STM (Maybe GroupReg)
+getUserGroupReg st ctId ugrId = find (\r -> ctId == dbContactId r && ugrId == userGroupRegId r) <$> readTVar (groupRegs st)
 
-getContactGroupRegs :: DirectoryStore -> ContactId -> STM [GroupReg]
-getContactGroupRegs st ctId = filter ((ctId ==) . dbContactId) <$> readTVar (groupRegs st)
+getUserGroupRegs :: DirectoryStore -> ContactId -> STM [GroupReg]
+getUserGroupRegs st ctId = filter ((ctId ==) . dbContactId) <$> readTVar (groupRegs st)
 
-filterListedGroups :: DirectoryStore -> [GroupInfo] -> STM [GroupInfo]
+filterListedGroups :: DirectoryStore -> [(GroupInfo, GroupSummary)] -> STM [(GroupInfo, GroupSummary)]
 filterListedGroups st gs = do
   lgs <- readTVar $ listedGroups st
-  pure $ filter (\GroupInfo {groupId} -> groupId `S.member` lgs) gs
+  pure $ filter (\(GroupInfo {groupId}, _) -> groupId `S.member` lgs) gs
 
 listGroup :: DirectoryStore -> GroupId -> STM ()
 listGroup st gId = do
@@ -78,7 +97,7 @@ unlistGroup st gId = do
 
 data DirectoryLogRecord
   = CreateGroupReg GroupReg
-  | UpdateGroupRegStatus GroupRegId GroupRegStatus
+  | UpdateGroupRegStatus GroupId GroupRegStatus
 
 getDirectoryStore :: FilePath -> IO DirectoryStore
 getDirectoryStore path = do
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 95343fd9a5..cdb15a46d0 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -1144,6 +1144,9 @@ processChatCommand = \case
     incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId)
     connectionStats <- withAgent (`getConnectionServers` contactConnId ct)
     pure $ CRContactInfo user ct connectionStats (fmap fromLocalProfile incognitoProfile)
+  APIGroupInfo gId -> withUser $ \user -> do
+    (g, s) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> liftIO (getGroupSummary db user gId)
+    pure $ CRGroupInfo user g s
   APIGroupMemberInfo gId gMemberId -> withUser $ \user -> do
     (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId
     connectionStats <- mapM (withAgent . flip getConnectionServers) (memberConnId m)
@@ -1230,6 +1233,9 @@ processChatCommand = \case
   SetShowMessages cName ntfOn -> updateChatSettings cName (\cs -> cs {enableNtfs = ntfOn})
   SetSendReceipts cName rcptsOn_ -> updateChatSettings cName (\cs -> cs {sendRcpts = rcptsOn_})
   ContactInfo cName -> withContactName cName APIContactInfo
+  ShowGroupInfo gName -> withUser $ \user -> do
+    groupId <- withStore $ \db -> getGroupIdByName db user gName
+    processChatCommand $ APIGroupInfo groupId
   GroupMemberInfo gName mName -> withMemberName gName mName APIGroupMemberInfo
   SwitchContact cName -> withContactName cName APISwitchContact
   SwitchGroupMember gName mName -> withMemberName gName mName APISwitchGroupMember
@@ -1493,7 +1499,7 @@ processChatCommand = \case
     groupId <- withStore $ \db -> getGroupIdByName db user gName
     processChatCommand $ APIListMembers groupId
   APIListGroups userId contactId_ search_ -> withUserId userId $ \user ->
-    CRGroupsList user <$> withStore' (\db -> getUserGroupDetails db user contactId_ search_)
+    CRGroupsList user <$> withStore' (\db -> getUserGroupsWithSummary db user contactId_ search_)
   ListGroups cName_ search_ -> withUser $ \user@User {userId} -> do
     ct_ <- forM cName_ $ \cName -> withStore $ \db -> getContactByName db user cName
     processChatCommand $ APIListGroups userId (contactId' <$> ct_) search_
@@ -5092,8 +5098,10 @@ chatCommandP =
       "/reconnect" $> ReconnectAllServers,
       "/_settings " *> (APISetChatSettings <$> chatRefP <* A.space <*> jsonP),
       "/_info #" *> (APIGroupMemberInfo <$> A.decimal <* A.space <*> A.decimal),
+      "/_info #" *> (APIGroupInfo <$> A.decimal),
       "/_info @" *> (APIContactInfo <$> A.decimal),
       ("/info #" <|> "/i #") *> (GroupMemberInfo <$> displayName <* A.space <* char_ '@' <*> displayName),
+      ("/info #" <|> "/i #") *> (ShowGroupInfo <$> displayName),
       ("/info " <|> "/i ") *> char_ '@' *> (ContactInfo <$> displayName),
       "/_switch #" *> (APISwitchGroupMember <$> A.decimal <* A.space <*> A.decimal),
       "/_switch @" *> (APISwitchContact <$> A.decimal),
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index bc60b371b6..4c9c7993f1 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/src/Simplex/Chat/Controller.hs
@@ -291,6 +291,7 @@ data ChatCommand
   | ReconnectAllServers
   | APISetChatSettings ChatRef ChatSettings
   | APIContactInfo ContactId
+  | APIGroupInfo GroupId
   | APIGroupMemberInfo GroupId GroupMemberId
   | APISwitchContact ContactId
   | APISwitchGroupMember GroupId GroupMemberId
@@ -307,6 +308,7 @@ data ChatCommand
   | SetShowMessages ChatName Bool
   | SetSendReceipts ChatName (Maybe Bool)
   | ContactInfo ContactName
+  | ShowGroupInfo GroupName
   | GroupMemberInfo GroupName ContactName
   | SwitchContact ContactName
   | SwitchGroupMember GroupName ContactName
@@ -424,6 +426,7 @@ data ChatResponse
   | CRChatItemTTL {user :: User, chatItemTTL :: Maybe Int64}
   | CRNetworkConfig {networkConfig :: NetworkConfig}
   | CRContactInfo {user :: User, contact :: Contact, connectionStats :: ConnectionStats, customUserProfile :: Maybe Profile}
+  | CRGroupInfo {user :: User, groupInfo :: GroupInfo, groupSummary :: GroupSummary}
   | CRGroupMemberInfo {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionStats_ :: Maybe ConnectionStats}
   | CRContactSwitchStarted {user :: User, contact :: Contact, connectionStats :: ConnectionStats}
   | CRGroupMemberSwitchStarted {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionStats :: ConnectionStats}
@@ -461,7 +464,7 @@ data ChatResponse
   | CRContactRequestRejected {user :: User, contactRequest :: UserContactRequest}
   | CRUserAcceptedGroupSent {user :: User, groupInfo :: GroupInfo, hostContact :: Maybe Contact}
   | CRUserDeletedMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
-  | CRGroupsList {user :: User, groups :: [GroupInfo]}
+  | CRGroupsList {user :: User, groups :: [(GroupInfo, GroupSummary)]}
   | CRSentGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember}
   | CRFileTransferStatus User (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus
   | CRFileTransferStatusXFTP User AChatItem
diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs
index 7b54e642ed..274d6edc6f 100644
--- a/src/Simplex/Chat/Store/Groups.hs
+++ b/src/Simplex/Chat/Store/Groups.hs
@@ -45,6 +45,8 @@ module Simplex.Chat.Store.Groups
     deleteGroup,
     getUserGroups,
     getUserGroupDetails,
+    getUserGroupsWithSummary,
+    getGroupSummary,
     getContactGroupPreferences,
     checkContactHasGroups,
     getGroupInvitation,
@@ -468,6 +470,30 @@ getUserGroupDetails db User {userId, userContactId} _contactId_ search_ =
   where
     search = fromMaybe "" search_
 
+getUserGroupsWithSummary :: DB.Connection -> User -> Maybe ContactId -> Maybe String -> IO [(GroupInfo, GroupSummary)]
+getUserGroupsWithSummary db user _contactId_ search_ =
+  getUserGroupDetails db user _contactId_ search_
+    >>= mapM (\g@GroupInfo {groupId} -> (g,) <$> getGroupSummary db user groupId)
+
+-- the statuses on non-current members should match memberCurrent' function
+getGroupSummary :: DB.Connection -> User -> GroupId -> IO GroupSummary
+getGroupSummary db User {userId} groupId = do
+  currentMembers_ <- maybeFirstRow fromOnly $
+    DB.query
+      db
+      [sql|
+        SELECT count (m.group_member_id)
+        FROM groups g
+        JOIN group_members m USING (group_id)
+        WHERE g.user_id = ?
+          AND g.group_id = ?
+          AND m.member_status != ?
+          AND m.member_status != ?
+          AND m.member_status != ?
+      |]
+      (userId, groupId, GSMemRemoved, GSMemLeft, GSMemInvited)
+  pure GroupSummary {currentMembers = fromMaybe 0 currentMembers_}
+
 getContactGroupPreferences :: DB.Connection -> User -> Contact -> IO [FullGroupPreferences]
 getContactGroupPreferences db User {userId} Contact {contactId} = do
   map (mergeGroupPreferences . fromOnly)
diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs
index 9d9791f1a9..77b5b763c3 100644
--- a/src/Simplex/Chat/Types.hs
+++ b/src/Simplex/Chat/Types.hs
@@ -318,6 +318,13 @@ instance ToJSON GroupInfo where toEncoding = J.genericToEncoding J.defaultOption
 groupName' :: GroupInfo -> GroupName
 groupName' GroupInfo {localDisplayName = g} = g
 
+data GroupSummary = GroupSummary
+  { currentMembers :: Int
+  }
+  deriving (Show, Generic)
+
+instance ToJSON GroupSummary where toEncoding = J.genericToEncoding J.defaultOptions
+
 data ContactOrGroup = CGContact Contact | CGGroup Group
 
 contactAndGroupIds :: ContactOrGroup -> (Maybe ContactId, Maybe GroupId)
@@ -784,6 +791,7 @@ memberActive m = case memberStatus m of
 memberCurrent :: GroupMember -> Bool
 memberCurrent = memberCurrent' . memberStatus
 
+-- update getGroupSummary if this is changed
 memberCurrent' :: GroupMemberStatus -> Bool
 memberCurrent' = \case
   GSMemRemoved -> False
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index 2e7232c1ef..febda0de5b 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -79,6 +79,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
   CRChatItemTTL u ttl -> ttyUser u $ viewChatItemTTL ttl
   CRNetworkConfig cfg -> viewNetworkConfig cfg
   CRContactInfo u ct cStats customUserProfile -> ttyUser u $ viewContactInfo ct cStats customUserProfile
+  CRGroupInfo u g s -> ttyUser u $ viewGroupInfo g s
   CRGroupMemberInfo u g m cStats -> ttyUser u $ viewGroupMemberInfo g m cStats
   CRContactSwitchStarted {} -> ["switch started"]
   CRGroupMemberSwitchStarted {} -> ["switch started"]
@@ -811,12 +812,12 @@ viewContactConnected ct@Contact {localDisplayName} userIncognitoProfile testView
     Nothing ->
       [ttyFullContact ct <> ": contact is connected"]
 
-viewGroupsList :: [GroupInfo] -> [StyledString]
+viewGroupsList :: [(GroupInfo, GroupSummary)] -> [StyledString]
 viewGroupsList [] = ["you have no groups!", "to create: " <> highlight' "/g <name>"]
 viewGroupsList gs = map groupSS $ sortOn ldn_ gs
   where
-    ldn_ = T.toLower . (localDisplayName :: GroupInfo -> GroupName)
-    groupSS g@GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}, membership, chatSettings} =
+    ldn_ = T.toLower . (localDisplayName :: GroupInfo -> GroupName) . fst
+    groupSS (g@GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}, membership, chatSettings}, GroupSummary {currentMembers}) =
       case memberStatus membership of
         GSMemInvited -> groupInvitation' g
         s -> membershipIncognito g <> ttyGroup ldn <> optFullName ldn fullName <> viewMemberStatus s
@@ -826,9 +827,10 @@ viewGroupsList gs = map groupSS $ sortOn ldn_ gs
           GSMemLeft -> delete "you left"
           GSMemGroupDeleted -> delete "group deleted"
           _
-            | enableNtfs chatSettings -> ""
-            | otherwise -> " (muted, you can " <> highlight ("/unmute #" <> ldn) <> ")"
+            | enableNtfs chatSettings -> " (" <> memberCount <> ")"
+            | otherwise -> " (" <> memberCount <> ", muted, you can " <> highlight ("/unmute #" <> ldn) <> ")"
         delete reason = " (" <> reason <> ", delete local copy: " <> highlight ("/d #" <> ldn) <> ")"
+        memberCount = sShow currentMembers <> " member" <> if currentMembers == 1 then "" else "s"
 
 groupInvitation' :: GroupInfo -> StyledString
 groupInvitation' GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}, membership = membership@GroupMember {memberProfile}} =
@@ -935,6 +937,12 @@ viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, conta
     <> ["alias: " <> plain localAlias | localAlias /= ""]
     <> [viewConnectionVerified (contactSecurityCode ct)]
 
+viewGroupInfo :: GroupInfo -> GroupSummary -> [StyledString]
+viewGroupInfo GroupInfo {groupId} s =
+  [ "group ID: " <> sShow groupId,
+    "current members: " <> sShow (currentMembers s)
+  ]
+
 viewGroupMemberInfo :: GroupInfo -> GroupMember -> Maybe ConnectionStats -> [StyledString]
 viewGroupMemberInfo GroupInfo {groupId} m@GroupMember {groupMemberId, memberProfile = LocalProfile {localAlias}} stats =
   [ "group ID: " <> sShow groupId,
diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs
index 1712efbd66..f1a5676bec 100644
--- a/tests/Bots/DirectoryTests.hs
+++ b/tests/Bots/DirectoryTests.hs
@@ -15,7 +15,7 @@ import Directory.Store
 import Simplex.Chat.Bot.KnownContacts
 import Simplex.Chat.Core
 import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts (..))
-import Simplex.Chat.Types (Profile (..), GroupMemberRole (GROwner))
+import Simplex.Chat.Types (GroupMemberRole (..), Profile (..))
 import System.FilePath ((</>))
 import Test.Hspec
 
@@ -45,6 +45,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
 
 directoryProfile :: Profile
 directoryProfile = Profile {displayName = "SimpleX-Directory", fullName = "", image = Nothing, contactLink = Nothing, preferences = Nothing}
@@ -139,6 +141,7 @@ testDirectoryService tmp =
       u <# "SimpleX-Directory> PSA (Privacy, Security & Anonymity)"
       u <## "Welcome message:"
       u <## welcome
+      u <## "2 members"
     updateGroupProfile u welcome = do
       u ##> ("/set welcome #PSA " <> welcome)
       u <## "description changed to:"
@@ -172,7 +175,7 @@ testSuspendResume tmp =
 testDelistedOwnerLeaves :: HasCallStack => FilePath -> IO ()
 testDelistedOwnerLeaves tmp =
   withDirectoryService tmp $ \superUser dsLink ->
-    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
       withNewTestChat tmp "cath" cathProfile $ \cath -> do
         bob `connectVia` dsLink
         registerGroup superUser bob "privacy" "Privacy"
@@ -203,7 +206,7 @@ testDelistedOwnerRemoved tmp =
 testNotDelistedMemberLeaves :: HasCallStack => FilePath -> IO ()
 testNotDelistedMemberLeaves tmp =
   withDirectoryService tmp $ \superUser dsLink ->
-    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
       withNewTestChat tmp "cath" cathProfile $ \cath -> do
         bob `connectVia` dsLink
         registerGroup superUser bob "privacy" "Privacy"
@@ -216,7 +219,7 @@ testNotDelistedMemberLeaves tmp =
 testNotDelistedMemberRemoved :: HasCallStack => FilePath -> IO ()
 testNotDelistedMemberRemoved tmp = 
   withDirectoryService tmp $ \superUser dsLink ->
-    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
       withNewTestChat tmp "cath" cathProfile $ \cath -> do
         bob `connectVia` dsLink
         registerGroup superUser bob "privacy" "Privacy"
@@ -228,7 +231,7 @@ testNotDelistedMemberRemoved tmp =
 testDelistedServiceRemoved :: HasCallStack => FilePath -> IO ()
 testDelistedServiceRemoved tmp =
   withDirectoryService tmp $ \superUser dsLink ->
-    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
       withNewTestChat tmp "cath" cathProfile $ \cath -> do
         bob `connectVia` dsLink
         registerGroup superUser bob "privacy" "Privacy"
@@ -245,12 +248,12 @@ testDelistedServiceRemoved tmp =
 testDelistedRoleChanges :: HasCallStack => FilePath -> IO ()
 testDelistedRoleChanges tmp =
   withDirectoryService tmp $ \superUser dsLink ->
-    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
       withNewTestChat tmp "cath" cathProfile $ \cath -> do
         bob `connectVia` dsLink
         registerGroup superUser bob "privacy" "Privacy"
         addCathAsOwner bob cath
-        groupFound cath "privacy"
+        groupFoundN 3 cath "privacy"
         -- de-listed if service role changed
         bob ##> "/mr privacy SimpleX-Directory member"
         bob <## "#privacy: you changed the role of SimpleX-Directory from admin to member"
@@ -268,7 +271,7 @@ testDelistedRoleChanges tmp =
         bob <## ""
         bob <## "The group is listed in the directory again."
         superUser <# "SimpleX-Directory> The group ID 1 (privacy) is listed (SimpleX-Directory role is changed to admin)."
-        groupFound cath "privacy"
+        groupFoundN 3 cath "privacy"
         -- de-listed if owner role changed
         cath ##> "/mr privacy bob admin"
         cath <## "#privacy: you changed the role of bob from owner to admin"
@@ -286,26 +289,26 @@ testDelistedRoleChanges tmp =
         bob <## ""
         bob <## "The group is listed in the directory again."
         superUser <# "SimpleX-Directory> The group ID 1 (privacy) is listed (user role is set to owner)."
-        groupFound cath "privacy"
+        groupFoundN 3 cath "privacy"
 
 testNotDelistedMemberRoleChanged :: HasCallStack => FilePath -> IO ()
 testNotDelistedMemberRoleChanged tmp =
   withDirectoryService tmp $ \superUser dsLink ->
-    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
       withNewTestChat tmp "cath" cathProfile $ \cath -> do
         bob `connectVia` dsLink
         registerGroup superUser bob "privacy" "Privacy"
         addCathAsOwner bob cath
-        groupFound cath "privacy"
+        groupFoundN 3 cath "privacy"
         bob ##> "/mr privacy cath member"
         bob <## "#privacy: you changed the role of cath from owner to member"
         cath <## "#privacy: bob changed your role from owner to member"
-        groupFound cath "privacy"
+        groupFoundN 3 cath "privacy"
 
 testNotSentApprovalBadRoles :: HasCallStack => FilePath -> IO ()
 testNotSentApprovalBadRoles tmp =
   withDirectoryService tmp $ \superUser dsLink ->
-    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
       withNewTestChat tmp "cath" cathProfile $ \cath -> do
         bob `connectVia` dsLink
         cath `connectVia` dsLink
@@ -328,7 +331,7 @@ testNotSentApprovalBadRoles tmp =
 testNotApprovedBadRoles :: HasCallStack => FilePath -> IO ()
 testNotApprovedBadRoles tmp =
   withDirectoryService tmp $ \superUser dsLink ->
-    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
       withNewTestChat tmp "cath" cathProfile $ \cath -> do
         bob `connectVia` dsLink
         cath `connectVia` dsLink
@@ -355,7 +358,7 @@ testNotApprovedBadRoles tmp =
 testRegOwnerChangedProfile :: HasCallStack => FilePath -> IO ()
 testRegOwnerChangedProfile tmp =
   withDirectoryService tmp $ \superUser dsLink ->
-    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
       withNewTestChat tmp "cath" cathProfile $ \cath -> do
         bob `connectVia` dsLink
         registerGroup superUser bob "privacy" "Privacy"
@@ -369,12 +372,12 @@ testRegOwnerChangedProfile tmp =
         groupNotFound cath "privacy"
         superUser <# "SimpleX-Directory> The group ID 1 (privacy) is updated."
         reapproveGroup superUser bob
-        groupFound cath "privacy"
+        groupFoundN 3 cath "privacy"
 
 testAnotherOwnerChangedProfile :: HasCallStack => FilePath -> IO ()
 testAnotherOwnerChangedProfile tmp =
   withDirectoryService tmp $ \superUser dsLink ->
-    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
       withNewTestChat tmp "cath" cathProfile $ \cath -> do
         bob `connectVia` dsLink
         registerGroup superUser bob "privacy" "Privacy"
@@ -388,12 +391,12 @@ testAnotherOwnerChangedProfile tmp =
         groupNotFound cath "privacy"
         superUser <# "SimpleX-Directory> The group ID 1 (privacy) is updated."
         reapproveGroup superUser bob
-        groupFound cath "privacy"
+        groupFoundN 3 cath "privacy"
 
 testRegOwnerRemovedLink :: HasCallStack => FilePath -> IO ()
 testRegOwnerRemovedLink tmp =
   withDirectoryService tmp $ \superUser dsLink ->
-    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
       withNewTestChat tmp "cath" cathProfile $ \cath -> do
         bob `connectVia` dsLink
         registerGroup superUser bob "privacy" "Privacy"
@@ -421,12 +424,12 @@ testRegOwnerRemovedLink tmp =
         cath <## "description changed to:"
         cath <## welcomeWithLink
         reapproveGroup superUser bob
-        groupFound cath "privacy"
+        groupFoundN 3 cath "privacy"
 
 testAnotherOwnerRemovedLink :: HasCallStack => FilePath -> IO ()
 testAnotherOwnerRemovedLink tmp =
   withDirectoryService tmp $ \superUser dsLink ->
-    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
       withNewTestChat tmp "cath" cathProfile $ \cath -> do
         bob `connectVia` dsLink
         registerGroup superUser bob "privacy" "Privacy"
@@ -463,12 +466,12 @@ testAnotherOwnerRemovedLink tmp =
         cath <## "description changed to:"
         cath <## (welcomeWithLink <> " - welcome!")
         reapproveGroup superUser bob
-        groupFound cath "privacy"
+        groupFoundN 3 cath "privacy"
 
 testDuplicateAskConfirmation :: HasCallStack => FilePath -> IO ()
 testDuplicateAskConfirmation tmp =
   withDirectoryService tmp $ \superUser dsLink ->
-    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
       withNewTestChat tmp "cath" cathProfile $ \cath -> do
         bob `connectVia` dsLink
         submitGroup bob "privacy" "Privacy"
@@ -477,8 +480,8 @@ testDuplicateAskConfirmation tmp =
         submitGroup cath "privacy" "Privacy"
         cath <# "SimpleX-Directory> The group privacy (Privacy) is already submitted to the directory."
         cath <## "To confirm the registration, please send:"
-        cath <# "SimpleX-Directory> /confirm 2:privacy"
-        cath #> "@SimpleX-Directory /confirm 2:privacy"
+        cath <# "SimpleX-Directory> /confirm 1:privacy"
+        cath #> "@SimpleX-Directory /confirm 1:privacy"
         welcomeWithLink <- groupAccepted cath "privacy"
         groupNotFound bob "privacy"
         completeRegistration superUser cath "privacy" "Privacy" welcomeWithLink 2
@@ -487,7 +490,7 @@ testDuplicateAskConfirmation tmp =
 testDuplicateProhibitRegistration :: HasCallStack => FilePath -> IO ()
 testDuplicateProhibitRegistration tmp =
   withDirectoryService tmp $ \superUser dsLink ->
-    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
       withNewTestChat tmp "cath" cathProfile $ \cath -> do
         bob `connectVia` dsLink
         registerGroup superUser bob "privacy" "Privacy"
@@ -499,7 +502,7 @@ testDuplicateProhibitRegistration tmp =
 testDuplicateProhibitConfirmation :: HasCallStack => FilePath -> IO ()
 testDuplicateProhibitConfirmation tmp =
   withDirectoryService tmp $ \superUser dsLink ->
-    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
       withNewTestChat tmp "cath" cathProfile $ \cath -> do
         bob `connectVia` dsLink
         submitGroup bob "privacy" "Privacy"
@@ -508,17 +511,17 @@ testDuplicateProhibitConfirmation tmp =
         submitGroup cath "privacy" "Privacy"
         cath <# "SimpleX-Directory> The group privacy (Privacy) is already submitted to the directory."
         cath <## "To confirm the registration, please send:"
-        cath <# "SimpleX-Directory> /confirm 2:privacy"
+        cath <# "SimpleX-Directory> /confirm 1:privacy"
         groupNotFound cath "privacy"
         completeRegistration superUser bob "privacy" "Privacy" welcomeWithLink 1
         groupFound cath "privacy"
-        cath #> "@SimpleX-Directory /confirm 2:privacy"
+        cath #> "@SimpleX-Directory /confirm 1:privacy"
         cath <# "SimpleX-Directory> The group privacy (Privacy) is already listed in the directory, please choose another name."
 
 testDuplicateProhibitWhenUpdated :: HasCallStack => FilePath -> IO ()
 testDuplicateProhibitWhenUpdated tmp =
   withDirectoryService tmp $ \superUser dsLink ->
-    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
       withNewTestChat tmp "cath" cathProfile $ \cath -> do
         bob `connectVia` dsLink
         submitGroup bob "privacy" "Privacy"
@@ -527,8 +530,8 @@ testDuplicateProhibitWhenUpdated tmp =
         submitGroup cath "privacy" "Privacy"
         cath <# "SimpleX-Directory> The group privacy (Privacy) is already submitted to the directory."
         cath <## "To confirm the registration, please send:"
-        cath <# "SimpleX-Directory> /confirm 2:privacy"
-        cath #> "@SimpleX-Directory /confirm 2:privacy"
+        cath <# "SimpleX-Directory> /confirm 1:privacy"
+        cath #> "@SimpleX-Directory /confirm 1:privacy"
         welcomeWithLink' <- groupAccepted cath "privacy"
         groupNotFound cath "privacy"
         completeRegistration superUser bob "privacy" "Privacy" welcomeWithLink 1
@@ -549,7 +552,7 @@ testDuplicateProhibitWhenUpdated tmp =
 testDuplicateProhibitApproval :: HasCallStack => FilePath -> IO ()
 testDuplicateProhibitApproval tmp =
   withDirectoryService tmp $ \superUser dsLink ->
-    withNewTestChat tmp "bob" bobProfile $ \bob -> do
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
       withNewTestChat tmp "cath" cathProfile $ \cath -> do
         bob `connectVia` dsLink
         submitGroup bob "privacy" "Privacy"
@@ -558,8 +561,8 @@ testDuplicateProhibitApproval tmp =
         submitGroup cath "privacy" "Privacy"
         cath <# "SimpleX-Directory> The group privacy (Privacy) is already submitted to the directory."
         cath <## "To confirm the registration, please send:"
-        cath <# "SimpleX-Directory> /confirm 2:privacy"
-        cath #> "@SimpleX-Directory /confirm 2:privacy"
+        cath <# "SimpleX-Directory> /confirm 1:privacy"
+        cath #> "@SimpleX-Directory /confirm 1:privacy"
         welcomeWithLink' <- groupAccepted cath "privacy"
         updateProfileWithLink cath "privacy" welcomeWithLink' 2
         notifySuperUser superUser cath "privacy" "Privacy" welcomeWithLink' 2
@@ -572,6 +575,93 @@ testDuplicateProhibitApproval tmp =
         superUser <# ("SimpleX-Directory> > " <> approve)
         superUser <## "      The group ID 2 (privacy) is already listed in the directory."
 
+testListUserGroups :: HasCallStack => FilePath -> IO ()
+testListUserGroups tmp =
+  withDirectoryService tmp $ \superUser dsLink ->
+    withNewTestChat tmp "bob" bobProfile $ \bob ->
+      withNewTestChat tmp "cath" cathProfile $ \cath -> do
+        bob `connectVia` dsLink
+        cath `connectVia` dsLink
+        registerGroup superUser bob "privacy" "Privacy"
+        connectUsers bob cath
+        fullAddMember "privacy" "Privacy" bob cath GRMember
+        joinGroup "privacy" cath bob
+        cath <## "#privacy: member SimpleX-Directory_1 is connected"
+        cath <## "contact SimpleX-Directory_1 is merged into SimpleX-Directory"
+        cath <## "use @SimpleX-Directory <message> to send messages"
+        registerGroupId superUser bob "security" "Security" 2 2
+        registerGroupId superUser cath "anonymity" "Anonymity" 3 1
+        bob #> "@SimpleX-Directory /list"
+        bob <# "SimpleX-Directory> > /list"
+        bob <## "      2 registered group(s)"
+        bob <# "SimpleX-Directory> 1. privacy (Privacy)"
+        bob <## "Welcome message:"
+        bob <##. "Link to join the group privacy: "
+        bob <## "3 members"
+        bob <## "Status: active"
+        bob <# "SimpleX-Directory> 2. security (Security)"
+        bob <## "Welcome message:"
+        bob <##. "Link to join the group security: "
+        bob <## "2 members"
+        bob <## "Status: active"
+        cath #> "@SimpleX-Directory /list"
+        cath <# "SimpleX-Directory> > /list"
+        cath <## "      1 registered group(s)"
+        cath <# "SimpleX-Directory> 1. anonymity (Anonymity)"
+        cath <## "Welcome message:"
+        cath <##. "Link to join the group anonymity: "
+        cath <## "2 members"
+        cath <## "Status: active"
+        -- with de-listed group
+        groupFound cath "anonymity"
+        cath ##> "/mr anonymity SimpleX-Directory member"
+        cath <## "#anonymity: you changed the role of SimpleX-Directory from admin to member"
+        cath <# "SimpleX-Directory> SimpleX-Directory role in the group ID 1 (anonymity) is changed to member."
+        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)."
+        groupNotFound cath "anonymity"
+        cath #> "@SimpleX-Directory /list"
+        cath <# "SimpleX-Directory> > /list"
+        cath <## "      1 registered group(s)"
+        cath <# "SimpleX-Directory> 1. anonymity (Anonymity)"
+        cath <## "Welcome message:"
+        cath <##. "Link to join the group anonymity: "
+        cath <## "2 members"
+        cath <## "Status: suspended because roles changed"
+        -- superuser lists all groups
+        superUser #> "@SimpleX-Directory /last"
+        superUser <# "SimpleX-Directory> > /last"
+        superUser <## "      3 registered group(s)"
+        superUser <# "SimpleX-Directory> 1. privacy (Privacy)"
+        superUser <## "Welcome message:"
+        superUser <##. "Link to join the group privacy: "
+        superUser <## "Owner: bob"
+        superUser <## "3 members"
+        superUser <## "Status: active"
+        superUser <# "SimpleX-Directory> 2. security (Security)"
+        superUser <## "Welcome message:"
+        superUser <##. "Link to join the group security: "
+        superUser <## "Owner: bob"
+        superUser <## "2 members"
+        superUser <## "Status: active"
+        superUser <# "SimpleX-Directory> 3. anonymity (Anonymity)"
+        superUser <## "Welcome message:"
+        superUser <##. "Link to join the group anonymity: "
+        superUser <## "Owner: cath"
+        superUser <## "2 members"
+        superUser <## "Status: suspended because roles changed"
+        -- showing last 1 group
+        superUser #> "@SimpleX-Directory /last 1"
+        superUser <# "SimpleX-Directory> > /last 1"
+        superUser <## "      3 registered group(s), showing the last 1"
+        superUser <# "SimpleX-Directory> 3. anonymity (Anonymity)"
+        superUser <## "Welcome message:"
+        superUser <##. "Link to join the group anonymity: "
+        superUser <## "Owner: cath"
+        superUser <## "2 members"
+        superUser <## "Status: suspended because roles changed"
+
 reapproveGroup :: HasCallStack => TestCC -> TestCC -> IO ()
 reapproveGroup superUser bob = do
   superUser <#. "SimpleX-Directory> bob submitted the group ID 1: privacy ("
@@ -617,10 +707,13 @@ withDirectoryService tmp test = do
         bot st = simplexChatCore testCfg (mkChatOpts opts) Nothing $ directoryService st opts
 
 registerGroup :: TestCC -> TestCC -> String -> String -> IO ()
-registerGroup su u n fn = do
+registerGroup su u n fn = registerGroupId su u n fn 1 1
+
+registerGroupId :: TestCC -> TestCC -> String -> String -> Int -> Int -> IO ()
+registerGroupId su u n fn gId ugId = do
   submitGroup u n fn
   welcomeWithLink <- groupAccepted u n
-  completeRegistration su u n fn welcomeWithLink 1
+  completeRegistrationId su u n fn welcomeWithLink gId ugId
 
 submitGroup :: TestCC -> String -> String -> IO ()
 submitGroup u n fn = do
@@ -642,17 +735,21 @@ groupAccepted u n = do
   dropStrPrefix "SimpleX-Directory> " . dropTime <$> getTermLine u -- welcome message with link
 
 completeRegistration :: TestCC -> TestCC -> String -> String -> String -> Int -> IO ()
-completeRegistration su u n fn welcomeWithLink gId = do
-  updateProfileWithLink u n welcomeWithLink gId
+completeRegistration su u n fn welcomeWithLink gId =
+  completeRegistrationId su u n fn welcomeWithLink gId gId
+
+completeRegistrationId :: TestCC -> TestCC -> String -> String -> String -> Int -> Int -> IO ()
+completeRegistrationId su u n fn welcomeWithLink gId ugId = do
+  updateProfileWithLink u n welcomeWithLink ugId
   notifySuperUser su u n fn welcomeWithLink gId
-  approveRegistration su u n gId
+  approveRegistrationId su u n gId ugId
 
 updateProfileWithLink :: TestCC -> String -> String -> Int -> IO ()
-updateProfileWithLink u n welcomeWithLink gId = do
+updateProfileWithLink u n welcomeWithLink ugId = do
   u ##> ("/set welcome " <> n <> " " <> welcomeWithLink)
   u <## "description changed to:"
   u <## welcomeWithLink
-  u <# ("SimpleX-Directory> Thank you! The group link for ID " <> show gId <> " (" <> n <> ") is added to the welcome message.")
+  u <# ("SimpleX-Directory> Thank you! The group link for ID " <> show ugId <> " (" <> n <> ") is added to the welcome message.")
   u <## "You will be notified once the group is added to the directory - it may take up to 24 hours."
 
 notifySuperUser :: TestCC -> TestCC -> String -> String -> String -> Int -> IO ()
@@ -667,12 +764,16 @@ notifySuperUser su u n fn welcomeWithLink gId = do
   su <# ("SimpleX-Directory> " <> approve)
 
 approveRegistration :: TestCC -> TestCC -> String -> Int -> IO ()
-approveRegistration su u n gId = do
+approveRegistration su u n gId =
+  approveRegistrationId su u n gId gId
+
+approveRegistrationId :: TestCC -> TestCC -> String -> Int -> Int -> IO ()
+approveRegistrationId su u n gId ugId = do
   let approve = "/approve " <> show gId <> ":" <> n <> " 1"
   su #> ("@SimpleX-Directory " <> approve)
   su <# ("SimpleX-Directory> > " <> approve)
   su <## "      Group approved!"
-  u <# ("SimpleX-Directory> The group ID " <> show gId <> " (" <> n <> ") is approved and listed in directory!")
+  u <# ("SimpleX-Directory> The group ID " <> show ugId <> " (" <> n <> ") is approved and listed in directory!")
   u <## "Please note: if you change the group profile it will be hidden from directory until it is re-approved."
 
 connectVia :: TestCC -> String -> IO ()
@@ -713,13 +814,17 @@ removeMember gName admin removed = do
   removed <## ("use /d " <> gn <> " to delete the group")
 
 groupFound :: TestCC -> String -> IO ()
-groupFound u name = do
+groupFound = groupFoundN 2
+
+groupFoundN :: Int -> TestCC -> String -> IO ()
+groupFoundN count u name = do
   u #> ("@SimpleX-Directory " <> name)
   u <# ("SimpleX-Directory> > " <> name)
   u <## "      Found 1 group(s)"
   u <#. ("SimpleX-Directory> " <> name <> " (")
   u <## "Welcome message:"
-  u <##. "Link to join the group privacy: "
+  u <##. "Link to join the group "
+  u <## (show count <> " members")
 
 groupNotFound :: TestCC -> String -> IO ()
 groupNotFound u s = do
diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs
index 7b93b97589..2384daac3f 100644
--- a/tests/ChatTests/Direct.hs
+++ b/tests/ChatTests/Direct.hs
@@ -990,7 +990,7 @@ testMuteGroup =
         (bob </)
         (cath <# "#team alice> hi")
       bob ##> "/gs"
-      bob <## "#team (muted, you can /unmute #team)"
+      bob <## "#team (3 members, muted, you can /unmute #team)"
       bob ##> "/unmute #team"
       bob <## "ok"
       alice #> "#team hi again"
@@ -998,7 +998,7 @@ testMuteGroup =
         (bob <# "#team alice> hi again")
         (cath <# "#team alice> hi again")
       bob ##> "/gs"
-      bob <## "#team"
+      bob <## "#team (3 members)"
 
 testCreateSecondUser :: HasCallStack => FilePath -> IO ()
 testCreateSecondUser =
diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs
index 6e1e761208..5882319efb 100644
--- a/tests/ChatTests/Groups.hs
+++ b/tests/ChatTests/Groups.hs
@@ -132,7 +132,7 @@ testGroupShared alice bob cath checkMessages = do
   when checkMessages $ getReadChats msgItem1 msgItem2
   -- list groups
   alice ##> "/gs"
-  alice <## "#team"
+  alice <## "#team (3 members)"
   -- list group members
   alice ##> "/ms team"
   alice
@@ -739,18 +739,18 @@ testGroupList =
         ]
       -- alice sees both groups
       alice ##> "/gs"
-      alice <### ["#team", "#tennis"]
+      alice <### ["#team (2 members)", "#tennis (1 member)"]
       -- bob sees #tennis as invitation
       bob ##> "/gs"
       bob
-        <### [ "#team",
+        <### [ "#team (2 members)",
                "#tennis - you are invited (/j tennis to join, /d #tennis to delete invitation)"
              ]
       -- after deleting invitation bob sees only one group
       bob ##> "/d #tennis"
       bob <## "#tennis: you deleted the group"
       bob ##> "/gs"
-      bob <## "#team"
+      bob <## "#team (2 members)"
 
 testGroupMessageQuotedReply :: HasCallStack => FilePath -> IO ()
 testGroupMessageQuotedReply =
diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs
index 08d33df1d6..b9e8371b0b 100644
--- a/tests/ChatTests/Profiles.hs
+++ b/tests/ChatTests/Profiles.hs
@@ -770,7 +770,7 @@ testJoinGroupIncognito = testChat4 aliceProfile bobProfile cathProfile danProfil
     dan <##> cath
     -- list groups
     cath ##> "/gs"
-    cath <## "i #secret_club"
+    cath <## "i #secret_club (4 members)"
     -- list group members
     alice ##> "/ms secret_club"
     alice
diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs
index 694ef847c0..4c7ca8d0a4 100644
--- a/tests/ChatTests/Utils.hs
+++ b/tests/ChatTests/Utils.hs
@@ -470,6 +470,7 @@ createGroup3 :: HasCallStack => String -> TestCC -> TestCC -> TestCC -> IO ()
 createGroup3 gName cc1 cc2 cc3 = do
   createGroup2 gName cc1 cc2
   connectUsers cc1 cc3
+  name1 <- userName cc1
   name3 <- userName cc3
   sName2 <- showName cc2
   sName3 <- showName cc3
@@ -481,7 +482,7 @@ createGroup3 gName cc1 cc2 cc3 = do
         cc3 <## ("#" <> gName <> ": you joined the group")
         cc3 <## ("#" <> gName <> ": member " <> sName2 <> " is connected"),
       do
-        cc2 <## ("#" <> gName <> ": alice added " <> sName3 <> " to the group (connecting...)")
+        cc2 <## ("#" <> gName <> ": " <> name1 <> " added " <> sName3 <> " to the group (connecting...)")
         cc2 <## ("#" <> gName <> ": new member " <> name3 <> " is connected")
     ]
 

From 53662ef077abaa57f3d4e06e15b6cf727682b897 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Mon, 7 Aug 2023 08:25:15 +0100
Subject: [PATCH 5/5] directory: store log (#2863)

* directory: store log

* store log test (fails)

* fix store log
---
 apps/simplex-directory-service/Main.hs        |   2 +-
 .../src/Directory/Events.hs                   |  10 +-
 .../src/Directory/Options.hs                  |  27 +-
 .../src/Directory/Service.hs                  |  65 ++---
 .../src/Directory/Store.hs                    | 271 +++++++++++++++---
 src/Simplex/Chat.hs                           |   6 +-
 src/Simplex/Chat/Bot.hs                       |   9 +-
 src/Simplex/Chat/Core.hs                      |   4 +-
 tests/Bots/DirectoryTests.hs                  | 177 +++++++-----
 9 files changed, 417 insertions(+), 154 deletions(-)

diff --git a/apps/simplex-directory-service/Main.hs b/apps/simplex-directory-service/Main.hs
index 103f382461..434e42d851 100644
--- a/apps/simplex-directory-service/Main.hs
+++ b/apps/simplex-directory-service/Main.hs
@@ -11,5 +11,5 @@ import Simplex.Chat.Terminal (terminalChatConfig)
 main :: IO ()
 main = do
   opts@DirectoryOpts {directoryLog} <- welcomeGetOpts
-  st <- getDirectoryStore directoryLog
+  st <- restoreDirectoryStore directoryLog
   simplexChatCore terminalChatConfig (mkChatOpts opts) Nothing $ directoryService st opts
diff --git a/apps/simplex-directory-service/src/Directory/Events.hs b/apps/simplex-directory-service/src/Directory/Events.hs
index bdf76e80d2..8ab6bea805 100644
--- a/apps/simplex-directory-service/src/Directory/Events.hs
+++ b/apps/simplex-directory-service/src/Directory/Events.hs
@@ -7,7 +7,15 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE StandaloneDeriving #-}
 
-module Directory.Events where
+module Directory.Events
+  ( DirectoryEvent (..),
+    DirectoryCmd (..),
+    ADirectoryCmd (..),
+    DirectoryRole (..),
+    SDirectoryRole (..),
+    crDirectoryEvent,
+  )
+where
 
 import Control.Applicative ((<|>))
 import Data.Attoparsec.Text (Parser)
diff --git a/apps/simplex-directory-service/src/Directory/Options.hs b/apps/simplex-directory-service/src/Directory/Options.hs
index 1bdde35923..1f06afe116 100644
--- a/apps/simplex-directory-service/src/Directory/Options.hs
+++ b/apps/simplex-directory-service/src/Directory/Options.hs
@@ -4,7 +4,12 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module Directory.Options where
+module Directory.Options
+ ( DirectoryOpts (..),
+   getDirectoryOpts,
+   mkChatOpts,
+ )
+where
 
 import Options.Applicative
 import Simplex.Chat.Bot.KnownContacts
@@ -14,8 +19,9 @@ import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts, coreChatOptsP)
 data DirectoryOpts = DirectoryOpts
   { coreOptions :: CoreChatOpts,
     superUsers :: [KnownContact],
-    directoryLog :: FilePath,
-    serviceName :: String
+    directoryLog :: Maybe FilePath,
+    serviceName :: String,
+    testing :: Bool
   }
 
 directoryOpts :: FilePath -> FilePath -> Parser DirectoryOpts
@@ -27,14 +33,14 @@ directoryOpts appDir defaultDbFileName = do
       ( long "super-users"
           <> metavar "SUPER_USERS"
           <> help "Comma-separated list of super-users in the format CONTACT_ID:DISPLAY_NAME who will be allowed to manage the directory"
-          <> value []
       )
   directoryLog <-
-    strOption
-      ( long "directory-file"
-          <> metavar "DIRECTORY_FILE"
-          <> help "Append only log for directory state"
-      )
+    Just <$>
+      strOption
+        ( long "directory-file"
+            <> metavar "DIRECTORY_FILE"
+            <> help "Append only log for directory state"
+        )
   serviceName <-
     strOption
       ( long "service-name"
@@ -47,7 +53,8 @@ directoryOpts appDir defaultDbFileName = do
       { coreOptions,
         superUsers,
         directoryLog,
-        serviceName
+        serviceName,
+        testing = False
       }
 
 getDirectoryOpts :: FilePath -> FilePath -> IO DirectoryOpts
diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs
index 6f3ac92fc8..570aa57817 100644
--- a/apps/simplex-directory-service/src/Directory/Service.hs
+++ b/apps/simplex-directory-service/src/Directory/Service.hs
@@ -54,14 +54,15 @@ data GroupRolesStatus
 welcomeGetOpts :: IO DirectoryOpts
 welcomeGetOpts = do
   appDir <- getAppUserDataDirectory "simplex"
-  opts@DirectoryOpts {coreOptions = CoreChatOpts {dbFilePrefix}} <- getDirectoryOpts appDir "simplex_directory_service"
-  putStrLn $ "SimpleX Directory Service Bot v" ++ versionNumber
-  putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
+  opts@DirectoryOpts {coreOptions = CoreChatOpts {dbFilePrefix}, testing} <- getDirectoryOpts appDir "simplex_directory_service"
+  unless testing $ do  
+    putStrLn $ "SimpleX Directory Service Bot v" ++ versionNumber
+    putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
   pure opts
 
 directoryService :: DirectoryStore -> DirectoryOpts -> User -> ChatController -> IO ()
-directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = do
-  initializeBotAddress cc
+directoryService st DirectoryOpts {superUsers, serviceName, testing} User {userId} cc = do
+  initializeBotAddress' (not testing) cc
   race_ (forever $ void getLine) . forever $ do
     (_, resp) <- atomically . readTBQueue $ outputQ cc
     forM_ (crDirectoryEvent resp) $ \case
@@ -90,14 +91,6 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
       atomically (getGroupReg st groupId) >>= \case
         Just gr -> action gr
         Nothing -> putStrLn $ T.unpack $ "Error: " <> err <> ", group: " <> localDisplayName <> ", can't find group registration ID " <> tshow groupId
-    setGroupStatus GroupReg {groupRegStatus, dbGroupId} grStatus = atomically $ do
-      writeTVar groupRegStatus grStatus
-      case grStatus of
-        GRSActive -> listGroup st dbGroupId
-        GRSSuspended -> reserveGroup st dbGroupId
-        GRSSuspendedBadRoles -> reserveGroup st dbGroupId
-        _ -> unlistGroup st dbGroupId
-
     groupInfoText GroupProfile {displayName = n, fullName = fn, description = d} =
       n <> (if n == fn || T.null fn then "" else " (" <> fn <> ")") <> maybe "" ("\nWelcome message:\n" <>) d
     userGroupReference gr GroupInfo {groupProfile = GroupProfile {displayName}} = userGroupReference' gr displayName
@@ -131,7 +124,7 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
 
     processInvitation :: Contact -> GroupInfo -> IO ()
     processInvitation ct g@GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = do
-      void $ atomically $ addGroupReg st ct g GRSProposed
+      void $ addGroupReg st ct g GRSProposed
       r <- sendChatCmd cc $ APIJoinGroup groupId
       sendMessage cc ct $ T.unpack $ case r of
         CRUserAcceptedGroupSent {} -> "Joining the group " <> displayName <> "…"
@@ -139,7 +132,7 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
 
     deContactConnected :: Contact -> IO ()
     deContactConnected ct = do
-      putStrLn $ T.unpack (localDisplayName' ct) <> " connected"
+      unless testing $ putStrLn $ T.unpack (localDisplayName' ct) <> " connected"
       sendMessage cc ct $
         "Welcome to " <> serviceName <> " service!\n\
         \Send a search string to find groups or */help* to learn how to add groups to directory.\n\n\
@@ -156,7 +149,7 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
           Nothing -> sendMessage cc ct "Error: getDuplicateGroup. Please notify the developers."
       where
         askConfirmation = do
-          ugrId <- atomically $ addGroupReg st ct g GRSPendingConfirmation
+          ugrId <- addGroupReg st ct g GRSPendingConfirmation
           sendMessage cc ct $ T.unpack $ "The group " <> displayName <> " (" <> fullName <> ") is already submitted to the directory.\nTo confirm the registration, please send:"
           sendMessage cc ct $ "/confirm " <> show ugrId <> ":" <> T.unpack displayName
 
@@ -193,12 +186,12 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
     deServiceJoinedGroup ctId g owner =
       withGroupReg g "joined group" $ \gr ->
         when (ctId `isOwner` gr) $ do
-          atomically $ writeTVar (dbOwnerMemberId gr) (Just $ groupMemberId' owner)
+          setGroupRegOwner st gr owner
           let GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = g
           notifyOwner gr $ T.unpack $ "Joined the group " <> displayName <> ", creating the link…"
           sendChatCmd cc (APICreateGroupLink groupId GRMember) >>= \case
             CRGroupLinkCreated {connReqContact} -> do
-              setGroupStatus gr GRSPendingUpdate
+              setGroupStatus st gr GRSPendingUpdate
               notifyOwner gr
                 "Created the public link to join the group via this directory service that is always online.\n\n\
                 \Please add it to the group welcome message.\n\
@@ -215,7 +208,6 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
     deGroupUpdated :: ContactId -> GroupInfo -> GroupInfo -> IO ()
     deGroupUpdated ctId fromGroup toGroup =
       unless (sameProfile p p') $ do
-        atomically $ unlistGroup st groupId
         withGroupReg toGroup "group updated" $ \gr -> do
           let userGroupRef = userGroupReference gr toGroup
           readTVarIO (groupRegStatus gr) >>= \case
@@ -250,28 +242,27 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
             Nothing -> notifyOwner gr "Error: getDuplicateGroup. Please notify the developers."
             Just DGReserved -> notifyOwner gr $ groupAlreadyListed toGroup
             _ -> do
-              notifyOwner gr $ "Thank you! The group link for " <> userGroupReference gr toGroup <> " is added to the welcome message.\nYou will be notified once the group is added to the directory - it may take up to 24 hours."
               let gaId = 1
-              setGroupStatus gr $ GRSPendingApproval gaId
+              setGroupStatus st gr $ GRSPendingApproval gaId
+              notifyOwner gr $ "Thank you! The group link for " <> userGroupReference gr toGroup <> " is added to the welcome message.\nYou will be notified once the group is added to the directory - it may take up to 24 hours."
               checkRolesSendToApprove gr gaId
         processProfileChange gr n' = do
+          setGroupStatus st gr GRSPendingUpdate
           let userGroupRef = userGroupReference gr toGroup
               groupRef = groupReference toGroup
           groupProfileUpdate >>= \case
             GPNoServiceLink -> do
-              setGroupStatus gr GRSPendingUpdate
               notifyOwner gr $ "The group profile is updated " <> userGroupRef <> ", but no link is added to the welcome message.\n\nThe group will remain hidden from the directory until the group link is added and the group is re-approved."
             GPServiceLinkRemoved -> do
-              setGroupStatus gr GRSPendingUpdate
               notifyOwner gr $ "The group link for " <> userGroupRef <> " is removed from the welcome message.\n\nThe group is hidden from the directory until the group link is added and the group is re-approved."
               notifySuperUsers $ "The group link is removed from " <> groupRef <> ", de-listed."
             GPServiceLinkAdded -> do
-              setGroupStatus gr $ GRSPendingApproval n'
+              setGroupStatus st gr $ GRSPendingApproval n'
               notifyOwner gr $ "The group link is added to " <> userGroupRef <> "!\nIt is hidden from the directory until approved."
               notifySuperUsers $ "The group link is added to " <> groupRef <> "."
               checkRolesSendToApprove gr n'
             GPHasServiceLink -> do
-              setGroupStatus gr $ GRSPendingApproval n'
+              setGroupStatus st gr $ GRSPendingApproval n'
               notifyOwner gr $ "The group " <> userGroupRef <> " is updated!\nIt is hidden from the directory until approved."
               notifySuperUsers $ "The group " <> groupRef <> " is updated."
               checkRolesSendToApprove gr n'
@@ -313,14 +304,14 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
         when (ctId `isOwner` gr) $ do
           readTVarIO (groupRegStatus gr) >>= \case
             GRSSuspendedBadRoles -> when (rStatus == GRSOk) $ do
-              setGroupStatus gr GRSActive
+              setGroupStatus st gr GRSActive
               notifyOwner gr $ uCtRole <> ".\n\nThe group is listed in the directory again."
               notifySuperUsers $ "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 gr GRSSuspendedBadRoles
+              setGroupStatus st gr GRSSuspendedBadRoles
               notifyOwner gr $ uCtRole <> ".\n\nThe group is no longer listed in the directory."
               notifySuperUsers $ "The group " <> groupRef <> " is de-listed " <> suCtRole
             _ -> pure ()
@@ -338,7 +329,7 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
         readTVarIO (groupRegStatus gr) >>= \case
           GRSSuspendedBadRoles -> when (serviceRole == GRAdmin) $
             whenContactIsOwner gr $ do
-              setGroupStatus gr GRSActive
+              setGroupStatus st gr GRSActive
               notifyOwner gr $ uSrvRole <> ".\n\nThe group is listed in the directory again."
               notifySuperUsers $ "The group " <> groupRef <> " is listed " <> suSrvRole
           GRSPendingApproval gaId -> when (serviceRole == GRAdmin) $
@@ -346,7 +337,7 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
               sendToApprove g gr gaId
               notifyOwner gr $ uSrvRole <> ".\n\nThe group is submitted for approval."
           GRSActive -> when (serviceRole /= GRAdmin) $ do
-            setGroupStatus gr GRSSuspendedBadRoles
+            setGroupStatus st gr GRSSuspendedBadRoles
             notifyOwner gr $ uSrvRole <> ".\n\nThe group is no longer listed in the directory."
             notifySuperUsers $ "The group " <> groupRef <> " is de-listed " <> suSrvRole
           _ -> pure ()
@@ -362,7 +353,7 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
     deContactRemovedFromGroup ctId g =
       withGroupReg g "contact removed" $ \gr -> do
         when (ctId `isOwner` gr) $ do
-          setGroupStatus gr GRSRemoved
+          setGroupStatus st gr GRSRemoved
           notifyOwner gr $ "You are removed from the group " <> userGroupReference gr g <> ".\n\nThe group is no longer listed in the directory."
           notifySuperUsers $ "The group " <> groupReference g <> " is de-listed (group owner is removed)."
 
@@ -370,14 +361,14 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
     deContactLeftGroup ctId g =
       withGroupReg g "contact left" $ \gr -> do
         when (ctId `isOwner` gr) $ do
-          setGroupStatus gr GRSRemoved
+          setGroupStatus st gr GRSRemoved
           notifyOwner gr $ "You left the group " <> userGroupReference gr g <> ".\n\nThe group is no longer listed in the directory."
           notifySuperUsers $ "The group " <> groupReference g <> " is de-listed (group owner left)."
 
     deServiceRemovedFromGroup :: GroupInfo -> IO ()
     deServiceRemovedFromGroup g =
       withGroupReg g "service removed" $ \gr -> do
-        setGroupStatus gr GRSRemoved
+        setGroupStatus st gr GRSRemoved
         notifyOwner gr $ serviceName <> " is removed from the group " <> userGroupReference gr g <> ".\n\nThe group is no longer listed in the directory."
         notifySuperUsers $ "The group " <> groupReference g <> " is de-listed (directory service is removed)."
 
@@ -397,8 +388,8 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
             atomically (filterListedGroups st groups) >>= \case
               [] -> sendReply "No groups found"
               gs -> do
-                sendReply $ "Found " <> show (length gs) <> " group(s)"
-                void . forkIO $ forM_ gs $
+                sendReply $ "Found " <> show (length gs) <> " group(s)" <> if length gs > 10 then ", sending 10." else ""
+                void . forkIO $ forM_ (take 10 gs) $
                   \(GroupInfo {groupProfile = p@GroupProfile {image = image_}}, GroupSummary {currentMembers}) -> do
                     let membersStr = tshow currentMembers <> " members"
                         text = groupInfoText p <> "\n" <> membersStr
@@ -448,7 +439,7 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
                       _ -> do
                         getGroupRolesStatus g gr >>= \case
                           Just GRSOk -> do
-                            setGroupStatus gr GRSActive
+                            setGroupStatus st gr GRSActive
                             sendReply "Group approved!"
                             notifyOwner gr $ "The group " <> userGroupReference' gr n <> " is approved and listed in directory!\nPlease note: if you change the group profile it will be hidden from directory until it is re-approved."
                           Just GRSServiceNotAdmin -> replyNotApproved serviceNotAdmin
@@ -470,7 +461,7 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
             Just (_, gr) ->
               readTVarIO (groupRegStatus gr) >>= \case
                 GRSActive -> do
-                  setGroupStatus gr GRSSuspended
+                  setGroupStatus st gr GRSSuspended
                   notifyOwner gr $ "The group " <> userGroupReference' gr gName <> " is suspended and hidden from directory. Please contact the administrators."
                   sendReply "Group suspended!"
                 _ -> sendReply $ "The group " <> groupRef <> " is not active, can't be suspended."
@@ -481,7 +472,7 @@ directoryService st DirectoryOpts {superUsers, serviceName} User {userId} cc = d
             Just (_, gr) ->
               readTVarIO (groupRegStatus gr) >>= \case
                 GRSSuspended -> do
-                  setGroupStatus gr GRSActive
+                  setGroupStatus st gr GRSActive
                   notifyOwner gr $ "The group " <> userGroupReference' gr gName <> " is listed in the directory again!"
                   sendReply "Group listing resumed!"
                 _ -> sendReply $ "The group " <> groupRef <> " is not suspended, can't be resumed."
diff --git a/apps/simplex-directory-service/src/Directory/Store.hs b/apps/simplex-directory-service/src/Directory/Store.hs
index 9a91d21e8a..5082cab2ce 100644
--- a/apps/simplex-directory-service/src/Directory/Store.hs
+++ b/apps/simplex-directory-service/src/Directory/Store.hs
@@ -1,32 +1,70 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Directory.Store where
+module Directory.Store
+  ( DirectoryStore (..),
+    GroupReg (..),
+    GroupRegStatus (..),
+    UserGroupRegId,
+    GroupApprovalId,
+    restoreDirectoryStore,
+    addGroupReg,
+    setGroupStatus,
+    setGroupRegOwner,
+    getGroupReg,
+    getUserGroupReg,
+    getUserGroupRegs,
+    filterListedGroups,
+    groupRegStatusText,
+  )
+where
 
 import Control.Concurrent.STM
+import Control.Monad
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import Data.Composition ((.:))
 import Data.Int (Int64)
+import Data.List (find, foldl', sortOn)
+import Data.Map (Map)
+import qualified Data.Map.Strict as M
+import Data.Maybe (isJust)
 import Data.Set (Set)
+import qualified Data.Set as S
 import Data.Text (Text)
 import Simplex.Chat.Types
-import Data.List (find, foldl')
-import qualified Data.Set as S
+import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Util (ifM)
+import System.IO (Handle, IOMode (..), openFile, BufferMode (..), hSetBuffering)
+import System.Directory (renameFile, doesFileExist)
 
 data DirectoryStore = DirectoryStore
   { groupRegs :: TVar [GroupReg],
     listedGroups :: TVar (Set GroupId),
-    reservedGroups :: TVar (Set GroupId)
+    reservedGroups :: TVar (Set GroupId),
+    directoryLogFile :: Maybe Handle
   }
 
 data GroupReg = GroupReg
-  { userGroupRegId :: UserGroupRegId,
-    dbGroupId :: GroupId,
+  { dbGroupId :: GroupId,
+    userGroupRegId :: UserGroupRegId,
     dbContactId :: ContactId,
     dbOwnerMemberId :: TVar (Maybe GroupMemberId),
     groupRegStatus :: TVar GroupRegStatus
   }
 
+data GroupRegData = GroupRegData
+  { dbGroupId_ :: GroupId,
+    userGroupRegId_ :: UserGroupRegId,
+    dbContactId_ :: ContactId,
+    dbOwnerMemberId_ :: Maybe GroupMemberId,
+    groupRegStatus_ :: GroupRegStatus
+  }
+
 type UserGroupRegId = Int64
 
 type GroupApprovalId = Int64
@@ -41,6 +79,8 @@ data GroupRegStatus
   | GRSSuspendedBadRoles
   | GRSRemoved
 
+data DirectoryStatus = DSListed | DSReserved | DSRegistered
+
 groupRegStatusText :: GroupRegStatus -> Text
 groupRegStatusText = \case
   GRSPendingConfirmation -> "pending confirmation (duplicate names)"
@@ -52,20 +92,50 @@ groupRegStatusText = \case
   GRSSuspendedBadRoles -> "suspended because roles changed"
   GRSRemoved -> "removed"
 
-addGroupReg :: DirectoryStore -> Contact -> GroupInfo -> GroupRegStatus -> STM UserGroupRegId
+grDirectoryStatus :: GroupRegStatus -> DirectoryStatus
+grDirectoryStatus = \case
+  GRSActive -> DSListed
+  GRSSuspended -> DSReserved
+  GRSSuspendedBadRoles -> DSReserved
+  _ -> DSRegistered
+
+addGroupReg :: DirectoryStore -> Contact -> GroupInfo -> GroupRegStatus -> IO UserGroupRegId
 addGroupReg st ct GroupInfo {groupId} grStatus = do
-  dbOwnerMemberId <- newTVar Nothing
-  groupRegStatus <- newTVar grStatus
-  let gr = GroupReg {userGroupRegId = 1, dbGroupId = groupId, dbContactId = ctId, dbOwnerMemberId, groupRegStatus}
-  stateTVar (groupRegs st) $ \grs ->
-    let ugrId = 1 + foldl' maxUgrId 0 grs
-     in (ugrId, gr {userGroupRegId = ugrId} : grs)
+  grData <- atomically addGroupReg_
+  logGCreate st grData
+  pure $ userGroupRegId_ grData
   where
+    addGroupReg_ = do
+      let grData = GroupRegData {dbGroupId_ = groupId, userGroupRegId_ = 1, dbContactId_ = ctId, dbOwnerMemberId_ = Nothing, groupRegStatus_ = grStatus}
+      gr <- dataToGroupReg grData
+      stateTVar (groupRegs st) $ \grs ->
+        let ugrId = 1 + foldl' maxUgrId 0 grs
+            grData' = grData {userGroupRegId_ = ugrId}
+            gr' = gr {userGroupRegId = ugrId}
+        in (grData', gr' : grs)
     ctId = contactId' ct
     maxUgrId mx GroupReg {dbContactId, userGroupRegId}
       | dbContactId == ctId && userGroupRegId > mx = userGroupRegId
       | otherwise = mx
 
+setGroupStatus :: DirectoryStore -> GroupReg -> GroupRegStatus -> IO ()
+setGroupStatus st gr grStatus = do
+  logGUpdateStatus st (dbGroupId gr) grStatus
+  atomically $ do
+    writeTVar (groupRegStatus gr) grStatus
+    updateListing st $ dbGroupId gr
+  where
+    updateListing = case grDirectoryStatus grStatus of
+      DSListed -> listGroup
+      DSReserved -> reserveGroup
+      DSRegistered -> unlistGroup
+
+setGroupRegOwner :: DirectoryStore -> GroupReg -> GroupMember -> IO ()
+setGroupRegOwner st gr owner = do
+  let memberId = groupMemberId' owner
+  logGUpdateOwner st (dbGroupId gr) memberId
+  atomically $ writeTVar (dbOwnerMemberId gr) (Just memberId)
+
 getGroupReg :: DirectoryStore -> GroupId -> STM (Maybe GroupReg)
 getGroupReg st gId = find ((gId ==) . dbGroupId) <$> readTVar (groupRegs st)
 
@@ -96,28 +166,163 @@ unlistGroup st gId = do
   modifyTVar' (reservedGroups st) $ S.delete gId
 
 data DirectoryLogRecord
-  = CreateGroupReg GroupReg
-  | UpdateGroupRegStatus GroupId GroupRegStatus
+  = GRCreate GroupRegData
+  | GRUpdateStatus GroupId GroupRegStatus
+  | GRUpdateOwner GroupId GroupMemberId
 
-getDirectoryStore :: FilePath -> IO DirectoryStore
-getDirectoryStore path = do
-  groupRegs <- readDirectoryState path
-  st <- atomically newDirectoryStore
-  atomically $ mapM_ (add st) groupRegs
-  pure st
+data DLRTag = GRCreate_ | GRUpdateStatus_ | GRUpdateOwner_
+
+logDLR :: DirectoryStore -> DirectoryLogRecord -> IO ()
+logDLR st r = forM_ (directoryLogFile st) $ \h -> B.hPutStrLn h (strEncode r)
+
+logGCreate :: DirectoryStore -> GroupRegData -> IO ()
+logGCreate st = logDLR st . GRCreate
+
+logGUpdateStatus :: DirectoryStore -> GroupId -> GroupRegStatus -> IO ()
+logGUpdateStatus st = logDLR st .: GRUpdateStatus
+
+logGUpdateOwner :: DirectoryStore -> GroupId -> GroupMemberId -> IO ()
+logGUpdateOwner st = logDLR st .: GRUpdateOwner
+
+instance StrEncoding DLRTag where
+  strEncode = \case
+    GRCreate_ -> "GCREATE"
+    GRUpdateStatus_ -> "GSTATUS"
+    GRUpdateOwner_ -> "GOWNER"
+  strP =
+    A.takeTill (== ' ') >>= \case
+      "GCREATE" -> pure GRCreate_
+      "GSTATUS" -> pure GRUpdateStatus_
+      "GOWNER" -> pure GRUpdateOwner_
+      _ -> fail "invalid DLRTag"
+
+instance StrEncoding DirectoryLogRecord where
+  strEncode = \case
+    GRCreate gr -> strEncode (GRCreate_, gr)
+    GRUpdateStatus gId grStatus -> strEncode (GRUpdateStatus_, gId, grStatus)
+    GRUpdateOwner gId grOwnerId -> strEncode (GRUpdateOwner_, gId, grOwnerId)
+  strP =
+    strP >>= \case
+      GRCreate_ -> GRCreate <$> (A.space *> strP)
+      GRUpdateStatus_ -> GRUpdateStatus <$> (A.space *> A.decimal) <*> (A.space *> strP)
+      GRUpdateOwner_ -> GRUpdateOwner <$> (A.space *> A.decimal) <*> (A.space *> A.decimal)
+
+instance StrEncoding GroupRegData where
+  strEncode GroupRegData {dbGroupId_, userGroupRegId_, dbContactId_, dbOwnerMemberId_, groupRegStatus_} =
+    B.unwords
+      [ "group_id=" <> strEncode dbGroupId_,
+        "user_group_id=" <> strEncode userGroupRegId_,
+        "contact_id=" <> strEncode dbContactId_,
+        "owner_member_id=" <> strEncode dbOwnerMemberId_,
+        "status=" <> strEncode groupRegStatus_
+      ]
+  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_}
+
+instance StrEncoding GroupRegStatus where
+  strEncode = \case
+    GRSPendingConfirmation -> "pending_confirmation"
+    GRSProposed -> "proposed"
+    GRSPendingUpdate -> "pending_update"
+    GRSPendingApproval gaId -> "pending_approval:" <> strEncode gaId
+    GRSActive -> "active"
+    GRSSuspended -> "suspended"
+    GRSSuspendedBadRoles -> "suspended_bad_roles"
+    GRSRemoved -> "removed"
+  strP =
+    A.takeTill (\c -> c == ' ' || c == ':') >>= \case
+      "pending_confirmation" -> pure GRSPendingConfirmation
+      "proposed" -> pure GRSProposed
+      "pending_update" -> pure GRSPendingUpdate
+      "pending_approval" -> GRSPendingApproval <$> (A.char ':' *> A.decimal)
+      "active" -> pure GRSActive
+      "suspended" -> pure GRSSuspended
+      "suspended_bad_roles" -> pure GRSSuspendedBadRoles
+      "removed" -> pure GRSRemoved
+      _ -> fail "invalid GroupRegStatus"
+
+dataToGroupReg :: GroupRegData -> STM GroupReg
+dataToGroupReg GroupRegData {dbGroupId_, userGroupRegId_, dbContactId_, dbOwnerMemberId_, groupRegStatus_} = do
+  dbOwnerMemberId <- newTVar dbOwnerMemberId_
+  groupRegStatus <- newTVar groupRegStatus_
+  pure
+    GroupReg
+      { dbGroupId = dbGroupId_,
+        userGroupRegId = userGroupRegId_,
+        dbContactId = dbContactId_,
+        dbOwnerMemberId,
+        groupRegStatus
+      }
+
+restoreDirectoryStore :: Maybe FilePath -> IO DirectoryStore
+restoreDirectoryStore = \case
+  Just f -> ifM (doesFileExist f) (restore f) (newFile f >>= new . Just)
+  Nothing -> new Nothing
   where
-    add :: DirectoryStore -> GroupReg -> STM ()
-    add st gr = modifyTVar' (groupRegs st) (gr :) -- TODO set listedGroups
+    new = atomically . newDirectoryStore
+    newFile f = do
+      h <- openFile f WriteMode
+      hSetBuffering h LineBuffering
+      pure h
+    restore f = do
+      grs <- readDirectoryData f
+      renameFile f (f <> ".bak")
+      h <- writeDirectoryData f grs -- compact
+      atomically $ mkDirectoryStore h grs
 
-newDirectoryStore :: STM DirectoryStore
-newDirectoryStore = do
-  groupRegs <- newTVar []
-  listedGroups <- newTVar mempty
-  reservedGroups <- newTVar mempty
-  pure DirectoryStore {groupRegs, listedGroups, reservedGroups}
+emptyStoreData :: ([GroupReg], Set GroupId, Set GroupId)
+emptyStoreData = ([], S.empty, S.empty)
 
-readDirectoryState :: FilePath -> IO [GroupReg]
-readDirectoryState _ = pure []
+newDirectoryStore :: Maybe Handle -> STM DirectoryStore
+newDirectoryStore = (`mkDirectoryStore_` emptyStoreData)
 
-writeDirectoryState :: FilePath -> [GroupReg] -> IO ()
-writeDirectoryState _ _ = pure ()
+mkDirectoryStore :: Handle -> [GroupRegData] -> STM DirectoryStore
+mkDirectoryStore h groups =
+  foldM addGroupRegData emptyStoreData groups >>= mkDirectoryStore_ (Just h)
+  where
+    addGroupRegData (!grs, !listed, !reserved) gr@GroupRegData {dbGroupId_ = gId} = do
+      gr' <- dataToGroupReg gr
+      let grs' = gr' : grs
+      pure $ case grDirectoryStatus $ groupRegStatus_ gr of
+        DSListed -> (grs', S.insert gId listed, reserved)
+        DSReserved -> (grs', listed, S.insert gId reserved)
+        DSRegistered -> (grs', listed, reserved)
+
+mkDirectoryStore_ :: Maybe Handle -> ([GroupReg], Set GroupId, Set GroupId) -> STM DirectoryStore
+mkDirectoryStore_ h (grs, listed, reserved) = do
+  groupRegs <- newTVar grs
+  listedGroups <- newTVar listed
+  reservedGroups <- newTVar reserved
+  pure DirectoryStore {groupRegs, listedGroups, reservedGroups, directoryLogFile = h}
+
+readDirectoryData :: FilePath -> IO [GroupRegData]
+readDirectoryData f =
+  sortOn dbGroupId_ . M.elems
+    <$> (foldM processDLR M.empty . B.lines =<< B.readFile f)
+  where
+    processDLR :: Map GroupId GroupRegData -> ByteString -> IO (Map GroupId GroupRegData)
+    processDLR m l = case strDecode l of
+      Left e -> m <$ putStrLn ("Error parsing log record: " <> e <> ", " <> B.unpack (B.take 80 l))
+      Right r -> case r of
+        GRCreate gr@GroupRegData {dbGroupId_ = gId} -> do
+          when (isJust $ M.lookup gId m) $
+            putStrLn $ "Warning: duplicate group with ID " <> show gId <> ", group replaced."
+          pure $ M.insert gId gr m
+        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.")
+        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.")
+
+writeDirectoryData :: FilePath -> [GroupRegData] -> IO Handle
+writeDirectoryData f grs = do
+  h <- openFile f WriteMode
+  hSetBuffering h LineBuffering
+  forM_ grs $ B.hPutStrLn h . strEncode . GRCreate
+  pure h
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index cdb15a46d0..7eacbe378c 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -4847,13 +4847,13 @@ createInternalChatItem user cd content itemTs_ = do
   ci <- liftIO $ mkChatItem cd ciId content Nothing Nothing Nothing Nothing False itemTs createdAt
   toView $ CRNewChatItem user (AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci)
 
-getCreateActiveUser :: SQLiteStore -> IO User
-getCreateActiveUser st = do
+getCreateActiveUser :: SQLiteStore -> Bool -> IO User
+getCreateActiveUser st testView = do
   user <-
     withTransaction st getUsers >>= \case
       [] -> newUser
       users -> maybe (selectUser users) pure (find activeUser users)
-  putStrLn $ "Current user: " <> userStr user
+  unless testView $ putStrLn $ "Current user: " <> userStr user
   pure user
   where
     newUser :: IO User
diff --git a/src/Simplex/Chat/Bot.hs b/src/Simplex/Chat/Bot.hs
index 34e752ec21..234963b44c 100644
--- a/src/Simplex/Chat/Bot.hs
+++ b/src/Simplex/Chat/Bot.hs
@@ -38,18 +38,21 @@ chatBotRepl welcome answer _user cc = do
     contactConnected Contact {localDisplayName} = putStrLn $ T.unpack localDisplayName <> " connected"
 
 initializeBotAddress :: ChatController -> IO ()
-initializeBotAddress cc = do
+initializeBotAddress = initializeBotAddress' True
+
+initializeBotAddress' :: Bool -> ChatController -> IO ()
+initializeBotAddress' logAddress cc = do
   sendChatCmd cc ShowMyAddress >>= \case
     CRUserContactLink _ UserContactLink {connReqContact} -> showBotAddress connReqContact
     CRChatCmdError _ (ChatErrorStore SEUserContactLinkNotFound) -> do
-      putStrLn "No bot address, creating..."
+      when logAddress $ putStrLn "No bot address, creating..."
       sendChatCmd cc CreateMyAddress >>= \case
         CRUserContactLinkCreated _ uri -> showBotAddress uri
         _ -> putStrLn "can't create bot address" >> exitFailure
     _ -> putStrLn "unexpected response" >> exitFailure
   where
     showBotAddress uri = do
-      putStrLn $ "Bot's contact address is: " <> B.unpack (strEncode uri)
+      when logAddress $ putStrLn $ "Bot's contact address is: " <> B.unpack (strEncode uri)
       void $ sendChatCmd cc $ AddressAutoAccept $ Just AutoAccept {acceptIncognito = False, autoReply = Nothing}
 
 sendMessage :: ChatController -> Contact -> String -> IO ()
diff --git a/src/Simplex/Chat/Core.hs b/src/Simplex/Chat/Core.hs
index 2ec6ddb7f9..4af161ab41 100644
--- a/src/Simplex/Chat/Core.hs
+++ b/src/Simplex/Chat/Core.hs
@@ -15,7 +15,7 @@ import System.Exit (exitFailure)
 import UnliftIO.Async
 
 simplexChatCore :: ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> (User -> ChatController -> IO ()) -> IO ()
-simplexChatCore cfg@ChatConfig {confirmMigrations} opts@ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, dbKey, logAgent}} sendToast chat =
+simplexChatCore cfg@ChatConfig {confirmMigrations, testView} opts@ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, dbKey, logAgent}} sendToast chat =
   case logAgent of
     Just level -> do
       setLogLevel level
@@ -27,7 +27,7 @@ simplexChatCore cfg@ChatConfig {confirmMigrations} opts@ChatOpts {coreOptions =
       putStrLn $ "Error opening database: " <> show e
       exitFailure
     run db@ChatDatabase {chatStore} = do
-      u <- getCreateActiveUser chatStore
+      u <- getCreateActiveUser chatStore testView
       cc <- newChatController db (Just u) cfg opts sendToast
       runSimplexChat opts u cc chat
 
diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs
index f1a5676bec..e074587ad5 100644
--- a/tests/Bots/DirectoryTests.hs
+++ b/tests/Bots/DirectoryTests.hs
@@ -9,6 +9,7 @@ import ChatClient
 import ChatTests.Utils
 import Control.Concurrent (forkIO, killThread, threadDelay)
 import Control.Exception (finally)
+import Control.Monad (forM_)
 import Directory.Options
 import Directory.Service
 import Directory.Store
@@ -18,6 +19,7 @@ import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts (..))
 import Simplex.Chat.Types (GroupMemberRole (..), Profile (..))
 import System.FilePath ((</>))
 import Test.Hspec
+import GHC.IO.Handle (hClose)
 
 directoryServiceTests :: SpecWith FilePath
 directoryServiceTests = do
@@ -47,6 +49,8 @@ directoryServiceTests = do
     it "should prohibit approval if a duplicate group is listed" testDuplicateProhibitApproval
   describe "list groups" $ do
     it "should list user's groups" testListUserGroups
+  describe "store log" $ do
+    it "should restore directory service state" testRestoreDirectory
 
 directoryProfile :: Profile
 directoryProfile = Profile {displayName = "SimpleX-Directory", fullName = "", image = Nothing, contactLink = Nothing, preferences = Nothing}
@@ -56,8 +60,9 @@ mkDirectoryOpts tmp superUsers =
   DirectoryOpts
     { coreOptions = (coreOptions (testOpts :: ChatOpts)) {dbFilePrefix = tmp </> serviceDbPrefix},
       superUsers,
-      directoryLog = tmp </> "directory_service.log",
-      serviceName = "SimpleX-Directory"
+      directoryLog = Just $ tmp </> "directory_service.log",
+      serviceName = "SimpleX-Directory",
+      testing = True
     }
 
 serviceDbPrefix :: FilePath
@@ -591,19 +596,6 @@ testListUserGroups tmp =
         cath <## "use @SimpleX-Directory <message> to send messages"
         registerGroupId superUser bob "security" "Security" 2 2
         registerGroupId superUser cath "anonymity" "Anonymity" 3 1
-        bob #> "@SimpleX-Directory /list"
-        bob <# "SimpleX-Directory> > /list"
-        bob <## "      2 registered group(s)"
-        bob <# "SimpleX-Directory> 1. privacy (Privacy)"
-        bob <## "Welcome message:"
-        bob <##. "Link to join the group privacy: "
-        bob <## "3 members"
-        bob <## "Status: active"
-        bob <# "SimpleX-Directory> 2. security (Security)"
-        bob <## "Welcome message:"
-        bob <##. "Link to join the group security: "
-        bob <## "2 members"
-        bob <## "Status: active"
         cath #> "@SimpleX-Directory /list"
         cath <# "SimpleX-Directory> > /list"
         cath <## "      1 registered group(s)"
@@ -621,46 +613,85 @@ testListUserGroups tmp =
         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)."
         groupNotFound cath "anonymity"
-        cath #> "@SimpleX-Directory /list"
-        cath <# "SimpleX-Directory> > /list"
-        cath <## "      1 registered group(s)"
-        cath <# "SimpleX-Directory> 1. anonymity (Anonymity)"
-        cath <## "Welcome message:"
-        cath <##. "Link to join the group anonymity: "
-        cath <## "2 members"
-        cath <## "Status: suspended because roles changed"
-        -- superuser lists all groups
-        superUser #> "@SimpleX-Directory /last"
-        superUser <# "SimpleX-Directory> > /last"
-        superUser <## "      3 registered group(s)"
-        superUser <# "SimpleX-Directory> 1. privacy (Privacy)"
-        superUser <## "Welcome message:"
-        superUser <##. "Link to join the group privacy: "
-        superUser <## "Owner: bob"
-        superUser <## "3 members"
-        superUser <## "Status: active"
-        superUser <# "SimpleX-Directory> 2. security (Security)"
-        superUser <## "Welcome message:"
-        superUser <##. "Link to join the group security: "
-        superUser <## "Owner: bob"
-        superUser <## "2 members"
-        superUser <## "Status: active"
-        superUser <# "SimpleX-Directory> 3. anonymity (Anonymity)"
-        superUser <## "Welcome message:"
-        superUser <##. "Link to join the group anonymity: "
-        superUser <## "Owner: cath"
-        superUser <## "2 members"
-        superUser <## "Status: suspended because roles changed"
-        -- showing last 1 group
-        superUser #> "@SimpleX-Directory /last 1"
-        superUser <# "SimpleX-Directory> > /last 1"
-        superUser <## "      3 registered group(s), showing the last 1"
-        superUser <# "SimpleX-Directory> 3. anonymity (Anonymity)"
-        superUser <## "Welcome message:"
-        superUser <##. "Link to join the group anonymity: "
-        superUser <## "Owner: cath"
-        superUser <## "2 members"
-        superUser <## "Status: suspended because roles changed"
+        listGroups superUser bob cath
+
+testRestoreDirectory :: HasCallStack => FilePath -> IO ()
+testRestoreDirectory tmp = do
+  testListUserGroups tmp
+  restoreDirectoryService tmp 3 3 $ \superUser _dsLink ->
+    withTestChat tmp "bob" $ \bob ->
+      withTestChat tmp "cath" $ \cath -> do
+        bob <## "2 contacts connected (use /cs for the list)"
+        bob <###
+          [ "#privacy (Privacy): connected to server(s)",
+            "#security (Security): connected to server(s)"
+          ] 
+        cath <## "2 contacts connected (use /cs for the list)"
+        cath <###
+          [ "#privacy (Privacy): connected to server(s)",
+            "#anonymity (Anonymity): connected to server(s)"
+          ]
+        listGroups superUser bob cath
+        groupFoundN 3 bob "privacy"
+        groupFound bob "security"
+        groupFoundN 3 cath "privacy"
+        groupFound cath "security"
+
+listGroups :: HasCallStack => TestCC -> TestCC -> TestCC -> IO ()
+listGroups superUser bob cath = do
+  bob #> "@SimpleX-Directory /list"
+  bob <# "SimpleX-Directory> > /list"
+  bob <## "      2 registered group(s)"
+  bob <# "SimpleX-Directory> 1. privacy (Privacy)"
+  bob <## "Welcome message:"
+  bob <##. "Link to join the group privacy: "
+  bob <## "3 members"
+  bob <## "Status: active"
+  bob <# "SimpleX-Directory> 2. security (Security)"
+  bob <## "Welcome message:"
+  bob <##. "Link to join the group security: "
+  bob <## "2 members"
+  bob <## "Status: active"
+  cath #> "@SimpleX-Directory /list"
+  cath <# "SimpleX-Directory> > /list"
+  cath <## "      1 registered group(s)"
+  cath <# "SimpleX-Directory> 1. anonymity (Anonymity)"
+  cath <## "Welcome message:"
+  cath <##. "Link to join the group anonymity: "
+  cath <## "2 members"
+  cath <## "Status: suspended because roles changed"
+  -- superuser lists all groups
+  superUser #> "@SimpleX-Directory /last"
+  superUser <# "SimpleX-Directory> > /last"
+  superUser <## "      3 registered group(s)"
+  superUser <# "SimpleX-Directory> 1. privacy (Privacy)"
+  superUser <## "Welcome message:"
+  superUser <##. "Link to join the group privacy: "
+  superUser <## "Owner: bob"
+  superUser <## "3 members"
+  superUser <## "Status: active"
+  superUser <# "SimpleX-Directory> 2. security (Security)"
+  superUser <## "Welcome message:"
+  superUser <##. "Link to join the group security: "
+  superUser <## "Owner: bob"
+  superUser <## "2 members"
+  superUser <## "Status: active"
+  superUser <# "SimpleX-Directory> 3. anonymity (Anonymity)"
+  superUser <## "Welcome message:"
+  superUser <##. "Link to join the group anonymity: "
+  superUser <## "Owner: cath"
+  superUser <## "2 members"
+  superUser <## "Status: suspended because roles changed"
+  -- showing last 1 group
+  superUser #> "@SimpleX-Directory /last 1"
+  superUser <# "SimpleX-Directory> > /last 1"
+  superUser <## "      3 registered group(s), showing the last 1"
+  superUser <# "SimpleX-Directory> 3. anonymity (Anonymity)"
+  superUser <## "Welcome message:"
+  superUser <##. "Link to join the group anonymity: "
+  superUser <## "Owner: cath"
+  superUser <## "2 members"
+  superUser <## "Status: suspended because roles changed"
 
 reapproveGroup :: HasCallStack => TestCC -> TestCC -> IO ()
 reapproveGroup superUser bob = do
@@ -691,20 +722,38 @@ withDirectoryService tmp test = do
         connectUsers ds superUser
         ds ##> "/ad"
         getContactLink ds True
+  withDirectory tmp dsLink test
+
+restoreDirectoryService :: HasCallStack => FilePath -> Int -> Int -> (TestCC -> String -> IO ()) -> IO ()
+restoreDirectoryService tmp ctCount grCount test = do
+  dsLink <-
+    withTestChat tmp serviceDbPrefix $ \ds -> do
+      ds <## (show ctCount <> " contacts connected (use /cs for the list)")
+      ds <## "Your address is active! To show: /sa"
+      ds <## (show grCount <> " group links active")
+      forM_ [1..grCount] $ \_ -> ds <##. "#"
+      ds ##> "/sa"
+      dsLink <- getContactLink ds False
+      ds <## "auto_accept on"
+      pure dsLink
+  withDirectory tmp dsLink test
+
+withDirectory :: HasCallStack => FilePath -> String -> (TestCC -> String -> IO ()) -> IO ()
+withDirectory tmp dsLink test = do
   let opts = mkDirectoryOpts tmp [KnownContact 2 "alice"]
-  withDirectory opts $
+  runDirectory opts $
     withTestChat tmp "super_user" $ \superUser -> do
       superUser <## "1 contacts connected (use /cs for the list)"
       test superUser dsLink
+
+runDirectory :: DirectoryOpts -> IO () -> IO ()
+runDirectory opts@DirectoryOpts {directoryLog} action = do
+  st <- restoreDirectoryStore directoryLog
+  t <- forkIO $ bot st
+  threadDelay 500000
+  action `finally` (mapM_ hClose (directoryLogFile st) >> killThread t)
   where
-    withDirectory :: DirectoryOpts -> IO () -> IO ()
-    withDirectory opts@DirectoryOpts {directoryLog} action = do
-      st <- getDirectoryStore directoryLog
-      t <- forkIO $ bot st
-      threadDelay 500000
-      action `finally` killThread t
-      where
-        bot st = simplexChatCore testCfg (mkChatOpts opts) Nothing $ directoryService st opts
+    bot st = simplexChatCore testCfg (mkChatOpts opts) Nothing $ directoryService st opts
 
 registerGroup :: TestCC -> TestCC -> String -> String -> IO ()
 registerGroup su u n fn = registerGroupId su u n fn 1 1