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>

README.md

@@ -24,7 +24,7 @@
 - 🔐 Double ratchet end-to-end encryption, with additional encryption layer.
 - 📱 Mobile apps for Android ([Google Play](https://play.google.com/store/apps/details?id=chat.simplex.app), [APK](https://github.com/simplex-chat/simplex-chat/releases/latest/download/simplex.apk)) and [iOS](https://apps.apple.com/us/app/simplex-chat/id1605771084).
 - 🚀 [TestFlight preview for iOS](https://testflight.apple.com/join/DWuT2LQu) with the new features 1-2 weeks earlier - **limited to 10,000 users**!
-- 🖥 Available as a terminal (console) app / CLI on Linux, MacOS, Windows.
+- 🖥 Available as a terminal (console) [app / CLI](#zap-quick-installation-of-a-terminal-app) on Linux, MacOS, Windows.
 
 **NEW**: Security audit by [Trail of Bits](https://www.trailofbits.com/about), the [new website](https://simplex.chat) and v4.2 released! [See the announcement](./blog/20221108-simplex-chat-v4.2-security-audit-new-website.md)
 

apps/ios/README.md

@@ -0,0 +1 @@
+# SimpleX Chat iOS app

apps/simplex-bot-advanced/Main.hs

@@ -33,6 +33,9 @@ welcomeGetOpts = do
   putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
   pure opts
 
+welcomeMessage :: String
+welcomeMessage = "Hello! I am a simple squaring bot.\nIf you send me a number, I will calculate its square"
+
 mySquaringBot :: User -> ChatController -> IO ()
 mySquaringBot _user cc = do
   initializeBotAddress cc
@@ -41,14 +44,13 @@ mySquaringBot _user cc = do
     case resp of
       CRContactConnected _ contact _ -> do
         contactConnected contact
-        void . sendMsg contact $ "Hello! I am a simple squaring bot - if you send me a number, I will calculate its square"
-      CRNewChatItem _ (AChatItem _ SMDRcv (DirectChat contact) ChatItem {content}) -> do
-        let msg = T.unpack $ ciContentToText content
+        sendMessage cc contact welcomeMessage
+      CRNewChatItem _ (AChatItem _ SMDRcv (DirectChat contact) ChatItem {content = mc@CIRcvMsgContent {}}) -> do
+        let msg = T.unpack $ ciContentToText mc
             number_ = readMaybe msg :: Maybe Integer
-        void . sendMsg contact $ case number_ of
-          Nothing -> "\"" <> msg <> "\" is not a number"
+        sendMessage cc contact $ case number_ of
           Just n -> msg <> " * " <> msg <> " = " <> show (n * n)
+          _ -> "\"" <> msg <> "\" is not a number"
       _ -> pure ()
   where
-    sendMsg Contact {contactId} msg = sendChatCmd cc $ "/_send @" <> show contactId <> " text " <> msg
     contactConnected Contact {localDisplayName} = putStrLn $ T.unpack localDisplayName <> " connected"

apps/simplex-bot-advanced/README.md

@@ -0,0 +1,13 @@
+# Advanced SimpleX Chat bot example
+
+In most cases [a simple REPL bot](../simplex-bot/) is sufficient, but in cases you want to program more advanced communication scenarios you may take a more complex event-based approach, as in this example.
+
+Event-based approach allows you:
+
+- decide whether to connect to a user or not depending on any factors, e.g. user display name.
+- disconnect from users who send too many messages or send messages that bot finds inappropriate.
+- react to message deletions and editing.
+- process reply messages differently, taking the original message into account.
+- process and send images and voice messages.
+- create groups of users, e.g. to connect 2 users.
+- etc.

apps/simplex-bot/Main.hs

@@ -14,11 +14,14 @@ main :: IO ()
 main = do
   opts <- welcomeGetOpts
   simplexChatCore terminalChatConfig opts Nothing $
-    chatBotRepl "Hello! I am a simple squaring bot - if you send me a number, I will calculate its square" $ \msg ->
-      case readMaybe msg :: Maybe Integer of
+    chatBotRepl welcomeMessage $ \_contact msg ->
+      pure $ case readMaybe msg :: Maybe Integer of
         Just n -> msg <> " * " <> msg <> " = " <> show (n * n)
         _ -> "\"" <> msg <> "\" is not a number"
 
+welcomeMessage :: String
+welcomeMessage = "Hello! I am a simple squaring bot.\nIf you send me a number, I will calculate its square"
+
 welcomeGetOpts :: IO ChatOpts
 welcomeGetOpts = do
   appDir <- getAppUserDataDirectory "simplex"

apps/simplex-bot/README.md

@@ -0,0 +1,17 @@
+# Simple SimpleX Chat bot example
+
+This chat bot is a Haskell implementation of a REPL chat bot.
+
+All you have to do to create your bot based on this example is to provide a welcome message for connecting users and a function of type `Contact -> String -> IO String`. This function should transform the sent message into a reply message, ignoring any system messages related to preferences and user profile changes.
+
+This bot example calculates the square of the number that is sent to it, but you can program it to do other things, simply by changing REPL function:
+
+- a more advanced calculator (e.g., based on [this one](https://github.com/jonathanknowles/haskell-calculator)).
+- translation to/from any language.
+- lookup of market quotes.
+- search of the information.
+- AI-powered dialogue – the bot can maintain any conversation state based on the contact.
+- provide any other online service via chat UI.
+- etc.
+
+Please share any bots you create with us, we will add to this page and can host them if you like!

apps/simplex-broadcast-bot/Main.hs

@@ -0,0 +1,74 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Control.Concurrent.Async
+import Control.Concurrent.STM
+import Control.Monad.Reader
+import qualified Data.Text as T
+import Options
+import Simplex.Chat.Bot
+import Simplex.Chat.Controller
+import Simplex.Chat.Core
+import Simplex.Chat.Messages
+import Simplex.Chat.Options
+import Simplex.Chat.Protocol (MsgContent (..))
+import Simplex.Chat.Terminal (terminalChatConfig)
+import Simplex.Chat.Types
+import System.Directory (getAppUserDataDirectory)
+
+main :: IO ()
+main = do
+  opts@BroadcastBotOpts {chatOptions} <- welcomeGetOpts
+  simplexChatCore terminalChatConfig chatOptions Nothing $ broadcastBot opts
+
+welcomeGetOpts :: IO BroadcastBotOpts
+welcomeGetOpts = do
+  appDir <- getAppUserDataDirectory "simplex"
+  opts@BroadcastBotOpts {chatOptions = ChatOpts {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 "/contacts" >>= \case
+                CRContactsList _ cts -> 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 = Publisher {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"

apps/simplex-broadcast-bot/Options.hs

@@ -0,0 +1,97 @@
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Options where
+
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import Data.Int (Int64)
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8)
+import Options.Applicative
+import Simplex.Chat.Controller (updateStr, versionNumber, versionString)
+import Simplex.Chat.Options
+import Simplex.Messaging.Parsers (parseAll)
+import Simplex.Messaging.Util (safeDecodeUtf8)
+
+data Publisher = Publisher
+  { contactId :: Int64,
+    localDisplayName :: Text
+  }
+  deriving (Eq)
+
+data BroadcastBotOpts = BroadcastBotOpts
+  { chatOptions :: ChatOpts,
+    publishers :: [Publisher],
+    welcomeMessage :: String,
+    prohibitedMessage :: String
+  }
+
+defaultWelcomeMessage :: [Publisher] -> String
+defaultWelcomeMessage ps = "Hello! I am a broadcast bot.\nI broadcast messages to all connected users from " <> publisherNames ps <> "."
+
+defaultProhibitedMessage :: [Publisher] -> String
+defaultProhibitedMessage ps = "Sorry, only these users can broadcast messages: " <> publisherNames ps <> ". Your message is deleted."
+
+publisherNames :: [Publisher] -> String
+publisherNames = T.unpack . T.intercalate ", " . map (("@" <>) . localDisplayName)
+
+broadcastBotOpts :: FilePath -> FilePath -> Parser BroadcastBotOpts
+broadcastBotOpts appDir defaultDbFileName = do
+  chatOptions <- chatOptsP appDir defaultDbFileName
+  publishers <-
+    option
+      parsePublishers
+      ( 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
+      { chatOptions,
+        publishers,
+        welcomeMessage = fromMaybe (defaultWelcomeMessage publishers) welcomeMessage_,
+        prohibitedMessage = fromMaybe (defaultProhibitedMessage publishers) prohibitedMessage_
+      }
+
+parsePublishers :: ReadM [Publisher]
+parsePublishers = eitherReader $ parseAll publishersP . encodeUtf8 . T.pack
+
+publishersP :: A.Parser [Publisher]
+publishersP = publisherP `A.sepBy1` A.char ','
+  where
+    publisherP = do
+      contactId <- A.decimal <* A.char ':'
+      localDisplayName <- safeDecodeUtf8 <$> A.takeTill (A.inClass ", ")
+      pure Publisher {contactId, localDisplayName}
+
+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

apps/simplex-broadcast-bot/README.md

@@ -0,0 +1,9 @@
+# SimpleX broadcast bot
+
+The bot allows anybody to connect to it and re-broadcasts all messages received from specified users configured via CLI options (publishers) to all users.
+
+Welcome message and reply to the users who are not set as publishers can also be configured via CLI options.
+
+It's a poor man's feed, until we have a better support for feeds in SimpleX Chat.
+
+We use it to broadcast status notifications for SimpleX Chat servers when we do any maintenance or in case they become unavailable.

apps/simplex-chat/README.md

@@ -0,0 +1,3 @@
+# SimpleX Chat CLI app
+
+See [repo REAMDE](../../README.md#zap-quick-installation-of-a-terminal-app) for installation and usage instructions.

package.yaml

@@ -88,6 +88,14 @@ executables:
     ghc-options:
       - -threaded
 
+  simplex-broadcast-bot:
+    source-dirs: apps/simplex-broadcast-bot
+    main: Main.hs
+    dependencies:
+      - simplex-chat
+    ghc-options:
+      - -threaded
+
 tests:
   simplex-chat-test:
     source-dirs: tests

simplex-chat.cabal

@@ -235,6 +235,54 @@ executable simplex-bot-advanced
   if flag(swift)
     cpp-options: -DswiftJSON
 
+executable simplex-broadcast-bot
+  main-is: Main.hs
+  other-modules:
+      Options
+      Paths_simplex_chat
+  hs-source-dirs:
+      apps/simplex-broadcast-bot
+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns -threaded
+  build-depends:
+      aeson ==2.0.*
+    , ansi-terminal >=0.10 && <0.12
+    , async ==2.2.*
+    , attoparsec ==0.14.*
+    , base >=4.7 && <5
+    , base64-bytestring >=1.0 && <1.3
+    , bytestring ==0.10.*
+    , composition ==1.0.*
+    , containers ==0.6.*
+    , cryptonite >=0.27 && <0.30
+    , direct-sqlcipher ==2.3.*
+    , directory ==1.3.*
+    , email-validate ==2.3.*
+    , exceptions ==0.10.*
+    , filepath ==1.4.*
+    , http-types ==0.12.*
+    , mtl ==2.2.*
+    , network >=3.1.2.7 && <3.2
+    , optparse-applicative >=0.15 && <0.17
+    , process ==1.6.*
+    , random >=1.1 && <1.3
+    , record-hasfield ==1.0.*
+    , simple-logger ==0.1.*
+    , simplex-chat
+    , simplexmq >=3.4
+    , socks ==0.6.*
+    , sqlcipher-simple ==0.4.*
+    , stm ==2.5.*
+    , template-haskell ==2.16.*
+    , terminal ==0.2.*
+    , text ==1.2.*
+    , time ==1.9.*
+    , unliftio ==0.2.*
+    , unliftio-core ==0.2.*
+    , zip ==1.7.*
+  default-language: Haskell2010
+  if flag(swift)
+    cpp-options: -DswiftJSON
+
 executable simplex-chat
   main-is: Main.hs
   other-modules:

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