{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}

module Directory.Service
  ( welcomeGetOpts,
    directoryService,
    directoryServiceCLI,
  )
where

import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.STM
import Control.Exception (SomeException, try)
import Control.Logger.Simple
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import qualified Data.Attoparsec.Text as A
import Data.Bifunctor (first)
import Data.Either (fromRight)
import Data.List (find, intercalate)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe, isJust, isNothing, maybeToList)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
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.Captcha
import Directory.Events
import Directory.Listing
import Directory.Options
import Directory.Search
import Directory.Store
import Directory.Store.Migrate
import Directory.Util
import Simplex.Chat.Bot
import Simplex.Chat.Bot.KnownContacts
import Simplex.Chat.Controller
import Simplex.Chat.Core
import Simplex.Chat.Markdown (Format (..), FormattedText (..), SimplexLinkType (..), parseMaybeMarkdownList, viewName)
import Simplex.Chat.Messages
import Simplex.Chat.Options
import Simplex.Chat.Protocol (GroupShortLinkData (..), LinkOwnerSig (..), MsgChatLink (..), MsgContent (..), memberSupportVoiceVersion)
import Simplex.Chat.Store.Direct (getContact)
import Simplex.Chat.Store.Groups (getGroupLink, getGroupMember, getGroupMemberByMemberId, setGroupCustomData) -- TODO remove 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.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.View (serializeChatError, serializeChatResponse, simplexChatContact, viewContactName, viewGroupName)
import Simplex.Messaging.Agent.Protocol (AConnectionLink (..), ACreatedConnLink (..), AgentErrorType (..), ConnectionLink (..), CreatedConnLink (..), SConnectionMode (..), sameConnReqContact, sameShortLinkContact)
import qualified Simplex.Messaging.Crypto.File as CF
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (ErrorType (..))
import Simplex.Messaging.TMap (TMap)
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Util (eitherToMaybe, raceAny_, safeDecodeUtf8, tshow, unlessM, (<$$>))
import System.Directory (getAppUserDataDirectory, removeFile)
import System.Exit (exitFailure)
import System.Process (readProcess)
import Text.Read (readMaybe)

data GroupProfileUpdate
  = GPNoServiceLink
  | GPServiceLinkAdded {linkNow :: Text}
  | GPServiceLinkRemoved
  | GPHasServiceLink {linkBefore :: Text, linkNow :: Text}
  | GPServiceLinkError

data DuplicateGroup
  = DGUnique -- display name or full name is unique
  | DGRegistered -- the group with the same names is registered, additional confirmation is required
  | DGReserved -- the group with the same names is listed, the registration is not allowed

data GroupRolesStatus
  = GRSOk
  | GRSServiceNotAdmin
  | GRSContactNotOwner
  | GRSBadRoles
  deriving (Eq)

data ServiceState = ServiceState
  { searchRequests :: TMap ContactId SearchRequest,
    blockedWordsCfg :: BlockedWordsConfig,
    pendingCaptchas :: TMap GroupMemberId PendingCaptcha,
    serviceCC :: TMVar ChatController,
    eventQ :: TQueue DirectoryEvent,
    updateListingsJob :: TMVar ()
  }

data CaptchaMode = CMText | CMAudio

data PendingCaptcha = PendingCaptcha
  { captchaText :: Text,
    sentAt :: UTCTime,
    attempts :: Int,
    captchaMode :: CaptchaMode
  }

captchaLength :: Int
captchaLength = 7

maxCaptchaAttempts :: Int
maxCaptchaAttempts = 5

captchaTTL :: NominalDiffTime
captchaTTL = 600 -- 10 minutes

newServiceState :: DirectoryOpts -> IO ServiceState
newServiceState opts = do
  searchRequests <- TM.emptyIO
  blockedWordsCfg <- readBlockedWordsConfig opts
  pendingCaptchas <- TM.emptyIO
  serviceCC <- newEmptyTMVarIO
  eventQ <- newTQueueIO
  updateListingsJob <- newEmptyTMVarIO
  pure ServiceState {searchRequests, blockedWordsCfg, pendingCaptchas, serviceCC, eventQ, updateListingsJob}

welcomeGetOpts :: IO DirectoryOpts
welcomeGetOpts = do
  appDir <- getAppUserDataDirectory "simplex"
  opts@DirectoryOpts {coreOptions, testing, superUsers, adminUsers, ownersGroup} <- getDirectoryOpts appDir "simplex_directory_service"
  unless testing $ do
    putStrLn $ "SimpleXXX Directory Service Bot v" ++ versionNumber
    printDbOpts coreOptions
    putStrLn $ knownContacts "superuser" superUsers
    putStrLn $ knownContacts "admin user" adminUsers
    putStrLn $ case ownersGroup of
      Nothing -> "No owner's group"
      Just KnownGroup {groupId, localDisplayName = n} -> "Owners' group: " <> knownName groupId n
  pure opts
  where
    knownContacts userType = \case
      [] -> "No " <> userType <> "s"
      cts -> show (length cts) <> " " <> userType <> "(s): " <> intercalate ", " (map knownContact cts)
    knownContact KnownContact {contactId, localDisplayName = n} = knownName contactId n
    knownName i n = show i <> ":" <> T.unpack (viewName n)

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

updateListingDelay :: Int
updateListingDelay = 5 * 60 * 1000000 -- update every 5 minutes

updateListingsThread_ :: DirectoryOpts -> ServiceState -> Maybe (IO ())
updateListingsThread_ opts env = updateListingsThread <$> webFolder opts
  where
    updateListingsThread f = do
      cc <- atomically $ readTMVar $ serviceCC env
      forever $ do
        u <- readTVarIO $ currentUser cc
        forM_ u $ \user -> updateGroupListingFiles cc user f
        delay <- registerDelay updateListingDelay
        atomically $ void (takeTMVar $ updateListingsJob env) `orElse` unlessM (readTVar delay) retry

listingsUpdated :: ServiceState -> IO ()
listingsUpdated env = void $ atomically $ tryPutTMVar (updateListingsJob env) ()

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

directoryPreStartHook :: DirectoryOpts -> ChatController -> IO ()
directoryPreStartHook opts ChatController {config, chatStore} = runDirectoryMigrations opts config chatStore

directoryPostStartHook :: DirectoryOpts -> ServiceState -> ChatController -> IO ()
directoryPostStartHook opts@DirectoryOpts {noAddress, testing} env cc =
  readTVarIO (currentUser cc) >>= \case
    Nothing -> putStrLn "No current user" >> exitFailure
    Just User {userId, profile = p@LocalProfile {preferences}} -> do
      unless noAddress $ initializeBotAddress' (not testing) cc
      void $ atomically $ tryPutTMVar (serviceCC env) cc
      listingsUpdated env
      let cmds = fromMaybe [] $ preferences >>= commands_
      unless (cmds == directoryCommands) $ do
        let prefs = (fromMaybe emptyChatPrefs preferences) {files = Just FilesPreference {allow = FANo}, commands = Just directoryCommands} :: Preferences
            p' = (fromLocalProfile p) {displayName = serviceName opts, peerType = Just CPTBot, preferences = Just prefs} :: Profile
        liftIO $
          sendChatCmd cc (APIUpdateProfile userId p') >>= \case
            Right CRUserProfileUpdated {} -> putStrLn "Updated directory commands"
            Right r -> putStrLn ("Error: unexpected response " <> show r) >> exitFailure
            Left e -> putStrLn ("Error: " <> show e) >> exitFailure

directoryCommands :: [ChatBotCommand]
directoryCommands =
  [ CBCCommand "new" "New groups" Nothing,
    CBCCommand "help" "How to submit your group" Nothing,
    CBCCommand "list" "Your own groups" Nothing,
    CBCMenu
      "Group settings"
      [ CBCCommand "role" "View new member role" idParam,
        CBCCommand "filter" "Anti-spam filter" idParam,
        CBCCommand "link" "View and upgrade group link" idParam,
        CBCCommand "delete" "Remove a group from directory" (Just "<ID>:'<NAME>'")
      ]
  ]
  where
    idParam = Just "<ID>"

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

acceptMemberHook :: DirectoryOpts -> ServiceState -> GroupInfo -> GroupLinkInfo -> Profile -> IO (Either GroupRejectionReason (GroupAcceptance, GroupMemberRole))
acceptMemberHook
  DirectoryOpts {profileNameLimit}
  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) -> (GAPendingApproval, 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} = (\DirectoryGroupData {memberAcceptance = ma} -> ma) $ 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, testing} = do
  extensionRules <- maybe (pure []) (fmap read . readFile) blockedExtensionRules
  spelling <- maybe (pure M.empty) (fmap (M.fromList . read) . readFile) nameSpellingFile
  blockedFragments <- S.fromList <$> maybe (pure []) (fmap T.lines . T.readFile) blockedFragmentsFile
  bws <- maybe (pure []) (fmap lines . readFile) blockedWordsFile
  let blockedWords = S.fromList $ concatMap (wordVariants extensionRules) bws
  unless testing $ putStrLn $ "Blocked fragments: " <> show (length blockedFragments) <> ", blocked words: " <> show (length blockedWords) <> ", spelling rules: " <> show (M.size spelling)
  pure BlockedWordsConfig {blockedFragments, blockedWords, extensionRules, spelling}

directoryServiceEvent :: DirectoryLog -> DirectoryOpts -> ServiceState -> User -> ChatController -> DirectoryEvent -> IO ()
directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName, ownersGroup, searchResults} env@ServiceState {searchRequests} user@User {userId} cc = \case
    DEContactConnected ct -> deContactConnected ct
    DEGroupInvitation {contact = ct, groupInfo = g, fromMemberRole, memberRole} -> deGroupInvitation ct g fromMemberRole memberRole
    DEServiceJoinedGroup ctId g owner -> deServiceJoinedGroup ctId g owner
    DEGroupUpdated {member, fromGroup, toGroup} -> deGroupUpdated member fromGroup toGroup
    DEGroupLinkCheck g -> deGroupLinkCheck g
    DEPendingMember g m -> dePendingMember g m
    DEPendingMemberMsg g m ciId t -> dePendingMemberMsg g m ciId t
    DEContactRoleChanged g ctId role -> deContactRoleChanged g ctId role
    DEServiceRoleChanged g role -> deServiceRoleChanged g role
    DEContactRemovedFromGroup ctId g -> deContactRemovedFromGroup ctId g
    DEContactLeftGroup ctId g -> deContactLeftGroup ctId g
    DEServiceRemovedFromGroup g -> deServiceRemovedFromGroup g
    DEGroupDeleted g -> deGroupDeleted g
    DEChatLinkReceived {contact = ct, chatLink, ownerSig} -> deChatLinkReceived ct chatLink ownerSig
    DEMemberUpdated {groupInfo = g, fromMember, toMember} -> deMemberUpdated g fromMember toMember
    DEUnsupportedMessage _ct _ciId -> pure ()
    DEItemEditIgnored _ct -> pure ()
    DEItemDeleteIgnored _ct -> pure ()
    DEContactCommand ct ciId (ADC sUser cmd) -> do
      logInfo $ "command received " <> directoryCmdTag cmd
      case sUser of
        SDRUser -> deUserCommand ct ciId cmd
        SDRAdmin -> deAdminCommand ct ciId cmd
        SDRSuperUser -> deSuperUserCommand ct ciId cmd
    DELogChatResponse r -> logInfo r
  where
    groupLinkText (CCLink cReq sLnk_) = maybe (strEncodeTxt $ simplexChatContact cReq) strEncodeTxt sLnk_
    withAdminUsers action = void . forkIO $ do
      forM_ superUsers $ \KnownContact {contactId} -> action contactId
      forM_ adminUsers $ \KnownContact {contactId} -> action contactId
    withSuperUsers action = void . forkIO $ forM_ superUsers $ \KnownContact {contactId} -> action contactId
    notifyAdminUsers s = withAdminUsers $ \contactId -> sendMessage' cc contactId s
    notifyOwner = sendMessage' cc . dbContactId
    ctId `isOwner` GroupReg {dbContactId} = ctId == dbContactId
    withGroupReg :: GroupInfo -> Text -> (GroupReg -> IO ()) -> IO ()
    withGroupReg GroupInfo {groupId, localDisplayName} err action =
      getGroupReg cc groupId >>= \case
        Right gr -> action gr
        Left e -> do
          let msg = "Error: " <> err <> ", group: " <> tshow groupId <> " " <> localDisplayName <> ", " <> T.pack e
          notifyAdminUsers msg
          logError msg
    groupInfoText p@GroupProfile {description = d, publicGroup} = groupNameDescr p <> maybe "" ("\nWelcome message:\n" <>) d <> linkToJoin
      where
        linkToJoin = case publicGroup of
          Just pg@PublicGroupProfile {groupLink} ->
            "\nLink to join " <> groupTypeStr' pg <> ": " <> strEncodeTxt groupLink
              <> "\nYou need SimpleX Chat app v6.5 to join."
          Nothing -> ""
    membersCountStr GroupProfile {publicGroup} GroupSummary {currentMembers, publicMemberCount} =
      let count = fromMaybe currentMembers publicMemberCount
          label = case publicGroup of
            Just PublicGroupProfile {groupType = GTChannel} -> " subscribers"
            _ -> " members"
       in tshow count <> label
    knockingStr :: Maybe GroupMemberAdmission -> [Text]
    knockingStr = \case
      Just GroupMemberAdmission {review = Just MCAll} -> ["New members are reviewed by admins"]
      _ -> []
    groupNameDescr GroupProfile {displayName = n, fullName = fn, shortDescr = sd_} =
      n <> maybe "" (\d' -> " (" <> d' <> ")") descr
      where
        descr
          | n == fn || T.null fn = if sd_ == Just "" then Nothing else sd_
          | otherwise = Just fn
    userGroupReference gr GroupInfo {groupProfile = GroupProfile {displayName}} = userGroupReference' gr displayName
    userGroupReference' GroupReg {userGroupRegId} displayName = groupReference' userGroupRegId displayName
    groupReference GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = groupReference' groupId displayName
    groupReference' groupId displayName = "ID " <> tshow groupId <> " (" <> displayName <> ")"
    groupAlreadyListed GroupInfo {groupProfile = p} =
      "The group " <> groupNameDescr p <> " is already listed in the directory, please choose another name."
    ifPublicGroup :: GroupInfo -> IO () -> IO () -> IO ()
    ifPublicGroup GroupInfo {groupProfile = GroupProfile {publicGroup}} reject action =
      if isJust publicGroup then reject else action

    getDuplicateGroup :: GroupInfo -> IO (Either String DuplicateGroup)
    getDuplicateGroup GroupInfo {groupId, groupProfile = GroupProfile {displayName}} =
      duplicateGroup <$$> getDuplicateGroupRegs cc user displayName
      where
        duplicateGroup [] = DGUnique
        duplicateGroup ((GroupInfo {groupId = gId, membership}, GroupReg {groupRegStatus = status}) : groups)
          | gId == groupId || memberRemoved membership = duplicateGroup groups
          | otherwise = case grDirectoryStatus status of
              DSListed -> DGReserved
              DSReserved -> DGReserved
              DSRegistered -> case duplicateGroup groups of
                DGReserved -> DGReserved
                _ -> DGRegistered
              DSRemoved -> duplicateGroup groups

    processInvitation :: Contact -> GroupInfo -> Maybe GroupReg -> IO ()
    processInvitation ct g@GroupInfo {groupId, groupProfile = GroupProfile {displayName}} = \case
      Nothing -> addGroupReg notifyAdminUsers st cc ct g GRSProposed joinGroup
      Just _gr -> setGroupStatus notifyAdminUsers st env cc groupId GRSProposed joinGroup
      where
        joinGroup _ = do
          r <- sendChatCmd cc $ APIJoinGroup groupId MFNone
          sendMessage cc ct $ case r of
            Right CRUserAcceptedGroupSent {} -> "Joining the group " <> displayName <> "…"
            _ -> "Error joining group " <> displayName <> ", please re-send the invitation!"

    deContactConnected :: Contact -> IO ()
    deContactConnected ct = when (contactDirect ct) $ do
      logInfo $ (viewContactName ct) <> " connected"
      sendMessage cc ct $
        ("Welcome to " <> serviceName <> "!\n\n")
          <> "🔍 Send search string to find groups - try _security_.\n\
             \/help - how to submit your group or channel.\n\
             \/new - recent groups.\n\n\
             \[Directory rules](https://simplex.chat/docs/directory.html)."

    deGroupInvitation :: Contact -> GroupInfo -> GroupMemberRole -> GroupMemberRole -> IO ()
    deGroupInvitation ct g@GroupInfo {groupProfile = p@GroupProfile {displayName}} fromMemberRole memberRole = do
      logInfo $ "invited to group " <> viewGroupName g <> " by " <> viewContactName ct
      case badRolesMsg $ groupRolesStatus fromMemberRole memberRole of
        Just msg -> sendMessage cc ct msg
        Nothing ->
          getDuplicateGroup g >>= \case
            Right DGUnique -> processInvitation ct g Nothing
            Right DGRegistered -> askConfirmation
            Right DGReserved -> sendMessage cc ct $ groupAlreadyListed g
            Left e -> sendMessage cc ct $ "Error: getDuplicateGroup. Please notify the developers.\n" <> T.pack e
      where
        askConfirmation =
          addGroupReg notifyAdminUsers st cc ct g GRSPendingConfirmation $ \GroupReg {userGroupRegId} -> do
            sendMessage cc ct $ "The group " <> groupNameDescr p <> " is already submitted to the directory.\nTo confirm the registration, please send:"
            sendMessage cc ct $ "/confirm " <> tshow userGroupRegId <> ":" <> viewName displayName

    badRolesMsg :: GroupRolesStatus -> Maybe Text
    badRolesMsg = \case
      GRSOk -> Nothing
      GRSServiceNotAdmin -> Just "You must grant directory service *admin* role to register the group"
      GRSContactNotOwner -> Just "You must have a group *owner* role to register the group"
      GRSBadRoles -> Just "You must have a group *owner* role and you must grant directory service *admin* role to register the group"

    getGroupRolesStatus :: GroupInfo -> GroupReg -> IO (Either String GroupRolesStatus)
    getGroupRolesStatus GroupInfo {groupId, membership = GroupMember {memberRole = serviceRole}} gr =
      rStatus <$$> getOwnerGroupMember groupId gr
      where
        rStatus GroupMember {memberRole} = groupRolesStatus memberRole serviceRole

    groupRolesStatus :: GroupMemberRole -> GroupMemberRole -> GroupRolesStatus
    groupRolesStatus contactRole serviceRole = case (contactRole, serviceRole) of
      (GROwner, GRAdmin) -> GRSOk
      (_, GRAdmin) -> GRSContactNotOwner
      (GROwner, _) -> GRSServiceNotAdmin
      _ -> GRSBadRoles

    getOwnerGroupMember :: GroupId -> GroupReg -> IO (Either String GroupMember)
    getOwnerGroupMember gId GroupReg {dbOwnerMemberId} = case dbOwnerMemberId of
      Just mId -> withDB "getGroupMember" cc $ \db -> withExceptT show $ getGroupMember db (vr cc) user gId mId
      Nothing -> pure $ Left "no owner member in group registration"

    deServiceJoinedGroup :: ContactId -> GroupInfo -> GroupMember -> IO ()
    deServiceJoinedGroup ctId g@GroupInfo {groupId} owner = do
      logInfo $ "service joined group " <> viewGroupName g
      withGroupReg g "joined group" $ \gr ->
        when (ctId `isOwner` gr) $ do
          let GroupInfo {groupProfile = GroupProfile {displayName}} = g
          setGroupRegOwner cc groupId owner >>= \case
            Left e -> do
              let msg = "Error updating group " <> tshow groupId <> " owner: " <> T.pack e
              logError msg
              notifyOwner gr msg
            Right () -> do
              logGUpdateOwner st groupId $ groupMemberId' owner
              notifyOwner gr $ "Joined the group " <> displayName <> ", creating the link…"
              sendChatCmd cc (APICreateGroupLink groupId GRMember) >>= \case
                Right CRGroupLinkCreated {groupLink = GroupLink {connLinkContact = gLink}} ->
                  setGroupStatus notifyAdminUsers st env cc groupId GRSPendingUpdate $ \gr' -> do
                    notifyOwner
                      gr'
                      "Created the public link to join the group via this directory service that is always online.\n\n\
                      \Please add it to the group welcome message.\n\
                      \For example, add:"
                    notifyOwner gr' $ "Link to join the group " <> displayName <> ": " <> groupLinkText gLink
                Left (ChatError e) -> case e of
                  CEGroupUserRole {} -> notifyOwner gr "Failed creating group link, as service is no longer an admin."
                  CEGroupMemberUserRemoved -> notifyOwner gr "Failed creating group link, as service is removed from the group."
                  CEGroupNotJoined _ -> notifyOwner gr $ unexpectedError "group not joined"
                  CEGroupMemberNotActive -> notifyOwner gr $ unexpectedError "service membership is not active"
                  _ -> notifyOwner gr $ unexpectedError "can't create group link"
                _ -> notifyOwner gr $ unexpectedError "can't create group link"

    deGroupUpdated :: GroupMember -> GroupInfo -> GroupInfo -> IO ()
    deGroupUpdated m@GroupMember {memberProfile = LocalProfile {displayName = mName}} fromGroup toGroup = do
      logInfo $ "group updated " <> viewGroupName toGroup
      unless (sameProfile p p') $ do
        withGroupReg toGroup "group updated" $ \gr@GroupReg {groupRegStatus} -> do
          let userGroupRef = userGroupReference gr toGroup
              byMember = case memberContactId m of
                Just ctId | ctId `isOwner` gr -> "" -- group registration owner, not any group owner.
                _ -> " by " <> mName -- owner notification from directory will include the name.
          case publicGroup p' of
            Just pg -> case groupRegStatus of
              GRSPendingApproval n -> publicGroupProfileChange pg gr byMember $ n + 1
              GRSActive -> publicGroupProfileChange pg gr byMember 1
              _ -> pure ()
            Nothing -> case groupRegStatus of
              GRSPendingConfirmation -> pure ()
              GRSProposed -> pure ()
              GRSPendingUpdate ->
                groupProfileUpdate >>= \case
                  GPNoServiceLink ->
                    notifyOwner gr $ "The profile updated for " <> userGroupRef <> byMember <> ", but the group link is not added to the welcome message."
                  GPServiceLinkAdded _ -> groupLinkAdded gr byMember
                  GPServiceLinkRemoved ->
                    notifyOwner gr $
                      "The group link of " <> userGroupRef <> " is removed from the welcome message" <> byMember <> ", please add it."
                  GPHasServiceLink {} -> groupLinkAdded gr byMember
                  GPServiceLinkError -> do
                    notifyOwner gr $
                      ("Error: " <> serviceName <> " has no group link for " <> userGroupRef)
                        <> " after profile was updated"
                        <> byMember
                        <> ". Please report the error to the developers."
                    logError $ "Error: no group link for " <> userGroupRef
              GRSPendingApproval n -> processProfileChange gr byMember False $ n + 1
              GRSActive -> processProfileChange gr byMember True 1
              GRSSuspended -> processProfileChange gr byMember False 1
              GRSSuspendedBadRoles -> processProfileChange gr byMember False 1
              GRSRemoved -> pure ()
      where
        GroupInfo {groupId, groupProfile = p} = fromGroup
        GroupInfo {groupProfile = p'} = toGroup
        sameProfile
          GroupProfile {displayName = n, fullName = fn, shortDescr = sd, image = i, description = d, memberAdmission = ma, publicGroup = pg}
          GroupProfile {displayName = n', fullName = fn', shortDescr = sd', image = i', description = d', memberAdmission = ma', publicGroup = pg'} =
            n == n' && fn == fn' && i == i' && sd == sd' && (T.words <$> d) == (T.words <$> d') && ma == ma' && pg == pg'
        publicGroupProfileChange pg@PublicGroupProfile {groupLink} gr byMember n' = do
          let gt = groupTypeStr' pg
              userGroupRef = userGroupReference gr toGroup
              groupRef = groupReference toGroup
              link = ACL SCMContact $ CLShort groupLink
              updatedNotification gr' g' = do
                notifyOwner gr' $
                  ("The " <> gt <> " " <> userGroupRef <> " is updated" <> byMember)
                    <> ".\nIt is hidden from the directory until approved."
                notifyAdminUsers $ "The " <> gt <> " " <> groupRef <> " is updated" <> byMember <> "."
                sendToApprove g' gr' n'
          sendChatCmd cc (APIConnectPlan userId (Just link) True Nothing) >>= \case
            Right (CRConnectionPlan _ _ (CPGroupLink (GLPKnown {groupInfo = g'}))) ->
              case dbOwnerMemberId gr of
                Just ownerGMId ->
                  withDB "getGroupMember" cc (\db -> withExceptT show $ getGroupMember db (vr cc) user groupId ownerGMId) >>= \case
                    Right ownerMember
                      | let GroupMember {memberRole = role} = ownerMember, role >= GROwner ->
                          setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval n') (`updatedNotification` g')
                      | otherwise -> do
                          setGroupStatus notifyAdminUsers st env cc groupId GRSSuspendedBadRoles $ \_ -> pure ()
                          notifyOwner gr $ "The registration owner is no longer an owner. Registration suspended."
                    Left _ -> logError $ "could not find owner member for " <> groupRef
                Nothing -> logError $ "no owner member set for " <> groupRef
            _ ->
              setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval n') (`updatedNotification` toGroup)
        groupLinkAdded gr byMember =
          getDuplicateGroup toGroup >>= \case
            Left e -> notifyOwner gr $ "Error: getDuplicateGroup. Please notify the developers.\n" <> T.pack e
            Right DGReserved -> notifyOwner gr $ groupAlreadyListed toGroup
            _ -> setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval gaId) $ \gr' -> do
              notifyOwner gr' $
                ("Thank you! The group link for " <> userGroupReference gr' toGroup <> " is added to the welcome message" <> byMember)
                  <> ".\nYou will be notified once the group is added to the directory - it may take up to 48 hours."
              checkRolesSendToApprove gr' gaId
              where
                gaId = 1
        processProfileChange gr byMember isActive n' = do
          let userGroupRef = userGroupReference gr toGroup
              groupRef = groupReference toGroup
          groupProfileUpdate >>= \case
            GPNoServiceLink -> setGroupStatus notifyAdminUsers st env cc groupId GRSPendingUpdate $ \gr' -> do
              notifyOwner gr' $
                ("The group profile is updated for " <> userGroupRef <> byMember <> ", but no link is added to the welcome message.\n\n")
                  <> "The group will remain hidden from the directory until the group link is added and the group is re-approved."
            GPServiceLinkRemoved -> setGroupStatus notifyAdminUsers st env cc groupId GRSPendingUpdate $ \gr' -> do
              notifyOwner gr' $
                ("The group link for " <> userGroupRef <> " is removed from the welcome message" <> byMember)
                  <> ".\n\nThe group is hidden from the directory until the group link is added and the group is re-approved."
              notifyAdminUsers $ "The group link is removed from " <> groupRef <> ", de-listed."
            GPServiceLinkAdded _ -> setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval n') $ \gr' -> do
              notifyOwner gr' $
                ("The group link is added to " <> userGroupRef <> byMember)
                  <> "!\nIt is hidden from the directory until approved."
              notifyAdminUsers $ "The group link is added to " <> groupRef <> byMember <> "."
              checkRolesSendToApprove gr n'
            GPHasServiceLink {linkBefore, linkNow}
              | isActive && onlyLinkChanged p p' -> do
                  notifyOwner gr $
                    ("The group " <> userGroupRef <> " is updated" <> byMember)
                      <> "!\nThe group is listed in directory."
                  notifyAdminUsers $ "The group " <> groupRef <> " is updated" <> byMember <> " - only link or whitespace changes.\nThe group remained listed in directory."
              | otherwise -> setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval n') $ \gr' -> do
                  notifyOwner gr' $
                    ("The group " <> userGroupRef <> " is updated" <> byMember)
                      <> "!\nIt is hidden from the directory until approved."
                  notifyAdminUsers $ "The group " <> groupRef <> " is updated" <> byMember <> "."
                  checkRolesSendToApprove gr' n'
              where
                onlyLinkChanged
                  GroupProfile {displayName = dn, fullName = fn, shortDescr = sd, image = i, description = d, memberAdmission = ma}
                  GroupProfile {displayName = dn', fullName = fn', shortDescr = sd', image = i', description = d', memberAdmission = ma'} =
                    dn == dn' && fn == fn' && i == i' && sd == sd' && ma == ma' && (T.words . T.replace linkBefore "" <$> d) == (T.words . T.replace linkNow "" <$> d')
            GPServiceLinkError -> logError $ "Error: no group link for " <> groupRef <> " pending approval."
        groupProfileUpdate = profileUpdate <$> sendChatCmd cc (APIGetGroupLink groupId)
          where
            profileUpdate = \case
              Right CRGroupLink {groupLink = GroupLink {connLinkContact = CCLink cr sl_}} ->
                let linkBefore_ = profileGroupLinkText fromGroup
                    linkNow_ = profileGroupLinkText toGroup
                    profileGroupLinkText GroupInfo {groupProfile = gp} =
                      maybe Nothing (fmap (\(FormattedText _ t) -> t) . find ftHasLink) $ parseMaybeMarkdownList =<< description gp
                    ftHasLink = \case
                      FormattedText (Just SimplexLink {simplexUri = ACL SCMContact cLink}) _ -> case cLink of
                        CLFull cr' -> sameConnReqContact cr' cr
                        CLShort sl' -> maybe False (sameShortLinkContact sl') sl_
                      _ -> False
                 in case (linkBefore_, linkNow_) of
                      (Just linkBefore, Just linkNow) -> GPHasServiceLink linkBefore linkNow
                      (Just _, Nothing) -> GPServiceLinkRemoved
                      (Nothing, Just linkNow) -> GPServiceLinkAdded linkNow
                      (Nothing, Nothing) -> GPNoServiceLink
              _ -> GPServiceLinkError
        checkRolesSendToApprove gr gaId = do
          (badRolesMsg <$$> getGroupRolesStatus toGroup gr) >>= \case
            Left e -> notifyOwner gr $ "Error: getGroupRolesStatus. Please notify the developers.\n" <> T.pack e
            Right (Just msg) -> notifyOwner gr msg
            Right 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 CMText
      | otherwise = approvePendingMember a g m
      where
        a = groupMemberAcceptance g
        captchaNotice =
          "Captcha is generated by SimpleXXX Directory service.\n\n*Send captcha text* to join the group " <> displayName <> "."
            <> if canSendVoiceCaptcha g m then "\nSend /audio to receive a voice captcha." else ""

    sendMemberCaptcha :: GroupInfo -> GroupMember -> Maybe ChatItemId -> Text -> Int -> CaptchaMode -> IO ()
    sendMemberCaptcha GroupInfo {groupId} m quotedId noticeText prevAttempts mode = do
      s <- getCaptchaStr captchaLength ""
      sentAt <- getCurrentTime
      let captcha = PendingCaptcha {captchaText = T.pack s, sentAt, attempts = prevAttempts + 1, captchaMode = mode}
      atomically $ TM.insert gmId captcha $ pendingCaptchas env
      case mode of
        CMAudio -> do
          mc <- getCaptchaContent s
          sendComposedMessages_ cc sendRef [(quotedId, MCText noticeText), (Nothing, mc)]
          sendVoiceCaptcha sendRef s
        CMText -> do
          mc <- getCaptchaContent s
          sendComposedMessages_ cc sendRef [(quotedId, MCText noticeText), (Nothing, mc)]
      where
        sendRef = SRGroup groupId (Just $ GCSMemberSupport (Just gmId)) False
        gmId = groupMemberId' m

    sendVoiceCaptcha :: SendRef -> String -> IO ()
    sendVoiceCaptcha sendRef s =
      forM_ (voiceCaptchaGenerator opts) $ \script ->
        void . forkIO $ do
          voiceResult <- try $ readProcess script [s] "" :: IO (Either SomeException String)
          case voiceResult of
            Right r -> case lines r of
              (filePath : durationStr : _)
                | not (null filePath), Just duration <- readMaybe durationStr -> do
                    sendComposedMessageFile cc sendRef Nothing (MCVoice "" duration) (CF.plain filePath)
                    void (try $ removeFile filePath :: IO (Either SomeException ()))
              _ -> logError "voice captcha generator: unexpected output"
            Left e -> logError $ "voice captcha generator error: " <> tshow e

    getCaptchaContent :: String -> IO MsgContent
    getCaptchaContent s = case captchaGenerator opts of
      Nothing -> pure $ MCText $ T.pack s
      Just script -> content <$> readProcess script [s] ""
      where
        content r = case T.lines $ T.pack r of
          [] -> textMsg
          "" : _ -> textMsg
          img : _ -> MCImage "" $ ImageData img
        textMsg = MCText $ T.pack s

    canSendVoiceCaptcha :: GroupInfo -> GroupMember -> Bool
    canSendVoiceCaptcha gInfo m =
      isJust (voiceCaptchaGenerator opts)
        && (groupFeatureUserAllowed SGFVoice gInfo || supportsVersion m memberSupportVoiceVersion)

    approvePendingMember :: DirectoryMemberAcceptance -> GroupInfo -> GroupMember -> IO ()
    approvePendingMember a g@GroupInfo {groupId} m@GroupMember {memberProfile = LocalProfile {displayName, image}} = do
      gli_ <- join . eitherToMaybe <$> withDB' "getGroupLinkInfo" 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
        Right CRMemberAccepted {member} -> do
          atomically $ TM.delete gmId $ pendingCaptchas env
          if memberStatus member == GSMemPendingReview
            then logInfo $ "Member " <> viewName displayName <> " accepted and pending review, group " <> tshow groupId <> ":" <> viewGroupName g
            else 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
          let gmId = groupMemberId' m
              sendRef = SRGroup groupId (Just $ GCSMemberSupport (Just gmId)) False
              -- /audio is matched as text, not as DirectoryCmd, because it is only valid
              -- in group context at captcha stage, while DirectoryCmd is for DM commands.
              isAudioCmd = T.strip msgText == "/audio"
              cmd = fromRight (ADC SDRUser DCUnknownCommand) $ A.parseOnly (directoryCmdP Nothing <* A.endOfInput) $ T.strip msgText
          atomically (TM.lookup gmId $ pendingCaptchas env) >>= \case
            Nothing
              | isAudioCmd && canSendVoiceCaptcha g m -> sendMemberCaptcha g m (Just ciId) noCaptcha 0 CMAudio
              | isAudioCmd -> sendComposedMessages_ cc sendRef [(Just ciId, MCText voiceCaptchaUnavailable)]
              | otherwise -> sendMemberCaptcha g m (Just ciId) noCaptcha 0 CMText
            Just pc@PendingCaptcha {captchaText, sentAt, attempts, captchaMode}
              | isAudioCmd ->
                  if canSendVoiceCaptcha g m
                    then case captchaMode of
                      CMText -> do
                        atomically $ TM.insert gmId pc {captchaMode = CMAudio} $ pendingCaptchas env
                        sendVoiceCaptcha sendRef (T.unpack captchaText)
                      CMAudio ->
                        sendComposedMessages_ cc sendRef [(Just ciId, MCText audioAlreadyEnabled)]
                    else sendComposedMessages_ cc sendRef [(Just ciId, MCText voiceCaptchaUnavailable)]
              | otherwise -> case cmd of
                  ADC SDRUser (DCSearchGroup {}) -> do
                    ts <- getCurrentTime
                    if
                      | ts `diffUTCTime` sentAt > captchaTTL -> sendMemberCaptcha g m (Just ciId) captchaExpired (attempts - 1) captchaMode
                      | matchCaptchaStr captchaText msgText -> do
                          sendComposedMessages_ cc sendRef [(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 captchaMode
                  _ -> sendComposedMessages_ cc sendRef [(Just ciId, MCText unknownCommand)]
      | otherwise = approvePendingMember a g m
      where
        a = groupMemberAcceptance g
        rejectPendingMember rjctNotice = do
          let gmId = groupMemberId' m
          sendComposedMessages cc (SRGroup groupId (Just $ GCSMemberSupport (Just gmId)) False) [MCText rjctNotice]
          sendChatCmd cc (APIRemoveMembers groupId [gmId] False) >>= \case
            Right (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 :: Text
        captchaExpired = "Captcha expired, please try again."
        wrongCaptcha :: Int -> Text
        wrongCaptcha attempts
          | attempts == maxCaptchaAttempts - 1 = "Incorrect text, please try again - this is your last attempt."
          | otherwise = "Incorrect text, please try again."
        noCaptcha :: Text
        noCaptcha = "Unexpected message, please try again."
        audioAlreadyEnabled :: Text
        audioAlreadyEnabled = "Audio captcha is already enabled."
        voiceCaptchaUnavailable :: Text
        voiceCaptchaUnavailable = "Voice captcha is not available - please update SimpleX Chat to v6.5+ or use text captcha."
        unknownCommand :: Text
        unknownCommand = "Unknown command, please enter captcha text."
        tooManyAttempts :: Text
        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 {groupId, groupProfile = p@GroupProfile {displayName, image = image', publicGroup = pg_}, groupSummary} GroupReg {dbContactId, promoted} gaId = do
      ct_ <- getContact' cc user dbContactId
      let gt = maybe "group" groupTypeStr' pg_
          membersStr = "_" <> membersCountStr p groupSummary <> "_\n"
          text =
            either (\_ -> "The " <> gt <> " ID " <> tshow groupId <> " submitted: ") (\c -> localDisplayName' c <> " submitted the " <> gt <> " ID " <> tshow groupId <> ": ") ct_
              <> ("\n" <> groupInfoText p <> "\n" <> membersStr <> "\nTo approve send:")
          msg = maybe (MCText text) (\image -> MCImage {text, image}) image'
      withAdminUsers $ \cId -> do
        let approveCmd = MCText $ "/approve " <> tshow groupId <> ":" <> viewName displayName <> " " <> tshow gaId <> if promoted then " promote=on" else ""
        sendComposedMessages cc (SRDirect cId) [msg, approveCmd]

    deGroupLinkCheck :: GroupInfo -> IO ()
    deGroupLinkCheck gInfo@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup = pg_}, groupSummary = summary} =
      withGroupReg gInfo "link check" $ \gr@GroupReg {groupRegStatus, dbOwnerMemberId} ->
        forM_ pg_ $ \pg@PublicGroupProfile {groupLink} ->
          when (groupRegStatus == GRSActive || pendingApproval groupRegStatus) $ do
            let link = ACL SCMContact $ CLShort groupLink
            sendChatCmd cc (APIConnectPlan userId (Just link) True Nothing) >>= \case
              Right (CRConnectionPlan _ _ (CPGroupLink (GLPKnown {groupInfo = g', groupUpdated = BoolDef updated, linkOwners = ListDef owners}))) ->
                checkValidOwner dbOwnerMemberId owners $ do
                  when updated $ reapprove pg gr groupRegStatus g'
                  when (updated || summary /= groupSummary g') $ listingsUpdated env
              Left (ChatErrorAgent {agentError = SMP _ err}) | linkDeleted err ->
                setGroupStatus logError st env cc groupId GRSRemoved $ \gr' ->
                  notifyOwner gr' "The channel link is no longer valid.\nThe channel is removed from the directory."
              _ -> pure ()
      where
        linkDeleted = \case
          AUTH -> True
          BLOCKED {} -> True
          _ -> False
        checkValidOwner dbOwnerMemberId owners onValid = case dbOwnerMemberId of
          Just ownerGMId ->
            withDB "checkGroupLink" cc (\db -> withExceptT show $ getGroupMember db (vr cc) user groupId ownerGMId) >>= \case
              Right GroupMember {memberId, memberPubKey}
                | any (\GroupLinkOwner {memberId = mId, memberKey} -> memberId == mId && memberPubKey == Just memberKey) owners -> onValid
              _ -> setGroupStatus logError st env cc groupId GRSSuspendedBadRoles $ \gr' ->
                notifyOwner gr' "The registration owner is no longer a channel owner.\nThe channel is no longer listed in the directory."
          Nothing -> onValid
        reapprove pg gr groupRegStatus g' = do
          let gt = groupTypeStr' pg
              groupRef = groupReference gInfo
          notifyAdminUsers $ "The " <> gt <> " " <> groupRef <> " profile changed."
          case groupRegStatus of
            GRSActive ->
              setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval 1) $ \gr' -> do
                notifyOwner gr' $ "The " <> gt <> " profile has changed.\nIt is hidden from the directory until approved."
                sendToApprove g' gr' 1
            GRSPendingApproval n ->
              sendToApprove g' gr (n + 1)
            _ -> pure ()

    deContactRoleChanged :: GroupInfo -> ContactId -> GroupMemberRole -> IO ()
    deContactRoleChanged g@GroupInfo {groupId, membership = GroupMember {memberRole = serviceRole}} ctId contactRole = do
      logInfo $ "contact ID " <> tshow ctId <> " role changed in group " <> viewGroupName g <> " to " <> tshow contactRole
      withGroupReg g "contact role changed" $ \gr@GroupReg {groupRegStatus} -> do
        let userGroupRef = userGroupReference gr g
            uCtRole = "Your role in the group " <> userGroupRef <> " is changed to " <> ctRole
        when (ctId `isOwner` gr) $
          case groupRegStatus of
            GRSSuspendedBadRoles | rStatus == GRSOk ->
              setGroupStatus notifyAdminUsers st env cc groupId GRSActive $ \gr' -> do
                notifyOwner gr' $ uCtRole <> ".\n\nThe group is listed in the directory again."
                notifyAdminUsers $ "The group " <> groupRef <> " is listed " <> suCtRole
            GRSPendingApproval gaId | rStatus == GRSOk -> do
              sendToApprove g gr gaId
              notifyOwner gr $ uCtRole <> ".\n\nThe group is submitted for approval."
            GRSActive | rStatus /= GRSOk ->
              setGroupStatus notifyAdminUsers st env cc groupId GRSSuspendedBadRoles $ \gr' -> do
                notifyOwner gr' $ uCtRole <> ".\n\nThe group is no longer listed in the directory."
                notifyAdminUsers $ "The group " <> groupRef <> " is de-listed " <> suCtRole
            _ -> pure ()
      where
        rStatus = groupRolesStatus contactRole serviceRole
        groupRef = groupReference g
        ctRole = "*" <> textEncode contactRole <> "*"
        suCtRole = "(user role is set to " <> ctRole <> ")."

    deServiceRoleChanged :: GroupInfo -> GroupMemberRole -> IO ()
    deServiceRoleChanged g@GroupInfo {groupId} serviceRole = do
      logInfo $ "service role changed in group " <> viewGroupName g <> " to " <> tshow serviceRole
      withGroupReg g "service role changed" $ \gr@GroupReg {groupRegStatus} -> do
        let userGroupRef = userGroupReference gr g
            uSrvRole = serviceName <> " role in the group " <> userGroupRef <> " is changed to " <> srvRole
        case groupRegStatus of
          GRSSuspendedBadRoles | serviceRole == GRAdmin ->
            whenContactIsOwner gr $
              setGroupStatus notifyAdminUsers st env cc groupId GRSActive $ \gr' -> do
                notifyOwner gr' $ uSrvRole <> ".\n\nThe group is listed in the directory again."
                notifyAdminUsers $ "The group " <> groupRef <> " is listed " <> suSrvRole
          GRSPendingApproval gaId | serviceRole == GRAdmin ->
            whenContactIsOwner gr $ do
              sendToApprove g gr gaId
              notifyOwner gr $ uSrvRole <> ".\n\nThe group is submitted for approval."
          GRSActive | serviceRole /= GRAdmin ->
            setGroupStatus notifyAdminUsers st env cc groupId GRSSuspendedBadRoles $ \gr' -> do
              notifyOwner gr' $ uSrvRole <> ".\n\nThe group is no longer listed in the directory."
              notifyAdminUsers $ "The group " <> groupRef <> " is de-listed " <> suSrvRole
          _ -> pure ()
      where
        groupRef = groupReference g
        srvRole = "*" <> textEncode serviceRole <> "*"
        suSrvRole = "(" <> serviceName <> " role is changed to " <> srvRole <> ")."
        whenContactIsOwner gr action =
          getOwnerGroupMember groupId gr
            >>= mapM_ (\cm@GroupMember {memberRole} -> when (memberRole == GROwner && memberActive cm) action)

    deContactRemovedFromGroup :: ContactId -> GroupInfo -> IO ()
    deContactRemovedFromGroup ctId g@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup = pg_}} = do
      let gt = maybe "group" groupTypeStr' pg_
      logInfo $ "contact ID " <> tshow ctId <> " removed from group " <> viewGroupName g
      withGroupReg g "contact removed" $ \gr ->
        when (ctId `isOwner` gr) $
          setGroupStatus notifyAdminUsers st env cc groupId GRSRemoved $ \gr' -> do
            notifyOwner gr' $ "You are removed from the " <> gt <> " " <> userGroupReference gr' g <> ".\n\nThe " <> gt <> " is no longer listed in the directory."
            notifyAdminUsers $ "The " <> gt <> " " <> groupReference g <> " is de-listed (" <> gt <> " owner is removed)."
            when (isJust pg_) $ leavePublicGroup g

    deContactLeftGroup :: ContactId -> GroupInfo -> IO ()
    deContactLeftGroup ctId g@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup = pg_}} = do
      let gt = maybe "group" groupTypeStr' pg_
      logInfo $ "contact ID " <> tshow ctId <> " left group " <> viewGroupName g
      withGroupReg g "contact left" $ \gr ->
        when (ctId `isOwner` gr) $
          setGroupStatus notifyAdminUsers st env cc groupId GRSRemoved $ \gr' -> do
            notifyOwner gr' $ "You left the " <> gt <> " " <> userGroupReference gr' g <> ".\n\nThe " <> gt <> " is no longer listed in the directory."
            notifyAdminUsers $ "The " <> gt <> " " <> groupReference g <> " is de-listed (" <> gt <> " owner left)."
            when (isJust pg_) $ leavePublicGroup g

    deServiceRemovedFromGroup :: GroupInfo -> IO ()
    deServiceRemovedFromGroup g@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup = pg_}} = do
      let gt = maybe "group" groupTypeStr' pg_
      logInfo $ "service removed from group " <> viewGroupName g
      setGroupStatus notifyAdminUsers st env cc groupId GRSRemoved $ \gr -> do
        notifyOwner gr $ serviceName <> " is removed from the " <> gt <> " " <> userGroupReference gr g <> ".\n\nThe " <> gt <> " is no longer listed in the directory."
        notifyAdminUsers $ "The " <> gt <> " " <> groupReference g <> " is de-listed (directory service is removed)."

    deGroupDeleted :: GroupInfo -> IO ()
    deGroupDeleted g@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup = pg_}} = do
      let gt = maybe "group" groupTypeStr' pg_
      logInfo $ "group removed " <> viewGroupName g
      setGroupStatus notifyAdminUsers st env cc groupId GRSRemoved $ \gr -> do
        notifyOwner gr $ "The " <> gt <> " " <> userGroupReference gr g <> " is deleted.\n\nThe " <> gt <> " is no longer listed in the directory."
        notifyAdminUsers $ "The " <> gt <> " " <> groupReference g <> " is de-listed (" <> gt <> " is deleted)."

    deChatLinkReceived :: Contact -> MsgChatLink -> Maybe LinkOwnerSig -> IO ()
    deChatLinkReceived ct (MCLGroup {connLink, groupProfile = GroupProfile {publicGroup = Just PublicGroupProfile {groupType}}}) (Just ownerSig@LinkOwnerSig {ownerId = Just (B64UrlByteString oIdBytes)}) =
      case groupType of
        GTUnknown tag -> sendMessage cc ct $ "Unsupported group type: " <> T.pack (show tag)
        gt -> do
          let link = ACL SCMContact $ CLShort connLink
              mId = MemberId oIdBytes
              gt' = groupTypeStr gt
          sendChatCmd cc (APIConnectPlan userId (Just link) True (Just ownerSig)) >>= \case
            Right (CRConnectionPlan _ (ACCL SCMContact ccLink) plan) ->
              handleGroupLinkPlan ct ccLink mId ownerSig gt' plan
            _ -> sendMessage cc ct "Error: could not connect. Please report it to directory admins."
    deChatLinkReceived ct (MCLGroup {groupProfile = GroupProfile {publicGroup = Just pg}}) _ =
      sendMessage cc ct $ "To add a " <> groupTypeStr' pg <> " to directory you must be the owner."
    deChatLinkReceived ct _ _ =
      sendMessage cc ct "Only channels can be added to directory via link."

    groupTypeStr :: GroupType -> Text
    groupTypeStr = \case
      GTChannel -> "channel"
      GTGroup -> "group"
      GTUnknown _ -> "group"

    groupTypeStr' :: PublicGroupProfile -> Text
    groupTypeStr' PublicGroupProfile {groupType} = groupTypeStr groupType

    leavePublicGroup :: GroupInfo -> IO ()
    leavePublicGroup GroupInfo {groupId} =
      void $ sendChatCmd cc (APILeaveGroup groupId)

    handleGroupLinkPlan :: Contact -> CreatedLinkContact -> MemberId -> LinkOwnerSig -> Text -> ConnectionPlan -> IO ()
    handleGroupLinkPlan ct ccLink mId ownerSig gt = \case
      CPGroupLink glp -> case glp of
        GLPOk {groupSLinkData_, ownerVerification} -> case (groupSLinkData_, ownerVerification) of
          (Just groupSLinkData, Just OVVerified) -> joinAndRegisterPublicGroup ct ccLink mId gt groupSLinkData
          (_, Just (OVFailed reason)) -> sendMessage cc ct $ "Link signature verification failed: " <> reason <> ".\nYou must be the " <> gt <> " owner to register it."
          (Nothing, _) -> sendMessage cc ct $ "Error: no " <> gt <> " information available via the link."
          _ -> sendMessage cc ct $ "Error: could not verify " <> gt <> " ownership. Please report it to directory admins."
        GLPKnown {groupInfo = g, groupUpdated = BoolDef updated, ownerVerification} -> case ownerVerification of
          Just OVVerified -> deReregistration ct g updated ownerSig
          Just (OVFailed reason) -> sendMessage cc ct $ "Link signature verification failed: " <> reason <> ".\nYou must be the " <> gt <> " owner to register it."
          Nothing -> sendMessage cc ct $ "Error: could not verify " <> gt <> " ownership."
        GLPConnectingProhibit _ -> sendMessage cc ct $ "Already connecting to this " <> gt <> "."
        GLPConnectingConfirmReconnect -> sendMessage cc ct $ "Already connecting to this " <> gt <> "."
        GLPNoRelays _ -> sendMessage cc ct $ T.toTitle gt <> " has no active relays. Please try again later."
        GLPOwnLink _ -> sendMessage cc ct "Unexpected error. Please report it to directory admins."
      _ -> sendMessage cc ct "Unexpected error. Please report it to directory admins."

    joinAndRegisterPublicGroup :: Contact -> CreatedLinkContact -> MemberId -> Text -> GroupShortLinkData -> IO ()
    joinAndRegisterPublicGroup ct ccLink mId gt groupSLinkData = do
      let GroupShortLinkData {groupProfile = GroupProfile {displayName}} = groupSLinkData
          ownerContact = GroupOwnerContact {contactId = contactId' ct, memberId = mId}
      sendMessage cc ct $ "Joining the " <> gt <> " " <> displayName <> "…"
      sendChatCmd cc (APIPrepareGroup userId ccLink False groupSLinkData) >>= \case
        Right (CRNewPreparedChat _ (AChat SCTGroup (Chat (GroupChat gInfo _) _ _))) -> do
          let gId = groupId' gInfo
          addGroupReg notifyAdminUsers st cc ct gInfo GRSProposed $ \_ -> pure ()
          sendChatCmd cc (APIConnectPreparedGroup gId False (Just ownerContact) Nothing) >>= \case
            Right CRStartedConnectionToGroup {groupInfo = gInfo'} ->
              withDB "getGroupMember" cc (\db -> withExceptT show $ getGroupMemberByMemberId db (vr cc) user gInfo' mId) >>= \case
                Right ownerMember ->
                  void $ setGroupRegOwner cc gId ownerMember
                Left e -> do
                  logError $ "could not find owner member: " <> T.pack e
                  sendMessage cc ct "Error: could not find owner member after joining. Please report it to directory admins."
            _ -> sendMessage cc ct $ "Error joining " <> gt <> " " <> displayName <> ", please re-send the link!"
        _ -> sendMessage cc ct $ "Error joining " <> gt <> " " <> displayName <> ", please re-send the link!"

    deReregistration :: Contact -> GroupInfo -> Bool -> LinkOwnerSig -> IO ()
    deReregistration ct g@GroupInfo {groupId, groupProfile = GroupProfile {publicGroup = pg_}} profileChanged LinkOwnerSig {ownerId = Just (B64UrlByteString oIdBytes)} = do
      let mId = MemberId oIdBytes
          gt = maybe "group" groupTypeStr' pg_
      withDB "getGroupMemberByMemberId" cc (\db -> withExceptT show $ getGroupMemberByMemberId db (vr cc) user g mId) >>= \case
        Right ownerMember@GroupMember {memberRole = role, memberStatus} ->
          if
            | role >= GROwner && memberStatus /= GSMemUnknown ->
                getGroupReg cc groupId >>= \case
                  Right gr
                    | contactId' ct `isOwner` gr -> sameOwnerReregistration gr gt
                    | otherwise -> sendMessage cc ct $ "This " <> gt <> " is registered by another owner."
                  Left _ ->
                    addGroupReg notifyAdminUsers st cc ct g (GRSPendingApproval 1) $ \gr -> do
                      void $ setGroupRegOwner cc groupId ownerMember
                      sendToApprove g gr 1
            | role < GROwner -> sendMessage cc ct $ "You must be the " <> gt <> " owner to register it."
            | otherwise -> sendMessage cc ct $ "Waiting for the owner member to be connected to the " <> gt <> "."
        Left _ -> sendMessage cc ct $ "Error: could not verify " <> gt <> " ownership. Please report it to directory admins."
      where
        sameOwnerReregistration gr gt = case groupRegStatus gr of
          GRSProposed -> sendMessage cc ct $ "Registration is in progress, waiting for the owner member to be connected to the " <> gt <> "."
          GRSPendingConfirmation -> pendingApprovalTransition gr gt 1
          GRSPendingUpdate -> pendingApprovalTransition gr gt 1
          GRSPendingApproval n
            | profileChanged -> pendingApprovalTransition gr gt $ n + 1
            | otherwise -> sendMessage cc ct $ T.toTitle gt <> " is already pending approval."
          GRSActive
            | profileChanged -> pendingApprovalTransition gr gt 1
            | otherwise -> sendMessage cc ct $ T.toTitle gt <> " is already listed in the directory."
          GRSSuspended -> sendMessage cc ct $ T.toTitle gt <> " is suspended by admin. Please contact support."
          GRSSuspendedBadRoles -> pendingApprovalTransition gr gt 1
          GRSRemoved -> pendingApprovalTransition gr gt 1
        pendingApprovalTransition gr gt n = do
          let userGroupRef = userGroupReference gr g
          setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval n) $ \gr' -> do
            notifyOwner gr' $
              "The " <> gt <> " " <> userGroupRef <> " is submitted for approval.\nIt is hidden from the directory until approved."
            sendToApprove g gr' n
    deReregistration ct _ _ _ =
      sendMessage cc ct "Error: could not verify ownership. Please report it to directory admins."

    deMemberUpdated :: GroupInfo -> GroupMember -> GroupMember -> IO ()
    deMemberUpdated g@GroupInfo {groupId, groupProfile = GroupProfile {displayName, publicGroup}} fromMember toMember =
      withGroupReg g "owner member announced" $ \gr@GroupReg {groupRegStatus, dbOwnerMemberId} ->
        when (groupRegStatus == GRSProposed && (dbOwnerMemberId == Just (groupMemberId' fromMember) || dbOwnerMemberId == Just (groupMemberId' toMember))) $
          let GroupMember {memberRole = role} = toMember
              gt = maybe "group" groupTypeStr' publicGroup
           in if role >= GROwner
                then setGroupStatus notifyAdminUsers st env cc groupId (GRSPendingApproval 1) $ \gr' -> do
                  notifyOwner gr' $ "Joined the " <> gt <> " " <> displayName <> ". Registration is pending approval — it may take up to 48 hours."
                  sendToApprove g gr' 1
                else do
                  setGroupStatus notifyAdminUsers st env cc groupId GRSRemoved $ \_ -> pure ()
                  sendMessage' cc (dbContactId gr) "The signing key does not belong to a current owner. Registration cancelled."

    deUserCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRUser -> IO ()
    deUserCommand ct ciId = \case
      DCHelp DHSRegistration ->
        sendMessage cc ct $
          "You must be the group or channel owner to add it to the directory.\n\n\
          \*To register a channel*, use _Share via chat_ to send its link to "
            <> serviceName
            <> " bot.\n\n\
               \*To register a group*:\n\
               \1️⃣ *Invite* "
            <> serviceName
            <> " bot to your group as *admin* - it will create a link for new members to join.\n\
               \2️⃣ *Add* this link to the group's welcome message.\n\n\
               \Once your group or channel *approved*, it can be found here or at [simplex.chat/directory](https://simplex.chat/directory).\n\n\
               \_We usually review within a day, except holidays_. [More details](https://simplex.chat/docs/directory.html#adding-groups-to-the-directory)."
      DCHelp DHSCommands ->
        sendMessage cc ct $
          "/'help commands' - receive this help message.\n\
          \/help - how to register your group or channel to be added to directory.\n\
          \/list - list the groups you registered.\n\
          \`/role <ID>` - view and set default member role for your group.\n\
          \`/filter <ID>` - view and set spam filter settings for group.\n\
          \`/link <ID>` - view and upgrade group link.\n\
          \`/delete <ID>:<NAME>` - remove the group you submitted from directory, with _ID_ and _name_ as shown by /list command.\n\n\
          \To search for groups, send the search text."
      DCSearchGroup s ft ->
        sendFoundListedGroups (STSearch s) Nothing notFound $ \gs n ->
          let more = if n > length gs then ", sending top " <> tshow (length gs) else ""
           in "Found " <> tshow n <> " group(s)" <> more <> "."
        where
          notFound
            | hasSimplexGroupLink ft = "No groups found.\nTo register a group or a channel, please use \"Share via chat\" feature."
            | otherwise = "No groups found"
          hasSimplexGroupLink = \case
            Just fts -> any isGroupLink fts
            Nothing -> False
          isGroupLink (FormattedText (Just SimplexLink {linkType}) _) = linkType == XLGroup || linkType == XLChannel
          isGroupLink _ = False
      DCSearchNext ->
        atomically (TM.lookup (contactId' ct) searchRequests) >>= \case
          Just SearchRequest {searchType, searchTime, lastGroup} -> do
            currentTime <- getCurrentTime
            if diffUTCTime currentTime searchTime > 300 -- 5 minutes
              then do
                atomically $ TM.delete (contactId' ct) searchRequests
                showAllGroups
              else
                sendFoundListedGroups searchType (Just lastGroup) "No more groups" $ \gs _ ->
                  "Sending " <> tshow (length gs) <> " more group(s)."
          Nothing -> showAllGroups
        where
          showAllGroups = deUserCommand ct ciId DCAllGroups
      DCAllGroups -> sendFoundListedGroups STAll Nothing "No groups listed" $ allGroupsReply "top"
      DCRecentGroups -> sendFoundListedGroups STRecent Nothing "No groups listed" $ allGroupsReply "the most recent"
      DCSubmitGroup _link -> pure ()
      DCConfirmDuplicateGroup ugrId gName ->
        withUserGroupReg ugrId gName $ \g@GroupInfo {groupProfile = GroupProfile {displayName}} gr@GroupReg {groupRegStatus} -> case groupRegStatus of
          GRSPendingConfirmation ->
            getDuplicateGroup g >>= \case
              Left e -> sendMessage cc ct $ "Error: getDuplicateGroup. Please notify the developers.\n" <> T.pack e
              Right DGReserved -> sendMessage cc ct $ groupAlreadyListed g
              _ -> processInvitation ct g $ Just gr
          _ -> sendReply $ "Error: the group ID " <> tshow ugrId <> " (" <> displayName <> ") is not pending confirmation."
      DCListUserGroups ->
        getUserGroupRegs cc user (contactId' ct) >>= \case
          Left e -> sendReply $ "Error reading groups: " <> T.pack e
          Right gs -> sendGroupsInfo ct ciId isAdmin (gs, length gs)
      DCDeleteGroup gId gName ->
        (if isAdmin then withGroupAndReg sendReply else withUserGroupReg) gId gName $ \g@GroupInfo {groupProfile = GroupProfile {displayName, publicGroup = pg_}} GroupReg {dbGroupId} -> do
          let gt = maybe "group" groupTypeStr' pg_
          delGroupReg cc dbGroupId >>= \case
            Right () -> do
              logGDelete st dbGroupId
              sendReply $ (if isAdmin then "The " <> gt <> " " else "Your " <> gt <> " ") <> displayName <> " is deleted from the directory"
              when (isJust pg_) $ leavePublicGroup g
            Left e -> sendReply $ "Error deleting " <> gt <> " " <> displayName <> ": " <> T.pack e
      DCMemberRole gId gName_ mRole_ ->
        (if isAdmin then withGroupAndReg_ sendReply else withUserGroupReg_) gId gName_ $ \g _gr ->
          ifPublicGroup g (sendReply "This command is not available for public groups.") $ do
          let GroupInfo {groupProfile = GroupProfile {displayName = n}} = g
          case mRole_ of
            Nothing ->
              getGroupLink' cc user g >>= \case
                Right GroupLink {connLinkContact = gLink, acceptMemberRole} -> do
                  let anotherRole = case acceptMemberRole of GRObserver -> GRMember; _ -> GRObserver
                  sendReply $
                    initialRole n acceptMemberRole
                      <> ("Send /'role " <> tshow gId <> " " <> textEncode anotherRole <> "' to change it.\n\n")
                      <> onlyViaLink gLink
                Left _ -> 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 *" <> textEncode mRole <> "*\n"
          onlyViaLink gLink = "*Please note*: it applies only to members joining via this link: " <> groupLinkText gLink
      DCGroupFilter gId gName_ acceptance_ ->
        (if isAdmin then withGroupAndReg_ sendReply else withUserGroupReg_) gId gName_ $ \g _gr ->
          ifPublicGroup g (sendReply "This command is not available for public groups.") $ 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' "setGroupCustomData" cc (\db -> setGroupCustomData db user g $ Just d) >>= \case
                Right () -> sendSettigns n a' " set to"
                Left e -> sendReply $ "Error changing spam filter settings for group " <> n <> ": " <> T.pack e
            _ -> 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."
                ]
                  <> ["/'filter " <> tshow gId <> " name' - enable name filter" | isNothing (rejectNames a)]
                  <> ["/'filter " <> tshow gId <> " captcha' - enable captcha challenge" | isNothing (passCaptcha a)]
                  <> ["/'filter " <> tshow gId <> " name captcha' - enable both" | isNothing (rejectNames a) || isNothing (passCaptcha a)]
                  <> ["/'filter " <> tshow gId <> " off' - disable filter" | isJust (rejectNames a) || isJust (passCaptcha a)]
          showCondition = \case
            Nothing -> "_disabled_"
            Just PCAll -> "_enabled_"
            Just PCNoImage -> "_enabled for profiles without image_"
      DCShowUpgradeGroupLink gId gName_ ->
        (if isAdmin then withGroupAndReg_ sendReply else withUserGroupReg_) gId gName_ $ \GroupInfo {groupId, groupProfile = GroupProfile {publicGroup = pg_}, localDisplayName = gName} _ -> case pg_ of
          Just pg@PublicGroupProfile {groupLink} ->
            sendReply $ "The link to join the " <> groupTypeStr' pg <> " " <> groupReference' gId gName <> ":\n" <> strEncodeTxt groupLink
          Nothing -> do
            let groupRef = groupReference' gId gName
            withGroupLinkResult groupRef (sendChatCmd cc $ APIGetGroupLink groupId) $
              \GroupLink {connLinkContact = gLink@(CCLink _ sLnk_), acceptMemberRole, shortLinkDataSet, shortLinkLargeDataSet = BoolDef slLargeDataSet} -> do
                let shouldBeUpgraded = isNothing sLnk_ || not shortLinkDataSet || not slLargeDataSet
                sendReply $
                  T.unlines $
                    [ "The link to join the group " <> groupRef <> ":",
                      groupLinkText gLink,
                      "New member role: " <> textEncode acceptMemberRole
                    ]
                      <> ["The link is being upgraded..." | shouldBeUpgraded]
                when shouldBeUpgraded $ do
                  let send = sendComposedMessage cc ct Nothing . MCText . T.unlines
                  withGroupLinkResult groupRef (sendChatCmd cc $ APIAddGroupShortLink groupId) $
                    \GroupLink {connLinkContact = CCLink _ sLnk_'} -> case (sLnk_, sLnk_') of
                      (Just _, Just _) ->
                        send ["The group link is upgraded for: " <> groupRef, "No changes to group needed."]
                      (Nothing, Just sLnk) ->
                        sendComposedMessages
                          cc
                          (SRDirect $ contactId' ct)
                          [ MCText $
                              T.unlines
                                [ "Please replace the old link in welcome message of your group " <> groupRef,
                                  "If this is the only change, the group will remain listed in directory without re-approval.",
                                  "",
                                  "The new link:"
                                ],
                            MCText $ strEncodeTxt sLnk
                          ]
                      (_, Nothing) ->
                        send ["The short link is not created for " <> groupRef, "Please report it to the developers."]
        where
          withGroupLinkResult groupRef a cb =
            a >>= \case
              Right CRGroupLink {groupLink} -> cb groupLink
              Left (ChatErrorStore (SEGroupLinkNotFound _)) ->
                sendReply $ "The group " <> groupRef <> " has no public link."
              Right r -> do
                ts <- getCurrentTime
                tz <- getCurrentTimeZone
                let resp = T.pack $ serializeChatResponse (Nothing, Just user) (config cc) ts tz Nothing r
                sendReply $ "Unexpected error:\n" <> resp
              Left e -> do
                let resp = T.pack $ serializeChatError True (config cc) e
                sendReply $ "Unexpected error:\n" <> resp
      DCUnknownCommand -> sendReply "Unknown command"
      DCCommandError tag -> sendReply $ "Command error: " <> tshow tag
      where
        knownCt = knownContact ct
        isAdmin = knownCt `elem` adminUsers || knownCt `elem` superUsers
        withUserGroupReg ugrId = withUserGroupReg_ ugrId . Just
        withUserGroupReg_ ugrId gName_ action =
          getUserGroupReg cc user (contactId' ct) ugrId >>= \case
            -- TODO differentiate group not found error
            Left e -> sendReply $ "Group ID " <> tshow ugrId <> " error:" <> T.pack e
            Right (g@GroupInfo {groupProfile = GroupProfile {displayName}}, gr)
              | maybe True (displayName ==) gName_ -> action g gr
              | otherwise -> sendReply $ "Group ID " <> tshow ugrId <> " has the display name " <> displayName
        sendReply = mkSendReply ct ciId
        sendFoundListedGroups searchType lastGroup_ notFound replyStr =
          searchListedGroups cc user searchType lastGroup_ searchResults >>= \case
            Right ([], _) -> do
              atomically $ TM.delete (contactId' ct) searchRequests
              sendReply notFound
            Right (gs, n) -> do
              let moreGroups = n - length gs
              updateSearchRequest searchType $ last gs
              sendFoundGroups (replyStr gs n) gs moreGroups
            Left e -> sendReply $ "Error: searchListedGroups. Please notify the developers.\n" <> T.pack e
        allGroupsReply sortName gs n =
          let more = if n > length gs then ", sending " <> sortName <> " " <> tshow (length gs) else ""
           in tshow n <> " group(s) listed" <> more <> "."
        updateSearchRequest :: SearchType -> (GroupInfo, GroupReg) -> IO ()
        updateSearchRequest searchType (GroupInfo {groupId}, _) = do
          searchTime <- getCurrentTime
          let search = SearchRequest {searchType, searchTime, lastGroup = groupId}
          atomically $ TM.insert (contactId' ct) search searchRequests
        sendFoundGroups reply gs moreGroups =
          void . forkIO $ sendComposedMessages_ cc (SRDirect $ contactId' ct) msgs
          where
            msgs = replyMsg :| map foundGroup gs <> [moreMsg | moreGroups > 0]
            replyMsg = (Just ciId, MCText reply)
            foundGroup (GroupInfo {groupId, groupProfile = p@GroupProfile {image = image_, memberAdmission}, groupSummary}, _) =
              let membersStr = "_" <> membersCountStr p groupSummary <> "_"
                  showId = if isAdmin then tshow groupId <> ". " else ""
                  text = T.unlines $ [showId <> groupInfoText p, membersStr] ++ knockingStr memberAdmission
               in (Nothing, maybe (MCText text) (\image -> MCImage {text, image}) image_)
            moreMsg = (Nothing, MCText $ "Send /next 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, promote} ->
            withGroupAndReg sendReply groupId n $ \g gr@GroupReg {userGroupRegId = ugrId, promoted} ->
              case groupRegStatus gr of
                GRSPendingApproval gaId
                  | gaId == groupApprovalId -> do
                      let GroupInfo {groupProfile = GroupProfile {publicGroup = pg_}} = g
                          isPublicGroup_ = isJust pg_
                          gt = maybe "group" groupTypeStr' pg_
                      getDuplicateGroup g >>= \case
                        Left e -> sendReply $ "Error: getDuplicateGroup. Please notify the developers.\n" <> T.pack e
                        Right DGReserved -> sendReply $ "The " <> gt <> " " <> groupRef <> " is already listed in the directory."
                        _ -> do
                          rolesOk <- if isPublicGroup_ then pure (Right GRSOk) else getGroupRolesStatus g gr
                          case rolesOk of
                            Right GRSOk -> do
                              let grPromoted'
                                    | promoted || knownCt `elem` superUsers = fromMaybe promoted promote
                                    | otherwise = False
                              setGroupStatusPromo sendReply st env cc gr GRSActive grPromoted' $ do
                                let approved = "The " <> gt <> " " <> userGroupReference' gr n <> " is approved"
                                let commands
                                      | isPublicGroup_ = ""
                                      | otherwise =
                                          "\n\nSupported commands:\n"
                                            <> ("/'filter " <> tshow ugrId <> "' - to configure anti-spam filter.\n")
                                            <> ("/'role " <> tshow ugrId <> "' - to set default member role.\n")
                                            <> ("/'link " <> tshow ugrId <> "' - to view/upgrade group link.")
                                notifyOwner gr $
                                  (approved <> " and listed in directory - please moderate it!\n")
                                    <> "_Please note_: if you change the " <> gt <> " profile it will be hidden from directory until it is re-approved."
                                    <> commands
                                invited <-
                                  forM ownersGroup $ \og@KnownGroup {localDisplayName = ogName} -> do
                                    inviteToOwnersGroup og gr $ \case
                                      Right () -> do
                                        owner <- groupOwnerInfo groupRef $ dbContactId gr
                                        pure $ "Invited " <> owner <> " to owners' group " <> viewName ogName
                                      Left err -> pure err
                                sendReply $ T.toTitle gt <> " approved" <> (if grPromoted' then " (promoted)" else "") <> "!" <> maybe "" ("\n" <>) invited
                                notifyOtherSuperUsers $ approved <> " by " <> viewName (localDisplayName' ct) <> maybe "" ("\n" <>) invited
                            Right GRSServiceNotAdmin -> replyNotApproved serviceNotAdmin
                            Right GRSContactNotOwner -> replyNotApproved "user is not an owner."
                            Right GRSBadRoles -> replyNotApproved $ "user is not an owner, " <> serviceNotAdmin
                            Left e -> sendReply $ "Error: getGroupRolesStatus. Please notify the developers.\n" <> T.pack e
                            where
                              replyNotApproved reason = sendReply $ "Group is not approved: " <> reason
                              serviceNotAdmin = serviceName <> " is not an admin."
                  | otherwise -> sendReply "Incorrect approval code"
                _ -> sendReply $ "Error: the group " <> groupRef <> " is not pending approval."
            where
              groupRef = groupReference' groupId n
          DCRejectGroup _gaId _gName -> pure ()
          DCSuspendGroup groupId gName -> do
            let groupRef = groupReference' groupId gName
            withGroupAndReg sendReply groupId gName $ \_ gr ->
              case groupRegStatus gr of
                GRSActive -> setGroupStatus sendReply st env cc groupId GRSSuspended $ \gr' -> do
                  let suspended = "The group " <> userGroupReference' gr gName <> " is suspended"
                  notifyOwner gr' $ suspended <> " and hidden from directory. Please contact the administrators."
                  sendReply "Group suspended!"
                  notifyOtherSuperUsers $ suspended <> " by " <> viewName (localDisplayName' ct)
                _ -> sendReply $ "The group " <> groupRef <> " is not active, can't be suspended."
          DCResumeGroup groupId gName -> do
            let groupRef = groupReference' groupId gName
            withGroupAndReg sendReply groupId gName $ \_ gr ->
              case groupRegStatus gr of
                GRSSuspended -> setGroupStatus sendReply st env cc groupId GRSActive $ \gr' -> do
                  let groupStr = "The group " <> userGroupReference' gr gName
                  notifyOwner gr' $ groupStr <> " is listed in the directory again!"
                  sendReply "Group listing resumed!"
                  notifyOtherSuperUsers $ groupStr <> " listing resumed by " <> viewName (localDisplayName' ct)
                _ -> sendReply $ "The group " <> groupRef <> " is not suspended, can't be resumed."
          DCListLastGroups count ->
            listLastGroups cc user count >>= \case
              Left e -> sendReply $ "Error reading groups: " <> T.pack e
              Right gs -> sendGroupsInfo ct ciId True $ first reverse gs
          DCListPendingGroups count ->
            listPendingGroups cc user count >>= \case
              Left e -> sendReply $ "Error reading groups: " <> T.pack e
              Right gs -> sendGroupsInfo ct ciId True $ first reverse gs
          DCSendToGroupOwner groupId gName msg -> do
            let groupRef = groupReference' groupId gName
            withGroupAndReg sendReply groupId gName $ \_ gr@GroupReg {dbContactId = ctId} -> do
              notifyOwner gr msg
              owner <- groupOwnerInfo groupRef ctId
              sendReply $ "Forwarded to " <> owner
          DCInviteOwnerToGroup groupId gName -> case ownersGroup of
            Just og@KnownGroup {localDisplayName = ogName} ->
              withGroupAndReg sendReply groupId gName $ \_ gr@GroupReg {dbContactId = ctId} -> do
                inviteToOwnersGroup og gr $ \case
                  Right () -> do
                    let groupRef = groupReference' groupId gName
                    owner <- groupOwnerInfo groupRef ctId
                    let invited = " invited " <> owner <> " to owners' group " <> viewName ogName
                    notifyOtherSuperUsers $ viewName (localDisplayName' ct) <> invited
                    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
        knownCt = knownContact ct
        sendReply = mkSendReply ct ciId
        notifyOtherSuperUsers s = withSuperUsers $ \ctId -> unless (ctId == contactId' ct) $ sendMessage' cc ctId s
        inviteToOwnersGroup :: KnownGroup -> GroupReg -> (Either Text () -> IO a) -> IO a
        inviteToOwnersGroup KnownGroup {groupId = ogId} GroupReg {dbContactId = ctId} cont =
          sendChatCmd cc (APIListMembers ogId) >>= \case
            Right (CRGroupMembers _ (Group _ ms))
              | alreadyMember ms -> cont $ Left "Owner is already a member of owners' group"
              | otherwise -> do
                  sendChatCmd cc (APIAddMember ogId ctId GRMember) >>= \case
                    Right CRSentGroupInvitation {} -> do
                      printLog cc CLLInfo $ "invited contact ID " <> show ctId <> " to owners' group"
                      cont $ Right ()
                    r -> contErr r
            r -> contErr r
          where
            alreadyMember = any (\m -> memberContactId m == Just ctId && memberCurrent m)
            contErr r = do
              let err = "error inviting contact ID " <> tshow ctId <> " to owners' group: " <> tshow r
              putStrLn $ T.unpack err
              cont $ Left err
        groupOwnerInfo groupRef dbContactId = do
          owner_ <- getContact' cc user dbContactId
          let ownerInfo = "the owner of the group " <> groupRef
              ownerName ct' = "@" <> viewName (localDisplayName' ct') <> ", "
          pure $ either (const "") ownerName owner_ <> ownerInfo

    deSuperUserCommand :: Contact -> ChatItemId -> DirectoryCmd 'DRSuperUser -> IO ()
    deSuperUserCommand ct ciId cmd
      | knownContact ct `elem` superUsers = case cmd of
          DCPromoteGroup groupId gName promote' ->
            withGroupAndReg sendReply groupId gName $ \_ gr@GroupReg {groupRegStatus, promoted} -> do
              let notify = sendReply $ "Group promotion " <> (if promote' then "enabled" <> (if groupRegStatus == GRSActive then "." else ", but the group is not listed.") else "disabled.")
              if promote' /= promoted
                then setGroupPromoted sendReply st env cc gr promote' notify
                else notify
          DCExecuteCommand cmdStr ->
            sendChatCmdStr cc cmdStr >>= \case
              Right r -> do
                ts <- getCurrentTime
                tz <- getCurrentTimeZone
                sendReply $ T.pack $ serializeChatResponse (Nothing, Just user) (config cc) ts tz Nothing r
              Left e ->
                sendReply $ T.pack $ serializeChatError True (config cc) e
          DCCommandError tag -> sendReply $ "Command error: " <> tshow tag
      | otherwise = sendReply "You are not allowed to use this command"
      where
        sendReply = mkSendReply ct ciId

    knownContact :: Contact -> KnownContact
    knownContact ct = KnownContact {contactId = contactId' ct, localDisplayName = localDisplayName' ct}

    mkSendReply :: Contact -> ChatItemId -> Text -> IO ()
    mkSendReply ct ciId = sendComposedMessage cc ct (Just ciId) . MCText

    withGroupAndReg :: (Text -> IO ()) -> GroupId -> GroupName -> (GroupInfo -> GroupReg -> IO ()) -> IO ()
    withGroupAndReg sendReply gId = withGroupAndReg_ sendReply gId . Just

    withGroupAndReg_ :: (Text -> IO ()) -> GroupId -> Maybe GroupName -> (GroupInfo -> GroupReg -> IO ()) -> IO ()
    withGroupAndReg_ sendReply gId gName_ action =
      getGroupAndReg cc user gId >>= \case
        Left e -> sendReply $ "Group " <> tshow gId <> " error (getGroup): " <> T.pack e
        Right (g@GroupInfo {groupProfile = GroupProfile {displayName}}, gr)
          | maybe False (displayName ==) gName_ ->
              action g gr
          | otherwise ->
              sendReply $ "Group ID " <> tshow gId <> " has the display name " <> displayName

    getOwnersInfo :: [(GroupInfo, GroupReg)] -> IO [((GroupInfo, GroupReg), Maybe (Either String Contact))]
    getOwnersInfo gs =
      fmap (either (\e -> map (,Just (Left e)) gs) id) $ withDB' "getOwnersInfo" cc $ \db ->
        mapM (\g@(_, gr) -> fmap ((g,) . Just . first show) $ runExceptT $ getContact db (vr cc) user $ dbContactId gr) gs

    sendGroupsInfo :: Contact -> ChatItemId -> Bool -> ([(GroupInfo, GroupReg)], Int) -> IO ()
    sendGroupsInfo ct ciId isAdmin (gs, n) = do
      let more = if n > length gs then ", showing the last " <> tshow (length gs) else ""
          replyMsg = (Just ciId, MCText $ tshow n <> " registered group(s)" <> more)
      gs' <- if isAdmin then getOwnersInfo gs else pure $ map (,Nothing) gs
      sendComposedMessages_ cc (SRDirect $ contactId' ct) $ replyMsg :| map groupMessage gs'
      where
        groupMessage ((g, gr), ct_) =
          let GroupInfo {groupId, groupProfile = p@GroupProfile {image = image_, memberAdmission}, groupSummary} = g
              GroupReg {userGroupRegId, groupRegStatus} = gr
              useGroupId = if isAdmin then groupId else userGroupRegId
              statusStr = "Status: " <> groupRegStatusText groupRegStatus
              membersStr = "_" <> membersCountStr p groupSummary <> "_"
              cmds = "/'role " <> tshow useGroupId <> "', /'filter " <> tshow useGroupId <> "'"
              ownerStr = maybe "" (("Owner: " <>) . either (("getContact error: " <>) . T.pack) localDisplayName') ct_
              text = T.unlines $ [tshow useGroupId <> ". " <> groupInfoText p] ++ [ownerStr | isAdmin] ++ [membersStr, statusStr] ++ knockingStr memberAdmission ++ [cmds]
              msg = maybe (MCText text) (\image -> MCImage {text, image}) image_
           in (Nothing, msg)

setGroupStatusPromo :: (Text -> IO ()) -> DirectoryLog -> ServiceState -> ChatController -> GroupReg -> GroupRegStatus -> Bool -> IO () -> IO ()
setGroupStatusPromo sendReply st env cc GroupReg {dbGroupId = gId} grStatus' grPromoted' continue = do
  let status' = grDirectoryStatus grStatus'
  setGroupStatusPromoStore cc gId grStatus' grPromoted' >>= \case
    Left e -> sendReply $ "Error updating group " <> tshow gId <> " status: " <> T.pack e
    Right (status, grPromoted) -> do
      when ((status == DSListed || status' == DSListed) && (status /= status' || grPromoted /= grPromoted')) $
        listingsUpdated env
      logGUpdateStatus st gId grStatus'
      logGUpdatePromotion st gId grPromoted'
      continue

addGroupReg :: (Text -> IO ()) -> DirectoryLog -> ChatController -> Contact -> GroupInfo -> GroupRegStatus -> (GroupReg -> IO ()) -> IO ()
addGroupReg sendMsg st cc ct g@GroupInfo {groupId} grStatus continue =
  addGroupRegStore cc ct g grStatus >>= \case
    Left e -> sendMsg $ "Error creating group registation for group " <> tshow groupId <> ": " <> T.pack e
    Right gr -> do
      logGCreate st gr
      continue gr

setGroupStatus :: (Text -> IO ()) -> DirectoryLog -> ServiceState -> ChatController -> GroupId -> GroupRegStatus -> (GroupReg -> IO ()) -> IO ()
setGroupStatus sendMsg st env cc gId grStatus' continue = do
  let status' = grDirectoryStatus grStatus'
  setGroupStatusStore cc gId grStatus' >>= \case
    Left e -> sendMsg $ "Error updating group " <> tshow gId <> " status: " <> T.pack e
    Right (grStatus, gr) -> do
      let status = grDirectoryStatus grStatus
      when ((status == DSListed || status' == DSListed) && status /= status') $ listingsUpdated env
      logGUpdateStatus st gId grStatus'
      continue gr

setGroupPromoted :: (Text -> IO ()) -> DirectoryLog -> ServiceState -> ChatController -> GroupReg -> Bool -> IO () -> IO ()
setGroupPromoted sendReply st env cc GroupReg {dbGroupId = gId} grPromoted' continue =
  setGroupPromotedStore cc gId grPromoted' >>= \case
    Left e -> sendReply $ "Error updating group " <> tshow gId <> " status: " <> T.pack e
    Right (status, grPromoted) -> do
      when (status == DSListed && grPromoted' /= grPromoted) $ listingsUpdated env
      logGUpdatePromotion st gId grPromoted'
      continue

updateGroupListingFiles :: ChatController -> User -> FilePath -> IO ()
updateGroupListingFiles cc u dir =
  getAllListedGroups cc u >>= \case
    Right gs -> generateListing dir gs
    Left e -> logError $ "generateListing error: failed to read groups: " <> T.pack e

getContact' :: ChatController -> User -> ContactId -> IO (Either String Contact)
getContact' cc user ctId = withDB "getContact" cc $ \db ->  withExceptT show $ getContact db (vr cc) user ctId

getGroupLink' :: ChatController -> User -> GroupInfo -> IO (Either String GroupLink)
getGroupLink' cc user gInfo =
  withDB "getGroupLink" cc $ \db -> withExceptT groupDBError $ getGroupLink db user gInfo

setGroupLinkRole :: ChatController -> GroupInfo -> GroupMemberRole -> IO (Maybe CreatedLinkContact)
setGroupLinkRole cc GroupInfo {groupId} mRole = resp <$> sendChatCmd cc (APIGroupLinkMemberRole groupId mRole)
  where
    resp = \case
      Right (CRGroupLink {groupLink = GroupLink {connLinkContact}}) -> Just connLinkContact
      _ -> Nothing

unexpectedError :: Text -> Text
unexpectedError err = "Unexpected error: " <> err <> ", please notify the developers."

strEncodeTxt :: StrEncoding a => a -> Text
strEncodeTxt = safeDecodeUtf8 . strEncode
