never executed always true always false
1 module PureClaw.Channels.Telegram
2 ( -- * Telegram channel
3 TelegramChannel (..)
4 , TelegramConfig (..)
5 , mkTelegramChannel
6 -- * Message parsing
7 , parseTelegramUpdate
8 , TelegramUpdate (..)
9 , TelegramMessage (..)
10 , TelegramChat (..)
11 , TelegramUser (..)
12 ) where
13
14 import Control.Concurrent.STM
15 import Control.Exception
16 import Data.Aeson
17 import Data.IORef
18 import Data.Text (Text)
19 import Data.Text qualified as T
20 import Data.Text.Encoding qualified as TE
21 import Network.HTTP.Types.URI qualified as URI
22
23 import PureClaw.Channels.Class
24 import PureClaw.Core.Errors
25 import PureClaw.Core.Types
26 import PureClaw.Handles.Channel
27 import PureClaw.Handles.Log
28 import PureClaw.Handles.Network
29
30 -- | Configuration for Telegram channel.
31 data TelegramConfig = TelegramConfig
32 { _tc_botToken :: Text
33 , _tc_apiBase :: Text
34 }
35 deriving stock (Show, Eq)
36
37 -- | A Telegram channel backed by a message queue. Updates are pushed
38 -- into the queue (e.g. from a webhook endpoint) and the agent loop
39 -- pulls them out via 'receive'. Responses are sent via the Telegram
40 -- Bot API using the provided 'NetworkHandle'.
41 data TelegramChannel = TelegramChannel
42 { _tch_config :: TelegramConfig
43 , _tch_inbox :: TQueue TelegramUpdate
44 , _tch_network :: NetworkHandle
45 , _tch_log :: LogHandle
46 , _tch_lastChat :: IORef (Maybe Int)
47 }
48
49 -- | Create a Telegram channel with an empty inbox.
50 mkTelegramChannel :: TelegramConfig -> NetworkHandle -> LogHandle -> IO TelegramChannel
51 mkTelegramChannel config nh lh = do
52 inbox <- newTQueueIO
53 chatRef <- newIORef Nothing
54 pure TelegramChannel
55 { _tch_config = config
56 , _tch_inbox = inbox
57 , _tch_network = nh
58 , _tch_log = lh
59 , _tch_lastChat = chatRef
60 }
61
62 instance Channel TelegramChannel where
63 toHandle tc = ChannelHandle
64 { _ch_receive = receiveUpdate tc
65 , _ch_send = sendMessage tc
66 , _ch_sendError = sendTelegramError tc
67 , _ch_sendChunk = \_ -> pure () -- Telegram doesn't support streaming
68 , _ch_streaming = False
69 , _ch_readSecret = ioError (userError "Vault management requires the CLI interface")
70 , _ch_prompt = \promptText -> do
71 sendMessage tc (OutgoingMessage promptText)
72 _im_content <$> receiveUpdate tc
73 , _ch_promptSecret = \_ ->
74 ioError (userError "Vault management requires the CLI interface")
75 }
76
77 -- | Block until a Telegram update arrives in the queue.
78 receiveUpdate :: TelegramChannel -> IO IncomingMessage
79 receiveUpdate tc = do
80 update <- atomically $ readTQueue (_tch_inbox tc)
81 let msg = _tu_message update
82 userId = T.pack (show (_tu_id (_tm_from msg)))
83 chatId = _tcht_id (_tm_chat msg)
84 content = _tm_text msg
85 writeIORef (_tch_lastChat tc) (Just chatId)
86 pure IncomingMessage
87 { _im_userId = UserId userId
88 , _im_content = content
89 }
90
91 -- | Send a message to the last active chat via the Telegram Bot API.
92 sendMessage :: TelegramChannel -> OutgoingMessage -> IO ()
93 sendMessage tc msg = do
94 chatId <- readIORef (_tch_lastChat tc)
95 case chatId of
96 Nothing -> _lh_logWarn (_tch_log tc) "No chat_id available for send"
97 Just cid -> do
98 result <- try @SomeException (postTelegram tc "sendMessage" cid (_om_content msg))
99 case result of
100 Left e -> _lh_logError (_tch_log tc) $ "Telegram send failed: " <> T.pack (show e)
101 Right resp
102 | _hr_statusCode resp == 200 -> pure ()
103 | otherwise ->
104 _lh_logError (_tch_log tc) $
105 "Telegram API error " <> T.pack (show (_hr_statusCode resp))
106
107 -- | Send an error message to the Telegram chat.
108 sendTelegramError :: TelegramChannel -> PublicError -> IO ()
109 sendTelegramError tc err = do
110 chatId <- readIORef (_tch_lastChat tc)
111 case chatId of
112 Nothing -> _lh_logWarn (_tch_log tc) "No chat_id available for error send"
113 Just cid -> do
114 let errText = case err of
115 RateLimitError -> "Rate limited. Please try again in a moment."
116 NotAllowedError -> "Not allowed."
117 TemporaryError t -> t
118 result <- try @SomeException (postTelegram tc "sendMessage" cid errText)
119 case result of
120 Left e -> _lh_logError (_tch_log tc) $ "Telegram error send failed: " <> T.pack (show e)
121 Right _ -> pure ()
122
123 -- | POST to a Telegram Bot API method with chat_id and text parameters.
124 postTelegram :: TelegramChannel -> Text -> Int -> Text -> IO HttpResponse
125 postTelegram tc method chatId text = do
126 let config = _tch_config tc
127 url = _tc_apiBase config <> "/bot" <> _tc_botToken config <> "/" <> method
128 body = "chat_id=" <> URI.urlEncode False (TE.encodeUtf8 (T.pack (show chatId)))
129 <> "&text=" <> URI.urlEncode False (TE.encodeUtf8 text)
130 case mkAllowedUrl AllowAll url of
131 Left e -> throwIO (userError ("Bad Telegram URL: " <> show e))
132 Right allowed -> _nh_httpPost (_tch_network tc) allowed body
133
134 -- | A Telegram Update object (simplified).
135 data TelegramUpdate = TelegramUpdate
136 { _tu_updateId :: Int
137 , _tu_message :: TelegramMessage
138 }
139 deriving stock (Show, Eq)
140
141 -- | A Telegram Message object (simplified).
142 data TelegramMessage = TelegramMessage
143 { _tm_messageId :: Int
144 , _tm_from :: TelegramUser
145 , _tm_chat :: TelegramChat
146 , _tm_text :: Text
147 }
148 deriving stock (Show, Eq)
149
150 -- | A Telegram Chat object (simplified).
151 data TelegramChat = TelegramChat
152 { _tcht_id :: Int
153 , _tcht_type :: Text
154 }
155 deriving stock (Show, Eq)
156
157 -- | A Telegram User object (simplified).
158 data TelegramUser = TelegramUser
159 { _tu_id :: Int
160 , _tu_firstName :: Text
161 }
162 deriving stock (Show, Eq)
163
164 instance FromJSON TelegramUpdate where
165 parseJSON = withObject "TelegramUpdate" $ \o ->
166 TelegramUpdate <$> o .: "update_id" <*> o .: "message"
167
168 instance FromJSON TelegramMessage where
169 parseJSON = withObject "TelegramMessage" $ \o ->
170 TelegramMessage <$> o .: "message_id" <*> o .: "from" <*> o .: "chat" <*> o .: "text"
171
172 instance FromJSON TelegramChat where
173 parseJSON = withObject "TelegramChat" $ \o ->
174 TelegramChat <$> o .: "id" <*> o .: "type"
175
176 instance FromJSON TelegramUser where
177 parseJSON = withObject "TelegramUser" $ \o ->
178 TelegramUser <$> o .: "id" <*> o .: "first_name"
179
180 -- | Parse a JSON value as a Telegram update.
181 parseTelegramUpdate :: Value -> Either String TelegramUpdate
182 parseTelegramUpdate v = case fromJSON v of
183 Error err -> Left err
184 Success upd -> Right upd