summaryrefslogtreecommitdiff
path: root/Omni/Agent/Telegram
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Agent/Telegram')
-rw-r--r--Omni/Agent/Telegram/Media.hs306
-rw-r--r--Omni/Agent/Telegram/Reminders.hs107
-rw-r--r--Omni/Agent/Telegram/Types.hs549
3 files changed, 962 insertions, 0 deletions
diff --git a/Omni/Agent/Telegram/Media.hs b/Omni/Agent/Telegram/Media.hs
new file mode 100644
index 0000000..1ef35de
--- /dev/null
+++ b/Omni/Agent/Telegram/Media.hs
@@ -0,0 +1,306 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Telegram Media Handling - File downloads, image analysis, voice transcription.
+--
+-- : out omni-agent-telegram-media
+-- : dep aeson
+-- : dep http-conduit
+-- : dep base64-bytestring
+module Omni.Agent.Telegram.Media
+ ( -- * File Downloads
+ getFile,
+ downloadFile,
+ downloadFileBytes,
+ downloadPhoto,
+ downloadVoice,
+ downloadAndExtractPdf,
+
+ -- * Multimodal Processing
+ analyzeImage,
+ transcribeVoice,
+
+ -- * Size Limits
+ maxImageBytes,
+ maxVoiceBytes,
+ checkPhotoSize,
+ checkVoiceSize,
+
+ -- * HTTP Utilities
+ httpGetBytes,
+ httpPostJson,
+
+ -- * Testing
+ main,
+ test,
+ )
+where
+
+import Alpha
+import Data.Aeson ((.=))
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.KeyMap as KeyMap
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base64.Lazy as B64
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.CaseInsensitive as CI
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as TE
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TLE
+import qualified Network.HTTP.Client as HTTPClient
+import qualified Network.HTTP.Simple as HTTP
+import qualified Omni.Agent.Telegram.Types as Types
+import qualified Omni.Agent.Tools.Pdf as Pdf
+import qualified Omni.Test as Test
+import System.IO (hClose)
+import System.IO.Temp (withSystemTempFile)
+
+main :: IO ()
+main = Test.run test
+
+test :: Test.Tree
+test =
+ Test.group
+ "Omni.Agent.Telegram.Media"
+ [ Test.unit "maxImageBytes is 10MB" <| do
+ maxImageBytes Test.@=? 10_000_000,
+ Test.unit "maxVoiceBytes is 20MB" <| do
+ maxVoiceBytes Test.@=? 20_000_000,
+ Test.unit "checkPhotoSize accepts small photos" <| do
+ let photo = Types.TelegramPhoto "id" 800 600 (Just 100_000)
+ checkPhotoSize photo Test.@=? Right (),
+ Test.unit "checkPhotoSize rejects large photos" <| do
+ let photo = Types.TelegramPhoto "id" 800 600 (Just 15_000_000)
+ case checkPhotoSize photo of
+ Left _ -> pure ()
+ Right _ -> Test.assertFailure "Expected rejection",
+ Test.unit "checkVoiceSize accepts small voice" <| do
+ let voice = Types.TelegramVoice "id" 60 (Just "audio/ogg") (Just 500_000)
+ checkVoiceSize voice Test.@=? Right (),
+ Test.unit "checkVoiceSize rejects large voice" <| do
+ let voice = Types.TelegramVoice "id" 60 (Just "audio/ogg") (Just 25_000_000)
+ case checkVoiceSize voice of
+ Left _ -> pure ()
+ Right _ -> Test.assertFailure "Expected rejection"
+ ]
+
+maxImageBytes :: Int
+maxImageBytes = 10_000_000
+
+maxVoiceBytes :: Int
+maxVoiceBytes = 20_000_000
+
+checkPhotoSize :: Types.TelegramPhoto -> Either Text ()
+checkPhotoSize photo =
+ case Types.tpFileSize photo of
+ Just size
+ | size > maxImageBytes ->
+ Left <| "image too large (" <> tshow (size `div` 1_000_000) <> "MB), max " <> tshow (maxImageBytes `div` 1_000_000) <> "MB"
+ _ -> Right ()
+
+checkVoiceSize :: Types.TelegramVoice -> Either Text ()
+checkVoiceSize voice =
+ case Types.tvFileSize voice of
+ Just size
+ | size > maxVoiceBytes ->
+ Left <| "voice message too large (" <> tshow (size `div` 1_000_000) <> "MB), max " <> tshow (maxVoiceBytes `div` 1_000_000) <> "MB"
+ _ -> Right ()
+
+httpGetBytes :: String -> IO (Either Text BL.ByteString)
+httpGetBytes url = do
+ result <-
+ try <| do
+ req <- HTTP.parseRequest url
+ resp <- HTTP.httpLBS req
+ let status = HTTP.getResponseStatusCode resp
+ if status >= 200 && status < 300
+ then pure (Right (HTTP.getResponseBody resp))
+ else pure (Left ("HTTP " <> tshow status))
+ case result of
+ Left (e :: SomeException) -> pure (Left ("HTTP error: " <> tshow e))
+ Right r -> pure r
+
+httpPostJson :: String -> [(ByteString, ByteString)] -> Aeson.Value -> Int -> IO (Either Text BL.ByteString)
+httpPostJson url extraHeaders body timeoutSecs = do
+ result <-
+ try <| do
+ req0 <- HTTP.parseRequest url
+ let baseReq =
+ HTTP.setRequestMethod "POST"
+ <| HTTP.setRequestHeader "Content-Type" ["application/json"]
+ <| HTTP.setRequestBodyLBS (Aeson.encode body)
+ <| HTTP.setRequestResponseTimeout (HTTPClient.responseTimeoutMicro (timeoutSecs * 1000000))
+ <| req0
+ req = foldr addHeader baseReq extraHeaders
+ addHeader (name, value) = HTTP.addRequestHeader (CI.mk name) value
+ resp <- HTTP.httpLBS req
+ let status = HTTP.getResponseStatusCode resp
+ if status >= 200 && status < 300
+ then pure (Right (HTTP.getResponseBody resp))
+ else pure (Left ("HTTP " <> tshow status <> ": " <> shortBody resp))
+ case result of
+ Left (e :: SomeException) -> pure (Left ("HTTP error: " <> tshow e))
+ Right r -> pure r
+ where
+ shortBody r =
+ let b = BL.toStrict (HTTP.getResponseBody r)
+ in TE.decodeUtf8 (BS.take 200 b)
+
+getFile :: Types.TelegramConfig -> Text -> IO (Either Text Text)
+getFile cfg fileId = do
+ let url =
+ Text.unpack (Types.tgApiBaseUrl cfg)
+ <> "/bot"
+ <> Text.unpack (Types.tgBotToken cfg)
+ <> "/getFile?file_id="
+ <> Text.unpack fileId
+ result <- httpGetBytes url
+ case result of
+ Left err -> pure (Left err)
+ Right body ->
+ case Aeson.decode body of
+ Just (Aeson.Object obj) -> case KeyMap.lookup "result" obj of
+ Just (Aeson.Object resultObj) -> case KeyMap.lookup "file_path" resultObj of
+ Just (Aeson.String path) -> pure (Right path)
+ _ -> pure (Left "No file_path in response")
+ _ -> pure (Left "No result in response")
+ _ -> pure (Left "Failed to parse getFile response")
+
+downloadFileBytes :: Types.TelegramConfig -> Text -> IO (Either Text BL.ByteString)
+downloadFileBytes cfg filePath = do
+ let url =
+ "https://api.telegram.org/file/bot"
+ <> Text.unpack (Types.tgBotToken cfg)
+ <> "/"
+ <> Text.unpack filePath
+ httpGetBytes url
+
+downloadFile :: Types.TelegramConfig -> Text -> FilePath -> IO (Either Text ())
+downloadFile cfg filePath destPath = do
+ result <- downloadFileBytes cfg filePath
+ case result of
+ Left err -> pure (Left err)
+ Right bytes -> do
+ BL.writeFile destPath bytes
+ pure (Right ())
+
+downloadPhoto :: Types.TelegramConfig -> Types.TelegramPhoto -> IO (Either Text BL.ByteString)
+downloadPhoto cfg photo = do
+ filePathResult <- getFile cfg (Types.tpFileId photo)
+ case filePathResult of
+ Left err -> pure (Left err)
+ Right filePath -> downloadFileBytes cfg filePath
+
+downloadVoice :: Types.TelegramConfig -> Types.TelegramVoice -> IO (Either Text BL.ByteString)
+downloadVoice cfg voice = do
+ filePathResult <- getFile cfg (Types.tvFileId voice)
+ case filePathResult of
+ Left err -> pure (Left err)
+ Right filePath -> downloadFileBytes cfg filePath
+
+downloadAndExtractPdf :: Types.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
+
+parseOpenRouterResponse :: BL.ByteString -> Either Text Text
+parseOpenRouterResponse body =
+ case Aeson.decode body 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) -> Right content
+ Just Aeson.Null -> Left "No content in response"
+ _ -> Left "Unexpected content type in response"
+ _ -> Left "No message in choice"
+ _ -> Left "Empty choices array"
+ _ -> Left "No choices in response"
+ _ -> Left "Failed to parse response"
+
+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 objectively in third person. do not use first person pronouns like 'I can see'. just describe what is shown."
+ else userPrompt <> "\n\n(describe objectively in third person, no first person pronouns)"
+ 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
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ headers =
+ [ ("Authorization", "Bearer " <> encodeUtf8 apiKey),
+ ("HTTP-Referer", "https://omni.dev"),
+ ("X-Title", "Omni Agent")
+ ]
+ result <- httpPostJson "https://openrouter.ai/api/v1/chat/completions" headers body 120
+ case result of
+ Left err -> pure (Left ("Vision API error: " <> err))
+ Right respBody -> pure (first ("Vision API: " <>) (parseOpenRouterResponse respBody))
+
+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)
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ headers =
+ [ ("Authorization", "Bearer " <> encodeUtf8 apiKey),
+ ("HTTP-Referer", "https://omni.dev"),
+ ("X-Title", "Omni Agent")
+ ]
+ result <- httpPostJson "https://openrouter.ai/api/v1/chat/completions" headers body 120
+ case result of
+ Left err -> pure (Left ("Transcription API error: " <> err))
+ Right respBody -> pure (first ("Transcription API: " <>) (parseOpenRouterResponse respBody))
diff --git a/Omni/Agent/Telegram/Reminders.hs b/Omni/Agent/Telegram/Reminders.hs
new file mode 100644
index 0000000..706f9da
--- /dev/null
+++ b/Omni/Agent/Telegram/Reminders.hs
@@ -0,0 +1,107 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Telegram Reminders - Background reminder loop and user chat persistence.
+--
+-- : out omni-agent-telegram-reminders
+-- : dep sqlite-simple
+module Omni.Agent.Telegram.Reminders
+ ( -- * User Chat Persistence
+ initUserChatsTable,
+ recordUserChat,
+ lookupChatId,
+
+ -- * Reminder Loop
+ reminderLoop,
+ checkAndSendReminders,
+
+ -- * Testing
+ main,
+ test,
+ )
+where
+
+import Alpha
+import Data.Time (getCurrentTime)
+import qualified Database.SQLite.Simple as SQL
+import qualified Omni.Agent.Memory as Memory
+import qualified Omni.Agent.Telegram.Types as Types
+import qualified Omni.Agent.Tools.Todos as Todos
+import qualified Omni.Test as Test
+
+main :: IO ()
+main = Test.run test
+
+test :: Test.Tree
+test =
+ Test.group
+ "Omni.Agent.Telegram.Reminders"
+ [ Test.unit "initUserChatsTable is idempotent" <| do
+ Memory.withMemoryDb <| \conn -> do
+ initUserChatsTable conn
+ initUserChatsTable conn
+ pure ()
+ ]
+
+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 :: Types.TelegramConfig -> (Types.TelegramConfig -> Int -> Text -> IO ()) -> IO ()
+reminderLoop tgConfig sendMsg =
+ forever <| do
+ threadDelay (5 * 60 * 1000000)
+ checkAndSendReminders tgConfig sendMsg
+
+checkAndSendReminders :: Types.TelegramConfig -> (Types.TelegramConfig -> Int -> Text -> IO ()) -> IO ()
+checkAndSendReminders tgConfig sendMsg = 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."
+ sendMsg tgConfig chatId msg
+ Todos.markReminderSent (Todos.todoId td)
+ putText <| "Sent reminder for todo " <> tshow (Todos.todoId td) <> " to chat " <> tshow chatId
diff --git a/Omni/Agent/Telegram/Types.hs b/Omni/Agent/Telegram/Types.hs
new file mode 100644
index 0000000..2db6a52
--- /dev/null
+++ b/Omni/Agent/Telegram/Types.hs
@@ -0,0 +1,549 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Telegram Bot Types - Data types and JSON parsing for Telegram API.
+--
+-- : out omni-agent-telegram-types
+-- : dep aeson
+module Omni.Agent.Telegram.Types
+ ( -- * Configuration
+ TelegramConfig (..),
+ defaultTelegramConfig,
+ isUserAllowed,
+
+ -- * Message Types
+ TelegramMessage (..),
+ TelegramUpdate (..),
+ TelegramDocument (..),
+ TelegramPhoto (..),
+ TelegramVoice (..),
+ TelegramReplyMessage (..),
+
+ -- * Parsing
+ parseUpdate,
+ parseDocument,
+ parseLargestPhoto,
+ parsePhotoSize,
+ parseVoice,
+ parseReplyMessage,
+
+ -- * Utilities
+ isPdf,
+ isSupportedVoiceFormat,
+
+ -- * Testing
+ main,
+ test,
+ )
+where
+
+import Alpha
+import Data.Aeson ((.!=), (.:), (.:?), (.=))
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.KeyMap as KeyMap
+import qualified Data.Text as Text
+import qualified Omni.Test as Test
+
+main :: IO ()
+main = Test.run test
+
+test :: Test.Tree
+test =
+ Test.group
+ "Omni.Agent.Telegram.Types"
+ [ 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,
+ tmReplyTo = 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 "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 "isSupportedVoiceFormat accepts ogg" <| do
+ let voice = TelegramVoice "id" 10 (Just "audio/ogg") Nothing
+ isSupportedVoiceFormat voice Test.@=? True,
+ Test.unit "isSupportedVoiceFormat accepts opus" <| do
+ let voice = TelegramVoice "id" 10 (Just "audio/opus") Nothing
+ isSupportedVoiceFormat voice Test.@=? True,
+ Test.unit "isSupportedVoiceFormat defaults to True for unknown" <| do
+ let voice = TelegramVoice "id" 10 Nothing Nothing
+ isSupportedVoiceFormat voice Test.@=? True
+ ]
+
+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 .: "bot_token"))
+ <*> (v .:? "polling_timeout" .!= 30)
+ <*> (v .:? "api_base_url" .!= "https://api.telegram.org")
+ <*> (v .:? "allowed_user_ids" .!= [])
+ <*> (v .:? "kagi_api_key")
+ <*> (v .: "openrouter_api_key")
+
+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
+ }
+
+isUserAllowed :: TelegramConfig -> Int -> Bool
+isUserAllowed cfg usrId =
+ null (tgAllowedUserIds cfg) || usrId `elem` tgAllowedUserIds cfg
+
+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_id"))
+ <*> (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 .: "file_id"))
+ <*> (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 .: "file_id"))
+ <*> (v .: "duration")
+ <*> (v .:? "mime_type")
+ <*> (v .:? "file_size")
+
+data TelegramReplyMessage = TelegramReplyMessage
+ { trMessageId :: Int,
+ trFromFirstName :: Maybe Text,
+ trFromLastName :: Maybe Text,
+ trText :: Text
+ }
+ deriving (Show, Eq, Generic)
+
+instance Aeson.ToJSON TelegramReplyMessage where
+ toJSON r =
+ Aeson.object
+ [ "message_id" .= trMessageId r,
+ "from_first_name" .= trFromFirstName r,
+ "from_last_name" .= trFromLastName r,
+ "text" .= trText r
+ ]
+
+instance Aeson.FromJSON TelegramReplyMessage where
+ parseJSON =
+ Aeson.withObject "TelegramReplyMessage" <| \v ->
+ (TelegramReplyMessage </ (v .: "message_id"))
+ <*> (v .:? "from_first_name")
+ <*> (v .:? "from_last_name")
+ <*> (v .:? "text" .!= "")
+
+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,
+ tmReplyTo :: Maybe TelegramReplyMessage
+ }
+ 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,
+ "reply_to" .= tmReplyTo m
+ ]
+
+instance Aeson.FromJSON TelegramMessage where
+ parseJSON =
+ Aeson.withObject "TelegramMessage" <| \v ->
+ (TelegramMessage </ (v .: "update_id"))
+ <*> (v .: "chat_id")
+ <*> (v .: "user_id")
+ <*> (v .: "user_first_name")
+ <*> (v .:? "user_last_name")
+ <*> (v .: "text")
+ <*> (v .:? "document")
+ <*> (v .:? "photo")
+ <*> (v .:? "voice")
+ <*> (v .:? "reply_to")
+
+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 .: "update_id"))
+ <*> (v .:? "message")
+
+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 replyTo = case KeyMap.lookup "reply_to_message" msgObj of
+ Just (Aeson.Object replyObj) -> parseReplyMessage replyObj
+ _ -> 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,
+ tmReplyTo = replyTo
+ }
+
+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
+ }
+
+parseReplyMessage :: Aeson.Object -> Maybe TelegramReplyMessage
+parseReplyMessage obj = do
+ messageId <- case KeyMap.lookup "message_id" obj of
+ Just (Aeson.Number n) -> Just (round n)
+ _ -> Nothing
+ let fromFirstName = case KeyMap.lookup "from" obj of
+ Just (Aeson.Object fromObj) -> case KeyMap.lookup "first_name" fromObj of
+ Just (Aeson.String s) -> Just s
+ _ -> Nothing
+ _ -> Nothing
+ fromLastName = case KeyMap.lookup "from" obj of
+ Just (Aeson.Object fromObj) -> case KeyMap.lookup "last_name" fromObj of
+ Just (Aeson.String s) -> Just s
+ _ -> Nothing
+ _ -> Nothing
+ text = case KeyMap.lookup "text" obj of
+ Just (Aeson.String s) -> s
+ _ -> case KeyMap.lookup "caption" obj of
+ Just (Aeson.String s) -> s
+ _ -> ""
+ pure
+ TelegramReplyMessage
+ { trMessageId = messageId,
+ trFromFirstName = fromFirstName,
+ trFromLastName = fromLastName,
+ trText = text
+ }
+
+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
+
+isSupportedVoiceFormat :: TelegramVoice -> Bool
+isSupportedVoiceFormat voice =
+ case tvMimeType voice of
+ Just "audio/ogg" -> True
+ Just "audio/opus" -> True
+ Just "audio/x-opus+ogg" -> True
+ Nothing -> True
+ _ -> False
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-19 05:18:07 +0000