Add sigil-telegram package for Telegram Bot API clients

Message

New package providing a layered Telegram Bot API client:

Types: tg-update, tg-message, tg-chat, tg-user structs with dict->record converters for JSON API responses
Client: tg-api-call for arbitrary API methods, convenience wrappers for sendMessage, sendPhoto, sendDocument, editMessage, deleteMessage, answerCallbackQuery, and getUpdates with long-polling
File uploads: multipart/form-data encoding via direct TLS connection with tg-upload-photo and tg-upload-document for local file sending
Bot framework: make-tg-bot with tg-on-command, tg-on-message, tg-on-callback handler registration, tg-bot-run polling loop with configurable error recovery, and chat/user authorization lists
Formatting: tg-escape-markdown and helpers (tg-bold, tg-italic, tg-underline, tg-strike, tg-code, tg-code-block, tg-link, tg-spoiler) for composing MarkdownV2 messages
Inline keyboards: tg-inline-keyboard and tg-button builders

Dependencies: sigil-stdlib, sigil-json, sigil-http, sigil-tls, sigil-crypto

Changed

 docs/telegram.md              | 446 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 package.sgl                   |  20 +++++++
 src/sigil/telegram.sgl        | 105 ++++++++++++++++++++++++++++++++++
 src/sigil/telegram/bot.sgl    | 362 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/sigil/telegram/client.sgl | 498 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/sigil/telegram/format.sgl | 130 +++++++++++++++++++++++++++++++++++++++++++
 src/sigil/telegram/types.sgl  | 128 ++++++++++++++++++++++++++++++++++++++++++
 test/test-telegram.sgl        | 282 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 8 files changed, 1971 insertions(+)

Diff

docs/telegram.mdadded

@@ -0,0 +1,446 @@

# Telegram

> Telegram Bot API client with long-polling, command handlers, MarkdownV2 formatting, and file uploads.

```scheme

(import (sigil telegram))

```

## Two Approaches

+10

+11

There are two ways to use the package depending on your use case:

+12

+13

**Fetch-and-respond** — Best for scripts, cron jobs, and AI agents that wake up, check for messages, respond, and exit. Use `tg-fetch-updates` with a `tg-client` directly:

+14

+15

```scheme

+16

(import (sigil telegram))

+17

+18

(define client (tg-client token: "123456:ABC-DEF..."))

+19

+20

;; Fetch all pending messages (non-blocking, confirms receipt)

+21

(for-each

+22

(lambda (update)

+23

(let ((msg (tg-update-message update)))

+24

(when (and msg (tg-message-text msg))

+25

(tg-send-message client

+26

(tg-chat-id (tg-message-chat msg))

+27

(string-append "You said: " (tg-escape-markdown (tg-message-text msg)))

+28

parse-mode: "MarkdownV2"))))

+29

(tg-fetch-updates client))

+30

```

+31

+32

**Long-running bot** — Best for interactive bots that stay online and respond in real time. Use `make-tg-bot` with handler registration and `tg-bot-run`:

+33

+34

```scheme

+35

(import (sigil telegram))

+36

+37

(define bot (make-tg-bot token: "123456:ABC-DEF..."))

+38

+39

(tg-on-command bot "/start"

+40

(lambda (bot msg)

+41

(tg-reply bot msg "Hello! I'm a Sigil bot.")))

+42

+43

(tg-bot-run bot)

+44

```

+45

+46

Both approaches share the same client, types, formatting, and media APIs.

+47

+48

## Sending Messages

+49

+50

```scheme

+51

;; Plain text

+52

(tg-send-message client chat-id "Hello!")

+53

+54

;; With MarkdownV2 formatting

+55

(tg-send-message client chat-id

+56

(string-append (tg-bold "Status") ": " (tg-escape-markdown "All systems go!"))

+57

parse-mode: "MarkdownV2")

+58

+59

;; With reply markup (inline keyboard)

+60

(tg-send-message client chat-id "Choose one:"

+61

reply-markup: (tg-inline-keyboard

+62

(list (list (tg-button "Yes" callback: "yes")

+63

(tg-button "No" callback: "no")))))

+64

```

+65

+66

## Message Formatting (MarkdownV2)

+67

+68

Telegram's MarkdownV2 requires escaping 18 special characters outside of formatting entities. Use `tg-escape-markdown` on all dynamic text before composing messages.

+69

+70

### Escaping

+71

+72

```scheme

+73

;; These characters must be escaped: _ * [ ] ( ) ~ ` > # + - = | { } . !

+74

(tg-escape-markdown "Hello! Price: $5.00 (USD)")

+75

; => "Hello\\! Price: $5\\.00 \$USD\$"

+76

```

+77

+78

### Formatting Helpers

+79

+80

All helpers wrap text with the appropriate MarkdownV2 syntax. They do NOT auto-escape their input, so escape dynamic content first.

+81

+82

```scheme

+83

(tg-bold "important") ; => "*important*"

+84

(tg-italic "emphasis") ; => "_emphasis_"

+85

(tg-underline "noted") ; => "__noted__"

+86

(tg-strike "removed") ; => "~removed~"

+87

(tg-code "variable") ; => "`variable`"

+88

(tg-spoiler "hidden") ; => "||hidden||"

+89

+90

(tg-link "Click here" "https://example.com")

+91

; => "[Click here](https://example.com)"

+92

+93

(tg-code-block "(+ 1 2)")

+94

; => "```\n(+ 1 2)```"

+95

+96

(tg-code-block "(+ 1 2)" language: "scheme")

+97

; => "```scheme\n(+ 1 2)```"

+98

```

+99

+100

### Composing Formatted Messages

+101

+102

Escape dynamic text with `tg-escape-markdown`, then wrap with formatting helpers:

+103

+104

```scheme

+105

(define (format-status-report name status duration)

+106

(string-append

+107

(tg-bold "Build Report") "\n\n"

+108

(tg-bold "Package: ") (tg-escape-markdown name) "\n"

+109

(tg-bold "Status: ") (tg-italic (tg-escape-markdown status)) "\n"

+110

(tg-bold "Duration: ") (tg-code (tg-escape-markdown duration))))

+111

+112

(tg-send-message client chat-id

+113

(format-status-report "sigil-http" "passed" "42s")

+114

parse-mode: "MarkdownV2")

+115

```

+116

+117

## Sending Photos and Documents

+118

+119

Three ways to send media:

+120

+121

### By URL

+122

+123

Telegram downloads the file from the URL:

+124

+125

```scheme

+126

(tg-send-photo client chat-id "https://example.com/photo.jpg"

+127

caption: "A nice photo")

+128

+129

(tg-send-document client chat-id "https://example.com/report.pdf"

+130

caption: "Monthly report")

+131

```

+132

+133

### By file_id

+134

+135

Reference a file already on Telegram's servers (e.g., from a received message):

+136

+137

```scheme

+138

(let ((photo-id (dict-ref (array-ref (tg-message-photo msg) 0) file_id:)))

+139

(tg-send-photo client other-chat-id photo-id))

+140

```

+141

+142

### By Local File Upload

+143

+144

Upload a file from the local filesystem. MIME type is auto-detected:

+145

+146

```scheme

+147

(tg-upload-photo client chat-id "/tmp/screenshot.png"

+148

caption: "Build output")

+149

+150

(tg-upload-document client chat-id "/tmp/report.pdf"

+151

caption: "Generated report"

+152

parse-mode: "MarkdownV2")

+153

```

+154

+155

### Photo with Formatted Caption

+156

+157

```scheme

+158

(tg-upload-photo client chat-id "/tmp/chart.png"

+159

caption: (string-append

+160

(tg-bold "Daily Metrics") "\n"

+161

(tg-escape-markdown "Generated at 2024-01-15 09:00"))

+162

parse-mode: "MarkdownV2")

+163

```

+164

+165

## Inline Keyboards

+166

+167

Build interactive buttons that trigger callback queries:

+168

+169

```scheme

+170

;; Create keyboard with callback buttons

+171

(tg-send-message client chat-id "Rate this:"

+172

reply-markup: (tg-inline-keyboard

+173

(list

+174

(list (tg-button "1" callback: "rate_1")

+175

(tg-button "2" callback: "rate_2")

+176

(tg-button "3" callback: "rate_3"))

+177

(list (tg-button "Visit docs" url: "https://example.com")))))

+178

+179

;; Handle button presses

+180

(tg-on-callback bot

+181

(lambda (bot query)

+182

(tg-answer-callback (tg-bot-client bot)

+183

(dict-ref query id:)

+184

text: (string-append "You pressed: " (dict-ref query data:)))))

+185

```

+186

+187

## Bot Framework

+188

+189

### Creating a Bot

+190

+191

```scheme

+192

(define bot (make-tg-bot

+193

token: "123456:ABC-DEF..."

+194

allowed-chats: '(12345 67890) ; Optional: restrict to these chat IDs

+195

allowed-users: '(111 222))) ; Optional: restrict to these user IDs

+196

```

+197

+198

Both `allowed-chats:` and `allowed-users:` default to `#f` (allow all). When set, both must pass (AND logic). Unauthorized messages are silently ignored.

+199

+200

### Registering Handlers

+201

+202

All handlers receive `(bot msg)` as arguments:

+203

+204

```scheme

+205

;; Command handler - matches /command messages

+206

(tg-on-command bot "/start"

+207

(lambda (bot msg)

+208

(tg-reply bot msg "Welcome!")))

+209

+210

;; Message handler - called for every authorized message

+211

(tg-on-message bot

+212

(lambda (bot msg)

+213

(when (tg-message-text msg)

+214

(display (tg-message-text msg))

+215

(newline))))

+216

+217

;; Callback query handler - inline keyboard presses

+218

(tg-on-callback bot

+219

(lambda (bot query)

+220

(tg-answer-callback (tg-bot-client bot) (dict-ref query id:))))

+221

+222

;; Error handler - called on exceptions during update processing

+223

;; Return 'stop to halt, 'continue to skip backoff, anything else for default 5s backoff

+224

(tg-on-error bot

+225

(lambda (exn)

+226

(display "Error: " (current-error-port))

+227

(display exn (current-error-port))

+228

(newline (current-error-port))))

+229

```

+230

+231

### Running the Bot

+232

+233

```scheme

+234

;; Blocking polling loop (default 30s long-poll timeout)

+235

(tg-bot-run bot)

+236

(tg-bot-run bot timeout: 10)

+237

+238

;; Stop the bot (from a handler or another thread)

+239

(tg-bot-stop bot)

+240

+241

;; Non-blocking single poll (for custom event loops)

+242

(tg-bot-tick bot)

+243

```

+244

+245

## Reply Helpers

+246

+247

```scheme

+248

;; Text reply

+249

(tg-reply bot msg "Got it!")

+250

+251

;; Formatted reply

+252

(tg-reply bot msg (tg-bold "Done") parse-mode: "MarkdownV2")

+253

+254

;; Quote the original message

+255

(tg-reply bot msg "Replying to you" quote?: #t)

+256

+257

;; Reply with photo (URL/file_id)

+258

(tg-reply-photo bot msg "https://example.com/photo.jpg"

+259

caption: "Here you go!")

+260

+261

;; Reply with uploaded local photo

+262

(tg-reply-photo/upload bot msg "/tmp/result.png"

+263

caption: "Processing complete")

+264

```

+265

+266

## Low-Level Client

+267

+268

For direct API access without the bot framework:

+269

+270

```scheme

+271

(define client (tg-client token: "123456:ABC-DEF..."))

+272

+273

;; Call any Telegram Bot API method

+274

(tg-api-call client "getMe")

+275

; => #{ id: 123 is_bot: #t first_name: "MyBot" ... }

+276

+277

;; With parameters

+278

(tg-api-call client "sendMessage"

+279

params: (dict chat_id: 12345 text: "Hello from low-level API"))

+280

```

+281

+282

## Message and Update Types

+283

+284

### tg-message

+285

+286

```scheme

+287

(tg-message-message-id msg) ; => 42

+288

(tg-message-chat msg) ; => tg-chat record

+289

(tg-message-from msg) ; => tg-user record or #f

+290

(tg-message-date msg) ; => unix timestamp

+291

(tg-message-text msg) ; => "Hello" or #f

+292

(tg-message-photo msg) ; => array of photo sizes or #f

+293

(tg-message-document msg) ; => dict or #f

+294

(tg-message-reply-to msg) ; => tg-message or #f

+295

(tg-message-raw msg) ; => full API dict (access any field)

+296

```

+297

+298

### tg-chat

+299

+300

```scheme

+301

(tg-chat-id chat) ; => 12345

+302

(tg-chat-type chat) ; => "private", "group", "supergroup", "channel"

+303

(tg-chat-title chat) ; => "My Group" or #f

+304

(tg-chat-username chat) ; => "alice" or #f

+305

```

+306

+307

### tg-user

+308

+309

```scheme

+310

(tg-user-id user) ; => 12345

+311

(tg-user-is-bot user) ; => #t or #f

+312

(tg-user-first-name user) ; => "Alice"

+313

(tg-user-last-name user) ; => "Smith" or #f

+314

(tg-user-username user) ; => "alice" or #f

+315

```

+316

+317

### Accessing Raw API Fields

+318

+319

Any Telegram API field not modeled as a struct field is accessible via `tg-message-raw`:

+320

+321

```scheme

+322

;; Access sticker data from a message

+323

(dict-ref (tg-message-raw msg) sticker: #f)

+324

+325

;; Access location data

+326

(dict-ref (tg-message-raw msg) location: #f)

+327

```

+328

+329

## Common Patterns

+330

+331

### Echo Bot

+332

+333

```scheme

+334

(import (sigil telegram))

+335

+336

(define bot (make-tg-bot token: "123456:ABC-DEF..."))

+337

+338

(tg-on-message bot

+339

(lambda (bot msg)

+340

(when (tg-message-text msg)

+341

(tg-reply bot msg (tg-message-text msg)))))

+342

+343

(tg-bot-run bot)

+344

```

+345

+346

### Command Bot

+347

+348

```scheme

+349

(import (sigil telegram))

+350

+351

(define bot (make-tg-bot token: "123456:ABC-DEF..."))

+352

+353

(tg-on-command bot "/start"

+354

(lambda (bot msg)

+355

(tg-reply bot msg

+356

(string-append

+357

(tg-bold "Welcome\\!") "\n\n"

+358

"Available commands:\n"

+359

"/help \\- Show help\n"

+360

"/status \\- Check status")

+361

parse-mode: "MarkdownV2")))

+362

+363

(tg-on-command bot "/help"

+364

(lambda (bot msg)

+365

(tg-reply bot msg "Send me a message and I'll echo it back.")))

+366

+367

(tg-on-command bot "/status"

+368

(lambda (bot msg)

+369

(tg-reply bot msg

+370

(string-append (tg-bold "Status: ") (tg-code "online"))

+371

parse-mode: "MarkdownV2")))

+372

+373

(tg-bot-run bot)

+374

```

+375

+376

### Fetch-and-Respond Script

+377

+378

Process pending messages without a long-running loop. Ideal for cron jobs, AI agents, or any script that runs periodically:

+379

+380

```scheme

+381

(import (sigil telegram))

+382

+383

(define client (tg-client token: "123456:ABC-DEF..."))

+384

+385

(for-each

+386

(lambda (update)

+387

(let ((msg (tg-update-message update)))

+388

(when msg

+389

(let ((text (tg-message-text msg))

+390

(chat-id (tg-chat-id (tg-message-chat msg))))

+391

(cond

+392

((and text (string=? text "/status"))

+393

(tg-send-message client chat-id

+394

(string-append (tg-bold "Status: ") (tg-code "all systems go"))

+395

parse-mode: "MarkdownV2"))

+396

(text

+397

(tg-send-message client chat-id

+398

(string-append "You said: " (tg-escape-markdown text))

+399

parse-mode: "MarkdownV2")))))))

+400

(tg-fetch-updates client))

+401

```

+402

+403

### Notification Sender

+404

+405

Send one-shot messages from scripts or AI agents without checking for updates:

+406

+407

```scheme

+408

(import (sigil telegram))

+409

+410

(define client (tg-client token: "123456:ABC-DEF..."))

+411

(define chat-id 12345)

+412

+413

;; Send a formatted status report

+414

(tg-send-message client chat-id

+415

(string-append

+416

(tg-bold "Build Complete") "\n\n"

+417

"Package: " (tg-escape-markdown "sigil-http") "\n"

+418

"Status: " (tg-italic "passed") "\n"

+419

"Duration: " (tg-code "42s"))

+420

parse-mode: "MarkdownV2")

+421

+422

;; Upload a screenshot

+423

(tg-upload-photo client chat-id "/tmp/screenshot.png"

+424

caption: "Build output")

+425

```

+426

+427

### Photo Bot

+428

+429

```scheme

+430

(import (sigil telegram))

+431

+432

(define bot (make-tg-bot token: "123456:ABC-DEF..."))

+433

+434

(tg-on-command bot "/photo"

+435

(lambda (bot msg)

+436

(tg-reply-photo bot msg "https://picsum.photos/400/300"

+437

caption: "Random photo")))

+438

+439

(tg-on-command bot "/upload"

+440

(lambda (bot msg)

+441

(tg-reply-photo/upload bot msg "/tmp/generated-chart.png"

+442

caption: (string-append (tg-bold "Chart") "\nGenerated just now")

+443

parse-mode: "MarkdownV2")))

+444

+445

(tg-bot-run bot)

+446

```

package.sgladded

@@ -0,0 +1,20 @@

;;; sigil-telegram - Telegram Bot API client library

;;;

;;; Provides a Telegram Bot API client with long-polling updates,

;;; command/message handlers, chat authorization, MarkdownV2 formatting,

;;; and media sending with file upload support.

(package

name: "sigil-telegram"

version: "0.7.0"

+10

description: "Telegram Bot API client library"

+11

url: "https://codeberg.org/sigil/sigil"

+12

license: "BSD-3-Clause"

+13

authors: (list "David Wilson <david@daviwil.com>")

+14

+15

dependencies: (list

+16

(from-workspace name: "sigil-stdlib")

+17

(from-workspace name: "sigil-json")

+18

(from-workspace name: "sigil-http")

+19

(from-workspace name: "sigil-tls")

+20

(from-workspace name: "sigil-crypto")))

src/sigil/telegram.sgladded

@@ -0,0 +1,105 @@

;;; (sigil telegram) - Telegram Bot API Client Library

;;;

;;; Provides a complete Telegram Bot API client with long-polling updates,

;;; command/message handlers, chat authorization, MarkdownV2 formatting,

;;; and media sending with file upload support.

;;;

;;; Quick start:

;;; ```scheme

;;; (import (sigil telegram))

+10

;;;

+11

;;; (define bot (make-tg-bot token: "123456:ABC-DEF..."))

+12

;;;

+13

;;; (tg-on-command bot "/start"

+14

;;; (lambda (bot msg)

+15

;;; (tg-reply bot msg "Hello!")))

+16

;;;

+17

;;; (tg-bot-run bot)

+18

;;; ```

+19

+20

(define-library (sigil telegram)

+21

(import (sigil telegram types)

+22

(sigil telegram client)

+23

(sigil telegram bot)

+24

(sigil telegram format))

+25

+26

(export

+27

;; Types - User

+28

tg-user tg-user? tg-user-id tg-user-is-bot

+29

tg-user-first-name tg-user-last-name tg-user-username

+30

dict->tg-user

+31

+32

;; Types - Chat

+33

tg-chat tg-chat? tg-chat-id tg-chat-type

+34

tg-chat-title tg-chat-username

+35

dict->tg-chat

+36

+37

;; Types - Message

+38

tg-message tg-message? tg-message-message-id tg-message-chat

+39

tg-message-from tg-message-date tg-message-text

+40

tg-message-photo tg-message-document tg-message-reply-to

+41

tg-message-raw

+42

dict->tg-message

+43

+44

;; Types - Update

+45

tg-update tg-update? tg-update-update-id tg-update-message

+46

tg-update-callback-query tg-update-raw

+47

dict->tg-update

+48

+49

;; Client

+50

tg-client tg-client? tg-client-token

+51

tg-client-last-update-id set-tg-client-last-update-id!

+52

tg-api-call

+53

+54

;; Messages

+55

tg-get-me

+56

tg-send-message

+57

tg-edit-message

+58

tg-delete-message

+59

+60

;; Media (URL/file_id)

+61

tg-send-photo

+62

tg-send-document

+63

+64

;; Media (file upload)

+65

tg-upload-photo

+66

tg-upload-document

+67

+68

;; Callbacks

+69

tg-answer-callback

+70

+71

;; Updates

+72

tg-get-updates

+73

tg-fetch-updates

+74

+75

;; Inline keyboards

+76

tg-inline-keyboard

+77

tg-button

+78

+79

;; Bot framework

+80

tg-bot make-tg-bot tg-bot?

+81

tg-bot-client

+82

tg-bot-allowed-chats set-tg-bot-allowed-chats!

+83

tg-bot-allowed-users set-tg-bot-allowed-users!

+84

tg-bot-running?

+85

tg-on-command

+86

tg-on-message

+87

tg-on-callback

+88

tg-on-error

+89

tg-bot-run

+90

tg-bot-stop

+91

tg-bot-tick

+92

tg-reply

+93

tg-reply-photo

+94

tg-reply-photo/upload

+95

+96

;; Formatting

+97

tg-escape-markdown

+98

tg-bold

+99

tg-italic

+100

tg-underline

+101

tg-strike

+102

tg-code

+103

tg-code-block

+104

tg-link

+105

tg-spoiler))

src/sigil/telegram/bot.sgladded

@@ -0,0 +1,362 @@

;;; (sigil telegram bot) - Telegram Bot Framework

;;;

;;; High-level bot framework with command/message handlers,

;;; long-polling event loop, and chat authorization.

(define-library (sigil telegram bot)

(import (sigil core)

(sigil string)

(sigil struct)

+10

(sigil time)

+11

(sigil telegram types)

+12

(sigil telegram client))

+13

+14

(export

+15

;; Bot record

+16

tg-bot make-tg-bot tg-bot?

+17

tg-bot-client

+18

tg-bot-allowed-chats set-tg-bot-allowed-chats!

+19

tg-bot-allowed-users set-tg-bot-allowed-users!

+20

tg-bot-running?

+21

+22

;; Handler registration

+23

tg-on-command

+24

tg-on-message

+25

tg-on-callback

+26

tg-on-error

+27

+28

;; Event loop

+29

tg-bot-run

+30

tg-bot-stop

+31

tg-bot-tick

+32

+33

;; Convenience

+34

tg-reply

+35

tg-reply-photo

+36

tg-reply-photo/upload

+37

+38

;; Internal (exported for testing)

+39

extract-command

+40

authorized?)

+41

+42

(begin

+43

+44

;; ============================================================

+45

;; Bot Record

+46

;; ============================================================

+47

+48

(define-struct tg-bot

+49

(client)

+50

(allowed-chats default: #f mutable: #t)

+51

(allowed-users default: #f mutable: #t)

+52

(command-handlers default: #{} mutable: #t)

+53

(message-handlers default: '() mutable: #t)

+54

(callback-handlers default: '() mutable: #t)

+55

(error-handler default: #f mutable: #t)

+56

(running? default: #f mutable: #t))

+57

+58

;; ============================================================

+59

;; Constructor

+60

;; ============================================================

+61

+62

;;; Create a Telegram bot.

+63

;;;

+64

;;; ```scheme

+65

;;; (define bot (make-tg-bot

+66

;;; token: "123456:ABC-DEF..."

+67

;;; allowed-chats: '(12345 67890)))

+68

;;; ```

+69

(define (make-tg-bot (keys: (token #f)

+70

(allowed-chats #f)

+71

(allowed-users #f)))

+72

(: (token: string?) (allowed-chats: (maybe list?))

+73

(allowed-users: (maybe list?)) -> tg-bot?)

+74

(unless token (error "make-tg-bot: token: is required"))

+75

(tg-bot

+76

client: (tg-client token: token)

+77

allowed-chats: allowed-chats

+78

allowed-users: allowed-users))

+79

+80

;; ============================================================

+81

;; Handler Registration

+82

;; ============================================================

+83

+84

;;; Register a handler for a specific bot command.

+85

;;;

+86

;;; The handler receives `(bot msg)`. The command string should

+87

;;; include the leading slash (e.g., "/start").

+88

;;;

+89

;;; ```scheme

+90

;;; (tg-on-command bot "/start"

+91

;;; (lambda (bot msg)

+92

;;; (tg-reply bot msg "Hello!")))

+93

;;; ```

+94

(define (tg-on-command bot command handler)

+95

(: tg-bot? string? procedure? -> void?)

+96

(let* ((handlers (tg-bot-command-handlers bot))

+97

(existing (dict-ref handlers (string->keyword command) '())))

+98

(set-tg-bot-command-handlers!

+99

bot

+100

(dict-set handlers (string->keyword command)

+101

(append existing (list handler))))))

+102

+103

;;; Register a handler for all text messages.

+104

;;;

+105

;;; Called for every message that passes authorization.

+106

;;;

+107

;;; ```scheme

+108

;;; (tg-on-message bot

+109

;;; (lambda (bot msg)

+110

;;; (display (tg-message-text msg))))

+111

;;; ```

+112

(define (tg-on-message bot handler)

+113

(: tg-bot? procedure? -> void?)

+114

(set-tg-bot-message-handlers!

+115

bot

+116

(append (tg-bot-message-handlers bot) (list handler))))

+117

+118

;;; Register a handler for callback queries (inline keyboard presses).

+119

;;;

+120

;;; The handler receives `(bot query)` where `query` is a raw dict.

+121

;;;

+122

;;; ```scheme

+123

;;; (tg-on-callback bot

+124

;;; (lambda (bot query)

+125

;;; (tg-answer-callback (tg-bot-client bot)

+126

;;; (dict-ref query id:) text: "Received!")))

+127

;;; ```

+128

(define (tg-on-callback bot handler)

+129

(: tg-bot? procedure? -> void?)

+130

(set-tg-bot-callback-handlers!

+131

bot

+132

(append (tg-bot-callback-handlers bot) (list handler))))

+133

+134

;;; Set an error handler for exceptions during update processing.

+135

;;;

+136

;;; The handler receives the exception and should return:

+137

;;; - `'stop` to halt the bot

+138

;;; - `'continue` to retry immediately (skip backoff)

+139

;;; - Any other value to apply the default 5-second backoff

+140

;;;

+141

;;; ```scheme

+142

;;; (tg-on-error bot

+143

;;; (lambda (exn)

+144

;;; (display "Error: ")

+145

;;; (display exn)

+146

;;; (newline)))

+147

;;; ```

+148

(define (tg-on-error bot handler)

+149

(: tg-bot? procedure? -> void?)

+150

(set-tg-bot-error-handler! bot handler))

+151

+152

;; ============================================================

+153

;; Authorization

+154

;; ============================================================

+155

+156

;;; Check if an update is authorized based on allowed-chats and

+157

;;; allowed-users lists.

+158

(define (authorized? bot update)

+159

(: tg-bot? tg-update? -> boolean?)

+160

(let ((msg (tg-update-message update)))

+161

(if (not msg)

+162

#t ; Non-message updates pass through

+163

(let ((chat-id (tg-chat-id (tg-message-chat msg)))

+164

(user-id (and (tg-message-from msg)

+165

(tg-user-id (tg-message-from msg)))))

+166

(and (or (not (tg-bot-allowed-chats bot))

+167

(member chat-id (tg-bot-allowed-chats bot)))

+168

(or (not (tg-bot-allowed-users bot))

+169

(and user-id

+170

(member user-id (tg-bot-allowed-users bot)))))))))

+171

+172

;; ============================================================

+173

;; Command Extraction

+174

;; ============================================================

+175

+176

;;; Extract the command name from a message text.

+177

;;;

+178

;;; Strips @botname mentions and arguments.

+179

;;; "/start" => "/start"

+180

;;; "/help@MyBot" => "/help"

+181

;;; "/set value 42" => "/set"

+182

(define (extract-command text)

+183

(: string? -> string?)

+184

(let* ((space-pos (string-index text (lambda (c) (char=? c #\space))))

+185

(cmd-part (if space-pos

+186

(substring text 0 space-pos)

+187

text))

+188

(at-pos (string-index cmd-part (lambda (c) (char=? c #\@)))))

+189

(if at-pos

+190

(substring cmd-part 0 at-pos)

+191

cmd-part)))

+192

+193

;; ============================================================

+194

;; Update Dispatch

+195

;; ============================================================

+196

+197

;; Dispatch a single update to registered handlers

+198

(define (dispatch-update bot update)

+199

(when (authorized? bot update)

+200

;; Message handling

+201

(let ((msg (tg-update-message update)))

+202

(when msg

+203

;; Check for command

+204

(let ((text (tg-message-text msg)))

+205

(when (and text

+206

(> (string-length text) 0)

+207

(char=? (string-ref text 0) #\/))

+208

(let* ((cmd (extract-command text))

+209

(cmd-key (string->keyword cmd))

+210

(handlers (dict-ref (tg-bot-command-handlers bot)

+211

cmd-key '())))

+212

(for-each (lambda (h) (h bot msg)) handlers))))

+213

+214

;; General message handlers

+215

(for-each (lambda (h) (h bot msg))

+216

(tg-bot-message-handlers bot))))

+217

+218

;; Callback query handling

+219

(let ((cb (tg-update-callback-query update)))

+220

(when cb

+221

(for-each (lambda (h) (h bot cb))

+222

(tg-bot-callback-handlers bot))))))

+223

+224

;; ============================================================

+225

;; Event Loop

+226

;; ============================================================

+227

+228

;;; Run the bot polling loop.

+229

;;;

+230

;;; Blocks and polls for updates using long-polling. Each update

+231

;;; is dispatched to registered handlers. Stops when `tg-bot-stop`

+232

;;; is called.

+233

;;;

+234

;;; ```scheme

+235

;;; (tg-on-command bot "/ping"

+236

;;; (lambda (bot msg)

+237

;;; (tg-reply bot msg "pong!")))

+238

;;;

+239

;;; (tg-bot-run bot)

+240

;;; ```

+241

(define (tg-bot-run bot (keys: (timeout 30)))

+242

(: tg-bot? (timeout: integer?) -> void?)

+243

(set-tg-bot-running?! bot #t)

+244

(let loop ()

+245

(when (tg-bot-running? bot)

+246

(let ((error-result

+247

(guard (exn

+248

(else

+249

(if (tg-bot-error-handler bot)

+250

((tg-bot-error-handler bot) exn)

+251

(begin

+252

(display "tg-bot-run: error: " (current-error-port))

+253

(display exn (current-error-port))

+254

(newline (current-error-port))

+255

;; Default: apply backoff

+256

#t))))

+257

(let ((updates (tg-get-updates (tg-bot-client bot)

+258

timeout: timeout)))

+259

(when updates

+260

(for-each

+261

(lambda (raw-update)

+262

(let ((update (dict->tg-update raw-update)))

+263

(set-tg-client-last-update-id!

+264

(tg-bot-client bot)

+265

(+ (tg-update-update-id update) 1))

+266

(dispatch-update bot update)))

+267

(if (array? updates) (array->list updates) '())))

+268

;; No error

+269

#f))))

+270

;; Handle error recovery

+271

(cond

+272

((eq? error-result 'stop)

+273

(set-tg-bot-running?! bot #f))

+274

((eq? error-result 'continue)

+275

;; Skip backoff, retry immediately

+276

#t)

+277

(error-result

+278

;; Default backoff

+279

(sleep 5))))

+280

(loop))))

+281

+282

;;; Stop the bot polling loop.

+283

(define (tg-bot-stop bot)

+284

(: tg-bot? -> void?)

+285

(set-tg-bot-running?! bot #f))

+286

+287

;;; Process one batch of updates (non-blocking).

+288

;;;

+289

;;; Uses timeout: 0 for immediate return. Useful for integrating

+290

;;; with other event loops.

+291

(define (tg-bot-tick bot)

+292

(: tg-bot? -> void?)

+293

(let ((updates (tg-get-updates (tg-bot-client bot) timeout: 0)))

+294

(when updates

+295

(for-each

+296

(lambda (raw-update)

+297

(let ((update (dict->tg-update raw-update)))

+298

(set-tg-client-last-update-id!

+299

(tg-bot-client bot)

+300

(+ (tg-update-update-id update) 1))

+301

(dispatch-update bot update)))

+302

(if (array? updates) (array->list updates) '())))))

+303

+304

;; ============================================================

+305

;; Convenience

+306

;; ============================================================

+307

+308

;;; Reply to a message with text.

+309

;;;

+310

;;; Sends a reply in the same chat. Set `quote?:` to #t to quote

+311

;;; the original message.

+312

;;;

+313

;;; ```scheme

+314

;;; (tg-reply bot msg "Got it!" parse-mode: "MarkdownV2")

+315

;;; ```

+316

(define (tg-reply bot msg text

+317

(keys: (parse-mode #f) (quote? #f) (reply-markup #f)))

+318

(: tg-bot? tg-message? string?

+319

(parse-mode: (maybe string?)) (quote?: boolean?)

+320

(reply-markup: (maybe dict?)) -> tg-message?)

+321

(tg-send-message (tg-bot-client bot)

+322

(tg-chat-id (tg-message-chat msg))

+323

text

+324

parse-mode: parse-mode

+325

reply-to: (if quote? (tg-message-message-id msg) #f)

+326

reply-markup: reply-markup))

+327

+328

;;; Reply to a message with a photo (URL or file_id).

+329

;;;

+330

;;; ```scheme

+331

;;; (tg-reply-photo bot msg "https://example.com/photo.jpg"

+332

;;; caption: "Here you go!")

+333

;;; ```

+334

(define (tg-reply-photo bot msg photo

+335

(keys: (caption #f) (parse-mode #f)))

+336

(: tg-bot? tg-message? string?

+337

(caption: (maybe string?)) (parse-mode: (maybe string?))

+338

-> tg-message?)

+339

(tg-send-photo (tg-bot-client bot)

+340

(tg-chat-id (tg-message-chat msg))

+341

photo

+342

caption: caption

+343

parse-mode: parse-mode))

+344

+345

;;; Reply to a message with an uploaded local photo.

+346

;;;

+347

;;; ```scheme

+348

;;; (tg-reply-photo/upload bot msg "/tmp/result.png"

+349

;;; caption: "Processing complete")

+350

;;; ```

+351

(define (tg-reply-photo/upload bot msg path

+352

(keys: (caption #f) (parse-mode #f)))

+353

(: tg-bot? tg-message? string?

+354

(caption: (maybe string?)) (parse-mode: (maybe string?))

+355

-> tg-message?)

+356

(tg-upload-photo (tg-bot-client bot)

+357

(tg-chat-id (tg-message-chat msg))

+358

path

+359

caption: caption

+360

parse-mode: parse-mode))

+361

+362

))

src/sigil/telegram/client.sgladded

@@ -0,0 +1,498 @@

;;; (sigil telegram client) - Telegram Bot API Client

;;;

;;; Provides low-level HTTP transport for the Telegram Bot API,

;;; including JSON-based API calls and multipart file uploads.

(define-library (sigil telegram client)

(import (sigil core)

(sigil string)

(sigil struct)

+10

(sigil io)

+11

(sigil fs)

+12

(sigil json)

+13

(sigil http client)

+14

(sigil http mime)

+15

(sigil tls)

+16

(sigil crypto)

+17

(sigil path)

+18

(sigil telegram types))

+19

+20

(export

+21

;; Client

+22

tg-client tg-client? tg-client-token

+23

tg-client-last-update-id set-tg-client-last-update-id!

+24

+25

;; Core API

+26

tg-api-call

+27

+28

;; Messages

+29

tg-get-me

+30

tg-send-message

+31

tg-edit-message

+32

tg-delete-message

+33

+34

;; Media (URL/file_id)

+35

tg-send-photo

+36

tg-send-document

+37

+38

;; Media (file upload)

+39

tg-upload-photo

+40

tg-upload-document

+41

+42

;; Callbacks

+43

tg-answer-callback

+44

+45

;; Updates

+46

tg-get-updates

+47

tg-fetch-updates

+48

+49

;; Inline keyboards

+50

tg-inline-keyboard

+51

tg-button

+52

+53

;; Multipart (exported for testing)

+54

build-multipart-body

+55

encode-text-part

+56

encode-file-part

+57

generate-boundary)

+58

+59

(begin

+60

+61

;; ============================================================

+62

;; Client Record

+63

;; ============================================================

+64

+65

(define-struct tg-client

+66

(token)

+67

(api-url default: "https://api.telegram.org")

+68

(last-update-id default: 0 mutable: #t))

+69

+70

;; ============================================================

+71

;; Core API Call

+72

;; ============================================================

+73

+74

;; Build the full API URL for a method

+75

(define (api-url client method)

+76

(string-append (tg-client-api-url client)

+77

"/bot" (tg-client-token client)

+78

"/" method))

+79

+80

;;; Make a Telegram Bot API call.

+81

;;;

+82

;;; Calls the given method with the provided parameters dict.

+83

;;; Returns the `result` field from the API response on success,

+84

;;; or raises an error if `ok` is false.

+85

;;;

+86

;;; ```scheme

+87

;;; (tg-api-call client "getMe" #{})

+88

;;; ; => #{ id: 123456 is_bot: #t first_name: "MyBot" ... }

+89

;;; ```

+90

(define (tg-api-call client method (keys: (params #{})))

+91

(: tg-client? string? (params: dict?) -> any?)

+92

(let ((response (http-post/json (api-url client method) params)))

+93

(unless response

+94

(error (string-append "tg-api-call: HTTP request failed for " method)))

+95

(if (eq? (dict-ref response ok: #f) #t)

+96

(dict-ref response result: #f)

+97

(error (string-append "tg-api-call: " method " failed: "

+98

(or (dict-ref response description: #f)

+99

"unknown error"))

+100

(dict-ref response error_code: #f)))))

+101

+102

;; Helper to build params dict, adding optional keyword arguments

+103

(define (add-param params key value)

+104

(if value (dict-set params key value) params))

+105

+106

;; ============================================================

+107

;; Bot Info

+108

;; ============================================================

+109

+110

;;; Get information about the bot.

+111

;;;

+112

;;; ```scheme

+113

;;; (tg-get-me client) ; => #{ id: 123 is_bot: #t first_name: "MyBot" ... }

+114

;;; ```

+115

(define (tg-get-me client)

+116

(: tg-client? -> dict?)

+117

(tg-api-call client "getMe"))

+118

+119

;; ============================================================

+120

;; Sending Messages

+121

;; ============================================================

+122

+123

;;; Send a text message.

+124

;;;

+125

;;; Returns the sent message as a tg-message record.

+126

;;;

+127

;;; ```scheme

+128

;;; (tg-send-message client 12345 "Hello!")

+129

;;;

+130

;;; (tg-send-message client 12345

+131

;;; (string-append (tg-bold "Hello") "\\!")

+132

;;; parse-mode: "MarkdownV2")

+133

;;; ```

+134

(define (tg-send-message client chat-id text

+135

(keys: (parse-mode #f) (reply-to #f)

+136

(disable-notification #f) (reply-markup #f)))

+137

(: tg-client? (any-of integer? string?) string?

+138

(parse-mode: (maybe string?)) (reply-to: (maybe integer?))

+139

(disable-notification: (maybe boolean?)) (reply-markup: (maybe dict?))

+140

-> tg-message?)

+141

(let* ((params (dict chat_id: chat-id text: text))

+142

(params (add-param params parse_mode: parse-mode))

+143

(params (add-param params reply_to_message_id: reply-to))

+144

(params (if disable-notification

+145

(dict-set params disable_notification: #t)

+146

params))

+147

(params (add-param params reply_markup: reply-markup)))

+148

(dict->tg-message (tg-api-call client "sendMessage" params: params))))

+149

+150

;;; Edit an existing message's text.

+151

;;;

+152

;;; ```scheme

+153

;;; (tg-edit-message client 12345 678 "Updated text")

+154

;;; ```

+155

(define (tg-edit-message client chat-id message-id text

+156

(keys: (parse-mode #f) (reply-markup #f)))

+157

(: tg-client? (any-of integer? string?) integer? string?

+158

(parse-mode: (maybe string?)) (reply-markup: (maybe dict?))

+159

-> any?)

+160

(let* ((params (dict chat_id: chat-id message_id: message-id text: text))

+161

(params (add-param params parse_mode: parse-mode))

+162

(params (add-param params reply_markup: reply-markup)))

+163

(tg-api-call client "editMessageText" params: params)))

+164

+165

;;; Delete a message.

+166

;;;

+167

;;; ```scheme

+168

;;; (tg-delete-message client 12345 678)

+169

;;; ```

+170

(define (tg-delete-message client chat-id message-id)

+171

(: tg-client? (any-of integer? string?) integer? -> any?)

+172

(tg-api-call client "deleteMessage"

+173

params: (dict chat_id: chat-id message_id: message-id)))

+174

+175

;; ============================================================

+176

;; Media Sending (URL/file_id)

+177

;; ============================================================

+178

+179

;;; Send a photo by URL or file_id.

+180

;;;

+181

;;; The `photo` parameter must be a Telegram file_id string or an

+182

;;; HTTP/HTTPS URL. For uploading a local file, use `tg-upload-photo`.

+183

;;;

+184

;;; ```scheme

+185

;;; (tg-send-photo client 12345 "https://example.com/photo.jpg"

+186

;;; caption: "A nice photo")

+187

;;; ```

+188

(define (tg-send-photo client chat-id photo

+189

(keys: (caption #f) (parse-mode #f) (reply-markup #f)))

+190

(: tg-client? (any-of integer? string?) string?

+191

(caption: (maybe string?)) (parse-mode: (maybe string?))

+192

(reply-markup: (maybe dict?)) -> tg-message?)

+193

(let* ((params (dict chat_id: chat-id photo: photo))

+194

(params (add-param params caption: caption))

+195

(params (add-param params parse_mode: parse-mode))

+196

(params (add-param params reply_markup: reply-markup)))

+197

(dict->tg-message (tg-api-call client "sendPhoto" params: params))))

+198

+199

;;; Send a document by URL or file_id.

+200

;;;

+201

;;; The `document` parameter must be a Telegram file_id string or an

+202

;;; HTTP/HTTPS URL. For uploading a local file, use `tg-upload-document`.

+203

;;;

+204

;;; ```scheme

+205

;;; (tg-send-document client 12345 "https://example.com/file.pdf")

+206

;;; ```

+207

(define (tg-send-document client chat-id document

+208

(keys: (caption #f) (parse-mode #f) (reply-markup #f)))

+209

(: tg-client? (any-of integer? string?) string?

+210

(caption: (maybe string?)) (parse-mode: (maybe string?))

+211

(reply-markup: (maybe dict?)) -> tg-message?)

+212

(let* ((params (dict chat_id: chat-id document: document))

+213

(params (add-param params caption: caption))

+214

(params (add-param params parse_mode: parse-mode))

+215

(params (add-param params reply_markup: reply-markup)))

+216

(dict->tg-message (tg-api-call client "sendDocument" params: params))))

+217

+218

;; ============================================================

+219

;; Multipart File Upload

+220

;; ============================================================

+221

+222

;;; Generate a unique multipart boundary string.

+223

(define (generate-boundary)

+224

(: -> string?)

+225

(let ((bytes (random-bytes 16)))

+226

(string-append "SigilBoundary" (base64-encode bytes))))

+227

+228

;;; Encode a text form field as a bytevector.

+229

(define (encode-text-part boundary name value)

+230

(: string? string? string? -> bytevector?)

+231

(string->utf8

+232

(string-append "--" boundary "\r\n"

+233

"Content-Disposition: form-data; name=\"" name "\"\r\n"

+234

"\r\n"

+235

value "\r\n")))

+236

+237

;;; Encode a file form field as a bytevector.

+238

(define (encode-file-part boundary name filename content-type data)

+239

(: string? string? string? string? bytevector? -> bytevector?)

+240

(bytevector-append

+241

(string->utf8

+242

(string-append "--" boundary "\r\n"

+243

"Content-Disposition: form-data; name=\"" name

+244

"\"; filename=\"" filename "\"\r\n"

+245

"Content-Type: " content-type "\r\n"

+246

"\r\n"))

+247

data

+248

(string->utf8 "\r\n")))

+249

+250

;;; Build a complete multipart/form-data body as a bytevector.

+251

;;;

+252

;;; `fields` is a list of (name . value) pairs for text fields.

+253

;;; `files` is a list of (name filename content-type bytevector) lists.

+254

;;; Returns a pair: (boundary . body-bytevector).

+255

(define (build-multipart-body fields files)

+256

(: list? list? -> pair?)

+257

(let* ((boundary (generate-boundary))

+258

(text-parts (map (lambda (field)

+259

(encode-text-part boundary (car field) (cdr field)))

+260

fields))

+261

(file-parts (map (lambda (file)

+262

(encode-file-part boundary

+263

(list-ref file 0)

+264

(list-ref file 1)

+265

(list-ref file 2)

+266

(list-ref file 3)))

+267

files))

+268

(closing (string->utf8 (string-append "--" boundary "--\r\n")))

+269

(body (apply bytevector-append

+270

(append text-parts file-parts (list closing)))))

+271

(cons boundary body)))

+272

+273

;; Read a file into a bytevector

+274

(define (read-file-bytes path)

+275

(let* ((size (file-size path))

+276

(port (open-binary-input-file path))

+277

(data (read-bytevector size port)))

+278

(close-input-port port)

+279

data))

+280

+281

;; Read all string data from a TLS connection until closed

+282

(define (read-all-tls-data conn)

+283

(let loop ((chunks '()))

+284

(let ((chunk (tls-read conn)))

+285

(cond

+286

((or (not chunk) (eof-object? chunk))

+287

(apply string-append (reverse chunks)))

+288

((string=? chunk "")

+289

(apply string-append (reverse chunks)))

+290

(else

+291

(loop (cons chunk chunks)))))))

+292

+293

;; Parse a raw HTTP response string to extract JSON body

+294

(define (parse-tls-response data)

+295

(let ((header-end (string-find data "\r\n\r\n")))

+296

(if header-end

+297

(let ((body (substring data (+ header-end 4)

+298

(string-length data))))

+299

(json-decode body))

+300

#f)))

+301

+302

;; Send a multipart API call via direct TLS connection

+303

(define (tg-api-call/upload client method fields files)

+304

(let* ((result (build-multipart-body fields files))

+305

(boundary (car result))

+306

(body (cdr result))

+307

(path (string-append "/bot" (tg-client-token client) "/" method))

+308

(headers (string-append

+309

"POST " path " HTTP/1.1\r\n"

+310

"Host: api.telegram.org\r\n"

+311

"User-Agent: Sigil/1.0\r\n"

+312

"Connection: close\r\n"

+313

"Content-Type: multipart/form-data; boundary=" boundary "\r\n"

+314

"Content-Length: " (number->string (bytevector-length body)) "\r\n"

+315

"\r\n"))

+316

(conn (tls-connect "api.telegram.org" 443)))

+317

(unless conn

+318

(error "tg-api-call/upload: failed to connect to api.telegram.org"))

+319

(tls-write conn headers)

+320

(tls-write conn body)

+321

(let* ((response-data (read-all-tls-data conn))

+322

(_ (tls-close conn))

+323

(response (parse-tls-response response-data)))

+324

(unless response

+325

(error (string-append "tg-api-call/upload: failed to parse response for " method)))

+326

(if (eq? (dict-ref response ok: #f) #t)

+327

(dict-ref response result: #f)

+328

(error (string-append "tg-api-call/upload: " method " failed: "

+329

(or (dict-ref response description: #f)

+330

"unknown error"))

+331

(dict-ref response error_code: #f))))))

+332

+333

;;; Upload a local photo file.

+334

;;;

+335

;;; Reads the file at `path`, auto-detects its MIME type, and sends

+336

;;; it to the Telegram API via multipart/form-data upload.

+337

;;;

+338

;;; ```scheme

+339

;;; (tg-upload-photo client 12345 "/tmp/screenshot.png"

+340

;;; caption: "Build output")

+341

;;; ```

+342

(define (tg-upload-photo client chat-id path

+343

(keys: (caption #f) (parse-mode #f) (reply-markup #f)))

+344

(: tg-client? (any-of integer? string?) string?

+345

(caption: (maybe string?)) (parse-mode: (maybe string?))

+346

(reply-markup: (maybe dict?)) -> tg-message?)

+347

(let* ((data (read-file-bytes path))

+348

(mime (mime-type-for-file path))

+349

(filename (path-basename path))

+350

(fields (let* ((f (list (cons "chat_id" (if (integer? chat-id)

+351

(number->string chat-id)

+352

chat-id))))

+353

(f (if caption (cons (cons "caption" caption) f) f))

+354

(f (if parse-mode (cons (cons "parse_mode" parse-mode) f) f))

+355

(f (if reply-markup

+356

(cons (cons "reply_markup" (json-encode reply-markup)) f)

+357

f)))

+358

f))

+359

(files (list (list "photo" filename mime data))))

+360

(dict->tg-message (tg-api-call/upload client "sendPhoto" fields files))))

+361

+362

;;; Upload a local document file.

+363

;;;

+364

;;; Reads the file at `path`, auto-detects its MIME type, and sends

+365

;;; it to the Telegram API via multipart/form-data upload.

+366

;;;

+367

;;; ```scheme

+368

;;; (tg-upload-document client 12345 "/tmp/report.pdf")

+369

;;; ```

+370

(define (tg-upload-document client chat-id path

+371

(keys: (caption #f) (parse-mode #f) (reply-markup #f)))

+372

(: tg-client? (any-of integer? string?) string?

+373

(caption: (maybe string?)) (parse-mode: (maybe string?))

+374

(reply-markup: (maybe dict?)) -> tg-message?)

+375

(let* ((data (read-file-bytes path))

+376

(mime (mime-type-for-file path))

+377

(filename (path-basename path))

+378

(fields (let* ((f (list (cons "chat_id" (if (integer? chat-id)

+379

(number->string chat-id)

+380

chat-id))))

+381

(f (if caption (cons (cons "caption" caption) f) f))

+382

(f (if parse-mode (cons (cons "parse_mode" parse-mode) f) f))

+383

(f (if reply-markup

+384

(cons (cons "reply_markup" (json-encode reply-markup)) f)

+385

f)))

+386

f))

+387

(files (list (list "document" filename mime data))))

+388

(dict->tg-message (tg-api-call/upload client "sendDocument" fields files))))

+389

+390

;; ============================================================

+391

;; Callback Queries

+392

;; ============================================================

+393

+394

;;; Answer a callback query (inline keyboard button press).

+395

;;;

+396

;;; ```scheme

+397

;;; (tg-answer-callback client callback-query-id

+398

;;; text: "Button pressed!")

+399

;;; ```

+400

(define (tg-answer-callback client callback-query-id

+401

(keys: (text #f) (show-alert #f)))

+402

(: tg-client? string? (text: (maybe string?)) (show-alert: (maybe boolean?)) -> any?)

+403

(let* ((params (dict callback_query_id: callback-query-id))

+404

(params (add-param params text: text))

+405

(params (if show-alert

+406

(dict-set params show_alert: #t)

+407

params)))

+408

(tg-api-call client "answerCallbackQuery" params: params)))

+409

+410

;; ============================================================

+411

;; Updates

+412

;; ============================================================

+413

+414

;;; Get updates using long-polling.

+415

;;;

+416

;;; Returns an array of update dicts, or #f on failure.

+417

;;; Typically called by the bot framework, not directly.

+418

(define (tg-get-updates client (keys: (timeout 30) (allowed-updates #f)))

+419

(: tg-client? (timeout: integer?) (allowed-updates: (maybe list?)) -> any?)

+420

(let* ((offset (tg-client-last-update-id client))

+421

(params (dict timeout: timeout))

+422

(params (if (> offset 0) (dict-set params offset: offset) params))

+423

(params (add-param params allowed_updates: allowed-updates)))

+424

(tg-api-call client "getUpdates" params: params)))

+425

+426

;;; Fetch all pending updates as a list of tg-update records.

+427

;;;

+428

;;; Returns immediately (non-blocking) with all unconfirmed updates,

+429

;;; converts them to typed records, and confirms receipt with

+430

;;; Telegram so they won't be returned again on the next call.

+431

;;;

+432

;;; This is the simplest way to check for new messages in a

+433

;;; script that wakes up, processes messages, and exits.

+434

;;;

+435

;;; ```scheme

+436

;;; (define client (tg-client token: "..."))

+437

;;; (for-each

+438

;;; (lambda (update)

+439

;;; (let ((msg (tg-update-message update)))

+440

;;; (when (and msg (tg-message-text msg))

+441

;;; (tg-send-message client

+442

;;; (tg-chat-id (tg-message-chat msg))

+443

;;; "Got it!"))))

+444

;;; (tg-fetch-updates client))

+445

;;; ```

+446

(define (tg-fetch-updates client)

+447

(: tg-client? -> list?)

+448

(let ((raw-updates (tg-get-updates client timeout: 0)))

+449

(if (and raw-updates (array? raw-updates) (> (array-length raw-updates) 0))

+450

(let ((updates (map dict->tg-update (array->list raw-updates))))

+451

;; Update offset and confirm receipt immediately so a

+452

;; subsequent process won't see the same updates

+453

(let ((last (list-ref updates (- (length updates) 1))))

+454

(set-tg-client-last-update-id! client

+455

(+ (tg-update-update-id last) 1))

+456

(tg-get-updates client timeout: 0))

+457

updates)

+458

'())))

+459

+460

;; ============================================================

+461

;; Inline Keyboards

+462

;; ============================================================

+463

+464

;;; Build an inline keyboard markup dict.

+465

;;;

+466

;;; Takes a list of rows, where each row is a list of button dicts

+467

;;; (created with `tg-button`).

+468

;;;

+469

;;; ```scheme

+470

;;; (tg-inline-keyboard

+471

;;; (list

+472

;;; (list (tg-button "Yes" callback: "yes")

+473

;;; (tg-button "No" callback: "no"))))

+474

;;; ```

+475

(define (tg-inline-keyboard rows)

+476

(: list? -> dict?)

+477

(dict inline_keyboard:

+478

(list->array

+479

(map (lambda (row) (list->array row)) rows))))

+480

+481

;;; Build an inline keyboard button.

+482

;;;

+483

;;; Specify either `callback:` for a callback data string or

+484

;;; `url:` for an external link.

+485

;;;

+486

;;; ```scheme

+487

;;; (tg-button "Click me" callback: "btn_click")

+488

;;; (tg-button "Visit" url: "https://example.com")

+489

;;; ```

+490

(define (tg-button text (keys: (callback #f) (url #f)))

+491

(: string? (callback: (maybe string?)) (url: (maybe string?)) -> dict?)

+492

(let ((btn (dict text: text)))

+493

(cond

+494

(callback (dict-set btn callback_data: callback))

+495

(url (dict-set btn url: url))

+496

(else btn))))

+497

+498

))

src/sigil/telegram/format.sgladded

@@ -0,0 +1,130 @@

;;; (sigil telegram format) - MarkdownV2 Formatting Helpers

;;;

;;; Provides escaping and formatting functions for Telegram's MarkdownV2

;;; parse mode. Dynamic text must be escaped with `tg-escape-markdown`

;;; before wrapping with formatting helpers.

(define-library (sigil telegram format)

(import (sigil core)

(sigil string))

+10

+11

(export

+12

tg-escape-markdown

+13

tg-bold

+14

tg-italic

+15

tg-underline

+16

tg-strike

+17

tg-code

+18

tg-code-block

+19

tg-link

+20

tg-spoiler)

+21

+22

(begin

+23

+24

;; Characters that must be escaped in MarkdownV2 outside of formatting

+25

(define %markdown-special-chars

+26

'("_" "*" "[" "]" "(" ")" "~" "`" ">" "#"

+27

"+" "-" "=" "|" "{" "}" "." "!"))

+28

+29

;;; Escape a string for Telegram MarkdownV2 format.

+30

;;;

+31

;;; Prepends a backslash before each special character that MarkdownV2

+32

;;; requires to be escaped. Call this on dynamic text before wrapping

+33

;;; it with formatting helpers like `tg-bold` or `tg-italic`.

+34

;;;

+35

;;; ```scheme

+36

;;; (tg-escape-markdown "Hello! How are you?")

+37

;;; ; => "Hello\\! How are you\\?"

+38

;;;

+39

;;; (tg-escape-markdown "Price: $5.00 (USD)")

+40

;;; ; => "Price: $5\\.00 \$USD\$"

+41

;;; ```

+42

(define (tg-escape-markdown text)

+43

(: string? -> string?)

+44

(fold (lambda (result char)

+45

(string-replace result char (string-append "\\" char)))

+46

text

+47

%markdown-special-chars))

+48

+49

;;; Format text as bold in MarkdownV2.

+50

;;;

+51

;;; ```scheme

+52

;;; (tg-bold "important") ; => "*important*"

+53

;;; ```

+54

(define (tg-bold text)

+55

(: string? -> string?)

+56

(string-append "*" text "*"))

+57

+58

;;; Format text as italic in MarkdownV2.

+59

;;;

+60

;;; ```scheme

+61

;;; (tg-italic "emphasis") ; => "_emphasis_"

+62

;;; ```

+63

(define (tg-italic text)

+64

(: string? -> string?)

+65

(string-append "_" text "_"))

+66

+67

;;; Format text as underlined in MarkdownV2.

+68

;;;

+69

;;; ```scheme

+70

;;; (tg-underline "noted") ; => "__noted__"

+71

;;; ```

+72

(define (tg-underline text)

+73

(: string? -> string?)

+74

(string-append "__" text "__"))

+75

+76

;;; Format text as strikethrough in MarkdownV2.

+77

;;;

+78

;;; ```scheme

+79

;;; (tg-strike "removed") ; => "~removed~"

+80

;;; ```

+81

(define (tg-strike text)

+82

(: string? -> string?)

+83

(string-append "~" text "~"))

+84

+85

;;; Format text as inline code in MarkdownV2.

+86

;;;

+87

;;; ```scheme

+88

;;; (tg-code "variable") ; => "`variable`"

+89

;;; ```

+90

(define (tg-code text)

+91

(: string? -> string?)

+92

(string-append "`" text "`"))

+93

+94

;;; Format text as a code block in MarkdownV2.

+95

;;;

+96

;;; Optionally specify a language for syntax highlighting.

+97

;;;

+98

;;; ```scheme

+99

;;; (tg-code-block "(+ 1 2)")

+100

;;; ; => "```\n(+ 1 2)```"

+101

;;;

+102

;;; (tg-code-block "(+ 1 2)" language: "scheme")

+103

;;; ; => "```scheme\n(+ 1 2)```"

+104

;;; ```

+105

(define (tg-code-block text (keys: (language #f)))

+106

(: string? (language: (maybe string?)) -> string?)

+107

(if language

+108

(string-append "```" language "\n" text "```")

+109

(string-append "```\n" text "```")))

+110

+111

;;; Format a MarkdownV2 inline link.

+112

;;;

+113

;;; ```scheme

+114

;;; (tg-link "Click here" "https://example.com")

+115

;;; ; => "[Click here](https://example.com)"

+116

;;; ```

+117

(define (tg-link text url)

+118

(: string? string? -> string?)

+119

(string-append "[" text "](" url ")"))

+120

+121

;;; Format text as a spoiler in MarkdownV2.

+122

;;;

+123

;;; ```scheme

+124

;;; (tg-spoiler "hidden text") ; => "||hidden text||"

+125

;;; ```

+126

(define (tg-spoiler text)

+127

(: string? -> string?)

+128

(string-append "||" text "||"))

+129

+130

))

src/sigil/telegram/types.sgladded

@@ -0,0 +1,128 @@

;;; (sigil telegram types) - Telegram API Data Types

;;;

;;; Defines structs for core Telegram objects (Update, Message, Chat, User)

;;; and conversion functions from JSON dicts to typed records.

(define-library (sigil telegram types)

(import (sigil core)

(sigil struct))

+10

(export

+11

;; User

+12

tg-user tg-user? tg-user-id tg-user-is-bot

+13

tg-user-first-name tg-user-last-name tg-user-username

+14

dict->tg-user

+15

+16

;; Chat

+17

tg-chat tg-chat? tg-chat-id tg-chat-type

+18

tg-chat-title tg-chat-username

+19

dict->tg-chat

+20

+21

;; Message

+22

tg-message tg-message? tg-message-message-id tg-message-chat

+23

tg-message-from tg-message-date tg-message-text

+24

tg-message-photo tg-message-document tg-message-reply-to

+25

tg-message-raw

+26

dict->tg-message

+27

+28

;; Update

+29

tg-update tg-update? tg-update-update-id tg-update-message

+30

tg-update-callback-query tg-update-raw

+31

dict->tg-update)

+32

+33

(begin

+34

+35

;; ============================================================

+36

;; User

+37

;; ============================================================

+38

+39

(define-struct tg-user

+40

(id)

+41

(is-bot default: #f)

+42

(first-name default: "")

+43

(last-name default: #f)

+44

(username default: #f))

+45

+46

;;; Convert a JSON dict to a tg-user record.

+47

(define (dict->tg-user d)

+48

(: dict? -> tg-user?)

+49

(tg-user

+50

id: (dict-ref d id: 0)

+51

is-bot: (dict-ref d is_bot: #f)

+52

first-name: (or (dict-ref d first_name: #f) "")

+53

last-name: (dict-ref d last_name: #f)

+54

username: (dict-ref d username: #f)))

+55

+56

;; ============================================================

+57

;; Chat

+58

;; ============================================================

+59

+60

(define-struct tg-chat

+61

(id)

+62

(type default: "private")

+63

(title default: #f)

+64

(username default: #f))

+65

+66

;;; Convert a JSON dict to a tg-chat record.

+67

(define (dict->tg-chat d)

+68

(: dict? -> tg-chat?)

+69

(tg-chat

+70

id: (dict-ref d id: 0)

+71

type: (or (dict-ref d type: #f) "private")

+72

title: (dict-ref d title: #f)

+73

username: (dict-ref d username: #f)))

+74

+75

;; ============================================================

+76

;; Message

+77

;; ============================================================

+78

+79

(define-struct tg-message

+80

(message-id)

+81

(chat)

+82

(from default: #f)

+83

(date default: 0)

+84

(text default: #f)

+85

(photo default: #f)

+86

(document default: #f)

+87

(reply-to default: #f)

+88

(raw default: #{}))

+89

+90

;;; Convert a JSON dict to a tg-message record.

+91

(define (dict->tg-message d)

+92

(: dict? -> tg-message?)

+93

(let ((chat-dict (dict-ref d chat: #f))

+94

(from-dict (dict-ref d from: #f))

+95

(reply-dict (dict-ref d reply_to_message: #f)))

+96

(tg-message

+97

message-id: (dict-ref d message_id: 0)

+98

chat: (if chat-dict (dict->tg-chat chat-dict) (tg-chat id: 0))

+99

from: (and from-dict (dict->tg-user from-dict))

+100

date: (dict-ref d date: 0)

+101

text: (dict-ref d text: #f)

+102

photo: (dict-ref d photo: #f)

+103

document: (dict-ref d document: #f)

+104

reply-to: (and reply-dict (dict->tg-message reply-dict))

+105

raw: d)))

+106

+107

;; ============================================================

+108

;; Update

+109

;; ============================================================

+110

+111

(define-struct tg-update

+112

(update-id)

+113

(message default: #f)

+114

(callback-query default: #f)

+115

(raw default: #{}))

+116

+117

;;; Convert a JSON dict to a tg-update record.

+118

(define (dict->tg-update d)

+119

(: dict? -> tg-update?)

+120

(let ((msg-dict (dict-ref d message: #f))

+121

(cb-dict (dict-ref d callback_query: #f)))

+122

(tg-update

+123

update-id: (dict-ref d update_id: 0)

+124

message: (and msg-dict (dict->tg-message msg-dict))

+125

callback-query: cb-dict

+126

raw: d)))

+127

+128

))

test/test-telegram.sgladded

@@ -0,0 +1,282 @@

(import (sigil test)

(scheme base)

(sigil string)

(sigil telegram types)

(sigil telegram client)

(sigil telegram bot)

(sigil telegram format))

;; ============================================================

+10

;; Type Parsing

+11

;; ============================================================

+12

+13

(test-group "dict->tg-user"

+14

(test "parses all fields"

+15

(let ((user (dict->tg-user #{ id: 123 is_bot: #f

+16

first_name: "Alice"

+17

last_name: "Smith"

+18

username: "alice" })))

+19

(assert-equal 123 (tg-user-id user))

+20

(assert-false (tg-user-is-bot user))

+21

(assert-equal "Alice" (tg-user-first-name user))

+22

(assert-equal "Smith" (tg-user-last-name user))

+23

(assert-equal "alice" (tg-user-username user))))

+24

+25

(test "handles missing optional fields"

+26

(let ((user (dict->tg-user #{ id: 456 is_bot: #t first_name: "Bot" })))

+27

(assert-equal 456 (tg-user-id user))

+28

(assert-true (tg-user-is-bot user))

+29

(assert-false (tg-user-last-name user))

+30

(assert-false (tg-user-username user)))))

+31

+32

(test-group "dict->tg-chat"

+33

(test "parses private chat"

+34

(let ((chat (dict->tg-chat #{ id: 100 type: "private"

+35

username: "alice" })))

+36

(assert-equal 100 (tg-chat-id chat))

+37

(assert-equal "private" (tg-chat-type chat))

+38

(assert-false (tg-chat-title chat))

+39

(assert-equal "alice" (tg-chat-username chat))))

+40

+41

(test "parses group chat"

+42

(let ((chat (dict->tg-chat #{ id: -200 type: "supergroup"

+43

title: "My Group" })))

+44

(assert-equal -200 (tg-chat-id chat))

+45

(assert-equal "supergroup" (tg-chat-type chat))

+46

(assert-equal "My Group" (tg-chat-title chat)))))

+47

+48

(test-group "dict->tg-message"

+49

(test "parses text message"

+50

(let ((msg (dict->tg-message

+51

#{ message_id: 42

+52

chat: #{ id: 100 type: "private" }

+53

from: #{ id: 123 is_bot: #f first_name: "Alice" }

+54

date: 1700000000

+55

text: "Hello world" })))

+56

(assert-equal 42 (tg-message-message-id msg))

+57

(assert-equal 100 (tg-chat-id (tg-message-chat msg)))

+58

(assert-equal 123 (tg-user-id (tg-message-from msg)))

+59

(assert-equal 1700000000 (tg-message-date msg))

+60

(assert-equal "Hello world" (tg-message-text msg))

+61

(assert-false (tg-message-photo msg))

+62

(assert-false (tg-message-document msg))))

+63

+64

(test "handles missing from field"

+65

(let ((msg (dict->tg-message

+66

#{ message_id: 1

+67

chat: #{ id: 100 type: "channel" }

+68

date: 0

+69

text: "Channel post" })))

+70

(assert-false (tg-message-from msg))))

+71

+72

(test "preserves raw dict"

+73

(let* ((raw #{ message_id: 1 chat: #{ id: 1 type: "private" }

+74

text: "test" sticker: #{ file_id: "abc" } })

+75

(msg (dict->tg-message raw)))

+76

(assert-equal "abc" (dict-ref (dict-ref (tg-message-raw msg) sticker:) file_id:)))))

+77

+78

(test-group "dict->tg-update"

+79

(test "parses message update"

+80

(let ((update (dict->tg-update

+81

#{ update_id: 999

+82

message: #{ message_id: 1

+83

chat: #{ id: 100 type: "private" }

+84

text: "Hello" } })))

+85

(assert-equal 999 (tg-update-update-id update))

+86

(assert-true (tg-message? (tg-update-message update)))

+87

(assert-false (tg-update-callback-query update))))

+88

+89

(test "parses callback query update"

+90

(let ((update (dict->tg-update

+91

#{ update_id: 1000

+92

callback_query: #{ id: "abc123"

+93

data: "btn_yes" } })))

+94

(assert-equal 1000 (tg-update-update-id update))

+95

(assert-false (tg-update-message update))

+96

(assert-equal "abc123" (dict-ref (tg-update-callback-query update) id:)))))

+97

+98

;; ============================================================

+99

;; Command Extraction

+100

;; ============================================================

+101

+102

(test-group "extract-command"

+103

(test "simple command"

+104

(assert-equal "/start" (extract-command "/start")))

+105

+106

(test "command with bot mention"

+107

(assert-equal "/help" (extract-command "/help@MyBot")))

+108

+109

(test "command with arguments"

+110

(assert-equal "/set" (extract-command "/set value 42")))

+111

+112

(test "command with mention and arguments"

+113

(assert-equal "/cmd" (extract-command "/cmd@Bot arg1 arg2")))

+114

+115

(test "single slash"

+116

(assert-equal "/" (extract-command "/"))))

+117

+118

;; ============================================================

+119

;; MarkdownV2 Escaping

+120

;; ============================================================

+121

+122

(test-group "tg-escape-markdown"

+123

(test "escapes exclamation mark"

+124

(assert-equal "hello\\!" (tg-escape-markdown "hello!")))

+125

+126

(test "escapes period"

+127

(assert-equal "1\\.0" (tg-escape-markdown "1.0")))

+128

+129

(test "escapes multiple characters"

+130

(assert-equal "a\\.b\\~c" (tg-escape-markdown "a.b~c")))

+131

+132

(test "escapes parentheses"

+133

(assert-equal "\$test\$" (tg-escape-markdown "(test)")))

+134

+135

(test "plain text unchanged"

+136

(assert-equal "hello world" (tg-escape-markdown "hello world")))

+137

+138

(test "empty string"

+139

(assert-equal "" (tg-escape-markdown ""))))

+140

+141

;; ============================================================

+142

;; Formatting Helpers

+143

;; ============================================================

+144

+145

(test-group "formatting"

+146

(test "bold"

+147

(assert-equal "*text*" (tg-bold "text")))

+148

+149

(test "italic"

+150

(assert-equal "_text_" (tg-italic "text")))

+151

+152

(test "underline"

+153

(assert-equal "__text__" (tg-underline "text")))

+154

+155

(test "strikethrough"

+156

(assert-equal "~text~" (tg-strike "text")))

+157

+158

(test "code"

+159

(assert-equal "`code`" (tg-code "code")))

+160

+161

(test "code block without language"

+162

(assert-equal "```\n(+ 1 2)```" (tg-code-block "(+ 1 2)")))

+163

+164

(test "code block with language"

+165

(assert-equal "```scheme\n(+ 1 2)```"

+166

(tg-code-block "(+ 1 2)" language: "scheme")))

+167

+168

(test "link"

+169

(assert-equal "[Click](https://example.com)"

+170

(tg-link "Click" "https://example.com")))

+171

+172

(test "spoiler"

+173

(assert-equal "||hidden||" (tg-spoiler "hidden"))))

+174

+175

;; ============================================================

+176

;; Inline Keyboard

+177

;; ============================================================

+178

+179

(test-group "inline keyboard"

+180

(test "button with callback"

+181

(let ((btn (tg-button "Yes" callback: "yes")))

+182

(assert-equal "Yes" (dict-ref btn text:))

+183

(assert-equal "yes" (dict-ref btn callback_data:))))

+184

+185

(test "button with url"

+186

(let ((btn (tg-button "Visit" url: "https://example.com")))

+187

(assert-equal "Visit" (dict-ref btn text:))

+188

(assert-equal "https://example.com" (dict-ref btn url:))))

+189

+190

(test "keyboard structure"

+191

(let ((kb (tg-inline-keyboard

+192

(list (list (tg-button "A" callback: "a")

+193

(tg-button "B" callback: "b"))))))

+194

(assert-true (dict? kb))

+195

(assert-true (array? (dict-ref kb inline_keyboard:)))

+196

(assert-equal 1 (array-length (dict-ref kb inline_keyboard:)))

+197

(assert-equal 2 (array-length (array-ref (dict-ref kb inline_keyboard:) 0))))))

+198

+199

;; ============================================================

+200

;; Authorization

+201

;; ============================================================

+202

+203

(test-group "authorization"

+204

(define (make-test-bot (keys: (allowed-chats #f) (allowed-users #f)))

+205

(tg-bot

+206

client: (tg-client token: "test")

+207

allowed-chats: allowed-chats

+208

allowed-users: allowed-users))

+209

+210

(define (make-test-update chat-id user-id)

+211

(tg-update

+212

update-id: 1

+213

message: (tg-message

+214

message-id: 1

+215

chat: (tg-chat id: chat-id type: "private")

+216

from: (tg-user id: user-id first-name: "Test"))))

+217

+218

(test "all allowed when no restrictions"

+219

(let ((bot (make-test-bot)))

+220

(assert-true (authorized? bot (make-test-update 100 200)))))

+221

+222

(test "chat restriction allows matching chat"

+223

(let ((bot (make-test-bot allowed-chats: '(100 200))))

+224

(assert-true (authorized? bot (make-test-update 100 999)))))

+225

+226

(test "chat restriction blocks non-matching chat"

+227

(let ((bot (make-test-bot allowed-chats: '(100 200))))

+228

(assert-false (authorized? bot (make-test-update 300 999)))))

+229

+230

(test "user restriction allows matching user"

+231

(let ((bot (make-test-bot allowed-users: '(200 300))))

+232

(assert-true (authorized? bot (make-test-update 999 200)))))

+233

+234

(test "user restriction blocks non-matching user"

+235

(let ((bot (make-test-bot allowed-users: '(200 300))))

+236

(assert-false (authorized? bot (make-test-update 999 400)))))

+237

+238

(test "both restrictions must pass"

+239

(let ((bot (make-test-bot allowed-chats: '(100) allowed-users: '(200))))

+240

(assert-true (authorized? bot (make-test-update 100 200)))

+241

(assert-false (authorized? bot (make-test-update 100 300)))

+242

(assert-false (authorized? bot (make-test-update 200 200)))))

+243

+244

(test "non-message update passes through"

+245

(let ((bot (make-test-bot allowed-chats: '(100))))

+246

(assert-true (authorized? bot (tg-update update-id: 1))))))

+247

+248

;; ============================================================

+249

;; Multipart Encoding

+250

;; ============================================================

+251

+252

(test-group "multipart encoding"

+253

(test "text part format"

+254

(let* ((bv (encode-text-part "BOUNDARY" "chat_id" "12345"))

+255

(str (utf8->string bv)))

+256

(assert-true (string-contains? str "--BOUNDARY\r\n"))

+257

(assert-true (string-contains? str "Content-Disposition: form-data; name=\"chat_id\""))

+258

(assert-true (string-contains? str "12345"))))

+259

+260

(test "file part format"

+261

(let* ((data (string->utf8 "fake image data"))

+262

(bv (encode-file-part "BOUNDARY" "photo" "test.jpg" "image/jpeg" data))

+263

(str (utf8->string bv)))

+264

(assert-true (string-contains? str "--BOUNDARY\r\n"))

+265

(assert-true (string-contains? str "name=\"photo\"; filename=\"test.jpg\""))

+266

(assert-true (string-contains? str "Content-Type: image/jpeg"))

+267

(assert-true (string-contains? str "fake image data"))))

+268

+269

(test "build-multipart-body produces boundary and body"

+270

(let* ((result (build-multipart-body

+271

(list (cons "chat_id" "12345"))

+272

(list (list "photo" "test.jpg" "image/jpeg"

+273

(string->utf8 "data")))))

+274

(boundary (car result))

+275

(body (cdr result)))

+276

(assert-true (string? boundary))

+277

(assert-true (bytevector? body))

+278

;; Body should end with closing boundary

+279

(let ((str (utf8->string body)))

+280

(assert-true (string-contains? str (string-append "--" boundary "--")))))))

+281

+282

(run-tests)