apps: update chat bots, readme (#1928)

* 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>

src/Simplex/Chat/Bot.hs

@@ -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 <> ")"

src/Simplex/Chat/Controller.hs

@@ -572,6 +572,10 @@ data ComposedMessage = ComposedMessage
   }
   deriving (Show, Generic, FromJSON)
 
+instance ToJSON ComposedMessage where
+  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
+  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+
 data NtfMsgInfo = NtfMsgInfo {msgTs :: UTCTime, msgFlags :: MsgFlags}
   deriving (Show, Generic)
 

src/Simplex/Chat/Options.hs

@@ -7,6 +7,7 @@
 
 module Simplex.Chat.Options
   ( ChatOpts (..),
+    chatOptsP,
     getChatOpts,
     smpServersP,
     fullNetworkConfig,
@@ -43,8 +44,8 @@ data ChatOpts = ChatOpts
     maintenance :: Bool
   }
 
-chatOpts :: FilePath -> FilePath -> Parser ChatOpts
-chatOpts appDir defaultDbFileName = do
+chatOptsP :: FilePath -> FilePath -> Parser ChatOpts
+chatOptsP appDir defaultDbFileName = do
   dbFilePrefix <-
     strOption
       ( long "database"
@@ -229,7 +230,7 @@ getChatOpts :: FilePath -> FilePath -> IO ChatOpts
 getChatOpts appDir defaultDbFileName =
   execParser $
     info
-      (helper <*> versionOption <*> chatOpts appDir defaultDbFileName)
+      (helper <*> versionOption <*> chatOptsP appDir defaultDbFileName)
       (header versionStr <> fullDesc <> progDesc "Start chat with DB_FILE file and use SERVER as SMP server")
   where
     versionStr = versionString versionNumber