diff options
Diffstat (limited to 'Omni/Agent/Telegram.hs')
| -rw-r--r-- | Omni/Agent/Telegram.hs | 95 |
1 files changed, 86 insertions, 9 deletions
diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index e089945..0c3a870 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -28,6 +28,7 @@ module Omni.Agent.Telegram -- * Telegram API getUpdates, sendMessage, + sendTypingAction, -- * Bot Loop runTelegramBot, @@ -48,6 +49,7 @@ import Control.Concurrent.STM (newTVarIO, readTVarIO, writeTVar) import Data.Aeson ((.!=), (.:), (.:?), (.=)) import qualified Data.Aeson as Aeson import qualified Data.Aeson.KeyMap as KeyMap +import qualified Data.ByteString.Lazy as BL import qualified Data.Text as Text import qualified Network.HTTP.Client as HTTPClient import qualified Network.HTTP.Simple as HTTP @@ -268,6 +270,28 @@ getUpdates cfg offset = do putText <| "Telegram HTTP error: " <> tshow status pure [] +-- | Send typing indicator to a Telegram chat. +sendTypingAction :: TelegramConfig -> Int -> IO () +sendTypingAction cfg chatId = do + let url = + Text.unpack (tgApiBaseUrl cfg) + <> "/bot" + <> Text.unpack (tgBotToken cfg) + <> "/sendChatAction" + req0 <- HTTP.parseRequest url + let body = + Aeson.object + [ "chat_id" .= chatId, + "action" .= ("typing" :: Text) + ] + req = + HTTP.setRequestMethod "POST" + <| HTTP.setRequestHeader "Content-Type" ["application/json"] + <| HTTP.setRequestBodyLBS (Aeson.encode body) + <| req0 + _ <- try (HTTP.httpLBS req) :: IO (Either SomeException (HTTP.Response BL.ByteString)) + pure () + -- | Send a message to a Telegram chat. sendMessage :: TelegramConfig -> Int -> Text -> IO () sendMessage cfg chatId text = do @@ -293,10 +317,10 @@ sendMessage cfg chatId text = do putText <| "Failed to send message: " <> tshow e Right response -> do let status = HTTP.getResponseStatusCode response - unless (status >= 200 && status < 300) - <| putText - <| "Send message failed: " - <> tshow status + respBody = HTTP.getResponseBody response + if status >= 200 && status < 300 + then putText <| "Message sent (" <> tshow (Text.length text) <> " chars)" + else putText <| "Send message failed: " <> tshow status <> " - " <> tshow respBody -- | System prompt for the Telegram bot agent. telegramSystemPrompt :: Text @@ -347,23 +371,34 @@ handleMessage :: TelegramMessage -> IO () handleMessage tgConfig provider engineCfg msg = do + sendTypingAction tgConfig (tmChatId msg) + let userName = tmUserFirstName msg <> maybe "" (" " <>) (tmUserLastName msg) + chatId = tmChatId msg user <- Memory.getOrCreateUserByTelegramId (tmUserId msg) userName + let uid = Memory.userId user + + _ <- Memory.saveMessage uid chatId Memory.UserRole (tmText msg) + + (conversationContext, contextTokens) <- Memory.getConversationContext uid chatId maxConversationTokens + putText <| "Conversation context: " <> tshow contextTokens <> " tokens" - memories <- Memory.recallMemories (Memory.userId user) (tmText msg) 5 + memories <- Memory.recallMemories uid (tmText msg) 5 let memoryContext = Memory.formatMemoriesForPrompt memories let systemPrompt = telegramSystemPrompt <> "\n\n## What you know about this user\n" <> memoryContext + <> "\n\n" + <> conversationContext let tools = - [ Memory.rememberTool (Memory.userId user), - Memory.recallTool (Memory.userId user) + [ Memory.rememberTool uid, + Memory.recallTool uid ] let agentCfg = @@ -382,10 +417,21 @@ handleMessage tgConfig provider engineCfg msg = do case result of Left err -> do putText <| "Agent error: " <> err - sendMessage tgConfig (tmChatId msg) "Sorry, I encountered an error. Please try again." + sendMessage tgConfig chatId "Sorry, I encountered an error. Please try again." Right agentResult -> do let response = Engine.resultFinalMessage agentResult - sendMessage tgConfig (tmChatId msg) response + putText <| "Response text: " <> Text.take 200 response + + _ <- Memory.saveMessage uid chatId Memory.AssistantRole response + + if Text.null response + then do + putText "Warning: empty response from agent" + sendMessage tgConfig chatId "hmm, i don't have a response for that" + else sendMessage tgConfig chatId response + + checkAndSummarize provider uid chatId + putText <| "Responded to " <> userName @@ -393,6 +439,37 @@ handleMessage tgConfig provider engineCfg msg = do <> tshow (Engine.resultTotalCost agentResult) <> " cents)" +maxConversationTokens :: Int +maxConversationTokens = 4000 + +summarizationThreshold :: Int +summarizationThreshold = 3000 + +checkAndSummarize :: Provider.Provider -> Text -> Int -> IO () +checkAndSummarize provider uid chatId = do + (_, currentTokens) <- Memory.getConversationContext uid chatId maxConversationTokens + when (currentTokens > summarizationThreshold) <| do + putText <| "Context at " <> tshow currentTokens <> " tokens, summarizing..." + recentMsgs <- Memory.getRecentMessages uid chatId 50 + let conversationText = + Text.unlines + [ (if Memory.cmRole m == Memory.UserRole then "User: " else "Assistant: ") <> Memory.cmContent m + | m <- reverse recentMsgs + ] + summaryResult <- + Provider.chat + provider + [] + [ Provider.Message Provider.System "You are a conversation summarizer. Summarize the key points, decisions, and context from this conversation in 2-3 paragraphs. Focus on information that would be useful for continuing the conversation later." Nothing Nothing, + Provider.Message Provider.User ("Summarize this conversation:\n\n" <> conversationText) Nothing Nothing + ] + case summaryResult of + Left err -> putText <| "Summarization failed: " <> err + Right summaryMsg -> do + let summary = Provider.msgContent summaryMsg + _ <- Memory.summarizeAndArchive uid chatId summary + putText "Conversation summarized and archived" + -- | Start the Telegram bot from environment or provided token. startBot :: Maybe Text -> IO () startBot maybeToken = do |