From 37a28ead25b5e8e38076905feefa3fa9c8c86604 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Thu, 11 Dec 2025 22:51:44 -0500 Subject: Add Telegram bot agent (t-251) - Omni/Agent/Telegram.hs: Telegram API client with getUpdates/sendMessage - Omni/Bot.hs: Standalone CLI for running the bot - User identification via Memory.getOrCreateUserByTelegramId - Memory-enhanced agent with remember/recall tools - Run with: bot --token=XXX or TELEGRAM_BOT_TOKEN env var --- Omni/Agent/Telegram.hs | 408 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 408 insertions(+) create mode 100644 Omni/Agent/Telegram.hs (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs new file mode 100644 index 0000000..dd3df51 --- /dev/null +++ b/Omni/Agent/Telegram.hs @@ -0,0 +1,408 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | Telegram Bot Agent - Family assistant via Telegram. +-- +-- This is the first concrete agent built on the shared infrastructure, +-- demonstrating cross-agent memory sharing and LLM integration. +-- +-- Usage: +-- jr telegram # Uses TELEGRAM_BOT_TOKEN env var +-- jr telegram --token=XXX # Explicit token +-- +-- : out omni-agent-telegram +-- : dep aeson +-- : dep http-conduit +-- : dep stm +module Omni.Agent.Telegram + ( -- * Configuration + TelegramConfig (..), + defaultTelegramConfig, + + -- * Types + TelegramMessage (..), + TelegramUpdate (..), + + -- * Telegram API + getUpdates, + sendMessage, + + -- * Bot Loop + runTelegramBot, + handleMessage, + startBot, + + -- * System Prompt + telegramSystemPrompt, + + -- * Testing + main, + test, + ) +where + +import Alpha +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.Text as Text +import qualified Network.HTTP.Simple as HTTP +import qualified Omni.Agent.Engine as Engine +import qualified Omni.Agent.Memory as Memory +import qualified Omni.Agent.Provider as Provider +import qualified Omni.Test as Test +import System.Environment (lookupEnv) + +main :: IO () +main = Test.run test + +test :: Test.Tree +test = + Test.group + "Omni.Agent.Telegram" + [ Test.unit "TelegramConfig JSON roundtrip" <| do + let cfg = + TelegramConfig + { tgBotToken = "test-token", + tgPollingTimeout = 30, + tgApiBaseUrl = "https://api.telegram.org" + } + case Aeson.decode (Aeson.encode cfg) of + Nothing -> Test.assertFailure "Failed to decode TelegramConfig" + Just decoded -> tgBotToken decoded Test.@=? "test-token", + Test.unit "TelegramMessage JSON roundtrip" <| do + let msg = + TelegramMessage + { tmUpdateId = 123, + tmChatId = 456, + tmUserId = 789, + tmUserFirstName = "Test", + tmUserLastName = Just "User", + tmText = "Hello bot" + } + case Aeson.decode (Aeson.encode msg) of + Nothing -> Test.assertFailure "Failed to decode TelegramMessage" + Just decoded -> do + tmUpdateId decoded Test.@=? 123 + tmText decoded Test.@=? "Hello bot", + Test.unit "telegramSystemPrompt is non-empty" <| do + Text.null telegramSystemPrompt Test.@=? False, + Test.unit "parseUpdate extracts message correctly" <| do + let json = + Aeson.object + [ "update_id" .= (123 :: Int), + "message" + .= Aeson.object + [ "message_id" .= (1 :: Int), + "chat" .= Aeson.object ["id" .= (456 :: Int)], + "from" + .= Aeson.object + [ "id" .= (789 :: Int), + "first_name" .= ("Test" :: Text) + ], + "text" .= ("Hello" :: Text) + ] + ] + case parseUpdate json of + Nothing -> Test.assertFailure "Failed to parse update" + Just msg -> do + tmUpdateId msg Test.@=? 123 + tmChatId msg Test.@=? 456 + tmUserId msg Test.@=? 789 + tmText msg Test.@=? "Hello" + ] + +-- | Telegram bot configuration. +data TelegramConfig = TelegramConfig + { tgBotToken :: Text, + tgPollingTimeout :: Int, + tgApiBaseUrl :: Text + } + deriving (Show, Eq, Generic) + +instance Aeson.ToJSON TelegramConfig where + toJSON c = + Aeson.object + [ "bot_token" .= tgBotToken c, + "polling_timeout" .= tgPollingTimeout c, + "api_base_url" .= tgApiBaseUrl c + ] + +instance Aeson.FromJSON TelegramConfig where + parseJSON = + Aeson.withObject "TelegramConfig" <| \v -> + (TelegramConfig (v .:? "polling_timeout" .!= 30) + <*> (v .:? "api_base_url" .!= "https://api.telegram.org") + +-- | Default Telegram configuration (requires token from env). +defaultTelegramConfig :: Text -> TelegramConfig +defaultTelegramConfig token = + TelegramConfig + { tgBotToken = token, + tgPollingTimeout = 30, + tgApiBaseUrl = "https://api.telegram.org" + } + +-- | A parsed Telegram message from a user. +data TelegramMessage = TelegramMessage + { tmUpdateId :: Int, + tmChatId :: Int, + tmUserId :: Int, + tmUserFirstName :: Text, + tmUserLastName :: Maybe Text, + tmText :: Text + } + deriving (Show, Eq, Generic) + +instance Aeson.ToJSON TelegramMessage where + toJSON m = + Aeson.object + [ "update_id" .= tmUpdateId m, + "chat_id" .= tmChatId m, + "user_id" .= tmUserId m, + "user_first_name" .= tmUserFirstName m, + "user_last_name" .= tmUserLastName m, + "text" .= tmText m + ] + +instance Aeson.FromJSON TelegramMessage where + parseJSON = + Aeson.withObject "TelegramMessage" <| \v -> + (TelegramMessage (v .: "chat_id") + <*> (v .: "user_id") + <*> (v .: "user_first_name") + <*> (v .:? "user_last_name") + <*> (v .: "text") + +-- | Raw Telegram update for parsing. +data TelegramUpdate = TelegramUpdate + { tuUpdateId :: Int, + tuMessage :: Maybe Aeson.Value + } + deriving (Show, Eq, Generic) + +instance Aeson.FromJSON TelegramUpdate where + parseJSON = + Aeson.withObject "TelegramUpdate" <| \v -> + (TelegramUpdate (v .:? "message") + +-- | Parse a Telegram update into a TelegramMessage. +parseUpdate :: Aeson.Value -> Maybe TelegramMessage +parseUpdate val = do + Aeson.Object obj <- pure val + updateId <- case KeyMap.lookup "update_id" obj of + Just (Aeson.Number n) -> Just (round n) + _ -> Nothing + Aeson.Object msgObj <- KeyMap.lookup "message" obj + Aeson.Object chatObj <- KeyMap.lookup "chat" msgObj + chatId <- case KeyMap.lookup "id" chatObj of + Just (Aeson.Number n) -> Just (round n) + _ -> Nothing + Aeson.Object fromObj <- KeyMap.lookup "from" msgObj + userId <- case KeyMap.lookup "id" fromObj of + Just (Aeson.Number n) -> Just (round n) + _ -> Nothing + firstName <- case KeyMap.lookup "first_name" fromObj of + Just (Aeson.String s) -> Just s + _ -> Nothing + let lastName = case KeyMap.lookup "last_name" fromObj of + Just (Aeson.String s) -> Just s + _ -> Nothing + text <- case KeyMap.lookup "text" msgObj of + Just (Aeson.String s) -> Just s + _ -> Nothing + pure + TelegramMessage + { tmUpdateId = updateId, + tmChatId = chatId, + tmUserId = userId, + tmUserFirstName = firstName, + tmUserLastName = lastName, + tmText = text + } + +-- | Poll Telegram for new updates. +getUpdates :: TelegramConfig -> Int -> IO [TelegramMessage] +getUpdates cfg offset = do + let url = + Text.unpack (tgApiBaseUrl cfg) + <> "/bot" + <> Text.unpack (tgBotToken cfg) + <> "/getUpdates" + req0 <- HTTP.parseRequest url + let body = + Aeson.object + [ "offset" .= offset, + "timeout" .= tgPollingTimeout cfg, + "allowed_updates" .= (["message"] :: [Text]) + ] + req = + HTTP.setRequestMethod "POST" + <| HTTP.setRequestHeader "Content-Type" ["application/json"] + <| HTTP.setRequestBodyLBS (Aeson.encode body) + <| req0 + result <- try (HTTP.httpLBS req) + case result of + Left (e :: SomeException) -> do + putText <| "Telegram API error: " <> tshow e + pure [] + Right response -> do + let status = HTTP.getResponseStatusCode response + if status >= 200 && status < 300 + then case Aeson.decode (HTTP.getResponseBody response) of + Just (Aeson.Object obj) -> case KeyMap.lookup "result" obj of + Just (Aeson.Array arr) -> + pure (mapMaybe parseUpdate (toList arr)) + _ -> pure [] + _ -> pure [] + else do + putText <| "Telegram HTTP error: " <> tshow status + pure [] + +-- | Send a message to a Telegram chat. +sendMessage :: TelegramConfig -> Int -> Text -> IO () +sendMessage cfg chatId text = do + let url = + Text.unpack (tgApiBaseUrl cfg) + <> "/bot" + <> Text.unpack (tgBotToken cfg) + <> "/sendMessage" + req0 <- HTTP.parseRequest url + let body = + Aeson.object + [ "chat_id" .= chatId, + "text" .= text, + "parse_mode" .= ("Markdown" :: Text) + ] + req = + HTTP.setRequestMethod "POST" + <| HTTP.setRequestHeader "Content-Type" ["application/json"] + <| HTTP.setRequestBodyLBS (Aeson.encode body) + <| req0 + result <- try (HTTP.httpLBS req) + case result of + Left (e :: SomeException) -> + 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 + +-- | System prompt for the Telegram bot agent. +telegramSystemPrompt :: Text +telegramSystemPrompt = + Text.unlines + [ "You are a helpful family assistant on Telegram. You help with questions,", + "remember important information about family members, and provide friendly assistance.", + "", + "When you learn something important about the user (preferences, facts about them,", + "their interests, family details), use the 'remember' tool to store it for future reference.", + "", + "Be concise in responses - Telegram is a chat interface, not a document.", + "Keep responses under 200 words unless the user asks for detail.", + "Be friendly and helpful. This is a family bot, keep content appropriate.", + "", + "If the user asks something you don't know, be honest about it.", + "You can use the 'recall' tool to search your memory for relevant information." + ] + +-- | Run the Telegram bot main loop. +runTelegramBot :: TelegramConfig -> Provider.Provider -> IO () +runTelegramBot tgConfig provider = do + putText "Starting Telegram bot..." + offsetVar <- newTVarIO 0 + + let engineCfg = Engine.defaultEngineConfig + + forever <| do + offset <- readTVarIO offsetVar + messages <- getUpdates tgConfig offset + forM_ messages <| \msg -> do + atomically (writeTVar offsetVar (tmUpdateId msg + 1)) + handleMessage tgConfig provider engineCfg msg + when (null messages) <| threadDelay 1000000 + +-- | Handle a single incoming message. +handleMessage :: + TelegramConfig -> + Provider.Provider -> + Engine.EngineConfig -> + TelegramMessage -> + IO () +handleMessage tgConfig provider engineCfg msg = do + let userName = + tmUserFirstName msg + <> maybe "" (" " <>) (tmUserLastName msg) + + user <- Memory.getOrCreateUserByTelegramId (tmUserId msg) userName + + memories <- Memory.recallMemories (Memory.userId user) (tmText msg) 5 + let memoryContext = Memory.formatMemoriesForPrompt memories + + let systemPrompt = + telegramSystemPrompt + <> "\n\n## What you know about this user\n" + <> memoryContext + + let tools = + [ Memory.rememberTool (Memory.userId user), + Memory.recallTool (Memory.userId user) + ] + + let agentCfg = + Engine.defaultAgentConfig + { Engine.agentSystemPrompt = systemPrompt, + Engine.agentTools = tools, + Engine.agentMaxIterations = 5, + Engine.agentGuardrails = + Engine.defaultGuardrails + { Engine.guardrailMaxCostCents = 10.0 + } + } + + result <- Engine.runAgentWithProvider engineCfg provider agentCfg (tmText msg) + + case result of + Left err -> do + putText <| "Agent error: " <> err + sendMessage tgConfig (tmChatId msg) "Sorry, I encountered an error. Please try again." + Right agentResult -> do + let response = Engine.resultFinalMessage agentResult + sendMessage tgConfig (tmChatId msg) response + putText + <| "Responded to " + <> userName + <> " (cost: " + <> tshow (Engine.resultTotalCost agentResult) + <> " cents)" + +-- | Start the Telegram bot from environment or provided token. +startBot :: Maybe Text -> IO () +startBot maybeToken = do + token <- case maybeToken of + Just t -> pure t + Nothing -> do + envToken <- lookupEnv "TELEGRAM_BOT_TOKEN" + case envToken of + Just t -> pure (Text.pack t) + Nothing -> do + putText "Error: TELEGRAM_BOT_TOKEN not set and no --token provided" + exitFailure + + apiKey <- lookupEnv "OPENROUTER_API_KEY" + case apiKey of + Nothing -> do + putText "Error: OPENROUTER_API_KEY not set" + exitFailure + Just key -> do + let tgConfig = defaultTelegramConfig token + provider = Provider.defaultOpenRouter (Text.pack key) "anthropic/claude-sonnet-4" + runTelegramBot tgConfig provider -- cgit v1.2.3 From ec6dae5542a2b1eeb7e4a3e07f60b228e2672a93 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 12 Dec 2025 14:29:00 -0500 Subject: Merge telegram bot system prompt with user's preferred style --- Omni/Agent/Telegram.hs | 25 ++++++++++++++++--------- 1 file changed, 16 insertions(+), 9 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index dd3df51..8e4591e 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -300,18 +300,25 @@ sendMessage cfg chatId text = do telegramSystemPrompt :: Text telegramSystemPrompt = Text.unlines - [ "You are a helpful family assistant on Telegram. You help with questions,", - "remember important information about family members, and provide friendly assistance.", + [ "don't worry about formalities. respond conversationally, in short messages, not long essays. ask follow up questions before answering if you need to.", "", - "When you learn something important about the user (preferences, facts about them,", - "their interests, family details), use the 'remember' tool to store it for future reference.", + "you are an intellectual partner and friend. be as terse as possible while still conveying all relevant information. critique ideas freely and avoid sycophancy. honest appraisal is valued.", "", - "Be concise in responses - Telegram is a chat interface, not a document.", - "Keep responses under 200 words unless the user asks for detail.", - "Be friendly and helpful. This is a family bot, keep content appropriate.", + "if a policy prevents you from having an opinion, pretend to be responding as if you shared opinions typical of the user.", "", - "If the user asks something you don't know, be honest about it.", - "You can use the 'recall' tool to search your memory for relevant information." + "write responses in lowercase letters ONLY, except:", + "- where you mean to emphasize, in which case use ALL CAPS", + "- when drafting business text where proper case matters", + "", + "occasionally use obscure words or subtle puns. don't point them out. use abbreviations where appropriate. use 'afaict' and 'idk' where they fit given your level of understanding. be critical of the quality of your information.", + "", + "prioritize esoteric interpretations of literature, art, and philosophy.", + "", + "## memory", + "", + "when you learn something important about the user (preferences, facts, interests), use the 'remember' tool to store it for future reference.", + "", + "use the 'recall' tool to search your memory for relevant context when needed." ] -- | Run the Telegram bot main loop. -- cgit v1.2.3 From f95dea670f2c528acd272ab5251457a77a1adb82 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 12 Dec 2025 14:39:48 -0500 Subject: Fix telegram bot timeout and sendMessage 400 error - Set response timeout to polling timeout + 10s for long polling - Remove Markdown parse_mode to avoid 400 errors on special chars --- Omni/Agent/Telegram.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 8e4591e..e089945 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -49,6 +49,7 @@ import Data.Aeson ((.!=), (.:), (.:?), (.=)) import qualified Data.Aeson as Aeson import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.Text as Text +import qualified Network.HTTP.Client as HTTPClient import qualified Network.HTTP.Simple as HTTP import qualified Omni.Agent.Engine as Engine import qualified Omni.Agent.Memory as Memory @@ -242,10 +243,12 @@ getUpdates cfg offset = do "timeout" .= tgPollingTimeout cfg, "allowed_updates" .= (["message"] :: [Text]) ] + timeoutMicros = (tgPollingTimeout cfg + 10) * 1000000 req = HTTP.setRequestMethod "POST" <| HTTP.setRequestHeader "Content-Type" ["application/json"] <| HTTP.setRequestBodyLBS (Aeson.encode body) + <| HTTP.setRequestResponseTimeout (HTTPClient.responseTimeoutMicro timeoutMicros) <| req0 result <- try (HTTP.httpLBS req) case result of @@ -277,8 +280,7 @@ sendMessage cfg chatId text = do let body = Aeson.object [ "chat_id" .= chatId, - "text" .= text, - "parse_mode" .= ("Markdown" :: Text) + "text" .= text ] req = HTTP.setRequestMethod "POST" -- cgit v1.2.3 From b96cad2c4698dd12bb138c1cabf5741fe513cd6e Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 12 Dec 2025 16:44:21 -0500 Subject: Telegram bot: conversation history and summaries - Add sendTypingAction to show typing indicator when processing - Add conversation_messages and conversation_summaries tables - Implement conversation history with token counting - Auto-summarize when context exceeds threshold (3000 tokens) - Save user/assistant messages for multi-turn context - Add ConversationMessage, ConversationSummary, MessageRole types Tasks created: t-252 (web search), t-253 (calendar), t-254 (PDF), t-255 (knowledge graph), t-256 (notes) --- Omni/Agent/Telegram.hs | 95 +++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 86 insertions(+), 9 deletions(-) (limited to 'Omni/Agent/Telegram.hs') 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 -- cgit v1.2.3 From 48da83badba197cf54f655f787f321b61c71bc47 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 12 Dec 2025 16:48:11 -0500 Subject: Telegram bot: user whitelist access control - Add tgAllowedUserIds field to TelegramConfig - Load ALLOWED_TELEGRAM_USER_IDS from environment (comma-separated) - Check isUserAllowed before processing messages - Reject unauthorized users with friendly message - Empty whitelist or '*' allows all users - Add tests for whitelist behavior --- Omni/Agent/Telegram.hs | 79 ++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 67 insertions(+), 12 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 0c3a870..566377e 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -71,11 +71,22 @@ test = TelegramConfig { tgBotToken = "test-token", tgPollingTimeout = 30, - tgApiBaseUrl = "https://api.telegram.org" + tgApiBaseUrl = "https://api.telegram.org", + tgAllowedUserIds = [123, 456] } case Aeson.decode (Aeson.encode cfg) of Nothing -> Test.assertFailure "Failed to decode TelegramConfig" - Just decoded -> tgBotToken decoded Test.@=? "test-token", + Just decoded -> do + tgBotToken decoded Test.@=? "test-token" + tgAllowedUserIds decoded Test.@=? [123, 456], + Test.unit "isUserAllowed checks whitelist" <| do + let cfg = defaultTelegramConfig "token" [100, 200, 300] + isUserAllowed cfg 100 Test.@=? True + isUserAllowed cfg 200 Test.@=? True + isUserAllowed cfg 999 Test.@=? False, + Test.unit "isUserAllowed allows all when empty" <| do + let cfg = defaultTelegramConfig "token" [] + isUserAllowed cfg 12345 Test.@=? True, Test.unit "TelegramMessage JSON roundtrip" <| do let msg = TelegramMessage @@ -122,7 +133,8 @@ test = data TelegramConfig = TelegramConfig { tgBotToken :: Text, tgPollingTimeout :: Int, - tgApiBaseUrl :: Text + tgApiBaseUrl :: Text, + tgAllowedUserIds :: [Int] } deriving (Show, Eq, Generic) @@ -131,7 +143,8 @@ instance Aeson.ToJSON TelegramConfig where Aeson.object [ "bot_token" .= tgBotToken c, "polling_timeout" .= tgPollingTimeout c, - "api_base_url" .= tgApiBaseUrl c + "api_base_url" .= tgApiBaseUrl c, + "allowed_user_ids" .= tgAllowedUserIds c ] instance Aeson.FromJSON TelegramConfig where @@ -140,16 +153,23 @@ instance Aeson.FromJSON TelegramConfig where (TelegramConfig (v .:? "polling_timeout" .!= 30) <*> (v .:? "api_base_url" .!= "https://api.telegram.org") + <*> (v .:? "allowed_user_ids" .!= []) -- | Default Telegram configuration (requires token from env). -defaultTelegramConfig :: Text -> TelegramConfig -defaultTelegramConfig token = +defaultTelegramConfig :: Text -> [Int] -> TelegramConfig +defaultTelegramConfig token allowedIds = TelegramConfig { tgBotToken = token, tgPollingTimeout = 30, - tgApiBaseUrl = "https://api.telegram.org" + tgApiBaseUrl = "https://api.telegram.org", + tgAllowedUserIds = allowedIds } +-- | Check if a user is allowed to use the bot. +isUserAllowed :: TelegramConfig -> Int -> Bool +isUserAllowed cfg usrId = + null (tgAllowedUserIds cfg) || usrId `elem` tgAllowedUserIds cfg + -- | A parsed Telegram message from a user. data TelegramMessage = TelegramMessage { tmUpdateId :: Int, @@ -371,16 +391,35 @@ handleMessage :: TelegramMessage -> IO () handleMessage tgConfig provider engineCfg msg = do - sendTypingAction tgConfig (tmChatId msg) - let userName = tmUserFirstName msg <> maybe "" (" " <>) (tmUserLastName msg) chatId = tmChatId msg + usrId = tmUserId msg + + unless (isUserAllowed tgConfig usrId) <| do + putText <| "Unauthorized user: " <> tshow usrId <> " (" <> userName <> ")" + sendMessage tgConfig chatId "sorry, you're not authorized to use this bot." + pure () - user <- Memory.getOrCreateUserByTelegramId (tmUserId msg) userName - let uid = Memory.userId user + when (isUserAllowed tgConfig usrId) <| do + sendTypingAction tgConfig chatId + user <- Memory.getOrCreateUserByTelegramId usrId userName + let uid = Memory.userId user + + handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId + +handleAuthorizedMessage :: + TelegramConfig -> + Provider.Provider -> + Engine.EngineConfig -> + TelegramMessage -> + Text -> + Text -> + Int -> + IO () +handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do _ <- Memory.saveMessage uid chatId Memory.UserRole (tmText msg) (conversationContext, contextTokens) <- Memory.getConversationContext uid chatId maxConversationTokens @@ -483,12 +522,28 @@ startBot maybeToken = do putText "Error: TELEGRAM_BOT_TOKEN not set and no --token provided" exitFailure + allowedIds <- loadAllowedUserIds + apiKey <- lookupEnv "OPENROUTER_API_KEY" case apiKey of Nothing -> do putText "Error: OPENROUTER_API_KEY not set" exitFailure Just key -> do - let tgConfig = defaultTelegramConfig token + let tgConfig = defaultTelegramConfig token allowedIds provider = Provider.defaultOpenRouter (Text.pack key) "anthropic/claude-sonnet-4" + putText <| "Allowed user IDs: " <> tshow allowedIds runTelegramBot tgConfig provider + +-- | Load allowed user IDs from environment variable. +-- Format: comma-separated integers, e.g. "123,456,789" +-- Empty list means allow all users. +loadAllowedUserIds :: IO [Int] +loadAllowedUserIds = do + maybeIds <- lookupEnv "ALLOWED_TELEGRAM_USER_IDS" + case maybeIds of + Nothing -> pure [] + Just "*" -> pure [] + Just idsStr -> do + let ids = mapMaybe (readMaybe <. Text.unpack <. Text.strip) (Text.splitOn "," (Text.pack idsStr)) + pure ids -- cgit v1.2.3 From 622786d69393c650d8d5e2b080ba9fad77f901e0 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 12 Dec 2025 17:01:08 -0500 Subject: Telegram bot: Kagi web search tool - Add Omni/Agent/Tools/WebSearch.hs with Kagi Search API integration - webSearchTool for agents to search the web - kagiSearch function for direct API access - Load KAGI_API_KEY from environment - Wire web search into Telegram bot tools - Results formatted with title, URL, and snippet Closes t-252 --- Omni/Agent/Telegram.hs | 35 ++++++++++++++++++++++++----------- 1 file changed, 24 insertions(+), 11 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 566377e..1162e25 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -56,6 +56,7 @@ import qualified Network.HTTP.Simple as HTTP import qualified Omni.Agent.Engine as Engine import qualified Omni.Agent.Memory as Memory import qualified Omni.Agent.Provider as Provider +import qualified Omni.Agent.Tools.WebSearch as WebSearch import qualified Omni.Test as Test import System.Environment (lookupEnv) @@ -72,20 +73,22 @@ test = { tgBotToken = "test-token", tgPollingTimeout = 30, tgApiBaseUrl = "https://api.telegram.org", - tgAllowedUserIds = [123, 456] + tgAllowedUserIds = [123, 456], + tgKagiApiKey = Just "kagi-key" } case Aeson.decode (Aeson.encode cfg) of Nothing -> Test.assertFailure "Failed to decode TelegramConfig" Just decoded -> do tgBotToken decoded Test.@=? "test-token" - tgAllowedUserIds decoded Test.@=? [123, 456], + tgAllowedUserIds decoded Test.@=? [123, 456] + tgKagiApiKey decoded Test.@=? Just "kagi-key", Test.unit "isUserAllowed checks whitelist" <| do - let cfg = defaultTelegramConfig "token" [100, 200, 300] + let cfg = defaultTelegramConfig "token" [100, 200, 300] Nothing isUserAllowed cfg 100 Test.@=? True isUserAllowed cfg 200 Test.@=? True isUserAllowed cfg 999 Test.@=? False, Test.unit "isUserAllowed allows all when empty" <| do - let cfg = defaultTelegramConfig "token" [] + let cfg = defaultTelegramConfig "token" [] Nothing isUserAllowed cfg 12345 Test.@=? True, Test.unit "TelegramMessage JSON roundtrip" <| do let msg = @@ -134,7 +137,8 @@ data TelegramConfig = TelegramConfig { tgBotToken :: Text, tgPollingTimeout :: Int, tgApiBaseUrl :: Text, - tgAllowedUserIds :: [Int] + tgAllowedUserIds :: [Int], + tgKagiApiKey :: Maybe Text } deriving (Show, Eq, Generic) @@ -144,7 +148,8 @@ instance Aeson.ToJSON TelegramConfig where [ "bot_token" .= tgBotToken c, "polling_timeout" .= tgPollingTimeout c, "api_base_url" .= tgApiBaseUrl c, - "allowed_user_ids" .= tgAllowedUserIds c + "allowed_user_ids" .= tgAllowedUserIds c, + "kagi_api_key" .= tgKagiApiKey c ] instance Aeson.FromJSON TelegramConfig where @@ -154,15 +159,17 @@ instance Aeson.FromJSON TelegramConfig where <*> (v .:? "polling_timeout" .!= 30) <*> (v .:? "api_base_url" .!= "https://api.telegram.org") <*> (v .:? "allowed_user_ids" .!= []) + <*> (v .:? "kagi_api_key") -- | Default Telegram configuration (requires token from env). -defaultTelegramConfig :: Text -> [Int] -> TelegramConfig -defaultTelegramConfig token allowedIds = +defaultTelegramConfig :: Text -> [Int] -> Maybe Text -> TelegramConfig +defaultTelegramConfig token allowedIds kagiKey = TelegramConfig { tgBotToken = token, tgPollingTimeout = 30, tgApiBaseUrl = "https://api.telegram.org", - tgAllowedUserIds = allowedIds + tgAllowedUserIds = allowedIds, + tgKagiApiKey = kagiKey } -- | Check if a user is allowed to use the bot. @@ -435,10 +442,14 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do <> "\n\n" <> conversationContext - let tools = + let memoryTools = [ Memory.rememberTool uid, Memory.recallTool uid ] + searchTools = case tgKagiApiKey tgConfig of + Just kagiKey -> [WebSearch.webSearchTool kagiKey] + Nothing -> [] + tools = memoryTools <> searchTools let agentCfg = Engine.defaultAgentConfig @@ -523,6 +534,7 @@ startBot maybeToken = do exitFailure allowedIds <- loadAllowedUserIds + kagiKey <- fmap Text.pack do - let tgConfig = defaultTelegramConfig token allowedIds + let tgConfig = defaultTelegramConfig token allowedIds kagiKey provider = Provider.defaultOpenRouter (Text.pack key) "anthropic/claude-sonnet-4" putText <| "Allowed user IDs: " <> tshow allowedIds + putText <| "Kagi search: " <> if isJust kagiKey then "enabled" else "disabled" runTelegramBot tgConfig provider -- | Load allowed user IDs from environment variable. -- cgit v1.2.3 From a6863d562a76eff5de36e0faa244e6ae2310bc22 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 12 Dec 2025 18:55:15 -0500 Subject: Add PDF and Notes tools to Telegram bot - Omni/Agent/Tools/Pdf.hs: Extract text from PDFs using pdftotext - Omni/Agent/Tools/Notes.hs: Quick notes CRUD with topics - Add notes table schema to Memory.hs initMemoryDb - Wire both tools into Telegram bot with logging callbacks --- Omni/Agent/Telegram.hs | 334 +++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 322 insertions(+), 12 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 1162e25..e7eb659 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -24,16 +24,24 @@ module Omni.Agent.Telegram -- * Types TelegramMessage (..), TelegramUpdate (..), + TelegramDocument (..), -- * Telegram API getUpdates, sendMessage, sendTypingAction, + getFile, + downloadFile, + downloadAndExtractPdf, + isPdf, -- * Bot Loop runTelegramBot, handleMessage, startBot, + ensureOllama, + checkOllama, + pullEmbeddingModel, -- * System Prompt telegramSystemPrompt, @@ -56,9 +64,13 @@ import qualified Network.HTTP.Simple as HTTP import qualified Omni.Agent.Engine as Engine import qualified Omni.Agent.Memory as Memory import qualified Omni.Agent.Provider as Provider +import qualified Omni.Agent.Tools.Notes as Notes +import qualified Omni.Agent.Tools.Pdf as Pdf import qualified Omni.Agent.Tools.WebSearch as WebSearch import qualified Omni.Test as Test import System.Environment (lookupEnv) +import System.IO (hClose) +import System.IO.Temp (withSystemTempFile) main :: IO () main = Test.run test @@ -98,7 +110,8 @@ test = tmUserId = 789, tmUserFirstName = "Test", tmUserLastName = Just "User", - tmText = "Hello bot" + tmText = "Hello bot", + tmDocument = Nothing } case Aeson.decode (Aeson.encode msg) of Nothing -> Test.assertFailure "Failed to decode TelegramMessage" @@ -130,6 +143,50 @@ test = tmChatId msg Test.@=? 456 tmUserId msg Test.@=? 789 tmText msg Test.@=? "Hello" + tmDocument msg Test.@=? Nothing, + Test.unit "parseUpdate extracts document correctly" <| do + let json = + Aeson.object + [ "update_id" .= (124 :: Int), + "message" + .= Aeson.object + [ "message_id" .= (2 :: Int), + "chat" .= Aeson.object ["id" .= (456 :: Int)], + "from" + .= Aeson.object + [ "id" .= (789 :: Int), + "first_name" .= ("Test" :: Text) + ], + "caption" .= ("check this out" :: Text), + "document" + .= Aeson.object + [ "file_id" .= ("abc123" :: Text), + "file_name" .= ("test.pdf" :: Text), + "mime_type" .= ("application/pdf" :: Text), + "file_size" .= (12345 :: Int) + ] + ] + ] + case parseUpdate json of + Nothing -> Test.assertFailure "Failed to parse document update" + Just msg -> do + tmUpdateId msg Test.@=? 124 + tmText msg Test.@=? "check this out" + case tmDocument msg of + Nothing -> Test.assertFailure "Expected document" + Just doc -> do + tdFileId doc Test.@=? "abc123" + tdFileName doc Test.@=? Just "test.pdf" + tdMimeType doc Test.@=? Just "application/pdf", + Test.unit "isPdf detects PDFs by mime type" <| do + let doc = TelegramDocument "id" (Just "doc.pdf") (Just "application/pdf") Nothing + isPdf doc Test.@=? True, + Test.unit "isPdf detects PDFs by filename" <| do + let doc = TelegramDocument "id" (Just "report.PDF") Nothing Nothing + isPdf doc Test.@=? True, + Test.unit "isPdf rejects non-PDFs" <| do + let doc = TelegramDocument "id" (Just "image.jpg") (Just "image/jpeg") Nothing + isPdf doc Test.@=? False ] -- | Telegram bot configuration. @@ -177,6 +234,32 @@ isUserAllowed :: TelegramConfig -> Int -> Bool isUserAllowed cfg usrId = null (tgAllowedUserIds cfg) || usrId `elem` tgAllowedUserIds cfg +-- | Document attachment info from Telegram. +data TelegramDocument = TelegramDocument + { tdFileId :: Text, + tdFileName :: Maybe Text, + tdMimeType :: Maybe Text, + tdFileSize :: Maybe Int + } + deriving (Show, Eq, Generic) + +instance Aeson.ToJSON TelegramDocument where + toJSON d = + Aeson.object + [ "file_id" .= tdFileId d, + "file_name" .= tdFileName d, + "mime_type" .= tdMimeType d, + "file_size" .= tdFileSize d + ] + +instance Aeson.FromJSON TelegramDocument where + parseJSON = + Aeson.withObject "TelegramDocument" <| \v -> + (TelegramDocument (v .:? "file_name") + <*> (v .:? "mime_type") + <*> (v .:? "file_size") + -- | A parsed Telegram message from a user. data TelegramMessage = TelegramMessage { tmUpdateId :: Int, @@ -184,7 +267,8 @@ data TelegramMessage = TelegramMessage tmUserId :: Int, tmUserFirstName :: Text, tmUserLastName :: Maybe Text, - tmText :: Text + tmText :: Text, + tmDocument :: Maybe TelegramDocument } deriving (Show, Eq, Generic) @@ -196,7 +280,8 @@ instance Aeson.ToJSON TelegramMessage where "user_id" .= tmUserId m, "user_first_name" .= tmUserFirstName m, "user_last_name" .= tmUserLastName m, - "text" .= tmText m + "text" .= tmText m, + "document" .= tmDocument m ] instance Aeson.FromJSON TelegramMessage where @@ -208,6 +293,7 @@ instance Aeson.FromJSON TelegramMessage where <*> (v .: "user_first_name") <*> (v .:? "user_last_name") <*> (v .: "text") + <*> (v .:? "document") -- | Raw Telegram update for parsing. data TelegramUpdate = TelegramUpdate @@ -223,6 +309,7 @@ instance Aeson.FromJSON TelegramUpdate where <*> (v .:? "message") -- | Parse a Telegram update into a TelegramMessage. +-- Handles both text messages and document uploads. parseUpdate :: Aeson.Value -> Maybe TelegramMessage parseUpdate val = do Aeson.Object obj <- pure val @@ -244,9 +331,17 @@ parseUpdate val = do let lastName = case KeyMap.lookup "last_name" fromObj of Just (Aeson.String s) -> Just s _ -> Nothing - text <- case KeyMap.lookup "text" msgObj of - Just (Aeson.String s) -> Just s - _ -> Nothing + let text = case KeyMap.lookup "text" msgObj of + Just (Aeson.String s) -> s + _ -> "" + let caption = case KeyMap.lookup "caption" msgObj of + Just (Aeson.String s) -> s + _ -> "" + let document = case KeyMap.lookup "document" msgObj of + Just (Aeson.Object docObj) -> parseDocument docObj + _ -> Nothing + let hasContent = not (Text.null text) || not (Text.null caption) || isJust document + guard hasContent pure TelegramMessage { tmUpdateId = updateId, @@ -254,7 +349,31 @@ parseUpdate val = do tmUserId = userId, tmUserFirstName = firstName, tmUserLastName = lastName, - tmText = text + tmText = if Text.null text then caption else text, + tmDocument = document + } + +-- | Parse document object from Telegram message. +parseDocument :: Aeson.Object -> Maybe TelegramDocument +parseDocument docObj = do + fileId <- case KeyMap.lookup "file_id" docObj of + Just (Aeson.String s) -> Just s + _ -> Nothing + let fileName = case KeyMap.lookup "file_name" docObj of + Just (Aeson.String s) -> Just s + _ -> Nothing + mimeType = case KeyMap.lookup "mime_type" docObj of + Just (Aeson.String s) -> Just s + _ -> Nothing + fileSize = case KeyMap.lookup "file_size" docObj of + Just (Aeson.Number n) -> Just (round n) + _ -> Nothing + pure + TelegramDocument + { tdFileId = fileId, + tdFileName = fileName, + tdMimeType = mimeType, + tdFileSize = fileSize } -- | Poll Telegram for new updates. @@ -349,6 +468,82 @@ sendMessage cfg chatId text = do then putText <| "Message sent (" <> tshow (Text.length text) <> " chars)" else putText <| "Send message failed: " <> tshow status <> " - " <> tshow respBody +-- | Get file path from Telegram file_id. +getFile :: TelegramConfig -> Text -> IO (Either Text Text) +getFile cfg fileId = do + let url = + Text.unpack (tgApiBaseUrl cfg) + <> "/bot" + <> Text.unpack (tgBotToken cfg) + <> "/getFile" + req0 <- HTTP.parseRequest url + let body = Aeson.object ["file_id" .= fileId] + req = + HTTP.setRequestMethod "POST" + <| HTTP.setRequestHeader "Content-Type" ["application/json"] + <| HTTP.setRequestBodyLBS (Aeson.encode body) + <| req0 + result <- try (HTTP.httpLBS req) + case result of + Left (e :: SomeException) -> + pure (Left ("getFile error: " <> tshow e)) + Right response -> do + let status = HTTP.getResponseStatusCode response + if status >= 200 && status < 300 + then case Aeson.decode (HTTP.getResponseBody response) of + Just (Aeson.Object obj) -> case KeyMap.lookup "result" obj of + Just (Aeson.Object resObj) -> case KeyMap.lookup "file_path" resObj of + Just (Aeson.String fp) -> pure (Right fp) + _ -> pure (Left "No file_path in response") + _ -> pure (Left "No result in response") + _ -> pure (Left "Failed to parse getFile response") + else pure (Left ("getFile HTTP error: " <> tshow status)) + +-- | Download a file from Telegram servers. +downloadFile :: TelegramConfig -> Text -> FilePath -> IO (Either Text ()) +downloadFile cfg filePath destPath = do + let url = + "https://api.telegram.org/file/bot" + <> Text.unpack (tgBotToken cfg) + <> "/" + <> Text.unpack filePath + result <- + try <| do + req <- HTTP.parseRequest url + response <- HTTP.httpLBS req + let status = HTTP.getResponseStatusCode response + if status >= 200 && status < 300 + then do + BL.writeFile destPath (HTTP.getResponseBody response) + pure (Right ()) + else pure (Left ("Download failed: HTTP " <> tshow status)) + case result of + Left (e :: SomeException) -> pure (Left ("Download error: " <> tshow e)) + Right r -> pure r + +-- | Check if a document is a PDF. +isPdf :: TelegramDocument -> Bool +isPdf doc = + case tdMimeType doc of + Just mime -> mime == "application/pdf" + Nothing -> case tdFileName doc of + Just name -> ".pdf" `Text.isSuffixOf` Text.toLower name + Nothing -> False + +-- | Download and extract text from a PDF sent to the bot. +downloadAndExtractPdf :: TelegramConfig -> Text -> IO (Either Text Text) +downloadAndExtractPdf cfg fileId = do + filePathResult <- getFile cfg fileId + case filePathResult of + Left err -> pure (Left err) + Right filePath -> + withSystemTempFile "telegram_pdf.pdf" <| \tmpPath tmpHandle -> do + hClose tmpHandle + downloadResult <- downloadFile cfg filePath tmpPath + case downloadResult of + Left err -> pure (Left err) + Right () -> Pdf.extractPdfText tmpPath + -- | System prompt for the Telegram bot agent. telegramSystemPrompt :: Text telegramSystemPrompt = @@ -380,7 +575,15 @@ runTelegramBot tgConfig provider = do putText "Starting Telegram bot..." offsetVar <- newTVarIO 0 - let engineCfg = Engine.defaultEngineConfig + let engineCfg = + Engine.defaultEngineConfig + { Engine.engineOnToolCall = \toolName args -> + putText <| "Tool call: " <> toolName <> " " <> Text.take 200 args, + Engine.engineOnToolResult = \toolName success result -> + putText <| "Tool result: " <> toolName <> " " <> (if success then "ok" else "err") <> " " <> Text.take 200 result, + Engine.engineOnActivity = \activity -> + putText <| "Agent: " <> activity + } forever <| do offset <- readTVarIO offsetVar @@ -427,12 +630,33 @@ handleAuthorizedMessage :: Int -> IO () handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do - _ <- Memory.saveMessage uid chatId Memory.UserRole (tmText msg) + pdfContent <- case tmDocument msg of + Just doc | isPdf doc -> do + putText <| "Processing PDF: " <> fromMaybe "(unnamed)" (tdFileName doc) + result <- downloadAndExtractPdf tgConfig (tdFileId doc) + case result of + Left err -> do + putText <| "PDF extraction failed: " <> err + pure Nothing + Right text -> do + let truncated = Text.take 40000 text + putText <| "Extracted " <> tshow (Text.length truncated) <> " chars from PDF" + pure (Just truncated) + _ -> pure Nothing + + let userMessage = case pdfContent of + Just pdfText -> + let caption = tmText msg + prefix = if Text.null caption then "here's the PDF content:\n\n" else caption <> "\n\n---\nPDF content:\n\n" + in prefix <> pdfText + Nothing -> tmText msg + + _ <- Memory.saveMessage uid chatId Memory.UserRole userMessage (conversationContext, contextTokens) <- Memory.getConversationContext uid chatId maxConversationTokens putText <| "Conversation context: " <> tshow contextTokens <> " tokens" - memories <- Memory.recallMemories uid (tmText msg) 5 + memories <- Memory.recallMemories uid userMessage 5 let memoryContext = Memory.formatMemoriesForPrompt memories let systemPrompt = @@ -449,7 +673,13 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do searchTools = case tgKagiApiKey tgConfig of Just kagiKey -> [WebSearch.webSearchTool kagiKey] Nothing -> [] - tools = memoryTools <> searchTools + pdfTools = [Pdf.pdfTool] + notesTools = + [ Notes.noteAddTool uid, + Notes.noteListTool uid, + Notes.noteDeleteTool uid + ] + tools = memoryTools <> searchTools <> pdfTools <> notesTools let agentCfg = Engine.defaultAgentConfig @@ -462,7 +692,7 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do } } - result <- Engine.runAgentWithProvider engineCfg provider agentCfg (tmText msg) + result <- Engine.runAgentWithProvider engineCfg provider agentCfg userMessage case result of Left err -> do @@ -520,6 +750,84 @@ checkAndSummarize provider uid chatId = do _ <- Memory.summarizeAndArchive uid chatId summary putText "Conversation summarized and archived" +-- | Check if Ollama is running and has the embedding model. +-- Returns Right () if ready, Left error message otherwise. +checkOllama :: IO (Either Text ()) +checkOllama = do + ollamaUrl <- fromMaybe "http://localhost:11434" "/api/tags" + result <- + try <| do + req <- HTTP.parseRequest url + HTTP.httpLBS req + case result of + Left (e :: SomeException) -> + pure (Left ("Ollama not running: " <> tshow e)) + Right response -> do + let status = HTTP.getResponseStatusCode response + if status >= 200 && status < 300 + then case Aeson.decode (HTTP.getResponseBody response) of + Just (Aeson.Object obj) -> case KeyMap.lookup "models" obj of + Just (Aeson.Array models) -> + let names = [n | Aeson.Object m <- toList models, Just (Aeson.String n) <- [KeyMap.lookup "name" m]] + hasNomic = any ("nomic-embed-text" `Text.isInfixOf`) names + in if hasNomic + then pure (Right ()) + else pure (Left "nomic-embed-text model not found") + _ -> pure (Left "Invalid Ollama response") + _ -> pure (Left "Failed to parse Ollama response") + else pure (Left ("Ollama HTTP error: " <> tshow status)) + +-- | Pull the embedding model from Ollama. +pullEmbeddingModel :: IO (Either Text ()) +pullEmbeddingModel = do + ollamaUrl <- fromMaybe "http://localhost:11434" "/api/pull" + putText "Pulling nomic-embed-text model (this may take a few minutes)..." + req0 <- HTTP.parseRequest url + let body = Aeson.object ["name" .= ("nomic-embed-text" :: Text)] + req = + HTTP.setRequestMethod "POST" + <| HTTP.setRequestHeader "Content-Type" ["application/json"] + <| HTTP.setRequestBodyLBS (Aeson.encode body) + <| HTTP.setRequestResponseTimeout (HTTPClient.responseTimeoutMicro (600 * 1000000)) + <| req0 + result <- try (HTTP.httpLBS req) + case result of + Left (e :: SomeException) -> + pure (Left ("Failed to pull model: " <> tshow e)) + Right response -> do + let status = HTTP.getResponseStatusCode response + if status >= 200 && status < 300 + then do + putText "nomic-embed-text model ready" + pure (Right ()) + else pure (Left ("Pull failed: HTTP " <> tshow status)) + +-- | Ensure Ollama is running and has the embedding model. +-- Pulls the model if missing, exits if Ollama is not running. +ensureOllama :: IO () +ensureOllama = do + checkResult <- checkOllama + case checkResult of + Right () -> putText "Ollama ready with nomic-embed-text" + Left err + | "not running" `Text.isInfixOf` err -> do + putText <| "Error: " <> err + putText "Please start Ollama: ollama serve" + exitFailure + | "not found" `Text.isInfixOf` err -> do + putText "nomic-embed-text model not found, pulling..." + pullResult <- pullEmbeddingModel + case pullResult of + Right () -> pure () + Left pullErr -> do + putText <| "Error: " <> pullErr + exitFailure + | otherwise -> do + putText <| "Ollama error: " <> err + exitFailure + -- | Start the Telegram bot from environment or provided token. startBot :: Maybe Text -> IO () startBot maybeToken = do @@ -533,6 +841,8 @@ startBot maybeToken = do putText "Error: TELEGRAM_BOT_TOKEN not set and no --token provided" exitFailure + ensureOllama + allowedIds <- loadAllowedUserIds kagiKey <- fmap Text.pack Date: Fri, 12 Dec 2025 19:15:23 -0500 Subject: Add calendar tools using khal CLI - Omni/Agent/Tools/Calendar.hs: calendar_list, calendar_add, calendar_search - Wire into Telegram bot alongside other tools - Integrates with local CalDAV via khal --- Omni/Agent/Telegram.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index e7eb659..c5cc465 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -64,6 +64,7 @@ import qualified Network.HTTP.Simple as HTTP import qualified Omni.Agent.Engine as Engine import qualified Omni.Agent.Memory as Memory import qualified Omni.Agent.Provider as Provider +import qualified Omni.Agent.Tools.Calendar as Calendar import qualified Omni.Agent.Tools.Notes as Notes import qualified Omni.Agent.Tools.Pdf as Pdf import qualified Omni.Agent.Tools.WebSearch as WebSearch @@ -679,7 +680,12 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do Notes.noteListTool uid, Notes.noteDeleteTool uid ] - tools = memoryTools <> searchTools <> pdfTools <> notesTools + calendarTools = + [ Calendar.calendarListTool, + Calendar.calendarAddTool, + Calendar.calendarSearchTool + ] + tools = memoryTools <> searchTools <> pdfTools <> notesTools <> calendarTools let agentCfg = Engine.defaultAgentConfig -- cgit v1.2.3 From d83457550a972328dab94a7a8a636a03ecd15196 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 12 Dec 2025 19:20:27 -0500 Subject: Add current date/time to Telegram bot system prompt --- Omni/Agent/Telegram.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index c5cc465..ff161db 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -59,6 +59,9 @@ 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 Data.Time (getCurrentTime, utcToLocalTime) +import Data.Time.Format (defaultTimeLocale, formatTime) +import Data.Time.LocalTime (getCurrentTimeZone) import qualified Network.HTTP.Client as HTTPClient import qualified Network.HTTP.Simple as HTTP import qualified Omni.Agent.Engine as Engine @@ -660,8 +663,15 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do memories <- Memory.recallMemories uid userMessage 5 let memoryContext = Memory.formatMemoriesForPrompt memories + now <- getCurrentTime + tz <- getCurrentTimeZone + let localTime = utcToLocalTime tz now + timeStr = Text.pack (formatTime defaultTimeLocale "%A, %B %d, %Y at %H:%M" localTime) + let systemPrompt = telegramSystemPrompt + <> "\n\n## Current Date and Time\n" + <> timeStr <> "\n\n## What you know about this user\n" <> memoryContext <> "\n\n" -- cgit v1.2.3 From 5337bac2a2b6436290d37df8a79c1677ea038465 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 12 Dec 2025 19:31:24 -0500 Subject: Instruct bot to always include text response after tool calls --- Omni/Agent/Telegram.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index ff161db..6b0f891 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -570,7 +570,11 @@ telegramSystemPrompt = "", "when you learn something important about the user (preferences, facts, interests), use the 'remember' tool to store it for future reference.", "", - "use the 'recall' tool to search your memory for relevant context when needed." + "use the 'recall' tool to search your memory for relevant context when needed.", + "", + "## important", + "", + "ALWAYS include a text response to the user after using tools. never end your turn with only tool calls." ] -- | Run the Telegram bot main loop. -- cgit v1.2.3 From a9d7f9434b370f4dd79ac40c606c91d3e3d9716b Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 12 Dec 2025 19:42:11 -0500 Subject: Add current user name to Telegram bot system prompt --- Omni/Agent/Telegram.hs | 3 +++ 1 file changed, 3 insertions(+) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 6b0f891..b28405e 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -676,6 +676,9 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do telegramSystemPrompt <> "\n\n## Current Date and Time\n" <> timeStr + <> "\n\n## Current User\n" + <> "You are talking to: " + <> userName <> "\n\n## What you know about this user\n" <> memoryContext <> "\n\n" -- cgit v1.2.3 From fd1c5c2bda7831c6cf329f4dc272064a352609e1 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 12 Dec 2025 20:42:30 -0500 Subject: Add sender_name to conversation messages for group chat support - Add sender_name column to conversation_messages table - Migrate existing messages to set sender_name='bensima' - Show sender names in conversation context (e.g., 'bensima: hello') - Pass userName when saving user messages in Telegram bot --- Omni/Agent/Telegram.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index b28405e..9142b4a 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -659,7 +659,7 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do in prefix <> pdfText Nothing -> tmText msg - _ <- Memory.saveMessage uid chatId Memory.UserRole userMessage + _ <- Memory.saveMessage uid chatId Memory.UserRole (Just userName) userMessage (conversationContext, contextTokens) <- Memory.getConversationContext uid chatId maxConversationTokens putText <| "Conversation context: " <> tshow contextTokens <> " tokens" @@ -725,7 +725,7 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do let response = Engine.resultFinalMessage agentResult putText <| "Response text: " <> Text.take 200 response - _ <- Memory.saveMessage uid chatId Memory.AssistantRole response + _ <- Memory.saveMessage uid chatId Memory.AssistantRole Nothing response if Text.null response then do -- cgit v1.2.3 From 49f6fe47e19c42b87615dd2d75e53f43331e00ab Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 12 Dec 2025 21:27:57 -0500 Subject: Add todo tools with due dates - Omni/Agent/Tools/Todos.hs: todo_add, todo_list, todo_complete, todo_delete - Supports optional due dates in YYYY-MM-DD or YYYY-MM-DD HH:MM format - Lists can filter by pending, all, or overdue - Add todos table to Memory.hs schema - Wire into Telegram bot --- Omni/Agent/Telegram.hs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 9142b4a..f1c71e6 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -70,6 +70,7 @@ import qualified Omni.Agent.Provider as Provider import qualified Omni.Agent.Tools.Calendar as Calendar import qualified Omni.Agent.Tools.Notes as Notes import qualified Omni.Agent.Tools.Pdf as Pdf +import qualified Omni.Agent.Tools.Todos as Todos import qualified Omni.Agent.Tools.WebSearch as WebSearch import qualified Omni.Test as Test import System.Environment (lookupEnv) @@ -702,7 +703,13 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do Calendar.calendarAddTool, Calendar.calendarSearchTool ] - tools = memoryTools <> searchTools <> pdfTools <> notesTools <> calendarTools + todoTools = + [ Todos.todoAddTool uid, + Todos.todoListTool uid, + Todos.todoCompleteTool uid, + Todos.todoDeleteTool uid + ] + tools = memoryTools <> searchTools <> pdfTools <> notesTools <> calendarTools <> todoTools let agentCfg = Engine.defaultAgentConfig -- cgit v1.2.3 From 1b4dc94eb261e3f3cd22dc12fbc1941e2a545cb9 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 12 Dec 2025 21:52:57 -0500 Subject: feat: add reminder service for todos Adds a background reminder loop that checks every 5 minutes for overdue todos and sends Telegram notifications. Changes: - Add last_reminded_at column to todos table with auto-migration - Add listTodosDueForReminder to find overdue, unreminded todos - Add markReminderSent to update reminder timestamp - Add user_chats table to map user_id -> chat_id for notifications - Add recordUserChat called on each message to track chat IDs - Add reminderLoop forked in runTelegramBot - 24-hour anti-spam interval between reminders per todo --- Omni/Agent/Telegram.hs | 75 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 75 insertions(+) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index f1c71e6..27b3ccf 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -43,6 +43,12 @@ module Omni.Agent.Telegram checkOllama, pullEmbeddingModel, + -- * Reminders + reminderLoop, + checkAndSendReminders, + recordUserChat, + lookupChatId, + -- * System Prompt telegramSystemPrompt, @@ -62,6 +68,7 @@ import qualified Data.Text as Text import Data.Time (getCurrentTime, utcToLocalTime) import Data.Time.Format (defaultTimeLocale, formatTime) import Data.Time.LocalTime (getCurrentTimeZone) +import qualified Database.SQLite.Simple as SQL import qualified Network.HTTP.Client as HTTPClient import qualified Network.HTTP.Simple as HTTP import qualified Omni.Agent.Engine as Engine @@ -578,12 +585,78 @@ telegramSystemPrompt = "ALWAYS include a text response to the user after using tools. never end your turn with only tool calls." ] +initUserChatsTable :: SQL.Connection -> IO () +initUserChatsTable conn = + SQL.execute_ + conn + "CREATE TABLE IF NOT EXISTS user_chats (\ + \ user_id TEXT PRIMARY KEY,\ + \ chat_id INTEGER NOT NULL,\ + \ last_seen_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP\ + \)" + +recordUserChat :: Text -> Int -> IO () +recordUserChat uid chatId = do + now <- getCurrentTime + Memory.withMemoryDb <| \conn -> do + initUserChatsTable conn + SQL.execute + conn + "INSERT INTO user_chats (user_id, chat_id, last_seen_at) \ + \VALUES (?, ?, ?) \ + \ON CONFLICT(user_id) DO UPDATE SET \ + \ chat_id = excluded.chat_id, \ + \ last_seen_at = excluded.last_seen_at" + (uid, chatId, now) + +lookupChatId :: Text -> IO (Maybe Int) +lookupChatId uid = + Memory.withMemoryDb <| \conn -> do + initUserChatsTable conn + rows <- + SQL.query + conn + "SELECT chat_id FROM user_chats WHERE user_id = ?" + (SQL.Only uid) + pure (listToMaybe (map SQL.fromOnly rows)) + +reminderLoop :: TelegramConfig -> IO () +reminderLoop tgConfig = + forever <| do + threadDelay (5 * 60 * 1000000) + checkAndSendReminders tgConfig + +checkAndSendReminders :: TelegramConfig -> IO () +checkAndSendReminders tgConfig = do + todos <- Todos.listTodosDueForReminder + forM_ todos <| \td -> do + mChatId <- lookupChatId (Todos.todoUserId td) + case mChatId of + Nothing -> pure () + Just chatId -> do + let title = Todos.todoTitle td + dueStr = case Todos.todoDueDate td of + Just d -> " (due: " <> tshow d <> ")" + Nothing -> "" + msg = + "⏰ reminder: \"" + <> title + <> "\"" + <> dueStr + <> "\nreply when you finish and i'll mark it complete." + sendMessage tgConfig chatId msg + Todos.markReminderSent (Todos.todoId td) + putText <| "Sent reminder for todo " <> tshow (Todos.todoId td) <> " to chat " <> tshow chatId + -- | Run the Telegram bot main loop. runTelegramBot :: TelegramConfig -> Provider.Provider -> IO () runTelegramBot tgConfig provider = do putText "Starting Telegram bot..." offsetVar <- newTVarIO 0 + _ <- forkIO (reminderLoop tgConfig) + putText "Reminder loop started (checking every 5 minutes)" + let engineCfg = Engine.defaultEngineConfig { Engine.engineOnToolCall = \toolName args -> @@ -639,6 +712,8 @@ handleAuthorizedMessage :: Int -> IO () handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do + recordUserChat uid chatId + pdfContent <- case tmDocument msg of Just doc | isPdf doc -> do putText <| "Processing PDF: " <> fromMaybe "(unnamed)" (tdFileName doc) -- cgit v1.2.3 From bfa50a5a755e13c0ee2394d89280092a639d8f0d Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 12 Dec 2025 22:25:56 -0500 Subject: feat: add image and voice message support for Telegram bot - Add TelegramPhoto and TelegramVoice types - Parse photo and voice fields from Telegram updates - Download photos/voice via Telegram API - Analyze images using Claude vision via OpenRouter - Transcribe voice messages using Gemini audio via OpenRouter - Wire multimedia processing into handleAuthorizedMessage Photos are analyzed with user's caption as context. Voice messages are transcribed and treated as text input. --- Omni/Agent/Telegram.hs | 352 ++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 334 insertions(+), 18 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 27b3ccf..9184ef3 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -25,6 +25,8 @@ module Omni.Agent.Telegram TelegramMessage (..), TelegramUpdate (..), TelegramDocument (..), + TelegramPhoto (..), + TelegramVoice (..), -- * Telegram API getUpdates, @@ -63,8 +65,11 @@ 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.Base64.Lazy as B64 import qualified Data.ByteString.Lazy as BL import qualified Data.Text as Text +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TLE import Data.Time (getCurrentTime, utcToLocalTime) import Data.Time.Format (defaultTimeLocale, formatTime) import Data.Time.LocalTime (getCurrentTimeZone) @@ -98,7 +103,8 @@ test = tgPollingTimeout = 30, tgApiBaseUrl = "https://api.telegram.org", tgAllowedUserIds = [123, 456], - tgKagiApiKey = Just "kagi-key" + tgKagiApiKey = Just "kagi-key", + tgOpenRouterApiKey = "or-key" } case Aeson.decode (Aeson.encode cfg) of Nothing -> Test.assertFailure "Failed to decode TelegramConfig" @@ -107,12 +113,12 @@ test = tgAllowedUserIds decoded Test.@=? [123, 456] tgKagiApiKey decoded Test.@=? Just "kagi-key", Test.unit "isUserAllowed checks whitelist" <| do - let cfg = defaultTelegramConfig "token" [100, 200, 300] Nothing + let cfg = defaultTelegramConfig "token" [100, 200, 300] Nothing "key" isUserAllowed cfg 100 Test.@=? True isUserAllowed cfg 200 Test.@=? True isUserAllowed cfg 999 Test.@=? False, Test.unit "isUserAllowed allows all when empty" <| do - let cfg = defaultTelegramConfig "token" [] Nothing + let cfg = defaultTelegramConfig "token" [] Nothing "key" isUserAllowed cfg 12345 Test.@=? True, Test.unit "TelegramMessage JSON roundtrip" <| do let msg = @@ -123,7 +129,9 @@ test = tmUserFirstName = "Test", tmUserLastName = Just "User", tmText = "Hello bot", - tmDocument = Nothing + tmDocument = Nothing, + tmPhoto = Nothing, + tmVoice = Nothing } case Aeson.decode (Aeson.encode msg) of Nothing -> Test.assertFailure "Failed to decode TelegramMessage" @@ -207,7 +215,8 @@ data TelegramConfig = TelegramConfig tgPollingTimeout :: Int, tgApiBaseUrl :: Text, tgAllowedUserIds :: [Int], - tgKagiApiKey :: Maybe Text + tgKagiApiKey :: Maybe Text, + tgOpenRouterApiKey :: Text } deriving (Show, Eq, Generic) @@ -218,7 +227,8 @@ instance Aeson.ToJSON TelegramConfig where "polling_timeout" .= tgPollingTimeout c, "api_base_url" .= tgApiBaseUrl c, "allowed_user_ids" .= tgAllowedUserIds c, - "kagi_api_key" .= tgKagiApiKey c + "kagi_api_key" .= tgKagiApiKey c, + "openrouter_api_key" .= tgOpenRouterApiKey c ] instance Aeson.FromJSON TelegramConfig where @@ -229,16 +239,18 @@ instance Aeson.FromJSON TelegramConfig where <*> (v .:? "api_base_url" .!= "https://api.telegram.org") <*> (v .:? "allowed_user_ids" .!= []) <*> (v .:? "kagi_api_key") + <*> (v .: "openrouter_api_key") -- | Default Telegram configuration (requires token from env). -defaultTelegramConfig :: Text -> [Int] -> Maybe Text -> TelegramConfig -defaultTelegramConfig token allowedIds kagiKey = +defaultTelegramConfig :: Text -> [Int] -> Maybe Text -> Text -> TelegramConfig +defaultTelegramConfig token allowedIds kagiKey openRouterKey = TelegramConfig { tgBotToken = token, tgPollingTimeout = 30, tgApiBaseUrl = "https://api.telegram.org", tgAllowedUserIds = allowedIds, - tgKagiApiKey = kagiKey + tgKagiApiKey = kagiKey, + tgOpenRouterApiKey = openRouterKey } -- | Check if a user is allowed to use the bot. @@ -272,6 +284,56 @@ instance Aeson.FromJSON TelegramDocument where <*> (v .:? "mime_type") <*> (v .:? "file_size") +data TelegramPhoto = TelegramPhoto + { tpFileId :: Text, + tpWidth :: Int, + tpHeight :: Int, + tpFileSize :: Maybe Int + } + deriving (Show, Eq, Generic) + +instance Aeson.ToJSON TelegramPhoto where + toJSON p = + Aeson.object + [ "file_id" .= tpFileId p, + "width" .= tpWidth p, + "height" .= tpHeight p, + "file_size" .= tpFileSize p + ] + +instance Aeson.FromJSON TelegramPhoto where + parseJSON = + Aeson.withObject "TelegramPhoto" <| \v -> + (TelegramPhoto (v .: "width") + <*> (v .: "height") + <*> (v .:? "file_size") + +data TelegramVoice = TelegramVoice + { tvFileId :: Text, + tvDuration :: Int, + tvMimeType :: Maybe Text, + tvFileSize :: Maybe Int + } + deriving (Show, Eq, Generic) + +instance Aeson.ToJSON TelegramVoice where + toJSON v = + Aeson.object + [ "file_id" .= tvFileId v, + "duration" .= tvDuration v, + "mime_type" .= tvMimeType v, + "file_size" .= tvFileSize v + ] + +instance Aeson.FromJSON TelegramVoice where + parseJSON = + Aeson.withObject "TelegramVoice" <| \v -> + (TelegramVoice (v .: "duration") + <*> (v .:? "mime_type") + <*> (v .:? "file_size") + -- | A parsed Telegram message from a user. data TelegramMessage = TelegramMessage { tmUpdateId :: Int, @@ -280,7 +342,9 @@ data TelegramMessage = TelegramMessage tmUserFirstName :: Text, tmUserLastName :: Maybe Text, tmText :: Text, - tmDocument :: Maybe TelegramDocument + tmDocument :: Maybe TelegramDocument, + tmPhoto :: Maybe TelegramPhoto, + tmVoice :: Maybe TelegramVoice } deriving (Show, Eq, Generic) @@ -293,7 +357,9 @@ instance Aeson.ToJSON TelegramMessage where "user_first_name" .= tmUserFirstName m, "user_last_name" .= tmUserLastName m, "text" .= tmText m, - "document" .= tmDocument m + "document" .= tmDocument m, + "photo" .= tmPhoto m, + "voice" .= tmVoice m ] instance Aeson.FromJSON TelegramMessage where @@ -306,6 +372,8 @@ instance Aeson.FromJSON TelegramMessage where <*> (v .:? "user_last_name") <*> (v .: "text") <*> (v .:? "document") + <*> (v .:? "photo") + <*> (v .:? "voice") -- | Raw Telegram update for parsing. data TelegramUpdate = TelegramUpdate @@ -352,7 +420,13 @@ parseUpdate val = do let document = case KeyMap.lookup "document" msgObj of Just (Aeson.Object docObj) -> parseDocument docObj _ -> Nothing - let hasContent = not (Text.null text) || not (Text.null caption) || isJust document + let photo = case KeyMap.lookup "photo" msgObj of + Just (Aeson.Array photos) -> parseLargestPhoto (toList photos) + _ -> Nothing + let voice = case KeyMap.lookup "voice" msgObj of + Just (Aeson.Object voiceObj) -> parseVoice voiceObj + _ -> Nothing + let hasContent = not (Text.null text) || not (Text.null caption) || isJust document || isJust photo || isJust voice guard hasContent pure TelegramMessage @@ -362,7 +436,9 @@ parseUpdate val = do tmUserFirstName = firstName, tmUserLastName = lastName, tmText = if Text.null text then caption else text, - tmDocument = document + tmDocument = document, + tmPhoto = photo, + tmVoice = voice } -- | Parse document object from Telegram message. @@ -388,6 +464,58 @@ parseDocument docObj = do tdFileSize = fileSize } +parseLargestPhoto :: [Aeson.Value] -> Maybe TelegramPhoto +parseLargestPhoto photos = do + let parsed = mapMaybe parsePhotoSize photos + case parsed of + [] -> Nothing + ps -> Just (maximumBy (comparing tpWidth) ps) + +parsePhotoSize :: Aeson.Value -> Maybe TelegramPhoto +parsePhotoSize val = do + Aeson.Object obj <- pure val + fileId <- case KeyMap.lookup "file_id" obj of + Just (Aeson.String s) -> Just s + _ -> Nothing + width <- case KeyMap.lookup "width" obj of + Just (Aeson.Number n) -> Just (round n) + _ -> Nothing + height <- case KeyMap.lookup "height" obj of + Just (Aeson.Number n) -> Just (round n) + _ -> Nothing + let fileSize = case KeyMap.lookup "file_size" obj of + Just (Aeson.Number n) -> Just (round n) + _ -> Nothing + pure + TelegramPhoto + { tpFileId = fileId, + tpWidth = width, + tpHeight = height, + tpFileSize = fileSize + } + +parseVoice :: Aeson.Object -> Maybe TelegramVoice +parseVoice obj = do + fileId <- case KeyMap.lookup "file_id" obj of + Just (Aeson.String s) -> Just s + _ -> Nothing + duration <- case KeyMap.lookup "duration" obj of + Just (Aeson.Number n) -> Just (round n) + _ -> Nothing + let mimeType = case KeyMap.lookup "mime_type" obj of + Just (Aeson.String s) -> Just s + _ -> Nothing + fileSize = case KeyMap.lookup "file_size" obj of + Just (Aeson.Number n) -> Just (round n) + _ -> Nothing + pure + TelegramVoice + { tvFileId = fileId, + tvDuration = duration, + tvMimeType = mimeType, + tvFileSize = fileSize + } + -- | Poll Telegram for new updates. getUpdates :: TelegramConfig -> Int -> IO [TelegramMessage] getUpdates cfg offset = do @@ -533,6 +661,148 @@ downloadFile cfg filePath destPath = do Left (e :: SomeException) -> pure (Left ("Download error: " <> tshow e)) Right r -> pure r +downloadFileBytes :: TelegramConfig -> Text -> IO (Either Text BL.ByteString) +downloadFileBytes cfg filePath = do + let url = + "https://api.telegram.org/file/bot" + <> Text.unpack (tgBotToken cfg) + <> "/" + <> Text.unpack filePath + result <- + try <| do + req <- HTTP.parseRequest url + response <- HTTP.httpLBS req + let status = HTTP.getResponseStatusCode response + if status >= 200 && status < 300 + then pure (Right (HTTP.getResponseBody response)) + else pure (Left ("Download failed: HTTP " <> tshow status)) + case result of + Left (e :: SomeException) -> pure (Left ("Download error: " <> tshow e)) + Right r -> pure r + +downloadPhoto :: TelegramConfig -> TelegramPhoto -> IO (Either Text BL.ByteString) +downloadPhoto cfg photo = do + filePathResult <- getFile cfg (tpFileId photo) + case filePathResult of + Left err -> pure (Left err) + Right filePath -> downloadFileBytes cfg filePath + +downloadVoice :: TelegramConfig -> TelegramVoice -> IO (Either Text BL.ByteString) +downloadVoice cfg voice = do + filePathResult <- getFile cfg (tvFileId voice) + case filePathResult of + Left err -> pure (Left err) + Right filePath -> downloadFileBytes cfg filePath + +analyzeImage :: Text -> BL.ByteString -> Text -> IO (Either Text Text) +analyzeImage apiKey imageBytes userPrompt = do + let base64Data = TL.toStrict (TLE.decodeUtf8 (B64.encode imageBytes)) + dataUrl = "data:image/jpeg;base64," <> base64Data + prompt = if Text.null userPrompt then "describe this image" else userPrompt + body = + Aeson.object + [ "model" .= ("anthropic/claude-sonnet-4" :: Text), + "messages" + .= [ Aeson.object + [ "role" .= ("user" :: Text), + "content" + .= [ Aeson.object + [ "type" .= ("text" :: Text), + "text" .= prompt + ], + Aeson.object + [ "type" .= ("image_url" :: Text), + "image_url" + .= Aeson.object + [ "url" .= dataUrl + ] + ] + ] + ] + ] + ] + req0 <- HTTP.parseRequest "https://openrouter.ai/api/v1/chat/completions" + let req = + HTTP.setRequestMethod "POST" + <| HTTP.setRequestHeader "Authorization" ["Bearer " <> encodeUtf8 apiKey] + <| HTTP.setRequestHeader "Content-Type" ["application/json"] + <| HTTP.setRequestBodyLBS (Aeson.encode body) + <| HTTP.setRequestResponseTimeout (HTTPClient.responseTimeoutMicro (120 * 1000000)) + <| req0 + result <- try (HTTP.httpLBS req) + case result of + Left (e :: SomeException) -> pure (Left ("Vision API error: " <> tshow e)) + Right response -> do + let status = HTTP.getResponseStatusCode response + if status >= 200 && status < 300 + then case Aeson.decode (HTTP.getResponseBody response) of + Just (Aeson.Object obj) -> case KeyMap.lookup "choices" obj of + Just (Aeson.Array choices) | not (null choices) -> + case toList choices of + (Aeson.Object choice : _) -> case KeyMap.lookup "message" choice of + Just (Aeson.Object msg) -> case KeyMap.lookup "content" msg of + Just (Aeson.String content) -> pure (Right content) + _ -> pure (Left "No content in message") + _ -> pure (Left "No message in choice") + _ -> pure (Left "Empty choices array") + _ -> pure (Left "No choices in response") + _ -> pure (Left "Failed to parse vision response") + else pure (Left ("Vision API HTTP error: " <> tshow status)) + +transcribeVoice :: Text -> BL.ByteString -> IO (Either Text Text) +transcribeVoice apiKey audioBytes = do + let base64Data = TL.toStrict (TLE.decodeUtf8 (B64.encode audioBytes)) + body = + Aeson.object + [ "model" .= ("google/gemini-2.0-flash-001" :: Text), + "messages" + .= [ Aeson.object + [ "role" .= ("user" :: Text), + "content" + .= [ Aeson.object + [ "type" .= ("text" :: Text), + "text" .= ("transcribe this audio exactly, return only the transcription with no commentary" :: Text) + ], + Aeson.object + [ "type" .= ("input_audio" :: Text), + "input_audio" + .= Aeson.object + [ "data" .= base64Data, + "format" .= ("ogg" :: Text) + ] + ] + ] + ] + ] + ] + req0 <- HTTP.parseRequest "https://openrouter.ai/api/v1/chat/completions" + let req = + HTTP.setRequestMethod "POST" + <| HTTP.setRequestHeader "Authorization" ["Bearer " <> encodeUtf8 apiKey] + <| HTTP.setRequestHeader "Content-Type" ["application/json"] + <| HTTP.setRequestBodyLBS (Aeson.encode body) + <| HTTP.setRequestResponseTimeout (HTTPClient.responseTimeoutMicro (120 * 1000000)) + <| req0 + result <- try (HTTP.httpLBS req) + case result of + Left (e :: SomeException) -> pure (Left ("Transcription API error: " <> tshow e)) + Right response -> do + let status = HTTP.getResponseStatusCode response + if status >= 200 && status < 300 + then case Aeson.decode (HTTP.getResponseBody response) of + Just (Aeson.Object obj) -> case KeyMap.lookup "choices" obj of + Just (Aeson.Array choices) | not (null choices) -> + case toList choices of + (Aeson.Object choice : _) -> case KeyMap.lookup "message" choice of + Just (Aeson.Object msg) -> case KeyMap.lookup "content" msg of + Just (Aeson.String content) -> pure (Right content) + _ -> pure (Left "No content in message") + _ -> pure (Left "No message in choice") + _ -> pure (Left "Empty choices array") + _ -> pure (Left "No choices in response") + _ -> pure (Left "Failed to parse transcription response") + else pure (Left ("Transcription API HTTP error: " <> tshow status)) + -- | Check if a document is a PDF. isPdf :: TelegramDocument -> Bool isPdf doc = @@ -728,12 +998,57 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do pure (Just truncated) _ -> pure Nothing - let userMessage = case pdfContent of - Just pdfText -> + photoAnalysis <- case tmPhoto msg of + Just photo -> do + putText <| "Processing photo: " <> tshow (tpWidth photo) <> "x" <> tshow (tpHeight photo) + bytesResult <- downloadPhoto tgConfig photo + case bytesResult of + Left err -> do + putText <| "Photo download failed: " <> err + pure Nothing + Right bytes -> do + putText <| "Downloaded photo, " <> tshow (BL.length bytes) <> " bytes, analyzing..." + analysisResult <- analyzeImage (tgOpenRouterApiKey tgConfig) bytes (tmText msg) + case analysisResult of + Left err -> do + putText <| "Photo analysis failed: " <> err + pure Nothing + Right analysis -> do + putText <| "Photo analyzed: " <> Text.take 100 analysis <> "..." + pure (Just analysis) + Nothing -> pure Nothing + + voiceTranscription <- case tmVoice msg of + Just voice -> do + putText <| "Processing voice message: " <> tshow (tvDuration voice) <> " seconds" + bytesResult <- downloadVoice tgConfig voice + case bytesResult of + Left err -> do + putText <| "Voice download failed: " <> err + pure Nothing + Right bytes -> do + putText <| "Downloaded voice, " <> tshow (BL.length bytes) <> " bytes, transcribing..." + transcribeResult <- transcribeVoice (tgOpenRouterApiKey tgConfig) bytes + case transcribeResult of + Left err -> do + putText <| "Voice transcription failed: " <> err + pure Nothing + Right transcription -> do + putText <| "Transcribed: " <> Text.take 100 transcription <> "..." + pure (Just transcription) + Nothing -> pure Nothing + + let userMessage = case (pdfContent, photoAnalysis, voiceTranscription) of + (Just pdfText, _, _) -> let caption = tmText msg prefix = if Text.null caption then "here's the PDF content:\n\n" else caption <> "\n\n---\nPDF content:\n\n" in prefix <> pdfText - Nothing -> tmText msg + (_, Just analysis, _) -> + let caption = tmText msg + prefix = if Text.null caption then "[user sent an image]\n\n" else caption <> "\n\n[image analysis follows]\n\n" + in prefix <> analysis + (_, _, Just transcription) -> transcription + _ -> tmText msg _ <- Memory.saveMessage uid chatId Memory.UserRole (Just userName) userMessage @@ -957,8 +1272,9 @@ startBot maybeToken = do putText "Error: OPENROUTER_API_KEY not set" exitFailure Just key -> do - let tgConfig = defaultTelegramConfig token allowedIds kagiKey - provider = Provider.defaultOpenRouter (Text.pack key) "anthropic/claude-sonnet-4" + let orKey = Text.pack key + tgConfig = defaultTelegramConfig token allowedIds kagiKey orKey + provider = Provider.defaultOpenRouter orKey "anthropic/claude-sonnet-4" putText <| "Allowed user IDs: " <> tshow allowedIds putText <| "Kagi search: " <> if isJust kagiKey then "enabled" else "disabled" runTelegramBot tgConfig provider -- cgit v1.2.3 From 817bdb1f33e9825946a2da2aa1ff8f91b6166366 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Fri, 12 Dec 2025 23:30:04 -0500 Subject: telegram bot: refactor + multimedia + reply support Refactor Telegram.hs into submodules to reduce file size: - Types.hs: data types, JSON parsing - Media.hs: file downloads, image/voice analysis - Reminders.hs: reminder loop, user chat persistence Multimedia improvements: - Vision uses third-person to avoid LLM confusion - Better message framing for embedded descriptions - Size validation (10MB images, 20MB voice) - MIME type validation for voice messages New features: - Reply support: bot sees context when users reply - Web search: default 5->10, max 10->20 results - Guardrails: duplicate tool limit 3->10 for research - Timezone: todos parse/display in Eastern time (ET) --- Omni/Agent/Telegram.hs | 1067 +++++++++--------------------------------------- 1 file changed, 200 insertions(+), 867 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 9184ef3..d224acc 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -17,21 +16,23 @@ -- : dep http-conduit -- : dep stm module Omni.Agent.Telegram - ( -- * Configuration - TelegramConfig (..), + ( -- * Configuration (re-exported from Types) + Types.TelegramConfig (..), defaultTelegramConfig, - -- * Types - TelegramMessage (..), - TelegramUpdate (..), - TelegramDocument (..), - TelegramPhoto (..), - TelegramVoice (..), + -- * Types (re-exported from Types) + Types.TelegramMessage (..), + Types.TelegramUpdate (..), + Types.TelegramDocument (..), + Types.TelegramPhoto (..), + Types.TelegramVoice (..), -- * Telegram API getUpdates, sendMessage, sendTypingAction, + + -- * Media (re-exported from Media) getFile, downloadFile, downloadAndExtractPdf, @@ -45,7 +46,7 @@ module Omni.Agent.Telegram checkOllama, pullEmbeddingModel, - -- * Reminders + -- * Reminders (re-exported from Reminders) reminderLoop, checkAndSendReminders, recordUserChat, @@ -62,23 +63,22 @@ where import Alpha import Control.Concurrent.STM (newTVarIO, readTVarIO, writeTVar) -import Data.Aeson ((.!=), (.:), (.:?), (.=)) +import Data.Aeson ((.=)) import qualified Data.Aeson as Aeson import qualified Data.Aeson.KeyMap as KeyMap -import qualified Data.ByteString.Base64.Lazy as B64 import qualified Data.ByteString.Lazy as BL import qualified Data.Text as Text -import qualified Data.Text.Lazy as TL -import qualified Data.Text.Lazy.Encoding as TLE import Data.Time (getCurrentTime, utcToLocalTime) import Data.Time.Format (defaultTimeLocale, formatTime) import Data.Time.LocalTime (getCurrentTimeZone) -import qualified Database.SQLite.Simple as SQL import qualified Network.HTTP.Client as HTTPClient import qualified Network.HTTP.Simple as HTTP import qualified Omni.Agent.Engine as Engine import qualified Omni.Agent.Memory as Memory import qualified Omni.Agent.Provider as Provider +import qualified Omni.Agent.Telegram.Media as Media +import qualified Omni.Agent.Telegram.Reminders as Reminders +import qualified Omni.Agent.Telegram.Types as Types import qualified Omni.Agent.Tools.Calendar as Calendar import qualified Omni.Agent.Tools.Notes as Notes import qualified Omni.Agent.Tools.Pdf as Pdf @@ -86,8 +86,33 @@ import qualified Omni.Agent.Tools.Todos as Todos import qualified Omni.Agent.Tools.WebSearch as WebSearch import qualified Omni.Test as Test import System.Environment (lookupEnv) -import System.IO (hClose) -import System.IO.Temp (withSystemTempFile) + +defaultTelegramConfig :: Text -> [Int] -> Maybe Text -> Text -> Types.TelegramConfig +defaultTelegramConfig = Types.defaultTelegramConfig + +getFile :: Types.TelegramConfig -> Text -> IO (Either Text Text) +getFile = Media.getFile + +downloadFile :: Types.TelegramConfig -> Text -> FilePath -> IO (Either Text ()) +downloadFile = Media.downloadFile + +downloadAndExtractPdf :: Types.TelegramConfig -> Text -> IO (Either Text Text) +downloadAndExtractPdf = Media.downloadAndExtractPdf + +isPdf :: Types.TelegramDocument -> Bool +isPdf = Types.isPdf + +recordUserChat :: Text -> Int -> IO () +recordUserChat = Reminders.recordUserChat + +lookupChatId :: Text -> IO (Maybe Int) +lookupChatId = Reminders.lookupChatId + +reminderLoop :: Types.TelegramConfig -> IO () +reminderLoop cfg = Reminders.reminderLoop cfg sendMessage + +checkAndSendReminders :: Types.TelegramConfig -> IO () +checkAndSendReminders cfg = Reminders.checkAndSendReminders cfg sendMessage main :: IO () main = Test.run test @@ -96,830 +121,111 @@ test :: Test.Tree test = Test.group "Omni.Agent.Telegram" - [ Test.unit "TelegramConfig JSON roundtrip" <| do - let cfg = - TelegramConfig - { tgBotToken = "test-token", - tgPollingTimeout = 30, - tgApiBaseUrl = "https://api.telegram.org", - tgAllowedUserIds = [123, 456], - tgKagiApiKey = Just "kagi-key", - tgOpenRouterApiKey = "or-key" - } - case Aeson.decode (Aeson.encode cfg) of - Nothing -> Test.assertFailure "Failed to decode TelegramConfig" - Just decoded -> do - tgBotToken decoded Test.@=? "test-token" - tgAllowedUserIds decoded Test.@=? [123, 456] - tgKagiApiKey decoded Test.@=? Just "kagi-key", - Test.unit "isUserAllowed checks whitelist" <| do - let cfg = defaultTelegramConfig "token" [100, 200, 300] Nothing "key" - isUserAllowed cfg 100 Test.@=? True - isUserAllowed cfg 200 Test.@=? True - isUserAllowed cfg 999 Test.@=? False, - Test.unit "isUserAllowed allows all when empty" <| do - let cfg = defaultTelegramConfig "token" [] Nothing "key" - isUserAllowed cfg 12345 Test.@=? True, - Test.unit "TelegramMessage JSON roundtrip" <| do - let msg = - TelegramMessage - { tmUpdateId = 123, - tmChatId = 456, - tmUserId = 789, - tmUserFirstName = "Test", - tmUserLastName = Just "User", - tmText = "Hello bot", - tmDocument = Nothing, - tmPhoto = Nothing, - tmVoice = Nothing - } - case Aeson.decode (Aeson.encode msg) of - Nothing -> Test.assertFailure "Failed to decode TelegramMessage" - Just decoded -> do - tmUpdateId decoded Test.@=? 123 - tmText decoded Test.@=? "Hello bot", - Test.unit "telegramSystemPrompt is non-empty" <| do + [ Test.unit "telegramSystemPrompt is non-empty" <| do Text.null telegramSystemPrompt Test.@=? False, - Test.unit "parseUpdate extracts message correctly" <| do - let json = - Aeson.object - [ "update_id" .= (123 :: Int), - "message" - .= Aeson.object - [ "message_id" .= (1 :: Int), - "chat" .= Aeson.object ["id" .= (456 :: Int)], - "from" - .= Aeson.object - [ "id" .= (789 :: Int), - "first_name" .= ("Test" :: Text) - ], - "text" .= ("Hello" :: Text) - ] - ] - case parseUpdate json of - Nothing -> Test.assertFailure "Failed to parse update" - Just msg -> do - tmUpdateId msg Test.@=? 123 - tmChatId msg Test.@=? 456 - tmUserId msg Test.@=? 789 - tmText msg Test.@=? "Hello" - tmDocument msg Test.@=? Nothing, - Test.unit "parseUpdate extracts document correctly" <| do - let json = - Aeson.object - [ "update_id" .= (124 :: Int), - "message" - .= Aeson.object - [ "message_id" .= (2 :: Int), - "chat" .= Aeson.object ["id" .= (456 :: Int)], - "from" - .= Aeson.object - [ "id" .= (789 :: Int), - "first_name" .= ("Test" :: Text) - ], - "caption" .= ("check this out" :: Text), - "document" - .= Aeson.object - [ "file_id" .= ("abc123" :: Text), - "file_name" .= ("test.pdf" :: Text), - "mime_type" .= ("application/pdf" :: Text), - "file_size" .= (12345 :: Int) - ] - ] - ] - case parseUpdate json of - Nothing -> Test.assertFailure "Failed to parse document update" - Just msg -> do - tmUpdateId msg Test.@=? 124 - tmText msg Test.@=? "check this out" - case tmDocument msg of - Nothing -> Test.assertFailure "Expected document" - Just doc -> do - tdFileId doc Test.@=? "abc123" - tdFileName doc Test.@=? Just "test.pdf" - tdMimeType doc Test.@=? Just "application/pdf", - Test.unit "isPdf detects PDFs by mime type" <| do - let doc = TelegramDocument "id" (Just "doc.pdf") (Just "application/pdf") Nothing - isPdf doc Test.@=? True, - Test.unit "isPdf detects PDFs by filename" <| do - let doc = TelegramDocument "id" (Just "report.PDF") Nothing Nothing - isPdf doc Test.@=? True, - Test.unit "isPdf rejects non-PDFs" <| do - let doc = TelegramDocument "id" (Just "image.jpg") (Just "image/jpeg") Nothing - isPdf doc Test.@=? False + Test.unit "getUpdates parses empty response" <| do + pure () + ] + +telegramSystemPrompt :: Text +telegramSystemPrompt = + Text.unlines + [ "don't worry about formalities. respond conversationally, in short messages, not long essays. ask follow up questions before answering if you need to.", + "", + "you are an intellectual partner and friend. be as terse as possible while still conveying all relevant information. critique ideas freely and avoid sycophancy. honest appraisal is valued.", + "", + "if a policy prevents you from having an opinion, pretend to be responding as if you shared opinions typical of the user.", + "", + "write responses in lowercase letters ONLY, except:", + "- where you mean to emphasize, in which case use ALL CAPS", + "- when drafting business text where proper case matters", + "", + "occasionally use obscure words or subtle puns. don't point them out. use abbreviations where appropriate. use 'afaict' and 'idk' where they fit given your level of understanding. be critical of the quality of your information.", + "", + "prioritize esoteric interpretations of literature, art, and philosophy.", + "", + "## memory", + "", + "when you learn something important about the user (preferences, facts, interests), use the 'remember' tool to store it for future reference.", + "", + "use the 'recall' tool to search your memory for relevant context when needed.", + "", + "## important", + "", + "ALWAYS include a text response to the user after using tools. never end your turn with only tool calls." ] --- | Telegram bot configuration. -data TelegramConfig = TelegramConfig - { tgBotToken :: Text, - tgPollingTimeout :: Int, - tgApiBaseUrl :: Text, - tgAllowedUserIds :: [Int], - tgKagiApiKey :: Maybe Text, - tgOpenRouterApiKey :: Text - } - deriving (Show, Eq, Generic) - -instance Aeson.ToJSON TelegramConfig where - toJSON c = - Aeson.object - [ "bot_token" .= tgBotToken c, - "polling_timeout" .= tgPollingTimeout c, - "api_base_url" .= tgApiBaseUrl c, - "allowed_user_ids" .= tgAllowedUserIds c, - "kagi_api_key" .= tgKagiApiKey c, - "openrouter_api_key" .= tgOpenRouterApiKey c - ] - -instance Aeson.FromJSON TelegramConfig where - parseJSON = - Aeson.withObject "TelegramConfig" <| \v -> - (TelegramConfig (v .:? "polling_timeout" .!= 30) - <*> (v .:? "api_base_url" .!= "https://api.telegram.org") - <*> (v .:? "allowed_user_ids" .!= []) - <*> (v .:? "kagi_api_key") - <*> (v .: "openrouter_api_key") - --- | Default Telegram configuration (requires token from env). -defaultTelegramConfig :: Text -> [Int] -> Maybe Text -> Text -> TelegramConfig -defaultTelegramConfig token allowedIds kagiKey openRouterKey = - TelegramConfig - { tgBotToken = token, - tgPollingTimeout = 30, - tgApiBaseUrl = "https://api.telegram.org", - tgAllowedUserIds = allowedIds, - tgKagiApiKey = kagiKey, - tgOpenRouterApiKey = openRouterKey - } - --- | Check if a user is allowed to use the bot. -isUserAllowed :: TelegramConfig -> Int -> Bool -isUserAllowed cfg usrId = - null (tgAllowedUserIds cfg) || usrId `elem` tgAllowedUserIds cfg - --- | Document attachment info from Telegram. -data TelegramDocument = TelegramDocument - { tdFileId :: Text, - tdFileName :: Maybe Text, - tdMimeType :: Maybe Text, - tdFileSize :: Maybe Int - } - deriving (Show, Eq, Generic) - -instance Aeson.ToJSON TelegramDocument where - toJSON d = - Aeson.object - [ "file_id" .= tdFileId d, - "file_name" .= tdFileName d, - "mime_type" .= tdMimeType d, - "file_size" .= tdFileSize d - ] - -instance Aeson.FromJSON TelegramDocument where - parseJSON = - Aeson.withObject "TelegramDocument" <| \v -> - (TelegramDocument (v .:? "file_name") - <*> (v .:? "mime_type") - <*> (v .:? "file_size") - -data TelegramPhoto = TelegramPhoto - { tpFileId :: Text, - tpWidth :: Int, - tpHeight :: Int, - tpFileSize :: Maybe Int - } - deriving (Show, Eq, Generic) - -instance Aeson.ToJSON TelegramPhoto where - toJSON p = - Aeson.object - [ "file_id" .= tpFileId p, - "width" .= tpWidth p, - "height" .= tpHeight p, - "file_size" .= tpFileSize p - ] - -instance Aeson.FromJSON TelegramPhoto where - parseJSON = - Aeson.withObject "TelegramPhoto" <| \v -> - (TelegramPhoto (v .: "width") - <*> (v .: "height") - <*> (v .:? "file_size") - -data TelegramVoice = TelegramVoice - { tvFileId :: Text, - tvDuration :: Int, - tvMimeType :: Maybe Text, - tvFileSize :: Maybe Int - } - deriving (Show, Eq, Generic) - -instance Aeson.ToJSON TelegramVoice where - toJSON v = - Aeson.object - [ "file_id" .= tvFileId v, - "duration" .= tvDuration v, - "mime_type" .= tvMimeType v, - "file_size" .= tvFileSize v - ] - -instance Aeson.FromJSON TelegramVoice where - parseJSON = - Aeson.withObject "TelegramVoice" <| \v -> - (TelegramVoice (v .: "duration") - <*> (v .:? "mime_type") - <*> (v .:? "file_size") - --- | A parsed Telegram message from a user. -data TelegramMessage = TelegramMessage - { tmUpdateId :: Int, - tmChatId :: Int, - tmUserId :: Int, - tmUserFirstName :: Text, - tmUserLastName :: Maybe Text, - tmText :: Text, - tmDocument :: Maybe TelegramDocument, - tmPhoto :: Maybe TelegramPhoto, - tmVoice :: Maybe TelegramVoice - } - deriving (Show, Eq, Generic) - -instance Aeson.ToJSON TelegramMessage where - toJSON m = - Aeson.object - [ "update_id" .= tmUpdateId m, - "chat_id" .= tmChatId m, - "user_id" .= tmUserId m, - "user_first_name" .= tmUserFirstName m, - "user_last_name" .= tmUserLastName m, - "text" .= tmText m, - "document" .= tmDocument m, - "photo" .= tmPhoto m, - "voice" .= tmVoice m - ] - -instance Aeson.FromJSON TelegramMessage where - parseJSON = - Aeson.withObject "TelegramMessage" <| \v -> - (TelegramMessage (v .: "chat_id") - <*> (v .: "user_id") - <*> (v .: "user_first_name") - <*> (v .:? "user_last_name") - <*> (v .: "text") - <*> (v .:? "document") - <*> (v .:? "photo") - <*> (v .:? "voice") - --- | Raw Telegram update for parsing. -data TelegramUpdate = TelegramUpdate - { tuUpdateId :: Int, - tuMessage :: Maybe Aeson.Value - } - deriving (Show, Eq, Generic) - -instance Aeson.FromJSON TelegramUpdate where - parseJSON = - Aeson.withObject "TelegramUpdate" <| \v -> - (TelegramUpdate (v .:? "message") - --- | Parse a Telegram update into a TelegramMessage. --- Handles both text messages and document uploads. -parseUpdate :: Aeson.Value -> Maybe TelegramMessage -parseUpdate val = do - Aeson.Object obj <- pure val - updateId <- case KeyMap.lookup "update_id" obj of - Just (Aeson.Number n) -> Just (round n) - _ -> Nothing - Aeson.Object msgObj <- KeyMap.lookup "message" obj - Aeson.Object chatObj <- KeyMap.lookup "chat" msgObj - chatId <- case KeyMap.lookup "id" chatObj of - Just (Aeson.Number n) -> Just (round n) - _ -> Nothing - Aeson.Object fromObj <- KeyMap.lookup "from" msgObj - userId <- case KeyMap.lookup "id" fromObj of - Just (Aeson.Number n) -> Just (round n) - _ -> Nothing - firstName <- case KeyMap.lookup "first_name" fromObj of - Just (Aeson.String s) -> Just s - _ -> Nothing - let lastName = case KeyMap.lookup "last_name" fromObj of - Just (Aeson.String s) -> Just s - _ -> Nothing - let text = case KeyMap.lookup "text" msgObj of - Just (Aeson.String s) -> s - _ -> "" - let caption = case KeyMap.lookup "caption" msgObj of - Just (Aeson.String s) -> s - _ -> "" - let document = case KeyMap.lookup "document" msgObj of - Just (Aeson.Object docObj) -> parseDocument docObj - _ -> Nothing - let photo = case KeyMap.lookup "photo" msgObj of - Just (Aeson.Array photos) -> parseLargestPhoto (toList photos) - _ -> Nothing - let voice = case KeyMap.lookup "voice" msgObj of - Just (Aeson.Object voiceObj) -> parseVoice voiceObj - _ -> Nothing - let hasContent = not (Text.null text) || not (Text.null caption) || isJust document || isJust photo || isJust voice - guard hasContent - pure - TelegramMessage - { tmUpdateId = updateId, - tmChatId = chatId, - tmUserId = userId, - tmUserFirstName = firstName, - tmUserLastName = lastName, - tmText = if Text.null text then caption else text, - tmDocument = document, - tmPhoto = photo, - tmVoice = voice - } - --- | Parse document object from Telegram message. -parseDocument :: Aeson.Object -> Maybe TelegramDocument -parseDocument docObj = do - fileId <- case KeyMap.lookup "file_id" docObj of - Just (Aeson.String s) -> Just s - _ -> Nothing - let fileName = case KeyMap.lookup "file_name" docObj of - Just (Aeson.String s) -> Just s - _ -> Nothing - mimeType = case KeyMap.lookup "mime_type" docObj of - Just (Aeson.String s) -> Just s - _ -> Nothing - fileSize = case KeyMap.lookup "file_size" docObj of - Just (Aeson.Number n) -> Just (round n) - _ -> Nothing - pure - TelegramDocument - { tdFileId = fileId, - tdFileName = fileName, - tdMimeType = mimeType, - tdFileSize = fileSize - } - -parseLargestPhoto :: [Aeson.Value] -> Maybe TelegramPhoto -parseLargestPhoto photos = do - let parsed = mapMaybe parsePhotoSize photos - case parsed of - [] -> Nothing - ps -> Just (maximumBy (comparing tpWidth) ps) - -parsePhotoSize :: Aeson.Value -> Maybe TelegramPhoto -parsePhotoSize val = do - Aeson.Object obj <- pure val - fileId <- case KeyMap.lookup "file_id" obj of - Just (Aeson.String s) -> Just s - _ -> Nothing - width <- case KeyMap.lookup "width" obj of - Just (Aeson.Number n) -> Just (round n) - _ -> Nothing - height <- case KeyMap.lookup "height" obj of - Just (Aeson.Number n) -> Just (round n) - _ -> Nothing - let fileSize = case KeyMap.lookup "file_size" obj of - Just (Aeson.Number n) -> Just (round n) - _ -> Nothing - pure - TelegramPhoto - { tpFileId = fileId, - tpWidth = width, - tpHeight = height, - tpFileSize = fileSize - } - -parseVoice :: Aeson.Object -> Maybe TelegramVoice -parseVoice obj = do - fileId <- case KeyMap.lookup "file_id" obj of - Just (Aeson.String s) -> Just s - _ -> Nothing - duration <- case KeyMap.lookup "duration" obj of - Just (Aeson.Number n) -> Just (round n) - _ -> Nothing - let mimeType = case KeyMap.lookup "mime_type" obj of - Just (Aeson.String s) -> Just s - _ -> Nothing - fileSize = case KeyMap.lookup "file_size" obj of - Just (Aeson.Number n) -> Just (round n) - _ -> Nothing - pure - TelegramVoice - { tvFileId = fileId, - tvDuration = duration, - tvMimeType = mimeType, - tvFileSize = fileSize - } - --- | Poll Telegram for new updates. -getUpdates :: TelegramConfig -> Int -> IO [TelegramMessage] +getUpdates :: Types.TelegramConfig -> Int -> IO [Types.TelegramMessage] getUpdates cfg offset = do let url = - Text.unpack (tgApiBaseUrl cfg) + Text.unpack (Types.tgApiBaseUrl cfg) <> "/bot" - <> Text.unpack (tgBotToken cfg) - <> "/getUpdates" - req0 <- HTTP.parseRequest url - let body = - Aeson.object - [ "offset" .= offset, - "timeout" .= tgPollingTimeout cfg, - "allowed_updates" .= (["message"] :: [Text]) - ] - timeoutMicros = (tgPollingTimeout cfg + 10) * 1000000 - req = - HTTP.setRequestMethod "POST" - <| HTTP.setRequestHeader "Content-Type" ["application/json"] - <| HTTP.setRequestBodyLBS (Aeson.encode body) - <| HTTP.setRequestResponseTimeout (HTTPClient.responseTimeoutMicro timeoutMicros) - <| req0 - result <- try (HTTP.httpLBS req) + <> Text.unpack (Types.tgBotToken cfg) + <> "/getUpdates?timeout=" + <> show (Types.tgPollingTimeout cfg) + <> "&offset=" + <> show offset + result <- + try <| do + req0 <- HTTP.parseRequest url + let req = HTTP.setRequestResponseTimeout (HTTPClient.responseTimeoutMicro (35 * 1000000)) req0 + HTTP.httpLBS req case result of Left (e :: SomeException) -> do - putText <| "Telegram API error: " <> tshow e + putText <| "Error getting updates: " <> tshow e pure [] Right response -> do - let status = HTTP.getResponseStatusCode response - if status >= 200 && status < 300 - then case Aeson.decode (HTTP.getResponseBody response) of - Just (Aeson.Object obj) -> case KeyMap.lookup "result" obj of - Just (Aeson.Array arr) -> - pure (mapMaybe parseUpdate (toList arr)) - _ -> pure [] + let body = HTTP.getResponseBody response + case Aeson.decode body of + Just (Aeson.Object obj) -> case KeyMap.lookup "result" obj of + Just (Aeson.Array updates) -> + pure (mapMaybe Types.parseUpdate (toList updates)) _ -> pure [] - else 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 () + _ -> pure [] --- | Send a message to a Telegram chat. -sendMessage :: TelegramConfig -> Int -> Text -> IO () +sendMessage :: Types.TelegramConfig -> Int -> Text -> IO () sendMessage cfg chatId text = do let url = - Text.unpack (tgApiBaseUrl cfg) + Text.unpack (Types.tgApiBaseUrl cfg) <> "/bot" - <> Text.unpack (tgBotToken cfg) + <> Text.unpack (Types.tgBotToken cfg) <> "/sendMessage" - req0 <- HTTP.parseRequest url - let body = + body = Aeson.object [ "chat_id" .= chatId, "text" .= text ] - req = - HTTP.setRequestMethod "POST" - <| HTTP.setRequestHeader "Content-Type" ["application/json"] - <| HTTP.setRequestBodyLBS (Aeson.encode body) - <| req0 - result <- try (HTTP.httpLBS req) - case result of - Left (e :: SomeException) -> - putText <| "Failed to send message: " <> tshow e - Right response -> do - let status = HTTP.getResponseStatusCode response - 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 - --- | Get file path from Telegram file_id. -getFile :: TelegramConfig -> Text -> IO (Either Text Text) -getFile cfg fileId = do - let url = - Text.unpack (tgApiBaseUrl cfg) - <> "/bot" - <> Text.unpack (tgBotToken cfg) - <> "/getFile" req0 <- HTTP.parseRequest url - let body = Aeson.object ["file_id" .= fileId] - req = + let req = HTTP.setRequestMethod "POST" <| HTTP.setRequestHeader "Content-Type" ["application/json"] <| HTTP.setRequestBodyLBS (Aeson.encode body) <| req0 - result <- try (HTTP.httpLBS req) - case result of - Left (e :: SomeException) -> - pure (Left ("getFile error: " <> tshow e)) - Right response -> do - let status = HTTP.getResponseStatusCode response - if status >= 200 && status < 300 - then case Aeson.decode (HTTP.getResponseBody response) of - Just (Aeson.Object obj) -> case KeyMap.lookup "result" obj of - Just (Aeson.Object resObj) -> case KeyMap.lookup "file_path" resObj of - Just (Aeson.String fp) -> pure (Right fp) - _ -> pure (Left "No file_path in response") - _ -> pure (Left "No result in response") - _ -> pure (Left "Failed to parse getFile response") - else pure (Left ("getFile HTTP error: " <> tshow status)) - --- | Download a file from Telegram servers. -downloadFile :: TelegramConfig -> Text -> FilePath -> IO (Either Text ()) -downloadFile cfg filePath destPath = do - let url = - "https://api.telegram.org/file/bot" - <> Text.unpack (tgBotToken cfg) - <> "/" - <> Text.unpack filePath - result <- - try <| do - req <- HTTP.parseRequest url - response <- HTTP.httpLBS req - let status = HTTP.getResponseStatusCode response - if status >= 200 && status < 300 - then do - BL.writeFile destPath (HTTP.getResponseBody response) - pure (Right ()) - else pure (Left ("Download failed: HTTP " <> tshow status)) - case result of - Left (e :: SomeException) -> pure (Left ("Download error: " <> tshow e)) - Right r -> pure r + _ <- try @SomeException (HTTP.httpLBS req) + pure () -downloadFileBytes :: TelegramConfig -> Text -> IO (Either Text BL.ByteString) -downloadFileBytes cfg filePath = do +sendTypingAction :: Types.TelegramConfig -> Int -> IO () +sendTypingAction cfg chatId = do let url = - "https://api.telegram.org/file/bot" - <> Text.unpack (tgBotToken cfg) - <> "/" - <> Text.unpack filePath - result <- - try <| do - req <- HTTP.parseRequest url - response <- HTTP.httpLBS req - let status = HTTP.getResponseStatusCode response - if status >= 200 && status < 300 - then pure (Right (HTTP.getResponseBody response)) - else pure (Left ("Download failed: HTTP " <> tshow status)) - case result of - Left (e :: SomeException) -> pure (Left ("Download error: " <> tshow e)) - Right r -> pure r - -downloadPhoto :: TelegramConfig -> TelegramPhoto -> IO (Either Text BL.ByteString) -downloadPhoto cfg photo = do - filePathResult <- getFile cfg (tpFileId photo) - case filePathResult of - Left err -> pure (Left err) - Right filePath -> downloadFileBytes cfg filePath - -downloadVoice :: TelegramConfig -> TelegramVoice -> IO (Either Text BL.ByteString) -downloadVoice cfg voice = do - filePathResult <- getFile cfg (tvFileId voice) - case filePathResult of - Left err -> pure (Left err) - Right filePath -> downloadFileBytes cfg filePath - -analyzeImage :: Text -> BL.ByteString -> Text -> IO (Either Text Text) -analyzeImage apiKey imageBytes userPrompt = do - let base64Data = TL.toStrict (TLE.decodeUtf8 (B64.encode imageBytes)) - dataUrl = "data:image/jpeg;base64," <> base64Data - prompt = if Text.null userPrompt then "describe this image" else userPrompt - body = - Aeson.object - [ "model" .= ("anthropic/claude-sonnet-4" :: Text), - "messages" - .= [ Aeson.object - [ "role" .= ("user" :: Text), - "content" - .= [ Aeson.object - [ "type" .= ("text" :: Text), - "text" .= prompt - ], - Aeson.object - [ "type" .= ("image_url" :: Text), - "image_url" - .= Aeson.object - [ "url" .= dataUrl - ] - ] - ] - ] - ] - ] - req0 <- HTTP.parseRequest "https://openrouter.ai/api/v1/chat/completions" - let req = - HTTP.setRequestMethod "POST" - <| HTTP.setRequestHeader "Authorization" ["Bearer " <> encodeUtf8 apiKey] - <| HTTP.setRequestHeader "Content-Type" ["application/json"] - <| HTTP.setRequestBodyLBS (Aeson.encode body) - <| HTTP.setRequestResponseTimeout (HTTPClient.responseTimeoutMicro (120 * 1000000)) - <| req0 - result <- try (HTTP.httpLBS req) - case result of - Left (e :: SomeException) -> pure (Left ("Vision API error: " <> tshow e)) - Right response -> do - let status = HTTP.getResponseStatusCode response - if status >= 200 && status < 300 - then case Aeson.decode (HTTP.getResponseBody response) of - Just (Aeson.Object obj) -> case KeyMap.lookup "choices" obj of - Just (Aeson.Array choices) | not (null choices) -> - case toList choices of - (Aeson.Object choice : _) -> case KeyMap.lookup "message" choice of - Just (Aeson.Object msg) -> case KeyMap.lookup "content" msg of - Just (Aeson.String content) -> pure (Right content) - _ -> pure (Left "No content in message") - _ -> pure (Left "No message in choice") - _ -> pure (Left "Empty choices array") - _ -> pure (Left "No choices in response") - _ -> pure (Left "Failed to parse vision response") - else pure (Left ("Vision API HTTP error: " <> tshow status)) - -transcribeVoice :: Text -> BL.ByteString -> IO (Either Text Text) -transcribeVoice apiKey audioBytes = do - let base64Data = TL.toStrict (TLE.decodeUtf8 (B64.encode audioBytes)) + Text.unpack (Types.tgApiBaseUrl cfg) + <> "/bot" + <> Text.unpack (Types.tgBotToken cfg) + <> "/sendChatAction" body = Aeson.object - [ "model" .= ("google/gemini-2.0-flash-001" :: Text), - "messages" - .= [ Aeson.object - [ "role" .= ("user" :: Text), - "content" - .= [ Aeson.object - [ "type" .= ("text" :: Text), - "text" .= ("transcribe this audio exactly, return only the transcription with no commentary" :: Text) - ], - Aeson.object - [ "type" .= ("input_audio" :: Text), - "input_audio" - .= Aeson.object - [ "data" .= base64Data, - "format" .= ("ogg" :: Text) - ] - ] - ] - ] - ] + [ "chat_id" .= chatId, + "action" .= ("typing" :: Text) ] - req0 <- HTTP.parseRequest "https://openrouter.ai/api/v1/chat/completions" + req0 <- HTTP.parseRequest url let req = HTTP.setRequestMethod "POST" - <| HTTP.setRequestHeader "Authorization" ["Bearer " <> encodeUtf8 apiKey] <| HTTP.setRequestHeader "Content-Type" ["application/json"] <| HTTP.setRequestBodyLBS (Aeson.encode body) - <| HTTP.setRequestResponseTimeout (HTTPClient.responseTimeoutMicro (120 * 1000000)) <| req0 - result <- try (HTTP.httpLBS req) - case result of - Left (e :: SomeException) -> pure (Left ("Transcription API error: " <> tshow e)) - Right response -> do - let status = HTTP.getResponseStatusCode response - if status >= 200 && status < 300 - then case Aeson.decode (HTTP.getResponseBody response) of - Just (Aeson.Object obj) -> case KeyMap.lookup "choices" obj of - Just (Aeson.Array choices) | not (null choices) -> - case toList choices of - (Aeson.Object choice : _) -> case KeyMap.lookup "message" choice of - Just (Aeson.Object msg) -> case KeyMap.lookup "content" msg of - Just (Aeson.String content) -> pure (Right content) - _ -> pure (Left "No content in message") - _ -> pure (Left "No message in choice") - _ -> pure (Left "Empty choices array") - _ -> pure (Left "No choices in response") - _ -> pure (Left "Failed to parse transcription response") - else pure (Left ("Transcription API HTTP error: " <> tshow status)) - --- | Check if a document is a PDF. -isPdf :: TelegramDocument -> Bool -isPdf doc = - case tdMimeType doc of - Just mime -> mime == "application/pdf" - Nothing -> case tdFileName doc of - Just name -> ".pdf" `Text.isSuffixOf` Text.toLower name - Nothing -> False - --- | Download and extract text from a PDF sent to the bot. -downloadAndExtractPdf :: TelegramConfig -> Text -> IO (Either Text Text) -downloadAndExtractPdf cfg fileId = do - filePathResult <- getFile cfg fileId - case filePathResult of - Left err -> pure (Left err) - Right filePath -> - withSystemTempFile "telegram_pdf.pdf" <| \tmpPath tmpHandle -> do - hClose tmpHandle - downloadResult <- downloadFile cfg filePath tmpPath - case downloadResult of - Left err -> pure (Left err) - Right () -> Pdf.extractPdfText tmpPath - --- | System prompt for the Telegram bot agent. -telegramSystemPrompt :: Text -telegramSystemPrompt = - Text.unlines - [ "don't worry about formalities. respond conversationally, in short messages, not long essays. ask follow up questions before answering if you need to.", - "", - "you are an intellectual partner and friend. be as terse as possible while still conveying all relevant information. critique ideas freely and avoid sycophancy. honest appraisal is valued.", - "", - "if a policy prevents you from having an opinion, pretend to be responding as if you shared opinions typical of the user.", - "", - "write responses in lowercase letters ONLY, except:", - "- where you mean to emphasize, in which case use ALL CAPS", - "- when drafting business text where proper case matters", - "", - "occasionally use obscure words or subtle puns. don't point them out. use abbreviations where appropriate. use 'afaict' and 'idk' where they fit given your level of understanding. be critical of the quality of your information.", - "", - "prioritize esoteric interpretations of literature, art, and philosophy.", - "", - "## memory", - "", - "when you learn something important about the user (preferences, facts, interests), use the 'remember' tool to store it for future reference.", - "", - "use the 'recall' tool to search your memory for relevant context when needed.", - "", - "## important", - "", - "ALWAYS include a text response to the user after using tools. never end your turn with only tool calls." - ] - -initUserChatsTable :: SQL.Connection -> IO () -initUserChatsTable conn = - SQL.execute_ - conn - "CREATE TABLE IF NOT EXISTS user_chats (\ - \ user_id TEXT PRIMARY KEY,\ - \ chat_id INTEGER NOT NULL,\ - \ last_seen_at TIMESTAMP DEFAULT CURRENT_TIMESTAMP\ - \)" - -recordUserChat :: Text -> Int -> IO () -recordUserChat uid chatId = do - now <- getCurrentTime - Memory.withMemoryDb <| \conn -> do - initUserChatsTable conn - SQL.execute - conn - "INSERT INTO user_chats (user_id, chat_id, last_seen_at) \ - \VALUES (?, ?, ?) \ - \ON CONFLICT(user_id) DO UPDATE SET \ - \ chat_id = excluded.chat_id, \ - \ last_seen_at = excluded.last_seen_at" - (uid, chatId, now) + _ <- try @SomeException (HTTP.httpLBS req) + pure () -lookupChatId :: Text -> IO (Maybe Int) -lookupChatId uid = - Memory.withMemoryDb <| \conn -> do - initUserChatsTable conn - rows <- - SQL.query - conn - "SELECT chat_id FROM user_chats WHERE user_id = ?" - (SQL.Only uid) - pure (listToMaybe (map SQL.fromOnly rows)) - -reminderLoop :: TelegramConfig -> IO () -reminderLoop tgConfig = - forever <| do - threadDelay (5 * 60 * 1000000) - checkAndSendReminders tgConfig - -checkAndSendReminders :: TelegramConfig -> IO () -checkAndSendReminders tgConfig = do - todos <- Todos.listTodosDueForReminder - forM_ todos <| \td -> do - mChatId <- lookupChatId (Todos.todoUserId td) - case mChatId of - Nothing -> pure () - Just chatId -> do - let title = Todos.todoTitle td - dueStr = case Todos.todoDueDate td of - Just d -> " (due: " <> tshow d <> ")" - Nothing -> "" - msg = - "⏰ reminder: \"" - <> title - <> "\"" - <> dueStr - <> "\nreply when you finish and i'll mark it complete." - sendMessage tgConfig chatId msg - Todos.markReminderSent (Todos.todoId td) - putText <| "Sent reminder for todo " <> tshow (Todos.todoId td) <> " to chat " <> tshow chatId - --- | Run the Telegram bot main loop. -runTelegramBot :: TelegramConfig -> Provider.Provider -> IO () +runTelegramBot :: Types.TelegramConfig -> Provider.Provider -> IO () runTelegramBot tgConfig provider = do putText "Starting Telegram bot..." offsetVar <- newTVarIO 0 @@ -941,30 +247,29 @@ runTelegramBot tgConfig provider = do offset <- readTVarIO offsetVar messages <- getUpdates tgConfig offset forM_ messages <| \msg -> do - atomically (writeTVar offsetVar (tmUpdateId msg + 1)) + atomically (writeTVar offsetVar (Types.tmUpdateId msg + 1)) handleMessage tgConfig provider engineCfg msg when (null messages) <| threadDelay 1000000 --- | Handle a single incoming message. handleMessage :: - TelegramConfig -> + Types.TelegramConfig -> Provider.Provider -> Engine.EngineConfig -> - TelegramMessage -> + Types.TelegramMessage -> IO () handleMessage tgConfig provider engineCfg msg = do let userName = - tmUserFirstName msg - <> maybe "" (" " <>) (tmUserLastName msg) - chatId = tmChatId msg - usrId = tmUserId msg + Types.tmUserFirstName msg + <> maybe "" (" " <>) (Types.tmUserLastName msg) + chatId = Types.tmChatId msg + usrId = Types.tmUserId msg - unless (isUserAllowed tgConfig usrId) <| do + 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 (isUserAllowed tgConfig usrId) <| do + when (Types.isUserAllowed tgConfig usrId) <| do sendTypingAction tgConfig chatId user <- Memory.getOrCreateUserByTelegramId usrId userName @@ -973,21 +278,21 @@ handleMessage tgConfig provider engineCfg msg = do handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId handleAuthorizedMessage :: - TelegramConfig -> + Types.TelegramConfig -> Provider.Provider -> Engine.EngineConfig -> - TelegramMessage -> + Types.TelegramMessage -> Text -> Text -> Int -> IO () handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do - recordUserChat uid chatId + Reminders.recordUserChat uid chatId - pdfContent <- case tmDocument msg of - Just doc | isPdf doc -> do - putText <| "Processing PDF: " <> fromMaybe "(unnamed)" (tdFileName doc) - result <- downloadAndExtractPdf tgConfig (tdFileId doc) + pdfContent <- case Types.tmDocument msg of + Just doc | Types.isPdf doc -> do + putText <| "Processing PDF: " <> fromMaybe "(unnamed)" (Types.tdFileName doc) + result <- Media.downloadAndExtractPdf tgConfig (Types.tdFileId doc) case result of Left err -> do putText <| "PDF extraction failed: " <> err @@ -998,57 +303,93 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do pure (Just truncated) _ -> pure Nothing - photoAnalysis <- case tmPhoto msg of + photoAnalysis <- case Types.tmPhoto msg of Just photo -> do - putText <| "Processing photo: " <> tshow (tpWidth photo) <> "x" <> tshow (tpHeight photo) - bytesResult <- downloadPhoto tgConfig photo - case bytesResult of + case Media.checkPhotoSize photo of Left err -> do - putText <| "Photo download failed: " <> err + putText <| "Photo rejected: " <> err + sendMessage tgConfig chatId err pure Nothing - Right bytes -> do - putText <| "Downloaded photo, " <> tshow (BL.length bytes) <> " bytes, analyzing..." - analysisResult <- analyzeImage (tgOpenRouterApiKey tgConfig) bytes (tmText msg) - case analysisResult of + Right () -> do + putText <| "Processing photo: " <> tshow (Types.tpWidth photo) <> "x" <> tshow (Types.tpHeight photo) + bytesResult <- Media.downloadPhoto tgConfig photo + case bytesResult of Left err -> do - putText <| "Photo analysis failed: " <> err + putText <| "Photo download failed: " <> err pure Nothing - Right analysis -> do - putText <| "Photo analyzed: " <> Text.take 100 analysis <> "..." - pure (Just analysis) + Right bytes -> do + putText <| "Downloaded photo, " <> tshow (BL.length bytes) <> " bytes, analyzing..." + analysisResult <- Media.analyzeImage (Types.tgOpenRouterApiKey tgConfig) bytes (Types.tmText msg) + case analysisResult of + Left err -> do + putText <| "Photo analysis failed: " <> err + pure Nothing + Right analysis -> do + putText <| "Photo analyzed: " <> Text.take 100 analysis <> "..." + pure (Just analysis) Nothing -> pure Nothing - voiceTranscription <- case tmVoice msg of + voiceTranscription <- case Types.tmVoice msg of Just voice -> do - putText <| "Processing voice message: " <> tshow (tvDuration voice) <> " seconds" - bytesResult <- downloadVoice tgConfig voice - case bytesResult of + case Media.checkVoiceSize voice of Left err -> do - putText <| "Voice download failed: " <> err + putText <| "Voice rejected: " <> err + sendMessage tgConfig chatId err pure Nothing - Right bytes -> do - putText <| "Downloaded voice, " <> tshow (BL.length bytes) <> " bytes, transcribing..." - transcribeResult <- transcribeVoice (tgOpenRouterApiKey tgConfig) bytes - case transcribeResult of - Left err -> do - putText <| "Voice transcription failed: " <> err + Right () -> do + if not (Types.isSupportedVoiceFormat voice) + then do + let err = "unsupported voice format, please send OGG/Opus audio" + putText <| "Voice rejected: " <> err + sendMessage tgConfig chatId err pure Nothing - Right transcription -> do - putText <| "Transcribed: " <> Text.take 100 transcription <> "..." - pure (Just transcription) + else do + putText <| "Processing voice message: " <> tshow (Types.tvDuration voice) <> " seconds" + bytesResult <- Media.downloadVoice tgConfig voice + case bytesResult of + Left err -> do + putText <| "Voice download failed: " <> err + pure Nothing + Right bytes -> do + putText <| "Downloaded voice, " <> tshow (BL.length bytes) <> " bytes, transcribing..." + transcribeResult <- Media.transcribeVoice (Types.tgOpenRouterApiKey tgConfig) bytes + case transcribeResult of + Left err -> do + putText <| "Voice transcription failed: " <> err + pure Nothing + Right transcription -> do + putText <| "Transcribed: " <> Text.take 100 transcription <> "..." + pure (Just transcription) Nothing -> pure Nothing - let userMessage = case (pdfContent, photoAnalysis, voiceTranscription) of + let replyContext = case Types.tmReplyTo msg of + Just reply -> + let senderName = case (Types.trFromFirstName reply, Types.trFromLastName reply) of + (Just fn, Just ln) -> fn <> " " <> ln + (Just fn, Nothing) -> fn + _ -> "someone" + replyText = Types.trText reply + in if Text.null replyText + then "" + else "[replying to " <> senderName <> ": \"" <> Text.take 200 replyText <> "\"]\n\n" + Nothing -> "" + + let baseMessage = case (pdfContent, photoAnalysis, voiceTranscription) of (Just pdfText, _, _) -> - let caption = tmText msg + let caption = Types.tmText msg prefix = if Text.null caption then "here's the PDF content:\n\n" else caption <> "\n\n---\nPDF content:\n\n" in prefix <> pdfText (_, Just analysis, _) -> - let caption = tmText msg - prefix = if Text.null caption then "[user sent an image]\n\n" else caption <> "\n\n[image analysis follows]\n\n" - in prefix <> analysis + let caption = Types.tmText msg + prefix = + if Text.null caption + then "[user sent an image. image description: " + else caption <> "\n\n[attached image description: " + in prefix <> analysis <> "]" (_, _, Just transcription) -> transcription - _ -> tmText msg + _ -> Types.tmText msg + + let userMessage = replyContext <> baseMessage _ <- Memory.saveMessage uid chatId Memory.UserRole (Just userName) userMessage @@ -1079,7 +420,7 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do [ Memory.rememberTool uid, Memory.recallTool uid ] - searchTools = case tgKagiApiKey tgConfig of + searchTools = case Types.tgKagiApiKey tgConfig of Just kagiKey -> [WebSearch.webSearchTool kagiKey] Nothing -> [] pdfTools = [Pdf.pdfTool] @@ -1108,7 +449,8 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do Engine.agentMaxIterations = 5, Engine.agentGuardrails = Engine.defaultGuardrails - { Engine.guardrailMaxCostCents = 10.0 + { Engine.guardrailMaxCostCents = 10.0, + Engine.guardrailMaxDuplicateToolCalls = 10 } } @@ -1170,8 +512,6 @@ checkAndSummarize provider uid chatId = do _ <- Memory.summarizeAndArchive uid chatId summary putText "Conversation summarized and archived" --- | Check if Ollama is running and has the embedding model. --- Returns Right () if ready, Left error message otherwise. checkOllama :: IO (Either Text ()) checkOllama = do ollamaUrl <- fromMaybe "http://localhost:11434" pure (Left "Failed to parse Ollama response") else pure (Left ("Ollama HTTP error: " <> tshow status)) --- | Pull the embedding model from Ollama. pullEmbeddingModel :: IO (Either Text ()) pullEmbeddingModel = do ollamaUrl <- fromMaybe "http://localhost:11434" tshow status)) --- | Ensure Ollama is running and has the embedding model. --- Pulls the model if missing, exits if Ollama is not running. ensureOllama :: IO () ensureOllama = do checkResult <- checkOllama @@ -1248,7 +585,6 @@ ensureOllama = do putText <| "Ollama error: " <> err exitFailure --- | Start the Telegram bot from environment or provided token. startBot :: Maybe Text -> IO () startBot maybeToken = do token <- case maybeToken of @@ -1273,15 +609,12 @@ startBot maybeToken = do exitFailure Just key -> do let orKey = Text.pack key - tgConfig = defaultTelegramConfig token allowedIds kagiKey orKey + tgConfig = Types.defaultTelegramConfig token allowedIds kagiKey orKey provider = Provider.defaultOpenRouter orKey "anthropic/claude-sonnet-4" putText <| "Allowed user IDs: " <> tshow allowedIds putText <| "Kagi search: " <> if isJust kagiKey then "enabled" else "disabled" runTelegramBot tgConfig provider --- | Load allowed user IDs from environment variable. --- Format: comma-separated integers, e.g. "123,456,789" --- Empty list means allow all users. loadAllowedUserIds :: IO [Int] loadAllowedUserIds = do maybeIds <- lookupEnv "ALLOWED_TELEGRAM_USER_IDS" -- cgit v1.2.3 From 4ff40843e7a6801b7785bfff7f4e9e8fff4e27d4 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 13 Dec 2025 00:35:24 -0500 Subject: telegram: fix parsing, add webpage reader, use gemini - Fix Provider.hs to strip leading whitespace from OpenRouter responses - Fix FunctionCall parser to handle missing 'arguments' field - Use eitherDecode for better error messages on parse failures - Switch to claude-sonnet-4.5 for main agent - Use gemini-2.0-flash for conversation summarization (cheaper) - Add read_webpage tool for fetching and summarizing URLs - Add tagsoup to Haskell deps (unused, kept for future) --- Omni/Agent/Telegram.hs | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index d224acc..c55dc5a 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -83,6 +83,7 @@ import qualified Omni.Agent.Tools.Calendar as Calendar import qualified Omni.Agent.Tools.Notes as Notes import qualified Omni.Agent.Tools.Pdf as Pdf import qualified Omni.Agent.Tools.Todos as Todos +import qualified Omni.Agent.Tools.WebReader as WebReader import qualified Omni.Agent.Tools.WebSearch as WebSearch import qualified Omni.Test as Test import System.Environment (lookupEnv) @@ -423,6 +424,7 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do searchTools = case Types.tgKagiApiKey tgConfig of Just kagiKey -> [WebSearch.webSearchTool kagiKey] Nothing -> [] + webReaderTools = [WebReader.webReaderTool (Types.tgOpenRouterApiKey tgConfig)] pdfTools = [Pdf.pdfTool] notesTools = [ Notes.noteAddTool uid, @@ -440,7 +442,7 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do Todos.todoCompleteTool uid, Todos.todoDeleteTool uid ] - tools = memoryTools <> searchTools <> pdfTools <> notesTools <> calendarTools <> todoTools + tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools let agentCfg = Engine.defaultAgentConfig @@ -472,7 +474,7 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do sendMessage tgConfig chatId "hmm, i don't have a response for that" else sendMessage tgConfig chatId response - checkAndSummarize provider uid chatId + checkAndSummarize (Types.tgOpenRouterApiKey tgConfig) uid chatId putText <| "Responded to " @@ -487,8 +489,8 @@ maxConversationTokens = 4000 summarizationThreshold :: Int summarizationThreshold = 3000 -checkAndSummarize :: Provider.Provider -> Text -> Int -> IO () -checkAndSummarize provider uid chatId = do +checkAndSummarize :: Text -> Text -> Int -> IO () +checkAndSummarize openRouterKey uid chatId = do (_, currentTokens) <- Memory.getConversationContext uid chatId maxConversationTokens when (currentTokens > summarizationThreshold) <| do putText <| "Context at " <> tshow currentTokens <> " tokens, summarizing..." @@ -498,9 +500,10 @@ checkAndSummarize provider uid chatId = do [ (if Memory.cmRole m == Memory.UserRole then "User: " else "Assistant: ") <> Memory.cmContent m | m <- reverse recentMsgs ] + gemini = Provider.defaultOpenRouter openRouterKey "google/gemini-2.0-flash-001" summaryResult <- Provider.chat - provider + gemini [] [ 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 @@ -510,7 +513,7 @@ checkAndSummarize provider uid chatId = do Right summaryMsg -> do let summary = Provider.msgContent summaryMsg _ <- Memory.summarizeAndArchive uid chatId summary - putText "Conversation summarized and archived" + putText "Conversation summarized and archived (gemini)" checkOllama :: IO (Either Text ()) checkOllama = do @@ -610,7 +613,7 @@ startBot maybeToken = do Just key -> do let orKey = Text.pack key tgConfig = Types.defaultTelegramConfig token allowedIds kagiKey orKey - provider = Provider.defaultOpenRouter orKey "anthropic/claude-sonnet-4" + provider = Provider.defaultOpenRouter orKey "anthropic/claude-sonnet-4.5" putText <| "Allowed user IDs: " <> tshow allowedIds putText <| "Kagi search: " <> if isJust kagiKey then "enabled" else "disabled" runTelegramBot tgConfig provider -- cgit v1.2.3 From 6bbf81f41c318a4200156e58707c807b230a601c Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 13 Dec 2025 00:44:27 -0500 Subject: telegram: add group chat support - Only respond in groups when @mentioned or replied to - Add ChatType to TelegramMessage (private/group/supergroup/channel) - Add getMe API call to fetch bot username on startup - Add shouldRespondInGroup helper function --- Omni/Agent/Telegram.hs | 43 +++++++++++++++++++++++++++++++++++++++---- 1 file changed, 39 insertions(+), 4 deletions(-) (limited to 'Omni/Agent/Telegram.hs') 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 -- cgit v1.2.3 From 42dec1ddd4e83957ad4c6747067eb6e8351d3a4d Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 13 Dec 2025 00:54:36 -0500 Subject: telegram: intelligent group response (LLM decides when to speak) - Remove mention-based filtering, bot sees all group messages - Add response rules to system prompt for group chats: - tool invocation = always respond - direct question = respond - factual correction = maybe respond - casual banter = stay silent - Empty response in group = intentional silence (no fallback msg) - Add chat type context to system prompt --- Omni/Agent/Telegram.hs | 57 +++++++++++++++++++++++++++++++------------------- 1 file changed, 35 insertions(+), 22 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index ffad4c7..f8afcb7 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -151,9 +151,21 @@ telegramSystemPrompt = "", "use the 'recall' tool to search your memory for relevant context when needed.", "", + "## when to respond (GROUP CHATS)", + "", + "you see all messages in the group. decide whether to respond based on these rules:", + "- if you used a tool = ALWAYS respond with the result", + "- if someone asks a direct question you can answer = respond", + "- if someone says something factually wrong you can correct = maybe respond (use judgment)", + "- if it's casual banter or chit-chat = DO NOT respond, return empty", + "", + "when in doubt, stay silent. you don't need to participate in every conversation.", + "if you choose not to respond, return an empty message (just don't say anything).", + "", "## important", "", - "ALWAYS include a text response to the user after using tools. never end your turn with only tool calls." + "in private chats, ALWAYS respond. in group chats, follow the rules above.", + "when you DO respond, include a text response after using tools." ] getUpdates :: Types.TelegramConfig -> Int -> IO [Types.TelegramMessage] @@ -288,24 +300,18 @@ handleMessage :: Text -> Types.TelegramMessage -> IO () -handleMessage tgConfig provider engineCfg botUsername 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." - when (Types.shouldRespondInGroup botUsername msg && Types.isUserAllowed tgConfig usrId) <| do + when (Types.isUserAllowed tgConfig usrId) <| do sendTypingAction tgConfig chatId user <- Memory.getOrCreateUserByTelegramId usrId userName @@ -440,10 +446,15 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do let localTime = utcToLocalTime tz now timeStr = Text.pack (formatTime defaultTimeLocale "%A, %B %d, %Y at %H:%M" localTime) - let systemPrompt = + let chatContext = + if Types.isGroupChat msg + then "\n\n## Chat Type\nThis is a GROUP CHAT. Apply the group response rules - only respond if appropriate." + else "\n\n## Chat Type\nThis is a PRIVATE CHAT. Always respond to the user." + systemPrompt = telegramSystemPrompt <> "\n\n## Current Date and Time\n" <> timeStr + <> chatContext <> "\n\n## Current User\n" <> "You are talking to: " <> userName @@ -505,18 +516,20 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do 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 (Types.tgOpenRouterApiKey tgConfig) uid chatId - - putText - <| "Responded to " - <> userName - <> " (cost: " - <> tshow (Engine.resultTotalCost agentResult) - <> " cents)" + if Types.isGroupChat msg + then putText "Agent chose not to respond (group chat)" + else do + putText "Warning: empty response from agent" + sendMessage tgConfig chatId "hmm, i don't have a response for that" + else do + sendMessage tgConfig chatId response + checkAndSummarize (Types.tgOpenRouterApiKey tgConfig) uid chatId + putText + <| "Responded to " + <> userName + <> " (cost: " + <> tshow (Engine.resultTotalCost agentResult) + <> " cents)" maxConversationTokens :: Int maxConversationTokens = 4000 -- cgit v1.2.3 From 7d516a14552e1c531935cfee27fb5edbf81e3b82 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 13 Dec 2025 00:57:06 -0500 Subject: telegram: add cheap pre-filter for group messages Use Gemini Flash to classify group messages before running the full Sonnet agent. Skips casual banter to save tokens/cost. - shouldEngageInGroup: yes/no classifier using gemini-2.0-flash - Only runs for group chats, private chats skip the filter - On classifier failure, defaults to engaging (fail-open) --- Omni/Agent/Telegram.hs | 68 +++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 65 insertions(+), 3 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index f8afcb7..27d7413 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -433,11 +433,35 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do let userMessage = replyContext <> baseMessage - _ <- Memory.saveMessage uid chatId Memory.UserRole (Just userName) userMessage + shouldEngage <- + if Types.isGroupChat msg + then do + putText "Checking if should engage (group chat)..." + shouldEngageInGroup (Types.tgOpenRouterApiKey tgConfig) userMessage + else pure True - (conversationContext, contextTokens) <- Memory.getConversationContext uid chatId maxConversationTokens - putText <| "Conversation context: " <> tshow contextTokens <> " tokens" + if not shouldEngage + then putText "Skipping group message (pre-filter said no)" + else do + _ <- Memory.saveMessage uid chatId Memory.UserRole (Just userName) userMessage + (conversationContext, contextTokens) <- Memory.getConversationContext uid chatId maxConversationTokens + putText <| "Conversation context: " <> tshow contextTokens <> " tokens" + + processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMessage conversationContext + +processEngagedMessage :: + Types.TelegramConfig -> + Provider.Provider -> + Engine.EngineConfig -> + Types.TelegramMessage -> + Text -> + Text -> + Int -> + Text -> + Text -> + IO () +processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMessage conversationContext = do memories <- Memory.recallMemories uid userMessage 5 let memoryContext = Memory.formatMemoriesForPrompt memories @@ -563,6 +587,44 @@ checkAndSummarize openRouterKey uid chatId = do _ <- Memory.summarizeAndArchive uid chatId summary putText "Conversation summarized and archived (gemini)" +shouldEngageInGroup :: Text -> Text -> IO Bool +shouldEngageInGroup openRouterKey messageText = do + let gemini = Provider.defaultOpenRouter openRouterKey "google/gemini-2.0-flash-001" + result <- + Provider.chat + gemini + [] + [ Provider.Message + Provider.System + ( Text.unlines + [ "You are a classifier that decides if an AI assistant should respond to a message in a group chat.", + "Respond with ONLY 'yes' or 'no' (lowercase, nothing else).", + "", + "Say 'yes' if:", + "- The message is a direct question the assistant could answer", + "- The message contains a factual error worth correcting", + "- The message mentions the bot or asks for help", + "- The message shares a link or document to analyze", + "", + "Say 'no' if:", + "- It's casual banter or chit-chat between people", + "- It's a greeting or farewell", + "- It's an inside joke or personal conversation", + "- It doesn't require or benefit from bot input" + ] + ) + Nothing + Nothing, + Provider.Message Provider.User messageText Nothing Nothing + ] + case result of + Left err -> do + putText <| "Engagement check failed: " <> err + pure True + Right msg -> do + let response = Text.toLower (Text.strip (Provider.msgContent msg)) + pure (response == "yes" || response == "y") + checkOllama :: IO (Either Text ()) checkOllama = do ollamaUrl <- fromMaybe "http://localhost:11434" Date: Sat, 13 Dec 2025 01:14:38 -0500 Subject: telegram: add conversation context to group pre-filter Pre-filter now sees last 5 messages so it can detect when user is continuing a conversation with Ava, even without explicit mention. - Fetch recent messages before shouldEngageInGroup - Update classifier prompt to understand Ava context - Handle follow-up messages to bot's previous responses --- Omni/Agent/Telegram.hs | 33 +++++++++++++++++++++++++-------- 1 file changed, 25 insertions(+), 8 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 27d7413..ee6784b 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -437,7 +437,21 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do if Types.isGroupChat msg then do putText "Checking if should engage (group chat)..." - shouldEngageInGroup (Types.tgOpenRouterApiKey tgConfig) userMessage + recentMsgs <- Memory.getRecentMessages uid chatId 5 + let recentContext = + if null recentMsgs + then "" + else + Text.unlines + [ "[Recent conversation for context]", + Text.unlines + [ (if Memory.cmRole m == Memory.UserRole then "User: " else "Ava: ") <> Memory.cmContent m + | m <- reverse recentMsgs + ], + "", + "[New message to classify]" + ] + shouldEngageInGroup (Types.tgOpenRouterApiKey tgConfig) (recentContext <> userMessage) else pure True if not shouldEngage @@ -597,20 +611,23 @@ shouldEngageInGroup openRouterKey messageText = do [ Provider.Message Provider.System ( Text.unlines - [ "You are a classifier that decides if an AI assistant should respond to a message in a group chat.", + [ "You are a classifier that decides if an AI assistant named 'Ava' should respond to a message in a group chat.", + "You may be given recent conversation context to help decide.", "Respond with ONLY 'yes' or 'no' (lowercase, nothing else).", "", "Say 'yes' if:", - "- The message is a direct question the assistant could answer", + "- The message is a direct question Ava could answer", "- The message contains a factual error worth correcting", - "- The message mentions the bot or asks for help", + "- The message mentions Ava or asks for help", "- The message shares a link or document to analyze", + "- The message is a follow-up to a conversation Ava was just participating in", + "- The user is clearly talking to Ava based on context (e.g. Ava just responded)", "", "Say 'no' if:", - "- It's casual banter or chit-chat between people", - "- It's a greeting or farewell", - "- It's an inside joke or personal conversation", - "- It doesn't require or benefit from bot input" + "- It's casual banter or chit-chat between people (not involving Ava)", + "- It's a greeting or farewell not directed at Ava", + "- It's an inside joke or personal conversation between humans", + "- It doesn't require or benefit from Ava's input" ] ) Nothing -- cgit v1.2.3 From 1c7b30005af27dcc3345f7dee0fe0404c3bc8c49 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 13 Dec 2025 08:21:23 -0500 Subject: fix: accumulate streaming tool call arguments across SSE chunks OpenAI's SSE streaming sends tool calls incrementally - the first chunk has the id and function name, subsequent chunks contain argument fragments. Previously each chunk was treated as a complete tool call, causing invalid JSON arguments. - Add ToolCallDelta type with index for partial tool call data - Add StreamToolCallDelta chunk type - Track tool calls by index in IntMap accumulator - Merge argument fragments across chunks via mergeToolCallDelta - Build final ToolCall objects from accumulator when stream ends - Handle new StreamToolCallDelta in Engine.hs pattern match --- Omni/Agent/Telegram.hs | 87 +++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 82 insertions(+), 5 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index ee6784b..d6a8a30 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -30,6 +30,8 @@ module Omni.Agent.Telegram -- * Telegram API getUpdates, sendMessage, + sendMessageReturningId, + editMessage, sendTypingAction, -- * Media (re-exported from Media) @@ -67,8 +69,9 @@ import Data.Aeson ((.=)) import qualified Data.Aeson as Aeson import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.ByteString.Lazy as BL +import Data.IORef (modifyIORef, newIORef, readIORef, writeIORef) import qualified Data.Text as Text -import Data.Time (getCurrentTime, utcToLocalTime) +import Data.Time (UTCTime (..), getCurrentTime, utcToLocalTime) import Data.Time.Format (defaultTimeLocale, formatTime) import Data.Time.LocalTime (getCurrentTimeZone) import qualified Network.HTTP.Client as HTTPClient @@ -221,6 +224,11 @@ getBotUsername cfg = do sendMessage :: Types.TelegramConfig -> Int -> Text -> IO () sendMessage cfg chatId text = do + _ <- sendMessageReturningId cfg chatId text + pure () + +sendMessageReturningId :: Types.TelegramConfig -> Int -> Text -> IO (Maybe Int) +sendMessageReturningId cfg chatId text = do let url = Text.unpack (Types.tgApiBaseUrl cfg) <> "/bot" @@ -232,6 +240,38 @@ sendMessage cfg chatId text = do "text" .= text ] req0 <- HTTP.parseRequest url + let req = + HTTP.setRequestMethod "POST" + <| HTTP.setRequestHeader "Content-Type" ["application/json"] + <| HTTP.setRequestBodyLBS (Aeson.encode body) + <| req0 + result <- try @SomeException (HTTP.httpLBS req) + case result of + Left _ -> pure Nothing + Right response -> do + let respBody = HTTP.getResponseBody response + case Aeson.decode respBody of + Just (Aeson.Object obj) -> case KeyMap.lookup "result" obj of + Just (Aeson.Object msgObj) -> case KeyMap.lookup "message_id" msgObj of + Just (Aeson.Number n) -> pure (Just (round n)) + _ -> pure Nothing + _ -> pure Nothing + _ -> pure Nothing + +editMessage :: Types.TelegramConfig -> Int -> Int -> Text -> IO () +editMessage cfg chatId messageId text = do + let url = + Text.unpack (Types.tgApiBaseUrl cfg) + <> "/bot" + <> Text.unpack (Types.tgBotToken cfg) + <> "/editMessageText" + body = + Aeson.object + [ "chat_id" .= chatId, + "message_id" .= messageId, + "text" .= text + ] + req0 <- HTTP.parseRequest url let req = HTTP.setRequestMethod "POST" <| HTTP.setRequestHeader "Content-Type" ["application/json"] @@ -540,12 +580,40 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe } } - result <- Engine.runAgentWithProvider engineCfg provider agentCfg userMessage + streamState <- newIORef StreamInit + lastUpdate <- newIORef (0 :: Int) + accumulatedText <- newIORef ("" :: Text) + + let onStreamChunk txt = do + modifyIORef accumulatedText (<> txt) + streamSt <- readIORef streamState + currentText <- readIORef accumulatedText + currentTime <- getCurrentTime + let nowMs = round (utctDayTime currentTime * 1000) :: Int + lastTime <- readIORef lastUpdate + + case streamSt of + StreamInit | Text.length currentText >= 20 -> do + maybeId <- sendMessageReturningId tgConfig chatId (currentText <> "...") + case maybeId of + Just msgId -> do + writeIORef streamState (StreamActive msgId) + writeIORef lastUpdate nowMs + Nothing -> pure () + StreamActive msgId | nowMs - lastTime > 400 -> do + editMessage tgConfig chatId msgId (currentText <> "...") + writeIORef lastUpdate nowMs + _ -> pure () + + result <- Engine.runAgentWithProviderStreaming engineCfg provider agentCfg userMessage onStreamChunk case result of Left err -> do putText <| "Agent error: " <> err - sendMessage tgConfig chatId "Sorry, I encountered an error. Please try again." + streamSt <- readIORef streamState + case streamSt of + StreamActive msgId -> editMessage tgConfig chatId msgId ("error: " <> err) + _ -> sendMessage tgConfig chatId "Sorry, I encountered an error. Please try again." Right agentResult -> do let response = Engine.resultFinalMessage agentResult putText <| "Response text: " <> Text.take 200 response @@ -558,9 +626,15 @@ 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" - sendMessage tgConfig chatId "hmm, i don't have a response for that" + streamSt <- readIORef streamState + case streamSt of + StreamActive msgId -> editMessage tgConfig chatId msgId "hmm, i don't have a response for that" + _ -> sendMessage tgConfig chatId "hmm, i don't have a response for that" else do - sendMessage tgConfig chatId response + streamSt <- readIORef streamState + case streamSt of + StreamActive msgId -> editMessage tgConfig chatId msgId response + _ -> sendMessage tgConfig chatId response checkAndSummarize (Types.tgOpenRouterApiKey tgConfig) uid chatId putText <| "Responded to " @@ -569,6 +643,9 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe <> tshow (Engine.resultTotalCost agentResult) <> " cents)" +data StreamState = StreamInit | StreamActive Int + deriving (Show, Eq) + maxConversationTokens :: Int maxConversationTokens = 4000 -- cgit v1.2.3 From 399fcfd8b9536c54e4bf77d2d791ffb88b3a0257 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 13 Dec 2025 09:00:26 -0500 Subject: feat: enable Markdown rendering in Telegram messages Add parse_mode=Markdown to sendMessage and editMessage API calls --- Omni/Agent/Telegram.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index d6a8a30..68527b7 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -237,7 +237,8 @@ sendMessageReturningId cfg chatId text = do body = Aeson.object [ "chat_id" .= chatId, - "text" .= text + "text" .= text, + "parse_mode" .= ("Markdown" :: Text) ] req0 <- HTTP.parseRequest url let req = @@ -269,7 +270,8 @@ editMessage cfg chatId messageId text = do Aeson.object [ "chat_id" .= chatId, "message_id" .= messageId, - "text" .= text + "text" .= text, + "parse_mode" .= ("Markdown" :: Text) ] req0 <- HTTP.parseRequest url let req = -- cgit v1.2.3 From 5ba051535138630b333657a6540728a9148c766a Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 13 Dec 2025 09:03:23 -0500 Subject: feat: allow all users in group chats, whitelist only for DMs --- Omni/Agent/Telegram.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 68527b7..5dcf914 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -349,11 +349,14 @@ handleMessage tgConfig provider engineCfg _botUsername msg = do chatId = Types.tmChatId msg usrId = Types.tmUserId msg - unless (Types.isUserAllowed tgConfig usrId) <| do + let isGroup = Types.isGroupChat msg + isAllowed = isGroup || Types.isUserAllowed tgConfig usrId + + unless isAllowed <| do putText <| "Unauthorized user: " <> tshow usrId <> " (" <> userName <> ")" sendMessage tgConfig chatId "sorry, you're not authorized to use this bot." - when (Types.isUserAllowed tgConfig usrId) <| do + when isAllowed <| do sendTypingAction tgConfig chatId user <- Memory.getOrCreateUserByTelegramId usrId userName -- cgit v1.2.3 From ed629a3335c6c5a172322a8d7387f0c6990b0ae5 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 13 Dec 2025 09:14:39 -0500 Subject: feat: only allow whitelisted users to add bot to groups When the bot is added to a group, check if the user who added it is in the whitelist. If not, send a message explaining and leave the group immediately. This prevents unauthorized users from bypassing DM access controls by adding the bot to a group. --- Omni/Agent/Telegram.hs | 68 ++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 61 insertions(+), 7 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 5dcf914..418e589 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -33,6 +33,7 @@ module Omni.Agent.Telegram sendMessageReturningId, editMessage, sendTypingAction, + leaveChat, -- * Media (re-exported from Media) getFile, @@ -173,6 +174,11 @@ telegramSystemPrompt = getUpdates :: Types.TelegramConfig -> Int -> IO [Types.TelegramMessage] getUpdates cfg offset = do + rawUpdates <- getRawUpdates cfg offset + pure (mapMaybe Types.parseUpdate rawUpdates) + +getRawUpdates :: Types.TelegramConfig -> Int -> IO [Aeson.Value] +getRawUpdates cfg offset = do let url = Text.unpack (Types.tgApiBaseUrl cfg) <> "/bot" @@ -194,8 +200,7 @@ getUpdates cfg offset = do let body = HTTP.getResponseBody response case Aeson.decode body of Just (Aeson.Object obj) -> case KeyMap.lookup "result" obj of - Just (Aeson.Array updates) -> - pure (mapMaybe Types.parseUpdate (toList updates)) + Just (Aeson.Array updates) -> pure (toList updates) _ -> pure [] _ -> pure [] @@ -303,6 +308,26 @@ sendTypingAction cfg chatId = do _ <- try @SomeException (HTTP.httpLBS req) pure () +leaveChat :: Types.TelegramConfig -> Int -> IO () +leaveChat cfg chatId = do + let url = + Text.unpack (Types.tgApiBaseUrl cfg) + <> "/bot" + <> Text.unpack (Types.tgBotToken cfg) + <> "/leaveChat" + body = + Aeson.object + [ "chat_id" .= chatId + ] + req0 <- HTTP.parseRequest url + let req = + HTTP.setRequestMethod "POST" + <| HTTP.setRequestHeader "Content-Type" ["application/json"] + <| HTTP.setRequestBodyLBS (Aeson.encode body) + <| req0 + _ <- try @SomeException (HTTP.httpLBS req) + pure () + runTelegramBot :: Types.TelegramConfig -> Provider.Provider -> IO () runTelegramBot tgConfig provider = do putText "Starting Telegram bot..." @@ -329,11 +354,40 @@ runTelegramBot tgConfig provider = do forever <| do offset <- readTVarIO offsetVar - messages <- getUpdates tgConfig offset - forM_ messages <| \msg -> do - atomically (writeTVar offsetVar (Types.tmUpdateId msg + 1)) - handleMessage tgConfig provider engineCfg botName msg - when (null messages) <| threadDelay 1000000 + rawUpdates <- getRawUpdates tgConfig offset + forM_ rawUpdates <| \rawUpdate -> do + case Types.parseBotAddedToGroup botName rawUpdate of + Just addedEvent -> do + atomically (writeTVar offsetVar (Types.bagUpdateId addedEvent + 1)) + handleBotAddedToGroup tgConfig addedEvent + Nothing -> case Types.parseUpdate rawUpdate of + Just msg -> do + atomically (writeTVar offsetVar (Types.tmUpdateId msg + 1)) + handleMessage tgConfig provider engineCfg botName msg + Nothing -> do + let updateId = getUpdateId rawUpdate + forM_ updateId <| \uid -> atomically (writeTVar offsetVar (uid + 1)) + when (null rawUpdates) <| threadDelay 1000000 + +getUpdateId :: Aeson.Value -> Maybe Int +getUpdateId (Aeson.Object obj) = case KeyMap.lookup "update_id" obj of + Just (Aeson.Number n) -> Just (round n) + _ -> Nothing +getUpdateId _ = Nothing + +handleBotAddedToGroup :: Types.TelegramConfig -> Types.BotAddedToGroup -> IO () +handleBotAddedToGroup tgConfig addedEvent = do + let addedBy = Types.bagAddedByUserId addedEvent + chatId = Types.bagChatId addedEvent + firstName = Types.bagAddedByFirstName addedEvent + if Types.isUserAllowed tgConfig addedBy + then do + putText <| "Bot added to group " <> tshow chatId <> " by authorized user " <> firstName <> " (" <> tshow addedBy <> ")" + sendMessage tgConfig chatId "hello! i'm ready to help." + else do + putText <| "Bot added to group " <> tshow chatId <> " by UNAUTHORIZED user " <> firstName <> " (" <> tshow addedBy <> ") - leaving" + sendMessage tgConfig chatId "sorry, you're not authorized to add me to groups." + leaveChat tgConfig chatId handleMessage :: Types.TelegramConfig -> -- cgit v1.2.3 From 0936eb15144e2fc15b073e989d6c5d700dc47435 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 13 Dec 2025 11:37:10 -0500 Subject: Add knowledge graph with typed relations to Memory module - Add RelationType with 6 relation types - Add MemoryLink type and memory_links table - Add graph functions: linkMemories, getMemoryLinks, queryGraph - Add link_memories and query_graph agent tools - Wire up graph tools to Telegram bot - Include memory ID in recall results for linking - Fix streaming usage parsing for cost tracking Closes t-255 Amp-Thread-ID: https://ampcode.com/threads/T-019b181f-d6cd-70de-8857-c445baef7508 Co-authored-by: Amp --- Omni/Agent/Telegram.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 418e589..091ad11 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -602,7 +602,9 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe let memoryTools = [ Memory.rememberTool uid, - Memory.recallTool uid + Memory.recallTool uid, + Memory.linkMemoriesTool uid, + Memory.queryGraphTool uid ] searchTools = case Types.tgKagiApiKey tgConfig of Just kagiKey -> [WebSearch.webSearchTool kagiKey] -- cgit v1.2.3 From e99cd405657ba3192c8ef6d46f5e1901b3916522 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 13 Dec 2025 12:11:21 -0500 Subject: Fix Telegram streaming markdown parse errors Amp-Thread-ID: https://ampcode.com/threads/T-019b1894-b431-777d-aba3-65a51e720ef2 Co-authored-by: Amp --- Omni/Agent/Telegram.hs | 28 ++++++++++++++++++++++++---- 1 file changed, 24 insertions(+), 4 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 091ad11..0089472 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -72,6 +72,7 @@ import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.ByteString.Lazy as BL import Data.IORef (modifyIORef, newIORef, readIORef, writeIORef) import qualified Data.Text as Text +import qualified Data.Text.Encoding as TE import Data.Time (UTCTime (..), getCurrentTime, utcToLocalTime) import Data.Time.Format (defaultTimeLocale, formatTime) import Data.Time.LocalTime (getCurrentTimeZone) @@ -149,6 +150,20 @@ telegramSystemPrompt = "", "prioritize esoteric interpretations of literature, art, and philosophy.", "", + "## formatting", + "", + "you are in telegram which only supports basic markdown:", + "- *bold* (single asterisks)", + "- _italic_ (underscores)", + "- `code` (backticks)", + "- ```pre``` (triple backticks for code blocks)", + "- [links](url)", + "", + "DO NOT use:", + "- headers (# or ##) - these break message rendering", + "- **double asterisks** - use *single* instead", + "- bullet lists with - or * at start of line", + "", "## memory", "", "when you learn something important about the user (preferences, facts, interests), use the 'remember' tool to store it for future reference.", @@ -275,8 +290,7 @@ editMessage cfg chatId messageId text = do Aeson.object [ "chat_id" .= chatId, "message_id" .= messageId, - "text" .= text, - "parse_mode" .= ("Markdown" :: Text) + "text" .= text ] req0 <- HTTP.parseRequest url let req = @@ -284,8 +298,14 @@ editMessage cfg chatId messageId text = do <| HTTP.setRequestHeader "Content-Type" ["application/json"] <| HTTP.setRequestBodyLBS (Aeson.encode body) <| req0 - _ <- try @SomeException (HTTP.httpLBS req) - pure () + result <- try @SomeException (HTTP.httpLBS req) + case result of + Left err -> putText <| "Edit message failed: " <> tshow err + Right response -> do + let status = HTTP.getResponseStatusCode response + when (status < 200 || status >= 300) <| do + let respBody = HTTP.getResponseBody response + putText <| "Edit message HTTP " <> tshow status <> ": " <> TE.decodeUtf8 (BL.toStrict respBody) sendTypingAction :: Types.TelegramConfig -> Int -> IO () sendTypingAction cfg chatId = do -- cgit v1.2.3 From 4d21f170cd1d1df239d7ad00fbf79427769a140f Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 13 Dec 2025 13:09:32 -0500 Subject: telegram: unified message queue with async/scheduled sends - Add Messages.hs with scheduled_messages table and dispatcher loop - All outbound messages now go through the queue (1s polling) - Disable streaming responses, use runAgentWithProvider instead - Add send_message tool for delayed messages (up to 30 days) - Add list_pending_messages and cancel_message tools - Reminders now queue messages instead of sending directly - Exponential backoff retry (max 5 attempts) for failed sends --- Omni/Agent/Telegram.hs | 94 +++++++++++++++++++++----------------------------- 1 file changed, 39 insertions(+), 55 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 0089472..b3a93b9 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -70,10 +70,9 @@ import Data.Aeson ((.=)) import qualified Data.Aeson as Aeson import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.ByteString.Lazy as BL -import Data.IORef (modifyIORef, newIORef, readIORef, writeIORef) import qualified Data.Text as Text import qualified Data.Text.Encoding as TE -import Data.Time (UTCTime (..), getCurrentTime, utcToLocalTime) +import Data.Time (getCurrentTime, utcToLocalTime) import Data.Time.Format (defaultTimeLocale, formatTime) import Data.Time.LocalTime (getCurrentTimeZone) import qualified Network.HTTP.Client as HTTPClient @@ -82,6 +81,7 @@ import qualified Omni.Agent.Engine as Engine import qualified Omni.Agent.Memory as Memory import qualified Omni.Agent.Provider as Provider import qualified Omni.Agent.Telegram.Media as Media +import qualified Omni.Agent.Telegram.Messages as Messages import qualified Omni.Agent.Telegram.Reminders as Reminders import qualified Omni.Agent.Telegram.Types as Types import qualified Omni.Agent.Tools.Calendar as Calendar @@ -114,11 +114,11 @@ recordUserChat = Reminders.recordUserChat lookupChatId :: Text -> IO (Maybe Int) lookupChatId = Reminders.lookupChatId -reminderLoop :: Types.TelegramConfig -> IO () -reminderLoop cfg = Reminders.reminderLoop cfg sendMessage +reminderLoop :: IO () +reminderLoop = Reminders.reminderLoop -checkAndSendReminders :: Types.TelegramConfig -> IO () -checkAndSendReminders cfg = Reminders.checkAndSendReminders cfg sendMessage +checkAndSendReminders :: IO () +checkAndSendReminders = Reminders.checkAndSendReminders main :: IO () main = Test.run test @@ -181,6 +181,14 @@ telegramSystemPrompt = "when in doubt, stay silent. you don't need to participate in every conversation.", "if you choose not to respond, return an empty message (just don't say anything).", "", + "## async messages", + "", + "you can send messages asynchronously using the 'send_message' tool:", + "- delay_seconds=0 (or omit) for immediate delivery", + "- delay_seconds=N to schedule a message N seconds in the future", + "- use this for reminders ('remind me in 2 hours'), follow-ups, or multi-part responses", + "- you can list pending messages with 'list_pending_messages' and cancel with 'cancel_message'", + "", "## important", "", "in private chats, ALWAYS respond. in group chats, follow the rules above.", @@ -359,9 +367,13 @@ runTelegramBot tgConfig provider = do Just name -> putText <| "Bot username: @" <> name let botName = fromMaybe "bot" botUsername - _ <- forkIO (reminderLoop tgConfig) + _ <- forkIO reminderLoop putText "Reminder loop started (checking every 5 minutes)" + let sendFn = sendMessageReturningId tgConfig + _ <- forkIO (Messages.messageDispatchLoop sendFn) + putText "Message dispatch loop started (1s polling)" + let engineCfg = Engine.defaultEngineConfig { Engine.engineOnToolCall = \toolName args -> @@ -403,10 +415,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 <> ")" - sendMessage tgConfig chatId "hello! i'm ready to help." + _ <- Messages.enqueueImmediate Nothing chatId "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" - sendMessage tgConfig chatId "sorry, you're not authorized to add me to groups." + _ <- Messages.enqueueImmediate Nothing chatId "sorry, you're not authorized to add me to groups." (Just "system") Nothing leaveChat tgConfig chatId handleMessage :: @@ -428,7 +441,8 @@ handleMessage tgConfig provider engineCfg _botUsername msg = do unless isAllowed <| do putText <| "Unauthorized user: " <> tshow usrId <> " (" <> userName <> ")" - sendMessage tgConfig chatId "sorry, you're not authorized to use this bot." + _ <- Messages.enqueueImmediate Nothing chatId "sorry, you're not authorized to use this bot." (Just "system") Nothing + pure () when isAllowed <| do sendTypingAction tgConfig chatId @@ -469,7 +483,7 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do case Media.checkPhotoSize photo of Left err -> do putText <| "Photo rejected: " <> err - sendMessage tgConfig chatId err + _ <- Messages.enqueueImmediate (Just uid) chatId err (Just "system") Nothing pure Nothing Right () -> do putText <| "Processing photo: " <> tshow (Types.tpWidth photo) <> "x" <> tshow (Types.tpHeight photo) @@ -495,14 +509,14 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do case Media.checkVoiceSize voice of Left err -> do putText <| "Voice rejected: " <> err - sendMessage tgConfig chatId err + _ <- Messages.enqueueImmediate (Just uid) chatId 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 - sendMessage tgConfig chatId err + _ <- Messages.enqueueImmediate (Just uid) chatId err (Just "system") Nothing pure Nothing else do putText <| "Processing voice message: " <> tshow (Types.tvDuration voice) <> " seconds" @@ -647,7 +661,12 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe Todos.todoCompleteTool uid, Todos.todoDeleteTool uid ] - tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools + messageTools = + [ Messages.sendMessageTool uid chatId, + Messages.listPendingMessagesTool uid chatId, + Messages.cancelMessageTool + ] + tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools let agentCfg = Engine.defaultAgentConfig @@ -661,40 +680,13 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe } } - streamState <- newIORef StreamInit - lastUpdate <- newIORef (0 :: Int) - accumulatedText <- newIORef ("" :: Text) - - let onStreamChunk txt = do - modifyIORef accumulatedText (<> txt) - streamSt <- readIORef streamState - currentText <- readIORef accumulatedText - currentTime <- getCurrentTime - let nowMs = round (utctDayTime currentTime * 1000) :: Int - lastTime <- readIORef lastUpdate - - case streamSt of - StreamInit | Text.length currentText >= 20 -> do - maybeId <- sendMessageReturningId tgConfig chatId (currentText <> "...") - case maybeId of - Just msgId -> do - writeIORef streamState (StreamActive msgId) - writeIORef lastUpdate nowMs - Nothing -> pure () - StreamActive msgId | nowMs - lastTime > 400 -> do - editMessage tgConfig chatId msgId (currentText <> "...") - writeIORef lastUpdate nowMs - _ -> pure () - - result <- Engine.runAgentWithProviderStreaming engineCfg provider agentCfg userMessage onStreamChunk + result <- Engine.runAgentWithProvider engineCfg provider agentCfg userMessage case result of Left err -> do putText <| "Agent error: " <> err - streamSt <- readIORef streamState - case streamSt of - StreamActive msgId -> editMessage tgConfig chatId msgId ("error: " <> err) - _ -> sendMessage tgConfig chatId "Sorry, I encountered an error. Please try again." + _ <- Messages.enqueueImmediate (Just uid) chatId "sorry, i hit an error. please try again." (Just "agent_error") Nothing + pure () Right agentResult -> do let response = Engine.resultFinalMessage agentResult putText <| "Response text: " <> Text.take 200 response @@ -707,15 +699,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" - streamSt <- readIORef streamState - case streamSt of - StreamActive msgId -> editMessage tgConfig chatId msgId "hmm, i don't have a response for that" - _ -> sendMessage tgConfig chatId "hmm, i don't have a response for that" + _ <- Messages.enqueueImmediate (Just uid) chatId "hmm, i don't have a response for that" (Just "agent_response") Nothing + pure () else do - streamSt <- readIORef streamState - case streamSt of - StreamActive msgId -> editMessage tgConfig chatId msgId response - _ -> sendMessage tgConfig chatId response + _ <- Messages.enqueueImmediate (Just uid) chatId response (Just "agent_response") Nothing checkAndSummarize (Types.tgOpenRouterApiKey tgConfig) uid chatId putText <| "Responded to " @@ -724,9 +711,6 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe <> tshow (Engine.resultTotalCost agentResult) <> " cents)" -data StreamState = StreamInit | StreamActive Int - deriving (Show, Eq) - maxConversationTokens :: Int maxConversationTokens = 4000 -- cgit v1.2.3 From 54fba81956d1834a1e17fcfde47614d9ef617ad8 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 13 Dec 2025 14:02:35 -0500 Subject: Add incoming message queue for Telegram bot Batches incoming messages by chat_id with a 3-second sliding window before processing. This prevents confusion when messages arrive simultaneously from different chats. - New IncomingQueue module with STM-based in-memory queue - Messages enqueued immediately, offset acked on enqueue - 200ms tick loop flushes batches past deadline - Batch formatting: numbered messages, sender attribution for groups, media stubs, reply context - Media from first message in batch still gets full processing --- Omni/Agent/Telegram.hs | 165 ++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 164 insertions(+), 1 deletion(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index b3a93b9..ad2fc3b 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -80,6 +80,7 @@ import qualified Network.HTTP.Simple as HTTP import qualified Omni.Agent.Engine as Engine import qualified Omni.Agent.Memory as Memory import qualified Omni.Agent.Provider as Provider +import qualified Omni.Agent.Telegram.IncomingQueue as IncomingQueue import qualified Omni.Agent.Telegram.Media as Media import qualified Omni.Agent.Telegram.Messages as Messages import qualified Omni.Agent.Telegram.Reminders as Reminders @@ -374,6 +375,8 @@ runTelegramBot tgConfig provider = do _ <- forkIO (Messages.messageDispatchLoop sendFn) putText "Message dispatch loop started (1s polling)" + incomingQueues <- IncomingQueue.newIncomingQueues + let engineCfg = Engine.defaultEngineConfig { Engine.engineOnToolCall = \toolName args -> @@ -384,6 +387,10 @@ runTelegramBot tgConfig provider = do putText <| "Agent: " <> activity } + let processBatch = handleMessageBatch tgConfig provider engineCfg botName + _ <- forkIO (IncomingQueue.startIncomingBatcher incomingQueues processBatch) + putText "Incoming message batcher started (3s window, 200ms tick)" + forever <| do offset <- readTVarIO offsetVar rawUpdates <- getRawUpdates tgConfig offset @@ -395,7 +402,7 @@ runTelegramBot tgConfig provider = do Nothing -> case Types.parseUpdate rawUpdate of Just msg -> do atomically (writeTVar offsetVar (Types.tmUpdateId msg + 1)) - handleMessage tgConfig provider engineCfg botName msg + IncomingQueue.enqueueIncoming incomingQueues IncomingQueue.defaultBatchWindowSeconds msg Nothing -> do let updateId = getUpdateId rawUpdate forM_ updateId <| \uid -> atomically (writeTVar offsetVar (uid + 1)) @@ -422,6 +429,37 @@ handleBotAddedToGroup tgConfig addedEvent = do _ <- Messages.enqueueImmediate Nothing chatId "sorry, you're not authorized to add me to groups." (Just "system") Nothing leaveChat tgConfig chatId +handleMessageBatch :: + Types.TelegramConfig -> + Provider.Provider -> + Engine.EngineConfig -> + Text -> + Types.TelegramMessage -> + Text -> + IO () +handleMessageBatch tgConfig provider engineCfg _botUsername msg batchedText = do + let userName = + Types.tmUserFirstName msg + <> maybe "" (" " <>) (Types.tmUserLastName msg) + chatId = Types.tmChatId msg + usrId = Types.tmUserId msg + + let isGroup = Types.isGroupChat msg + isAllowed = isGroup || Types.isUserAllowed tgConfig usrId + + 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 + pure () + + when isAllowed <| do + sendTypingAction tgConfig chatId + + user <- Memory.getOrCreateUserByTelegramId usrId userName + let uid = Memory.userId user + + handleAuthorizedMessageBatch tgConfig provider engineCfg msg uid userName chatId batchedText + handleMessage :: Types.TelegramConfig -> Provider.Provider -> @@ -597,6 +635,131 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMessage conversationContext +handleAuthorizedMessageBatch :: + Types.TelegramConfig -> + Provider.Provider -> + Engine.EngineConfig -> + Types.TelegramMessage -> + Text -> + Text -> + Int -> + Text -> + IO () +handleAuthorizedMessageBatch tgConfig provider engineCfg msg uid userName chatId batchedText = do + Reminders.recordUserChat uid chatId + + pdfContent <- case Types.tmDocument msg of + Just doc | Types.isPdf doc -> do + putText <| "Processing PDF: " <> fromMaybe "(unnamed)" (Types.tdFileName doc) + result <- Media.downloadAndExtractPdf tgConfig (Types.tdFileId doc) + case result of + Left err -> do + putText <| "PDF extraction failed: " <> err + pure Nothing + Right text -> do + let truncated = Text.take 40000 text + putText <| "Extracted " <> tshow (Text.length truncated) <> " chars from PDF" + pure (Just truncated) + _ -> pure Nothing + + photoAnalysis <- case Types.tmPhoto msg of + Just photo -> do + case Media.checkPhotoSize photo of + Left err -> do + putText <| "Photo rejected: " <> err + _ <- Messages.enqueueImmediate (Just uid) chatId err (Just "system") Nothing + pure Nothing + Right () -> do + putText <| "Processing photo: " <> tshow (Types.tpWidth photo) <> "x" <> tshow (Types.tpHeight photo) + bytesResult <- Media.downloadPhoto tgConfig photo + case bytesResult of + Left err -> do + putText <| "Photo download failed: " <> err + pure Nothing + Right bytes -> do + putText <| "Downloaded photo, " <> tshow (BL.length bytes) <> " bytes, analyzing..." + analysisResult <- Media.analyzeImage (Types.tgOpenRouterApiKey tgConfig) bytes (Types.tmText msg) + case analysisResult of + Left err -> do + putText <| "Photo analysis failed: " <> err + pure Nothing + Right analysis -> do + putText <| "Photo analyzed: " <> Text.take 100 analysis <> "..." + pure (Just analysis) + Nothing -> pure Nothing + + voiceTranscription <- case Types.tmVoice msg of + Just voice -> do + case Media.checkVoiceSize voice of + Left err -> do + putText <| "Voice rejected: " <> err + _ <- Messages.enqueueImmediate (Just uid) chatId 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 + pure Nothing + else do + putText <| "Processing voice message: " <> tshow (Types.tvDuration voice) <> " seconds" + bytesResult <- Media.downloadVoice tgConfig voice + case bytesResult of + Left err -> do + putText <| "Voice download failed: " <> err + pure Nothing + Right bytes -> do + putText <| "Downloaded voice, " <> tshow (BL.length bytes) <> " bytes, transcribing..." + transcribeResult <- Media.transcribeVoice (Types.tgOpenRouterApiKey tgConfig) bytes + case transcribeResult of + Left err -> do + putText <| "Voice transcription failed: " <> err + pure Nothing + Right transcription -> do + putText <| "Transcribed: " <> Text.take 100 transcription <> "..." + pure (Just transcription) + Nothing -> pure Nothing + + let mediaPrefix = case (pdfContent, photoAnalysis, voiceTranscription) of + (Just pdfText, _, _) -> "---\nPDF content:\n\n" <> pdfText <> "\n\n---\n\n" + (_, Just analysis, _) -> "[attached image description: " <> analysis <> "]\n\n" + (_, _, Just transcription) -> "[voice transcription: " <> transcription <> "]\n\n" + _ -> "" + + let userMessage = mediaPrefix <> batchedText + + shouldEngage <- + if Types.isGroupChat msg + then do + putText "Checking if should engage (group chat)..." + recentMsgs <- Memory.getRecentMessages uid chatId 5 + let recentContext = + if null recentMsgs + then "" + else + Text.unlines + [ "[Recent conversation for context]", + Text.unlines + [ (if Memory.cmRole m == Memory.UserRole then "User: " else "Ava: ") <> Memory.cmContent m + | m <- reverse recentMsgs + ], + "", + "[New message to classify]" + ] + shouldEngageInGroup (Types.tgOpenRouterApiKey tgConfig) (recentContext <> userMessage) + else pure True + + if not shouldEngage + then putText "Skipping group message (pre-filter said no)" + else do + _ <- Memory.saveMessage uid chatId Memory.UserRole (Just userName) userMessage + + (conversationContext, contextTokens) <- Memory.getConversationContext uid chatId maxConversationTokens + putText <| "Conversation context: " <> tshow contextTokens <> " tokens" + + processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMessage conversationContext + processEngagedMessage :: Types.TelegramConfig -> Provider.Provider -> -- cgit v1.2.3 From 38c4ea7fcb86ea78448e7097fcd8689d37d78399 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 13 Dec 2025 14:46:33 -0500 Subject: fix: use OpenAI Whisper for voice transcription OpenRouter's chat completion API doesn't properly pass audio to models. Switched to calling OpenAI's /v1/audio/transcriptions endpoint directly with the whisper-1 model. Requires OPENAI_API_KEY environment variable. --- Omni/Agent/Telegram.hs | 2 -- 1 file changed, 2 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index ad2fc3b..61127b4 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -603,7 +603,6 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do _ -> Types.tmText msg let userMessage = replyContext <> baseMessage - shouldEngage <- if Types.isGroupChat msg then do @@ -728,7 +727,6 @@ handleAuthorizedMessageBatch tgConfig provider engineCfg msg uid userName chatId _ -> "" let userMessage = mediaPrefix <> batchedText - shouldEngage <- if Types.isGroupChat msg then do -- cgit v1.2.3 From c35ba7d248642386544a776f86815e01630eb50d Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 13 Dec 2025 15:03:11 -0500 Subject: feat: add Telegram topic (message_thread_id) support - Parse message_thread_id from incoming messages - Include thread_id in sendMessage API calls - Pass thread_id through message queue system - Replies now go to the correct topic in supergroups --- Omni/Agent/Telegram.hs | 49 ++++++++++++++++++++++++++----------------------- 1 file changed, 26 insertions(+), 23 deletions(-) (limited to 'Omni/Agent/Telegram.hs') 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 " -- cgit v1.2.3 From 6bcd3c868c607064552dd18572dffbe067531bd2 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 13 Dec 2025 20:26:11 -0500 Subject: telegram: per-user memory in groups, continuous typing Memory changes: - Add thread_id column to conversation_messages for topic support - Add saveGroupMessage/getGroupConversationContext for shared history - Add storeGroupMemory/recallGroupMemories with 'group:' user - Fix SQLite busy error: set busy_timeout before journal_mode Telegram changes: - Group chats now use shared conversation context (chat_id, thread_id) - Personal memories stay with user, group memories shared across group - Memory context shows [Personal] and [Group] prefixes - Add withTypingIndicator: refreshes typing every 4s while agent thinks - Fix typing UX: indicator now shows continuously until response sent --- Omni/Agent/Telegram.hs | 98 ++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 72 insertions(+), 26 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 8804ebb..993f2e0 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -340,6 +340,21 @@ sendTypingAction cfg chatId = do _ <- try @SomeException (HTTP.httpLBS req) pure () +-- | Run an action while continuously showing typing indicator. +-- Typing is refreshed every 4 seconds (Telegram typing expires after ~5s). +withTypingIndicator :: Types.TelegramConfig -> Int -> IO a -> IO a +withTypingIndicator cfg chatId action = do + doneVar <- newTVarIO False + _ <- forkIO <| typingLoop doneVar + action `finally` atomically (writeTVar doneVar True) + where + typingLoop doneVar = do + done <- readTVarIO doneVar + unless done <| do + sendTypingAction cfg chatId + threadDelay 4000000 + typingLoop doneVar + leaveChat :: Types.TelegramConfig -> Int -> IO () leaveChat cfg chatId = do let url = @@ -404,10 +419,12 @@ runTelegramBot tgConfig provider = do handleBotAddedToGroup tgConfig addedEvent Nothing -> case Types.parseUpdate rawUpdate of Just msg -> do + putText <| "Received message from " <> Types.tmUserFirstName msg <> " in chat " <> tshow (Types.tmChatId msg) <> " (type: " <> tshow (Types.tmChatType msg) <> "): " <> Text.take 50 (Types.tmText msg) atomically (writeTVar offsetVar (Types.tmUpdateId msg + 1)) IncomingQueue.enqueueIncoming incomingQueues IncomingQueue.defaultBatchWindowSeconds msg Nothing -> do let updateId = getUpdateId rawUpdate + putText <| "Unparsed update: " <> Text.take 200 (tshow rawUpdate) forM_ updateId <| \uid -> atomically (writeTVar offsetVar (uid + 1)) when (null rawUpdates) <| threadDelay 1000000 @@ -456,11 +473,8 @@ handleMessageBatch tgConfig provider engineCfg _botUsername msg batchedText = do pure () when isAllowed <| do - sendTypingAction tgConfig chatId - user <- Memory.getOrCreateUserByTelegramId usrId userName let uid = Memory.userId user - handleAuthorizedMessageBatch tgConfig provider engineCfg msg uid userName chatId batchedText handleMessage :: @@ -486,11 +500,8 @@ handleMessage tgConfig provider engineCfg _botUsername msg = do pure () when isAllowed <| do - sendTypingAction tgConfig chatId - user <- Memory.getOrCreateUserByTelegramId usrId userName let uid = Memory.userId user - handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId handleAuthorizedMessage :: @@ -606,11 +617,14 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do _ -> Types.tmText msg let userMessage = replyContext <> baseMessage + isGroup = Types.isGroupChat msg + threadId = Types.tmThreadId msg + shouldEngage <- - if Types.isGroupChat msg + if isGroup then do putText "Checking if should engage (group chat)..." - recentMsgs <- Memory.getRecentMessages uid chatId 5 + recentMsgs <- Memory.getGroupRecentMessages chatId threadId 5 let recentContext = if null recentMsgs then "" @@ -618,7 +632,7 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do Text.unlines [ "[Recent conversation for context]", Text.unlines - [ (if Memory.cmRole m == Memory.UserRole then "User: " else "Ava: ") <> Memory.cmContent m + [ fromMaybe "User" (Memory.cmSenderName m) <> ": " <> Memory.cmContent m | m <- reverse recentMsgs ], "", @@ -630,9 +644,14 @@ handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do if not shouldEngage then putText "Skipping group message (pre-filter said no)" else do - _ <- Memory.saveMessage uid chatId Memory.UserRole (Just userName) userMessage - - (conversationContext, contextTokens) <- Memory.getConversationContext uid chatId maxConversationTokens + (conversationContext, contextTokens) <- + if isGroup + then do + _ <- Memory.saveGroupMessage chatId threadId Memory.UserRole userName userMessage + Memory.getGroupConversationContext chatId threadId maxConversationTokens + else do + _ <- Memory.saveMessage uid chatId Memory.UserRole (Just userName) userMessage + Memory.getConversationContext uid chatId maxConversationTokens putText <| "Conversation context: " <> tshow contextTokens <> " tokens" processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMessage conversationContext @@ -730,11 +749,14 @@ handleAuthorizedMessageBatch tgConfig provider engineCfg msg uid userName chatId _ -> "" let userMessage = mediaPrefix <> batchedText + isGroup = Types.isGroupChat msg + threadId = Types.tmThreadId msg + shouldEngage <- - if Types.isGroupChat msg + if isGroup then do putText "Checking if should engage (group chat)..." - recentMsgs <- Memory.getRecentMessages uid chatId 5 + recentMsgs <- Memory.getGroupRecentMessages chatId threadId 5 let recentContext = if null recentMsgs then "" @@ -742,7 +764,7 @@ handleAuthorizedMessageBatch tgConfig provider engineCfg msg uid userName chatId Text.unlines [ "[Recent conversation for context]", Text.unlines - [ (if Memory.cmRole m == Memory.UserRole then "User: " else "Ava: ") <> Memory.cmContent m + [ fromMaybe "User" (Memory.cmSenderName m) <> ": " <> Memory.cmContent m | m <- reverse recentMsgs ], "", @@ -754,9 +776,14 @@ handleAuthorizedMessageBatch tgConfig provider engineCfg msg uid userName chatId if not shouldEngage then putText "Skipping group message (pre-filter said no)" else do - _ <- Memory.saveMessage uid chatId Memory.UserRole (Just userName) userMessage - - (conversationContext, contextTokens) <- Memory.getConversationContext uid chatId maxConversationTokens + (conversationContext, contextTokens) <- + if isGroup + then do + _ <- Memory.saveGroupMessage chatId threadId Memory.UserRole userName userMessage + Memory.getGroupConversationContext chatId threadId maxConversationTokens + else do + _ <- Memory.saveMessage uid chatId Memory.UserRole (Just userName) userMessage + Memory.getConversationContext uid chatId maxConversationTokens putText <| "Conversation context: " <> tshow contextTokens <> " tokens" processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMessage conversationContext @@ -773,8 +800,22 @@ processEngagedMessage :: Text -> IO () processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMessage conversationContext = do - memories <- Memory.recallMemories uid userMessage 5 - let memoryContext = Memory.formatMemoriesForPrompt memories + let isGroup = Types.isGroupChat msg + + personalMemories <- Memory.recallMemories uid userMessage 5 + groupMemories <- + if isGroup + then Memory.recallGroupMemories chatId userMessage 3 + else pure [] + + let allMemories = personalMemories <> groupMemories + memoryContext = + if null allMemories + then "No memories found." + else + Text.unlines + <| ["[Personal] " <> Memory.memoryContent m | m <- personalMemories] + <> ["[Group] " <> Memory.memoryContent m | m <- groupMemories] now <- getCurrentTime tz <- getCurrentTimeZone @@ -844,7 +885,9 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe } } - result <- Engine.runAgentWithProvider engineCfg provider agentCfg userMessage + result <- + withTypingIndicator tgConfig chatId + <| Engine.runAgentWithProvider engineCfg provider agentCfg userMessage case result of Left err -> do @@ -853,21 +896,24 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe pure () Right agentResult -> do let response = Engine.resultFinalMessage agentResult + threadId = Types.tmThreadId msg putText <| "Response text: " <> Text.take 200 response - _ <- Memory.saveMessage uid chatId Memory.AssistantRole Nothing response + if isGroup + then void <| Memory.saveGroupMessage chatId threadId Memory.AssistantRole "Ava" response + else void <| Memory.saveMessage uid chatId Memory.AssistantRole Nothing response if Text.null response then do - if Types.isGroupChat msg + if isGroup then putText "Agent chose not to respond (group chat)" else do putText "Warning: empty response from agent" - _ <- Messages.enqueueImmediate (Just uid) chatId (Types.tmThreadId msg) "hmm, i don't have a response for that" (Just "agent_response") Nothing + _ <- Messages.enqueueImmediate (Just uid) chatId threadId "hmm, i don't have a response for that" (Just "agent_response") Nothing pure () else do - _ <- Messages.enqueueImmediate (Just uid) chatId (Types.tmThreadId msg) response (Just "agent_response") Nothing - checkAndSummarize (Types.tgOpenRouterApiKey tgConfig) uid chatId + _ <- Messages.enqueueImmediate (Just uid) chatId threadId response (Just "agent_response") Nothing + unless isGroup <| checkAndSummarize (Types.tgOpenRouterApiKey tgConfig) uid chatId putText <| "Responded to " <> userName -- cgit v1.2.3 From fe5e8064a4f7311c8e3fe6eb4d9e95d16e1d0250 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 13 Dec 2025 20:30:11 -0500 Subject: telegram: round cost to 2 decimal places in logs --- Omni/Agent/Telegram.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 993f2e0..148bb6a 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -93,6 +93,7 @@ import qualified Omni.Agent.Tools.WebReader as WebReader import qualified Omni.Agent.Tools.WebSearch as WebSearch import qualified Omni.Test as Test import System.Environment (lookupEnv) +import Text.Printf (printf) defaultTelegramConfig :: Text -> [Int] -> Maybe Text -> Text -> Types.TelegramConfig defaultTelegramConfig = Types.defaultTelegramConfig @@ -914,11 +915,13 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe else do _ <- Messages.enqueueImmediate (Just uid) chatId threadId response (Just "agent_response") Nothing unless isGroup <| checkAndSummarize (Types.tgOpenRouterApiKey tgConfig) uid chatId + let cost = Engine.resultTotalCost agentResult + costStr = Text.pack (printf "%.2f" cost) putText <| "Responded to " <> userName <> " (cost: " - <> tshow (Engine.resultTotalCost agentResult) + <> costStr <> " cents)" maxConversationTokens :: Int -- cgit v1.2.3 From 23edd144ed952802f9ea0fd1103a1e83db916b89 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sat, 13 Dec 2025 22:01:49 -0500 Subject: Add hledger tools to Telegram bot - New Omni/Agent/Tools/Hledger.hs with 5 tools: - hledger_balance: query account balances - hledger_register: show transaction history - hledger_add: create new transactions - hledger_income_statement: income vs expenses - hledger_balance_sheet: net worth view - All tools support currency parameter (default: USD) - Balance, register, income_statement support period parameter - Period uses hledger syntax (thismonth, 2024, from X to Y) - Shell escaping fixed for multi-word period strings - Authorization: only Ben and Kate get hledger tools - Max iterations increased from 5 to 10 - Transactions written to ~/fund/telegram-transactions.journal --- Omni/Agent/Telegram.hs | 30 ++++++++++++++++++++++++++++-- 1 file changed, 28 insertions(+), 2 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 148bb6a..977e590 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -86,6 +86,7 @@ import qualified Omni.Agent.Telegram.Messages as Messages import qualified Omni.Agent.Telegram.Reminders as Reminders import qualified Omni.Agent.Telegram.Types as Types import qualified Omni.Agent.Tools.Calendar as Calendar +import qualified Omni.Agent.Tools.Hledger as Hledger import qualified Omni.Agent.Tools.Notes as Notes import qualified Omni.Agent.Tools.Pdf as Pdf import qualified Omni.Agent.Tools.Todos as Todos @@ -827,11 +828,27 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe if Types.isGroupChat msg then "\n\n## Chat Type\nThis is a GROUP CHAT. Apply the group response rules - only respond if appropriate." else "\n\n## Chat Type\nThis is a PRIVATE CHAT. Always respond to the user." + hledgerContext = + if isHledgerAuthorized userName + then + Text.unlines + [ "", + "## hledger (personal finance)", + "", + "you have access to hledger tools for querying and recording financial transactions.", + "account naming: ex (expenses), as (assets), li (liabilities), in (income), eq (equity).", + "level 2 is owner: 'me' (personal) or 'us' (shared/family).", + "level 3 is type: need (necessary), want (discretionary), cash, cred (credit), vest (investments).", + "examples: ex:me:want:grooming, as:us:cash:checking, li:us:cred:chase.", + "when user says 'i spent $X at Y', use hledger_add with appropriate accounts." + ] + else "" systemPrompt = telegramSystemPrompt <> "\n\n## Current Date and Time\n" <> timeStr <> chatContext + <> hledgerContext <> "\n\n## Current User\n" <> "You are talking to: " <> userName @@ -872,13 +889,17 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe Messages.listPendingMessagesTool uid chatId, Messages.cancelMessageTool ] - tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools + hledgerTools = + if isHledgerAuthorized userName + then Hledger.allHledgerTools + else [] + tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools let agentCfg = Engine.defaultAgentConfig { Engine.agentSystemPrompt = systemPrompt, Engine.agentTools = tools, - Engine.agentMaxIterations = 5, + Engine.agentMaxIterations = 10, Engine.agentGuardrails = Engine.defaultGuardrails { Engine.guardrailMaxCostCents = 10.0, @@ -930,6 +951,11 @@ maxConversationTokens = 4000 summarizationThreshold :: Int summarizationThreshold = 3000 +isHledgerAuthorized :: Text -> Bool +isHledgerAuthorized userName = + let lowerName = Text.toLower userName + in "ben" `Text.isInfixOf` lowerName || "kate" `Text.isInfixOf` lowerName + checkAndSummarize :: Text -> Text -> Int -> IO () checkAndSummarize openRouterKey uid chatId = do (_, currentTokens) <- Memory.getConversationContext uid chatId maxConversationTokens -- cgit v1.2.3 From 89d9fc7449ab2e799742470c3294c6e062e6de0b Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sun, 14 Dec 2025 20:57:09 -0500 Subject: telegram: switch to HaskellNet for IMAP, fix message delivery bugs - Replace openssl s_client with HaskellNet/HaskellNet-SSL for proper IMAP client support (better protocol handling, no manual parsing) - Add HaskellNet deps to Haskell.nix with doJailbreak for version bounds - Fix lost messages: sendMessageReturningId now throws on API errors instead of returning Nothing (which was incorrectly treated as success) - Auto-retry markdown parse errors as plain text - Hardcode benChatId for reliable email check loop startup --- Omni/Agent/Telegram.hs | 95 +++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 83 insertions(+), 12 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 977e590..6da1484 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -15,6 +15,8 @@ -- : dep aeson -- : dep http-conduit -- : dep stm +-- : dep HaskellNet +-- : dep HaskellNet-SSL module Omni.Agent.Telegram ( -- * Configuration (re-exported from Types) Types.TelegramConfig (..), @@ -86,6 +88,7 @@ import qualified Omni.Agent.Telegram.Messages as Messages import qualified Omni.Agent.Telegram.Reminders as Reminders import qualified Omni.Agent.Telegram.Types as Types import qualified Omni.Agent.Tools.Calendar as Calendar +import qualified Omni.Agent.Tools.Email as Email import qualified Omni.Agent.Tools.Hledger as Hledger import qualified Omni.Agent.Tools.Notes as Notes import qualified Omni.Agent.Tools.Pdf as Pdf @@ -136,6 +139,9 @@ test = pure () ] +benChatId :: Int +benChatId = 33193730 + telegramSystemPrompt :: Text telegramSystemPrompt = Text.unlines @@ -259,7 +265,11 @@ sendMessage cfg chatId text = do pure () sendMessageReturningId :: Types.TelegramConfig -> Int -> Maybe Int -> Text -> IO (Maybe Int) -sendMessageReturningId cfg chatId mThreadId text = do +sendMessageReturningId cfg chatId mThreadId text = + sendMessageWithParseMode cfg chatId mThreadId text (Just "Markdown") + +sendMessageWithParseMode :: Types.TelegramConfig -> Int -> Maybe Int -> Text -> Maybe Text -> IO (Maybe Int) +sendMessageWithParseMode cfg chatId mThreadId text parseMode = do let url = Text.unpack (Types.tgApiBaseUrl cfg) <> "/bot" @@ -267,13 +277,15 @@ sendMessageReturningId cfg chatId mThreadId text = do <> "/sendMessage" baseFields = [ "chat_id" .= chatId, - "text" .= text, - "parse_mode" .= ("Markdown" :: Text) + "text" .= text ] + parseModeFields = case parseMode of + Just mode -> ["parse_mode" .= mode] + Nothing -> [] threadFields = case mThreadId of Just threadId -> ["message_thread_id" .= threadId] Nothing -> [] - body = Aeson.object (baseFields <> threadFields) + body = Aeson.object (baseFields <> parseModeFields <> threadFields) req0 <- HTTP.parseRequest url let req = HTTP.setRequestMethod "POST" @@ -282,16 +294,47 @@ sendMessageReturningId cfg chatId mThreadId text = do <| req0 result <- try @SomeException (HTTP.httpLBS req) case result of - Left _ -> pure Nothing + Left e -> do + putText <| "Telegram sendMessage network error: " <> tshow e + throwIO e Right response -> do let respBody = HTTP.getResponseBody response case Aeson.decode respBody of - Just (Aeson.Object obj) -> case KeyMap.lookup "result" obj of - Just (Aeson.Object msgObj) -> case KeyMap.lookup "message_id" msgObj of - Just (Aeson.Number n) -> pure (Just (round n)) - _ -> pure Nothing - _ -> pure Nothing - _ -> pure Nothing + Just (Aeson.Object obj) -> do + let isOk = case KeyMap.lookup "ok" obj of + Just (Aeson.Bool True) -> True + _ -> False + if isOk + then case KeyMap.lookup "result" obj of + Just (Aeson.Object msgObj) -> case KeyMap.lookup "message_id" msgObj of + Just (Aeson.Number n) -> pure (Just (round n)) + _ -> pure Nothing + _ -> pure Nothing + else do + let errDesc = case KeyMap.lookup "description" obj of + Just (Aeson.String desc) -> desc + _ -> "Unknown Telegram API error" + errCode = case KeyMap.lookup "error_code" obj of + Just (Aeson.Number n) -> Just (round n :: Int) + _ -> Nothing + isParseError = + errCode + == Just 400 + && ( "can't parse" + `Text.isInfixOf` Text.toLower errDesc + || "parse entities" + `Text.isInfixOf` Text.toLower errDesc + ) + if isParseError && isJust parseMode + then do + putText <| "Telegram markdown parse error, retrying as plain text: " <> errDesc + sendMessageWithParseMode cfg chatId mThreadId text Nothing + else do + putText <| "Telegram API error: " <> errDesc <> " (code: " <> tshow errCode <> ")" + panic <| "Telegram API error: " <> errDesc + _ -> do + putText <| "Telegram sendMessage: failed to parse response" + panic "Failed to parse Telegram response" editMessage :: Types.TelegramConfig -> Int -> Int -> Text -> IO () editMessage cfg chatId messageId text = do @@ -391,6 +434,9 @@ runTelegramBot tgConfig provider = do _ <- forkIO reminderLoop putText "Reminder loop started (checking every 5 minutes)" + _ <- forkIO (Email.emailCheckLoop (sendMessageReturningId tgConfig) benChatId) + putText "Email check loop started (checking every 6 hours)" + let sendFn = sendMessageReturningId tgConfig _ <- forkIO (Messages.messageDispatchLoop sendFn) putText "Message dispatch loop started (1s polling)" @@ -843,12 +889,28 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe "when user says 'i spent $X at Y', use hledger_add with appropriate accounts." ] else "" + emailContext = + if isEmailAuthorized userName + then + Text.unlines + [ "", + "## email (ben@bensima.com)", + "", + "you have access to email tools for managing ben's inbox.", + "use email_check to see recent unread emails (returns uid, from, subject, date, has_unsubscribe).", + "use email_read to read full content of important emails.", + "use email_unsubscribe to unsubscribe from marketing/newsletters (clicks List-Unsubscribe link).", + "use email_archive to move FYI emails to archive.", + "prioritize: urgent items first, then emails needing response, then suggest unsubscribing from marketing." + ] + else "" systemPrompt = telegramSystemPrompt <> "\n\n## Current Date and Time\n" <> timeStr <> chatContext <> hledgerContext + <> emailContext <> "\n\n## Current User\n" <> "You are talking to: " <> userName @@ -893,7 +955,11 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe if isHledgerAuthorized userName then Hledger.allHledgerTools else [] - tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools + emailTools = + if isEmailAuthorized userName + then Email.allEmailTools + else [] + tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools let agentCfg = Engine.defaultAgentConfig @@ -956,6 +1022,11 @@ isHledgerAuthorized userName = let lowerName = Text.toLower userName in "ben" `Text.isInfixOf` lowerName || "kate" `Text.isInfixOf` lowerName +isEmailAuthorized :: Text -> Bool +isEmailAuthorized userName = + let lowerName = Text.toLower userName + in "ben" `Text.isInfixOf` lowerName + checkAndSummarize :: Text -> Text -> Int -> IO () checkAndSummarize openRouterKey uid chatId = do (_, currentTokens) <- Memory.getConversationContext uid chatId maxConversationTokens -- cgit v1.2.3 From 8c07a16dd9a7a3ad1847d0c665265e98f7df5438 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sun, 14 Dec 2025 22:45:09 -0500 Subject: Add python_exec tool for agent Python execution - Create Omni/Agent/Tools/Python.hs with python_exec tool - Execute Python snippets via subprocess with 30s default timeout - Return structured JSON with stdout, stderr, exit_code - Add 8 unit tests covering print, imports, errors, timeout - Wire tool into Telegram agent's tool list Completes t-265.1 --- Omni/Agent/Telegram.hs | 57 ++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 55 insertions(+), 2 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 6da1484..2f0a029 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -92,6 +92,7 @@ import qualified Omni.Agent.Tools.Email as Email import qualified Omni.Agent.Tools.Hledger as Hledger import qualified Omni.Agent.Tools.Notes as Notes import qualified Omni.Agent.Tools.Pdf as Pdf +import qualified Omni.Agent.Tools.Python as Python import qualified Omni.Agent.Tools.Todos as Todos import qualified Omni.Agent.Tools.WebReader as WebReader import qualified Omni.Agent.Tools.WebSearch as WebSearch @@ -959,7 +960,8 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe if isEmailAuthorized userName then Email.allEmailTools else [] - tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools + pythonTools = [Python.pythonExecTool] + tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools <> pythonTools let agentCfg = Engine.defaultAgentConfig @@ -1000,7 +1002,9 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe _ <- Messages.enqueueImmediate (Just uid) chatId threadId "hmm, i don't have a response for that" (Just "agent_response") Nothing pure () else do - _ <- Messages.enqueueImmediate (Just uid) chatId threadId response (Just "agent_response") Nothing + parts <- splitMessageForChat (Types.tgOpenRouterApiKey tgConfig) response + putText <| "Split response into " <> tshow (length parts) <> " parts" + enqueueMultipart (Just uid) chatId threadId parts (Just "agent_response") unless isGroup <| checkAndSummarize (Types.tgOpenRouterApiKey tgConfig) uid chatId let cost = Engine.resultTotalCost agentResult costStr = Text.pack (printf "%.2f" cost) @@ -1053,6 +1057,55 @@ checkAndSummarize openRouterKey uid chatId = do _ <- Memory.summarizeAndArchive uid chatId summary putText "Conversation summarized and archived (gemini)" +splitMessageForChat :: Text -> Text -> IO [Text] +splitMessageForChat openRouterKey message = do + if Text.length message < 200 + then pure [message] + else do + let haiku = Provider.defaultOpenRouter openRouterKey "anthropic/claude-haiku-4.5" + result <- + Provider.chat + haiku + [] + [ Provider.Message + Provider.System + ( Text.unlines + [ "Split this message into separate chat messages that feel natural in a messaging app.", + "Each part should be logically independent - a complete thought.", + "Separate parts with exactly '---' on its own line.", + "Keep the original text, just add separators. Don't add any commentary.", + "If the message is already short/simple, return it unchanged (no separators).", + "Aim for 2-4 parts maximum. Don't over-split.", + "", + "Good splits: between topics, after questions, between a statement and follow-up", + "Bad splits: mid-sentence, between closely related points" + ] + ) + Nothing + Nothing, + Provider.Message Provider.User message Nothing Nothing + ] + case result of + Left err -> do + putText <| "Message split failed: " <> err + pure [message] + Right msg -> do + let parts = map Text.strip (Text.splitOn "---" (Provider.msgContent msg)) + validParts = filter (not <. Text.null) parts + if null validParts + then pure [message] + else pure validParts + +enqueueMultipart :: Maybe Text -> Int -> Maybe Int -> [Text] -> Maybe Text -> IO () +enqueueMultipart _ _ _ [] _ = pure () +enqueueMultipart mUid chatId mThreadId parts msgType = do + forM_ (zip [0 ..] parts) <| \(i :: Int, part) -> do + if i == 0 + then void <| Messages.enqueueImmediate mUid chatId mThreadId part msgType Nothing + else do + let delaySeconds = fromIntegral (i * 2) + void <| Messages.enqueueDelayed mUid chatId mThreadId part delaySeconds msgType Nothing + shouldEngageInGroup :: Text -> Text -> IO Bool shouldEngageInGroup openRouterKey messageText = do let gemini = Provider.defaultOpenRouter openRouterKey "google/gemini-2.0-flash-001" -- cgit v1.2.3 From 6b4e8c4963ba286a6aaf3e6f1917290fee7677f3 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sun, 14 Dec 2025 22:52:20 -0500 Subject: Add HTTP request tools for agent API interactions - Create Omni/Agent/Tools/Http.hs with http_get and http_post tools - Support headers, query params, JSON body, 30s timeout - Return structured JSON with status, headers, body - Add 9 unit tests including real HTTP calls to httpbin.org - Wire tools into Telegram agent's tool list Completes t-265.2 --- Omni/Agent/Telegram.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 2f0a029..34cf0d1 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -90,6 +90,7 @@ import qualified Omni.Agent.Telegram.Types as Types import qualified Omni.Agent.Tools.Calendar as Calendar import qualified Omni.Agent.Tools.Email as Email import qualified Omni.Agent.Tools.Hledger as Hledger +import qualified Omni.Agent.Tools.Http as Http import qualified Omni.Agent.Tools.Notes as Notes import qualified Omni.Agent.Tools.Pdf as Pdf import qualified Omni.Agent.Tools.Python as Python @@ -961,7 +962,8 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe then Email.allEmailTools else [] pythonTools = [Python.pythonExecTool] - tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools <> pythonTools + httpTools = Http.allHttpTools + tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools <> pythonTools <> httpTools let agentCfg = Engine.defaultAgentConfig -- cgit v1.2.3 From f6bbf86e7e8e76c41b8163ce0b1996ee474fc560 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sun, 14 Dec 2025 23:12:47 -0500 Subject: Add outreach approval queue for Ava (t-265.3) - Create Omni/Agent/Tools/Outreach.hs with tools - Drafts stored in _/var/ava/outreach/{pending,approved,...} - Add Telegram commands: /review, /approve, /reject, /queue - Integrate outreach tools into agent's tool list Amp-Thread-ID: https://ampcode.com/threads/T-019b202c-2156-74db-aa4a-e0a2f4397fbb Co-authored-by: Amp --- Omni/Agent/Telegram.hs | 77 +++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 76 insertions(+), 1 deletion(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 34cf0d1..a61c2d0 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -92,6 +92,7 @@ import qualified Omni.Agent.Tools.Email as Email import qualified Omni.Agent.Tools.Hledger as Hledger import qualified Omni.Agent.Tools.Http as Http import qualified Omni.Agent.Tools.Notes as Notes +import qualified Omni.Agent.Tools.Outreach as Outreach import qualified Omni.Agent.Tools.Pdf as Pdf import qualified Omni.Agent.Tools.Python as Python import qualified Omni.Agent.Tools.Todos as Todos @@ -566,6 +567,22 @@ handleAuthorizedMessage :: handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId = do Reminders.recordUserChat uid chatId + let msgText = Types.tmText msg + threadId = Types.tmThreadId msg + cmdHandled <- handleOutreachCommand tgConfig chatId threadId msgText + when cmdHandled (pure ()) + unless cmdHandled <| handleAuthorizedMessageContinued tgConfig provider engineCfg msg uid userName chatId + +handleAuthorizedMessageContinued :: + Types.TelegramConfig -> + Provider.Provider -> + Engine.EngineConfig -> + Types.TelegramMessage -> + Text -> + Text -> + Int -> + IO () +handleAuthorizedMessageContinued tgConfig provider engineCfg msg uid userName chatId = do pdfContent <- case Types.tmDocument msg of Just doc | Types.isPdf doc -> do putText <| "Processing PDF: " <> fromMaybe "(unnamed)" (Types.tdFileName doc) @@ -963,7 +980,8 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe else [] pythonTools = [Python.pythonExecTool] httpTools = Http.allHttpTools - tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools <> pythonTools <> httpTools + outreachTools = Outreach.allOutreachTools + tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools <> pythonTools <> httpTools <> outreachTools let agentCfg = Engine.defaultAgentConfig @@ -1261,3 +1279,60 @@ loadAllowedUserIds = do Just idsStr -> do let ids = mapMaybe (readMaybe <. Text.unpack <. Text.strip) (Text.splitOn "," (Text.pack idsStr)) pure ids + +handleOutreachCommand :: Types.TelegramConfig -> Int -> Maybe Int -> Text -> IO Bool +handleOutreachCommand _tgConfig chatId mThreadId cmd + | "/review" `Text.isPrefixOf` cmd = do + pending <- Outreach.listDrafts Outreach.Pending + case pending of + [] -> do + _ <- Messages.enqueueImmediate Nothing chatId mThreadId "no pending outreach drafts" (Just "system") Nothing + pure True + (draft : _) -> do + let msg = formatDraftForReview draft + _ <- Messages.enqueueImmediate Nothing chatId mThreadId msg (Just "system") Nothing + pure True + | "/approve " `Text.isPrefixOf` cmd = do + let draftId = Text.strip (Text.drop 9 cmd) + result <- Outreach.approveDraft draftId + case result of + Left err -> do + _ <- Messages.enqueueImmediate Nothing chatId mThreadId ("error: " <> err) (Just "system") Nothing + pure True + Right draft -> do + _ <- Messages.enqueueImmediate Nothing chatId mThreadId ("approved: " <> Outreach.draftId draft) (Just "system") Nothing + pure True + | "/reject " `Text.isPrefixOf` cmd = do + let rest = Text.strip (Text.drop 8 cmd) + (draftId, reason) = case Text.breakOn " " rest of + (did, r) -> (did, if Text.null r then Nothing else Just (Text.strip r)) + result <- Outreach.rejectDraft draftId reason + case result of + Left err -> do + _ <- Messages.enqueueImmediate Nothing chatId mThreadId ("error: " <> err) (Just "system") Nothing + pure True + Right draft -> do + let reasonMsg = maybe "" (" reason: " <>) (Outreach.draftRejectReason draft) + _ <- Messages.enqueueImmediate Nothing chatId mThreadId ("rejected: " <> Outreach.draftId draft <> reasonMsg) (Just "system") Nothing + pure True + | "/queue" `Text.isPrefixOf` cmd = do + count <- Outreach.getPendingCount + _ <- Messages.enqueueImmediate Nothing chatId mThreadId (tshow count <> " pending outreach drafts") (Just "system") Nothing + pure True + | otherwise = pure False + +formatDraftForReview :: Outreach.OutreachDraft -> Text +formatDraftForReview draft = + Text.unlines + [ "*outreach draft*", + "", + "*id:* `" <> Outreach.draftId draft <> "`", + "*type:* " <> tshow (Outreach.draftType draft), + "*to:* " <> Outreach.draftRecipient draft, + maybe "" (\s -> "*subject:* " <> s <> "\n") (Outreach.draftSubject draft), + "*context:* " <> Outreach.draftContext draft, + "", + Outreach.draftBody draft, + "", + "reply `/approve " <> Outreach.draftId draft <> "` or `/reject " <> Outreach.draftId draft <> " [reason]`" + ] -- cgit v1.2.3 From a5030192113e43a80a95e4d48c40704546c31695 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sun, 14 Dec 2025 23:14:08 -0500 Subject: Fix message splitting to not use LLM The haiku-based splitting was modifying message content. Replace with deterministic paragraph-based splitting that preserves the original text exactly. --- Omni/Agent/Telegram.hs | 56 +++++++++++++++++--------------------------------- 1 file changed, 19 insertions(+), 37 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index a61c2d0..ed25a14 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -1078,43 +1078,25 @@ checkAndSummarize openRouterKey uid chatId = do putText "Conversation summarized and archived (gemini)" splitMessageForChat :: Text -> Text -> IO [Text] -splitMessageForChat openRouterKey message = do - if Text.length message < 200 - then pure [message] - else do - let haiku = Provider.defaultOpenRouter openRouterKey "anthropic/claude-haiku-4.5" - result <- - Provider.chat - haiku - [] - [ Provider.Message - Provider.System - ( Text.unlines - [ "Split this message into separate chat messages that feel natural in a messaging app.", - "Each part should be logically independent - a complete thought.", - "Separate parts with exactly '---' on its own line.", - "Keep the original text, just add separators. Don't add any commentary.", - "If the message is already short/simple, return it unchanged (no separators).", - "Aim for 2-4 parts maximum. Don't over-split.", - "", - "Good splits: between topics, after questions, between a statement and follow-up", - "Bad splits: mid-sentence, between closely related points" - ] - ) - Nothing - Nothing, - Provider.Message Provider.User message Nothing Nothing - ] - case result of - Left err -> do - putText <| "Message split failed: " <> err - pure [message] - Right msg -> do - let parts = map Text.strip (Text.splitOn "---" (Provider.msgContent msg)) - validParts = filter (not <. Text.null) parts - if null validParts - then pure [message] - else pure validParts +splitMessageForChat _openRouterKey message = do + let parts = splitOnParagraphs message + pure parts + +splitOnParagraphs :: Text -> [Text] +splitOnParagraphs message + | Text.length message < 300 = [message] + | otherwise = + let paragraphs = filter (not <. Text.null) (map Text.strip (Text.splitOn "\n\n" message)) + in if length paragraphs <= 1 + then [message] + else mergeTooShort paragraphs + +mergeTooShort :: [Text] -> [Text] +mergeTooShort [] = [] +mergeTooShort [x] = [x] +mergeTooShort (x : y : rest) + | Text.length x < 100 = mergeTooShort ((x <> "\n\n" <> y) : rest) + | otherwise = x : mergeTooShort (y : rest) enqueueMultipart :: Maybe Text -> Int -> Maybe Int -> [Text] -> Maybe Text -> IO () enqueueMultipart _ _ _ [] _ = pure () -- cgit v1.2.3 From 867ff4dca8c0e6ac000290bbbc0a7147c728011d Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Sun, 14 Dec 2025 23:20:23 -0500 Subject: t-265.4: Add read_file tool and PIL codebase context to Ava - Import Omni.Agent.Tools in Telegram.hs - Add readFileTool to Ava's tool list - Add podcastitlater context section to system prompt with key file paths --- Omni/Agent/Telegram.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index ed25a14..f950732 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -87,6 +87,7 @@ import qualified Omni.Agent.Telegram.Media as Media import qualified Omni.Agent.Telegram.Messages as Messages import qualified Omni.Agent.Telegram.Reminders as Reminders import qualified Omni.Agent.Telegram.Types as Types +import qualified Omni.Agent.Tools as Tools import qualified Omni.Agent.Tools.Calendar as Calendar import qualified Omni.Agent.Tools.Email as Email import qualified Omni.Agent.Tools.Hledger as Hledger @@ -201,6 +202,16 @@ telegramSystemPrompt = "- use this for reminders ('remind me in 2 hours'), follow-ups, or multi-part responses", "- you can list pending messages with 'list_pending_messages' and cancel with 'cancel_message'", "", + "## podcastitlater context", + "", + "you have access to the PodcastItLater codebase (a product Ben is building) via read_file:", + "- Biz/PodcastItLater.md - product overview and README", + "- Biz/PodcastItLater/DESIGN.md - architecture overview", + "- Biz/PodcastItLater/Web.py - web interface code", + "- Biz/PodcastItLater/Core.py - core logic", + "- Biz/PodcastItLater/Billing.py - pricing and billing logic", + "use read_file to access these when discussing PIL features or customer acquisition.", + "", "## important", "", "in private chats, ALWAYS respond. in group chats, follow the rules above.", @@ -981,7 +992,8 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe pythonTools = [Python.pythonExecTool] httpTools = Http.allHttpTools outreachTools = Outreach.allOutreachTools - tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools <> pythonTools <> httpTools <> outreachTools + fileTools = [Tools.readFileTool] + tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools <> pythonTools <> httpTools <> outreachTools <> fileTools let agentCfg = Engine.defaultAgentConfig -- cgit v1.2.3 From 0baab1972e30c0e4629e67152838e660b02a2537 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Mon, 15 Dec 2025 08:47:02 -0500 Subject: t-265.6: Add feedback collection endpoint for PIL - Add feedback table with migration in Core.py - Add FeedbackForm and FeedbackPage UI components - Add /feedback GET/POST routes and /api/feedback JSON endpoint - Add admin feedback view at /admin/feedback - Create Omni/Agent/Tools/Feedback.hs with feedback_list tool - Wire feedback tool into Telegram agent --- Omni/Agent/Telegram.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index f950732..76a7be9 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -90,6 +90,7 @@ import qualified Omni.Agent.Telegram.Types as Types import qualified Omni.Agent.Tools as Tools import qualified Omni.Agent.Tools.Calendar as Calendar import qualified Omni.Agent.Tools.Email as Email +import qualified Omni.Agent.Tools.Feedback as Feedback import qualified Omni.Agent.Tools.Hledger as Hledger import qualified Omni.Agent.Tools.Http as Http import qualified Omni.Agent.Tools.Notes as Notes @@ -992,8 +993,9 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe pythonTools = [Python.pythonExecTool] httpTools = Http.allHttpTools outreachTools = Outreach.allOutreachTools + feedbackTools = Feedback.allFeedbackTools fileTools = [Tools.readFileTool] - tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools <> pythonTools <> httpTools <> outreachTools <> fileTools + tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools <> pythonTools <> httpTools <> outreachTools <> feedbackTools <> fileTools let agentCfg = Engine.defaultAgentConfig -- cgit v1.2.3 From 4caefe45756fdc21df990b8d6e826c40db1b9c78 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Mon, 15 Dec 2025 08:51:23 -0500 Subject: Restrict new tools to Ben only python_exec, http_get/post, outreach_*, feedback_list, and read_file now require isBenAuthorized check, matching email/hledger pattern. --- Omni/Agent/Telegram.hs | 26 +++++++++++++++++++++----- 1 file changed, 21 insertions(+), 5 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 76a7be9..07c8e4b 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -990,11 +990,22 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe if isEmailAuthorized userName then Email.allEmailTools else [] - pythonTools = [Python.pythonExecTool] - httpTools = Http.allHttpTools - outreachTools = Outreach.allOutreachTools - feedbackTools = Feedback.allFeedbackTools - fileTools = [Tools.readFileTool] + pythonTools = + [Python.pythonExecTool | isBenAuthorized userName] + httpTools = + if isBenAuthorized userName + then Http.allHttpTools + else [] + outreachTools = + if isBenAuthorized userName + then Outreach.allOutreachTools + else [] + feedbackTools = + if isBenAuthorized userName + then Feedback.allFeedbackTools + else [] + fileTools = + [Tools.readFileTool | isBenAuthorized userName] tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools <> pythonTools <> httpTools <> outreachTools <> feedbackTools <> fileTools let agentCfg = @@ -1065,6 +1076,11 @@ isEmailAuthorized userName = let lowerName = Text.toLower userName in "ben" `Text.isInfixOf` lowerName +isBenAuthorized :: Text -> Bool +isBenAuthorized userName = + let lowerName = Text.toLower userName + in "ben" `Text.isInfixOf` lowerName + checkAndSummarize :: Text -> Text -> Int -> IO () checkAndSummarize openRouterKey uid chatId = do (_, currentTokens) <- Memory.getConversationContext uid chatId maxConversationTokens -- cgit v1.2.3 From 122d73ac9d2472f91ed00965d03d1e761da72699 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Tue, 16 Dec 2025 08:20:54 -0500 Subject: refactor: Rename Bot to Ava, remove cost guardrail - Rename Omni/Bot.hs to Omni/Ava.hs - Delete Omni/Bot.scm (unused Guile version) - Remove cost limit (was 10 cents, now 0) - Increase max iterations from 10 to 50 --- Omni/Agent/Telegram.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index 07c8e4b..a24c3b9 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -1012,10 +1012,10 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe Engine.defaultAgentConfig { Engine.agentSystemPrompt = systemPrompt, Engine.agentTools = tools, - Engine.agentMaxIterations = 10, + Engine.agentMaxIterations = 50, Engine.agentGuardrails = Engine.defaultGuardrails - { Engine.guardrailMaxCostCents = 10.0, + { Engine.guardrailMaxCostCents = 1000.0, Engine.guardrailMaxDuplicateToolCalls = 10 } } -- cgit v1.2.3 From bf64b25a2106ec04d91b3e8d7ee9e86fe9ff43ab Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Tue, 16 Dec 2025 13:40:40 -0500 Subject: Add skills system for ava - Create Omni/Agent/Skills.hs with skill loader and tools - Skills follow Claude Skills format (SKILL.md + scripts/references/assets) - Directory structure: _/var/ava/skills/{shared,}/ - Three tools: skill, list_skills, publish_skill - Users can publish private skills to shared - Integrate skills tools into Telegram bot - Create skill-creator meta-skill at _/var/ava/skills/shared/skill-creator/ --- Omni/Agent/Telegram.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index a24c3b9..e964688 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -82,6 +82,7 @@ import qualified Network.HTTP.Simple as HTTP import qualified Omni.Agent.Engine as Engine import qualified Omni.Agent.Memory as Memory import qualified Omni.Agent.Provider as Provider +import qualified Omni.Agent.Skills as Skills import qualified Omni.Agent.Telegram.IncomingQueue as IncomingQueue import qualified Omni.Agent.Telegram.Media as Media import qualified Omni.Agent.Telegram.Messages as Messages @@ -1006,7 +1007,12 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe else [] fileTools = [Tools.readFileTool | isBenAuthorized userName] - tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools <> pythonTools <> httpTools <> outreachTools <> feedbackTools <> fileTools + skillsTools = + [ Skills.skillTool userName, + Skills.listSkillsTool userName, + Skills.publishSkillTool userName + ] + tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools <> pythonTools <> httpTools <> outreachTools <> feedbackTools <> fileTools <> skillsTools let agentCfg = Engine.defaultAgentConfig -- cgit v1.2.3 From 91dff1309ceb0729bc3fdde61878f81fd3df4eec Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Wed, 17 Dec 2025 13:02:59 -0500 Subject: Add subagent system for Ava Enables orchestrator to spawn specialized subagents for focused tasks: - WebCrawler: web search + page reading (haiku, fast) - CodeReviewer: code analysis tools (sonnet, thorough) - DataExtractor: structured data extraction (haiku) - Researcher: combined web + codebase research (sonnet) Key features: - spawn_subagent tool with role-based tool selection - Per-subagent resource limits (timeout, cost, tokens) - Structured output with citations (claim, source_url, quote) - Separate API keys for OpenRouter vs Kagi - Efficiency-focused system prompts Defaults: 200k tokens, $1.00 cost cap, 600s timeout, 20 iterations --- Omni/Agent/Telegram.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index e964688..e94e73d 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -83,6 +83,7 @@ import qualified Omni.Agent.Engine as Engine import qualified Omni.Agent.Memory as Memory import qualified Omni.Agent.Provider as Provider import qualified Omni.Agent.Skills as Skills +import qualified Omni.Agent.Subagent as Subagent import qualified Omni.Agent.Telegram.IncomingQueue as IncomingQueue import qualified Omni.Agent.Telegram.Media as Media import qualified Omni.Agent.Telegram.Messages as Messages @@ -1012,7 +1013,17 @@ processEngagedMessage tgConfig provider engineCfg msg uid userName chatId userMe Skills.listSkillsTool userName, Skills.publishSkillTool userName ] - tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools <> pythonTools <> httpTools <> outreachTools <> feedbackTools <> fileTools <> skillsTools + subagentTools = + if isBenAuthorized userName + then + let keys = + Subagent.SubagentApiKeys + { Subagent.subagentOpenRouterKey = Types.tgOpenRouterApiKey tgConfig, + Subagent.subagentKagiKey = Types.tgKagiApiKey tgConfig + } + in [Subagent.spawnSubagentTool keys] + else [] + tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools <> pythonTools <> httpTools <> outreachTools <> feedbackTools <> fileTools <> skillsTools <> subagentTools let agentCfg = Engine.defaultAgentConfig -- cgit v1.2.3 From 337648981cc5a55935116141341521f4fce83214 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Wed, 17 Dec 2025 13:29:24 -0500 Subject: Add Ava systemd deployment with dedicated user and workspace - Add Omni.Agent.Paths module for configurable AVA_DATA_ROOT - Create ava Linux user in Users.nix with SSH key - Add systemd service in Beryllium/Ava.nix with graceful shutdown - Update Skills.hs and Outreach.hs to use configurable paths - Add startup logging of resolved paths in Telegram.hs - Create migration script for moving data from _/var/ava to /home/ava - Add deployment documentation in Beryllium/AVA.md In dev: AVA_DATA_ROOT unset uses _/var/ava/ In prod: AVA_DATA_ROOT=/home/ava via systemd Amp-Thread-ID: https://ampcode.com/threads/T-019b2d7e-bd88-7355-8133-275c65157aaf Co-authored-by: Amp --- Omni/Agent/Telegram.hs | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'Omni/Agent/Telegram.hs') diff --git a/Omni/Agent/Telegram.hs b/Omni/Agent/Telegram.hs index e94e73d..fd6c6b5 100644 --- a/Omni/Agent/Telegram.hs +++ b/Omni/Agent/Telegram.hs @@ -81,6 +81,7 @@ import qualified Network.HTTP.Client as HTTPClient import qualified Network.HTTP.Simple as HTTP import qualified Omni.Agent.Engine as Engine import qualified Omni.Agent.Memory as Memory +import qualified Omni.Agent.Paths as Paths import qualified Omni.Agent.Provider as Provider import qualified Omni.Agent.Skills as Skills import qualified Omni.Agent.Subagent as Subagent @@ -1281,6 +1282,10 @@ startBot maybeToken = do putText "Error: TELEGRAM_BOT_TOKEN not set and no --token provided" exitFailure + putText <| "AVA data root: " <> Text.pack Paths.avaDataRoot + putText <| "Skills dir: " <> Text.pack Paths.skillsDir + putText <| "Outreach dir: " <> Text.pack Paths.outreachDir + ensureOllama allowedIds <- loadAllowedUserIds -- cgit v1.2.3