diff --git a/DESCRIPTION b/DESCRIPTION index b654a58..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"), @@ -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/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 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