test/test-telegram.sgl — sigil-telegram

1(import (sigil test)

2 (sigil io)

3 (sigil string)

4 (sigil telegram types)

5 (sigil telegram client)

6 (sigil telegram bot)

7 (sigil telegram format))

9;; ============================================================

10;; Type Parsing

11;; ============================================================

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))))

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)))))

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))))

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)))))

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))))

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))))

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:)))))

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))))

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:)))))

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 (test "video file part uses video field name"

283 (let* ((data (string->utf8 "fake video bytes"))

284 (bv (encode-file-part "BOUNDARY" "video" "clip.mp4" "video/mp4" data))

285 (str (utf8->string bv)))

286 (assert-true (string-contains? str "name=\"video\"; filename=\"clip.mp4\""))

287 (assert-true (string-contains? str "Content-Type: video/mp4"))

288 (assert-true (string-contains? str "fake video bytes"))))

289

290 (test "multipart body preserves arbitrary file bytes verbatim"

291 ;; Audio tracks and binary container bytes must pass through untouched.

292 (let* ((raw (bytevector 0 1 2 255 254 253 0 13 10))

293 (result (build-multipart-body

294 (list (cons "chat_id" "1"))

295 (list (list "video" "a.mp4" "video/mp4" raw))))

296 (body (cdr result)))

297 (assert-true (bytevector? body))

298 ;; Locate the raw payload inside the body bytevector

299 (let loop ((i 0) (found #f))

300 (cond

301 (found (assert-true #t))

302 ((> (+ i (bytevector-length raw)) (bytevector-length body))

303 (assert-true #f))

304 ((let match ((j 0))

305 (cond

306 ((= j (bytevector-length raw)) #t)

307 ((= (bytevector-u8-ref body (+ i j))

308 (bytevector-u8-ref raw j))

309 (match (+ j 1)))

310 (else #f)))

311 (loop i #t))

312 (else (loop (+ i 1) #f)))))))

313

314(run-tests)