blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

apps: update chat bots, readme (#1928)

Browse Source 
* apps: update chat bots, readme

* CLI readme

* broadcast bot

* delete messages from non-publishers, better replies, support forwarding low-res images and links

* typo

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

* change

---------

Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
This commit is contained in:
Evgeny Poberezkin
2023-02-14 07:57:27 +00:00
committed by GitHub
parent 6f68840b3a
commit a0351d6f99
16 changed files with 332 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Bot.hs
+40 -5
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
@@ -8,17 +9,21 @@ module Simplex.Chat.Bot where
import Control.Concurrent.Async
import Control.Concurrent.STM
import Control.Monad.Reader
import qualified Data.Aeson as J
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import qualified Data.Text as T
import Simplex.Chat.Controller
import Simplex.Chat.Core
import Simplex.Chat.Messages
import Simplex.Chat.Protocol (MsgContent (..))
import Simplex.Chat.Store
import Simplex.Chat.Types (Contact (..), User (..))
import Simplex.Chat.Types (Contact (..), IsContact (..), User (..))
import Simplex.Messaging.Encoding.String (strEncode)
import Simplex.Messaging.Util (safeDecodeUtf8)
import System.Exit (exitFailure)
chatBotRepl :: String -> (String -> String) -> User -> ChatController -> IO ()
chatBotRepl :: String -> (Contact -> String -> IO String) -> User -> ChatController -> IO ()
chatBotRepl welcome answer _user cc = do
initializeBotAddress cc
race_ (forever $ void getLine) . forever $ do
@@ -27,9 +32,9 @@ chatBotRepl welcome answer _user cc = do
CRContactConnected _ contact _ -> do
contactConnected contact
void $ sendMsg contact welcome
CRNewChatItem _ (AChatItem _ SMDRcv (DirectChat contact) ChatItem {content}) -> do
let msg = T.unpack $ ciContentToText content
void . sendMsg contact $ answer msg
CRNewChatItem _ (AChatItem _ SMDRcv (DirectChat contact) ChatItem {content = mc@CIRcvMsgContent {}}) -> do
let msg = T.unpack $ ciContentToText mc
void $ sendMsg contact =<< answer contact msg
_ -> pure ()
where
sendMsg Contact {contactId} msg = sendChatCmd cc $ "/_send @" <> show contactId <> " text " <> msg
@@ -49,3 +54,33 @@ initializeBotAddress cc = do
showBotAddress uri = do
putStrLn $ "Bot's contact address is: " <> B.unpack (strEncode uri)
void $ sendChatCmd cc "/auto_accept on"
sendMessage :: ChatController -> Contact -> String -> IO ()
sendMessage cc ct = sendComposedMessage cc ct Nothing . textMsgContent
sendComposedMessage :: ChatController -> Contact -> Maybe ChatItemId -> MsgContent -> IO ()
sendComposedMessage cc ct quotedItemId msgContent = do
let cm = ComposedMessage {filePath = Nothing, quotedItemId, msgContent}
sendChatCmd cc ("/_send @" <> show (contactId' ct) <> " json " <> jsonEncode cm) >>= \case
CRNewChatItem {} -> printLog cc CLLInfo $ "sent message to " <> contactInfo ct
r -> putStrLn $ "unexpected send message response: " <> show r
where
jsonEncode = T.unpack . safeDecodeUtf8 . LB.toStrict . J.encode
deleteMessage :: ChatController -> Contact -> ChatItemId -> IO ()
deleteMessage cc ct chatItemId = do
let cmd = "/_delete item @" <> show (contactId' ct) <> " " <> show chatItemId <> " internal"
sendChatCmd cc cmd >>= \case
CRChatItemDeleted {} -> printLog cc CLLInfo $ "deleted message from " <> contactInfo ct
r -> putStrLn $ "unexpected delete message response: " <> show r
textMsgContent :: String -> MsgContent
textMsgContent = MCText . T.pack
printLog :: ChatController -> ChatLogLevel -> String -> IO ()
printLog cc level s
| logLevel (config cc) <= level = putStrLn s
| otherwise = pure ()
contactInfo :: Contact -> String
contactInfo Contact {contactId, localDisplayName} = T.unpack localDisplayName <> " (" <> show contactId <> ")"