summaryrefslogtreecommitdiff
path: root/Omni/Agent/Telegram.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Agent/Telegram.hs')
-rw-r--r--Omni/Agent/Telegram.hs95
1 files changed, 83 insertions, 12 deletions
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