From f9b467a70ce0ac7278c2d7b93cb60665857978a8 Mon Sep 17 00:00:00 2001 From: TroyHernandez Date: Mon, 7 Sep 2026 18:15:59 -0500 Subject: [PATCH 1/2] Add a Telegram adapter chat_telegram() puts the Bot API behind the contract, with HTTP delegated to the suggested httr package. getUpdates long polling is the poll, with one update offset as the cursor across every chat the bot is in; the first poll returns whatever Telegram is still holding, which is the mail that arrived while the bot was down rather than history. Sends render markdown to Telegram HTML, carry thread and reply targets, send each file as its own message ahead of the text, and honour notify = FALSE. Edits, emoji reactions and reaction events, typing, chat info, leaving, getMe identity, setMyName, @username addressing, and attachment fetch through getFile are all wired. Capabilities are honest about the Bot API: no history, member list, chat list, read markers, joining, or creating. Reaction events reach a bot in a group only where it is an administrator. Ids are formatted with %.0f rather than as.character(): R writes the double 100000 as "1e+05", and every id Telegram sends is a number. Every verb is exercised through a .api seam asserting on the wire shape each method receives, and httr formals are pinned for drift. --- DESCRIPTION | 3 +- NAMESPACE | 14 + R/telegram.R | 662 +++++++++++++++++++++++++++++++++ README.md | 1 + inst/tinytest/test_contract.R | 8 +- inst/tinytest/test_telegram.R | 676 ++++++++++++++++++++++++++++++++++ man/chat_telegram.Rd | 55 +++ tasks/todo.md | 4 +- 8 files changed, 1417 insertions(+), 6 deletions(-) create mode 100644 R/telegram.R create mode 100644 inst/tinytest/test_telegram.R create mode 100644 man/chat_telegram.Rd diff --git a/DESCRIPTION b/DESCRIPTION index b654a58..4a1e12b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -10,7 +10,8 @@ Authors@R: c( person("cornball.ai", role = "cph")) Description: A transport-agnostic contract for chat-room connectivity: connect, poll, and send against one interface, with adapters for - 'Matrix', 'Slack', Internet Relay Chat (IRC), and other platforms + 'Matrix', 'Slack', 'Telegram', Internet Relay Chat (IRC), and other + platforms supplied by optional packages. The contract is the union of the parameters found across the R chat-client ecosystem, with per-adapter capability flags for threads, markup dialects, encryption, and diff --git a/NAMESPACE b/NAMESPACE index 8c5f1d1..815a393 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -36,23 +36,27 @@ export(chat_send) export(chat_set_identity) export(chat_set_state) export(chat_slack) +export(chat_telegram) export(chat_typing) export(chat_whoami) S3method(chat_addressed,chat_irc) S3method(chat_addressed,chat_matrix) S3method(chat_addressed,chat_slack) +S3method(chat_addressed,chat_telegram) S3method(chat_addressed,default) S3method(chat_capabilities,chat_irc) S3method(chat_capabilities,chat_loopback) S3method(chat_capabilities,chat_matrix) S3method(chat_capabilities,chat_slack) +S3method(chat_capabilities,chat_telegram) S3method(chat_channel_create,chat_loopback) S3method(chat_channel_create,chat_matrix) S3method(chat_channel_create,chat_slack) S3method(chat_channel_create,default) S3method(chat_channel_info,chat_matrix) S3method(chat_channel_info,chat_slack) +S3method(chat_channel_info,chat_telegram) S3method(chat_channel_info,default) S3method(chat_channels,chat_loopback) S3method(chat_channels,chat_matrix) @@ -62,10 +66,12 @@ S3method(chat_disconnect,chat_irc) S3method(chat_disconnect,default) S3method(chat_download,chat_loopback) S3method(chat_download,chat_matrix) +S3method(chat_download,chat_telegram) S3method(chat_download,default) S3method(chat_edit,chat_loopback) S3method(chat_edit,chat_matrix) S3method(chat_edit,chat_slack) +S3method(chat_edit,chat_telegram) S3method(chat_edit,default) S3method(chat_get_state,chat_loopback) S3method(chat_get_state,chat_matrix) @@ -79,6 +85,7 @@ S3method(chat_join,chat_slack) S3method(chat_join,default) S3method(chat_leave,chat_matrix) S3method(chat_leave,chat_slack) +S3method(chat_leave,chat_telegram) S3method(chat_leave,default) S3method(chat_mark_read,chat_matrix) S3method(chat_mark_read,chat_slack) @@ -92,8 +99,10 @@ S3method(chat_poll,chat_irc) S3method(chat_poll,chat_loopback) S3method(chat_poll,chat_matrix) S3method(chat_poll,chat_slack) +S3method(chat_poll,chat_telegram) S3method(chat_react,chat_matrix) S3method(chat_react,chat_slack) +S3method(chat_react,chat_telegram) S3method(chat_react,default) S3method(chat_relogin,chat_matrix) S3method(chat_relogin,default) @@ -101,23 +110,28 @@ S3method(chat_resolve,chat_irc) S3method(chat_resolve,chat_loopback) S3method(chat_resolve,chat_matrix) S3method(chat_resolve,chat_slack) +S3method(chat_resolve,chat_telegram) S3method(chat_send,chat_irc) S3method(chat_send,chat_loopback) S3method(chat_send,chat_matrix) S3method(chat_send,chat_slack) +S3method(chat_send,chat_telegram) S3method(chat_set_identity,chat_irc) S3method(chat_set_identity,chat_matrix) S3method(chat_set_identity,chat_slack) +S3method(chat_set_identity,chat_telegram) S3method(chat_set_identity,default) S3method(chat_set_state,chat_loopback) S3method(chat_set_state,chat_matrix) S3method(chat_set_state,default) S3method(chat_typing,chat_matrix) +S3method(chat_typing,chat_telegram) S3method(chat_typing,default) S3method(chat_whoami,chat_irc) S3method(chat_whoami,chat_loopback) S3method(chat_whoami,chat_matrix) S3method(chat_whoami,chat_slack) +S3method(chat_whoami,chat_telegram) S3method(chat_whoami,default) S3method(print,chat_attachment) S3method(print,chat_config) diff --git a/R/telegram.R b/R/telegram.R new file mode 100644 index 0000000..43d88d4 --- /dev/null +++ b/R/telegram.R @@ -0,0 +1,662 @@ +#' @title Telegram adapter +#' @description chat.api methods for the Telegram Bot API, with HTTP +#' delegated to the suggested httr package. Receive is getUpdates +#' long polling: one call returns every update Telegram is holding +#' for the bot across every chat it is in, so the cursor is a single +#' update offset rather than one per channel. Sends, edits, +#' reactions, typing, chat metadata, leaving, and files in both +#' directions go through the same API. +#' +#' Known platform limits, reflected in \code{chat_capabilities()}: +#' the Bot API has no history read, no member list, no list of the +#' chats a bot is in, and no read markers. A bot cannot join a chat +#' or create one; a member adds it. Reaction events reach a bot in a +#' group only when it is an administrator there. + +#' Create a Telegram chat client +#' +#' Requires the suggested \pkg{httr} package and a bot token from +#' BotFather. +#' +#' Channels are chat identifiers as Telegram reports them -- a +#' positive number for a private chat, a negative one for a group or +#' channel -- always as character. \code{\link{chat_resolve}} turns a +#' public \code{@@username} into one. +#' +#' The first poll returns whatever updates Telegram is still holding +#' for the bot (it keeps them for 24 hours). That is the mail that +#' arrived while the bot was down rather than channel history, so it +#' comes out as ordinary traffic. Passing the returned cursor back as +#' \code{since} confirms it; Telegram re-sends anything unconfirmed. +#' +#' @param token Bot token; defaults to the \code{TELEGRAM_BOT_TOKEN} +#' environment variable. +#' @param timeout Long-poll wait in seconds, used by +#' \code{\link{chat_poll}} when it is given no \code{timeout}. +#' @param api_url Base URL of the Bot API. The default is Telegram's; +#' a local Bot API server takes its own. +#' @param .api Testing seam: replacement for the HTTP layer, a +#' \code{function(method, params, files)} returning the parsed +#' response (\code{list(ok =, result =)}). \code{params} arrives +#' already in wire form: NULLs dropped, logicals as +#' \code{"true"}/\code{"false"}, numbers as plain digits. Leave NULL +#' in production. +#' @param .download Testing seam: replacement for the file fetch, a +#' \code{function(file_path, dest)} writing the bytes behind a +#' getFile path to \code{dest}. Leave NULL in production; when both +#' seams are supplied the httr package is not required. +#' @return A \code{chat_client} of class \code{chat_telegram}. +#' @export +chat_telegram <- function(token = Sys.getenv("TELEGRAM_BOT_TOKEN"), + timeout = 30L, + api_url = "https://api.telegram.org", .api = NULL, + .download = NULL) { + if ((is.null(.api) || is.null(.download)) && + !requireNamespace("httr", quietly = TRUE)) { + stop("chat_telegram() requires the 'httr' package. ", + "Install it first.", call. = FALSE) + } + if (!is.character(token) || length(token) != 1L || !nzchar(token)) { + stop("chat_telegram() needs a bot token (TELEGRAM_BOT_TOKEN).", + call. = FALSE) + } + api_url <- sub("/+$", "", api_url) + env <- new.env(parent = emptyenv()) + env$cursor <- NULL + env$whoami <- NULL + structure(list(env = env, token = token, timeout = as.integer(timeout), + api_url = api_url, + api_fn = .api %||% telegram_http(token, api_url), + download_fn = .download %||% + telegram_http_download(token, api_url)), + class = c("chat_telegram", "chat_client")) +} + +# The update kinds the poll asks for. Passing the list on every +# getUpdates is how Telegram wants it set; it persists server-side +# until changed. Edits are not requested: an edited message is not new +# conversation, and a consumer that replied to the original would +# answer it twice. +telegram_update_kinds <- c("message", "channel_post", "message_reaction") + +# Identifiers as strings, never through as.character() on a double. +# R writes 100000 as "1e+05", and every id Telegram sends is a number +# to its JSON parser and a string to this contract. A chat id at a +# round hundred thousand would otherwise never match itself. +telegram_chr <- function(x) { + if (is.null(x) || !length(x)) { + return(NULL) + } + if (is.numeric(x)) { + return(sprintf("%.0f", x)) + } + as.character(x) +} + +telegram_time <- function(s) { + if (is.null(s)) { + as.POSIXct(NA) + } else { + as.POSIXct(as.numeric(s), origin = "1970-01-01") + } +} + +telegram_int <- function(x) { + if (is.null(x)) { + NA_integer_ + } else { + suppressWarnings(as.integer(x)) + } +} + +# Parameters as they go on the wire. Form encoding is what every Bot +# API method accepts, so no JSON is built for the common case -- the +# two array-valued parameters (allowed_updates, reaction) are handed +# over as JSON strings by their callers. Logicals become Telegram's +# lowercase spelling, which "TRUE" is not, and numbers go through +# telegram_chr() for the same reason ids do. +telegram_form <- function(params) { + params <- params[!vapply(params, is.null, logical(1))] + lapply(params, function(v) { + if (is.logical(v)) { + if (isTRUE(v)) "true" else "false" + } else if (is.numeric(v)) { + telegram_chr(v) + } else { + v + } + }) +} + +telegram_json_string <- function(x) { + x <- gsub("\\", "\\\\", x, fixed = TRUE) + gsub('"', '\\"', x, fixed = TRUE) +} + +telegram_json_array <- function(x) { + paste0('["', paste(vapply(x, telegram_json_string, ""), collapse = '","'), + '"]') +} + +# The production HTTP layer, one closure per client so the token stays +# out of the seam. Every method is a POST to /bot/; +# multipart is used only when there is a file to carry. +telegram_http <- function(token, api_url) { + force(token) + force(api_url) + function(method, params = list(), files = NULL) { + url <- sprintf("%s/bot%s/%s", api_url, token, method) + body <- params + encode <- "form" + if (length(files)) { + body <- c(body, lapply(files, httr::upload_file)) + encode <- "multipart" + } + # A long poll has to outlive its own wait; nothing else waits. + wait <- suppressWarnings(as.numeric(params$timeout %||% 0)) + if (is.na(wait)) { + wait <- 0 + } + resp <- httr::POST(url, body = body, encode = encode, + httr::timeout(wait + 30)) + # Read the body whatever the status: Telegram says no with a + # 4xx that still carries {ok: false, description}, and the + # description is the part worth reporting. + parsed <- tryCatch( + httr::content(resp, as = "parsed", type = "application/json"), + error = function(e) NULL) + if (!is.list(parsed)) { + stop("chat.api: Telegram ", method, " answered HTTP ", + httr::status_code(resp), " with no JSON body.", + call. = FALSE) + } + parsed + } +} + +# The file half. getFile hands back a path that is only fetchable +# through /file/bot/, so the token has to be here too. +telegram_http_download <- function(token, api_url) { + force(token) + force(api_url) + function(file_path, dest) { + url <- sprintf("%s/file/bot%s/%s", api_url, token, file_path) + resp <- httr::GET(url, httr::write_disk(dest, overwrite = TRUE)) + if (!identical(httr::status_code(resp), 200L)) { + stop("chat.api: Telegram file fetch answered HTTP ", + httr::status_code(resp), ".", call. = FALSE) + } + invisible(dest) + } +} + +# One place for the answer shape. A refused call is {ok: false, +# description} and raises with the description; a good one is +# unwrapped to its result. A seam that answers with something that is +# not a Bot API response at all is an error too, rather than a NULL +# that every caller would then have to index into. +telegram_call <- function(client, method, params = list(), files = NULL) { + res <- client$api_fn(method, telegram_form(params), files) + if (!is.list(res) || is.null(res$ok)) { + stop("chat.api: Telegram ", method, " returned no usable answer.", + call. = FALSE) + } + if (!isTRUE(res$ok)) { + stop("chat.api: Telegram refused ", method, ": ", + res$description %||% "no description given", call. = FALSE) + } + res$result +} + +#' Render contract markup for Telegram +#' +#' HTML parse mode is the target. MarkdownV2 requires a dozen ordinary +#' characters to be escaped in prose, and legacy Markdown swallows the +#' underscores in identifiers; HTML needs only the three escapes and +#' accepts the tags the contract's markdown maps to. plain sends the +#' text untouched with no parse_mode, the one mode where nothing needs +#' escaping. A supplied \code{rich} fragment is already HTML and wins. +#' @noRd +telegram_render <- function(text, markup, rich = NULL) { + if (!is.null(rich)) { + return(list(text = rich, parse_mode = "HTML")) + } + if (!identical(markup, "markdown")) { + return(list(text = text, parse_mode = NULL)) + } + list(text = telegram_markdown_html(text), parse_mode = "HTML") +} + +telegram_escape_html <- function(x) { + x <- gsub("&", "&", x, fixed = TRUE) + x <- gsub("<", "<", x, fixed = TRUE) + gsub(">", ">", x, fixed = TRUE) +} + +# The same handful of constructs slack_render() translates, plus code. +# Fenced blocks are split out first so nothing inside one is styled, +# and a language tag on the opening fence is dropped rather than +# printed as the block's first line. +telegram_markdown_html <- function(text) { + parts <- strsplit(text, "```", fixed = TRUE)[[1L]] + out <- character(length(parts)) + for (i in seq_along(parts)) { + p <- parts[[i]] + if (i %% 2L == 0L) { + p <- sub("^[[:alnum:]_+-]*\n", "", p) + p <- sub("\n$", "", p) + out[[i]] <- paste0("
", telegram_escape_html(p), "
") + next + } + p <- telegram_escape_html(p) + p <- gsub("`([^`]+)`", "\\1", p) + p <- gsub("\\[([^]]+)\\]\\(([^)]+)\\)", "\\1", p) + p <- gsub("\\*\\*([^*]+)\\*\\*", "\\1", p) + p <- gsub("\\*([^*]+)\\*", "\\1", p) + # Underscores inside a word are identifiers, not emphasis. + p <- gsub("(^|[^[:alnum:]_])_([^_]+)_(?![[:alnum:]_])", + "\\1\\2", p, perl = TRUE) + out[[i]] <- p + } + paste(out, collapse = "") +} + +#' @export +chat_poll.chat_telegram <- function(client, since = NULL, timeout = NULL, ...) { + if (!is.null(since)) { + client$env$cursor <- telegram_chr(since) + } + updates <- telegram_call(client, "getUpdates", list( + offset = client$env$cursor, + timeout = as.integer(timeout %||% client$timeout), + allowed_updates = telegram_json_array(telegram_update_kinds))) + # For `self`. Telegram does not echo a bot's own sends through + # getUpdates, so the comparison is belt and braces; what matters + # is that an unknown identity reports NULL rather than FALSE. + self_id <- telegram_self_id(client) + messages <- list() + reactions <- list() + last <- NULL + for (u in updates) { + uid <- u$update_id + if (is.numeric(uid) && (is.null(last) || uid > last)) { + last <- uid + } + rec <- telegram_message(u$message %||% u$channel_post, self_id) + if (!is.null(rec)) { + messages[[length(messages) + 1L]] <- rec + } + for (r in telegram_reaction_records(u$message_reaction, self_id)) { + reactions[[length(reactions) + 1L]] <- r + } + } + # The cursor is the next offset: handing it back confirms + # everything up to and including the last update seen, which is + # the only way Telegram has of being told. + if (!is.null(last)) { + client$env$cursor <- sprintf("%.0f", last + 1) + } + list(messages = messages, cursor = client$env$cursor, + reactions = reactions, raw = updates) +} + +telegram_self_id <- function(client) { + who <- tryCatch(chat_whoami(client), error = function(e) NULL) + if (is.null(who)) { + NULL + } else { + who$id + } +} + +# A message, or NULL for a service message (someone joined, a pin, a +# title change). Those carry neither text nor media and are not +# conversation; a consumer replying to one would be talking to a +# system notice. +telegram_message <- function(m, self_id) { + if (is.null(m)) { + return(NULL) + } + body <- m$text %||% m$caption + att <- telegram_attachment(m) + if (is.null(body) && is.null(att)) { + return(NULL) + } + if (is.null(body)) { + # The filename, as Matrix does: what a client that cannot + # show the picture shows. A photo has none, and stays "". + body <- if (is.na(att$name)) "" else att$name + } + # sender_chat first: a channel post has no `from`, and an + # anonymous group admin's `from` is Telegram's placeholder bot + # while sender_chat is the group they speak for. + sender <- telegram_chr(m$sender_chat$id %||% m$from$id) %||% "" + chat_message(id = telegram_chr(m$message_id), + channel = telegram_chr(m$chat$id), + sender = sender, + body = as.character(body), + ts = telegram_time(m$date), + thread = telegram_chr(m$message_thread_id), + markup = "plain", kind = "message", + self = if (is.null(self_id)) NULL else + identical(sender, self_id), + mentions = telegram_mentions(m), + attachments = if (is.null(att)) NULL else list(att), + raw = m) +} + +# Declared mentions: text_mention entities, which carry a user object +# for people without a username. An @username mention is text, and +# chat_addressed() reads it there. +telegram_mentions <- function(m) { + ents <- c(m$entities, m$caption_entities) + ids <- character() + for (e in ents) { + if (identical(e$type, "text_mention") && !is.null(e$user$id)) { + ids <- c(ids, telegram_chr(e$user$id)) + } + } + if (length(ids)) ids else NULL +} + +telegram_media_kinds <- c("document", "audio", "video", "voice", + "animation", "sticker", "video_note") + +# The one attachment a Telegram message can carry, as a record. url is +# left NA on purpose: the fetchable location comes from getFile, is +# temporary, and embeds the bot token, so it is not something to put on +# a record that consumers pass around. +telegram_attachment <- function(m) { + if (length(m$photo)) { + # Every size of the same picture, smallest first. + p <- m$photo[[length(m$photo)]] + return(chat_attachment(id = as.character(p$file_id), + bytes = telegram_int(p$file_size), raw = p)) + } + for (kind in telegram_media_kinds) { + x <- m[[kind]] + if (!is.null(x) && !is.null(x$file_id)) { + return(chat_attachment(id = as.character(x$file_id), + name = x$file_name %||% NA_character_, + mime = x$mime_type %||% NA_character_, + bytes = telegram_int(x$file_size), + raw = x)) + } + } + NULL +} + +telegram_reaction_key <- function(x) { + switch(x$type %||% "", emoji = x$emoji, custom_emoji = x$custom_emoji_id, + paid = "paid", NULL) +} + +# One record per reaction added. Telegram reports the whole before and +# after set of one user's reactions on one message, so an addition is +# what is in the new set and not the old; a removal has no shape in +# the contract and is not reported. +telegram_reaction_records <- function(r, self_id) { + if (is.null(r)) { + return(list()) + } + old <- unlist(lapply(r$old_reaction, telegram_reaction_key)) + new <- unlist(lapply(r$new_reaction, telegram_reaction_key)) + added <- setdiff(new, old) + sender <- telegram_chr(r$user$id %||% r$actor_chat$id) %||% "" + lapply(added, function(k) { + chat_reaction(id = NULL, channel = telegram_chr(r$chat$id), + sender = sender, target = telegram_chr(r$message_id), + key = as.character(k), ts = telegram_time(r$date), + self = if (is.null(self_id)) NULL else + identical(sender, self_id), + raw = r) + }) +} + +#' @export +chat_send.chat_telegram <- function(client, channel, text, + markup = c("plain", "markdown"), + thread = NULL, reply_to = NULL, + identity = NULL, files = NULL, + kind = "message", notify = TRUE, + rich = NULL, ...) { + markup <- match.arg(markup) + # identity is ignored: a bot posts as itself and Telegram has no + # per-message override, which identity_override = FALSE says. kind + # too: there is no notice or emote, only messages. + where <- list(chat_id = telegram_chr(channel), + message_thread_id = telegram_chr(thread), + reply_parameters = if (is.null(reply_to)) NULL else + sprintf('{"message_id":%s}', telegram_chr(reply_to)), + disable_notification = if (isTRUE(notify)) NULL else TRUE) + ids <- character() + # Each file is its own message, then the text, the order Matrix + # sends in. A missing file errors before anything goes out. + for (f in files) { + if (!file.exists(f)) { + stop("chat_send(): no such file: ", f, call. = FALSE) + } + } + for (f in files) { + sent <- telegram_call(client, "sendDocument", where, + files = list(document = f)) + ids <- c(ids, telegram_chr(sent$message_id)) + } + # Telegram refuses an empty text, so a send that was only files + # stops here. Empty with no files still goes out and is refused, + # which is the right report for that. + if (nzchar(text) || !length(files)) { + r <- telegram_render(text, markup, rich) + sent <- telegram_call(client, "sendMessage", + c(where, list(text = r$text, parse_mode = r$parse_mode))) + ids <- c(ids, telegram_chr(sent$message_id)) + } + invisible(ids) +} + +#' @export +chat_edit.chat_telegram <- function(client, channel, message_id, text, + markup = c("plain", "markdown"), + rich = NULL, kind = "message", ...) { + markup <- match.arg(markup) + r <- telegram_render(text, markup, rich) + telegram_call(client, "editMessageText", + list(chat_id = telegram_chr(channel), + message_id = telegram_chr(message_id), text = r$text, + parse_mode = r$parse_mode)) + # Edited in place, as Slack: the identifier is the one that went in. + invisible(as.character(message_id)) +} + +telegram_reaction_json <- function(key) { + if (!nzchar(key)) { + return("[]") + } + sprintf('[{"type":"emoji","emoji":"%s"}]', telegram_json_string(key)) +} + +#' @export +chat_react.chat_telegram <- function(client, channel, message_id, key, ...) { + # An emoji character, passed through as the contract says. Telegram + # accepts a fixed set and refuses the rest, and that refusal + # propagates. An empty key clears the bot's reactions on the + # message, which is the only way the API has of taking one back. + telegram_call(client, "setMessageReaction", + list(chat_id = telegram_chr(channel), + message_id = telegram_chr(message_id), + reaction = telegram_reaction_json(key))) + # No id: setMessageReaction answers True. + invisible(TRUE) +} + +#' @export +chat_typing.chat_telegram <- function(client, channel, on = TRUE, ...) { + # There is no "stopped typing": the indicator expires on its own + # after a few seconds or when a message arrives, so on = FALSE has + # nothing to send and says so. + if (!isTRUE(on)) { + return(invisible(FALSE)) + } + ok <- tryCatch({ + telegram_call(client, "sendChatAction", + list(chat_id = telegram_chr(channel), action = "typing")) + TRUE + }, error = function(e) FALSE) + invisible(ok) +} + +#' @export +chat_channel_info.chat_telegram <- function(client, channel, ...) { + ch <- telegram_call(client, "getChat", + list(chat_id = telegram_chr(channel))) + blank <- function(x) { + if (is.null(x) || !length(x) || !nzchar(as.character(x)[[1L]])) { + NULL + } else { + as.character(x)[[1L]] + } + } + name <- blank(ch$title) + if (is.null(name)) { + # A private chat has no title. The other party's name is what + # a human would call the conversation. + person <- trimws(paste(c(ch$first_name, ch$last_name), collapse = " ")) + name <- blank(person) %||% blank(ch$username) + } + list(id = telegram_chr(ch$id) %||% telegram_chr(channel), + name = name, topic = blank(ch$description)) +} + +#' @export +chat_leave.chat_telegram <- function(client, channel, ...) { + # Errors propagate: a leave that quietly failed keeps delivering a + # chat the caller believes it has left. + telegram_call(client, "leaveChat", list(chat_id = telegram_chr(channel))) + invisible(as.character(channel)) +} + +#' @export +chat_resolve.chat_telegram <- function(client, name, ...) { + name <- as.character(name) + # Already an id. Everything else is a public username, which getChat + # takes with its @ and answers with the numeric id. + if (grepl("^-?[0-9]+$", name)) { + return(name) + } + handle <- if (startsWith(name, "@")) name else paste0("@", name) + ch <- telegram_call(client, "getChat", list(chat_id = handle)) + id <- telegram_chr(ch$id) + if (is.null(id)) { + stop("chat.api: Telegram getChat returned no id for ", handle, ".", + call. = FALSE) + } + id +} + +#' @export +chat_capabilities.chat_telegram <- function(client, ...) { + list(threads = TRUE, thread_replies = TRUE, edits = TRUE, + # Reaction events arrive only where the bot is an + # administrator, or in a private chat. The flag says the + # poll can carry them, which it can; the group setting is + # the consumer's to arrange. + reactions = TRUE, reaction_events = TRUE, channel_info = TRUE, + # The Bot API has no member list, only a count and the + # administrators, and a list of admins is not a room. + members = FALSE, + # A bot is added to a chat by a member. Nothing arrives to + # accept, and there is no call by which it could join. + invites = FALSE, join = FALSE, whoami = TRUE, + # No history, no list of chats, no read markers in the Bot + # API. The chats a bot is in are whatever sends it updates. + channels = FALSE, history = FALSE, pending = FALSE, + mark_read = FALSE, set_identity = TRUE, relogin = FALSE, + channel_create = FALSE, leave = TRUE, set_state = FALSE, + files = TRUE, attachments = TRUE, typing = TRUE, e2ee = FALSE, + identity_override = FALSE, rich_markup = "html", + markup_dialects = c("plain", "markdown"), + # 4096 characters after entities parsing. Characters, not + # bytes, so a message of multibyte text hits it sooner than + # the number suggests. + max_message_bytes = 4096L) +} + +#' @export +chat_whoami.chat_telegram <- function(client, ...) { + # Cached for the client's lifetime, as Slack: the answer is a + # property of the token, and chat_addressed() asks once per message. + if (!is.null(client$env$whoami)) { + return(client$env$whoami) + } + me <- telegram_call(client, "getMe") + id <- telegram_chr(me$id) + if (is.null(id) || !nzchar(id)) { + stop("chat.api: Telegram getMe returned no id.", call. = FALSE) + } + # The username is the display: it is what a mention is written as. + who <- chat_identity(id, display = me$username %||% me$first_name %||% + NA_character_, raw = me) + client$env$whoami <- who + who +} + +#' @export +chat_addressed.chat_telegram <- function(client, message, ...) { + who <- chat_whoami(client) + if (identity_mentioned(who$id, message)) { + return(TRUE) + } + # A private chat is a conversation with the bot. Everything in it + # is for the bot; there is no one else it could be for. + if (identical(message$raw$chat$type, "private")) { + return(TRUE) + } + # A reply to something the bot said. + if (identical(telegram_chr(message$raw$reply_to_message$from$id), who$id)) { + return(TRUE) + } + # @username stays in the text on Telegram, unlike Slack, so this is + # a literal match on the handle -- bounded, so @bot is not @bots. + user <- who$raw$username + if (is.null(user) || !nzchar(user)) { + return(FALSE) + } + body <- message$body %||% "" + nzchar(body) && grepl(sprintf("(^|[^[:alnum:]_])@%s(?![[:alnum:]_])", + escape_rx(user)), + body, ignore.case = TRUE, perl = TRUE) +} + +#' @export +chat_set_identity.chat_telegram <- function(client, display, ...) { + # setMyName changes the bot's name, not its username: the handle + # people address it by is fixed at BotFather. The cached identity + # carried the old display and is now wrong. + telegram_call(client, "setMyName", list(name = display)) + client$env$whoami <- NULL + invisible(TRUE) +} + +#' @export +chat_download.chat_telegram <- function(client, attachment, dest = NULL, ...) { + got <- telegram_call(client, "getFile", list(file_id = attachment$id)) + path <- got$file_path + if (is.null(path) || !nzchar(path)) { + stop("chat.api: Telegram getFile returned no file_path for ", + attachment$id, ". Files over 20 MB cannot be fetched ", + "through the Bot API.", call. = FALSE) + } + if (is.null(dest)) { + # A photo carries no filename, but the path getFile hands back + # has an extension, and the temporary file should too. + named <- attachment + if (is.na(named$name)) { + named$name <- basename(path) + } + dest <- attachment_dest(named, NULL) + } + # Errors propagate, chat_react()'s reasoning: a fetch that quietly + # failed leaves the caller pointing at a path with no bytes. + client$download_fn(path, dest) + invisible(dest) +} diff --git a/README.md b/README.md index df64b13..de089fd 100644 --- a/README.md +++ b/README.md @@ -12,6 +12,7 @@ adapters that wake up when their platform client is installed: | Matrix | `chat_matrix()` | mx.client (Suggests) | working | | IRC | `chat_irc()` | base R sockets | working | | Slack | `chat_slack()` | slackr (Suggests) | signature-verified, review-hardened; live roundtrip pending a workspace token | +| Telegram | `chat_telegram()` | httr (Suggests) | every verb seam-tested against Bot API shapes; live roundtrip pending a bot token | ```r cl <- chat.api::chat_matrix(app = "mybot") diff --git a/inst/tinytest/test_contract.R b/inst/tinytest/test_contract.R index dcd51ae..5478ed1 100644 --- a/inst/tinytest/test_contract.R +++ b/inst/tinytest/test_contract.R @@ -66,7 +66,7 @@ if (requireNamespace("mx.client", quietly = TRUE)) { # ignoring it, this is where that shows up. local({ for (adapter in c("chat_loopback", "chat_irc", "chat_slack", - "chat_matrix")) { + "chat_matrix", "chat_telegram")) { m <- getS3method("chat_capabilities", adapter) caps <- m(structure(list(env = new.env()), class = adapter)) for (flag in c("reactions", "reaction_events")) { @@ -99,7 +99,7 @@ local({ # omits gives a consumer NULL, and NULL is not FALSE. local({ for (adapter in c("chat_loopback", "chat_irc", "chat_slack", - "chat_matrix")) { + "chat_matrix", "chat_telegram")) { m <- getS3method("chat_capabilities", adapter) caps <- m(structure(list(env = new.env()), class = adapter)) for (flag in c("channel_info", "members")) { @@ -135,7 +135,7 @@ local({ # ---- Every adapter answers the invite pair ---- local({ for (adapter in c("chat_loopback", "chat_irc", "chat_slack", - "chat_matrix")) { + "chat_matrix", "chat_telegram")) { m <- getS3method("chat_capabilities", adapter) caps <- m(structure(list(env = new.env()), class = adapter)) for (flag in c("invites", "join")) { @@ -445,7 +445,7 @@ local({ # another omits gives a consumer NULL, and NULL is not FALSE. local({ for (adapter in c("chat_loopback", "chat_irc", "chat_slack", - "chat_matrix")) { + "chat_matrix", "chat_telegram")) { m <- getS3method("chat_capabilities", adapter) caps <- m(structure(list(env = new.env()), class = adapter)) for (flag in c("channel_create", "leave", "files", "attachments")) { diff --git a/inst/tinytest/test_telegram.R b/inst/tinytest/test_telegram.R new file mode 100644 index 0000000..2367e1e --- /dev/null +++ b/inst/tinytest/test_telegram.R @@ -0,0 +1,676 @@ +# Telegram adapter verification. No bot token in CI, so this pins the +# adapter to httr's installed signatures (API-drift detection) and +# exercises every verb through the .api seam, asserting on the wire +# shape each Bot API method receives. Live traffic needs +# TELEGRAM_BOT_TOKEN. + +`%||%` <- function(a, b) if (is.null(a)) b else a + +if (requireNamespace("httr", quietly = TRUE)) { + # Every httr entry point the HTTP layer uses, by the arguments it + # passes. The seam can be wrong in the same direction as the code; + # only the installed package settles it. + expect_true(all(c("url", "body", "encode") %in% names(formals(httr::POST)))) + expect_true(all(c("url", "config") %in% names(formals(httr::GET)))) + expect_true(all(c("x", "as", "type") %in% names(formals(httr::content)))) + expect_true("path" %in% names(formals(httr::upload_file))) + expect_true(all(c("path", "overwrite") %in% names(formals(httr::write_disk)))) + expect_true("seconds" %in% names(formals(httr::timeout))) + expect_true("x" %in% names(formals(httr::status_code))) + + # Constructor: refuses to build without a token + expect_error(chat_telegram(token = ""), pattern = "token") + cl <- chat_telegram(token = "123:fake") + expect_true(inherits(cl, "chat_client")) + expect_true(inherits(cl, "chat_telegram")) + expect_identical(cl$timeout, 30L) + expect_identical(cl$api_url, "https://api.telegram.org") + # A trailing slash on a local Bot API server does not double up. + expect_identical(chat_telegram(token = "t", + api_url = "http://localhost:8081/")$api_url, + "http://localhost:8081") +} + +# ---- Seams ---- +# A client that needs neither httr nor the network. The download seam +# defaults to a no-op that reports the destination it was handed. +tg_client <- function(api, download = function(file_path, dest) dest, ...) { + chat_telegram(token = "123:fake", .api = api, .download = download, ...) +} + +# A seam that records every call and answers from a table keyed by +# method: a static response, or a function of (params, files). +tg_scripted <- function(answers) { + calls <- list() + api <- function(method, params = list(), files = NULL) { + calls[[length(calls) + 1L]] <<- list(method = method, params = params, + files = files) + a <- answers[[method]] + if (is.function(a)) { + a(params, files) + } else { + a %||% list(ok = TRUE, result = TRUE) + } + } + list(api = api, calls = function() calls, + of = function(method) Filter(function(x) x$method == method, calls)) +} + +me_ok <- list(ok = TRUE, result = list(id = 999, is_bot = TRUE, + first_name = "Corteza", + username = "corteza_bot")) + +# ---- Capabilities are honest ---- +local({ + caps <- chat_capabilities(tg_client(function(...) NULL)) + expect_true(caps$threads) + expect_true(caps$thread_replies) + expect_true(caps$edits) + expect_true(caps$reactions) + expect_true(caps$reaction_events) + expect_true(caps$channel_info) + expect_true(caps$whoami) + expect_true(caps$set_identity) + expect_true(caps$leave) + expect_true(caps$files) + expect_true(caps$attachments) + expect_true(caps$typing) + expect_false(caps$members) + expect_false(caps$invites) + expect_false(caps$join) + expect_false(caps$channels) + expect_false(caps$history) + expect_false(caps$pending) + expect_false(caps$mark_read) + expect_false(caps$channel_create) + expect_false(caps$set_state) + expect_false(caps$e2ee) + expect_false(caps$identity_override) + expect_identical(caps$rich_markup, "html") + expect_identical(caps$markup_dialects, c("plain", "markdown")) + expect_identical(caps$max_message_bytes, 4096L) +}) + +# The verbs the flags say are missing refuse rather than pretend, and +# the quiet ones stay quiet. +local({ + cl <- tg_client(function(...) stop("no call expected")) + expect_error(chat_members(cl, "5"), "not supported by this adapter") + expect_error(chat_channels(cl), "not supported by this adapter") + expect_error(chat_history(cl, "5"), "not supported by this adapter") + expect_error(chat_join(cl, "5"), "not supported by this adapter") + expect_error(chat_channel_create(cl, "x"), "not supported by this adapter") + expect_error(chat_pending(cl), "not supported by this adapter") + expect_error(chat_set_state(cl, "5", "t", list()), + "not supported by this adapter") + expect_false(chat_mark_read(cl, "5", "7")) + expect_true(chat_disconnect(cl)) +}) + +# ---- Pure helpers ---- +# Ids never go through as.character() on a double: R writes 100000 as +# "1e+05", and a chat id at a round number would never match itself. +expect_identical(chat.api:::telegram_chr(100000), "100000") +expect_identical(chat.api:::telegram_chr(-1001234567890), "-1001234567890") +expect_identical(chat.api:::telegram_chr(42L), "42") +expect_identical(chat.api:::telegram_chr("abc"), "abc") +expect_null(chat.api:::telegram_chr(NULL)) + +# Wire form: NULLs dropped, logicals lowercase, numbers as digits. +expect_identical(chat.api:::telegram_form(list(a = NULL, b = TRUE, c = FALSE, + d = 100000, e = "x")), + list(b = "true", c = "false", d = "100000", e = "x")) +expect_identical(chat.api:::telegram_form(list()), list()) +expect_identical(chat.api:::telegram_json_array(c("a", 'b"c')), + '["a","b\\"c"]') +expect_identical(chat.api:::telegram_reaction_json("\U0001F44D"), + '[{"type":"emoji","emoji":"\U0001F44D"}]') +expect_identical(chat.api:::telegram_reaction_json(""), "[]") + +# Rendering: plain is untouched with no parse_mode, the one mode where +# nothing needs escaping. +expect_identical(chat.api:::telegram_render("a < b & *c*", "plain"), + list(text = "a < b & *c*", parse_mode = NULL)) +# markdown becomes Telegram's HTML subset, escaped first. +local({ + r <- chat.api:::telegram_render( + "**bold** and *it* and `x < y` and [d](https://x.y) and chat_send_now and _em_", + "markdown") + expect_identical(r$parse_mode, "HTML") + expect_identical(r$text, paste0( + "bold and it and x < y and ", + "d and chat_send_now and em")) +}) +# Fenced code is escaped and left unstyled; the language tag goes. +expect_identical(chat.api:::telegram_markdown_html( + "see\n```r\nx <- 1 * 2\n```\ndone **ok**"), + "see\n
x <- 1 * 2
\ndone ok") +# A supplied rich fragment is already HTML and wins. +expect_identical(chat.api:::telegram_render("plain", "plain", + rich = "hi"), + list(text = "hi", parse_mode = "HTML")) + +# ---- Polling ---- +tg_msg <- function(message_id, text = NULL, chat_id = -100123, + type = "supergroup", from = 42, date = 1700000000, ...) { + m <- list(message_id = message_id, chat = list(id = chat_id, type = type), + from = list(id = from), date = date) + if (!is.null(text)) { + m$text <- text + } + c(m, list(...)) +} + +# First poll: no offset, the configured wait, the update kinds asked +# for explicitly. Service messages are skipped, channel posts carry +# the channel as sender, and the cursor is the next offset. +local({ + s <- tg_scripted(list( + getMe = me_ok, + getUpdates = function(params, files) { + if (is.null(params$offset)) { + list(ok = TRUE, result = list( + list(update_id = 100000, + message = tg_msg(7, "hello")), + list(update_id = 100001, + message = tg_msg(8, date = 1700000001, + new_chat_members = list(list(id = 999)))), + list(update_id = 100002, + channel_post = list(message_id = 9, + chat = list(id = -100999, type = "channel"), + sender_chat = list(id = -100999), + date = 1700000002, + text = "announcement", + message_thread_id = 5)))) + } else { + list(ok = TRUE, result = list()) + } + })) + cl <- tg_client(s$api, timeout = 7L) + p1 <- chat_poll(cl) + gu <- s$calls()[[1L]] + expect_identical(gu$method, "getUpdates") + expect_null(gu$params$offset) + expect_identical(gu$params$timeout, "7") + expect_identical(gu$params$allowed_updates, + '["message","channel_post","message_reaction"]') + expect_null(gu$files) + + expect_identical(length(p1$messages), 2L) + m <- p1$messages[[1L]] + expect_inherits(m, "chat_message") + expect_identical(m$id, "7") + expect_identical(m$channel, "-100123") + expect_identical(m$sender, "42") + expect_identical(m$body, "hello") + expect_identical(as.numeric(m$ts), 1700000000) + expect_null(m$thread) + expect_false(m$self) + expect_identical(m$markup, "plain") + expect_identical(m$kind, "message") + expect_null(m$attachments) + expect_identical(m$raw$message_id, 7) + m2 <- p1$messages[[2L]] + expect_identical(m2$id, "9") + expect_identical(m2$channel, "-100999") + expect_identical(m2$sender, "-100999") + expect_identical(m2$thread, "5") + expect_identical(p1$cursor, "100003") + expect_identical(p1$reactions, list()) + expect_identical(length(p1$raw), 3L) + + # The second poll confirms: the offset is the cursor. An empty + # answer leaves it where it was. + p2 <- chat_poll(cl, timeout = 0) + gu2 <- s$of("getUpdates")[[2L]] + expect_identical(gu2$params$offset, "100003") + expect_identical(gu2$params$timeout, "0") + expect_identical(p2$messages, list()) + expect_identical(p2$cursor, "100003") + # getMe once per client, not once per poll. + expect_identical(length(s$of("getMe")), 1L) +}) + +# since overrides the live cursor, and a numeric one is not written in +# scientific notation. +local({ + s <- tg_scripted(list(getMe = me_ok, + getUpdates = list(ok = TRUE, result = list()))) + cl <- tg_client(s$api) + chat_poll(cl, since = "555") + chat_poll(cl, since = 100000) + expect_identical(s$of("getUpdates")[[1L]]$params$offset, "555") + expect_identical(s$of("getUpdates")[[2L]]$params$offset, "100000") +}) + +# self: a message from the bot's own id is flagged, and an identity +# the adapter could not fetch reports NULL, which is "cannot tell" +# rather than "not me". +local({ + upd <- list(ok = TRUE, result = list( + list(update_id = 1, message = tg_msg(1, "x", from = 999)), + list(update_id = 2, message = tg_msg(2, "y", from = 42)))) + s <- tg_scripted(list(getMe = me_ok, getUpdates = upd)) + got <- chat_poll(tg_client(s$api))$messages + expect_true(got[[1L]]$self) + expect_false(got[[2L]]$self) + + s2 <- tg_scripted(list(getMe = list(ok = FALSE, description = "Unauthorized"), + getUpdates = upd)) + got2 <- chat_poll(tg_client(s2$api))$messages + expect_null(got2[[1L]]$self) + expect_null(got2[[2L]]$self) +}) + +# A transport failure or a refusal propagates rather than reading as a +# quiet poll. Telegram says no in the body with {ok: false}. +expect_error(chat_poll(tg_client(function(...) stop("connection reset"))), + "connection reset") +expect_error(chat_poll(tg_client(function(...) { + list(ok = FALSE, description = "Unauthorized") +})), "Telegram refused getUpdates: Unauthorized") +expect_error(chat_poll(tg_client(function(...) list(ok = FALSE))), + "no description given") +expect_error(chat_poll(tg_client(function(...) NULL)), "no usable answer") + +# Declared mentions are text_mention entities (a user object, for +# people without a handle). An @username stays in the text. +local({ + s <- tg_scripted(list(getMe = me_ok, getUpdates = list(ok = TRUE, result = list( + list(update_id = 1, message = tg_msg( + 1, "hi Bob and @corteza_bot", + entities = list( + list(type = "text_mention", offset = 3, length = 3, + user = list(id = 100000)), + list(type = "mention", offset = 11, length = 12)))))))) + cl <- tg_client(s$api) + m <- chat_poll(cl)$messages[[1L]] + expect_identical(m$mentions, "100000") + expect_true(chat_addressed(cl, m)) +}) + +# ---- Inbound media ---- +# A photo is every size of one picture, largest last; a document +# carries its own name and type. url stays NA: the fetchable location +# comes from getFile and embeds the token. +local({ + s <- tg_scripted(list(getMe = me_ok, getUpdates = list(ok = TRUE, result = list( + list(update_id = 1, message = tg_msg( + 1, chat_id = 5, type = "private", caption = "see plot", + photo = list(list(file_id = "small", file_size = 100), + list(file_id = "big", file_size = 5000)))), + list(update_id = 2, message = tg_msg( + 2, chat_id = 5, type = "private", + document = list(file_id = "doc1", file_name = "report.pdf", + mime_type = "application/pdf", file_size = 2048))), + list(update_id = 3, message = tg_msg( + 3, chat_id = 5, type = "private", + sticker = list(file_id = "stk"))))))) + got <- chat_poll(tg_client(s$api))$messages + expect_identical(length(got), 3L) + a1 <- got[[1L]]$attachments[[1L]] + expect_inherits(a1, "chat_attachment") + expect_identical(a1$id, "big") + expect_identical(a1$bytes, 5000L) + expect_true(is.na(a1$name)) + expect_true(is.na(a1$mime)) + expect_true(is.na(a1$url)) + expect_identical(got[[1L]]$body, "see plot") + a2 <- got[[2L]]$attachments[[1L]] + expect_identical(a2$id, "doc1") + expect_identical(a2$name, "report.pdf") + expect_identical(a2$mime, "application/pdf") + expect_identical(a2$bytes, 2048L) + # The filename stands in for a body, as on Matrix; a sticker has + # neither and stays "". + expect_identical(got[[2L]]$body, "report.pdf") + expect_identical(got[[3L]]$body, "") + expect_identical(got[[3L]]$attachments[[1L]]$id, "stk") +}) + +# Fetching: getFile names the path, the download seam gets the path +# and never the token, and a record with no name takes its extension +# from that path. +local({ + fetched <- NULL + s <- tg_scripted(list(getFile = function(params, files) { + list(ok = TRUE, result = list(file_id = params$file_id, + file_path = "photos/file_1.jpg")) + })) + cl <- tg_client(s$api, download = function(file_path, dest) { + fetched <<- list(file_path = file_path, dest = dest) + writeBin(as.raw(1:4), dest) + dest + }) + att <- chat_attachment("big") + dest <- chat_download(cl, att) + expect_identical(s$calls()[[1L]]$params$file_id, "big") + expect_identical(fetched$file_path, "photos/file_1.jpg") + expect_identical(fetched$dest, dest) + expect_true(grepl("[.]jpg$", dest)) + expect_true(file.exists(dest)) + expect_false(grepl("fake", fetched$file_path, fixed = TRUE)) + # An explicit destination is honoured, and a record's own name + # decides the extension when it has one. + d2 <- tempfile(fileext = ".bin") + expect_identical(chat_download(cl, att, d2), d2) + expect_true(grepl("[.]pdf$", chat_download(cl, chat_attachment( + "doc1", name = "report.pdf")))) +}) +# No file_path is what Telegram answers for a file the Bot API will not +# serve, and a refusal propagates either way. +expect_error(chat_download(tg_client(function(...) { + list(ok = TRUE, result = list(file_id = "x")) +}), chat_attachment("x")), "no file_path") +expect_error(chat_download(tg_client(function(...) { + list(ok = FALSE, description = "Bad Request: file is too big") +}), chat_attachment("x")), "file is too big") + +# ---- Sending ---- +local({ + s <- tg_scripted(list(sendMessage = function(params, files) { + list(ok = TRUE, result = list(message_id = 77, chat = list(id = -100123))) + })) + cl <- tg_client(s$api) + # Plain goes out untouched with no parse_mode and nothing else. + expect_identical(chat_send(cl, "-100123", "keep *this* literal"), "77") + c1 <- s$calls()[[1L]] + expect_identical(c1$method, "sendMessage") + expect_identical(c1$params, list(chat_id = "-100123", + text = "keep *this* literal")) + expect_null(c1$files) + # markdown is rendered to HTML and says so. + chat_send(cl, "-100123", "**bold** [x](https://y)", markup = "markdown") + p2 <- s$calls()[[2L]]$params + expect_identical(p2$parse_mode, "HTML") + expect_identical(p2$text, "bold x") + # rich wins over text and goes out as HTML. + chat_send(cl, "-100123", "fallback", rich = "real") + expect_identical(s$calls()[[3L]]$params$text, "real") + expect_identical(s$calls()[[3L]]$params$parse_mode, "HTML") + # Thread, reply and silence ride their own parameters. + chat_send(cl, -100123, "in thread", thread = 5, reply_to = "7", + notify = FALSE) + p4 <- s$calls()[[4L]]$params + expect_identical(p4$chat_id, "-100123") + expect_identical(p4$message_thread_id, "5") + expect_identical(p4$reply_parameters, '{"message_id":7}') + expect_identical(p4$disable_notification, "true") + # identity is ignored, not refused: identity_override is FALSE. + chat_send(cl, "-100123", "as gc", identity = list(name = "gc")) + expect_identical(names(s$calls()[[5L]]$params), c("chat_id", "text")) +}) + +# Files: one sendDocument per file, then the text, ids in that order, +# every one to the same place. A missing file errors before anything +# goes out, and a files-only send never posts an empty text. +local({ + f <- tempfile(fileext = ".png") + writeBin(as.raw(1:8), f) + n <- 0L + s <- tg_scripted(list( + sendDocument = function(params, files) { + n <<- n + 1L + list(ok = TRUE, result = list(message_id = 10 + n)) + }, + sendMessage = function(params, files) { + list(ok = TRUE, result = list(message_id = 20)) + })) + cl <- tg_client(s$api) + expect_identical(chat_send(cl, "5", "see plot", files = c(f, f), thread = 3), + c("11", "12", "20")) + calls <- s$calls() + expect_identical(vapply(calls, `[[`, "", "method"), + c("sendDocument", "sendDocument", "sendMessage")) + expect_identical(calls[[1L]]$files, list(document = f)) + expect_identical(calls[[1L]]$params, + list(chat_id = "5", message_thread_id = "3")) + expect_null(calls[[3L]]$files) + expect_identical(calls[[3L]]$params$message_thread_id, "3") + + expect_identical(chat_send(cl, "5", "", files = f), "13") + expect_identical(length(s$calls()), 4L) + + before <- length(s$calls()) + expect_error(chat_send(cl, "5", "x", + files = c(f, file.path(tempdir(), "nope.png"))), + "no such file") + expect_identical(length(s$calls()), before) +}) + +# A refusal is an error, not a message id. +expect_error(chat_send(tg_client(function(...) { + list(ok = FALSE, description = "Bad Request: chat not found") +}), "1", "x"), "Telegram refused sendMessage: Bad Request: chat not found") + +# ---- Edits ---- +local({ + s <- tg_scripted(list(editMessageText = list( + ok = TRUE, result = list(message_id = 7)))) + cl <- tg_client(s$api) + expect_identical(chat_edit(cl, "5", "7", "done"), "7") + expect_identical(s$calls()[[1L]]$method, "editMessageText") + expect_identical(s$calls()[[1L]]$params, + list(chat_id = "5", message_id = "7", text = "done")) + chat_edit(cl, "5", "7", "**done**", markup = "markdown") + expect_identical(s$calls()[[2L]]$params$text, "done") + expect_identical(s$calls()[[2L]]$params$parse_mode, "HTML") +}) +expect_error(chat_edit(tg_client(function(...) { + list(ok = FALSE, description = "Bad Request: message can't be edited") +}), "5", "7", "x"), "can't be edited") + +# ---- Reactions ---- +local({ + s <- tg_scripted(list(setMessageReaction = list(ok = TRUE, result = TRUE))) + cl <- tg_client(s$api) + expect_true(chat_react(cl, "5", "7", "\U0001F44D")) + expect_identical(s$calls()[[1L]]$method, "setMessageReaction") + expect_identical(s$calls()[[1L]]$params, list( + chat_id = "5", message_id = "7", + reaction = '[{"type":"emoji","emoji":"\U0001F44D"}]')) + # An empty key clears the bot's reaction, the API's only way back. + chat_react(cl, "5", "7", "") + expect_identical(s$calls()[[2L]]$params$reaction, "[]") +}) +expect_error(chat_react(tg_client(function(...) { + list(ok = FALSE, description = "Bad Request: REACTION_INVALID") +}), "5", "7", "x"), "REACTION_INVALID") + +# Reaction events: Telegram reports one user's whole before-and-after +# set on one message, so an addition is what is new and not old. A +# removal has no shape in the contract and is not reported. +local({ + thumbs <- list(type = "emoji", emoji = "\U0001F44D") + react <- function(user, date, old, new) { + list(chat = list(id = -100123, type = "supergroup"), message_id = 7, + user = list(id = user), date = date, + old_reaction = old, new_reaction = new) + } + s <- tg_scripted(list(getMe = me_ok, getUpdates = list(ok = TRUE, result = list( + list(update_id = 1, + message_reaction = react(42, 1700000005, list(), list(thumbs))), + list(update_id = 2, + message_reaction = react(999, 1700000006, list(thumbs), + list(thumbs, list(type = "custom_emoji", + custom_emoji_id = "c1")))), + list(update_id = 3, + message_reaction = react(42, 1700000007, list(thumbs), list())))))) + got <- chat_poll(tg_client(s$api)) + expect_identical(got$messages, list()) + expect_identical(length(got$reactions), 2L) + r1 <- got$reactions[[1L]] + expect_inherits(r1, "chat_reaction") + expect_null(r1$id) + expect_identical(r1$channel, "-100123") + expect_identical(r1$sender, "42") + expect_identical(r1$target, "7") + expect_identical(r1$key, "\U0001F44D") + expect_identical(as.numeric(r1$ts), 1700000005) + expect_false(r1$self) + r2 <- got$reactions[[2L]] + expect_identical(r2$key, "c1") + expect_true(r2$self) + expect_identical(got$cursor, "4") +}) + +# ---- Typing ---- +local({ + s <- tg_scripted(list(sendChatAction = list(ok = TRUE, result = TRUE))) + cl <- tg_client(s$api) + expect_true(chat_typing(cl, "5", TRUE)) + expect_identical(s$calls()[[1L]]$method, "sendChatAction") + expect_identical(s$calls()[[1L]]$params, list(chat_id = "5", action = "typing")) + # There is no "stopped typing" to send. + expect_false(chat_typing(cl, "5", FALSE)) + expect_identical(length(s$calls()), 1L) +}) +# A dropped indicator is a quiet FALSE, chat_typing()'s bargain. +expect_false(chat_typing(tg_client(function(...) stop("down")), "5")) + +# ---- Channel info ---- +local({ + s <- tg_scripted(list(getChat = list(ok = TRUE, result = list( + id = -1001234567890, type = "supergroup", title = "lab", + description = "the lab")))) + cl <- tg_client(s$api) + info <- chat_channel_info(cl, "-1001234567890") + expect_identical(s$calls()[[1L]]$method, "getChat") + expect_identical(s$calls()[[1L]]$params, list(chat_id = "-1001234567890")) + expect_identical(info, list(id = "-1001234567890", name = "lab", + topic = "the lab")) +}) +# A private chat has no title: the other party's name is what a human +# would call it, and no description is NULL, not "". +local({ + cl <- tg_client(function(...) list(ok = TRUE, result = list( + id = 5, type = "private", first_name = "Ann", last_name = "Lee", + username = "ann"))) + expect_identical(chat_channel_info(cl, "5"), + list(id = "5", name = "Ann Lee", topic = NULL)) +}) +local({ + cl <- tg_client(function(...) list(ok = TRUE, result = list( + id = 5, type = "private", username = "ann", description = ""))) + expect_identical(chat_channel_info(cl, "5")$name, "ann") + expect_null(chat_channel_info(cl, "5")$topic) +}) +expect_error(chat_channel_info(tg_client(function(...) { + list(ok = FALSE, description = "Bad Request: chat not found") +}), "1"), "chat not found") + +# ---- Leaving ---- +local({ + s <- tg_scripted(list(leaveChat = list(ok = TRUE, result = TRUE))) + cl <- tg_client(s$api) + expect_identical(chat_leave(cl, "-100123"), "-100123") + expect_identical(s$calls()[[1L]]$method, "leaveChat") + expect_identical(s$calls()[[1L]]$params, list(chat_id = "-100123")) +}) +# A refusal propagates, so a failed leave never reads as a quiet one. +expect_error(chat_leave(tg_client(function(...) { + list(ok = FALSE, description = "Forbidden: bot is not a member") +}), "1"), "not a member") + +# ---- Resolving ---- +# An id passes through without a call; a public username goes to +# getChat with its @, whether or not the caller typed one. +local({ + s <- tg_scripted(list(getChat = list(ok = TRUE, result = list( + id = -1001234567890, type = "supergroup")))) + cl <- tg_client(s$api) + expect_identical(chat_resolve(cl, "-100123"), "-100123") + expect_identical(chat_resolve(cl, "5"), "5") + expect_identical(length(s$calls()), 0L) + expect_identical(chat_resolve(cl, "@rstats"), "-1001234567890") + expect_identical(s$calls()[[1L]]$params, list(chat_id = "@rstats")) + expect_identical(chat_resolve(cl, "rstats"), "-1001234567890") + expect_identical(s$calls()[[2L]]$params$chat_id, "@rstats") +}) +expect_error(chat_resolve(tg_client(function(...) { + list(ok = FALSE, description = "Bad Request: chat not found") +}), "@nope"), "chat not found") + +# ---- Identity ---- +tg_message <- function(body, type = "supergroup", reply_from = NULL, + mentions = NULL) { + raw <- list(chat = list(id = -100123, type = type)) + if (!is.null(reply_from)) { + raw$reply_to_message <- list(from = list(id = reply_from)) + } + chat_message(id = "1", channel = "-100123", sender = "42", body = body, + ts = Sys.time(), mentions = mentions, raw = raw) +} + +local({ + s <- tg_scripted(list(getMe = me_ok)) + cl <- tg_client(s$api) + who <- chat_whoami(cl) + expect_inherits(who, "chat_identity") + expect_identical(who$id, "999") + # The username is the display: it is what a mention is written as. + expect_identical(who$display, "corteza_bot") + expect_identical(s$calls()[[1L]]$method, "getMe") + # One call per client. chat_addressed() asks on every message. + chat_whoami(cl) + expect_identical(length(s$calls()), 1L) + + # @username stays in the text on Telegram, so this is a literal, + # bounded, case-insensitive match on the handle. + expect_true(chat_addressed(cl, tg_message("hey @corteza_bot look"))) + expect_true(chat_addressed(cl, tg_message("@Corteza_Bot?"))) + expect_false(chat_addressed(cl, tg_message("hey @corteza_bot2 look"))) + expect_false(chat_addressed(cl, tg_message("mail x@corteza_bot now"))) + expect_false(chat_addressed(cl, tg_message("hey corteza_bot"))) + expect_false(chat_addressed(cl, tg_message(""))) + # A private chat is a conversation with the bot. + expect_true(chat_addressed(cl, tg_message("anything", type = "private"))) + # A reply to something the bot said. + expect_true(chat_addressed(cl, tg_message("yes", reply_from = 999))) + expect_false(chat_addressed(cl, tg_message("yes", reply_from = 42))) + # Declared mentions still count. + expect_true(chat_addressed(cl, tg_message("nothing", mentions = "999"))) + expect_identical(length(s$calls()), 1L) +}) + +# A bot with no username is not addressed by one. +local({ + cl <- tg_client(function(...) list(ok = TRUE, result = list( + id = 999, is_bot = TRUE, first_name = "Corteza"))) + expect_identical(chat_whoami(cl)$display, "Corteza") + expect_false(chat_addressed(cl, tg_message("@corteza_bot"))) +}) + +expect_error(chat_whoami(tg_client(function(...) { + list(ok = FALSE, description = "Unauthorized") +})), "Unauthorized") +expect_error(chat_whoami(tg_client(function(...) { + list(ok = TRUE, result = list(is_bot = TRUE)) +})), "no id") + +# set_identity changes the bot's name and drops the cached identity, +# which carried the old one. +local({ + s <- tg_scripted(list(getMe = me_ok, + setMyName = list(ok = TRUE, result = TRUE))) + cl <- tg_client(s$api) + chat_whoami(cl) + expect_true(chat_set_identity(cl, "Cornball")) + expect_identical(s$calls()[[2L]]$method, "setMyName") + expect_identical(s$calls()[[2L]]$params, list(name = "Cornball")) + chat_whoami(cl) + expect_identical(length(s$of("getMe")), 2L) +}) +expect_error(chat_set_identity(tg_client(function(...) { + list(ok = FALSE, description = "Too Many Requests: retry after 3600") +}), "x"), "Too Many Requests") + +# ---- Live, opt-in ---- +# A read-only round trip against the real API, only where a token is +# set and only at home. getMe is the cheapest call there is. +if (tinytest::at_home() && nzchar(Sys.getenv("TELEGRAM_BOT_TOKEN")) && + requireNamespace("httr", quietly = TRUE)) { + who <- chat_whoami(chat_telegram()) + expect_true(nzchar(who$id)) + expect_true(isTRUE(who$raw$is_bot)) +} diff --git a/man/chat_telegram.Rd b/man/chat_telegram.Rd new file mode 100644 index 0000000..fc5ea62 --- /dev/null +++ b/man/chat_telegram.Rd @@ -0,0 +1,55 @@ +% tinyrox says don't edit this manually, but it can't stop you! +\name{chat_telegram} +\alias{chat_telegram} +\title{Create a Telegram chat client} +\usage{ +chat_telegram( + token = Sys.getenv("TELEGRAM_BOT_TOKEN"), + timeout = 30L, + api_url = "https://api.telegram.org", + .api = NULL, + .download = NULL +) +} +\arguments{ +\item{token}{Bot token; defaults to the \code{TELEGRAM_BOT_TOKEN} +environment variable.} + +\item{timeout}{Long-poll wait in seconds, used by +\code{\link{chat_poll}} when it is given no \code{timeout}.} + +\item{api_url}{Base URL of the Bot API. The default is Telegram's; +a local Bot API server takes its own.} + +\item{.api}{Testing seam: replacement for the HTTP layer, a +\code{function(method, params, files)} returning the parsed +response (\code{list(ok =, result =)}). \code{params} arrives +already in wire form: NULLs dropped, logicals as +\code{"true"}/\code{"false"}, numbers as plain digits. Leave NULL +in production.} + +\item{.download}{Testing seam: replacement for the file fetch, a +\code{function(file_path, dest)} writing the bytes behind a +getFile path to \code{dest}. Leave NULL in production; when both +seams are supplied the httr package is not required.} +} +\value{ +A \code{chat_client} of class \code{chat_telegram}. +} +\description{ +Requires the suggested \pkg{httr} package and a bot token from +BotFather. +} +\details{ +Channels are chat identifiers as Telegram reports them -- a +positive number for a private chat, a negative one for a group or +channel -- always as character. \code{\link{chat_resolve}} turns a +public \code{@@username} into one. + +The first poll returns whatever updates Telegram is still holding +for the bot (it keeps them for 24 hours). That is the mail that +arrived while the bot was down rather than channel history, so it +comes out as ordinary traffic. Passing the returned cursor back as +\code{since} confirms it; Telegram re-sends anything unconfirmed. + +} diff --git a/tasks/todo.md b/tasks/todo.md index 16122fd..5ed8d03 100644 --- a/tasks/todo.md +++ b/tasks/todo.md @@ -12,7 +12,9 @@ token + test channel. - [ ] Rewire corteza loop to chat_poll/chat_send; land corteza PR #155 as the identity option -- [ ] Telegram adapter (getUpdates; shape-identical to Matrix sync) +- [x] Telegram adapter (getUpdates long poll, one offset cursor; every + verb seam-tested against Bot API shapes, httr formals pinned). + Live send/poll still needs a bot token. - [ ] CI (r-ci); decide public flip once the corteza rewire proves the contract From 7482a1bb2e4abf362e6c5de1ac44652135a80f4b Mon Sep 17 00:00:00 2001 From: TroyHernandez Date: Mon, 7 Sep 2026 18:34:13 -0500 Subject: [PATCH 2/2] Bump version to 0.0.1.27 --- DESCRIPTION | 2 +- NEWS.md | 12 ++++++++++++ 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4a1e12b..02147d3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: chat.api Type: Package Title: Transport-Agnostic Chat Contract for R Agents -Version: 0.0.1.26 +Version: 0.0.1.27 Date: 2026-09-07 Authors@R: c( person("Troy", "Hernandez", role = c("aut", "cre"), diff --git a/NEWS.md b/NEWS.md index 4a6a6aa..12596a2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,15 @@ +# chat.api 0.0.1.27 + +* New Telegram adapter, chat_telegram(), over the Bot API with HTTP + delegated to the suggested httr package. getUpdates long polling is + the poll, with a single update offset as the cursor. Sends render + markdown to Telegram HTML and carry threads, replies, files, and + silent delivery; edits, emoji reactions and reaction events, typing, + chat info, leaving, identity, @username addressing, and attachment + fetch through getFile are wired. Capabilities report what the Bot + API lacks: history, member and chat lists, read markers, joining, + and creating. + # chat.api 0.0.1.26 * Slack gains chat_channel_create() and chat_leave(), posting