summaryrefslogtreecommitdiff
path: root/Omni/Agent/Telegram.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Agent/Telegram.hs')
-rw-r--r--Omni/Agent/Telegram.hs43
1 files changed, 39 insertions, 4 deletions
diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs
index c55dc5a..ffad4c7 100644
--- a/Omni/Agent/Telegram.hs
+++ b/Omni/Agent/Telegram.hs
@@ -184,6 +184,29 @@ getUpdates cfg offset = do
_ -> pure []
_ -> pure []
+getBotUsername :: Types.TelegramConfig -> IO (Maybe Text)
+getBotUsername cfg = do
+ let url =
+ Text.unpack (Types.tgApiBaseUrl cfg)
+ <> "/bot"
+ <> Text.unpack (Types.tgBotToken cfg)
+ <> "/getMe"
+ result <-
+ try <| do
+ req <- HTTP.parseRequest url
+ HTTP.httpLBS req
+ case result of
+ Left (_ :: SomeException) -> pure Nothing
+ Right response -> do
+ let body = HTTP.getResponseBody response
+ case Aeson.decode body of
+ Just (Aeson.Object obj) -> case KeyMap.lookup "result" obj of
+ Just (Aeson.Object userObj) -> case KeyMap.lookup "username" userObj of
+ Just (Aeson.String username) -> pure (Just username)
+ _ -> pure Nothing
+ _ -> pure Nothing
+ _ -> pure Nothing
+
sendMessage :: Types.TelegramConfig -> Int -> Text -> IO ()
sendMessage cfg chatId text = do
let url =
@@ -231,6 +254,12 @@ runTelegramBot tgConfig provider = do
putText "Starting Telegram bot..."
offsetVar <- newTVarIO 0
+ botUsername <- getBotUsername tgConfig
+ case botUsername of
+ Nothing -> putText "Warning: could not get bot username, group mentions may not work"
+ Just name -> putText <| "Bot username: @" <> name
+ let botName = fromMaybe "bot" botUsername
+
_ <- forkIO (reminderLoop tgConfig)
putText "Reminder loop started (checking every 5 minutes)"
@@ -249,28 +278,34 @@ runTelegramBot tgConfig provider = do
messages <- getUpdates tgConfig offset
forM_ messages <| \msg -> do
atomically (writeTVar offsetVar (Types.tmUpdateId msg + 1))
- handleMessage tgConfig provider engineCfg msg
+ handleMessage tgConfig provider engineCfg botName msg
when (null messages) <| threadDelay 1000000
handleMessage ::
Types.TelegramConfig ->
Provider.Provider ->
Engine.EngineConfig ->
+ Text ->
Types.TelegramMessage ->
IO ()
-handleMessage tgConfig provider engineCfg msg = do
+handleMessage tgConfig provider engineCfg botUsername msg = do
let userName =
Types.tmUserFirstName msg
<> maybe "" (" " <>) (Types.tmUserLastName msg)
chatId = Types.tmChatId msg
usrId = Types.tmUserId msg
+ unless (Types.shouldRespondInGroup botUsername msg) <| do
+ when (Types.isGroupChat msg)
+ <| putText
+ <| "Ignoring group message (not mentioned): "
+ <> Text.take 50 (Types.tmText msg)
+
unless (Types.isUserAllowed tgConfig usrId) <| do
putText <| "Unauthorized user: " <> tshow usrId <> " (" <> userName <> ")"
sendMessage tgConfig chatId "sorry, you're not authorized to use this bot."
- pure ()
- when (Types.isUserAllowed tgConfig usrId) <| do
+ when (Types.shouldRespondInGroup botUsername msg && Types.isUserAllowed tgConfig usrId) <| do
sendTypingAction tgConfig chatId
user <- Memory.getOrCreateUserByTelegramId usrId userName