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 ;; exported so tests assert on the exact returned strings

29 *dry-run-not-sent-message*

30 *duplicate-suppressed-message*)

31 (begin

32

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

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

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

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

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

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

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

40

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

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

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

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

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

46

47 ;; Returned when COURIER_DISABLE_TELEGRAM_SEND gagged the send. It must

48 ;; be impossible to read as delivery: it does not begin with, and does not

49 ;; contain, a bare "Message sent". Named rather than inlined so the test

50 ;; suite asserts on the exact string the tool returns.

51 (define *dry-run-not-sent-message*

52 "Message NOT sent: COURIER_DISABLE_TELEGRAM_SEND is set (dry-run, nothing delivered).")

53

54 ;; Returned when the persistent dedup window suppressed a repeat. Under

55 ;; record-before-send this means "an identical message to this chat was

56 ;; already accepted for delivery", NOT "this call delivered something" --

57 ;; so it says which happened rather than reusing the plain success string.

58 (define *duplicate-suppressed-message*

59

      "Message already sent (duplicate suppressed: an identical message to this chat was accepted for delivery within the dedup window; nothing was sent again).")

60

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

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

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

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

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

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

67 ;; an empty cache.

68

69 ;; ============================================================

70 ;; Send Message Tool

71 ;; ============================================================

72

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

74 ;;;

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

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

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

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

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

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

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

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

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

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

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

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

87 ;; COURIER_SEND_DEDUP_FILE / COURIER_SEND_DEDUP_WINDOW.

88 (dedup-path (send-dedup-path))

89 (dedup-window (send-dedup-window))

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

91 (send-invocation 0))

92 (mcp-server-register-tool! server

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

94 '((type . "object")

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

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

97 (to . ((type . "string")

98

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

99 (required . ("text")))

100 (lambda (args)

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

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

103 (if (not text)

104 "Error: missing required argument 'text'"

105 (cond

106 ;; Worker mode: always send to leader

107 (worker-mode?

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

109 ;; Relay recipient

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

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

112 ;; Telegram

113 (else

114 (let ((chat-id (if to

115 (string->number to)

116 default-chat-id)))

117 (if (and token chat-id)

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

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

120 (inv (begin (set! send-invocation

121 (+ send-invocation 1))

122 send-invocation)))

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

124 chat-id: chat-id)

125 ;; Persistent, restart-surviving dedup. RECORD

126 ;; the key BEFORE attempting delivery: if the

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

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

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

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

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

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

133 now dedup-window)

134 ((suppress)

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

136 chat-id: chat-id)

137 *duplicate-suppressed-message*)

138 (else

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

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

141 (sleep send-delay))

142 (if send-disabled

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

144 ;; This used to return the real success

145 ;; string, so every gagged send from

146 ;; 2026-07-06 to 2026-08-04 reported

147 ;; delivery it had not earned — and, worse,

148 ;; was a perfect mimic of the silent-drop

149 ;; bug it was masking, making production

150 ;; observation of that bug impossible.

151 ;; A dry-run is a DEFINITE non-delivery, so

152 ;; it also releases the dedup key, for the

153 ;; same reason a rejected send does. The

154 ;; key was recorded BEFORE this branch;

155 ;; leaving it would make the next

156 ;; identical send take the 'suppress path

157 ;; and claim the message "was accepted for

158 ;; delivery" when nothing ever accepted

159 ;; it. Measured on the pre-fix binary:

160 ;; gag on, gag off, same text -> zero

161 ;; deliveries while reporting success.

162 ;; Returning (not raising) is

163 ;; deliberate: an MCP error invites a client

164 ;; retry, and retry-against-a-killed-courier

165 ;; is the mechanism behind the send storm.

166 (begin

167 (dedup-unrecord! dedup-path key)

168 (log-info "Telegram send disabled (dry-run) -- NOT delivered"

169 chat-id: chat-id)

170 *dry-run-not-sent-message*)

171 ;; Deliver exactly once. The key is already

172 ;; recorded. A transport error must NEVER

173 ;; escape this handler (an MCP error invites

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

175 ;; send.

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

177 ;; Reached Telegram, ack read

178 ;; failed: treat as delivered,

179 ;; keep the recorded key.

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

181 chat-id: chat-id)

182 "Message sent (ack unconfirmed).")

183 (else

184 ;; ok:true is the ONLY delivery

185 ;; path; any other error means

186 ;; Telegram did not accept the

187 ;; message (never-sent or

188 ;; rejected). Release the key so

189 ;; a genuine retry can go through,

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

191 ;; no crash).

192 (dedup-unrecord! dedup-path key)

193 (log-warn "Telegram send failed"

194 chat-id: chat-id

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

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

197 (tg-send-message

198 (tg-client token: token

199 api-url: api-url

200 request-timeout: *send-request-timeout*

201 connect-timeout: *send-connect-timeout*)

202 chat-id text)

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

204 "Message sent.")))))

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

206

207 ;; ============================================================

208 ;; Send Media Tool

209 ;; ============================================================

210

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

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

213 (define (path-media-type path)

214 (: string? -> symbol?)

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

216 (cond

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

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

219 (else 'document))))

220

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

222 ;; Unknown values fall back to extension detection.

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

224 (cond

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

226 (path-media-type path))

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

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

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

230 (else (path-media-type path))))

231

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

233 (define (format-size bytes)

234 (: integer? -> string?)

235 (cond

236 ((< bytes 1024)

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

238 ((< bytes (* 1024 1024))

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

240 (else

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

242 (whole (quotient mb-x10 10))

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

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

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

246

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

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

249 (case kind

250 ((photo)

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

252 ((video)

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

254 ;; without waiting for the whole download.

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

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

257 (else

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

259

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

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

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

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

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

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

266 (cond

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

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

269 ((not token)

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

271 (else

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

273 (string->number to-arg)

274 default-chat-id)))

275 (if (not chat-id)

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

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

278 (size (file-size path))

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

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

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

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

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

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

285 (client (tg-client token: token

286 request-timeout: *send-request-timeout*

287 connect-timeout: *send-connect-timeout*)))

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

289 (log-info "Telegram media sent"

290 chat-id: chat-id kind: kind

291 path: path bytes: size)

292 (string-append "Media sent ("

293 (symbol->string kind) ", "

294 (format-size size) ")"))))))))

295

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

297 ;;;

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

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

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

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

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

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

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

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

306 (mcp-server-register-tool! server

307 "send-media"

308

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

309 '((type . "object")

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

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

312 (to . ((type . "string")

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

314 (caption . ((type . "string")

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

316 (type . ((type . "string")

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

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

319 (required . ("path")))

320 (lambda (args)

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

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

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

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

325 (cond

326 ((not path)

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

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

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

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

331 ;; authoritative anyway.

332 (worker-mode?

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

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

335 (else

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

337

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

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

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

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

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

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

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

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

346 (lambda (envelope info)

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

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

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

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

351 (sender-name (relay-info-name info))

352 (result (cond

353 ((not path)

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

355 (else

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

357 (log-info "media-upload dispatched"

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

359 result: result)

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

361 ;; as a regular incoming relay message.

362 (guard (e (else

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

364 relay: sender-name

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

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