diff --git a/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs b/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs index 9dc927af9e..15f790e8b1 100644 --- a/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs +++ b/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs @@ -2,6 +2,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} module Broadcast.Bot where @@ -10,6 +11,7 @@ import Control.Concurrent (forkIO) import Control.Concurrent.Async import Control.Concurrent.STM import Control.Monad +import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.Text as T import Broadcast.Options import Simplex.Chat.Bot @@ -47,9 +49,10 @@ broadcastBot BroadcastBotOpts {publishers, welcomeMessage, prohibitedMessage} _u 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 " <> tshow (length cts') <> " contact(s)" + sendChatCmd cc (SendMessageBroadcast mc) >>= \case + CRBroadcastSent {successes, failures} -> + sendReply $ "Forwarded to " <> tshow successes <> " contact(s), " <> tshow failures <> " errors" + r -> putStrLn $ "Error broadcasting message: " <> show r r -> putStrLn $ "Error getting contacts list: " <> show r else sendReply "!1 Message is not supported!" | otherwise -> do diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index bd4d418158..043db9bfc9 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -472,7 +472,7 @@ data ChatCommand | SendMemberContactMessage GroupName ContactName Text | SendLiveMessage ChatName Text | SendMessageQuote {contactName :: ContactName, msgDir :: AMsgDirection, quotedMsg :: Text, message :: Text} - | SendMessageBroadcast Text -- UserId (not used in UI) + | SendMessageBroadcast MsgContent -- UserId (not used in UI) | DeleteMessage ChatName Text | DeleteMemberMessage GroupName ContactName Text | EditMessage {chatName :: ChatName, editedMsg :: Text, message :: Text} diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index d10959178c..11ea3a1f93 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -1888,7 +1888,7 @@ processChatCommand' vr = \case withSendRef chatRef $ \sendRef -> do let mc = MCText msg processChatCommand $ APISendMessages sendRef True Nothing [ComposedMessage Nothing Nothing mc mentions] - SendMessageBroadcast msg -> withUser $ \user -> do + SendMessageBroadcast mc -> withUser $ \user -> do contacts <- withFastStore' $ \db -> getUserContacts db vr user withChatLock "sendMessageBroadcast" . procCmd $ do let ctConns_ = L.nonEmpty $ foldr addContactConn [] contacts @@ -1912,7 +1912,6 @@ processChatCommand' vr = \case lift . void $ withStoreBatch' $ \db -> map (createCI db user timestamp) ctSndMsgs pure CRBroadcastSent {user, msgContent = mc, successes = length ctSndMsgs, failures = length errs, timestamp} where - mc = MCText msg addContactConn :: Contact -> [(Contact, Connection)] -> [(Contact, Connection)] addContactConn ct ctConns = case contactSendConn_ ct of Right conn | directOrUsed ct -> (ct, conn) : ctConns @@ -4150,7 +4149,7 @@ chatCommandP = ("\\\\ #" <|> "\\\\#") *> (DeleteMemberMessage <$> displayNameP <* A.space <* char_ '@' <*> displayNameP <* A.space <*> textP), ("! " <|> "!") *> (EditMessage <$> chatNameP <* A.space <*> (quotedMsg <|> pure "") <*> msgTextP), ReactToMessage <$> (("+" $> True) <|> ("-" $> False)) <*> reactionP <* A.space <*> chatNameP' <* A.space <*> textP, - "/feed " *> (SendMessageBroadcast <$> msgTextP), + "/feed " *> (SendMessageBroadcast . MCText <$> msgTextP), ("/chats" <|> "/cs") *> (LastChats <$> (" all" $> Nothing <|> Just <$> (A.space *> A.decimal <|> pure 20))), ("/tail" <|> "/t") *> (LastMessages <$> optional (A.space *> chatNameP) <*> msgCountP <*> pure Nothing), ("/search" <|> "/?") *> (LastMessages <$> optional (A.space *> chatNameP) <*> msgCountP <*> (Just <$> (A.space *> stringP))),