mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
SimpleX Directory Service (#2766)
* SimpleX Directory Service * more events * update events * fix * Apply suggestions from code review metavar Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> * metavar 2 Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> * process events * remove command serialization * update * update * process group profile update * basic group registration flow * search works * better messages * improve messages * test broadcast bot * test for directory service * better processing of group profile change, test * refactor * de-list group when owner or service is removed from the group, tests * fix: removing any member or any member leaving should not delist the group * refactor * more tests, fixes * disable bot tests in CI * remove comment --------- Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
f0d64a30e9
commit
2b69103055
@@ -0,0 +1,71 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Broadcast.Bot where
|
||||
|
||||
import Control.Concurrent (forkIO)
|
||||
import Control.Concurrent.Async
|
||||
import Control.Concurrent.STM
|
||||
import Control.Monad.Reader
|
||||
import qualified Data.Text as T
|
||||
import Broadcast.Options
|
||||
import Simplex.Chat.Bot
|
||||
import Simplex.Chat.Bot.KnownContacts
|
||||
import Simplex.Chat.Controller
|
||||
import Simplex.Chat.Core
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Messages.CIContent
|
||||
import Simplex.Chat.Options
|
||||
import Simplex.Chat.Protocol (MsgContent (..))
|
||||
import Simplex.Chat.Types
|
||||
import System.Directory (getAppUserDataDirectory)
|
||||
|
||||
welcomeGetOpts :: IO BroadcastBotOpts
|
||||
welcomeGetOpts = do
|
||||
appDir <- getAppUserDataDirectory "simplex"
|
||||
opts@BroadcastBotOpts {coreOptions = CoreChatOpts {dbFilePrefix}} <- getBroadcastBotOpts appDir "simplex_status_bot"
|
||||
putStrLn $ "SimpleX Chat Bot v" ++ versionNumber
|
||||
putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
|
||||
pure opts
|
||||
|
||||
broadcastBot :: BroadcastBotOpts -> User -> ChatController -> IO ()
|
||||
broadcastBot BroadcastBotOpts {publishers, welcomeMessage, prohibitedMessage} _user cc = do
|
||||
initializeBotAddress cc
|
||||
race_ (forever $ void getLine) . forever $ do
|
||||
(_, resp) <- atomically . readTBQueue $ outputQ cc
|
||||
case resp of
|
||||
CRContactConnected _ ct _ -> do
|
||||
contactConnected ct
|
||||
sendMessage cc ct welcomeMessage
|
||||
CRNewChatItem _ (AChatItem _ SMDRcv (DirectChat ct) ci@ChatItem {content = CIRcvMsgContent mc})
|
||||
| publisher `elem` publishers ->
|
||||
if allowContent mc
|
||||
then do
|
||||
sendChatCmd cc ListContacts >>= \case
|
||||
CRContactsList _ cts -> void . forkIO $ do
|
||||
let cts' = filter broadcastTo cts
|
||||
forM_ cts' $ \ct' -> sendComposedMessage cc ct' Nothing mc
|
||||
sendReply $ "Forwarded to " <> show (length cts') <> " contact(s)"
|
||||
r -> putStrLn $ "Error getting contacts list: " <> show r
|
||||
else sendReply "!1 Message is not supported!"
|
||||
| otherwise -> do
|
||||
sendReply prohibitedMessage
|
||||
deleteMessage cc ct $ chatItemId' ci
|
||||
where
|
||||
sendReply = sendComposedMessage cc ct (Just $ chatItemId' ci) . textMsgContent
|
||||
publisher = KnownContact {contactId = contactId' ct, localDisplayName = localDisplayName' ct}
|
||||
allowContent = \case
|
||||
MCText _ -> True
|
||||
MCLink {} -> True
|
||||
MCImage {} -> True
|
||||
_ -> False
|
||||
broadcastTo ct'@Contact {activeConn = conn@Connection {connStatus}} =
|
||||
(connStatus == ConnSndReady || connStatus == ConnReady)
|
||||
&& not (connDisabled conn)
|
||||
&& contactId' ct' /= contactId' ct
|
||||
_ -> pure ()
|
||||
where
|
||||
contactConnected ct = putStrLn $ T.unpack (localDisplayName' ct) <> " connected"
|
||||
@@ -0,0 +1,86 @@
|
||||
{-# LANGUAGE ApplicativeDo #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Broadcast.Options where
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Options.Applicative
|
||||
import Simplex.Chat.Bot.KnownContacts
|
||||
import Simplex.Chat.Controller (updateStr, versionNumber, versionString)
|
||||
import Simplex.Chat.Options (ChatOpts (..), CoreChatOpts, coreChatOptsP)
|
||||
|
||||
data BroadcastBotOpts = BroadcastBotOpts
|
||||
{ coreOptions :: CoreChatOpts,
|
||||
publishers :: [KnownContact],
|
||||
welcomeMessage :: String,
|
||||
prohibitedMessage :: String
|
||||
}
|
||||
|
||||
defaultWelcomeMessage :: [KnownContact] -> String
|
||||
defaultWelcomeMessage ps = "Hello! I am a broadcast bot.\nI broadcast messages to all connected users from " <> knownContactNames ps <> "."
|
||||
|
||||
defaultProhibitedMessage :: [KnownContact] -> String
|
||||
defaultProhibitedMessage ps = "Sorry, only these users can broadcast messages: " <> knownContactNames ps <> ". Your message is deleted."
|
||||
|
||||
broadcastBotOpts :: FilePath -> FilePath -> Parser BroadcastBotOpts
|
||||
broadcastBotOpts appDir defaultDbFileName = do
|
||||
coreOptions <- coreChatOptsP appDir defaultDbFileName
|
||||
publishers <-
|
||||
option
|
||||
parseKnownContacts
|
||||
( long "publishers"
|
||||
<> metavar "PUBLISHERS"
|
||||
<> help "Comma-separated list of publishers in the format CONTACT_ID:DISPLAY_NAME whose messages will be broadcasted"
|
||||
<> value []
|
||||
)
|
||||
welcomeMessage_ <-
|
||||
optional $
|
||||
strOption
|
||||
( long "welcome"
|
||||
<> metavar "WELCOME"
|
||||
<> help "Welcome message to be sent to all connecting users (default message will list allowed publishers)"
|
||||
)
|
||||
prohibitedMessage_ <-
|
||||
optional $
|
||||
strOption
|
||||
( long "prohibited"
|
||||
<> metavar "PROHIBITED"
|
||||
<> help "Reply to non-publishers who try to send messages (default reply will list allowed publishers)"
|
||||
<> showDefault
|
||||
)
|
||||
pure
|
||||
BroadcastBotOpts
|
||||
{ coreOptions,
|
||||
publishers,
|
||||
welcomeMessage = fromMaybe (defaultWelcomeMessage publishers) welcomeMessage_,
|
||||
prohibitedMessage = fromMaybe (defaultProhibitedMessage publishers) prohibitedMessage_
|
||||
}
|
||||
|
||||
getBroadcastBotOpts :: FilePath -> FilePath -> IO BroadcastBotOpts
|
||||
getBroadcastBotOpts appDir defaultDbFileName =
|
||||
execParser $
|
||||
info
|
||||
(helper <*> versionOption <*> broadcastBotOpts appDir defaultDbFileName)
|
||||
(header versionStr <> fullDesc <> progDesc "Start chat bot with DB_FILE file and use SERVER as SMP server")
|
||||
where
|
||||
versionStr = versionString versionNumber
|
||||
versionOption = infoOption versionAndUpdate (long "version" <> short 'v' <> help "Show version")
|
||||
versionAndUpdate = versionStr <> "\n" <> updateStr
|
||||
|
||||
mkChatOpts :: BroadcastBotOpts -> ChatOpts
|
||||
mkChatOpts BroadcastBotOpts {coreOptions} =
|
||||
ChatOpts
|
||||
{ coreOptions,
|
||||
chatCmd = "",
|
||||
chatCmdDelay = 3,
|
||||
chatServerPort = Nothing,
|
||||
optFilesFolder = Nothing,
|
||||
showReactions = False,
|
||||
allowInstantFiles = True,
|
||||
autoAcceptFileSize = 0,
|
||||
muteNotifications = True,
|
||||
maintenance = False
|
||||
}
|
||||
Reference in New Issue
Block a user