dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-06-05 08:02:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

SimpleX Directory Service (#2766)

Browse Source 
* 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
2023-08-01 20:54:51 +01:00
committed by GitHub
parent f0d64a30e9
commit 2b69103055
23 changed files with 1473 additions and 142 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Bot.hs
+19 -16
View File
@@ -9,9 +9,7 @@ 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
@@ -19,9 +17,8 @@ import Simplex.Chat.Messages
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Protocol (MsgContent (..))
import Simplex.Chat.Store
import Simplex.Chat.Types (Contact (..), IsContact (..), User (..))
import Simplex.Chat.Types (Contact (..), ContactId, IsContact (..), User (..))
import Simplex.Messaging.Encoding.String (strEncode)
import Simplex.Messaging.Util (safeDecodeUtf8)
import System.Exit (exitFailure)
chatBotRepl :: String -> (Contact -> String -> IO String) -> User -> ChatController -> IO ()
@@ -32,49 +29,55 @@ chatBotRepl welcome answer _user cc = do
case resp of
CRContactConnected _ contact _ -> do
contactConnected contact
void $ sendMsg contact welcome
void $ sendMessage cc contact welcome
CRNewChatItem _ (AChatItem _ SMDRcv (DirectChat contact) ChatItem {content = mc@CIRcvMsgContent {}}) -> do
let msg = T.unpack $ ciContentToText mc
void $ sendMsg contact =<< answer contact msg
void $ sendMessage cc contact =<< answer contact msg
_ -> pure ()
where
sendMsg Contact {contactId} msg = sendChatCmd cc $ "/_send @" <> show contactId <> " text " <> msg
contactConnected Contact {localDisplayName} = putStrLn $ T.unpack localDisplayName <> " connected"
initializeBotAddress :: ChatController -> IO ()
initializeBotAddress cc = do
sendChatCmd cc "/show_address" >>= \case
sendChatCmd cc ShowMyAddress >>= \case
CRUserContactLink _ UserContactLink {connReqContact} -> showBotAddress connReqContact
CRChatCmdError _ (ChatErrorStore SEUserContactLinkNotFound) -> do
putStrLn "No bot address, creating..."
sendChatCmd cc "/address" >>= \case
sendChatCmd cc CreateMyAddress >>= \case
CRUserContactLinkCreated _ uri -> showBotAddress uri
_ -> putStrLn "can't create bot address" >> exitFailure
_ -> putStrLn "unexpected response" >> exitFailure
where
showBotAddress uri = do
putStrLn $ "Bot's contact address is: " <> B.unpack (strEncode uri)
void $ sendChatCmd cc "/auto_accept on"
void $ sendChatCmd cc $ AddressAutoAccept $ Just AutoAccept {acceptIncognito = False, autoReply = Nothing}
sendMessage :: ChatController -> Contact -> String -> IO ()
sendMessage cc ct = sendComposedMessage cc ct Nothing . textMsgContent
sendMessage' :: ChatController -> ContactId -> String -> IO ()
sendMessage' cc ctId = sendComposedMessage' cc ctId Nothing . textMsgContent
sendComposedMessage :: ChatController -> Contact -> Maybe ChatItemId -> MsgContent -> IO ()
sendComposedMessage cc ct quotedItemId msgContent = do
sendComposedMessage cc = sendComposedMessage' cc . contactId'
sendComposedMessage' :: ChatController -> ContactId -> Maybe ChatItemId -> MsgContent -> IO ()
sendComposedMessage' cc ctId 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
sendChatCmd cc (APISendMessage (ChatRef CTDirect ctId) False Nothing cm) >>= \case
CRNewChatItem {} -> printLog cc CLLInfo $ "sent message to contact ID " <> show ctId
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"
let cmd = APIDeleteChatItem (contactRef ct) chatItemId CIDMInternal
sendChatCmd cc cmd >>= \case
CRChatItemDeleted {} -> printLog cc CLLInfo $ "deleted message from " <> contactInfo ct
r -> putStrLn $ "unexpected delete message response: " <> show r
contactRef :: Contact -> ChatRef
contactRef = ChatRef CTDirect . contactId'
textMsgContent :: String -> MsgContent
textMsgContent = MCText . T.pack