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.hs49
1 files changed, 26 insertions, 23 deletions
diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs
index 61127b4..8804ebb 100644
--- a/Omni/Agent/Telegram.hs
+++ b/Omni/Agent/Telegram.hs
@@ -253,22 +253,25 @@ getBotUsername cfg = do
sendMessage :: Types.TelegramConfig -> Int -> Text -> IO ()
sendMessage cfg chatId text = do
- _ <- sendMessageReturningId cfg chatId text
+ _ <- sendMessageReturningId cfg chatId Nothing text
pure ()
-sendMessageReturningId :: Types.TelegramConfig -> Int -> Text -> IO (Maybe Int)
-sendMessageReturningId cfg chatId text = do
+sendMessageReturningId :: Types.TelegramConfig -> Int -> Maybe Int -> Text -> IO (Maybe Int)
+sendMessageReturningId cfg chatId mThreadId text = do
let url =
Text.unpack (Types.tgApiBaseUrl cfg)
<> "/bot"
<> Text.unpack (Types.tgBotToken cfg)
<> "/sendMessage"
- body =
- Aeson.object
- [ "chat_id" .= chatId,
- "text" .= text,
- "parse_mode" .= ("Markdown" :: Text)
- ]
+ baseFields =
+ [ "chat_id" .= chatId,
+ "text" .= text,
+ "parse_mode" .= ("Markdown" :: Text)
+ ]
+ threadFields = case mThreadId of
+ Just threadId -> ["message_thread_id" .= threadId]
+ Nothing -> []
+ body = Aeson.object (baseFields <> threadFields)
req0 <- HTTP.parseRequest url
let req =
HTTP.setRequestMethod "POST"
@@ -422,11 +425,11 @@ handleBotAddedToGroup tgConfig addedEvent = do
if Types.isUserAllowed tgConfig addedBy
then do
putText <| "Bot added to group " <> tshow chatId <> " by authorized user " <> firstName <> " (" <> tshow addedBy <> ")"
- _ <- Messages.enqueueImmediate Nothing chatId "hello! i'm ready to help." (Just "system") Nothing
+ _ <- Messages.enqueueImmediate Nothing chatId Nothing "hello! i'm ready to help." (Just "system") Nothing
pure ()
else do
putText <| "Bot added to group " <> tshow chatId <> " by UNAUTHORIZED user " <> firstName <> " (" <> tshow addedBy <> ") - leaving"
- _ <- Messages.enqueueImmediate Nothing chatId "sorry, you're not authorized to add me to groups." (Just "system") Nothing
+ _ <- Messages.enqueueImmediate Nothing chatId Nothing "sorry, you're not authorized to add me to groups." (Just "system") Nothing
leaveChat tgConfig chatId
handleMessageBatch ::
@@ -449,7 +452,7 @@ handleMessageBatch tgConfig provider engineCfg _botUsername msg batchedText = do
unless isAllowed <| do
putText <| "Unauthorized user: " <> tshow usrId <> " (" <> userName <> ")"
- _ <- Messages.enqueueImmediate Nothing chatId "sorry, you're not authorized to use this bot." (Just "system") Nothing
+ _ <- Messages.enqueueImmediate Nothing chatId Nothing "sorry, you're not authorized to use this bot." (Just "system") Nothing
pure ()
when isAllowed <| do
@@ -479,7 +482,7 @@ handleMessage tgConfig provider engineCfg _botUsername msg = do
unless isAllowed <| do
putText <| "Unauthorized user: " <> tshow usrId <> " (" <> userName <> ")"
- _ <- Messages.enqueueImmediate Nothing chatId "sorry, you're not authorized to use this bot." (Just "system") Nothing
+ _ <- Messages.enqueueImmediate Nothing chatId Nothing "sorry, you're not authorized to use this bot." (Just "system") Nothing
pure ()
when isAllowed <| do
@@ -521,7 +524,7 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do
case Media.checkPhotoSize photo of
Left err -> do
putText <| "Photo rejected: " <> err
- _ <- Messages.enqueueImmediate (Just uid) chatId err (Just "system") Nothing
+ _ <- Messages.enqueueImmediate (Just uid) chatId (Types.tmThreadId msg) err (Just "system") Nothing
pure Nothing
Right () -> do
putText <| "Processing photo: " <> tshow (Types.tpWidth photo) <> "x" <> tshow (Types.tpHeight photo)
@@ -547,14 +550,14 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do
case Media.checkVoiceSize voice of
Left err -> do
putText <| "Voice rejected: " <> err
- _ <- Messages.enqueueImmediate (Just uid) chatId err (Just "system") Nothing
+ _ <- Messages.enqueueImmediate (Just uid) chatId (Types.tmThreadId msg) err (Just "system") Nothing
pure Nothing
Right () -> do
if not (Types.isSupportedVoiceFormat voice)
then do
let err = "unsupported voice format, please send OGG/Opus audio"
putText <| "Voice rejected: " <> err
- _ <- Messages.enqueueImmediate (Just uid) chatId err (Just "system") Nothing
+ _ <- Messages.enqueueImmediate (Just uid) chatId (Types.tmThreadId msg) err (Just "system") Nothing
pure Nothing
else do
putText <| "Processing voice message: " <> tshow (Types.tvDuration voice) <> " seconds"
@@ -666,7 +669,7 @@ handleAuthorizedMessageBatch tgConfig provider engineCfg msg uid userName chatId
case Media.checkPhotoSize photo of
Left err -> do
putText <| "Photo rejected: " <> err
- _ <- Messages.enqueueImmediate (Just uid) chatId err (Just "system") Nothing
+ _ <- Messages.enqueueImmediate (Just uid) chatId (Types.tmThreadId msg) err (Just "system") Nothing
pure Nothing
Right () -> do
putText <| "Processing photo: " <> tshow (Types.tpWidth photo) <> "x" <> tshow (Types.tpHeight photo)
@@ -692,14 +695,14 @@ handleAuthorizedMessageBatch tgConfig provider engineCfg msg uid userName chatId
case Media.checkVoiceSize voice of
Left err -> do
putText <| "Voice rejected: " <> err
- _ <- Messages.enqueueImmediate (Just uid) chatId err (Just "system") Nothing
+ _ <- Messages.enqueueImmediate (Just uid) chatId (Types.tmThreadId msg) err (Just "system") Nothing
pure Nothing
Right () -> do
if not (Types.isSupportedVoiceFormat voice)
then do
let err = "unsupported voice format, please send OGG/Opus audio"
putText <| "Voice rejected: " <> err
- _ <- Messages.enqueueImmediate (Just uid) chatId err (Just "system") Nothing
+ _ <- Messages.enqueueImmediate (Just uid) chatId (Types.tmThreadId msg) err (Just "system") Nothing
pure Nothing
else do
putText <| "Processing voice message: " <> tshow (Types.tvDuration voice) <> " seconds"
@@ -823,7 +826,7 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe
Todos.todoDeleteTool uid
]
messageTools =
- [ Messages.sendMessageTool uid chatId,
+ [ Messages.sendMessageTool uid chatId (Types.tmThreadId msg),
Messages.listPendingMessagesTool uid chatId,
Messages.cancelMessageTool
]
@@ -846,7 +849,7 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe
case result of
Left err -> do
putText <| "Agent error: " <> err
- _ <- Messages.enqueueImmediate (Just uid) chatId "sorry, i hit an error. please try again." (Just "agent_error") Nothing
+ _ <- Messages.enqueueImmediate (Just uid) chatId (Types.tmThreadId msg) "sorry, i hit an error. please try again." (Just "agent_error") Nothing
pure ()
Right agentResult -> do
let response = Engine.resultFinalMessage agentResult
@@ -860,10 +863,10 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe
then putText "Agent chose not to respond (group chat)"
else do
putText "Warning: empty response from agent"
- _ <- Messages.enqueueImmediate (Just uid) chatId "hmm, i don't have a response for that" (Just "agent_response") Nothing
+ _ <- Messages.enqueueImmediate (Just uid) chatId (Types.tmThreadId msg) "hmm, i don't have a response for that" (Just "agent_response") Nothing
pure ()
else do
- _ <- Messages.enqueueImmediate (Just uid) chatId response (Just "agent_response") Nothing
+ _ <- Messages.enqueueImmediate (Just uid) chatId (Types.tmThreadId msg) response (Just "agent_response") Nothing
checkAndSummarize (Types.tgOpenRouterApiKey tgConfig) uid chatId
putText
<| "Responded to "
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-19 12:14:16 +0000