src/courier/telegram.sgl

1;;; (courier telegram) - Telegram channel integration.

2;;;

3;;; Exposes send-message and send-media tools for sending messages

4;;; through Telegram or relays. Incoming Telegram polling lives in

5;;; (courier poller) -- it runs in an isolated child process so a

6;;; wedged poll cannot stall MCP request servicing.

7

8(define-library (courier telegram)

9 (import (sigil core)

10 (sigil string)

11 (sigil math)

12 (sigil time)

13 (sigil fs)

14 (sigil path)

15 (sigil telegram)

16 (only (sigil telegram client) tg-ack-unconfirmed?)

17 (sigil mcp server)

18 (sigil log)

19 (courier config)

20 (courier dedup)

21 (courier relay))

22 (export register-send-message-tool!

23 register-send-media-tool!

24 register-media-upload-handler!

25 path-media-type

26 resolve-media-type

27 format-size)

28 (begin

29

30 ;; HTTP read timeout (seconds) for leader-side Telegram sends. A

31 ;; blackholed send-response read on the leader's blocking TLS read

32 ;; would otherwise freeze the whole leader (MCP servicing, watchdog,

33 ;; poller supervision) until the OS TCP timeout -- the likeliest

34 ;; cause of needing a manual /mcp re-init. Bounding the read makes a

35 ;; stalled send raise promptly so the tool call fails cleanly.

36 (define *send-request-timeout* 25)

37

38 ;; TCP connect timeout for leader-side sends. Bounds the connect to

39 ;; api.telegram.org so a blackholed CDN IP fails fast instead of

40 ;; freezing the leader on the OS SYN timeout (the connect precedes the

41 ;; read, so the request timeout alone can't bound it).

42 (define *send-connect-timeout* 10)

43

44 ;; Idempotency/dedup backstop for Telegram sends lives in

45 ;; (courier dedup): a PERSISTENT, restart-surviving (chat-id,text)

46 ;; window. It is the load-bearing defence against the send-path

47 ;; duplication storm — see that module's header. The in-memory

48 ;; version this replaces could not survive the SIGKILL-and-retry

49 ;; loop that caused the spam, because a fresh process started with

50 ;; an empty cache.

51

52 ;; ============================================================

53 ;; Send Message Tool

54 ;; ============================================================

55

56 ;;; Register the send-message tool with the MCP server.

57 ;;;

58 ;;; Routes messages to relays or Telegram based on the `to` parameter.

59 ;;; In worker mode, always sends to the leader via relay.

60 (define (register-send-message-tool! server config relay-st worker-mode?)

61 (: mcp-server? courier-config? relay-state? boolean? -> void?)

62 (let ((token (courier-config-telegram-token config))

63 (default-chat-id (courier-config-telegram-chat-id config))

64 (api-url (or (courier-config-telegram-api-url config)

65 "https://api.telegram.org"))

66 (send-disabled (courier-config-telegram-send-disabled config))

67 (send-delay (courier-config-telegram-send-delay config))

68 ;; Persistent dedup store (survives process restarts) + its

69 ;; sliding window. Resolved once at registration; both honour

70 ;; COURIER_SEND_DEDUP_FILE / COURIER_SEND_DEDUP_WINDOW.

71 (dedup-path (send-dedup-path))

72 (dedup-window (send-dedup-window))

73 ;; Per-invocation counter, logged at DEBUG (off by default).

74 (send-invocation 0))

75 (mcp-server-register-tool! server

76 "send-message" "Send a message to a recipient (relay name, chat ID, or 'leader')"

77 '((type . "object")

78 (properties . ((text . ((type . "string")

79 (description . "The message to send")))

80 (to . ((type . "string")

81

                                  (description . "Recipient: relay name, Telegram chat ID, or 'leader' in worker mode. Uses default Telegram chat if omitted.")))))

82 (required . ("text")))

83 (lambda (args)

84 (let* ((text (dict-ref args text: #f))

85 (to (dict-ref args to: #f)))

86 (if (not text)

87 "Error: missing required argument 'text'"

88 (cond

89 ;; Worker mode: always send to leader

90 (worker-mode?

91 (relay-worker-send! relay-st text))

92 ;; Relay recipient

93 ((and to (relay-has-name? relay-st to))

94 (relay-send-message! relay-st to text))

95 ;; Telegram

96 (else

97 (let ((chat-id (if to

98 (string->number to)

99 default-chat-id)))

100 (if (and token chat-id)

101 (let* ((now (current-second))

102 (key (send-dedup-key chat-id text))

103 (inv (begin (set! send-invocation

104 (+ send-invocation 1))

105 send-invocation)))

106 (log-debug "send-message handler" inv: inv

107 chat-id: chat-id)

108 ;; Persistent, restart-surviving dedup. RECORD

109 ;; the key BEFORE attempting delivery: if the

110 ;; leader SIGKILLs courier mid-send and re-issues

111 ;; the same send (the storm), the fresh process

112 ;; sees the recorded key and suppresses it. An

113 ;; in-memory cache could not do this — a restart

114 ;; wiped it, which is why the spam recurred.

115 (case (dedup-check-and-record! dedup-path key

116 now dedup-window)

117 ((suppress)

118 (log-info "Duplicate send-message suppressed"

119 chat-id: chat-id)

120 "Message sent.")

121 (else

122 ;; Test hook: latency simulation (inert by default).

123 (when (and (number? send-delay) (> send-delay 0))

124 (sleep send-delay))

125 (if send-disabled

126 ;; Test hook: dry-run — no real delivery.

127 (begin

128 (log-info "Telegram send disabled (dry-run)"

129 chat-id: chat-id)

130 "Message sent.")

131 ;; Deliver exactly once. The key is already

132 ;; recorded. A transport error must NEVER

133 ;; escape this handler (an MCP error invites

134 ;; a client retry) and must never re-fire a

135 ;; send.

136 (guard (e ((tg-ack-unconfirmed? e)

137 ;; Reached Telegram, ack read

138 ;; failed: treat as delivered,

139 ;; keep the recorded key.

140 (log-info "Telegram delivered, ack unconfirmed"

141 chat-id: chat-id)

142 "Message sent (ack unconfirmed).")

143 (else

144 ;; ok:true is the ONLY delivery

145 ;; path; any other error means

146 ;; Telegram did not accept the

147 ;; message (never-sent or

148 ;; rejected). Release the key so

149 ;; a genuine retry can go through,

150 ;; and return cleanly (no re-raise,

151 ;; no crash).

152 (dedup-unrecord! dedup-path key)

153 (log-warn "Telegram send failed"

154 chat-id: chat-id

155 error: (format "~a" e))

156 "Error: Telegram send failed (message not delivered)."))

157 (tg-send-message

158 (tg-client token: token

159 api-url: api-url

160 request-timeout: *send-request-timeout*

161 connect-timeout: *send-connect-timeout*)

162 chat-id text)

163 (log-info "Telegram message sent" chat-id: chat-id)

164 "Message sent.")))))

165 "Error: Telegram not configured (missing token or chat ID)"))))))))))

166

167 ;; ============================================================

168 ;; Send Media Tool

169 ;; ============================================================

170

171 ;; Map a file path's extension to a Telegram media kind.

172 ;; Returns the symbol 'photo, 'video, or 'document.

173 (define (path-media-type path)

174 (: string? -> symbol?)

175 (let ((ext (string-downcase (path-extname path))))

176 (cond

177 ((member ext '(".png" ".jpg" ".jpeg" ".gif" ".webp")) 'photo)

178 ((member ext '(".mp4" ".mkv" ".mov" ".webm")) 'video)

179 (else 'document))))

180

181 ;; Resolve a caller-supplied type (string or #f) to a media kind symbol.

182 ;; Unknown values fall back to extension detection.

183 (define (resolve-media-type type-arg path)

184 (cond

185 ((or (not type-arg) (string=? type-arg "auto"))

186 (path-media-type path))

187 ((string=? type-arg "photo") 'photo)

188 ((string=? type-arg "video") 'video)

189 ((string=? type-arg "document") 'document)

190 (else (path-media-type path))))

191

192 ;; Format a byte count as a human-readable string ("412 KB", "2.4 MB").

193 (define (format-size bytes)

194 (: integer? -> string?)

195 (cond

196 ((< bytes 1024)

197 (string-append (number->string bytes) " B"))

198 ((< bytes (* 1024 1024))

199 (string-append (number->string (quotient bytes 1024)) " KB"))

200 (else

201 (let* ((mb-x10 (quotient (* bytes 10) (* 1024 1024)))

202 (whole (quotient mb-x10 10))

203 (tenth (modulo mb-x10 10)))

204 (string-append (number->string whole) "."

205 (number->string tenth) " MB")))))

206

207 ;; Dispatch to the right tg-upload-* function for the resolved kind.

208 (define (upload-by-kind client chat-id kind path caption)

209 (case kind

210 ((photo)

211 (tg-upload-photo client chat-id path caption: caption))

212 ((video)

213 ;; supports-streaming defaults on so Telegram users can scrub

214 ;; without waiting for the whole download.

215 (tg-upload-video client chat-id path

216 caption: caption supports-streaming: #t))

217 (else

218 (tg-upload-document client chat-id path caption: caption))))

219

220 ;; Leader-side handler that performs the actual upload and returns

221 ;; a result string. Used by both the in-process leader send-media

222 ;; tool and the relay media-upload envelope handler.

223 (define (do-media-upload config path to-arg caption-arg type-arg)

224 (let ((token (courier-config-telegram-token config))

225 (default-chat-id (courier-config-telegram-chat-id config)))

226 (cond

227 ((not (file-exists? path))

228 (string-append "Error: file not found: " path))

229 ((not token)

230 "Error: Telegram not configured (missing COURIER_TELEGRAM_TOKEN)")

231 (else

232 (let ((chat-id (if to-arg

233 (string->number to-arg)

234 default-chat-id)))

235 (if (not chat-id)

236 "Error: no chat ID (set COURIER_TELEGRAM_CHAT_ID or pass 'to')"

237 (let* ((kind (resolve-media-type type-arg path))

238 (size (file-size path))

239 ;; NOTE: media uploads go through tg-api-call/upload,

240 ;; which reads over a raw TLS connection (not

241 ;; sigil-http's http-post/json), so this timeout is

242 ;; NOT yet enforced on the upload read -- set for

243 ;; consistency/future-proofing. Bounding uploads needs

244 ;; a timeout on sigil-telegram's upload path (follow-up).

245 (client (tg-client token: token

246 request-timeout: *send-request-timeout*

247 connect-timeout: *send-connect-timeout*)))

248 (upload-by-kind client chat-id kind path caption-arg)

249 (log-info "Telegram media sent"

250 chat-id: chat-id kind: kind

251 path: path bytes: size)

252 (string-append "Media sent ("

253 (symbol->string kind) ", "

254 (format-size size) ")"))))))))

255

256 ;;; Register the send-media tool with the MCP server.

257 ;;;

258 ;;; Uploads a local file (photo, video, or document) to Telegram.

259 ;;; Type defaults to "auto", which infers the kind from the file

260 ;;; extension. In leader mode the upload runs locally; in worker

261 ;;; mode the request is framed as a `media-upload` envelope and

262 ;;; sent to the leader over the relay (the leader has the Telegram

263 ;;; credentials and a shared filesystem view of the file).

264 (define (register-send-media-tool! server config relay-st worker-mode?)

265 (: mcp-server? courier-config? relay-state? boolean? -> void?)

266 (mcp-server-register-tool! server

267 "send-media"

268

        "Upload a local media file (photo, video, or document) to a Telegram recipient. Use this to share screenshots, screen recordings, or other files with the user."

269 '((type . "object")

270 (properties . ((path . ((type . "string")

271 (description . "Absolute path to the local file to upload")))

272 (to . ((type . "string")

273 (description . "Telegram chat ID. Defaults to the configured chat ID.")))

274 (caption . ((type . "string")

275 (description . "Optional caption shown beneath the media")))

276 (type . ((type . "string")

277 (enum . ("photo" "video" "document" "auto"))

278 (description . "Media kind. 'auto' (default) infers from the file extension.")))))

279 (required . ("path")))

280 (lambda (args)

281 (let* ((path (dict-ref args path: #f))

282 (to (dict-ref args to: #f))

283 (caption (dict-ref args caption: #f))

284 (type-arg (dict-ref args type: #f)))

285 (cond

286 ((not path)

287 "Error: missing required argument 'path'")

288 ;; Worker mode: forward to leader. We do NOT pre-check

289 ;; file-exists?; the worker's filesystem may differ

290 ;; transiently from the leader's, and the leader is

291 ;; authoritative anyway.

292 (worker-mode?

293 (relay-worker-send-media! relay-st path

294 to: to caption: caption media-type: type-arg))

295 (else

296 (do-media-upload config path to caption type-arg)))))))

297

298 ;;; Install the leader-side handler that processes `media-upload`

299 ;;; envelopes arriving from worker relays. Must be called before

300 ;;; any worker connects. The handler reads the file from the

301 ;;; shared filesystem, dispatches via tg-upload-*, and sends the

302 ;;; result back to the worker as a regular relay text message.

303 (define (register-media-upload-handler! relay-st config)

304 (: relay-state? courier-config? -> void?)

305 (set-relay-state-media-upload-handler! relay-st

306 (lambda (envelope info)

307 (let* ((path (dict-ref envelope path: #f))

308 (to (dict-ref envelope to: #f))

309 (caption (dict-ref envelope caption: #f))

310 (type-arg (dict-ref envelope media-type: #f))

311 (sender-name (relay-info-name info))

312 (result (cond

313 ((not path)

314 "Error: media-upload envelope missing 'path'")

315 (else

316 (do-media-upload config path to caption type-arg)))))

317 (log-info "media-upload dispatched"

318 relay: sender-name path: (or path "?")

319 result: result)

320 ;; Best-effort ack back to the worker. The worker sees this

321 ;; as a regular incoming relay message.

322 (guard (e (else

323 (log-warn "media-upload ack send failed"

324 relay: sender-name

325 error: (format "~a" e))))

326 (relay-send-message! relay-st sender-name result))))))))