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_readSecret = ioError (userError "Vault management requires the CLI interface")
69 , _ch_prompt = \promptText -> do
70 sendMessage tc (OutgoingMessage promptText)
71 _im_content <$> receiveUpdate tc
72 , _ch_promptSecret = \_ ->
73 ioError (userError "Vault management requires the CLI interface")
74 }
75
76 -- | Block until a Telegram update arrives in the queue.
77 receiveUpdate :: TelegramChannel -> IO IncomingMessage
78 receiveUpdate tc = do
79 update <- atomically $ readTQueue (_tch_inbox tc)
80 let msg = _tu_message update
81 userId = T.pack (show (_tu_id (_tm_from msg)))
82 chatId = _tcht_id (_tm_chat msg)
83 content = _tm_text msg
84 writeIORef (_tch_lastChat tc) (Just chatId)
85 pure IncomingMessage
86 { _im_userId = UserId userId
87 , _im_content = content
88 }
89
90 -- | Send a message to the last active chat via the Telegram Bot API.
91 sendMessage :: TelegramChannel -> OutgoingMessage -> IO ()
92 sendMessage tc msg = do
93 chatId <- readIORef (_tch_lastChat tc)
94 case chatId of
95 Nothing -> _lh_logWarn (_tch_log tc) "No chat_id available for send"
96 Just cid -> do
97 result <- try @SomeException (postTelegram tc "sendMessage" cid (_om_content msg))
98 case result of
99 Left e -> _lh_logError (_tch_log tc) $ "Telegram send failed: " <> T.pack (show e)
100 Right resp
101 | _hr_statusCode resp == 200 -> pure ()
102 | otherwise ->
103 _lh_logError (_tch_log tc) $
104 "Telegram API error " <> T.pack (show (_hr_statusCode resp))
105
106 -- | Send an error message to the Telegram chat.
107 sendTelegramError :: TelegramChannel -> PublicError -> IO ()
108 sendTelegramError tc err = do
109 chatId <- readIORef (_tch_lastChat tc)
110 case chatId of
111 Nothing -> _lh_logWarn (_tch_log tc) "No chat_id available for error send"
112 Just cid -> do
113 let errText = case err of
114 RateLimitError -> "Rate limited. Please try again in a moment."
115 NotAllowedError -> "Not allowed."
116 TemporaryError t -> t
117 result <- try @SomeException (postTelegram tc "sendMessage" cid errText)
118 case result of
119 Left e -> _lh_logError (_tch_log tc) $ "Telegram error send failed: " <> T.pack (show e)
120 Right _ -> pure ()
121
122 -- | POST to a Telegram Bot API method with chat_id and text parameters.
123 postTelegram :: TelegramChannel -> Text -> Int -> Text -> IO HttpResponse
124 postTelegram tc method chatId text = do
125 let config = _tch_config tc
126 url = _tc_apiBase config <> "/bot" <> _tc_botToken config <> "/" <> method
127 body = "chat_id=" <> URI.urlEncode False (TE.encodeUtf8 (T.pack (show chatId)))
128 <> "&text=" <> URI.urlEncode False (TE.encodeUtf8 text)
129 case mkAllowedUrl AllowAll url of
130 Left e -> throwIO (userError ("Bad Telegram URL: " <> show e))
131 Right allowed -> _nh_httpPost (_tch_network tc) allowed body
132
133 -- | A Telegram Update object (simplified).
134 data TelegramUpdate = TelegramUpdate
135 { _tu_updateId :: Int
136 , _tu_message :: TelegramMessage
137 }
138 deriving stock (Show, Eq)
139
140 -- | A Telegram Message object (simplified).
141 data TelegramMessage = TelegramMessage
142 { _tm_messageId :: Int
143 , _tm_from :: TelegramUser
144 , _tm_chat :: TelegramChat
145 , _tm_text :: Text
146 }
147 deriving stock (Show, Eq)
148
149 -- | A Telegram Chat object (simplified).
150 data TelegramChat = TelegramChat
151 { _tcht_id :: Int
152 , _tcht_type :: Text
153 }
154 deriving stock (Show, Eq)
155
156 -- | A Telegram User object (simplified).
157 data TelegramUser = TelegramUser
158 { _tu_id :: Int
159 , _tu_firstName :: Text
160 }
161 deriving stock (Show, Eq)
162
163 instance FromJSON TelegramUpdate where
164 parseJSON = withObject "TelegramUpdate" $ \o ->
165 TelegramUpdate <$> o .: "update_id" <*> o .: "message"
166
167 instance FromJSON TelegramMessage where
168 parseJSON = withObject "TelegramMessage" $ \o ->
169 TelegramMessage <$> o .: "message_id" <*> o .: "from" <*> o .: "chat" <*> o .: "text"
170
171 instance FromJSON TelegramChat where
172 parseJSON = withObject "TelegramChat" $ \o ->
173 TelegramChat <$> o .: "id" <*> o .: "type"
174
175 instance FromJSON TelegramUser where
176 parseJSON = withObject "TelegramUser" $ \o ->
177 TelegramUser <$> o .: "id" <*> o .: "first_name"
178
179 -- | Parse a JSON value as a Telegram update.
180 parseTelegramUpdate :: Value -> Either String TelegramUpdate
181 parseTelegramUpdate v = case fromJSON v of
182 Error err -> Left err
183 Success upd -> Right upd