core: member acceptance (#5678)

* core: member acceptance

* migration

* move hook

* core: support sending direct messages to members (#5680)

* fix compilation, todos

* fix test

* predicates

* comment

* extend hook

* wip

* wip

* wip

* wip

* fix test

* mute output

* schema

* better query

* plans

* fix test

* directory

* captcha

* captcha works

* remove column, add UI types and group status icon

* fix test

* query plans

* exclude messages of pending members from history

* commands for filter settings

* core: separately delete pending approval members; other apis validation (#5699)

* accepted status

* send captcha messages as replies

* fix blocked words

* simpler filter info

* info about /filter and /role after group registration

* update query plans

---------

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

apps/ios/Shared/Views/ChatList/ChatPreviewView.swift

@@ -154,7 +154,7 @@ struct ChatPreviewView: View {
         }
     }
 
-    @ViewBuilder private func inactiveIcon() -> some View {
+    private func inactiveIcon() -> some View {
         Image(systemName: "multiply.circle.fill")
             .foregroundColor(.secondary.opacity(0.65))
             .background(Circle().foregroundColor(Color(uiColor: .systemBackground)))

apps/ios/SimpleXChat/ChatTypes.swift

@@ -2147,6 +2147,7 @@ public struct GroupMember: Identifiable, Decodable, Hashable {
         case .memGroupDeleted: return false
         case .memUnknown: return false
         case .memInvited: return false
+        case .memPendingApproval: return true
         case .memIntroduced: return false
         case .memIntroInvited: return false
         case .memAccepted: return false
@@ -2165,6 +2166,7 @@ public struct GroupMember: Identifiable, Decodable, Hashable {
         case .memGroupDeleted: return false
         case .memUnknown: return false
         case .memInvited: return false
+        case .memPendingApproval: return false
         case .memIntroduced: return true
         case .memIntroInvited: return true
         case .memAccepted: return true
@@ -2296,6 +2298,7 @@ public enum GroupMemberStatus: String, Decodable, Hashable {
     case memGroupDeleted = "deleted"
     case memUnknown = "unknown"
     case memInvited = "invited"
+    case memPendingApproval = "pending_approval"
     case memIntroduced = "introduced"
     case memIntroInvited = "intro-inv"
     case memAccepted = "accepted"
@@ -2312,6 +2315,7 @@ public enum GroupMemberStatus: String, Decodable, Hashable {
         case .memGroupDeleted: return "group deleted"
         case .memUnknown: return "unknown status"
         case .memInvited: return "invited"
+        case .memPendingApproval: return "pending approval"
         case .memIntroduced: return "connecting (introduced)"
         case .memIntroInvited: return "connecting (introduction invitation)"
         case .memAccepted: return "connecting (accepted)"
@@ -2330,6 +2334,7 @@ public enum GroupMemberStatus: String, Decodable, Hashable {
         case .memGroupDeleted: return "group deleted"
         case .memUnknown: return "unknown"
         case .memInvited: return "invited"
+        case .memPendingApproval: return "pending"
         case .memIntroduced: return "connecting"
         case .memIntroInvited: return "connecting"
         case .memAccepted: return "connecting"

apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/ChatModel.kt

@@ -1917,6 +1917,7 @@ data class GroupMember (
     GroupMemberStatus.MemGroupDeleted -> false
     GroupMemberStatus.MemUnknown -> false
     GroupMemberStatus.MemInvited -> false
+    GroupMemberStatus.MemPendingApproval -> true
     GroupMemberStatus.MemIntroduced -> false
     GroupMemberStatus.MemIntroInvited -> false
     GroupMemberStatus.MemAccepted -> false
@@ -1933,6 +1934,7 @@ data class GroupMember (
     GroupMemberStatus.MemGroupDeleted -> false
     GroupMemberStatus.MemUnknown -> false
     GroupMemberStatus.MemInvited -> false
+    GroupMemberStatus.MemPendingApproval -> false
     GroupMemberStatus.MemIntroduced -> true
     GroupMemberStatus.MemIntroInvited -> true
     GroupMemberStatus.MemAccepted -> true
@@ -2037,6 +2039,7 @@ enum class GroupMemberStatus {
   @SerialName("deleted") MemGroupDeleted,
   @SerialName("unknown") MemUnknown,
   @SerialName("invited") MemInvited,
+  @SerialName("pending_approval") MemPendingApproval,
   @SerialName("introduced") MemIntroduced,
   @SerialName("intro-inv") MemIntroInvited,
   @SerialName("accepted") MemAccepted,
@@ -2052,6 +2055,7 @@ enum class GroupMemberStatus {
     MemGroupDeleted -> generalGetString(MR.strings.group_member_status_group_deleted)
     MemUnknown -> generalGetString(MR.strings.group_member_status_unknown)
     MemInvited -> generalGetString(MR.strings.group_member_status_invited)
+    MemPendingApproval -> generalGetString(MR.strings.group_member_status_pending_approval)
     MemIntroduced -> generalGetString(MR.strings.group_member_status_introduced)
     MemIntroInvited -> generalGetString(MR.strings.group_member_status_intro_invitation)
     MemAccepted -> generalGetString(MR.strings.group_member_status_accepted)
@@ -2068,6 +2072,7 @@ enum class GroupMemberStatus {
     MemGroupDeleted -> generalGetString(MR.strings.group_member_status_group_deleted)
     MemUnknown -> generalGetString(MR.strings.group_member_status_unknown_short)
     MemInvited -> generalGetString(MR.strings.group_member_status_invited)
+    MemPendingApproval -> generalGetString(MR.strings.group_member_status_pending_approval_short)
     MemIntroduced -> generalGetString(MR.strings.group_member_status_connecting)
     MemIntroInvited -> generalGetString(MR.strings.group_member_status_connecting)
     MemAccepted -> generalGetString(MR.strings.group_member_status_connecting)

apps/multiplatform/common/src/commonMain/resources/MR/base/strings.xml

@@ -1632,6 +1632,8 @@
   <string name="group_member_status_group_deleted">group deleted</string>
   <string name="group_member_status_unknown">unknown status</string>
   <string name="group_member_status_invited">invited</string>
+  <string name="group_member_status_pending_approval">pending approval</string>
+  <string name="group_member_status_pending_approval_short">pending</string>
   <string name="group_member_status_introduced">connecting (introduced)</string>
   <string name="group_member_status_intro_invitation">connecting (introduction invitation)</string>
   <string name="group_member_status_accepted">connecting (accepted)</string>

apps/multiplatform/common/src/commonMain/resources/MR/images/ic_help_filled.svg

@@ -0,0 +1 @@
+<svg xmlns="http://www.w3.org/2000/svg" height="24px" viewBox="0 -960 960 960" width="24px" fill="#000000"><path d="M484.41-250.5q15.33 0 25.96-10.54T521-286.91q0-15.33-10.54-25.96t-25.87-10.63q-15.33 0-25.96 10.54T448-287.09q0 15.33 10.54 25.96t25.87 10.63ZM450-394h57q0-25.5 6.75-46.75t39.75-48.75q31-25.5 43.5-50.25T609.5-594q0-52.28-33.49-83.89-33.48-31.61-89.81-31.61-48.32 0-85.18 23.84-36.86 23.84-54.02 66.16l51.61 19q10.89-28 32.89-43 22.01-15 51.5-15 34 0 55 18.5t21 47.5q0 22-12.96 41.2-12.96 19.19-37.77 40.36Q479-486 464.5-459.93 450-433.85 450-394Zm30.06 309q-80.97 0-153.13-31.26-72.15-31.27-125.79-85Q147.5-255 116.25-327.02 85-399.05 85-479.94q0-81.97 31.26-154.13 31.27-72.15 85-125.54Q255-813 327.02-844q72.03-31 152.92-31 81.97 0 154.13 31.13 72.17 31.13 125.55 84.5Q813-706 844-633.98q31 72.03 31 153.92 0 80.97-31.01 153.13-31.02 72.15-84.5 125.79Q706-147.5 633.98-116.25 561.95-85 480.06-85Z"/></svg>

apps/simplex-directory-service/Main.hs

@@ -5,7 +5,9 @@ module Main where
 import Directory.Options
 import Directory.Service
 import Directory.Store
+import Simplex.Chat.Controller (ChatConfig (..), ChatHooks (..), defaultChatHooks)
 import Simplex.Chat.Core
+import Simplex.Chat.Terminal (terminalChatConfig)
 
 main :: IO ()
 main = do
@@ -14,5 +16,6 @@ main = do
   if runCLI
     then directoryServiceCLI st opts
     else do
-      cfg <- directoryChatConfig opts
+      env <- newServiceState opts
-      simplexChatCore cfg (mkChatOpts opts) $ directoryService st opts
+      let cfg = terminalChatConfig {chatHooks = defaultChatHooks {acceptMember = Just $ acceptMemberHook opts env}}
+      simplexChatCore cfg (mkChatOpts opts) $ directoryService st opts env

apps/simplex-directory-service/src/Directory/BlockedWords.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 module Directory.BlockedWords where
 
 import Data.Char (isMark, isPunctuation, isSpace)
@@ -5,28 +8,38 @@ import Data.List (isPrefixOf)
 import Data.Maybe (fromMaybe)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
+import Data.Set (Set)
+import qualified Data.Set as S
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Normalize as TN
 
-containsBlockedWords :: Map Char [Char] -> [String] -> Text -> Bool
+data BlockedWordsConfig = BlockedWordsConfig
-containsBlockedWords spelling blockedWords s =
+  { blockedWords :: Set Text,
-    let normalizedWords = concatMap words $ normalizeText spelling s
+    blockedFragments :: Set Text,
-        -- Fully normalize the entire string (no spaces or punctuation)
+    extensionRules :: [(String, [String])],
-        fullNorm = normalizeText spelling $ T.filter (not . isSpace) s
+    spelling :: Map Char [Char]
-        -- Check if any individual word is a swear word
+  }
-        wordCheck = any (`elem` blockedWords) normalizedWords
-        -- Check if the full string, when normalized, matches a swear word exactly
-        fullCheck = any (\bw -> T.length s <= length bw * 2 && any (bw ==) fullNorm) blockedWords
-        -- Check if the string is a single word (no spaces)
-        isSingleWord = not $ T.any isSpace s
-     in wordCheck || (fullCheck && not isSingleWord)
 
-normalizeText :: Map Char [Char] -> Text -> [String]
+hasBlockedFragments :: BlockedWordsConfig -> Text -> Bool
-normalizeText spelling =
+hasBlockedFragments BlockedWordsConfig {spelling, blockedFragments} s =
-  filter (not . null)
+  any (\w -> any (`T.isInfixOf` w) blockedFragments) ws
-    . map (filter (\c -> not (isPunctuation c) && not (isMark c)))
+  where
-    . allSubstitutions spelling
+    ws = S.fromList $ filter (not . T.null) $ normalizeText spelling s
+
+hasBlockedWords :: BlockedWordsConfig -> Text -> Bool
+hasBlockedWords BlockedWordsConfig {spelling, blockedWords} s =
+  not $ ws1 `S.disjoint` blockedWords && (length ws <= 1 || ws2 `S.disjoint` blockedWords)
+  where
+    ws = T.words s
+    ws1 = normalizeWords ws
+    ws2 = normalizeWords $ T.splitOn "  " s
+    normalizeWords = S.fromList . filter (not . T.null) . concatMap (normalizeText spelling)
+
+normalizeText :: Map Char [Char] -> Text -> [Text]
+normalizeText spelling' =
+  map (T.pack . filter (\c -> not $ isSpace c || isPunctuation c || isMark c))
+    . allSubstitutions spelling'
     . removeTriples
     . T.unpack
     . T.toLower
@@ -44,12 +57,12 @@ removeTriples xs = go xs '\0' False
 
 -- Generate all possible strings by substituting each character
 allSubstitutions :: Map Char [Char] -> String -> [String]
-allSubstitutions spelling = sequence . map substs
+allSubstitutions spelling' = sequence . map substs
   where
-    substs c = fromMaybe [c] $ M.lookup c spelling
+    substs c = fromMaybe [c] $ M.lookup c spelling'
 
-wordVariants :: [(String, [String])] -> String -> [String]
+wordVariants :: [(String, [String])] -> String -> [Text]
-wordVariants [] s = [s]
+wordVariants [] s = [T.pack s]
 wordVariants (sub : subs) s = concatMap (wordVariants subs) (replace sub)
   where
     replace (pat, tos) = go s

apps/simplex-directory-service/src/Directory/Events.hs

@@ -19,7 +19,7 @@ module Directory.Events
   )
 where
 
-import Control.Applicative ((<|>))
+import Control.Applicative (optional, (<|>))
 import Data.Attoparsec.Text (Parser)
 import qualified Data.Attoparsec.Text as A
 import Data.Char (isSpace)
@@ -46,6 +46,8 @@ data DirectoryEvent
   | DEGroupInvitation {contact :: Contact, groupInfo :: GroupInfo, fromMemberRole :: GroupMemberRole, memberRole :: GroupMemberRole}
   | DEServiceJoinedGroup {contactId :: ContactId, groupInfo :: GroupInfo, hostMember :: GroupMember}
   | DEGroupUpdated {contactId :: ContactId, fromGroup :: GroupInfo, toGroup :: GroupInfo}
+  | DEPendingMember GroupInfo GroupMember
+  | DEPendingMemberMsg GroupInfo GroupMember ChatItemId Text
   | DEContactRoleChanged GroupInfo ContactId GroupMemberRole -- contactId here is the contact whose role changed
   | DEServiceRoleChanged GroupInfo GroupMemberRole
   | DEContactRemovedFromGroup ContactId GroupInfo
@@ -65,6 +67,12 @@ crDirectoryEvent = \case
   CRReceivedGroupInvitation {contact, groupInfo, fromMemberRole, memberRole} -> Just $ DEGroupInvitation {contact, groupInfo, fromMemberRole, memberRole}
   CRUserJoinedGroup {groupInfo, hostMember} -> (\contactId -> DEServiceJoinedGroup {contactId, groupInfo, hostMember}) <$> memberContactId hostMember
   CRGroupUpdated {fromGroup, toGroup, member_} -> (\contactId -> DEGroupUpdated {contactId, fromGroup, toGroup}) <$> (memberContactId =<< member_)
+  CRJoinedGroupMember {groupInfo, member = m}
+    | pending m -> Just $ DEPendingMember groupInfo m
+    | otherwise -> Nothing
+  CRNewChatItems {chatItems = AChatItem _ _ (GroupChat g) ci : _} -> case ci of
+    ChatItem {chatDir = CIGroupRcv m, content = CIRcvMsgContent (MCText t)} | pending m -> Just $ DEPendingMemberMsg g m (chatItemId' ci) t
+    _ -> Nothing
   CRMemberRole {groupInfo, member, toRole}
     | groupMemberId' member == groupMemberId' (membership groupInfo) -> Just $ DEServiceRoleChanged groupInfo toRole
     | otherwise -> (\ctId -> DEContactRoleChanged groupInfo ctId toRole) <$> memberContactId member
@@ -89,6 +97,8 @@ crDirectoryEvent = \case
     _ -> Just $ DELogChatResponse $ "chat error: " <> tshow chatError
   CRChatErrors {chatErrors} -> Just $ DELogChatResponse $ "chat errors: " <> T.intercalate ", " (map tshow chatErrors)
   _ -> Nothing
+  where
+    pending m = memberStatus m == GSMemPendingApproval
 
 data DirectoryRole = DRUser | DRAdmin | DRSuperUser
 
@@ -108,7 +118,8 @@ data DirectoryCmdTag (r :: DirectoryRole) where
   DCConfirmDuplicateGroup_ :: DirectoryCmdTag 'DRUser
   DCListUserGroups_ :: DirectoryCmdTag 'DRUser
   DCDeleteGroup_ :: DirectoryCmdTag 'DRUser
-  DCSetRole_ :: DirectoryCmdTag 'DRUser
+  DCMemberRole_ :: DirectoryCmdTag 'DRUser
+  DCGroupFilter_ :: DirectoryCmdTag 'DRUser
   DCApproveGroup_ :: DirectoryCmdTag 'DRAdmin
   DCRejectGroup_ :: DirectoryCmdTag 'DRAdmin
   DCSuspendGroup_ :: DirectoryCmdTag 'DRAdmin
@@ -118,6 +129,8 @@ data DirectoryCmdTag (r :: DirectoryRole) where
   DCShowGroupLink_ :: DirectoryCmdTag 'DRAdmin
   DCSendToGroupOwner_ :: DirectoryCmdTag 'DRAdmin
   DCInviteOwnerToGroup_ :: DirectoryCmdTag 'DRAdmin
+  -- DCAddBlockedWord_ :: DirectoryCmdTag 'DRAdmin
+  -- DCRemoveBlockedWord_ :: DirectoryCmdTag 'DRAdmin
   DCExecuteCommand_ :: DirectoryCmdTag 'DRSuperUser
 
 deriving instance Show (DirectoryCmdTag r)
@@ -134,7 +147,8 @@ data DirectoryCmd (r :: DirectoryRole) where
   DCConfirmDuplicateGroup :: UserGroupRegId -> GroupName -> DirectoryCmd 'DRUser
   DCListUserGroups :: DirectoryCmd 'DRUser
   DCDeleteGroup :: UserGroupRegId -> GroupName -> DirectoryCmd 'DRUser
-  DCSetRole :: GroupId -> GroupName -> GroupMemberRole -> DirectoryCmd 'DRUser
+  DCMemberRole :: UserGroupRegId -> Maybe GroupName -> Maybe GroupMemberRole -> DirectoryCmd 'DRUser
+  DCGroupFilter :: UserGroupRegId -> Maybe GroupName -> Maybe DirectoryMemberAcceptance -> DirectoryCmd 'DRUser
   DCApproveGroup :: {groupId :: GroupId, displayName :: GroupName, groupApprovalId :: GroupApprovalId} -> DirectoryCmd 'DRAdmin
   DCRejectGroup :: GroupId -> GroupName -> DirectoryCmd 'DRAdmin
   DCSuspendGroup :: GroupId -> GroupName -> DirectoryCmd 'DRAdmin
@@ -144,6 +158,8 @@ data DirectoryCmd (r :: DirectoryRole) where
   DCShowGroupLink :: GroupId -> GroupName -> DirectoryCmd 'DRAdmin
   DCSendToGroupOwner :: GroupId -> GroupName -> Text -> DirectoryCmd 'DRAdmin
   DCInviteOwnerToGroup :: GroupId -> GroupName -> DirectoryCmd 'DRAdmin
+  -- DCAddBlockedWord :: Text -> DirectoryCmd 'DRAdmin
+  -- DCRemoveBlockedWord :: Text -> DirectoryCmd 'DRAdmin
   DCExecuteCommand :: String -> DirectoryCmd 'DRSuperUser
   DCUnknownCommand :: DirectoryCmd 'DRUser
   DCCommandError :: DirectoryCmdTag r -> DirectoryCmd r
@@ -175,7 +191,8 @@ directoryCmdP =
         "list" -> u DCListUserGroups_
         "ls" -> u DCListUserGroups_
         "delete" -> u DCDeleteGroup_
-        "role" -> u DCSetRole_
+        "role" -> u DCMemberRole_
+        "filter" -> u DCGroupFilter_
         "approve" -> au DCApproveGroup_
         "reject" -> au DCRejectGroup_
         "suspend" -> au DCSuspendGroup_
@@ -185,6 +202,8 @@ directoryCmdP =
         "link" -> au DCShowGroupLink_
         "owner" -> au DCSendToGroupOwner_
         "invite" -> au DCInviteOwnerToGroup_
+        -- "block_word" -> au DCAddBlockedWord_
+        -- "unblock_word" -> au DCRemoveBlockedWord_
         "exec" -> su DCExecuteCommand_
         "x" -> su DCExecuteCommand_
         _ -> fail "bad command tag"
@@ -202,10 +221,36 @@ directoryCmdP =
       DCConfirmDuplicateGroup_ -> gc DCConfirmDuplicateGroup
       DCListUserGroups_ -> pure DCListUserGroups
       DCDeleteGroup_ -> gc DCDeleteGroup
-      DCSetRole_ -> do
+      DCMemberRole_ -> do
-        (groupId, displayName) <- gc (,)
+        (groupId, displayName_) <- gc_ (,)
-        memberRole <- A.space *> ("member" $> GRMember <|> "observer" $> GRObserver)
+        memberRole_ <- optional $ spacesP *> ("member" $> GRMember <|> "observer" $> GRObserver)
-        pure $ DCSetRole groupId displayName memberRole
+        pure $ DCMemberRole groupId displayName_ memberRole_
+      DCGroupFilter_ -> do
+        (groupId, displayName_) <- gc_ (,)
+        acceptance_ <-
+          (A.takeWhile (== ' ') >> A.endOfInput) $> Nothing
+            <|> Just <$> (acceptancePresetsP <|> acceptanceFiltersP)
+        pure $ DCGroupFilter groupId displayName_ acceptance_
+        where
+          acceptancePresetsP =
+            spacesP
+              *> A.choice
+                [ "no" $> noJoinFilter,
+                  "basic" $> basicJoinFilter,
+                  ("moderate" <|> "mod") $> moderateJoinFilter,
+                  "strong" $> strongJoinFilter
+                ]
+          acceptanceFiltersP = do
+            rejectNames <- filterP "name"
+            passCaptcha <- filterP "captcha"
+            makeObserver <- filterP "observer"
+            pure DirectoryMemberAcceptance {rejectNames, passCaptcha, makeObserver}
+          filterP :: Text -> Parser (Maybe ProfileCondition)
+          filterP s = Just <$> (spacesP *> A.string s *> conditionP) <|> pure Nothing
+          conditionP =
+            "=all" $> PCAll
+              <|> ("=noimage" <|> "=no_image" <|> "=no-image") $> PCNoImage
+              <|> pure PCAll
       DCApproveGroup_ -> do
         (groupId, displayName) <- gc (,)
         groupApprovalId <- A.space *> A.decimal
@@ -221,9 +266,14 @@ directoryCmdP =
         msg <- A.space *> A.takeText
         pure $ DCSendToGroupOwner groupId displayName msg
       DCInviteOwnerToGroup_ -> gc DCInviteOwnerToGroup
-      DCExecuteCommand_ -> DCExecuteCommand . T.unpack <$> (A.space *> A.takeText)
+      -- DCAddBlockedWord_ -> DCAddBlockedWord <$> wordP
+      -- DCRemoveBlockedWord_ -> DCRemoveBlockedWord <$> wordP
+      DCExecuteCommand_ -> DCExecuteCommand . T.unpack <$> (spacesP *> A.takeText)
       where
-        gc f = f <$> (A.space *> A.decimal <* A.char ':') <*> displayNameTextP
+        gc f = f <$> (spacesP *> A.decimal) <*> (A.char ':' *> displayNameTextP)
+        gc_ f = f <$> (spacesP *> A.decimal) <*> optional (A.char ':' *> displayNameTextP)
+        -- wordP = spacesP *> A.takeTill (== ' ')
+        spacesP = A.takeWhile1 (== ' ')
 
 viewName :: Text -> Text
 viewName n = if T.any (== ' ') n then "'" <> n <> "'" else n
@@ -240,7 +290,8 @@ directoryCmdTag = \case
   DCListUserGroups -> "list" 
   DCDeleteGroup {} -> "delete"
   DCApproveGroup {} -> "approve"
-  DCSetRole {} -> "role"
+  DCMemberRole {} -> "role"
+  DCGroupFilter {} -> "filter"
   DCRejectGroup {} -> "reject"
   DCSuspendGroup {} -> "suspend"
   DCResumeGroup {} -> "resume"
@@ -249,6 +300,8 @@ directoryCmdTag = \case
   DCShowGroupLink {} -> "link"
   DCSendToGroupOwner {} -> "owner"
   DCInviteOwnerToGroup {} -> "invite"
+  -- DCAddBlockedWord _ -> "block_word"
+  -- DCRemoveBlockedWord _ -> "unblock_word"
   DCExecuteCommand _ -> "exec"
   DCUnknownCommand -> "unknown"
   DCCommandError _ -> "error"

apps/simplex-directory-service/src/Directory/Options.hs

@@ -13,10 +13,9 @@ module Directory.Options
 where
 
 import qualified Data.Text as T
-import Data.Text.Encoding (encodeUtf8)
 import Options.Applicative
 import Simplex.Chat.Bot.KnownContacts
-import Simplex.Chat.Controller (AcceptAsObserver (..), updateStr, versionNumber, versionString)
+import Simplex.Chat.Controller (updateStr, versionNumber, versionString)
 import Simplex.Chat.Options (ChatCmdLog (..), ChatOpts (..), CoreChatOpts, coreChatOptsP)
 
 data DirectoryOpts = DirectoryOpts
@@ -25,10 +24,11 @@ data DirectoryOpts = DirectoryOpts
     superUsers :: [KnownContact],
     ownersGroup :: Maybe KnownGroup,
     blockedWordsFile :: Maybe FilePath,
+    blockedFragmentsFile :: Maybe FilePath,
     blockedExtensionRules :: Maybe FilePath,
     nameSpellingFile :: Maybe FilePath,
     profileNameLimit :: Int,
-    acceptAsObserver :: Maybe AcceptAsObserver,
+    captchaGenerator :: Maybe FilePath,
     directoryLog :: Maybe FilePath,
     serviceName :: T.Text,
     runCLI :: Bool,
@@ -67,7 +67,14 @@ directoryOpts appDir defaultDbName = do
       strOption
         ( long "blocked-words-file"
             <> metavar "BLOCKED_WORDS_FILE"
-            <> help "File with the basic forms of words not allowed in profiles and groups"
+            <> help "File with the basic forms of words not allowed in profiles"
+        )
+  blockedFragmentsFile <-
+    optional $
+      strOption
+        ( long "blocked-fragments-file"
+            <> metavar "BLOCKED_WORDS_FILE"
+            <> help "File with the basic forms of word fragments not allowed in profiles"
         )
   blockedExtensionRules <-
     optional $
@@ -91,13 +98,12 @@ directoryOpts appDir defaultDbName = do
           <> help "Max length of profile name that will be allowed to connect and to join groups"
           <> value maxBound
       )
-  acceptAsObserver <-
+  captchaGenerator <-
     optional $
-      option
+      strOption
-        parseAcceptAsObserver
+        ( long "captcha-generator"
-        ( long "accept-as-observer"
+            <> metavar "CAPTCHA_GENERATOR"
-            <> metavar "ACCEPT_AS_OBSERVER"
+            <> help "Executable to generate captcha files, must accept text as parameter and save file to stdout as base64 up to 12500 bytes"
-            <> help "Whether to accept all or some of the joining members without posting rights ('all', 'no-image', 'incognito')"
         )
   directoryLog <-
     Just
@@ -125,10 +131,11 @@ directoryOpts appDir defaultDbName = do
         superUsers,
         ownersGroup,
         blockedWordsFile,
+        blockedFragmentsFile,
         blockedExtensionRules,
         nameSpellingFile,
         profileNameLimit,
-        acceptAsObserver,
+        captchaGenerator,
         directoryLog,
         serviceName = T.pack serviceName,
         runCLI,
@@ -165,12 +172,3 @@ mkChatOpts DirectoryOpts {coreOptions} =
       markRead = False,
       maintenance = False
     }
-
-parseAcceptAsObserver :: ReadM AcceptAsObserver
-parseAcceptAsObserver = eitherReader $ decodeAAO . encodeUtf8 . T.pack
-  where
-    decodeAAO = \case
-      "all" -> Right AOAll
-      "name-only" -> Right AONameOnly
-      "incognito" -> Right AOIncognito
-      _ -> Left "bad AcceptAsObserver"

apps/simplex-directory-service/src/Directory/Service.hs

@@ -5,31 +5,38 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Directory.Service
   ( welcomeGetOpts,
     directoryService,
     directoryServiceCLI,
-    directoryChatConfig
+    newServiceState,
+    acceptMemberHook
   )
 where
 
 import Control.Concurrent (forkIO)
 import Control.Concurrent.Async
 import Control.Concurrent.STM
+import qualified Control.Exception as E
 import Control.Logger.Simple
 import Control.Monad
-import Data.Composition ((.:))
+import Control.Monad.Except
-import Data.Containers.ListUtils (nubOrd)
+import Control.Monad.IO.Class
+import Data.Int (Int64)
 import Data.List (find, intercalate)
+import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Map.Strict as M
 import Data.Maybe (fromMaybe, isJust, maybeToList)
 import Data.Set (Set)
 import qualified Data.Set as S
 import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Time.Clock (diffUTCTime, getCurrentTime)
+import qualified Data.Text.IO as T
+import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime)
 import Data.Time.LocalTime (getCurrentTimeZone)
 import Directory.BlockedWords
 import Directory.Events
@@ -43,17 +50,24 @@ import Simplex.Chat.Core
 import Simplex.Chat.Messages
 import Simplex.Chat.Options
 import Simplex.Chat.Protocol (MsgContent (..))
+import Simplex.Chat.Store.Direct (getContact)
+import Simplex.Chat.Store.Groups (getGroupInfo, getGroupLink, getGroupSummary, setGroupCustomData)
+import Simplex.Chat.Store.Profiles (GroupLinkInfo (..), getGroupLinkInfo)
 import Simplex.Chat.Store.Shared (StoreError (..))
 import Simplex.Chat.Terminal (terminalChatConfig)
 import Simplex.Chat.Terminal.Main (simplexChatCLI')
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Shared
 import Simplex.Chat.View (serializeChatResponse, simplexChatContact, viewContactName, viewGroupName)
+import Simplex.Messaging.Agent.Store.Common (withTransaction)
+import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Util (safeDecodeUtf8, tshow, ($>>=), (<$$>))
 import System.Directory (getAppUserDataDirectory)
+import System.Process (readProcess)
+import System.Random (randomRIO)
 
 data GroupProfileUpdate = GPNoServiceLink | GPServiceLinkAdded | GPServiceLinkRemoved | GPHasServiceLink | GPServiceLinkError
 
@@ -70,13 +84,32 @@ data GroupRolesStatus
   deriving (Eq)
 
 data ServiceState = ServiceState
-  { searchRequests :: TMap ContactId SearchRequest
+  { searchRequests :: TMap ContactId SearchRequest,
+    blockedWordsCfg :: BlockedWordsConfig,
+    pendingCaptchas :: TMap GroupMemberId PendingCaptcha
   }
 
-newServiceState :: IO ServiceState
+data PendingCaptcha = PendingCaptcha
-newServiceState = do
+  { captchaText :: Text,
+    sentAt :: UTCTime,
+    attempts :: Int
+  }
+
+captchaLength :: Int
+captchaLength = 7
+
+maxCaptchaAttempts :: Int
+maxCaptchaAttempts = 5
+
+captchaTTL :: NominalDiffTime
+captchaTTL = 600 -- 10 minutes
+
+newServiceState :: DirectoryOpts -> IO ServiceState
+newServiceState opts = do
   searchRequests <- TM.emptyIO
-  pure ServiceState {searchRequests}
+  blockedWordsCfg <- readBlockedWordsConfig opts
+  pendingCaptchas <- TM.emptyIO
+  pure ServiceState {searchRequests, blockedWordsCfg, pendingCaptchas}
 
 welcomeGetOpts :: IO DirectoryOpts
 welcomeGetOpts = do
@@ -100,12 +133,12 @@ welcomeGetOpts = do
 
 directoryServiceCLI :: DirectoryStore -> DirectoryOpts -> IO ()
 directoryServiceCLI st opts = do
-  env <- newServiceState
+  env <- newServiceState opts
   eventQ <- newTQueueIO
   let eventHook cc resp = atomically $ resp <$ writeTQueue eventQ (cc, resp)
-  cfg <- directoryChatConfig opts
+      chatHooks = defaultChatHooks {eventHook = Just eventHook, acceptMember = Just $ acceptMemberHook opts env}
   race_
-    (simplexChatCLI' cfg {chatHooks = defaultChatHooks {eventHook}} (mkChatOpts opts) Nothing)
+    (simplexChatCLI' terminalChatConfig {chatHooks} (mkChatOpts opts) Nothing)
     (processEvents eventQ env)
   where
     processEvents eventQ env = forever $ do
@@ -113,31 +146,63 @@ directoryServiceCLI st opts = do
       u_ <- readTVarIO (currentUser cc)
       forM_ u_ $ \user -> directoryServiceEvent st opts env user cc resp
 
-directoryService :: DirectoryStore -> DirectoryOpts -> User -> ChatController -> IO ()
+directoryService :: DirectoryStore -> DirectoryOpts -> ServiceState -> User -> ChatController -> IO ()
-directoryService st opts@DirectoryOpts {testing} user cc = do
+directoryService st opts@DirectoryOpts {testing} env user cc = do
   initializeBotAddress' (not testing) cc
-  env <- newServiceState
   race_ (forever $ void getLine) . forever $ do
     (_, _, resp) <- atomically . readTBQueue $ outputQ cc
     directoryServiceEvent st opts env user cc resp
 
-directoryChatConfig :: DirectoryOpts -> IO ChatConfig
+acceptMemberHook :: DirectoryOpts -> ServiceState -> GroupInfo -> GroupLinkInfo -> Profile -> IO (Either GroupRejectionReason (GroupAcceptance, GroupMemberRole))
-directoryChatConfig DirectoryOpts {blockedWordsFile, nameSpellingFile, blockedExtensionRules, profileNameLimit, acceptAsObserver} = do
+acceptMemberHook
-  blockedWords <- mapM (fmap lines . readFile) blockedWordsFile
+  DirectoryOpts {profileNameLimit}
-  spelling <- maybe (pure M.empty) (fmap (M.fromList . read) . readFile) nameSpellingFile
+  ServiceState {blockedWordsCfg}
+  g
+  GroupLinkInfo {memberRole}
+  Profile {displayName, image = img} = runExceptT $ do
+    let a = groupMemberAcceptance g
+    when (useMemberFilter img $ rejectNames a) checkName
+    pure $
+      if
+        | useMemberFilter img (passCaptcha a) -> (GAPending, GRMember)
+        | useMemberFilter img (makeObserver a) -> (GAAccepted, GRObserver)
+        | otherwise -> (GAAccepted, memberRole)
+    where
+      checkName :: ExceptT GroupRejectionReason IO ()
+      checkName
+        | T.length displayName > profileNameLimit = throwError GRRLongName
+        | otherwise = do
+            when (hasBlockedFragments blockedWordsCfg displayName) $ throwError GRRBlockedName
+            when (hasBlockedWords blockedWordsCfg displayName) $ throwError GRRBlockedName
+
+groupMemberAcceptance :: GroupInfo -> DirectoryMemberAcceptance
+groupMemberAcceptance GroupInfo {customData} = memberAcceptance $ fromCustomData customData
+
+useMemberFilter :: Maybe ImageData -> Maybe ProfileCondition -> Bool
+useMemberFilter img_ = \case
+  Just PCAll -> True
+  Just PCNoImage -> maybe True (\(ImageData i) -> i == "") img_
+  Nothing -> False
+
+readBlockedWordsConfig :: DirectoryOpts -> IO BlockedWordsConfig
+readBlockedWordsConfig DirectoryOpts {blockedFragmentsFile, blockedWordsFile, nameSpellingFile, blockedExtensionRules} = do
   extensionRules <- maybe (pure []) (fmap read . readFile) blockedExtensionRules  
-  let !bws = nubOrd . concatMap (wordVariants extensionRules) <$> blockedWords
+  spelling <- maybe (pure M.empty) (fmap (M.fromList . read) . readFile) nameSpellingFile
-      !allowedProfileName = not .: containsBlockedWords spelling <$> bws
+  blockedFragments <- S.fromList <$> maybe (pure []) (fmap T.lines . T.readFile) blockedFragmentsFile
-  putStrLn $ "Blocked words: " <> show (maybe 0 length bws) <> ", spelling rules: " <> show (M.size spelling)
+  bws <- maybe (pure []) (fmap lines . readFile) blockedWordsFile
-  pure terminalChatConfig {allowedProfileName, profileNameLimit, acceptAsObserver}
+  let blockedWords = S.fromList $ concatMap (wordVariants extensionRules) bws
+  putStrLn $ "Blocked fragments: " <> show (length blockedFragments) <> ", blocked words: " <> show (length blockedWords) <> ", spelling rules: " <> show (M.size spelling)
+  pure BlockedWordsConfig {blockedFragments, blockedWords, extensionRules, spelling}
 
 directoryServiceEvent :: DirectoryStore -> DirectoryOpts -> ServiceState -> User -> ChatController -> ChatResponse -> IO ()
-directoryServiceEvent st DirectoryOpts {adminUsers, superUsers, serviceName, ownersGroup, searchResults} ServiceState {searchRequests} user@User {userId} cc event =
+directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName, ownersGroup, searchResults} env@ServiceState {searchRequests} user@User {userId} cc event =
   forM_ (crDirectoryEvent event) $ \case
     DEContactConnected ct -> deContactConnected ct
     DEGroupInvitation {contact = ct, groupInfo = g, fromMemberRole, memberRole} -> deGroupInvitation ct g fromMemberRole memberRole
     DEServiceJoinedGroup ctId g owner -> deServiceJoinedGroup ctId g owner
     DEGroupUpdated {contactId, fromGroup, toGroup} -> deGroupUpdated contactId fromGroup toGroup
+    DEPendingMember g m -> dePendingMember g m
+    DEPendingMemberMsg g m ciId t -> dePendingMemberMsg g m ciId t
     DEContactRoleChanged g ctId role -> deContactRoleChanged g ctId role
     DEServiceRoleChanged g role -> deServiceRoleChanged g role
     DEContactRemovedFromGroup ctId g -> deContactRemovedFromGroup ctId g
@@ -163,7 +228,7 @@ directoryServiceEvent st DirectoryOpts {adminUsers, superUsers, serviceName, own
     notifyOwner GroupReg {dbContactId} = sendMessage' cc dbContactId
     ctId `isOwner` GroupReg {dbContactId} = ctId == dbContactId
     withGroupReg GroupInfo {groupId, localDisplayName} err action = do
-      atomically (getGroupReg st groupId) >>= \case
+      getGroupReg st groupId >>= \case
         Just gr -> action gr
         Nothing -> logError $ "Error: " <> err <> ", group: " <> localDisplayName <> ", can't find group registration ID " <> tshow groupId
     groupInfoText GroupProfile {displayName = n, fullName = fn, description = d} =
@@ -373,10 +438,91 @@ directoryServiceEvent st DirectoryOpts {adminUsers, superUsers, serviceName, own
             Just (Just msg) -> notifyOwner gr msg
             Just Nothing -> sendToApprove toGroup gr gaId
 
+    dePendingMember :: GroupInfo -> GroupMember -> IO ()
+    dePendingMember g@GroupInfo {groupProfile = GroupProfile {displayName}}  m
+      | memberRequiresCaptcha a m = sendMemberCaptcha g m Nothing captchaNotice 0
+      | otherwise = approvePendingMember a g m
+      where
+        a = groupMemberAcceptance g
+        captchaNotice = "Captcha is generated by SimpleX Directory service.\n\n*Send captcha text* to join the group " <> displayName <> "."
+
+    sendMemberCaptcha :: GroupInfo -> GroupMember -> Maybe ChatItemId -> Text -> Int -> IO ()
+    sendMemberCaptcha GroupInfo {groupId} m quotedId noticeText prevAttempts = do
+      s <- getCaptchaStr captchaLength ""
+      mc <- getCaptcha s
+      sentAt <- getCurrentTime
+      let captcha = PendingCaptcha {captchaText = T.pack s, sentAt, attempts = prevAttempts + 1}
+      atomically $ TM.insert gmId captcha $ pendingCaptchas env
+      sendCaptcha mc
+      where
+        getCaptchaStr 0 s = pure s
+        getCaptchaStr n s = do
+          i <- randomRIO (0, length chars - 1)
+          let c = chars !! i
+          getCaptchaStr (n - 1) (c : s)
+        chars = "23456789ABCDEFGHIJKLMNOPQRSTUVWXYZabdefghijkmnpqrsty"
+        getCaptcha s = case captchaGenerator opts of
+          Nothing -> pure textMsg
+          Just script -> content <$> readProcess script [s] ""
+          where
+            textMsg = MCText $ T.pack s 
+            content r = case T.lines $ T.pack r of
+              [] -> textMsg
+              "" : _ -> textMsg
+              img : _ -> MCImage "" $ ImageData img
+        sendCaptcha mc = sendComposedMessages_ cc (SRGroup groupId $ Just gmId) [(quotedId, MCText noticeText), (Nothing, mc)]
+        gmId = groupMemberId' m
+
+    approvePendingMember :: DirectoryMemberAcceptance -> GroupInfo -> GroupMember -> IO ()
+    approvePendingMember a g@GroupInfo {groupId} m@GroupMember {memberProfile = LocalProfile {displayName, image}} = do
+      gli_ <- join <$> withDB' cc (\db -> getGroupLinkInfo db userId groupId)
+      let role = if useMemberFilter image (makeObserver a) then GRObserver else maybe GRMember (\GroupLinkInfo {memberRole} -> memberRole) gli_
+          gmId = groupMemberId' m
+      sendChatCmd cc (APIAcceptMember groupId gmId role) >>= \case
+        CRJoinedGroupMember {} -> do
+          atomically $ TM.delete gmId $ pendingCaptchas env
+          logInfo $ "Member " <> viewName displayName <> " accepted, group " <> tshow groupId <> ":" <> viewGroupName g
+        r -> logError $ "unexpected accept member response: " <> tshow r
+
+    dePendingMemberMsg :: GroupInfo -> GroupMember -> ChatItemId -> Text -> IO ()
+    dePendingMemberMsg g@GroupInfo {groupId, groupProfile = GroupProfile {displayName = n}} m@GroupMember {memberProfile = LocalProfile {displayName}} ciId msgText
+      | memberRequiresCaptcha a m = do
+          ts <- getCurrentTime
+          atomically (TM.lookup (groupMemberId' m) $ pendingCaptchas env) >>= \case
+            Just PendingCaptcha {captchaText, sentAt, attempts}
+              | ts `diffUTCTime` sentAt > captchaTTL -> sendMemberCaptcha g m (Just ciId) captchaExpired $ attempts - 1
+              | captchaText == msgText -> do
+                  sendComposedMessages_ cc (SRGroup groupId $ Just $ groupMemberId' m) [(Just ciId, MCText $ "Correct, you joined the group " <> n)]
+                  approvePendingMember a g m
+              | attempts >= maxCaptchaAttempts -> rejectPendingMember tooManyAttempts
+              | otherwise -> sendMemberCaptcha g m (Just ciId) (wrongCaptcha attempts) attempts
+            Nothing -> sendMemberCaptcha g m (Just ciId) noCaptcha 0
+      | otherwise = approvePendingMember a g m
+      where
+        a = groupMemberAcceptance g
+        rejectPendingMember rjctNotice = do
+          let gmId = groupMemberId' m
+          sendComposedMessages cc (SRGroup groupId $ Just gmId) [MCText rjctNotice]
+          sendChatCmd cc (APIRemoveMembers groupId [gmId]) >>= \case
+            CRUserDeletedMembers _ _ (_ : _) -> do
+              atomically $ TM.delete gmId $ pendingCaptchas env
+              logInfo $ "Member " <> viewName displayName <> " rejected, group " <> tshow groupId <> ":" <> viewGroupName g
+            r -> logError $ "unexpected remove member response: " <> tshow r
+        captchaExpired = "Captcha expired, please try again."
+        wrongCaptcha attempts
+          | attempts == maxCaptchaAttempts - 1 = "Incorrect text, please try again - this is your last attempt."
+          | otherwise = "Incorrect text, please try again."
+        noCaptcha = "Unexpected message, please try again."
+        tooManyAttempts = "Too many failed attempts, you can't join group."
+
+    memberRequiresCaptcha :: DirectoryMemberAcceptance -> GroupMember -> Bool
+    memberRequiresCaptcha a GroupMember {memberProfile = LocalProfile {image}} =
+      useMemberFilter image $ passCaptcha a
+
     sendToApprove :: GroupInfo -> GroupReg -> GroupApprovalId -> IO ()
     sendToApprove GroupInfo {groupProfile = p@GroupProfile {displayName, image = image'}} GroupReg {dbGroupId, dbContactId} gaId = do
-      ct_ <- getContact cc dbContactId
+      ct_ <- getContact' cc user dbContactId
-      gr_ <- getGroupAndSummary cc dbGroupId
+      gr_ <- getGroupAndSummary cc user dbGroupId
       let membersStr = maybe "" (\(_, s) -> "_" <> tshow (currentMembers s) <> " members_\n") gr_
           text =
             maybe ("The group ID " <> tshow dbGroupId <> " submitted: ") (\c -> localDisplayName' c <> " submitted the group ID " <> tshow dbGroupId <> ": ") ct_
@@ -518,41 +664,86 @@ directoryServiceEvent st DirectoryOpts {adminUsers, superUsers, serviceName, own
                 _ -> processInvitation ct g
             _ -> sendReply $ "Error: the group ID " <> tshow ugrId <> " (" <> displayName <> ") is not pending confirmation."
       DCListUserGroups ->
-        atomically (getUserGroupRegs st $ contactId' ct) >>= \grs -> do
+        getUserGroupRegs st (contactId' ct) >>= \grs -> do
           sendReply $ tshow (length grs) <> " registered group(s)"
+          -- debug how it can be that user has 0 registered groups
+          when (length grs == 0) $ do
+            total <- length <$> readTVarIO (groupRegs st)
+            withSuperUsers $ \ctId -> sendMessage' cc ctId $
+              "0 registered groups for " <> localDisplayName' ct <> " (" <> tshow (contactId' ct) <> ") out of " <> tshow total <> " registrations"
           void . forkIO $ forM_ (reverse grs) $ \gr@GroupReg {userGroupRegId} ->
             sendGroupInfo ct gr userGroupRegId Nothing
       DCDeleteGroup ugrId gName ->
         withUserGroupReg ugrId gName $ \GroupInfo {groupProfile = GroupProfile {displayName}} gr -> do
           delGroupReg st gr
           sendReply $ "Your group " <> displayName <> " is deleted from the directory"
-      DCSetRole gId gName mRole ->
+      DCMemberRole gId gName_ mRole_ ->
-        (if isAdmin then withGroupAndReg sendReply else withUserGroupReg) gId gName $
+        (if isAdmin then withGroupAndReg_ sendReply else withUserGroupReg_) gId gName_ $ \g _gr -> do
-          \GroupInfo {groupId, groupProfile = GroupProfile {displayName}} _gr -> do
+          let GroupInfo {groupProfile = GroupProfile {displayName = n}} = g
-            gLink_ <- setGroupLinkRole cc groupId mRole
+          case mRole_ of
-            sendReply $ case gLink_ of
+            Nothing ->
-              Nothing -> "Error: the initial member role for the group " <> displayName <> " was NOT upgated"
+              getGroupLinkRole cc user g >>= \case
-              Just gLink ->
+                Just (_, gLink, mRole) -> do
-                ("The initial member role for the group " <> displayName <> " is set to *" <> strEncodeTxt mRole <> "*\n\n")
+                  let anotherRole = case mRole of GRObserver -> GRMember; _ -> GRObserver
-                  <> ("*Please note*: it applies only to members joining via this link: " <> strEncodeTxt (simplexChatContact gLink))
+                  sendReply $
+                    initialRole n mRole
+                      <> ("Send */role " <> tshow gId <> " " <> strEncodeTxt anotherRole <> "* to change it.\n\n")
+                      <> onlyViaLink gLink
+                Nothing -> sendReply $ "Error: failed reading the initial member role for the group " <> n
+            Just mRole -> do
+              setGroupLinkRole cc g mRole >>= \case
+                Just gLink -> sendReply $ initialRole n mRole <> "\n" <> onlyViaLink gLink
+                Nothing -> sendReply $ "Error: the initial member role for the group " <> n <> " was NOT upgated."
+        where
+          initialRole n mRole = "The initial member role for the group " <> n <> " is set to *" <> strEncodeTxt mRole <> "*\n"
+          onlyViaLink gLink = "*Please note*: it applies only to members joining via this link: " <> strEncodeTxt (simplexChatContact gLink)
+      DCGroupFilter gId gName_ acceptance_ ->
+        (if isAdmin then withGroupAndReg_ sendReply else withUserGroupReg_) gId gName_ $ \g _gr -> do
+          let GroupInfo {groupProfile = GroupProfile {displayName = n}} = g
+              a = groupMemberAcceptance g
+          case acceptance_ of
+            Just a' | a /= a' -> do
+              let d = toCustomData $ DirectoryGroupData a'
+              withDB' cc (\db -> setGroupCustomData db user g $ Just d) >>= \case
+                Just () -> sendSettigns n a' " set to"
+                Nothing -> sendReply $ "Error changing spam filter settings for group " <> n
+            _ -> sendSettigns n a ""
+        where
+          sendSettigns n a setTo =
+            sendReply $
+              T.unlines
+                [ "Spam filter settings for group " <> n <> setTo <> ":",
+                  "- reject long/inappropriate names: " <> showCondition (rejectNames a),
+                  "- pass captcha to join: " <> showCondition (passCaptcha a),
+                  -- "- make observer: " <> showCondition (makeObserver a) <> (if isJust (makeObserver a) then "" else " (use default set with /role command)"),
+                  "",
+                  -- "Use */filter " <> tshow gId <> " <level>* to change spam filter level: no (disable), basic, moderate, strong.",
+                  -- "Or use */filter " <> tshow gId <> " [name[=noimage]] [captcha[=noimage]] [observer[=noimage]]* for advanced filter configuration."
+                  "Or use */filter " <> tshow gId <> " [name] [captcha]* to configure filter."
+                ]
+          showCondition = \case
+            Nothing -> "_disabled_"
+            Just PCAll -> "_enabled_"
+            Just PCNoImage -> "_enabled for profiles without image_"
       DCUnknownCommand -> sendReply "Unknown command"
       DCCommandError tag -> sendReply $ "Command error: " <> tshow tag
       where
         knownCt = knownContact ct
         isAdmin = knownCt `elem` adminUsers || knownCt `elem` superUsers
-        withUserGroupReg ugrId gName action =
+        withUserGroupReg ugrId = withUserGroupReg_ ugrId . Just
-          atomically (getUserGroupReg st (contactId' ct) ugrId) >>= \case
+        withUserGroupReg_ ugrId gName_ action =
+          getUserGroupReg st (contactId' ct) ugrId >>= \case
             Nothing -> sendReply $ "Group ID " <> tshow ugrId <> " not found"
             Just gr@GroupReg {dbGroupId} -> do
-              getGroup cc dbGroupId >>= \case
+              getGroup cc user dbGroupId >>= \case
                 Nothing -> sendReply $ "Group ID " <> tshow ugrId <> " not found"
                 Just g@GroupInfo {groupProfile = GroupProfile {displayName}}
-                  | displayName == gName -> action g gr
+                  | maybe True (displayName ==) gName_ -> action g gr
                   | otherwise -> sendReply $ "Group ID " <> tshow ugrId <> " has the display name " <> displayName
         sendReply = mkSendReply ct ciId
         withFoundListedGroups s_ action =
           getGroups_ s_ >>= \case
-            Just groups -> atomically (filterListedGroups st groups) >>= action
+            Just groups -> filterListedGroups st groups >>= action
             Nothing -> sendReply "Error: getGroups. Please notify the developers."
         sendSearchResults s = \case
           [] -> sendReply "No groups found"
@@ -560,18 +751,18 @@ directoryServiceEvent st DirectoryOpts {adminUsers, superUsers, serviceName, own
             let gs' = takeTop searchResults gs
                 moreGroups = length gs - length gs'
                 more = if moreGroups > 0 then ", sending top " <> tshow (length gs') else ""
-            sendReply $ "Found " <> tshow (length gs) <> " group(s)" <> more <> "."
+                reply = "Found " <> tshow (length gs) <> " group(s)" <> more <> "."
             updateSearchRequest (STSearch s) $ groupIds gs'
-            sendFoundGroups gs' moreGroups
+            sendFoundGroups reply gs' moreGroups
         sendAllGroups takeFirst sortName searchType = \case
           [] -> sendReply "No groups listed"
           gs -> do
             let gs' = takeFirst searchResults gs
                 moreGroups = length gs - length gs'
                 more = if moreGroups > 0 then ", sending " <> sortName <> " " <> tshow (length gs') else ""
-            sendReply $ tshow (length gs) <> " group(s) listed" <> more <> "."
+                reply = tshow (length gs) <> " group(s) listed" <> more <> "."
             updateSearchRequest searchType $ groupIds gs'
-            sendFoundGroups gs' moreGroups
+            sendFoundGroups reply gs' moreGroups
         sendNextSearchResults takeFirst SearchRequest {searchType, sentGroups} = \case
           [] -> do
             sendReply "Sorry, no more groups"
@@ -580,33 +771,31 @@ directoryServiceEvent st DirectoryOpts {adminUsers, superUsers, serviceName, own
             let gs' = takeFirst searchResults $ filterNotSent sentGroups gs
                 sentGroups' = sentGroups <> groupIds gs'
                 moreGroups = length gs - S.size sentGroups'
-            sendReply $ "Sending " <> tshow (length gs') <> " more group(s)."
+                reply = "Sending " <> tshow (length gs') <> " more group(s)."
             updateSearchRequest searchType sentGroups'
-            sendFoundGroups gs' moreGroups
+            sendFoundGroups reply gs' moreGroups
         updateSearchRequest :: SearchType -> Set GroupId -> IO ()
         updateSearchRequest searchType sentGroups = do
           searchTime <- getCurrentTime
           let search = SearchRequest {searchType, searchTime, sentGroups}
           atomically $ TM.insert (contactId' ct) search searchRequests
-        sendFoundGroups gs moreGroups =
+        sendFoundGroups reply gs moreGroups =
-          void . forkIO $ do
+          void . forkIO $ sendComposedMessages_ cc (SRDirect $ contactId' ct) msgs
-            forM_ gs $
+          where
-              \(GroupInfo {groupId, groupProfile = p@GroupProfile {image = image_}}, GroupSummary {currentMembers}) -> do
+            msgs = replyMsg :| map foundGroup gs <> [moreMsg | moreGroups > 0]
-                let membersStr = "_" <> tshow currentMembers <> " members_"
+            replyMsg = (Just ciId, MCText reply)
-                    showId = if isAdmin then tshow groupId <> ". " else ""
+            foundGroup (GroupInfo {groupId, groupProfile = p@GroupProfile {image = image_}}, GroupSummary {currentMembers}) =
-                    text = showId <> groupInfoText p <> "\n" <> membersStr
+              let membersStr = "_" <> tshow currentMembers <> " members_"
-                    msg = maybe (MCText text) (\image -> MCImage {text, image}) image_
+                  showId = if isAdmin then tshow groupId <> ". " else ""
-                sendComposedMessage cc ct Nothing msg
+                  text = showId <> groupInfoText p <> "\n" <> membersStr
-            when (moreGroups > 0) $
+               in (Nothing, maybe (MCText text) (\image -> MCImage {text, image}) image_)
-              sendComposedMessage cc ct Nothing $
+            moreMsg = (Nothing, MCText $ "Send */next* or just *.* for " <> tshow moreGroups <> " more result(s).")
-                MCText $
-                  "Send */next* or just *.* for " <> tshow moreGroups <> " more result(s)."
 
     deAdminCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRAdmin -> IO ()
     deAdminCommand ct ciId cmd
       | knownCt `elem` adminUsers || knownCt `elem` superUsers = case cmd of
           DCApproveGroup {groupId, displayName = n, groupApprovalId} ->
-            withGroupAndReg sendReply groupId n $ \g gr ->
+            withGroupAndReg sendReply groupId n $ \g gr@GroupReg {userGroupRegId = ugrId} ->
               readTVarIO (groupRegStatus gr) >>= \case
                 GRSPendingApproval gaId
                   | gaId == groupApprovalId -> do
@@ -618,7 +807,10 @@ directoryServiceEvent st DirectoryOpts {adminUsers, superUsers, serviceName, own
                             Just GRSOk -> do
                               setGroupStatus st gr GRSActive
                               let approved = "The group " <> userGroupReference' gr n <> " is approved"
-                              notifyOwner gr $ 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 $
+                                (approved <> " and listed in directory!\n")
+                                  <> "Please note: if you change the group profile it will be hidden from directory until it is re-approved.\n\n"
+                                  <> ("Use */filter " <> tshow ugrId <> "* to configure anti-spam filter and */role " <> tshow ugrId <> "* to set default member role.")
                               invited <-
                                 forM ownersGroup $ \og@KnownGroup {localDisplayName = ogName} -> do
                                   inviteToOwnersGroup og gr $ \case
@@ -699,6 +891,8 @@ directoryServiceEvent st DirectoryOpts {adminUsers, superUsers, serviceName, own
                     sendReply $ "you" <> invited
                   Left err -> sendReply err
             Nothing -> sendReply "owners' group is not specified"
+          -- DCAddBlockedWord _word -> pure ()
+          -- DCRemoveBlockedWord _word -> pure ()
           DCCommandError tag -> sendReply $ "Command error: " <> tshow tag
       | otherwise = sendReply "You are not allowed to use this command"
       where
@@ -713,7 +907,7 @@ directoryServiceEvent st DirectoryOpts {adminUsers, superUsers, serviceName, own
                 else pure groups
             sendReply $ tshow (length grs) <> " registered group(s)" <> (if length grs > count then ", showing the last " <> tshow count else "")
             void . forkIO $ forM_ (reverse $ take count grs) $ \gr@GroupReg {dbGroupId, dbContactId} -> do
-              ct_ <- getContact cc dbContactId
+              ct_ <- getContact' cc user dbContactId
               let ownerStr = "Owner: " <> maybe "getContact error" localDisplayName' ct_
               sendGroupInfo ct gr dbGroupId $ Just ownerStr
         inviteToOwnersGroup :: KnownGroup -> GroupReg -> (Either Text () -> IO a) -> IO a
@@ -735,7 +929,7 @@ directoryServiceEvent st DirectoryOpts {adminUsers, superUsers, serviceName, own
               putStrLn $ T.unpack err
               cont $ Left err
         groupOwnerInfo groupRef dbContactId = do
-          owner_ <- getContact cc dbContactId
+          owner_ <- getContact' cc user dbContactId
           let ownerInfo = "the owner of the group " <> groupRef
               ownerName ct' = "@" <> viewName (localDisplayName' ct') <> ", "
           pure $ maybe "" ownerName owner_ <> ownerInfo
@@ -760,12 +954,15 @@ directoryServiceEvent st DirectoryOpts {adminUsers, superUsers, serviceName, own
     mkSendReply ct ciId = sendComposedMessage cc ct (Just ciId) . MCText
 
     withGroupAndReg :: (Text -> IO ()) -> GroupId -> GroupName -> (GroupInfo -> GroupReg -> IO ()) -> IO ()
-    withGroupAndReg sendReply gId gName action =
+    withGroupAndReg sendReply gId = withGroupAndReg_ sendReply gId . Just
-      getGroup cc gId >>= \case
+
+    withGroupAndReg_ :: (Text -> IO ()) -> GroupId -> Maybe GroupName -> (GroupInfo -> GroupReg -> IO ()) -> IO ()
+    withGroupAndReg_ sendReply gId gName_ action =
+      getGroup cc user gId >>= \case
         Nothing -> sendReply $ "Group ID " <> tshow gId <> " not found (getGroup)"
         Just g@GroupInfo {groupProfile = GroupProfile {displayName}}
-          | displayName == gName ->
+          | maybe False (displayName ==) gName_ ->
-              atomically (getGroupReg st gId) >>= \case
+              getGroupReg st gId >>= \case
                 Nothing -> sendReply $ "Registration for group ID " <> tshow gId <> " not found (getGroupReg)"
                 Just gr -> action g gr
           | otherwise ->
@@ -775,7 +972,7 @@ directoryServiceEvent st DirectoryOpts {adminUsers, superUsers, serviceName, own
     sendGroupInfo ct gr@GroupReg {dbGroupId} useGroupId ownerStr_ = do
       grStatus <- readTVarIO $ groupRegStatus gr
       let statusStr = "Status: " <> groupRegStatusText grStatus
-      getGroupAndSummary cc dbGroupId >>= \case
+      getGroupAndSummary cc user 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]
@@ -785,31 +982,36 @@ directoryServiceEvent st DirectoryOpts {adminUsers, superUsers, serviceName, own
           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' :: ChatController -> User -> ContactId -> IO (Maybe Contact)
-getContact cc ctId = resp <$> sendChatCmd cc (APIGetChat (ChatRef CTDirect ctId) Nothing (CPLast 0) Nothing)
+getContact' cc user ctId = withDB cc $ \db -> getContact db (vr cc) user ctId
-  where
-    resp :: ChatResponse -> Maybe Contact
-    resp = \case
-      CRApiChat _ (AChat SCTDirect Chat {chatInfo = DirectChat ct}) _ -> Just ct
-      _ -> Nothing
 
-getGroup :: ChatController -> GroupId -> IO (Maybe GroupInfo)
+getGroup :: ChatController -> User -> GroupId -> IO (Maybe GroupInfo)
-getGroup cc gId = resp <$> sendChatCmd cc (APIGroupInfo gId)
+getGroup cc user gId = withDB cc $ \db -> getGroupInfo db (vr cc) user gId
-  where
-    resp :: ChatResponse -> Maybe GroupInfo
-    resp = \case
-      CRGroupInfo {groupInfo} -> Just groupInfo
-      _ -> Nothing
 
-getGroupAndSummary :: ChatController -> GroupId -> IO (Maybe (GroupInfo, GroupSummary))
+withDB' :: ChatController -> (DB.Connection -> IO a) -> IO (Maybe a)
-getGroupAndSummary cc gId = resp <$> sendChatCmd cc (APIGroupInfo gId)
+withDB' cc a = withDB cc $ ExceptT . fmap Right . a
-  where
-    resp = \case
-      CRGroupInfo {groupInfo, groupSummary} -> Just (groupInfo, groupSummary)
-      _ -> Nothing
 
-setGroupLinkRole :: ChatController -> GroupId -> GroupMemberRole -> IO (Maybe ConnReqContact)
+withDB :: ChatController -> (DB.Connection -> ExceptT StoreError IO a) -> IO (Maybe a)
-setGroupLinkRole cc gId mRole = resp <$> sendChatCmd cc (APIGroupLinkMemberRole gId mRole)
+withDB ChatController {chatStore} action = do
+  r_ :: Either ChatError a <- withTransaction chatStore (runExceptT . withExceptT ChatErrorStore . action) `E.catches` handleDBErrors
+  case r_ of
+    Right r -> pure $ Just r
+    Left e -> Nothing <$ logError ("Database error: " <> tshow e)
+
+getGroupAndSummary :: ChatController -> User -> GroupId -> IO (Maybe (GroupInfo, GroupSummary))
+getGroupAndSummary cc user gId =
+  withDB cc $ \db -> (,) <$> getGroupInfo db (vr cc) user gId <*> liftIO (getGroupSummary db user gId)
+
+vr :: ChatController -> VersionRangeChat
+vr ChatController {config = ChatConfig {chatVRange}} = chatVRange
+{-# INLINE vr #-}
+
+getGroupLinkRole :: ChatController -> User -> GroupInfo -> IO (Maybe (Int64, ConnReqContact, GroupMemberRole))
+getGroupLinkRole cc user gInfo =
+  withDB cc $ \db -> getGroupLink db user gInfo
+
+setGroupLinkRole :: ChatController -> GroupInfo -> GroupMemberRole -> IO (Maybe ConnReqContact)
+setGroupLinkRole cc GroupInfo {groupId} mRole = resp <$> sendChatCmd cc (APIGroupLinkMemberRole groupId mRole)
   where
     resp = \case
       CRGroupLink _ _ gLink _ -> Just gLink

apps/simplex-directory-service/src/Directory/Store.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Directory.Store
   ( DirectoryStore (..),
@@ -10,6 +11,9 @@ module Directory.Store
     GroupRegStatus (..),
     UserGroupRegId,
     GroupApprovalId,
+    DirectoryGroupData (..),
+    DirectoryMemberAcceptance (..),
+    ProfileCondition (..),
     restoreDirectoryStore,
     addGroupReg,
     delGroupReg,
@@ -21,25 +25,35 @@ module Directory.Store
     filterListedGroups,
     groupRegStatusText,
     pendingApproval,
+    fromCustomData,
+    toCustomData,
+    noJoinFilter,
+    basicJoinFilter,
+    moderateJoinFilter,
+    strongJoinFilter
   )
 where
 
 import Control.Concurrent.STM
 import Control.Monad
+import Data.Aeson ((.=), (.:))
+import qualified Data.Aeson.KeyMap as JM
+import qualified Data.Aeson.TH as JQ
+import qualified Data.Aeson.Types as JT
 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.Maybe (fromMaybe, isJust)
 import Data.Set (Set)
 import qualified Data.Set as S
 import Data.Text (Text)
 import Simplex.Chat.Types
 import Simplex.Messaging.Encoding.String
+import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON)
 import Simplex.Messaging.Util (ifM)
 import System.Directory (doesFileExist, renameFile)
 import System.IO (BufferMode (..), Handle, IOMode (..), hSetBuffering, openFile)
@@ -67,6 +81,51 @@ data GroupRegData = GroupRegData
     groupRegStatus_ :: GroupRegStatus
   }
 
+data DirectoryGroupData = DirectoryGroupData
+  { memberAcceptance :: DirectoryMemberAcceptance
+  }
+
+-- these filters are applied in the order of fields, depending on ProfileCondition:
+-- Nothing - do not apply
+-- Just
+--   PCAll - apply to all profiles
+--   PCNoImage - apply to profiles without images
+data DirectoryMemberAcceptance = DirectoryMemberAcceptance
+  { rejectNames :: Maybe ProfileCondition, -- reject long names and names with profanity
+    passCaptcha :: Maybe ProfileCondition, -- run captcha challenge with joining members
+    makeObserver :: Maybe ProfileCondition -- the role assigned in the end, after captcha challenge
+  }
+  deriving (Eq, Show)
+
+data ProfileCondition = PCAll | PCNoImage deriving (Eq, Show)
+
+noJoinFilter :: DirectoryMemberAcceptance
+noJoinFilter = DirectoryMemberAcceptance Nothing Nothing Nothing
+
+basicJoinFilter :: DirectoryMemberAcceptance
+basicJoinFilter =
+  DirectoryMemberAcceptance
+    { rejectNames = Just PCNoImage,
+      passCaptcha = Nothing,
+      makeObserver = Nothing
+    }
+
+moderateJoinFilter :: DirectoryMemberAcceptance
+moderateJoinFilter =
+  DirectoryMemberAcceptance
+    { rejectNames = Just PCAll,
+      passCaptcha = Just PCNoImage,
+      makeObserver = Nothing
+    }
+
+strongJoinFilter :: DirectoryMemberAcceptance
+strongJoinFilter =
+  DirectoryMemberAcceptance
+    { rejectNames = Just PCAll,
+      passCaptcha = Just PCAll,
+      makeObserver = Nothing
+    }
+
 type UserGroupRegId = Int64
 
 type GroupApprovalId = Int64
@@ -106,16 +165,31 @@ grDirectoryStatus = \case
   GRSSuspendedBadRoles -> DSReserved
   _ -> DSRegistered
 
+$(JQ.deriveJSON (enumJSON $ dropPrefix "PC") ''ProfileCondition)
+
+$(JQ.deriveJSON defaultJSON ''DirectoryMemberAcceptance)
+
+$(JQ.deriveJSON defaultJSON ''DirectoryGroupData)
+
+fromCustomData :: Maybe CustomData -> DirectoryGroupData
+fromCustomData cd_ =
+  let memberAcceptance = fromMaybe noJoinFilter $ cd_ >>= \(CustomData o) -> JT.parseMaybe (.: "memberAcceptance") o
+   in DirectoryGroupData {memberAcceptance}
+
+toCustomData :: DirectoryGroupData -> CustomData
+toCustomData DirectoryGroupData {memberAcceptance} =
+  CustomData $ JM.fromList ["memberAcceptance" .= memberAcceptance]
+
 addGroupReg :: DirectoryStore -> Contact -> GroupInfo -> GroupRegStatus -> IO UserGroupRegId
 addGroupReg st ct GroupInfo {groupId} grStatus = do
-  grData <- atomically addGroupReg_
+  grData <- 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 ->
+      atomically $ stateTVar (groupRegs st) $ \grs ->
         let ugrId = 1 + foldl' maxUgrId 0 grs
             grData' = grData {userGroupRegId_ = ugrId}
             gr' = gr {userGroupRegId = ugrId}
@@ -149,18 +223,18 @@ setGroupRegOwner st gr owner = do
   logGUpdateOwner st (dbGroupId gr) memberId
   atomically $ writeTVar (dbOwnerMemberId gr) (Just memberId)
 
-getGroupReg :: DirectoryStore -> GroupId -> STM (Maybe GroupReg)
+getGroupReg :: DirectoryStore -> GroupId -> IO (Maybe GroupReg)
-getGroupReg st gId = find ((gId ==) . dbGroupId) <$> readTVar (groupRegs st)
+getGroupReg st gId = find ((gId ==) . dbGroupId) <$> readTVarIO (groupRegs st)
 
-getUserGroupReg :: DirectoryStore -> ContactId -> UserGroupRegId -> STM (Maybe GroupReg)
+getUserGroupReg :: DirectoryStore -> ContactId -> UserGroupRegId -> IO (Maybe GroupReg)
-getUserGroupReg st ctId ugrId = find (\r -> ctId == dbContactId r && ugrId == userGroupRegId r) <$> readTVar (groupRegs st)
+getUserGroupReg st ctId ugrId = find (\r -> ctId == dbContactId r && ugrId == userGroupRegId r) <$> readTVarIO (groupRegs st)
 
-getUserGroupRegs :: DirectoryStore -> ContactId -> STM [GroupReg]
+getUserGroupRegs :: DirectoryStore -> ContactId -> IO [GroupReg]
-getUserGroupRegs st ctId = filter ((ctId ==) . dbContactId) <$> readTVar (groupRegs st)
+getUserGroupRegs st ctId = filter ((ctId ==) . dbContactId) <$> readTVarIO (groupRegs st)
 
-filterListedGroups :: DirectoryStore -> [(GroupInfo, GroupSummary)] -> STM [(GroupInfo, GroupSummary)]
+filterListedGroups :: DirectoryStore -> [(GroupInfo, GroupSummary)] -> IO [(GroupInfo, GroupSummary)]
 filterListedGroups st gs = do
-  lgs <- readTVar $ listedGroups st
+  lgs <- readTVarIO $ listedGroups st
   pure $ filter (\(GroupInfo {groupId}, _) -> groupId `S.member` lgs) gs
 
 listGroup :: DirectoryStore -> GroupId -> STM ()
@@ -200,10 +274,10 @@ logGDelete :: DirectoryStore -> GroupId -> IO ()
 logGDelete st = logDLR st . GRDelete
 
 logGUpdateStatus :: DirectoryStore -> GroupId -> GroupRegStatus -> IO ()
-logGUpdateStatus st = logDLR st .: GRUpdateStatus
+logGUpdateStatus st gId = logDLR st . GRUpdateStatus gId
 
 logGUpdateOwner :: DirectoryStore -> GroupId -> GroupMemberId -> IO ()
-logGUpdateOwner st = logDLR st .: GRUpdateOwner
+logGUpdateOwner st gId = logDLR st . GRUpdateOwner gId
 
 instance StrEncoding DLRTag where
   strEncode = \case
@@ -271,10 +345,10 @@ instance StrEncoding GroupRegStatus where
       "removed" -> pure GRSRemoved
       _ -> fail "invalid GroupRegStatus"
 
-dataToGroupReg :: GroupRegData -> STM GroupReg
+dataToGroupReg :: GroupRegData -> IO GroupReg
 dataToGroupReg GroupRegData {dbGroupId_, userGroupRegId_, dbContactId_, dbOwnerMemberId_, groupRegStatus_} = do
-  dbOwnerMemberId <- newTVar dbOwnerMemberId_
+  dbOwnerMemberId <- newTVarIO dbOwnerMemberId_
-  groupRegStatus <- newTVar groupRegStatus_
+  groupRegStatus <- newTVarIO groupRegStatus_
   pure
     GroupReg
       { dbGroupId = dbGroupId_,
@@ -286,10 +360,9 @@ dataToGroupReg GroupRegData {dbGroupId_, userGroupRegId_, dbContactId_, dbOwnerM
 
 restoreDirectoryStore :: Maybe FilePath -> IO DirectoryStore
 restoreDirectoryStore = \case
-  Just f -> ifM (doesFileExist f) (restore f) (newFile f >>= new . Just)
+  Just f -> ifM (doesFileExist f) (restore f) (newFile f >>= newDirectoryStore . Just)
-  Nothing -> new Nothing
+  Nothing -> newDirectoryStore Nothing
   where
-    new = atomically . newDirectoryStore
     newFile f = do
       h <- openFile f WriteMode
       hSetBuffering h LineBuffering
@@ -298,15 +371,15 @@ restoreDirectoryStore = \case
       grs <- readDirectoryData f
       renameFile f (f <> ".bak")
       h <- writeDirectoryData f grs -- compact
-      atomically $ mkDirectoryStore h grs
+      mkDirectoryStore h grs
 
 emptyStoreData :: ([GroupReg], Set GroupId, Set GroupId)
 emptyStoreData = ([], S.empty, S.empty)
 
-newDirectoryStore :: Maybe Handle -> STM DirectoryStore
+newDirectoryStore :: Maybe Handle -> IO DirectoryStore
 newDirectoryStore = (`mkDirectoryStore_` emptyStoreData)
 
-mkDirectoryStore :: Handle -> [GroupRegData] -> STM DirectoryStore
+mkDirectoryStore :: Handle -> [GroupRegData] -> IO DirectoryStore
 mkDirectoryStore h groups =
   foldM addGroupRegData emptyStoreData groups >>= mkDirectoryStore_ (Just h)
   where
@@ -318,11 +391,11 @@ mkDirectoryStore h groups =
         DSReserved -> (grs', listed, S.insert gId reserved)
         DSRegistered -> (grs', listed, reserved)
 
-mkDirectoryStore_ :: Maybe Handle -> ([GroupReg], Set GroupId, Set GroupId) -> STM DirectoryStore
+mkDirectoryStore_ :: Maybe Handle -> ([GroupReg], Set GroupId, Set GroupId) -> IO DirectoryStore
 mkDirectoryStore_ h (grs, listed, reserved) = do
-  groupRegs <- newTVar grs
+  groupRegs <- newTVarIO grs
-  listedGroups <- newTVar listed
+  listedGroups <- newTVarIO listed
-  reservedGroups <- newTVar reserved
+  reservedGroups <- newTVarIO reserved
   pure DirectoryStore {groupRegs, listedGroups, reservedGroups, directoryLogFile = h}
 
 readDirectoryData :: FilePath -> IO [GroupRegData]

simplex-chat.cabal

@@ -416,13 +416,17 @@ executable simplex-directory-service
       Paths_simplex_chat
   ghc-options: -O2 -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=missing-methods -Werror=incomplete-uni-patterns -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -threaded
   build-depends:
-      async ==2.2.*
+      aeson ==2.2.*
+    , async ==2.2.*
     , attoparsec ==0.14.*
     , base >=4.7 && <5
     , composition ==1.0.*
     , containers ==0.6.*
     , directory ==1.3.*
+    , mtl >=2.3.1 && <3.0
     , optparse-applicative >=0.15 && <0.17
+    , process >=1.6 && <1.6.18
+    , random >=1.1 && <1.3
     , simple-logger ==0.1.*
     , simplex-chat
     , simplexmq >=6.3
@@ -470,6 +474,7 @@ test-suite simplex-chat-test
       ViewTests
       Broadcast.Bot
       Broadcast.Options
+      Directory.BlockedWords
       Directory.Events
       Directory.Options
       Directory.Search
@@ -512,6 +517,7 @@ test-suite simplex-chat-test
     , mtl >=2.3.1 && <3.0
     , network ==3.1.*
     , optparse-applicative >=0.15 && <0.17
+    , random >=1.1 && <1.3
     , silently ==1.2.*
     , simple-logger ==0.1.*
     , simplex-chat

src/Simplex/Chat.hs

@@ -112,9 +112,6 @@ defaultChatConfig =
             ntf = _defaultNtfServers,
             netCfg = defaultNetworkConfig
           },
-      allowedProfileName = Nothing,
-      profileNameLimit = maxBound,
-      acceptAsObserver = Nothing,
       tbqSize = 1024,
       fileChunkSize = 15780, -- do not change
       xftpDescrPartSize = 14000,

src/Simplex/Chat/Bot.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE TupleSections #-}
 
 module Simplex.Chat.Bot where
 
@@ -11,6 +12,8 @@ import Control.Concurrent.Async
 import Control.Concurrent.STM
 import Control.Monad
 import qualified Data.ByteString.Char8 as B
+import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as L
 import qualified Data.Map.Strict as M
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -68,10 +71,16 @@ sendComposedMessage :: ChatController -> Contact -> Maybe ChatItemId -> MsgConte
 sendComposedMessage cc = sendComposedMessage' cc . contactId'
 
 sendComposedMessage' :: ChatController -> ContactId -> Maybe ChatItemId -> MsgContent -> IO ()
-sendComposedMessage' cc ctId quotedItemId msgContent = do
+sendComposedMessage' cc ctId qiId mc = sendComposedMessages_ cc (SRDirect ctId) [(qiId, mc)]
-  let cm = ComposedMessage {fileSource = Nothing, quotedItemId, msgContent, mentions = M.empty}
+
-  sendChatCmd cc (APISendMessages (ChatRef CTDirect ctId) False Nothing [cm]) >>= \case
+sendComposedMessages :: ChatController -> SendRef -> NonEmpty MsgContent -> IO ()
-    CRNewChatItems {} -> printLog cc CLLInfo $ "sent message to contact ID " <> show ctId
+sendComposedMessages cc sendRef = sendComposedMessages_ cc sendRef . L.map (Nothing,)
+
+sendComposedMessages_ :: ChatController -> SendRef -> NonEmpty (Maybe ChatItemId, MsgContent) -> IO ()
+sendComposedMessages_ cc sendRef qmcs = do
+  let cms = L.map (\(qiId, mc) -> ComposedMessage {fileSource = Nothing, quotedItemId = qiId, msgContent = mc, mentions = M.empty}) qmcs
+  sendChatCmd cc (APISendMessages sendRef False Nothing cms) >>= \case
+    CRNewChatItems {} -> printLog cc CLLInfo $ "sent " <> show (length cms) <> " messages to " <> show sendRef
     r -> putStrLn $ "unexpected send message response: " <> show r
 
 deleteMessage :: ChatController -> Contact -> ChatItemId -> IO ()

src/Simplex/Chat/Controller.hs

@@ -19,7 +19,8 @@ module Simplex.Chat.Controller where
 
 import Control.Concurrent (ThreadId)
 import Control.Concurrent.Async (Async)
-import Control.Exception
+import Control.Exception (Exception, SomeException)
+import qualified Control.Exception as E
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
@@ -60,7 +61,7 @@ import Simplex.Chat.Protocol
 import Simplex.Chat.Remote.AppVersion
 import Simplex.Chat.Remote.Types
 import Simplex.Chat.Stats (PresentedServersSummary)
-import Simplex.Chat.Store (AutoAccept, ChatLockEntity, StoreError (..), UserContactLink, UserMsgReceiptSettings)
+import Simplex.Chat.Store (AutoAccept, ChatLockEntity, StoreError (..), UserContactLink, GroupLinkInfo, UserMsgReceiptSettings)
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
@@ -93,7 +94,6 @@ import Simplex.RemoteControl.Invitation (RCSignedInvitation, RCVerifiedInvitatio
 import Simplex.RemoteControl.Types
 import System.IO (Handle)
 import System.Mem.Weak (Weak)
-import qualified UnliftIO.Exception as E
 import UnliftIO.STM
 #if !defined(dbPostgres)
 import Database.SQLite.Simple (SQLError)
@@ -137,9 +137,6 @@ data ChatConfig = ChatConfig
     chatVRange :: VersionRangeChat,
     confirmMigrations :: MigrationConfirmation,
     presetServers :: PresetServers,
-    allowedProfileName :: Maybe (ContactName -> Bool),
-    profileNameLimit :: Int,
-    acceptAsObserver :: Maybe AcceptAsObserver,
     tbqSize :: Natural,
     fileChunkSize :: Integer,
     xftpDescrPartSize :: Int,
@@ -161,11 +158,6 @@ data ChatConfig = ChatConfig
     chatHooks :: ChatHooks
   }
 
-data AcceptAsObserver
-  = AOAll -- all members
-  | AONameOnly -- members without image
-  | AOIncognito -- members with incognito-style names and without image
-
 data RandomAgentServers = RandomAgentServers
   { smpServers :: NonEmpty (ServerCfg 'PSMP),
     xftpServers :: NonEmpty (ServerCfg 'PXFTP)
@@ -177,18 +169,16 @@ data ChatHooks = ChatHooks
   { -- preCmdHook can be used to process or modify the commands before they are processed.
     -- This hook should be used to process CustomChatCommand.
     -- if this hook returns ChatResponse, the command processing will be skipped.
-    preCmdHook :: ChatController -> ChatCommand -> IO (Either ChatResponse ChatCommand),
+    preCmdHook :: Maybe (ChatController -> ChatCommand -> IO (Either ChatResponse ChatCommand)),
     -- eventHook can be used to additionally process or modify events,
     -- it is called before the event is sent to the user (or to the UI).
-    eventHook :: ChatController -> ChatResponse -> IO ChatResponse
+    eventHook :: Maybe (ChatController -> ChatResponse -> IO ChatResponse),
+    -- acceptMember hook can be used to accept or reject member connecting via group link without API calls
+    acceptMember :: Maybe (GroupInfo -> GroupLinkInfo -> Profile -> IO (Either GroupRejectionReason (GroupAcceptance, GroupMemberRole)))
   }
 
 defaultChatHooks :: ChatHooks
-defaultChatHooks =
+defaultChatHooks = ChatHooks Nothing Nothing Nothing
-  ChatHooks
-    { preCmdHook = \_ -> pure . Right,
-      eventHook = \_ -> pure
-    }
 
 data PresetServers = PresetServers
   { operators :: NonEmpty PresetOperator,
@@ -313,7 +303,7 @@ data ChatCommand
   | APIGetChat ChatRef (Maybe MsgContentTag) ChatPagination (Maybe String)
   | APIGetChatItems ChatPagination (Maybe String)
   | APIGetChatItemInfo ChatRef ChatItemId
-  | APISendMessages {chatRef :: ChatRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessages :: NonEmpty ComposedMessage}
+  | APISendMessages {sendRef :: SendRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessages :: NonEmpty ComposedMessage}
   | APICreateChatTag ChatTagData
   | APISetChatTags ChatRef (Maybe (NonEmpty ChatTagId))
   | APIDeleteChatTag ChatTagId
@@ -366,6 +356,7 @@ data ChatCommand
   | ApiGetConnNtfMessages {connIds :: NonEmpty AgentConnId}
   | APIAddMember GroupId ContactId GroupMemberRole
   | APIJoinGroup {groupId :: GroupId, enableNtfs :: MsgFilter}
+  | APIAcceptMember GroupId GroupMemberId GroupMemberRole
   | APIMembersRole GroupId (NonEmpty GroupMemberId) GroupMemberRole
   | APIBlockMembersForAll GroupId (NonEmpty GroupMemberId) Bool
   | APIRemoveMembers GroupId (NonEmpty GroupMemberId)
@@ -906,6 +897,17 @@ logResponseToFile = \case
   CRMessageError {} -> True
   _ -> False
 
+-- (Maybe GroupMemberId) can later be changed to GroupSndScope = GSSAll | GSSAdmins | GSSMember GroupMemberId
+data SendRef
+  = SRDirect ContactId
+  | SRGroup GroupId (Maybe GroupMemberId)
+  deriving (Eq, Show)
+
+sendToChatRef :: SendRef -> ChatRef
+sendToChatRef = \case
+  SRDirect cId -> ChatRef CTDirect cId
+  SRGroup gId _ -> ChatRef CTGroup gId
+
 data ChatPagination
   = CPLast Int
   | CPAfter ChatItemId Int
@@ -1509,7 +1511,9 @@ toView = lift . toView'
 toView' :: ChatResponse -> CM' ()
 toView' ev = do
   cc@ChatController {outputQ = localQ, remoteCtrlSession = session, config = ChatConfig {chatHooks}} <- ask
-  event <- liftIO $ eventHook chatHooks cc ev
+  event <- case eventHook chatHooks of
+    Just hook -> liftIO $ hook cc ev
+    Nothing -> pure ev
   atomically $
     readTVar session >>= \case
       Just (_, RCSessionConnected {remoteOutputQ})
@@ -1544,7 +1548,7 @@ withStoreBatch actions = do
   liftIO $ withTransaction chatStore $ mapM (`E.catches` handleDBErrors) . actions
 
 -- TODO [postgres] postgres specific error handling
-handleDBErrors :: [E.Handler IO (Either ChatError a)]
+handleDBErrors :: [E.Handler (Either ChatError a)]
 handleDBErrors =
 #if !defined(dbPostgres)
   ( E.Handler $ \(e :: SQLError) ->

src/Simplex/Chat/Library/Commands.hs

@@ -277,7 +277,9 @@ execChatCommand rh s = do
         | otherwise -> pure $ CRChatCmdError u $ ChatErrorRemoteHost (RHId rhId) $ RHELocalCommand
       _ -> do
         cc@ChatController {config = ChatConfig {chatHooks}} <- ask
-        liftIO (preCmdHook chatHooks cc cmd) >>= either pure (execChatCommand_ u)
+        case preCmdHook chatHooks of
+          Just hook -> liftIO (hook cc cmd) >>= either pure (execChatCommand_ u)
+          Nothing -> execChatCommand_ u cmd
 
 execChatCommand' :: ChatCommand -> CM' ChatResponse
 execChatCommand' cmd = asks currentUser >>= readTVarIO >>= (`execChatCommand_` cmd)
@@ -536,20 +538,17 @@ processChatCommand' vr = \case
         Just (CIFFGroup _ _ (Just gId) (Just fwdItemId)) ->
           Just <$> withFastStore (\db -> getAChatItem db vr user (ChatRef CTGroup gId) fwdItemId)
         _ -> pure Nothing
-  APISendMessages (ChatRef cType chatId) live itemTTL cms -> withUser $ \user -> mapM_ assertAllowedContent' cms >> case cType of
+  APISendMessages sendRef live itemTTL cms -> withUser $ \user -> mapM_ assertAllowedContent' cms >> case sendRef of
-    CTDirect -> do
+    SRDirect chatId -> do
       mapM_ assertNoMentions cms
       withContactLock "sendMessage" chatId $
         sendContactContentMessages user chatId live itemTTL (L.map composedMessageReq cms)
-    CTGroup ->
+    SRGroup chatId directMemId_ ->
       withGroupLock "sendMessage" chatId $ do
         (gInfo, cmrs) <- withFastStore $ \db -> do
           g <- getGroupInfo db vr user chatId
           (g,) <$> mapM (composedMessageReqMentions db user g) cms
-        sendGroupContentMessages user gInfo live itemTTL cmrs
+        sendGroupContentMessages user gInfo directMemId_ live itemTTL cmrs
-    CTLocal -> pure $ chatCmdError (Just user) "not supported"
-    CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
-    CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
   APICreateChatTag (ChatTagData emoji text) -> withUser $ \user -> withFastStore' $ \db -> do
     _ <- createChatTag db user emoji text
     CRChatTags user <$> getUserChatTags db user
@@ -583,7 +582,8 @@ processChatCommand' vr = \case
           mc = MCReport reportText reportReason
           cm = ComposedMessage {fileSource = Nothing, quotedItemId = Just reportedItemId, msgContent = mc, mentions = M.empty}
       when (null ms') $ throwChatError $ CECommandError "no moderators support receiving reports"
-      sendGroupContentMessages_ user gInfo ms' False Nothing [composedMessageReq cm]
+      let numFileInvs = length $ filter memberCurrent ms'
+      sendGroupContentMessages_ user gInfo Nothing ms' numFileInvs False Nothing [composedMessageReq cm]
     where
       compatibleModerator GroupMember {activeConn, memberChatVRange} =
         maxVersion (maybe memberChatVRange peerChatVRange activeConn) >= contentReportsVersion
@@ -633,6 +633,7 @@ processChatCommand' vr = \case
                     then do
                       ciMentions <- withFastStore $ \db -> getCIMentions db user gInfo ft_ mentions
                       let mentions' = M.map (\CIMention {memberId} -> MsgMention {memberId}) ciMentions
+                      -- TODO [knocking] send separately to pending approval member
                       SndMessage {msgId} <- sendGroupMessage user gInfo ms (XMsgUpdate itemSharedMId mc mentions' (ttl' <$> itemTimed) (justTrue . (live &&) =<< itemLive))
                       ci' <- withFastStore' $ \db -> do
                         currentTs <- liftIO getCurrentTime
@@ -687,6 +688,7 @@ processChatCommand' vr = \case
           assertUserGroupRole gInfo GRObserver -- can still delete messages sent earlier
           let msgIds = itemsMsgIds items
               events = L.nonEmpty $ map (`XMsgDel` Nothing) msgIds
+          -- TODO [knocking] validate: only current members or only single pending approval member
           mapM_ (sendGroupMessages user gInfo ms) events
           delGroupChatItems user gInfo items False
     CTLocal -> do
@@ -764,6 +766,7 @@ processChatCommand' vr = \case
             let GroupMember {memberId = itemMemberId} = chatItemMember g ci
             rs <- withFastStore' $ \db -> getGroupReactions db g membership itemMemberId itemSharedMId True
             checkReactionAllowed rs
+            -- TODO [knocking] send separately to pending approval member
             SndMessage {msgId} <- sendGroupMessage user g ms (XMsgReact itemSharedMId (Just itemMemberId) reaction add)
             createdAt <- liftIO getCurrentTime
             reactions <- withFastStore' $ \db -> do
@@ -847,7 +850,7 @@ processChatCommand' vr = \case
         Just cmrs' ->
           withGroupLock "forwardChatItem, to group" toChatId $ do
             gInfo <- withFastStore $ \db -> getGroupInfo db vr user toChatId
-            sendGroupContentMessages user gInfo False itemTTL cmrs'
+            sendGroupContentMessages user gInfo Nothing False itemTTL cmrs'
         Nothing -> pure $ CRNewChatItems user []
     CTLocal -> do
       cmrs <- prepareForward user
@@ -1084,6 +1087,7 @@ processChatCommand' vr = \case
         cancelFilesInProgress user filesInfo
         deleteFilesLocally filesInfo
         let doSendDel = memberActive membership && isOwner
+        -- TODO [knocking] send to pending approval members (move `memberCurrent` filter from sendGroupMessages_ to call sites)
         when doSendDel . void $ sendGroupMessage' user gInfo members XGrpDel
         deleteGroupLinkIfExists user gInfo
         deleteMembersConnections' user members doSendDel
@@ -1127,7 +1131,7 @@ processChatCommand' vr = \case
       (user@User {userId}, cReq) <- withFastStore $ \db -> getContactRequest' db connReqId
       (ct, conn@Connection {connId}, sqSecured) <- acceptContactRequest user cReq incognito
       ucl <- withFastStore $ \db -> getUserContactLinkById db userId userContactLinkId
-      let contactUsed = (\(_, groupId_, _) -> isNothing groupId_) ucl
+      let contactUsed = (\(_, gLinkInfo_) -> isNothing gLinkInfo_) ucl
       ct' <- withStore' $ \db -> do
         deleteContactRequestRec db user cReq
         updateContactAccepted db user ct contactUsed
@@ -1838,8 +1842,8 @@ processChatCommand' vr = \case
       CTDirect ->
         withFastStore' (\db -> runExceptT $ getContactIdByName db user name) >>= \case
           Right ctId -> do
-            let chatRef = ChatRef CTDirect ctId
+            let sendRef = SRDirect ctId
-            processChatCommand $ APISendMessages chatRef False Nothing [composedMessage Nothing mc]
+            processChatCommand $ APISendMessages sendRef False Nothing [composedMessage Nothing mc]
           Left _ ->
             withFastStore' (\db -> runExceptT $ getActiveMembersByName db vr user name) >>= \case
               Right [(gInfo, member)] -> do
@@ -1854,8 +1858,8 @@ processChatCommand' vr = \case
         (gId, mentions) <- withFastStore $ \db -> do
           gId <- getGroupIdByName db user name
           (gId,) <$> liftIO (getMessageMentions db user gId msg)
-        let chatRef = ChatRef CTGroup gId
+        let sendRef = SRGroup gId Nothing
-        processChatCommand $ APISendMessages chatRef False Nothing [ComposedMessage Nothing Nothing mc mentions]
+        processChatCommand $ APISendMessages sendRef False Nothing [ComposedMessage Nothing Nothing mc mentions]
       CTLocal
         | name == "" -> do
             folderId <- withFastStore (`getUserNoteFolderId` user)
@@ -1877,12 +1881,13 @@ processChatCommand' vr = \case
             processChatCommand $ APISendMemberContactInvitation contactId (Just mc)
           cr -> pure cr
       Just ctId -> do
-        let chatRef = ChatRef CTDirect ctId
+        let sendRef = SRDirect ctId
-        processChatCommand $ APISendMessages chatRef False Nothing [composedMessage Nothing mc]
+        processChatCommand $ APISendMessages sendRef False Nothing [composedMessage Nothing mc]
   SendLiveMessage chatName msg -> withUser $ \user -> do
     (chatRef, mentions) <- getChatRefAndMentions user chatName msg
-    let mc = MCText msg
+    withSendRef chatRef $ \sendRef -> do
-    processChatCommand $ APISendMessages chatRef True Nothing [ComposedMessage Nothing Nothing mc mentions]
+      let mc = MCText msg
+      processChatCommand $ APISendMessages sendRef True Nothing [ComposedMessage Nothing Nothing mc mentions]
   SendMessageBroadcast msg -> withUser $ \user -> do
     contacts <- withFastStore' $ \db -> getUserContacts db vr user
     withChatLock "sendMessageBroadcast" . procCmd $ do
@@ -1922,12 +1927,12 @@ processChatCommand' vr = \case
       combineResults _ _ (Left e) = Left e
       createCI :: DB.Connection -> User -> UTCTime -> (Contact, SndMessage) -> IO ()
       createCI db user createdAt (ct, sndMsg) =
-        void $ createNewSndChatItem db user (CDDirectSnd ct) sndMsg (CISndMsgContent mc) Nothing Nothing Nothing False createdAt
+        void $ createNewSndChatItem db user (CDDirectSnd ct) Nothing sndMsg (CISndMsgContent mc) Nothing Nothing Nothing False createdAt
   SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \user@User {userId} -> do
     contactId <- withFastStore $ \db -> getContactIdByName db user cName
     quotedItemId <- withFastStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir quotedMsg
     let mc = MCText msg
-    processChatCommand $ APISendMessages (ChatRef CTDirect contactId) False Nothing [ComposedMessage Nothing (Just quotedItemId) mc M.empty]
+    processChatCommand $ APISendMessages (SRDirect contactId) False Nothing [ComposedMessage Nothing (Just quotedItemId) mc M.empty]
   DeleteMessage chatName deletedMsg -> withUser $ \user -> do
     chatRef <- getChatRef user chatName
     deletedItemId <- getSentChatItemIdByText user chatRef deletedMsg
@@ -2023,14 +2028,27 @@ processChatCommand' vr = \case
           updateCIGroupInvitationStatus user g CIGISAccepted `catchChatError` (toView . CRChatError (Just user))
           pure $ CRUserAcceptedGroupSent user g {membership = membership {memberStatus = GSMemAccepted}} Nothing
         Nothing -> throwChatError $ CEContactNotActive ct
+  APIAcceptMember groupId gmId role -> withUser $ \user -> do
+    (gInfo, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user groupId <*> getGroupMemberById db vr user gmId
+    assertUserGroupRole gInfo GRAdmin
+    when (memberStatus m /= GSMemPendingApproval) $ throwChatError $ CECommandError "member is not pending approval"
+    case memberConn m of
+      Just mConn -> do
+        let msg = XGrpLinkAcpt role
+        void $ sendDirectMemberMessage mConn msg groupId
+        m' <- withFastStore' $ \db -> updateGroupMemberAccepted db user m role
+        introduceToGroup vr user gInfo m'
+        pure $ CRJoinedGroupMember user gInfo m'
+      _ -> throwChatError CEGroupMemberNotActive
   APIMembersRole groupId memberIds newRole -> withUser $ \user ->
     withGroupLock "memberRole" groupId . procCmd $ do
       g@(Group gInfo members) <- withFastStore $ \db -> getGroup db vr user groupId
       when (selfSelected gInfo) $ throwChatError $ CECommandError "can't change role for self"
-      let (invitedMems, currentMems, unchangedMems, maxRole, anyAdmin) = selectMembers members
+      let (invitedMems, currentMems, unchangedMems, maxRole, anyAdmin, anyPending) = selectMembers members
       when (length invitedMems + length currentMems + length unchangedMems /= length memberIds) $ throwChatError CEGroupMemberNotFound
       when (length memberIds > 1 && (anyAdmin || newRole >= GRAdmin)) $
         throwChatError $ CECommandError "can't change role of multiple members when admins selected, or new role is admin"
+      when anyPending $ throwChatError $ CECommandError "can't change role of members pending approval"
       assertUserGroupRole gInfo $ maximum ([GRAdmin, maxRole, newRole] :: [GroupMemberRole])
       (errs1, changed1) <- changeRoleInvitedMems user gInfo invitedMems
       (errs2, changed2, acis) <- changeRoleCurrentMems user g currentMems
@@ -2040,19 +2058,20 @@ processChatCommand' vr = \case
       pure $ CRMembersRoleUser {user, groupInfo = gInfo, members = changed1 <> changed2, toRole = newRole} -- same order is not guaranteed
     where
       selfSelected GroupInfo {membership} = elem (groupMemberId' membership) memberIds
-      selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool)
+      selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool, Bool)
-      selectMembers = foldr' addMember ([], [], [], GRObserver, False)
+      selectMembers = foldr' addMember ([], [], [], GRObserver, False, False)
         where
-          addMember m@GroupMember {groupMemberId, memberStatus, memberRole} (invited, current, unchanged, maxRole, anyAdmin)
+          addMember m@GroupMember {groupMemberId, memberStatus, memberRole} (invited, current, unchanged, maxRole, anyAdmin, anyPending)
             | groupMemberId `elem` memberIds =
                 let maxRole' = max maxRole memberRole
                     anyAdmin' = anyAdmin || memberRole >= GRAdmin
+                    anyPending' = anyPending || memberStatus == GSMemPendingApproval
                  in
                   if
-                    | memberRole == newRole -> (invited, current, m : unchanged, maxRole', anyAdmin')
+                    | memberRole == newRole -> (invited, current, m : unchanged, maxRole', anyAdmin', anyPending')
-                    | memberStatus == GSMemInvited -> (m : invited, current, unchanged, maxRole', anyAdmin')
+                    | memberStatus == GSMemInvited -> (m : invited, current, unchanged, maxRole', anyAdmin', anyPending')
-                    | otherwise -> (invited, m : current, unchanged, maxRole', anyAdmin')
+                    | otherwise -> (invited, m : current, unchanged, maxRole', anyAdmin', anyPending')
-            | otherwise = (invited, current, unchanged, maxRole, anyAdmin)
+            | otherwise = (invited, current, unchanged, maxRole, anyAdmin, anyPending)
       changeRoleInvitedMems :: User -> GroupInfo -> [GroupMember] -> CM ([ChatError], [GroupMember])
       changeRoleInvitedMems user gInfo memsToChange = do
         -- not batched, as we need to send different invitations to different connections anyway
@@ -2074,7 +2093,7 @@ processChatCommand' vr = \case
           let events = L.map (\GroupMember {memberId} -> XGrpMemRole memberId newRole) memsToChange'
           (msgs_, _gsr) <- sendGroupMessages user gInfo members events
           let itemsData = zipWith (fmap . sndItemData) memsToChange (L.toList msgs_)
-          cis_ <- saveSndChatItems user (CDGroupSnd gInfo) itemsData Nothing False
+          cis_ <- saveSndChatItems user (CDGroupSnd gInfo) Nothing itemsData Nothing False
           when (length cis_ /= length memsToChange) $ logError "changeRoleCurrentMems: memsToChange and cis_ length mismatch"
           (errs, changed) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (updMember db) memsToChange)
           let acis = map (AChatItem SCTGroup SMDSnd (GroupChat gInfo)) $ rights cis_
@@ -2084,7 +2103,7 @@ processChatCommand' vr = \case
             sndItemData GroupMember {groupMemberId, memberProfile} msg =
               let content = CISndGroupEvent $ SGEMemberRole groupMemberId (fromLocalProfile memberProfile) newRole
                   ts = ciContentTexts content
-                in NewSndChatItemData msg content ts M.empty Nothing Nothing Nothing
+               in NewSndChatItemData msg content ts M.empty Nothing Nothing Nothing
             updMember db m = do
               updateGroupMemberRole db user m newRole
               pure (m :: GroupMember) {memberRole = newRole}
@@ -2092,22 +2111,24 @@ processChatCommand' vr = \case
     withGroupLock "blockForAll" groupId . procCmd $ do
       Group gInfo members <- withFastStore $ \db -> getGroup db vr user groupId
       when (selfSelected gInfo) $ throwChatError $ CECommandError "can't block/unblock self"
-      let (blockMems, remainingMems, maxRole, anyAdmin) = selectMembers members
+      let (blockMems, remainingMems, maxRole, anyAdmin, anyPending) = selectMembers members
       when (length blockMems /= length memberIds) $ throwChatError CEGroupMemberNotFound
       when (length memberIds > 1 && anyAdmin) $ throwChatError $ CECommandError "can't block/unblock multiple members when admins selected"
+      when anyPending $ throwChatError $ CECommandError "can't block/unblock members pending approval"
       assertUserGroupRole gInfo $ max GRModerator maxRole
       blockMembers user gInfo blockMems remainingMems
     where
       selfSelected GroupInfo {membership} = elem (groupMemberId' membership) memberIds
-      selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], GroupMemberRole, Bool)
+      selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], GroupMemberRole, Bool, Bool)
-      selectMembers = foldr' addMember ([], [], GRObserver, False)
+      selectMembers = foldr' addMember ([], [], GRObserver, False, False)
         where
-          addMember m@GroupMember {groupMemberId, memberRole} (block, remaining, maxRole, anyAdmin)
+          addMember m@GroupMember {groupMemberId, memberRole, memberStatus} (block, remaining, maxRole, anyAdmin, anyPending)
             | groupMemberId `elem` memberIds =
                 let maxRole' = max maxRole memberRole
                     anyAdmin' = anyAdmin || memberRole >= GRAdmin
-                 in (m : block, remaining, maxRole', anyAdmin')
+                    anyPending' = anyPending || memberStatus == GSMemPendingApproval
-            | otherwise = (block, m : remaining, maxRole, anyAdmin)
+                 in (m : block, remaining, maxRole', anyAdmin', anyPending')
+            | otherwise = (block, m : remaining, maxRole, anyAdmin, anyPending)
       blockMembers :: User -> GroupInfo -> [GroupMember] -> [GroupMember] -> CM ChatResponse
       blockMembers user gInfo blockMems remainingMems = case L.nonEmpty blockMems of
         Nothing -> throwChatError $ CECommandError "no members to block/unblock"
@@ -2116,7 +2137,7 @@ processChatCommand' vr = \case
               events = L.map (\GroupMember {memberId} -> XGrpMemRestrict memberId MemberRestrictions {restriction = mrs}) blockMems'
           (msgs_, _gsr) <- sendGroupMessages user gInfo remainingMems events
           let itemsData = zipWith (fmap . sndItemData) blockMems (L.toList msgs_)
-          cis_ <- saveSndChatItems user (CDGroupSnd gInfo) itemsData Nothing False
+          cis_ <- saveSndChatItems user (CDGroupSnd gInfo) Nothing itemsData Nothing False
           when (length cis_ /= length blockMems) $ logError "blockMembers: blockMems and cis_ length mismatch"
           let acis = map (AChatItem SCTGroup SMDSnd (GroupChat gInfo)) $ rights cis_
           unless (null acis) $ toView $ CRNewChatItems user acis
@@ -2130,33 +2151,37 @@ processChatCommand' vr = \case
           sndItemData GroupMember {groupMemberId, memberProfile} msg =
             let content = CISndGroupEvent $ SGEMemberBlocked groupMemberId (fromLocalProfile memberProfile) blockFlag
                 ts = ciContentTexts content
-              in NewSndChatItemData msg content ts M.empty Nothing Nothing Nothing
+             in NewSndChatItemData msg content ts M.empty Nothing Nothing Nothing
   APIRemoveMembers groupId memberIds -> withUser $ \user ->
     withGroupLock "removeMembers" groupId . procCmd $ do
-      g@(Group gInfo members) <- withFastStore $ \db -> getGroup db vr user groupId
+      Group gInfo members <- withFastStore $ \db -> getGroup db vr user groupId
-      let (invitedMems, currentMems, maxRole, anyAdmin) = selectMembers members
+      let (invitedMems, pendingMems, currentMems, maxRole, anyAdmin) = selectMembers members
-      when (length invitedMems + length currentMems /= length memberIds) $ throwChatError CEGroupMemberNotFound
+      when (length invitedMems + length pendingMems + length currentMems /= length memberIds) $ throwChatError CEGroupMemberNotFound
       when (length memberIds > 1 && anyAdmin) $ throwChatError $ CECommandError "can't remove multiple members when admins selected"
       assertUserGroupRole gInfo $ max GRAdmin maxRole
       (errs1, deleted1) <- deleteInvitedMems user invitedMems
-      (errs2, deleted2, acis) <- deleteCurrentMems user g currentMems
+      (errs2, deleted2, acis2) <- deleteMemsSend user gInfo members currentMems
+      rs <- forM pendingMems $ \m -> deleteMemsSend user gInfo [m] [m]
+      let (errs3, deleted3, acis3) = concatTuples rs
+          acis = acis2 <> acis3
+          errs = errs1 <> errs2 <> errs3
       unless (null acis) $ toView $ CRNewChatItems user acis
-      let errs = errs1 <> errs2
       unless (null errs) $ toView $ CRChatErrors (Just user) errs
-      pure $ CRUserDeletedMembers user gInfo (deleted1 <> deleted2) -- same order is not guaranteed
+      pure $ CRUserDeletedMembers user gInfo (deleted1 <> deleted2 <> deleted3) -- same order is not guaranteed
     where
-      selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], GroupMemberRole, Bool)
+      selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool)
-      selectMembers = foldr' addMember ([], [], GRObserver, False)
+      selectMembers = foldr' addMember ([], [], [], GRObserver, False)
         where
-          addMember m@GroupMember {groupMemberId, memberStatus, memberRole} (invited, current, maxRole, anyAdmin)
+          addMember m@GroupMember {groupMemberId, memberStatus, memberRole} (invited, pending, current, maxRole, anyAdmin)
             | groupMemberId `elem` memberIds =
                 let maxRole' = max maxRole memberRole
                     anyAdmin' = anyAdmin || memberRole >= GRAdmin
                  in
-                  if memberStatus == GSMemInvited
+                  case memberStatus of
-                    then (m : invited, current, maxRole', anyAdmin')
+                    GSMemInvited -> (m : invited, pending, current, maxRole', anyAdmin')
-                    else (invited, m : current, maxRole', anyAdmin')
+                    GSMemPendingApproval -> (invited, m : pending, current, maxRole', anyAdmin')
-            | otherwise = (invited, current, maxRole, anyAdmin)
+                    _ -> (invited, pending, m : current, maxRole', anyAdmin')
+            | otherwise = (invited, pending, current, maxRole, anyAdmin)
       deleteInvitedMems :: User -> [GroupMember] -> CM ([ChatError], [GroupMember])
       deleteInvitedMems user memsToDelete = do
         deleteMembersConnections user memsToDelete
@@ -2165,14 +2190,14 @@ processChatCommand' vr = \case
           delMember db m = do
             deleteGroupMember db user m
             pure m {memberStatus = GSMemRemoved}
-      deleteCurrentMems :: User -> Group -> [GroupMember] -> CM ([ChatError], [GroupMember], [AChatItem])
+      deleteMemsSend :: User -> GroupInfo -> [GroupMember] -> [GroupMember] -> CM ([ChatError], [GroupMember], [AChatItem])
-      deleteCurrentMems user (Group gInfo members) memsToDelete = case L.nonEmpty memsToDelete of
+      deleteMemsSend user gInfo sendToMems memsToDelete = case L.nonEmpty memsToDelete of
         Nothing -> pure ([], [], [])
         Just memsToDelete' -> do
           let events = L.map (\GroupMember {memberId} -> XGrpMemDel memberId) memsToDelete'
-          (msgs_, _gsr) <- sendGroupMessages user gInfo members events
+          (msgs_, _gsr) <- sendGroupMessages user gInfo sendToMems events
           let itemsData = zipWith (fmap . sndItemData) memsToDelete (L.toList msgs_)
-          cis_ <- saveSndChatItems user (CDGroupSnd gInfo) itemsData Nothing False
+          cis_ <- saveSndChatItems user (CDGroupSnd gInfo) Nothing itemsData Nothing False
           when (length cis_ /= length memsToDelete) $ logError "deleteCurrentMems: memsToDelete and cis_ length mismatch"
           deleteMembersConnections' user memsToDelete True
           (errs, deleted) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (delMember db) memsToDelete)
@@ -2183,15 +2208,19 @@ processChatCommand' vr = \case
             sndItemData GroupMember {groupMemberId, memberProfile} msg =
               let content = CISndGroupEvent $ SGEMemberDeleted groupMemberId (fromLocalProfile memberProfile)
                   ts = ciContentTexts content
-                in NewSndChatItemData msg content ts M.empty Nothing Nothing Nothing
+               in NewSndChatItemData msg content ts M.empty Nothing Nothing Nothing
             delMember db m = do
               deleteOrUpdateMemberRecordIO db user m
               pure m {memberStatus = GSMemRemoved}
+      concatTuples :: [([a], [b], [c])] -> ([a], [b], [c])
+      concatTuples xs = (concat as, concat bs, concat cs)
+        where (as, bs, cs) = unzip3 xs
   APILeaveGroup groupId -> withUser $ \user@User {userId} -> do
     Group gInfo@GroupInfo {membership} members <- withFastStore $ \db -> getGroup db vr user groupId
     filesInfo <- withFastStore' $ \db -> getGroupFileInfo db user gInfo
     withGroupLock "leaveGroup" groupId . procCmd $ do
       cancelFilesInProgress user filesInfo
+      -- TODO [knocking] send to pending approval members (move `memberCurrent` filter from sendGroupMessages_ to call sites)
       msg <- sendGroupMessage' user gInfo members XGrpLeave
       ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft)
       toView $ CRNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci]
@@ -2320,7 +2349,7 @@ processChatCommand' vr = \case
         qiId <- getGroupChatItemIdByText db user gId cName quotedMsg
         (gId, qiId,) <$> liftIO (getMessageMentions db user gId msg)
     let mc = MCText msg
-    processChatCommand $ APISendMessages (ChatRef CTGroup groupId) False Nothing [ComposedMessage Nothing (Just quotedItemId) mc mentions]
+    processChatCommand $ APISendMessages (SRGroup groupId Nothing) False Nothing [ComposedMessage Nothing (Just quotedItemId) mc mentions]
   ClearNoteFolder -> withUser $ \user -> do
     folderId <- withFastStore (`getUserNoteFolderId` user)
     processChatCommand $ APIClearChat (ChatRef CTLocal folderId)
@@ -2361,15 +2390,16 @@ processChatCommand' vr = \case
     chatRef <- getChatRef user chatName
     case chatRef of
       ChatRef CTLocal folderId -> processChatCommand $ APICreateChatItems folderId [composedMessage (Just f) (MCFile "")]
-      _ -> processChatCommand $ APISendMessages chatRef False Nothing [composedMessage (Just f) (MCFile "")]
+      _ -> withSendRef chatRef $ \sendRef -> processChatCommand $ APISendMessages sendRef False Nothing [composedMessage (Just f) (MCFile "")]
   SendImage chatName f@(CryptoFile fPath _) -> withUser $ \user -> do
     chatRef <- getChatRef user chatName
-    filePath <- lift $ toFSFilePath fPath
+    withSendRef chatRef $ \sendRef -> do
-    unless (any (`isSuffixOf` map toLower fPath) imageExtensions) $ throwChatError CEFileImageType {filePath}
+      filePath <- lift $ toFSFilePath fPath
-    fileSize <- getFileSize filePath
+      unless (any (`isSuffixOf` map toLower fPath) imageExtensions) $ throwChatError CEFileImageType {filePath}
-    unless (fileSize <= maxImageSize) $ throwChatError CEFileImageSize {filePath}
+      fileSize <- getFileSize filePath
-    -- TODO include file description for preview
+      unless (fileSize <= maxImageSize) $ throwChatError CEFileImageSize {filePath}
-    processChatCommand $ APISendMessages chatRef False Nothing [composedMessage (Just f) (MCImage "" fixedImagePreview)]
+      -- TODO include file description for preview
+      processChatCommand $ APISendMessages sendRef False Nothing [composedMessage (Just f) (MCImage "" fixedImagePreview)]
   ForwardFile chatName fileId -> forwardFile chatName fileId SendFile
   ForwardImage chatName fileId -> forwardFile chatName fileId SendImage
   SendFileDescription _chatName _f -> pure $ chatCmdError Nothing "TODO"
@@ -2403,6 +2433,7 @@ processChatCommand' vr = \case
                   void . sendDirectContactMessage user contact $ XFileCancel sharedMsgId
                 Just (ChatRef CTGroup groupId) -> do
                   (Group gInfo ms, sharedMsgId) <- withFastStore $ \db -> (,) <$> getGroup db vr user groupId <*> getSharedMsgIdByFileId db userId fileId
+                  -- TODO [knocking] send separately to pending approval member
                   void . sendGroupMessage user gInfo ms $ XFileCancel sharedMsgId
                 Just _ -> throwChatError $ CEFileInternal "invalid chat ref for file transfer"
               ci <- withFastStore $ \db -> lookupChatItemByFileId db vr user fileId
@@ -2795,6 +2826,7 @@ processChatCommand' vr = \case
             GroupMember {memberProfile = LocalProfile {displayName, fullName, image}} <-
               withStore $ \db -> getGroupMemberByMemberId db vr user g businessId
             let p'' = p' {displayName, fullName, image} :: GroupProfile
+            -- TODO [knocking] send to pending approval members (move `memberCurrent` filter from sendGroupMessages_ to call sites)
             void $ sendGroupMessage user g' oldMs (XGrpInfo p'')
           let ps' = fromMaybe defaultBusinessGroupPrefs $ groupPreferences p'
           sendGroupMessage user g' newMs $ XGrpPrefs ps'
@@ -2823,6 +2855,8 @@ processChatCommand' vr = \case
       assertUserGroupRole gInfo GRAdmin -- TODO GRModerator when most users migrate
       let msgMemIds = itemsMsgMemIds gInfo items
           events = L.nonEmpty $ map (\(msgId, memId) -> XMsgDel msgId (Just memId)) msgMemIds
+      -- TODO [knocking] validate: only current members or only single pending approval member,
+      -- TODO            or prohibit pending approval members (only moderation and reports use this)
       mapM_ (sendGroupMessages user gInfo ms) events
       delGroupChatItems user gInfo items True
       where
@@ -3115,7 +3149,7 @@ processChatCommand' vr = \case
           msgs_ <- sendDirectContactMessages user ct $ L.map XMsgNew msgContainers
           let itemsData = prepareSndItemsData (L.toList cmrs) (L.toList ciFiles_) (L.toList quotedItems_) msgs_
           when (length itemsData /= length cmrs) $ logError "sendContactContentMessages: cmrs and itemsData length mismatch"
-          r@(_, cis) <- partitionEithers <$> saveSndChatItems user (CDDirectSnd ct) itemsData timed_ live
+          r@(_, cis) <- partitionEithers <$> saveSndChatItems user (CDDirectSnd ct) Nothing itemsData timed_ live
           processSendErrs user r
           forM_ (timed_ >>= timedDeleteAt') $ \deleteAt ->
             forM_ cis $ \ci ->
@@ -3151,14 +3185,26 @@ processChatCommand' vr = \case
                 quoteData ChatItem {content = CISndMsgContent qmc} = pure (qmc, CIQDirectSnd, True)
                 quoteData ChatItem {content = CIRcvMsgContent qmc} = pure (qmc, CIQDirectRcv, False)
                 quoteData _ = throwError SEInvalidQuote
-    sendGroupContentMessages :: User -> GroupInfo -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse
+    sendGroupContentMessages :: User -> GroupInfo -> Maybe GroupMemberId -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse
-    sendGroupContentMessages user gInfo live itemTTL cmrs = do
+    sendGroupContentMessages user gInfo@GroupInfo {membership} directMemId_ live itemTTL cmrs = do
       assertMultiSendable live cmrs
-      ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo
+      (ms, numFileInvs, notInHistory_) <- case directMemId_ of
-      sendGroupContentMessages_ user gInfo ms live itemTTL cmrs
+        Nothing -> do
-    sendGroupContentMessages_ :: User -> GroupInfo -> [GroupMember] -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse
+          ms <- withFastStore' $ \db -> getGroupMembers db vr user gInfo
-    sendGroupContentMessages_ user gInfo@GroupInfo {groupId, membership} ms live itemTTL cmrs = do
+          pure (ms, length $ filter memberCurrent ms, Nothing)
-      assertUserGroupRole gInfo GRAuthor
+        Just dmId -> do
+          when (dmId == groupMemberId' membership) $ throwChatError $ CECommandError "cannot send to self"
+          dm <- withFastStore $ \db -> getGroupMemberById db vr user dmId
+          unless (memberStatus dm == GSMemPendingApproval) $ throwChatError $ CECommandError "cannot send directly to member not pending approval"
+          pure ([dm], 1, Just NotInHistory)
+      sendGroupContentMessages_ user gInfo notInHistory_ ms numFileInvs live itemTTL cmrs
+    sendGroupContentMessages_ :: User -> GroupInfo -> Maybe NotInHistory -> [GroupMember] -> Int -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse
+    sendGroupContentMessages_ user gInfo@GroupInfo {groupId, membership} notInHistory_ ms numFileInvs live itemTTL cmrs = do
+      -- TODO [knocking] pass GroupSndScope?
+      let allowedRole = case ms of
+            [m] | memberCategory m == GCHostMember && memberStatus membership == GSMemPendingApproval -> Nothing
+            _ -> Just GRAuthor
+      forM_ allowedRole $ assertUserGroupRole gInfo
       assertGroupContentAllowed
       processComposedMessages
       where
@@ -3175,12 +3221,12 @@ processChatCommand' vr = \case
                 Nothing
         processComposedMessages :: CM ChatResponse
         processComposedMessages = do
-          (fInvs_, ciFiles_) <- L.unzip <$> setupSndFileTransfers (length $ filter memberCurrent ms)
+          (fInvs_, ciFiles_) <- L.unzip <$> setupSndFileTransfers numFileInvs
           timed_ <- sndGroupCITimed live gInfo itemTTL
           (chatMsgEvents, quotedItems_) <- L.unzip <$> prepareMsgs (L.zip cmrs fInvs_) timed_
           (msgs_, gsr) <- sendGroupMessages user gInfo ms chatMsgEvents
           let itemsData = prepareSndItemsData (L.toList cmrs) (L.toList ciFiles_) (L.toList quotedItems_) (L.toList msgs_)
-          cis_ <- saveSndChatItems user (CDGroupSnd gInfo) itemsData timed_ live
+          cis_ <- saveSndChatItems user (CDGroupSnd gInfo) notInHistory_ itemsData timed_ live
           when (length cis_ /= length cmrs) $ logError "sendGroupContentMessages: cmrs and cis_ length mismatch"
           createMemberSndStatuses cis_ msgs_ gsr
           let r@(_, cis) = partitionEithers cis_
@@ -3351,6 +3397,11 @@ processChatCommand' vr = \case
     getConnQueueInfo user Connection {connId, agentConnId = AgentConnId acId} = do
       msgInfo <- withFastStore' (`getLastRcvMsgInfo` connId)
       CRQueueInfo user msgInfo <$> withAgent (`getConnectionQueueInfo` acId)
+    withSendRef :: ChatRef -> (SendRef -> CM ChatResponse) -> CM ChatResponse
+    withSendRef chatRef a = case chatRef of
+      ChatRef CTDirect cId -> a $ SRDirect cId
+      ChatRef CTGroup gId -> a $ SRGroup gId Nothing
+      _ -> throwChatError $ CECommandError "not supported"
 
 protocolServers :: UserProtocol p => SProtocolType p -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP]) -> ([Maybe ServerOperator], [UserServer 'PSMP], [UserServer 'PXFTP])
 protocolServers p (operators, smpServers, xftpServers) = case p of
@@ -3833,7 +3884,7 @@ chatCommandP =
       "/_get chat " *> (APIGetChat <$> chatRefP <*> optional (" content=" *> strP) <* A.space <*> chatPaginationP <*> optional (" search=" *> stringP)),
       "/_get items " *> (APIGetChatItems <$> chatPaginationP <*> optional (" search=" *> stringP)),
       "/_get item info " *> (APIGetChatItemInfo <$> chatRefP <* A.space <*> A.decimal),
-      "/_send " *> (APISendMessages <$> chatRefP <*> liveMessageP <*> sendMessageTTLP <*> (" json " *> jsonP <|> " text " *> composedMessagesTextP)),
+      "/_send " *> (APISendMessages <$> sendRefP <*> liveMessageP <*> sendMessageTTLP <*> (" json " *> jsonP <|> " text " *> composedMessagesTextP)),
       "/_create tag " *> (APICreateChatTag <$> jsonP),
       "/_tags " *> (APISetChatTags <$> chatRefP <*> optional _strP),
       "/_delete tag " *> (APIDeleteChatTag <$> A.decimal),
@@ -3886,6 +3937,7 @@ chatCommandP =
       "/_ntf conn messages " *> (ApiGetConnNtfMessages <$> strP),
       "/_add #" *> (APIAddMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole),
       "/_join #" *> (APIJoinGroup <$> A.decimal <*> pure MFAll), -- needs to be changed to support in UI
+      "/_accept member #" *> (APIAcceptMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole),
       "/_member role #" *> (APIMembersRole <$> A.decimal <*> _strP <*> memberRole),
       "/_block #" *> (APIBlockMembersForAll <$> A.decimal <*> _strP <* A.space <* "blocked=" <*> onOffP),
       "/_remove #" *> (APIRemoveMembers <$> A.decimal <*> _strP),
@@ -4206,6 +4258,9 @@ chatCommandP =
         ct -> ChatName ct <$> displayNameP
     chatNameP' = ChatName <$> (chatTypeP <|> pure CTDirect) <*> displayNameP
     chatRefP = ChatRef <$> chatTypeP <*> A.decimal
+    sendRefP =
+      (A.char '@' $> SRDirect <*> A.decimal)
+        <|> (A.char '#' $> SRGroup <*> A.decimal <*> optional (" @" *> A.decimal))
     msgCountP = A.space *> A.decimal <|> pure 10
     ciTTLDecimal = ("default" $> Nothing) <|> (Just <$> A.decimal)
     ciTTL =

src/Simplex/Chat/Library/Internal.hs

@@ -38,7 +38,7 @@ import Data.Functor (($>))
 import Data.Functor.Identity
 import Data.Int (Int64)
 import Data.List (find, mapAccumL, partition)
-import Data.List.NonEmpty (NonEmpty (..))
+import Data.List.NonEmpty (NonEmpty (..), (<|))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
@@ -78,7 +78,7 @@ import Simplex.FileTransfer.Protocol (FileParty (..), FilePartyI)
 import Simplex.FileTransfer.Types (RcvFileId, SndFileId)
 import Simplex.Messaging.Agent as Agent
 import Simplex.Messaging.Agent.Client (getFastNetworkConfig, ipAddressProtected, withLockMap)
-import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..))
+import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), ServerCfg (..))
 import Simplex.Messaging.Agent.Lock (withLock)
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Agent.Protocol as AP (AgentErrorType (..))
@@ -820,17 +820,19 @@ acceptContactRequestAsync user cReq@UserContactRequest {agentInvitationId = Agen
     setCommandConnId db user cmdId connId
     pure ct
 
-acceptGroupJoinRequestAsync :: User -> GroupInfo -> UserContactRequest -> GroupMemberRole -> Maybe IncognitoProfile -> CM GroupMember
+acceptGroupJoinRequestAsync :: User -> GroupInfo -> UserContactRequest -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> CM GroupMember
 acceptGroupJoinRequestAsync
   user
   gInfo@GroupInfo {groupProfile, membership, businessChat}
   ucr@UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange}
+  gAccepted
   gLinkMemRole
   incognitoProfile = do
     gVar <- asks random
+    let initialStatus = acceptanceToStatus gAccepted
     (groupMemberId, memberId) <- withStore $ \db -> do
       liftIO $ deleteContactRequestRec db user ucr
-      createJoiningMember db gVar user gInfo ucr gLinkMemRole GSMemAccepted
+      createJoiningMember db gVar user gInfo ucr gLinkMemRole initialStatus
     currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo
     let Profile {displayName} = profileToSendOnAccept user incognitoProfile True
         GroupMember {memberRole = userRole, memberId = userMemberId} = membership
@@ -841,6 +843,7 @@ acceptGroupJoinRequestAsync
                 fromMemberName = displayName,
                 invitedMember = MemberIdRole memberId gLinkMemRole,
                 groupProfile,
+                accepted = Just gAccepted,
                 business = businessChat,
                 groupSize = Just currentMemCount
               }
@@ -900,6 +903,7 @@ acceptBusinessJoinRequestAsync
                 fromMemberName = displayName,
                 invitedMember = MemberIdRole memberId GRMember,
                 groupProfile = businessGroupProfile userProfile groupPreferences,
+                accepted = Just GAAccepted,
                 -- This refers to the "title member" that defines the group name and profile.
                 -- This coincides with fromMember to be current user when accepting the connecting user,
                 -- but it will be different when inviting somebody else.
@@ -926,6 +930,132 @@ profileToSendOnAccept user ip = userProfileToSend user (getIncognitoProfile <$>
       NewIncognito p -> p
       ExistingIncognito lp -> fromLocalProfile lp
 
+introduceToGroup :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
+introduceToGroup _ _ _ GroupMember {activeConn = Nothing} = throwChatError $ CEInternalError "member connection not active"
+introduceToGroup vr user gInfo@GroupInfo {groupId, membership} m@GroupMember {activeConn = Just conn} = do
+  members <- withStore' $ \db -> getGroupMembers db vr user gInfo
+  void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m
+  sendIntroductions members
+  when (groupFeatureAllowed SGFHistory gInfo) sendHistory
+  where
+    sendIntroductions members = do
+      intros <- withStore' $ \db -> createIntroductions db (maxVersion vr) members m
+      shuffledIntros <- liftIO $ shuffleIntros intros
+      if m `supportsVersion` batchSendVersion
+        then do
+          let events = map (memberIntro . reMember) shuffledIntros
+          forM_ (L.nonEmpty events) $ \events' ->
+            sendGroupMemberMessages user conn events' groupId
+        else forM_ shuffledIntros $ \intro ->
+          processIntro intro `catchChatError` (toView . CRChatError (Just user))
+    memberIntro :: GroupMember -> ChatMsgEvent 'Json
+    memberIntro reMember =
+      let mInfo = memberInfo reMember
+          mRestrictions = memberRestrictions reMember
+      in XGrpMemIntro mInfo mRestrictions
+    shuffleIntros :: [GroupMemberIntro] -> IO [GroupMemberIntro]
+    shuffleIntros intros = do
+      let (admins, others) = partition isAdmin intros
+          (admPics, admNoPics) = partition hasPicture admins
+          (othPics, othNoPics) = partition hasPicture others
+      mconcat <$> mapM shuffle [admPics, admNoPics, othPics, othNoPics]
+      where
+        isAdmin GroupMemberIntro {reMember = GroupMember {memberRole}} = memberRole >= GRAdmin
+        hasPicture GroupMemberIntro {reMember = GroupMember {memberProfile = LocalProfile {image}}} = isJust image
+    processIntro intro@GroupMemberIntro {introId} = do
+      void $ sendDirectMemberMessage conn (memberIntro $ reMember intro) groupId
+      withStore' $ \db -> updateIntroStatus db introId GMIntroSent
+    sendHistory =
+      when (m `supportsVersion` batchSendVersion) $ do
+        (errs, items) <- partitionEithers <$> withStore' (\db -> getGroupHistoryItems db user gInfo m 100)
+        (errs', events) <- partitionEithers <$> mapM (tryChatError . itemForwardEvents) items
+        let errors = map ChatErrorStore errs <> errs'
+        unless (null errors) $ toView $ CRChatErrors (Just user) errors
+        let events' = maybe (concat events) (\x -> concat events <> [x]) descrEvent_
+        forM_ (L.nonEmpty events') $ \events'' ->
+          sendGroupMemberMessages user conn events'' groupId
+    descrEvent_ :: Maybe (ChatMsgEvent 'Json)
+    descrEvent_
+      | m `supportsVersion` groupHistoryIncludeWelcomeVersion = do
+          let GroupInfo {groupProfile = GroupProfile {description}} = gInfo
+          fmap (\descr -> XMsgNew $ MCSimple $ extMsgContent (MCText descr) Nothing) description
+      | otherwise = Nothing
+    itemForwardEvents :: CChatItem 'CTGroup -> CM [ChatMsgEvent 'Json]
+    itemForwardEvents cci = case cci of
+      (CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv sender, content = CIRcvMsgContent mc, file})
+        | not (blockedByAdmin sender) -> do
+            fInvDescr_ <- join <$> forM file getRcvFileInvDescr
+            processContentItem sender ci mc fInvDescr_
+      (CChatItem SMDSnd ci@ChatItem {content = CISndMsgContent mc, file}) -> do
+        fInvDescr_ <- join <$> forM file getSndFileInvDescr
+        processContentItem membership ci mc fInvDescr_
+      _ -> pure []
+      where
+        getRcvFileInvDescr :: CIFile 'MDRcv -> CM (Maybe (FileInvitation, RcvFileDescrText))
+        getRcvFileInvDescr ciFile@CIFile {fileId, fileProtocol, fileStatus} = do
+          expired <- fileExpired
+          if fileProtocol /= FPXFTP || fileStatus == CIFSRcvCancelled || expired
+            then pure Nothing
+            else do
+              rfd <- withStore $ \db -> getRcvFileDescrByRcvFileId db fileId
+              pure $ invCompleteDescr ciFile rfd
+        getSndFileInvDescr :: CIFile 'MDSnd -> CM (Maybe (FileInvitation, RcvFileDescrText))
+        getSndFileInvDescr ciFile@CIFile {fileId, fileProtocol, fileStatus} = do
+          expired <- fileExpired
+          if fileProtocol /= FPXFTP || fileStatus == CIFSSndCancelled || expired
+            then pure Nothing
+            else do
+              -- can also lookup in extra_xftp_file_descriptions, though it can be empty;
+              -- would be best if snd file had a single rcv description for all members saved in files table
+              rfd <- withStore $ \db -> getRcvFileDescrBySndFileId db fileId
+              pure $ invCompleteDescr ciFile rfd
+        fileExpired :: CM Bool
+        fileExpired = do
+          ttl <- asks $ rcvFilesTTL . agentConfig . config
+          cutoffTs <- addUTCTime (-ttl) <$> liftIO getCurrentTime
+          pure $ chatItemTs cci < cutoffTs
+        invCompleteDescr :: CIFile d -> RcvFileDescr -> Maybe (FileInvitation, RcvFileDescrText)
+        invCompleteDescr CIFile {fileName, fileSize} RcvFileDescr {fileDescrText, fileDescrComplete}
+          | fileDescrComplete =
+              let fInvDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False}
+                  fInv = xftpFileInvitation fileName fileSize fInvDescr
+              in Just (fInv, fileDescrText)
+          | otherwise = Nothing
+        processContentItem :: GroupMember -> ChatItem 'CTGroup d -> MsgContent -> Maybe (FileInvitation, RcvFileDescrText) -> CM [ChatMsgEvent 'Json]
+        processContentItem sender ChatItem {formattedText, meta, quotedItem, mentions} mc fInvDescr_ =
+          if isNothing fInvDescr_ && not (msgContentHasText mc)
+            then pure []
+            else do
+              let CIMeta {itemTs, itemSharedMsgId, itemTimed} = meta
+                  quotedItemId_ = quoteItemId =<< quotedItem
+                  fInv_ = fst <$> fInvDescr_
+                  (mc', _, mentions') = updatedMentionNames mc formattedText mentions
+                  mentions'' = M.map (\CIMention {memberId} -> MsgMention {memberId}) mentions'
+              (chatMsgEvent, _) <- withStore $ \db -> prepareGroupMsg db user gInfo mc' mentions'' quotedItemId_ Nothing fInv_ itemTimed False
+              let senderVRange = memberChatVRange' sender
+                  xMsgNewChatMsg = ChatMessage {chatVRange = senderVRange, msgId = itemSharedMsgId, chatMsgEvent}
+              fileDescrEvents <- case (snd <$> fInvDescr_, itemSharedMsgId) of
+                (Just fileDescrText, Just msgId) -> do
+                  partSize <- asks $ xftpDescrPartSize . config
+                  let parts = splitFileDescr partSize fileDescrText
+                  pure . L.toList $ L.map (XMsgFileDescr msgId) parts
+                _ -> pure []
+              let fileDescrChatMsgs = map (ChatMessage senderVRange Nothing) fileDescrEvents
+                  GroupMember {memberId} = sender
+                  msgForwardEvents = map (\cm -> XGrpMsgForward memberId cm itemTs) (xMsgNewChatMsg : fileDescrChatMsgs)
+              pure msgForwardEvents
+
+splitFileDescr :: Int -> RcvFileDescrText -> NonEmpty FileDescr
+splitFileDescr partSize rfdText = splitParts 1 rfdText
+  where
+    splitParts partNo remText =
+      let (part, rest) = T.splitAt partSize remText
+          complete = T.null rest
+          fileDescr = FileDescr {fileDescrText = part, fileDescrPartNo = partNo, fileDescrComplete = complete}
+       in if complete
+            then fileDescr :| []
+            else fileDescr <| splitParts (partNo + 1) rest
+
 deleteGroupLink' :: User -> GroupInfo -> CM ()
 deleteGroupLink' user gInfo = do
   vr <- chatVersionRange
@@ -1459,6 +1589,7 @@ sendGroupMessage' user gInfo members chatMsgEvent =
 
 sendGroupMessages :: MsgEncodingI e => User -> GroupInfo -> [GroupMember] -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult)
 sendGroupMessages user gInfo members events = do
+  -- TODO [knocking] when sending to all, send profile update to pending approval members too, then filter for next step?
   when shouldSendProfileUpdate $
     sendProfileUpdate `catchChatError` (toView . CRChatError (Just user))
   sendGroupMessages_ user gInfo members events
@@ -1489,7 +1620,10 @@ sendGroupMessages_ :: MsgEncodingI e => User -> GroupInfo -> [GroupMember] -> No
 sendGroupMessages_ _user gInfo@GroupInfo {groupId} members events = do
   let idsEvts = L.map (GroupId groupId,) events
   sndMsgs_ <- lift $ createSndMessages idsEvts
-  recipientMembers <- liftIO $ shuffleMembers (filter memberCurrent members)
+  -- TODO [knocking] Possibly we need to pass GroupSndScope through all functions to here to avoid ad-hoc filtering.
+  recipientMembers <- case members of
+    [m] | memberStatus m == GSMemPendingApproval -> pure [m]
+    _ -> liftIO $ shuffleMembers (filter memberCurrent members)
   let msgFlags = MsgFlags {notification = any (hasNotification . toCMEventTag) events}
       (toSendSeparate, toSendBatched, toPending, forwarded, _, dups) =
         foldr' addMember ([], [], [], [], S.empty, 0 :: Int) recipientMembers
@@ -1691,7 +1825,7 @@ saveSndChatItem user cd msg content = saveSndChatItem' user cd msg content Nothi
 saveSndChatItem' :: ChatTypeI c => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> CM (ChatItem c 'MDSnd)
 saveSndChatItem' user cd msg content ciFile quotedItem itemForwarded itemTimed live = do
   let itemTexts = ciContentTexts content
-  saveSndChatItems user cd [Right NewSndChatItemData {msg, content, itemTexts, itemMentions = M.empty, ciFile, quotedItem, itemForwarded}] itemTimed live >>= \case
+  saveSndChatItems user cd Nothing [Right NewSndChatItemData {msg, content, itemTexts, itemMentions = M.empty, ciFile, quotedItem, itemForwarded}] itemTimed live >>= \case
     [Right ci] -> pure ci
     _ -> throwChatError $ CEInternalError "saveSndChatItem': expected 1 item"
 
@@ -1710,11 +1844,12 @@ saveSndChatItems ::
   ChatTypeI c =>
   User ->
   ChatDirection c 'MDSnd ->
+  Maybe NotInHistory ->
   [Either ChatError (NewSndChatItemData c)] ->
   Maybe CITimed ->
   Bool ->
   CM [Either ChatError (ChatItem c 'MDSnd)]
-saveSndChatItems user cd itemsData itemTimed live = do
+saveSndChatItems user cd notInHistory_ itemsData itemTimed live = do
   createdAt <- liftIO getCurrentTime
   when (contactChatDeleted cd || any (\NewSndChatItemData {content} -> ciRequiresAttention content) (rights itemsData)) $
     withStore' (\db -> updateChatTs db user cd createdAt)
@@ -1722,7 +1857,7 @@ saveSndChatItems user cd itemsData itemTimed live = do
   where
     createItem :: DB.Connection -> UTCTime -> NewSndChatItemData c -> IO (Either ChatError (ChatItem c 'MDSnd))
     createItem db createdAt NewSndChatItemData {msg = msg@SndMessage {sharedMsgId}, content, itemTexts, itemMentions, ciFile, quotedItem, itemForwarded} = do
-      ciId <- createNewSndChatItem db user cd msg content quotedItem itemForwarded itemTimed live createdAt
+      ciId <- createNewSndChatItem db user cd notInHistory_ msg content quotedItem itemForwarded itemTimed live createdAt
       forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
       let ci = mkChatItem_ cd ciId content itemTexts ciFile quotedItem (Just sharedMsgId) itemForwarded itemTimed live False createdAt Nothing createdAt
       Right <$> case cd of
@@ -1734,13 +1869,13 @@ saveRcvChatItemNoParse user cd msg brokerTs = saveRcvChatItem user cd msg broker
 
 saveRcvChatItem :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> UTCTime -> (CIContent 'MDRcv, (Text, Maybe MarkdownList)) -> CM (ChatItem c 'MDRcv)
 saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} brokerTs content =
-  saveRcvChatItem' user cd msg sharedMsgId_ brokerTs content Nothing Nothing False M.empty
+  saveRcvChatItem' user cd Nothing msg sharedMsgId_ brokerTs content Nothing Nothing False M.empty
 
 ciContentNoParse :: CIContent 'MDRcv -> (CIContent 'MDRcv, (Text, Maybe MarkdownList))
 ciContentNoParse content = (content, (ciContentToText content, Nothing))
 
-saveRcvChatItem' :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> UTCTime -> (CIContent 'MDRcv, (Text, Maybe MarkdownList)) -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> Map MemberName MsgMention -> CM (ChatItem c 'MDRcv)
+saveRcvChatItem' :: (ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> Maybe NotInHistory -> RcvMessage -> Maybe SharedMsgId -> UTCTime -> (CIContent 'MDRcv, (Text, Maybe MarkdownList)) -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> Map MemberName MsgMention -> CM (ChatItem c 'MDRcv)
-saveRcvChatItem' user cd msg@RcvMessage {chatMsgEvent, forwardedByMember} sharedMsgId_ brokerTs (content, (t, ft_)) ciFile itemTimed live mentions = do
+saveRcvChatItem' user cd notInHistory_ msg@RcvMessage {chatMsgEvent, forwardedByMember} sharedMsgId_ brokerTs (content, (t, ft_)) ciFile itemTimed live mentions = do
   createdAt <- liftIO getCurrentTime
   withStore' $ \db -> do
     when (ciRequiresAttention content || contactChatDeleted cd) $ updateChatTs db user cd createdAt
@@ -1753,7 +1888,7 @@ saveRcvChatItem' user cd msg@RcvMessage {chatMsgEvent, forwardedByMember} shared
             userMention' = userReply || any (\CIMention {memberId} -> sameMemberId memberId membership) mentions'
          in pure (mentions', userMention')
       CDDirectRcv _ -> pure (M.empty, False)
-    (ciId, quotedItem, itemForwarded) <- createNewRcvChatItem db user cd msg sharedMsgId_ content itemTimed live userMention brokerTs createdAt
+    (ciId, quotedItem, itemForwarded) <- createNewRcvChatItem db user cd notInHistory_ msg sharedMsgId_ content itemTimed live userMention brokerTs createdAt
     forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
     let ci = mkChatItem_ cd ciId content (t, ft_) ciFile quotedItem sharedMsgId_ itemForwarded itemTimed live userMention brokerTs forwardedByMember createdAt
     case cd of
@@ -1999,7 +2134,7 @@ createLocalChatItems user cd itemsData createdAt = do
   where
     createItem :: DB.Connection -> (CIContent 'MDSnd, Maybe (CIFile 'MDSnd), Maybe CIForwardedFrom, (Text, Maybe MarkdownList)) -> IO (ChatItem 'CTLocal 'MDSnd)
     createItem db (content, ciFile, itemForwarded, ts) = do
-      ciId <- createNewChatItem_ db user cd Nothing Nothing content (Nothing, Nothing, Nothing, Nothing, Nothing) itemForwarded Nothing False False createdAt Nothing createdAt
+      ciId <- createNewChatItem_ db user cd Nothing Nothing Nothing content (Nothing, Nothing, Nothing, Nothing, Nothing) itemForwarded Nothing False False createdAt Nothing createdAt
       forM_ ciFile $ \CIFile {fileId} -> updateFileTransferChatItemId db fileId ciId createdAt
       pure $ mkChatItem_ cd ciId content ts ciFile Nothing Nothing itemForwarded Nothing False False createdAt Nothing createdAt
 

src/Simplex/Chat/Library/Subscriber.hs

@@ -27,8 +27,8 @@ import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Either (lefts, partitionEithers, rights)
 import Data.Functor (($>))
 import Data.Int (Int64)
-import Data.List (foldl', partition)
+import Data.List (foldl')
-import Data.List.NonEmpty (NonEmpty (..), (<|))
+import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
@@ -36,8 +36,7 @@ import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
-import Data.Time (addUTCTime)
+import Data.Time.Clock (UTCTime, diffUTCTime)
-import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime)
 import qualified Data.UUID as UUID
 import qualified Data.UUID.V4 as V4
 import Data.Word (Word32)
@@ -47,7 +46,7 @@ import Simplex.Chat.Library.Internal
 import Simplex.Chat.Messages
 import Simplex.Chat.Messages.CIContent
 import Simplex.Chat.Messages.CIContent.Events
-import Simplex.Chat.ProfileGenerator (generateRandomProfile, isRandomName)
+import Simplex.Chat.ProfileGenerator (generateRandomProfile)
 import Simplex.Chat.Protocol
 import Simplex.Chat.Store
 import Simplex.Chat.Store.Connections
@@ -60,14 +59,12 @@ import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
-import Simplex.Chat.Util (shuffle)
 import Simplex.FileTransfer.Description (ValidFileDescription)
 import qualified Simplex.FileTransfer.Description as FD
 import Simplex.FileTransfer.Protocol (FilePartyI)
 import qualified Simplex.FileTransfer.Transport as XFTP
 import Simplex.FileTransfer.Types (FileErrorType (..), RcvFileId, SndFileId)
 import Simplex.Messaging.Agent as Agent
-import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..))
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Agent.Protocol as AP (AgentErrorType (..))
 import qualified Simplex.Messaging.Agent.Store.DB as DB
@@ -296,17 +293,6 @@ agentFileError = \case
       SMP.TRANSPORT TEVersion -> srvErr SrvErrVersion
       e -> srvErr . SrvErrOther $ tshow e
 
-splitFileDescr :: Int -> RcvFileDescrText -> NonEmpty FileDescr
-splitFileDescr partSize rfdText = splitParts 1 rfdText
-  where
-    splitParts partNo remText =
-      let (part, rest) = T.splitAt partSize remText
-          complete = T.null rest
-          fileDescr = FileDescr {fileDescrText = part, fileDescrPartNo = partNo, fileDescrComplete = complete}
-       in if complete
-            then fileDescr :| []
-            else fileDescr <| splitParts (partNo + 1) rest
-
 processAgentMsgRcvFile :: ACorrId -> RcvFileId -> AEvent 'AERcvFile -> CM ()
 processAgentMsgRcvFile _corrId aFileId msg = do
   (cRef_, fileId) <- withStore (`getXFTPRcvFileDBIds` AgentRcvFileId aFileId)
@@ -592,14 +578,16 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                 withStore' $ \db -> resetContactConnInitiated db user conn'
               forM_ viaUserContactLink $ \userContactLinkId -> do
                 ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId
-                let (UserContactLink {autoAccept}, groupId_, gLinkMemRole) = ucl
+                let (UserContactLink {autoAccept}, gli_) = ucl
                 when (connChatVersion < batchSend2Version) $ sendAutoReply ct' autoAccept
-                forM_ groupId_ $ \groupId -> do
+                -- TODO REMOVE LEGACY vvv
+                forM_ gli_ $ \GroupLinkInfo {groupId, memberRole = gLinkMemRole} -> do
                   groupInfo <- withStore $ \db -> getGroupInfo db vr user groupId
                   subMode <- chatReadVar subscriptionMode
                   groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode
                   gVar <- asks random
                   withStore $ \db -> createNewContactMemberAsync db gVar user groupInfo ct' gLinkMemRole groupConnIds connChatVersion peerChatVRange subMode
+            -- TODO REMOVE LEGACY ^^^
             Just (gInfo, m@GroupMember {activeConn}) ->
               when (maybe False ((== ConnReady) . connStatus) activeConn) $ do
                 notifyMemberConnected gInfo m $ Just ct
@@ -658,7 +646,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
               toView $ CRContactSndReady user ct
               forM_ viaUserContactLink $ \userContactLinkId -> do
                 ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId
-                let (UserContactLink {autoAccept}, _, _) = ucl
+                let (UserContactLink {autoAccept}, _) = ucl
                 when (connChatVersion >= batchSend2Version) $ sendAutoReply ct autoAccept
         QCONT ->
           void $ continueSending connEntity conn
@@ -703,6 +691,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                       liftIO $ setConnConnReqInv db user connId cReq
                       getHostConnId db user groupId
                     sendXGrpMemInv hostConnId Nothing XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq}
+              -- TODO REMOVE LEGACY vvv
               -- [async agent commands] group link auto-accept continuation on receiving INV
               CFCreateConnGrpInv -> do
                 ct <- withStore $ \db -> getContactViaMember db vr user m
@@ -728,6 +717,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                     (_msg, _) <- sendDirectContactMessage user ct $ XGrpInv groupInv
                     -- we could link chat item with sent group invitation message (_msg)
                     createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
+              -- TODO REMOVE LEGACY ^^^
               _ -> throwChatError $ CECommandError "unexpected cmdFunction"
             CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type"
       CONF confId _pqSupport _ connInfo -> do
@@ -765,7 +755,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
             | otherwise -> messageError "x.grp.mem.info: memberId is different from expected"
           -- sent when connecting via group link
           XInfo _ ->
-            -- TODO [group rejection] Keep rejected member record and connection for ability to start dialogue.
+            -- TODO Keep rejected member to allow them to appeal against rejection.
             when (memberStatus m == GSMemRejected) $ do
               deleteMemberConnection' user m True
               withStore' $ \db -> deleteGroupMember db user m
@@ -773,16 +763,20 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           _ -> messageError "INFO from member must have x.grp.mem.info, x.info or x.ok"
         pure ()
       CON _pqEnc -> unless (memberStatus m == GSMemRejected) $ do
-        withStore' $ \db -> do
+        status' <- case memberStatus m of
-          updateGroupMemberStatus db userId m GSMemConnected
+          GSMemPendingApproval -> pure GSMemPendingApproval
-          unless (memberActive membership) $
+          _ -> do
-            updateGroupMemberStatus db userId membership GSMemConnected
+            withStore' $ \db -> do
-        -- possible improvement: check for each pending message, requires keeping track of connection state
+              updateGroupMemberStatus db userId m GSMemConnected
-        unless (connDisabled conn) $ sendPendingGroupMessages user m conn
+              unless (memberActive membership) $
+                updateGroupMemberStatus db userId membership GSMemConnected
+            -- possible improvement: check for each pending message, requires keeping track of connection state
+            unless (connDisabled conn) $ sendPendingGroupMessages user m conn
+            pure GSMemConnected
         withAgent $ \a -> toggleConnectionNtfs a (aConnId conn) $ chatHasNtfs chatSettings
         case memberCategory m of
           GCHostMember -> do
-            toView $ CRUserJoinedGroup user gInfo {membership = membership {memberStatus = GSMemConnected}} m {memberStatus = GSMemConnected}
+            toView $ CRUserJoinedGroup user gInfo {membership = membership {memberStatus = status'}} m {memberStatus = status'}
             let cd = CDGroupRcv gInfo m
             createInternalChatItem user cd (CIRcvGroupE2EEInfo E2EInfo {pqEnabled = PQEncOff}) Nothing
             createGroupFeatureItems user cd CIRcvGroupFeature gInfo
@@ -793,125 +787,16 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
               expectHistory = groupFeatureAllowed SGFHistory gInfo && m `supportsVersion` groupHistoryIncludeWelcomeVersion
           GCInviteeMember -> do
             memberConnectedChatItem gInfo m
-            toView $ CRJoinedGroupMember user gInfo m {memberStatus = GSMemConnected}
+            toView $ CRJoinedGroupMember user gInfo m {memberStatus = status'}
             let Connection {viaUserContactLink} = conn
             when (isJust viaUserContactLink && isNothing (memberContactId m)) sendXGrpLinkMem
-            members <- withStore' $ \db -> getGroupMembers db vr user gInfo
-            void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m
-            sendIntroductions members
-            when (groupFeatureAllowed SGFHistory gInfo) sendHistory
             when (connChatVersion < batchSend2Version) sendGroupAutoReply
+            unless (status' == GSMemPendingApproval) $ introduceToGroup vr user gInfo m
             where
               sendXGrpLinkMem = do
                 let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
                     profileToSend = profileToSendOnAccept user profileMode True
                 void $ sendDirectMemberMessage conn (XGrpLinkMem profileToSend) groupId
-              sendIntroductions members = do
-                intros <- withStore' $ \db -> createIntroductions db (maxVersion vr) members m
-                shuffledIntros <- liftIO $ shuffleIntros intros
-                if m `supportsVersion` batchSendVersion
-                  then do
-                    let events = map (memberIntro . reMember) shuffledIntros
-                    forM_ (L.nonEmpty events) $ \events' ->
-                      sendGroupMemberMessages user conn events' groupId
-                  else forM_ shuffledIntros $ \intro ->
-                    processIntro intro `catchChatError` (toView . CRChatError (Just user))
-              memberIntro :: GroupMember -> ChatMsgEvent 'Json
-              memberIntro reMember =
-                let mInfo = memberInfo reMember
-                    mRestrictions = memberRestrictions reMember
-                 in XGrpMemIntro mInfo mRestrictions
-              shuffleIntros :: [GroupMemberIntro] -> IO [GroupMemberIntro]
-              shuffleIntros intros = do
-                let (admins, others) = partition isAdmin intros
-                    (admPics, admNoPics) = partition hasPicture admins
-                    (othPics, othNoPics) = partition hasPicture others
-                mconcat <$> mapM shuffle [admPics, admNoPics, othPics, othNoPics]
-                where
-                  isAdmin GroupMemberIntro {reMember = GroupMember {memberRole}} = memberRole >= GRAdmin
-                  hasPicture GroupMemberIntro {reMember = GroupMember {memberProfile = LocalProfile {image}}} = isJust image
-              processIntro intro@GroupMemberIntro {introId} = do
-                void $ sendDirectMemberMessage conn (memberIntro $ reMember intro) groupId
-                withStore' $ \db -> updateIntroStatus db introId GMIntroSent
-              sendHistory =
-                when (m `supportsVersion` batchSendVersion) $ do
-                  (errs, items) <- partitionEithers <$> withStore' (\db -> getGroupHistoryItems db user gInfo m 100)
-                  (errs', events) <- partitionEithers <$> mapM (tryChatError . itemForwardEvents) items
-                  let errors = map ChatErrorStore errs <> errs'
-                  unless (null errors) $ toView $ CRChatErrors (Just user) errors
-                  let events' = maybe (concat events) (\x -> concat events <> [x]) descrEvent_
-                  forM_ (L.nonEmpty events') $ \events'' ->
-                    sendGroupMemberMessages user conn events'' groupId
-              descrEvent_ :: Maybe (ChatMsgEvent 'Json)
-              descrEvent_
-                | m `supportsVersion` groupHistoryIncludeWelcomeVersion = do
-                    let GroupInfo {groupProfile = GroupProfile {description}} = gInfo
-                    fmap (\descr -> XMsgNew $ MCSimple $ extMsgContent (MCText descr) Nothing) description
-                | otherwise = Nothing
-              itemForwardEvents :: CChatItem 'CTGroup -> CM [ChatMsgEvent 'Json]
-              itemForwardEvents cci = case cci of
-                (CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv sender, content = CIRcvMsgContent mc, file})
-                  | not (blockedByAdmin sender) -> do
-                      fInvDescr_ <- join <$> forM file getRcvFileInvDescr
-                      processContentItem sender ci mc fInvDescr_
-                (CChatItem SMDSnd ci@ChatItem {content = CISndMsgContent mc, file}) -> do
-                  fInvDescr_ <- join <$> forM file getSndFileInvDescr
-                  processContentItem membership ci mc fInvDescr_
-                _ -> pure []
-                where
-                  getRcvFileInvDescr :: CIFile 'MDRcv -> CM (Maybe (FileInvitation, RcvFileDescrText))
-                  getRcvFileInvDescr ciFile@CIFile {fileId, fileProtocol, fileStatus} = do
-                    expired <- fileExpired
-                    if fileProtocol /= FPXFTP || fileStatus == CIFSRcvCancelled || expired
-                      then pure Nothing
-                      else do
-                        rfd <- withStore $ \db -> getRcvFileDescrByRcvFileId db fileId
-                        pure $ invCompleteDescr ciFile rfd
-                  getSndFileInvDescr :: CIFile 'MDSnd -> CM (Maybe (FileInvitation, RcvFileDescrText))
-                  getSndFileInvDescr ciFile@CIFile {fileId, fileProtocol, fileStatus} = do
-                    expired <- fileExpired
-                    if fileProtocol /= FPXFTP || fileStatus == CIFSSndCancelled || expired
-                      then pure Nothing
-                      else do
-                        -- can also lookup in extra_xftp_file_descriptions, though it can be empty;
-                        -- would be best if snd file had a single rcv description for all members saved in files table
-                        rfd <- withStore $ \db -> getRcvFileDescrBySndFileId db fileId
-                        pure $ invCompleteDescr ciFile rfd
-                  fileExpired :: CM Bool
-                  fileExpired = do
-                    ttl <- asks $ rcvFilesTTL . agentConfig . config
-                    cutoffTs <- addUTCTime (-ttl) <$> liftIO getCurrentTime
-                    pure $ chatItemTs cci < cutoffTs
-                  invCompleteDescr :: CIFile d -> RcvFileDescr -> Maybe (FileInvitation, RcvFileDescrText)
-                  invCompleteDescr CIFile {fileName, fileSize} RcvFileDescr {fileDescrText, fileDescrComplete}
-                    | fileDescrComplete =
-                        let fInvDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False}
-                            fInv = xftpFileInvitation fileName fileSize fInvDescr
-                         in Just (fInv, fileDescrText)
-                    | otherwise = Nothing
-                  processContentItem :: GroupMember -> ChatItem 'CTGroup d -> MsgContent -> Maybe (FileInvitation, RcvFileDescrText) -> CM [ChatMsgEvent 'Json]
-                  processContentItem sender ChatItem {formattedText, meta, quotedItem, mentions} mc fInvDescr_ =
-                    if isNothing fInvDescr_ && not (msgContentHasText mc)
-                      then pure []
-                      else do
-                        let CIMeta {itemTs, itemSharedMsgId, itemTimed} = meta
-                            quotedItemId_ = quoteItemId =<< quotedItem
-                            fInv_ = fst <$> fInvDescr_
-                            (mc', _, mentions') = updatedMentionNames mc formattedText mentions
-                            mentions'' = M.map (\CIMention {memberId} -> MsgMention {memberId}) mentions'
-                        (chatMsgEvent, _) <- withStore $ \db -> prepareGroupMsg db user gInfo mc' mentions'' quotedItemId_ Nothing fInv_ itemTimed False
-                        let senderVRange = memberChatVRange' sender
-                            xMsgNewChatMsg = ChatMessage {chatVRange = senderVRange, msgId = itemSharedMsgId, chatMsgEvent}
-                        fileDescrEvents <- case (snd <$> fInvDescr_, itemSharedMsgId) of
-                          (Just fileDescrText, Just msgId) -> do
-                            partSize <- asks $ xftpDescrPartSize . config
-                            let parts = splitFileDescr partSize fileDescrText
-                            pure . L.toList $ L.map (XMsgFileDescr msgId) parts
-                          _ -> pure []
-                        let fileDescrChatMsgs = map (ChatMessage senderVRange Nothing) fileDescrEvents
-                            GroupMember {memberId} = sender
-                            msgForwardEvents = map (\cm -> XGrpMsgForward memberId cm itemTs) (xMsgNewChatMsg : fileDescrChatMsgs)
-                        pure msgForwardEvents
           _ -> do
             let memCategory = memberCategory m
             withStore' (\db -> getViaGroupContact db vr user m) >>= \case
@@ -974,6 +859,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
               XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInvGroup gInfo m' sharedMsgId fileConnReq_ fName
               XInfo p -> xInfoMember gInfo m' p brokerTs
               XGrpLinkMem p -> xGrpLinkMem gInfo m' conn' p
+              XGrpLinkAcpt role -> xGrpLinkAcpt gInfo m' role
               XGrpMemNew memInfo -> xGrpMemNew gInfo m' memInfo msg brokerTs
               XGrpMemIntro memInfo memRestrictions_ -> xGrpMemIntro gInfo m' memInfo memRestrictions_
               XGrpMemInv memId introInv -> xGrpMemInv gInfo m' memId introInv
@@ -1294,13 +1180,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
       _ -> pure ()
       where
         profileContactRequest :: InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> PQSupport -> CM ()
-        profileContactRequest invId chatVRange p@Profile {displayName, image} xContactId_ reqPQSup = do
+        profileContactRequest invId chatVRange p@Profile {displayName} xContactId_ reqPQSup = do
           withStore (\db -> createOrUpdateContactRequest db vr user userContactLinkId invId chatVRange p xContactId_ reqPQSup) >>= \case
             CORContact contact -> toView $ CRContactRequestAlreadyAccepted user contact
             CORGroup gInfo -> toView $ CRBusinessRequestAlreadyAccepted user gInfo
             CORRequest cReq -> do
               ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId
-              let (UserContactLink {connReqContact, autoAccept}, groupId_, gLinkMemRole) = ucl
+              let (UserContactLink {connReqContact, autoAccept}, gLinkInfo_) = ucl
                   isSimplexTeam = sameConnReqContact connReqContact adminContactReq
                   v = maxVersion chatVRange
               case autoAccept of
@@ -1313,49 +1199,37 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                         else do
                           gInfo <- acceptBusinessJoinRequestAsync user cReq
                           toView $ CRAcceptingBusinessRequest user gInfo
-                  | otherwise -> case groupId_ of
+                  | otherwise -> case gLinkInfo_ of
                       Nothing -> do
                         -- [incognito] generate profile to send, create connection with incognito profile
                         incognitoProfile <- if acceptIncognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
                         ct <- acceptContactRequestAsync user cReq incognitoProfile reqPQSup
                         toView $ CRAcceptingContactRequest user ct
-                      Just groupId -> do
+                      Just gli@GroupLinkInfo {groupId, memberRole = gLinkMemRole} -> do
                         gInfo <- withStore $ \db -> getGroupInfo db vr user groupId
-                        cfg <- asks config
+                        acceptMember_ <- asks $ acceptMember . chatHooks . config
-                        case rejectionReason cfg of
+                        maybe (pure $ Right (GAAccepted, gLinkMemRole)) (\am -> liftIO $ am gInfo gli p) acceptMember_ >>= \case
-                          Nothing
+                          Right (acceptance, useRole)
                             | v < groupFastLinkJoinVersion ->
                                 messageError "processUserContactRequest: chat version range incompatible for accepting group join request"
                             | otherwise -> do
                                 let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
-                                    useRole = userMemberRole gLinkMemRole $ acceptAsObserver cfg
+                                mem <- acceptGroupJoinRequestAsync user gInfo cReq acceptance useRole profileMode
-                                mem <- acceptGroupJoinRequestAsync user gInfo cReq useRole profileMode
                                 createInternalChatItem user (CDGroupRcv gInfo mem) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
                                 toView $ CRAcceptingGroupJoinRequestMember user gInfo mem
-                          Just rjctReason
+                          Left rjctReason
                             | v < groupJoinRejectVersion ->
                                 messageWarning $ "processUserContactRequest (group " <> groupName' gInfo <> "): joining of " <> displayName <> " is blocked"
                             | otherwise -> do
                                 mem <- acceptGroupJoinSendRejectAsync user gInfo cReq rjctReason
                                 toViewTE $ TERejectingGroupJoinRequestMember user gInfo mem rjctReason
                 _ -> toView $ CRReceivedContactRequest user cReq
-          where
-            rejectionReason ChatConfig {profileNameLimit, allowedProfileName}
-              | T.length displayName > profileNameLimit = Just GRRLongName
-              | maybe False (\f -> not $ f displayName) allowedProfileName = Just GRRBlockedName
-              | otherwise = Nothing
-            userMemberRole linkRole = \case
-              Just AOAll -> GRObserver
-              Just AONameOnly | noImage -> GRObserver
-              Just AOIncognito | noImage && isRandomName displayName -> GRObserver
-              _ -> linkRole
-              where
-                noImage = maybe True (\(ImageData i) -> i == "") image
 
+    -- TODO [knocking] review
     memberCanSend :: GroupMember -> CM () -> CM ()
-    memberCanSend GroupMember {memberRole} a
+    memberCanSend GroupMember {memberRole, memberStatus} a
-      | memberRole <= GRObserver = messageError "member is not allowed to send messages"
+      | memberRole > GRObserver || memberStatus == GSMemPendingApproval = a
-      | otherwise = a
+      | otherwise = messageError "member is not allowed to send messages"
 
     processConnMERR :: ConnectionEntity -> Connection -> AgentErrorType -> CM ()
     processConnMERR connEntity conn err = do
@@ -1576,7 +1450,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
       where
         brokerTs = metaBrokerTs msgMeta
         newChatItem content ciFile_ timed_ live = do
-          ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs content ciFile_ timed_ live M.empty
+          ci <- saveRcvChatItem' user (CDDirectRcv ct) Nothing msg sharedMsgId_ brokerTs content ciFile_ timed_ live M.empty
           reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getDirectCIReactions db ct sharedMsgId) sharedMsgId_
           toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci {reactions}]
 
@@ -1643,7 +1517,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
         -- Chat item and update message which created it will have different sharedMsgId in this case...
         let timed_ = rcvContactCITimed ct ttl
             ts = ciContentTexts content
-        ci <- saveRcvChatItem' user (CDDirectRcv ct) msg (Just sharedMsgId) brokerTs (content, ts) Nothing timed_ live M.empty
+        ci <- saveRcvChatItem' user (CDDirectRcv ct) Nothing msg (Just sharedMsgId) brokerTs (content, ts) Nothing timed_ live M.empty
         ci' <- withStore' $ \db -> do
           createChatItemVersion db (chatItemId' ci) brokerTs mc
           updateDirectChatItem' db user contactId ci content True live Nothing Nothing
@@ -1760,10 +1634,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
         live' = fromMaybe False live_
         ExtMsgContent content mentions fInv_ itemTTL live_ = mcExtMsgContent mc
         ts@(_, ft_) = msgContentTexts content
+        saveRcvCI = saveRcvChatItem' user (CDGroupRcv gInfo m) (memberNotInHistory m) msg sharedMsgId_ brokerTs
         createBlockedByAdmin
           | groupFeatureAllowed SGFFullDelete gInfo = do
               -- ignores member role when blocked by admin
-              ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (ciContentNoParse CIRcvBlocked) Nothing timed' False M.empty
+              ci <- saveRcvCI (ciContentNoParse CIRcvBlocked) Nothing timed' False M.empty
               ci' <- withStore' $ \db -> updateGroupCIBlockedByAdmin db user gInfo ci brokerTs
               groupMsgToView gInfo ci'
           | otherwise = do
@@ -1775,7 +1650,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           | moderatorRole < GRModerator || moderatorRole < memberRole =
               createContentItem
           | groupFeatureMemberAllowed SGFFullDelete moderator gInfo = do
-              ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (ciContentNoParse CIRcvModerated) Nothing timed' False M.empty
+              ci <- saveRcvCI (ciContentNoParse CIRcvModerated) Nothing timed' False M.empty
               ci' <- withStore' $ \db -> updateGroupChatItemModerated db user gInfo ci moderator moderatedAt
               groupMsgToView gInfo ci'
           | otherwise = do
@@ -1783,7 +1658,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
               ci <- createNonLive file_
               toView =<< markGroupCIsDeleted user gInfo [CChatItem SMDRcv ci] False (Just moderator) moderatedAt
         createNonLive file_ =
-          saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (CIRcvMsgContent content, ts) (snd <$> file_) timed' False mentions
+          saveRcvCI (CIRcvMsgContent content, ts) (snd <$> file_) timed' False mentions
         createContentItem = do
           file_ <- processFileInv
           newChatItem (CIRcvMsgContent content, ts) (snd <$> file_) timed' live'
@@ -1792,7 +1667,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m
         newChatItem ciContent ciFile_ timed_ live = do
           let mentions' = if showMessages (memberSettings m) then mentions else []
-          ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs ciContent ciFile_ timed_ live mentions'
+          ci <- saveRcvCI ciContent ciFile_ timed_ live mentions'
           ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci
           reactions <- maybe (pure []) (\sharedMsgId -> withStore' $ \db -> getGroupCIReactions db gInfo memberId sharedMsgId) sharedMsgId_
           groupMsgToView gInfo ci' {reactions}
@@ -1808,7 +1683,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
             -- Chat item and update message which created it will have different sharedMsgId in this case...
             let timed_ = rcvGroupCITimed gInfo ttl_
                 mentions' = if showMessages (memberSettings m) then mentions else []
-            ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg (Just sharedMsgId) brokerTs (content, ts) Nothing timed_ live mentions'
+            ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) (memberNotInHistory m) msg (Just sharedMsgId) brokerTs (content, ts) Nothing timed_ live mentions'
             ci' <- withStore' $ \db -> do
               createChatItemVersion db (chatItemId' ci) brokerTs mc
               ci' <- updateGroupChatItem db user groupId ci content True live Nothing
@@ -1841,6 +1716,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                 else messageError "x.msg.update: group member attempted to update a message of another member"
             _ -> messageError "x.msg.update: group member attempted invalid message update"
 
+    memberNotInHistory :: GroupMember -> Maybe NotInHistory
+    memberNotInHistory = \case
+      GroupMember {memberStatus = GSMemPendingApproval} -> Just NotInHistory
+      _ -> Nothing
+
     groupMessageDelete :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe MemberId -> RcvMessage -> UTCTime -> CM ()
     groupMessageDelete gInfo@GroupInfo {membership} m@GroupMember {memberId, memberRole = senderRole} sharedMsgId sndMemberId_ RcvMessage {msgId} brokerTs = do
       let msgMemberId = fromMaybe memberId sndMemberId_
@@ -1896,7 +1776,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
       let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP
           ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol}
           content = ciContentNoParse $ CIRcvMsgContent $ MCFile ""
-      ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs content ciFile Nothing False M.empty
+      ci <- saveRcvChatItem' user (CDDirectRcv ct) Nothing msg sharedMsgId_ brokerTs content ciFile Nothing False M.empty
       toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci]
       where
         brokerTs = metaBrokerTs msgMeta
@@ -1910,7 +1790,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
       let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP
           ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol}
           content = ciContentNoParse $ CIRcvMsgContent $ MCFile ""
-      ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs content ciFile Nothing False M.empty
+      ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) Nothing msg sharedMsgId_ brokerTs content ciFile Nothing False M.empty
       ci' <- blockedMember m ci $ withStore' $ \db -> markGroupChatItemBlocked db user gInfo ci
       groupMsgToView gInfo ci'
 
@@ -2173,16 +2053,27 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
     xInfoMember gInfo m p' brokerTs = void $ processMemberProfileUpdate gInfo m p' True (Just brokerTs)
 
     xGrpLinkMem :: GroupInfo -> GroupMember -> Connection -> Profile -> CM ()
-    xGrpLinkMem gInfo@GroupInfo {membership, businessChat} m@GroupMember {groupMemberId, memberCategory} Connection {viaGroupLink} p' = do
+    xGrpLinkMem gInfo@GroupInfo {membership, businessChat} m@GroupMember {groupMemberId, memberCategory, memberStatus} Connection {viaGroupLink} p' = do
       xGrpLinkMemReceived <- withStore $ \db -> getXGrpLinkMemReceived db groupMemberId
       if (viaGroupLink || isJust businessChat) && isNothing (memberContactId m) && memberCategory == GCHostMember && not xGrpLinkMemReceived
         then do
           m' <- processMemberProfileUpdate gInfo m p' False Nothing
           withStore' $ \db -> setXGrpLinkMemReceived db groupMemberId True
-          let connectedIncognito = memberIncognito membership
+          unless (memberStatus == GSMemPendingApproval) $ do
-          probeMatchingMemberContact m' connectedIncognito
+            let connectedIncognito = memberIncognito membership
+            probeMatchingMemberContact m' connectedIncognito
         else messageError "x.grp.link.mem error: invalid group link host profile update"
 
+    xGrpLinkAcpt :: GroupInfo -> GroupMember -> GroupMemberRole -> CM ()
+    xGrpLinkAcpt gInfo@GroupInfo {membership} m role = do
+      membership' <- withStore' $ \db -> do
+        updateGroupMemberStatus db userId m GSMemConnected
+        updateGroupMemberAccepted db user membership role
+      let m' = m {memberStatus = GSMemConnected}
+      toView $ CRUserJoinedGroup user gInfo {membership = membership'} m'
+      let connectedIncognito = memberIncognito membership
+      probeMatchingMemberContact m' connectedIncognito
+
     processMemberProfileUpdate :: GroupInfo -> GroupMember -> Profile -> Bool -> Maybe UTCTime -> CM GroupMember
     processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId} p' createItems itemTs_
       | redactedMemberProfile (fromLocalProfile p) /= redactedMemberProfile p' = do
@@ -2330,7 +2221,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
         saveCallItem status = saveRcvChatItemNoParse user (CDDirectRcv ct) msg brokerTs (CIRcvCall status 0)
         featureRejected f = do
           let content = ciContentNoParse $ CIRcvChatFeatureRejected f
-          ci <- saveRcvChatItem' user (CDDirectRcv ct) msg sharedMsgId_ brokerTs content Nothing Nothing False M.empty
+          ci <- saveRcvChatItem' user (CDDirectRcv ct) Nothing msg sharedMsgId_ brokerTs content Nothing Nothing False M.empty
           toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci]
 
     -- to party initiating call

src/Simplex/Chat/Messages.hs

@@ -162,6 +162,8 @@ data ChatItem (c :: ChatType) (d :: MsgDirection) = ChatItem
   }
   deriving (Show)
 
+data NotInHistory = NotInHistory
+
 data CIMention = CIMention
   { memberId :: MemberId,
     -- member record can be created later than the mention is received

src/Simplex/Chat/ProfileGenerator.hs

@@ -2,8 +2,6 @@
 
 module Simplex.Chat.ProfileGenerator where
 
-import qualified Data.Attoparsec.Text as A
-import Data.Either (isRight)
 import Data.Text (Text)
 import Simplex.Chat.Types (Profile (..))
 import System.Random (randomRIO)
@@ -25,15 +23,6 @@ generateRandomProfile = do
             then pickNoun adjective (n - 1)
             else pure noun
 
--- This function does not check for exact match with this disctionary,
--- it only checks for the WordWord style.
-isRandomName :: Text -> Bool
-isRandomName = isRight . A.parseOnly randomNameP
-  where
-    randomNameP = A.satisfy upper >> A.takeWhile1 lower >> A.satisfy upper >> A.takeWhile1 lower >> A.endOfInput
-    upper c = c >= 'A' && c <= 'Z'
-    lower c = c >= 'a' && c <= 'z'
-
 adjectives :: [Text]
 adjectives =
   [ "Abatic",
@@ -1503,7 +1492,6 @@ adjectives =
     "Recommendable",
     "Rectangular",
     "Recuperative",
-    "Red",
     "Refined",
     "Reflecting",
     "Reflective",
@@ -2940,7 +2928,6 @@ nouns =
     "Sister",
     "Size",
     "Skill",
-    "Skin",
     "Skipper",
     "Sleek",
     "Slick",

src/Simplex/Chat/Protocol.hs

@@ -333,6 +333,7 @@ data ChatMsgEvent (e :: MsgEncoding) where
   XGrpLinkInv :: GroupLinkInvitation -> ChatMsgEvent 'Json
   XGrpLinkReject :: GroupLinkRejection -> ChatMsgEvent 'Json
   XGrpLinkMem :: Profile -> ChatMsgEvent 'Json
+  XGrpLinkAcpt :: GroupMemberRole -> ChatMsgEvent 'Json
   XGrpMemNew :: MemberInfo -> ChatMsgEvent 'Json
   XGrpMemIntro :: MemberInfo -> Maybe MemberRestrictions -> ChatMsgEvent 'Json
   XGrpMemInv :: MemberId -> IntroInvitation -> ChatMsgEvent 'Json
@@ -823,6 +824,7 @@ data CMEventTag (e :: MsgEncoding) where
   XGrpLinkInv_ :: CMEventTag 'Json
   XGrpLinkReject_ :: CMEventTag 'Json
   XGrpLinkMem_ :: CMEventTag 'Json
+  XGrpLinkAcpt_ :: CMEventTag 'Json
   XGrpMemNew_ :: CMEventTag 'Json
   XGrpMemIntro_ :: CMEventTag 'Json
   XGrpMemInv_ :: CMEventTag 'Json
@@ -875,6 +877,7 @@ instance MsgEncodingI e => StrEncoding (CMEventTag e) where
     XGrpLinkInv_ -> "x.grp.link.inv"
     XGrpLinkReject_ -> "x.grp.link.reject"
     XGrpLinkMem_ -> "x.grp.link.mem"
+    XGrpLinkAcpt_ -> "x.grp.link.acpt"
     XGrpMemNew_ -> "x.grp.mem.new"
     XGrpMemIntro_ -> "x.grp.mem.intro"
     XGrpMemInv_ -> "x.grp.mem.inv"
@@ -928,6 +931,7 @@ instance StrEncoding ACMEventTag where
         "x.grp.link.inv" -> XGrpLinkInv_
         "x.grp.link.reject" -> XGrpLinkReject_
         "x.grp.link.mem" -> XGrpLinkMem_
+        "x.grp.link.acpt" -> XGrpLinkAcpt_
         "x.grp.mem.new" -> XGrpMemNew_
         "x.grp.mem.intro" -> XGrpMemIntro_
         "x.grp.mem.inv" -> XGrpMemInv_
@@ -977,6 +981,7 @@ toCMEventTag msg = case msg of
   XGrpLinkInv _ -> XGrpLinkInv_
   XGrpLinkReject _ -> XGrpLinkReject_
   XGrpLinkMem _ -> XGrpLinkMem_
+  XGrpLinkAcpt _ -> XGrpLinkAcpt_
   XGrpMemNew _ -> XGrpMemNew_
   XGrpMemIntro _ _ -> XGrpMemIntro_
   XGrpMemInv _ _ -> XGrpMemInv_
@@ -1079,6 +1084,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
       XGrpLinkInv_ -> XGrpLinkInv <$> p "groupLinkInvitation"
       XGrpLinkReject_ -> XGrpLinkReject <$> p "groupLinkRejection"
       XGrpLinkMem_ -> XGrpLinkMem <$> p "profile"
+      XGrpLinkAcpt_ -> XGrpLinkAcpt <$> p "role"
       XGrpMemNew_ -> XGrpMemNew <$> p "memberInfo"
       XGrpMemIntro_ -> XGrpMemIntro <$> p "memberInfo" <*> opt "memberRestrictions"
       XGrpMemInv_ -> XGrpMemInv <$> p "memberId" <*> p "memberIntro"
@@ -1142,6 +1148,7 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @
       XGrpLinkInv groupLinkInv -> o ["groupLinkInvitation" .= groupLinkInv]
       XGrpLinkReject groupLinkRjct -> o ["groupLinkRejection" .= groupLinkRjct]
       XGrpLinkMem profile -> o ["profile" .= profile]
+      XGrpLinkAcpt role -> o ["role" .= role]
       XGrpMemNew memInfo -> o ["memberInfo" .= memInfo]
       XGrpMemIntro memInfo memRestrictions -> o $ ("memberRestrictions" .=? memRestrictions) ["memberInfo" .= memInfo]
       XGrpMemInv memId memIntro -> o ["memberId" .= memId, "memberIntro" .= memIntro]

src/Simplex/Chat/Store.hs

@@ -6,6 +6,7 @@ module Simplex.Chat.Store
     ChatLockEntity (..),
     UserMsgReceiptSettings (..),
     UserContactLink (..),
+    GroupLinkInfo (..),
     AutoAccept (..),
     createChatStore,
     migrations, -- used in tests

src/Simplex/Chat/Store/Groups.hs

@@ -78,6 +78,7 @@ module Simplex.Chat.Store.Groups
     createMemberConnectionAsync,
     updateGroupMemberStatus,
     updateGroupMemberStatusById,
+    updateGroupMemberAccepted,
     createNewGroupMember,
     checkGroupMemberHasItems,
     deleteGroupMember,
@@ -520,9 +521,10 @@ deleteContactCardKeepConn db connId Contact {contactId, profile = LocalProfile {
   DB.execute db "DELETE FROM contact_profiles WHERE contact_profile_id = ?" (Only profileId)
 
 createGroupInvitedViaLink :: DB.Connection -> VersionRangeChat -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
-createGroupInvitedViaLink db vr user conn GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, business} = do
+createGroupInvitedViaLink db vr user conn GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, accepted, business} = do
   let fromMemberProfile = profileFromName fromMemberName
-  createGroupViaLink' db vr user conn fromMember fromMemberProfile invitedMember groupProfile business GSMemAccepted
+      initialStatus = maybe GSMemAccepted acceptanceToStatus accepted
+  createGroupViaLink' db vr user conn fromMember fromMemberProfile invitedMember groupProfile business initialStatus
 
 createGroupRejectedViaLink :: DB.Connection -> VersionRangeChat -> User -> Connection -> GroupLinkRejection -> ExceptT StoreError IO (GroupInfo, GroupMember)
 createGroupRejectedViaLink db vr user conn GroupLinkRejection {fromMember = fromMember@MemberIdRole {memberId}, invitedMember, groupProfile} = do
@@ -1201,6 +1203,19 @@ updateGroupMemberStatusById db userId groupMemberId memStatus = do
     |]
     (memStatus, currentTs, userId, groupMemberId)
 
+updateGroupMemberAccepted :: DB.Connection -> User -> GroupMember -> GroupMemberRole -> IO GroupMember
+updateGroupMemberAccepted db User {userId} m@GroupMember {groupMemberId} role = do
+  currentTs <- getCurrentTime
+  DB.execute
+    db
+    [sql|
+      UPDATE group_members
+      SET member_status = ?, member_role = ?, updated_at = ?
+      WHERE user_id = ? AND group_member_id = ?
+    |]
+    (GSMemConnected, role, currentTs, userId, groupMemberId)
+  pure m {memberStatus = GSMemConnected, memberRole = role, updatedAt = currentTs}
+
 -- | add new member with profile
 createNewGroupMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
 createNewGroupMember db user gInfo invitingMember memInfo@MemberInfo {profile} memCategory memStatus = do

src/Simplex/Chat/Store/Messages.hs

@@ -142,7 +142,7 @@ import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe)
+import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)
 import Data.Ord (Down (..), comparing)
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -372,9 +372,9 @@ updateChatTs db User {userId} chatDirection chatTs = case toChatInfo chatDirecti
       (chatTs, userId, noteFolderId)
   _ -> pure ()
 
-createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId
+createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> Maybe NotInHistory -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId
-createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciContent quotedItem itemForwarded timed live createdAt =
+createNewSndChatItem db user chatDirection notInHistory_ SndMessage {msgId, sharedMsgId} ciContent quotedItem itemForwarded timed live createdAt =
-  createNewChatItem_ db user chatDirection createdByMsgId (Just sharedMsgId) ciContent quoteRow itemForwarded timed live False createdAt Nothing createdAt
+  createNewChatItem_ db user chatDirection notInHistory_ createdByMsgId (Just sharedMsgId) ciContent quoteRow itemForwarded timed live False createdAt Nothing createdAt
   where
     createdByMsgId = if msgId == 0 then Nothing else Just msgId
     quoteRow :: NewQuoteRow
@@ -388,9 +388,9 @@ createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciCon
           CIQGroupRcv (Just GroupMember {memberId}) -> (Just False, Just memberId)
           CIQGroupRcv Nothing -> (Just False, Nothing)
 
-createNewRcvChatItem :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c), Maybe CIForwardedFrom)
+createNewRcvChatItem :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> Maybe NotInHistory -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c), Maybe CIForwardedFrom)
-createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forwardedByMember} sharedMsgId_ ciContent timed live userMention itemTs createdAt = do
+createNewRcvChatItem db user chatDirection notInHistory_ RcvMessage {msgId, chatMsgEvent, forwardedByMember} sharedMsgId_ ciContent timed live userMention itemTs createdAt = do
-  ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow itemForwarded timed live userMention itemTs forwardedByMember createdAt
+  ciId <- createNewChatItem_ db user chatDirection notInHistory_ (Just msgId) sharedMsgId_ ciContent quoteRow itemForwarded timed live userMention itemTs forwardedByMember createdAt
   quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg
   pure (ciId, quotedItem, itemForwarded)
   where
@@ -407,13 +407,13 @@ createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forw
 
 createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> CIContent d -> UTCTime -> UTCTime -> IO ChatItemId
 createNewChatItemNoMsg db user chatDirection ciContent itemTs =
-  createNewChatItem_ db user chatDirection Nothing Nothing ciContent quoteRow Nothing Nothing False False itemTs Nothing
+  createNewChatItem_ db user chatDirection Nothing Nothing Nothing ciContent quoteRow Nothing Nothing False False itemTs Nothing
   where
     quoteRow :: NewQuoteRow
     quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing)
 
-createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> UTCTime -> Maybe GroupMemberId -> UTCTime -> IO ChatItemId
+createNewChatItem_ :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> Maybe NotInHistory -> Maybe MessageId -> Maybe SharedMsgId -> CIContent d -> NewQuoteRow -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> UTCTime -> Maybe GroupMemberId -> UTCTime -> IO ChatItemId
-createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent quoteRow itemForwarded timed live userMention itemTs forwardedByMember createdAt = do
+createNewChatItem_ db User {userId} chatDirection notInHistory_ msgId_ sharedMsgId ciContent quoteRow itemForwarded timed live userMention itemTs forwardedByMember createdAt = do
   DB.execute
     db
     [sql|
@@ -448,7 +448,7 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q
     includeInHistory :: Bool
     includeInHistory =
       let (_, groupId_, _, _) = idsRow
-       in isJust groupId_ && isJust (ciMsgContent ciContent) && ((msgContentTag <$> ciMsgContent ciContent) /= Just MCReport_)
+       in isJust groupId_ && isNothing notInHistory_ && isJust (ciMsgContent ciContent) && ((msgContentTag <$> ciMsgContent ciContent) /= Just MCReport_)
     forwardedFromRow :: (Maybe CIForwardedFromTag, Maybe Text, Maybe MsgDirection, Maybe Int64, Maybe Int64, Maybe Int64)
     forwardedFromRow = case itemForwarded of
       Nothing ->
@@ -2319,9 +2319,9 @@ updateGroupCIMentions db g ci@ChatItem {mentions} mentions'
       unless (null mentions) $ deleteMentions
       if null mentions'
         then pure ci
-        -- This is a fallback for the error that should not happen in practice.
+        else -- This is a fallback for the error that should not happen in practice.
         -- In theory, it may happen in item mentions in database are different from item record.
-        else createMentions `E.catch` \e -> if constraintError e then deleteMentions >> createMentions else E.throwIO e
+          createMentions `E.catch` \e -> if constraintError e then deleteMentions >> createMentions else E.throwIO e
   where
     deleteMentions = DB.execute db "DELETE FROM chat_item_mentions WHERE chat_item_id = ?" (Only $ chatItemId' ci)
     createMentions = createGroupCIMentions db g ci mentions'
@@ -3138,6 +3138,7 @@ getGroupSndStatusCounts db itemId =
     |]
     (Only itemId)
 
+-- TODO [knocking] filter out messages sent to member only
 getGroupHistoryItems :: DB.Connection -> User -> GroupInfo -> GroupMember -> Int -> IO [Either StoreError (CChatItem 'CTGroup)]
 getGroupHistoryItems db user@User {userId} g@GroupInfo {groupId} m count = do
   ciIds <- getLastItemIds_

src/Simplex/Chat/Store/Profiles.hs

@@ -18,6 +18,7 @@ module Simplex.Chat.Store.Profiles
   ( AutoAccept (..),
     UserMsgReceiptSettings (..),
     UserContactLink (..),
+    GroupLinkInfo (..),
     createUserRecord,
     createUserRecordAt,
     getUsersInfo,
@@ -47,6 +48,7 @@ module Simplex.Chat.Store.Profiles
     deleteUserAddress,
     getUserAddress,
     getUserContactLinkById,
+    getGroupLinkInfo,
     getUserContactLinkByConnReq,
     getContactWithoutConnViaAddress,
     updateUserAddressAutoAccept,
@@ -453,6 +455,12 @@ data UserContactLink = UserContactLink
   }
   deriving (Show)
 
+data GroupLinkInfo = GroupLinkInfo
+  { groupId :: GroupId,
+    memberRole :: GroupMemberRole
+  }
+  deriving (Show)
+
 data AutoAccept = AutoAccept
   { businessAddress :: Bool, -- possibly, it can be wrapped together with acceptIncognito, or AutoAccept made sum type
     acceptIncognito :: IncognitoEnabled,
@@ -481,18 +489,28 @@ getUserAddress db User {userId} =
       |]
       (Only userId)
 
-getUserContactLinkById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO (UserContactLink, Maybe GroupId, GroupMemberRole)
+getUserContactLinkById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO (UserContactLink, Maybe GroupLinkInfo)
 getUserContactLinkById db userId userContactLinkId =
-  ExceptT . firstRow (\(ucl :. (groupId_, mRole_)) -> (toUserContactLink ucl, groupId_, fromMaybe GRMember mRole_)) SEUserContactLinkNotFound $
+  ExceptT . firstRow (\(ucl :. gli) -> (toUserContactLink ucl, toGroupLinkInfo gli)) SEUserContactLinkNotFound $
-    DB.query
+    DB.query db (groupLinkInfoQuery <> " AND user_contact_link_id = ?") (userId, userContactLinkId)
-      db
+
-      [sql|
+groupLinkInfoQuery :: Query
-        SELECT conn_req_contact, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role
+groupLinkInfoQuery =
-        FROM user_contact_links
+  [sql|
-        WHERE user_id = ?
+    SELECT conn_req_contact, auto_accept, business_address, auto_accept_incognito, auto_reply_msg_content, group_id, group_link_member_role
-          AND user_contact_link_id = ?
+    FROM user_contact_links
-      |]
+    WHERE user_id = ?
-      (userId, userContactLinkId)
+  |]
+
+toGroupLinkInfo :: (Maybe GroupId, Maybe GroupMemberRole) -> Maybe GroupLinkInfo
+toGroupLinkInfo (groupId_, mRole_) =
+  (\groupId -> GroupLinkInfo {groupId, memberRole = fromMaybe GRMember mRole_})
+    <$> groupId_
+
+getGroupLinkInfo :: DB.Connection -> UserId -> GroupId -> IO (Maybe GroupLinkInfo)
+getGroupLinkInfo db userId groupId =
+  fmap join $ maybeFirstRow toGroupLinkInfo $ 
+    DB.query db (groupLinkInfoQuery <> " AND group_id = ?") (userId, groupId)
 
 getUserContactLinkByConnReq :: DB.Connection -> User -> (ConnReqContact, ConnReqContact) -> IO (Maybe UserContactLink)
 getUserContactLinkByConnReq db User {userId} (cReqSchema1, cReqSchema2) =

src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt

@@ -4870,7 +4870,7 @@ Query:
 Plan:
 SCAN usage_conditions
 
-Query:  SELECT chat_item_id FROM chat_items WHERE  ( user_id = ? AND group_id = ?  AND  item_ts < ? ) OR ( user_id = ? AND group_id = ?  AND  item_ts = ? AND chat_item_id < ? )  ORDER BY item_ts DESC, chat_item_id DESC  LIMIT ?
+Query:  SELECT chat_item_id FROM chat_items WHERE  (( user_id = ? AND group_id = ?  AND  item_ts < ? ) OR ( user_id = ? AND group_id = ?  AND  item_ts = ? AND chat_item_id < ? ))  ORDER BY item_ts DESC, chat_item_id DESC  LIMIT ?
 Plan:
 MULTI-INDEX OR
 INDEX 1
@@ -4879,7 +4879,7 @@ INDEX 2
 SEARCH chat_items USING COVERING INDEX idx_chat_items_groups_item_ts (user_id=? AND group_id=? AND item_ts=? AND rowid<?)
 USE TEMP B-TREE FOR ORDER BY
 
-Query:  SELECT chat_item_id FROM chat_items WHERE  ( user_id = ? AND group_id = ?  AND  item_ts > ? ) OR ( user_id = ? AND group_id = ?  AND  item_ts = ? AND chat_item_id > ? )  ORDER BY item_ts ASC, chat_item_id ASC  LIMIT ?
+Query:  SELECT chat_item_id FROM chat_items WHERE  (( user_id = ? AND group_id = ?  AND  item_ts > ? ) OR ( user_id = ? AND group_id = ?  AND  item_ts = ? AND chat_item_id > ? ))  ORDER BY item_ts ASC, chat_item_id ASC  LIMIT ?
 Plan:
 MULTI-INDEX OR
 INDEX 1

src/Simplex/Chat/Types.hs

@@ -668,6 +668,7 @@ data GroupLinkInvitation = GroupLinkInvitation
     fromMemberName :: ContactName,
     invitedMember :: MemberIdRole,
     groupProfile :: GroupProfile,
+    accepted :: Maybe GroupAcceptance,
     business :: Maybe BusinessChatInfo,
     groupSize :: Maybe Int
   }
@@ -997,6 +998,7 @@ data GroupMemberStatus
   | GSMemGroupDeleted -- user member of the deleted group
   | GSMemUnknown -- unknown member, whose message was forwarded by an admin (likely member wasn't introduced due to not being a current member, but message was included in history)
   | GSMemInvited -- member is sent to or received invitation to join the group
+  | GSMemPendingApproval -- member is connected to host but pending host approval before connecting to other members ("knocking")
   | GSMemIntroduced -- user received x.grp.mem.intro for this member (only with GCPreMember)
   | GSMemIntroInvited -- member is sent to or received from intro invitation
   | GSMemAccepted -- member accepted invitation (only User and Invitee)
@@ -1017,6 +1019,11 @@ instance ToJSON GroupMemberStatus where
   toJSON = J.String . textEncode
   toEncoding = JE.text . textEncode
 
+acceptanceToStatus :: GroupAcceptance -> GroupMemberStatus
+acceptanceToStatus = \case
+  GAAccepted -> GSMemAccepted
+  GAPending -> GSMemPendingApproval
+
 memberActive :: GroupMember -> Bool
 memberActive m = case memberStatus m of
   GSMemRejected -> False
@@ -1025,6 +1032,7 @@ memberActive m = case memberStatus m of
   GSMemGroupDeleted -> False
   GSMemUnknown -> False
   GSMemInvited -> False
+  GSMemPendingApproval -> True
   GSMemIntroduced -> False
   GSMemIntroInvited -> False
   GSMemAccepted -> False
@@ -1045,6 +1053,7 @@ memberCurrent' = \case
   GSMemGroupDeleted -> False
   GSMemUnknown -> False
   GSMemInvited -> False
+  GSMemPendingApproval -> False
   GSMemIntroduced -> True
   GSMemIntroInvited -> True
   GSMemAccepted -> True
@@ -1061,6 +1070,7 @@ memberRemoved m = case memberStatus m of
   GSMemGroupDeleted -> True
   GSMemUnknown -> False
   GSMemInvited -> False
+  GSMemPendingApproval -> False
   GSMemIntroduced -> False
   GSMemIntroInvited -> False
   GSMemAccepted -> False
@@ -1077,6 +1087,7 @@ instance TextEncoding GroupMemberStatus where
     "deleted" -> Just GSMemGroupDeleted
     "unknown" -> Just GSMemUnknown
     "invited" -> Just GSMemInvited
+    "pending_approval" -> Just GSMemPendingApproval
     "introduced" -> Just GSMemIntroduced
     "intro-inv" -> Just GSMemIntroInvited
     "accepted" -> Just GSMemAccepted
@@ -1092,6 +1103,7 @@ instance TextEncoding GroupMemberStatus where
     GSMemGroupDeleted -> "deleted"
     GSMemUnknown -> "unknown"
     GSMemInvited -> "invited"
+    GSMemPendingApproval -> "pending_approval"
     GSMemIntroduced -> "introduced"
     GSMemIntroInvited -> "intro-inv"
     GSMemAccepted -> "accepted"

src/Simplex/Chat/Types/Shared.hs

@@ -48,3 +48,27 @@ instance FromJSON GroupMemberRole where
 instance ToJSON GroupMemberRole where
   toJSON = strToJSON
   toEncoding = strToJEncoding
+
+data GroupAcceptance = GAAccepted | GAPending deriving (Eq, Show)
+
+-- TODO [knocking] encoding doesn't match field type
+instance FromField GroupAcceptance where fromField = blobFieldDecoder strDecode
+
+instance ToField GroupAcceptance where toField = toField . strEncode
+
+instance StrEncoding GroupAcceptance where
+  strEncode = \case
+    GAAccepted -> "accepted"
+    GAPending -> "pending"
+  strDecode = \case
+    "accepted" -> Right GAAccepted
+    "pending" -> Right GAPending
+    r -> Left $ "bad GroupAcceptance " <> B.unpack r
+  strP = strDecode <$?> A.takeByteString
+
+instance FromJSON GroupAcceptance where
+  parseJSON = strParseJSON "GroupAcceptance"
+
+instance ToJSON GroupAcceptance where
+  toJSON = strToJSON
+  toEncoding = strToJEncoding

src/Simplex/Chat/View.hs

@@ -1076,14 +1076,22 @@ viewNetworkStatuses = map viewStatuses . L.groupBy ((==) `on` netStatus) . sortO
     viewStatuses ss@(s :| _) = plain $ show (L.length ss) <> " connections " <> netStatusStr (netStatus s)
 
 viewUserJoinedGroup :: GroupInfo -> [StyledString]
-viewUserJoinedGroup g =
+viewUserJoinedGroup g@GroupInfo {membership} =
   case incognitoMembershipProfile g of
-    Just mp -> [ttyGroup' g <> ": you joined the group incognito as " <> incognitoProfile' (fromLocalProfile mp)]
+    Just mp -> [ttyGroup' g <> ": you joined the group incognito as " <> incognitoProfile' (fromLocalProfile mp) <> pendingApproval_]
-    Nothing -> [ttyGroup' g <> ": you joined the group"]
+    Nothing -> [ttyGroup' g <> ": you joined the group" <> pendingApproval_]
+  where
+    pendingApproval_ = case memberStatus membership of
+      GSMemPendingApproval -> ", pending approval"
+      _ -> ""
 
 viewJoinedGroupMember :: GroupInfo -> GroupMember -> [StyledString]
-viewJoinedGroupMember g m =
+viewJoinedGroupMember g@GroupInfo {groupId} m@GroupMember {groupMemberId, memberStatus} = case memberStatus of
-  [ttyGroup' g <> ": " <> ttyMember m <> " joined the group "]
+  GSMemPendingApproval ->
+    [ (ttyGroup' g <> ": " <> ttyMember m <> " connected and pending approval, ")
+      <> ("use " <> highlight ("/_accept member #" <> show groupId <> " " <> show groupMemberId <> " <role>") <> " to accept member")
+    ]
+  _ -> [ttyGroup' g <> ": " <> ttyMember m <> " joined the group "]
 
 viewReceivedGroupInvitation :: GroupInfo -> Contact -> GroupMemberRole -> [StyledString]
 viewReceivedGroupInvitation g c role =

tests/Bots/DirectoryTests.hs

@@ -86,12 +86,13 @@ mkDirectoryOpts TestParams {tmpPath = ps} superUsers ownersGroup =
       adminUsers = [],
       superUsers,
       ownersGroup,
-      directoryLog = Just $ ps </> "directory_service.log",
+      blockedFragmentsFile = Nothing,
       blockedWordsFile = Nothing,
       blockedExtensionRules = Nothing,
       nameSpellingFile = Nothing,
       profileNameLimit = maxBound,
-      acceptAsObserver = Nothing,
+      captchaGenerator = Nothing,
+      directoryLog = Just $ ps </> "directory_service.log",
       serviceName = "SimpleX-Directory",
       runCLI = False,
       searchResults = 3,
@@ -182,6 +183,8 @@ testDirectoryService ps =
         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."
+        bob <## ""
+        bob <## "Use /filter 1 to configure anti-spam filter and /role 1 to set default member role."
         search bob "privacy" welcomeWithLink'
         search bob "security" welcomeWithLink'
         cath `connectVia` dsLink
@@ -1045,6 +1048,8 @@ reapproveGroup count superUser bob = do
   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."
+  bob <## ""
+  bob <## "Use /filter 1 to configure anti-spam filter and /role 1 to set default member role."
 
 addCathAsOwner :: HasCallStack => TestCC -> TestCC -> IO ()
 addCathAsOwner bob cath = do
@@ -1114,7 +1119,9 @@ runDirectory cfg opts@DirectoryOpts {directoryLog} action = do
   threadDelay 500000
   action `finally` (mapM_ hClose (directoryLogFile st) >> killThread t)
   where
-    bot st = simplexChatCore cfg (mkChatOpts opts) $ directoryService st opts
+    bot st = do
+      env <- newServiceState opts
+      simplexChatCore cfg (mkChatOpts opts) $ directoryService st opts env
 
 registerGroup :: TestCC -> TestCC -> String -> String -> IO ()
 registerGroup su u n fn = registerGroupId su u n fn 1 1
@@ -1187,6 +1194,8 @@ approveRegistrationId su u n gId ugId = do
   su <## "      Group approved!"
   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."
+  u <## ""
+  u <## ("Use /filter " <> show ugId <> " to configure anti-spam filter and /role " <> show ugId <> " to set default member role.")
 
 connectVia :: TestCC -> String -> IO ()
 u `connectVia` dsLink = do

tests/ChatTests/Groups.hs

@@ -20,14 +20,14 @@ import qualified Data.ByteString.Char8 as B
 import Data.List (intercalate, isInfixOf)
 import qualified Data.Map.Strict as M
 import qualified Data.Text as T
-import Simplex.Chat.Controller (ChatConfig (..))
+import Simplex.Chat.Controller (ChatConfig (..), ChatHooks (..), defaultChatHooks)
 import Simplex.Chat.Library.Internal (uniqueMsgMentions, updatedMentionNames)
 import Simplex.Chat.Markdown (parseMaybeMarkdownList)
 import Simplex.Chat.Messages (CIMention (..), CIMentionMember (..), ChatItemId)
 import Simplex.Chat.Options
 import Simplex.Chat.Protocol (MsgMention (..), MsgContent (..), msgContentText)
 import Simplex.Chat.Types
-import Simplex.Chat.Types.Shared (GroupMemberRole (..))
+import Simplex.Chat.Types.Shared (GroupMemberRole (..), GroupAcceptance (..))
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.RetryInterval
 import qualified Simplex.Messaging.Agent.Store.DB as DB
@@ -98,7 +98,11 @@ chatGroupTests = do
     it "group link member role" testGroupLinkMemberRole
     it "host profile received" testGroupLinkHostProfileReceived
     it "existing contact merged" testGroupLinkExistingContactMerged
-    it "reject member joining via group link - blocked name" testGroupLinkRejectBlockedName
+  describe "group links - join rejection" $ do
+    it "reject member joining via group link - blocked name" testGLinkRejectBlockedName
+  describe "group links - manual acceptance" $ do
+    it "manually accept member joining via group link" testGLinkManualAcceptMember
+    it "delete pending member" testGLinkDeletePendingMember
   describe "group link connection plan" $ do
     it "ok to connect; known group" testPlanGroupLinkKnown
     it "own group link" testPlanGroupLinkOwn
@@ -185,6 +189,8 @@ chatGroupTests = do
     it "should send updated mentions in history" testGroupHistoryWithMentions
     describe "uniqueMsgMentions" testUniqueMsgMentions
     describe "updatedMentionNames" testUpdatedMentionNames
+  describe "group direct messages" $ do
+    it "should send group direct messages" testGroupDirectMessages
 
 testGroupCheckMessages :: HasCallStack => TestParams -> IO ()
 testGroupCheckMessages =
@@ -2867,8 +2873,8 @@ testGroupLinkExistingContactMerged =
       bob #> "#team hi there"
       alice <# "#team bob> hi there"
 
-testGroupLinkRejectBlockedName :: HasCallStack => TestParams -> IO ()
+testGLinkRejectBlockedName :: HasCallStack => TestParams -> IO ()
-testGroupLinkRejectBlockedName =
+testGLinkRejectBlockedName =
   testChatCfg2 cfg aliceProfile bobProfile $
     \alice bob -> do
       alice ##> "/g team"
@@ -2894,7 +2900,92 @@ testGroupLinkRejectBlockedName =
       bob <## "group link: known group #team"
       bob <## "use #team <message> to send messages"
   where
-    cfg = testCfg {allowedProfileName = Just (const False)}
+    cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Left GRRBlockedName)}}
+
+testGLinkManualAcceptMember :: HasCallStack => TestParams -> IO ()
+testGLinkManualAcceptMember =
+  testChatCfg3 cfg aliceProfile bobProfile cathProfile $
+    \alice bob cath -> do
+      createGroup2 "team" alice bob
+
+      alice ##> "/create link #team"
+      gLink <- getGroupLink alice "team" GRMember True
+      cath ##> ("/c " <> gLink)
+      cath <## "connection request sent!"
+      alice <## "cath (Catherine): accepting request to join group #team..."
+      concurrentlyN_
+        [ alice <## "#team: cath connected and pending approval, use /_accept member #1 3 <role> to accept member",
+          do
+            cath <## "#team: joining the group..."
+            cath <## "#team: you joined the group, pending approval"
+        ]
+
+      -- pending approval member doesn't see messages sent in group
+      alice #> "#team hi group"
+      bob <# "#team alice> hi group"
+
+      bob #> "#team hey"
+      alice <# "#team bob> hey"
+
+      -- pending approval member and host can send messages to each other
+      alice ##> "/_send #1 @3 text send me proofs"
+      alice <# "#team send me proofs"
+      cath <# "#team alice> send me proofs"
+
+      cath ##> "/_send #1 @1 text proofs"
+      cath <# "#team proofs"
+      alice <# "#team cath> proofs"
+
+      -- accept member
+      alice ##> "/_accept member #1 3 member"
+      concurrentlyN_
+        [ alice <## "#team: cath joined the group",
+          cath
+            <### [ "#team: you joined the group",
+                   WithTime "#team alice> hi group [>>]",
+                   WithTime "#team bob> hey [>>]",
+                   "#team: member bob (Bob) is connected"
+                 ],
+          do
+            bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
+            bob <## "#team: new member cath is connected"
+        ]
+
+      alice #> "#team welcome cath"
+      [bob, cath] *<# "#team alice> welcome cath"
+
+      bob #> "#team hi cath"
+      [alice, cath] *<# "#team bob> hi cath"
+
+      cath #> "#team hi group"
+      [alice, bob] *<# "#team cath> hi group"
+  where
+    cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Right (GAPending, GRObserver))}}
+
+testGLinkDeletePendingMember :: HasCallStack => TestParams -> IO ()
+testGLinkDeletePendingMember =
+  testChatCfg3 cfg aliceProfile bobProfile cathProfile $
+    \alice bob cath -> do
+      createGroup2 "team" alice bob
+
+      alice ##> "/create link #team"
+      gLink <- getGroupLink alice "team" GRMember True
+      cath ##> ("/c " <> gLink)
+      cath <## "connection request sent!"
+      alice <## "cath (Catherine): accepting request to join group #team..."
+      concurrentlyN_
+        [ alice <## "#team: cath connected and pending approval, use /_accept member #1 3 <role> to accept member",
+          do
+            cath <## "#team: joining the group..."
+            cath <## "#team: you joined the group, pending approval"
+        ]
+
+      alice ##> "/rm team cath"
+      alice <## "#team: you removed cath from the group"
+      cath <## "#team: alice removed you from the group"
+      cath <## "use /d #team to delete the group"
+  where
+    cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Right (GAPending, GRObserver))}}
 
 testPlanGroupLinkKnown :: HasCallStack => TestParams -> IO ()
 testPlanGroupLinkKnown =
@@ -6457,3 +6548,37 @@ testUpdatedMentionNames = do
     mentionedMember name_ = CIMention {memberId = MemberId "abcd", memberRef = ciMentionMember <$> name_}
       where
         ciMentionMember name = CIMentionMember {groupMemberId = 1, displayName = name, localAlias = Nothing, memberRole = GRMember}
+
+testGroupDirectMessages :: HasCallStack => TestParams -> IO ()
+testGroupDirectMessages =
+  testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
+    createGroup3 "team" alice bob cath
+
+    alice #> "#team 1"
+    [bob, cath] *<# "#team alice> 1"
+
+    bob #> "#team 2"
+    [alice, cath] *<# "#team bob> 2"
+
+    void $ withCCTransaction alice $ \db ->
+      DB.execute_ db "UPDATE group_members SET member_status='pending_approval' WHERE group_member_id = 2"
+
+    alice ##> "/_send #1 @2 text 3"
+    alice <# "#team 3"
+    bob <# "#team alice> 3"
+
+    void $ withCCTransaction bob $ \db ->
+      DB.execute_ db "UPDATE group_members SET member_status='pending_approval' WHERE group_member_id = 1"
+
+    bob ##> "/_send #1 @1 text 4"
+    bob <# "#team 4"
+    alice <# "#team bob> 4"
+
+    -- GSMemPendingApproval members don't receive messages sent to group.
+    -- Though in test we got here synthetically, in reality this status
+    -- means they are not yet part of group (not memberCurrent).
+    alice #> "#team 5"
+    cath <# "#team alice> 5"
+
+    bob #> "#team 6"
+    cath <# "#team bob> 6"

tests/SchemaDump.hs

@@ -125,7 +125,9 @@ skipComparisonForDownMigrations =
     -- indexes move down to the end of the file
     "20241125_indexes",
     -- indexes move down to the end of the file
-    "20250130_indexes"
+    "20250130_indexes",
+    -- index moves down to the end of the file
+    "20250227_member_acceptance"
   ]
 
 getSchema :: FilePath -> FilePath -> IO String