path: root/Omni/Agent/Telegram.hs

{-# 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
-- : dep HaskellNet
-- : dep HaskellNet-SSL
module Omni.Agent.Telegram
  ( -- * Configuration (re-exported from Types)
    Types.TelegramConfig (..),
    defaultTelegramConfig,

    -- * Types (re-exported from Types)
    Types.TelegramMessage (..),
    Types.TelegramUpdate (..),
    Types.TelegramDocument (..),
    Types.TelegramPhoto (..),
    Types.TelegramVoice (..),

    -- * Telegram API
    getUpdates,
    sendMessage,
    sendMessageReturningId,
    editMessage,
    sendTypingAction,
    leaveChat,

    -- * Media (re-exported from Media)
    getFile,
    downloadFile,
    downloadAndExtractPdf,
    isPdf,

    -- * Bot Loop
    runTelegramBot,
    handleMessage,
    startBot,
    ensureOllama,
    checkOllama,
    pullEmbeddingModel,

    -- * Reminders (re-exported from Reminders)
    reminderLoop,
    checkAndSendReminders,
    recordUserChat,
    lookupChatId,

    -- * 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.ByteString.Lazy as BL
import qualified Data.Text as Text
import qualified Data.Text.Encoding as TE
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
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
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.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
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

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 :: IO ()
reminderLoop = Reminders.reminderLoop

checkAndSendReminders :: IO ()
checkAndSendReminders = Reminders.checkAndSendReminders

main :: IO ()
main = Test.run test

test :: Test.Tree
test =
  Test.group
    "Omni.Agent.Telegram"
    [ Test.unit "telegramSystemPrompt is non-empty" <| do
        Text.null telegramSystemPrompt Test.@=? False,
      Test.unit "getUpdates parses empty response" <| do
        pure ()
    ]

benChatId :: Int
benChatId = 33193730

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.",
      "",
      "## 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.",
      "",
      "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).",
      "",
      "## 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.",
      "when you DO respond, include a text response after using tools."
    ]

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"
          <> 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 <| "Error getting updates: " <> tshow e
      pure []
    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.Array updates) -> pure (toList updates)
          _ -> 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
  _ <- sendMessageReturningId cfg chatId Nothing text
  pure ()

sendMessageReturningId :: Types.TelegramConfig -> Int -> Maybe Int -> Text -> IO (Maybe Int)
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"
          <> Text.unpack (Types.tgBotToken cfg)
          <> "/sendMessage"
      baseFields =
        [ "chat_id" .= chatId,
          "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 <> parseModeFields <> threadFields)
  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 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) -> 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
  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"]
          <| HTTP.setRequestBodyLBS (Aeson.encode body)
          <| req0
  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
  let url =
        Text.unpack (Types.tgApiBaseUrl cfg)
          <> "/bot"
          <> Text.unpack (Types.tgBotToken cfg)
          <> "/sendChatAction"
      body =
        Aeson.object
          [ "chat_id" .= chatId,
            "action" .= ("typing" :: Text)
          ]
  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 ()

-- | 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 =
        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..."
  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
  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)"

  incomingQueues <- IncomingQueue.newIncomingQueues

  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
          }

  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
    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
            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

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 <> ")"
      _ <- 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 Nothing "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 Nothing "sorry, you're not authorized to use this bot." (Just "system") Nothing
    pure ()

  when isAllowed <| do
    user <- Memory.getOrCreateUserByTelegramId usrId userName
    let uid = Memory.userId user
    handleAuthorizedMessageBatch tgConfig provider engineCfg msg uid userName chatId batchedText

handleMessage ::
  Types.TelegramConfig ->
  Provider.Provider ->
  Engine.EngineConfig ->
  Text ->
  Types.TelegramMessage ->
  IO ()
handleMessage tgConfig provider engineCfg _botUsername msg = 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 Nothing "sorry, you're not authorized to use this bot." (Just "system") Nothing
    pure ()

  when isAllowed <| do
    user <- Memory.getOrCreateUserByTelegramId usrId userName
    let uid = Memory.userId user
    handleAuthorizedMessage tgConfig provider engineCfg msg uid userName chatId

handleAuthorizedMessage ::
  Types.TelegramConfig ->
  Provider.Provider ->
  Engine.EngineConfig ->
  Types.TelegramMessage ->
  Text ->
  Text ->
  Int ->
  IO ()
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)
      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 (Types.tmThreadId msg) 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 (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 (Types.tmThreadId msg) 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 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 = 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 = 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
        _ -> Types.tmText msg

  let userMessage = replyContext <> baseMessage
      isGroup = Types.isGroupChat msg
      threadId = Types.tmThreadId msg

  shouldEngage <-
    if isGroup
      then do
        putText "Checking if should engage (group chat)..."
        recentMsgs <- Memory.getGroupRecentMessages chatId threadId 5
        let recentContext =
              if null recentMsgs
                then ""
                else
                  Text.unlines
                    [ "[Recent conversation for context]",
                      Text.unlines
                        [ fromMaybe "User" (Memory.cmSenderName m) <> ": " <> 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
      (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

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 (Types.tmThreadId msg) 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 (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 (Types.tmThreadId msg) 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
      isGroup = Types.isGroupChat msg
      threadId = Types.tmThreadId msg

  shouldEngage <-
    if isGroup
      then do
        putText "Checking if should engage (group chat)..."
        recentMsgs <- Memory.getGroupRecentMessages chatId threadId 5
        let recentContext =
              if null recentMsgs
                then ""
                else
                  Text.unlines
                    [ "[Recent conversation for context]",
                      Text.unlines
                        [ fromMaybe "User" (Memory.cmSenderName m) <> ": " <> 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
      (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

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
  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
  let localTime = utcToLocalTime tz now
      timeStr = Text.pack (formatTime defaultTimeLocale "%A, %B %d, %Y at %H:%M" localTime)

  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."
      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 ""
      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
          <> "\n\n## What you know about this user\n"
          <> memoryContext
          <> "\n\n"
          <> conversationContext

  let memoryTools =
        [ Memory.rememberTool uid,
          Memory.recallTool uid,
          Memory.linkMemoriesTool uid,
          Memory.queryGraphTool uid
        ]
      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,
          Notes.noteListTool uid,
          Notes.noteDeleteTool uid
        ]
      calendarTools =
        [ Calendar.calendarListTool,
          Calendar.calendarAddTool,
          Calendar.calendarSearchTool
        ]
      todoTools =
        [ Todos.todoAddTool uid,
          Todos.todoListTool uid,
          Todos.todoCompleteTool uid,
          Todos.todoDeleteTool uid
        ]
      messageTools =
        [ Messages.sendMessageTool uid chatId (Types.tmThreadId msg),
          Messages.listPendingMessagesTool uid chatId,
          Messages.cancelMessageTool
        ]
      hledgerTools =
        if isHledgerAuthorized userName
          then Hledger.allHledgerTools
          else []
      emailTools =
        if isEmailAuthorized userName
          then Email.allEmailTools
          else []
      pythonTools = [Python.pythonExecTool]
      httpTools = Http.allHttpTools
      outreachTools = Outreach.allOutreachTools
      tools = memoryTools <> searchTools <> webReaderTools <> pdfTools <> notesTools <> calendarTools <> todoTools <> messageTools <> hledgerTools <> emailTools <> pythonTools <> httpTools <> outreachTools

  let agentCfg =
        Engine.defaultAgentConfig
          { Engine.agentSystemPrompt = systemPrompt,
            Engine.agentTools = tools,
            Engine.agentMaxIterations = 10,
            Engine.agentGuardrails =
              Engine.defaultGuardrails
                { Engine.guardrailMaxCostCents = 10.0,
                  Engine.guardrailMaxDuplicateToolCalls = 10
                }
          }

  result <-
    withTypingIndicator tgConfig chatId
      <| Engine.runAgentWithProvider engineCfg provider agentCfg userMessage

  case result of
    Left err -> do
      putText <| "Agent error: " <> err
      _ <- 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
          threadId = Types.tmThreadId msg
      putText <| "Response text: " <> Text.take 200 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 isGroup
            then putText "Agent chose not to respond (group chat)"
            else do
              putText "Warning: empty response from agent"
              _ <- Messages.enqueueImmediate (Just uid) chatId threadId "hmm, i don't have a response for that" (Just "agent_response") Nothing
              pure ()
        else do
          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)
          putText
            <| "Responded to "
            <> userName
            <> " (cost: "
            <> costStr
            <> " cents)"

maxConversationTokens :: Int
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

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
  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
            ]
        gemini = Provider.defaultOpenRouter openRouterKey "google/gemini-2.0-flash-001"
    summaryResult <-
      Provider.chat
        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
        ]
    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 (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"
  result <-
    Provider.chat
      gemini
      []
      [ Provider.Message
          Provider.System
          ( Text.unlines
              [ "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 Ava could answer",
                "- The message contains a factual error worth correcting",
                "- 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 (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
          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" </ lookupEnv "OLLAMA_URL"
  let url = ollamaUrl <> "/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))

pullEmbeddingModel :: IO (Either Text ())
pullEmbeddingModel = do
  ollamaUrl <- fromMaybe "http://localhost:11434" </ lookupEnv "OLLAMA_URL"
  let url = ollamaUrl <> "/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))

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

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

  ensureOllama

  allowedIds <- loadAllowedUserIds
  kagiKey <- fmap Text.pack </ lookupEnv "KAGI_API_KEY"

  apiKey <- lookupEnv "OPENROUTER_API_KEY"
  case apiKey of
    Nothing -> do
      putText "Error: OPENROUTER_API_KEY not set"
      exitFailure
    Just key -> do
      let orKey = Text.pack key
          tgConfig = Types.defaultTelegramConfig token allowedIds kagiKey orKey
          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

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

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]`"
    ]