From 02a3192b53ef4f467b31c70d7607f23ac16c9e00 Mon Sep 17 00:00:00 2001 From: TroyHernandez Date: Wed, 19 Aug 2026 16:33:32 -0500 Subject: [PATCH 1/3] Add chat_set_state() for durable typed channel state A capability-gated setter for channel-scoped metadata: a Matrix state event on the Matrix adapter, an in-memory keyed store on loopback so consumers can round-trip it in tests, and a refusal everywhere else (set_state = FALSE on Slack and IRC). The Matrix method follows the channel_create pattern: injectable .state seam, mx.api::mx_set_state default, errors propagate. --- R/contract.R | 41 ++++++++++++++++++++++++++++++++++- R/irc.R | 2 +- R/loopback.R | 18 ++++++++++++++- R/matrix.R | 17 +++++++++++++-- R/slack.R | 2 +- inst/tinytest/test_contract.R | 28 ++++++++++++++++++++++++ inst/tinytest/test_matrix.R | 30 +++++++++++++++++++++++++ 7 files changed, 132 insertions(+), 6 deletions(-) diff --git a/R/contract.R b/R/contract.R index 3263967..7753f43 100644 --- a/R/contract.R +++ b/R/contract.R @@ -117,7 +117,8 @@ chat_resolve <- function(client, name, ...) { #' (\code{\link{chat_whoami}} works, and with it the default #' \code{\link{chat_addressed}}), \code{channel_create} #' (\code{\link{chat_channel_create}} works), \code{leave} -#' (\code{\link{chat_leave}} works), \code{files} (outbound: +#' (\code{\link{chat_leave}} works), \code{set_state} +#' (\code{\link{chat_set_state}} works), \code{files} (outbound: #' \code{chat_send(files =)} works), \code{attachments} (inbound: #' media comes back out of \code{\link{chat_poll}} as #' \code{\link{chat_attachment}} records), \code{typing}, @@ -848,6 +849,44 @@ chat_set_identity.default <- function(client, display, ...) { "). Check chat_capabilities()$set_identity.", call. = FALSE) } +#' Set durable typed state on a channel +#' +#' Attaches a typed, durable piece of metadata to a channel, readable +#' by every client in it and replaced by the next write to the same +#' \code{type} and \code{state_key}. On Matrix this is a state event; +#' most platforms have no equivalent, which is why it is +#' capability-gated: check \code{chat_capabilities()$set_state}. +#' +#' The default method throws, on \code{\link{chat_react}}'s reasoning: +#' a state write that silently did nothing leaves the caller believing +#' a marker is set that no reader will ever see. +#' +#' @param client A \code{chat_client}. +#' @param channel Channel/room identifier. +#' @param type Character. Namespaced event type, e.g. +#' \code{"m.room.topic"} or a reversed-domain custom type. +#' @param content Named list. The state content. A write replaces the +#' whole content for its \code{type}/\code{state_key} pair; there is +#' no merge. +#' @param state_key Character. Sub-key within the type. Most state is +#' keyed by the empty string, the default. +#' @param ... Adapter-specific options. +#' @return The state event's identifier where the platform gives one +#' (Matrix), invisibly; \code{TRUE} where it does not. +#' @export +chat_set_state <- function(client, channel, type, content, + state_key = "", ...) { + UseMethod("chat_set_state") +} + +#' @export +chat_set_state.default <- function(client, channel, type, content, + state_key = "", ...) { + stop("chat_set_state() is not supported by this adapter (", + paste(class(client), collapse = "/"), + "). Check chat_capabilities()$set_state.", call. = FALSE) +} + #' Refresh this client's credentials #' #' Forces the re-authentication that adapters otherwise perform on diff --git a/R/irc.R b/R/irc.R index c54a2b4..9b495b5 100644 --- a/R/irc.R +++ b/R/irc.R @@ -131,7 +131,7 @@ chat_capabilities.chat_irc <- function(client, ...) { mark_read = FALSE, set_identity = TRUE, relogin = FALSE, # IRC JOIN would create a channel implicitly, but this adapter # has no join verb yet, so neither flag can be TRUE honestly. - channel_create = FALSE, leave = FALSE, + channel_create = FALSE, leave = FALSE, set_state = FALSE, files = FALSE, attachments = FALSE, typing = FALSE, e2ee = FALSE, identity_override = FALSE, rich_markup = character(), markup_dialects = "plain", max_message_bytes = 400L) diff --git a/R/loopback.R b/R/loopback.R index 54db1de..f8255de 100644 --- a/R/loopback.R +++ b/R/loopback.R @@ -20,6 +20,10 @@ chat_loopback <- function() { # Channels declared by chat_channel_create(); chat_channels() # reports these plus every channel the log has seen traffic in. env$channels <- character() + # Durable channel state written by chat_set_state(), keyed by + # channel/type/state_key. A write replaces the previous content for + # its key, which is the Matrix semantic consumers test against. + env$state <- list() structure(list(env = env), class = c("chat_loopback", "chat_client")) } @@ -39,6 +43,18 @@ chat_channel_create.chat_loopback <- function(client, name, ...) { invisible(name) } +#' @export +chat_set_state.chat_loopback <- function(client, channel, type, content, + state_key = "", ...) { + stopifnot(is.character(channel), length(channel) == 1L, nzchar(channel), + is.character(type), length(type) == 1L, nzchar(type), + is.list(content), + is.character(state_key), length(state_key) == 1L) + key <- paste(channel, type, state_key, sep = "\r") + client$env$state[[key]] <- content + invisible(sprintf("loopback-state-%d", length(client$env$state))) +} + #' @export chat_send.chat_loopback <- function(client, channel, text, markup = c("plain", "markdown"), @@ -102,7 +118,7 @@ chat_capabilities.chat_loopback <- function(client, ...) { members = FALSE, invites = FALSE, join = FALSE, whoami = TRUE, channels = TRUE, history = TRUE, pending = FALSE, mark_read = FALSE, set_identity = FALSE, relogin = FALSE, - channel_create = TRUE, leave = FALSE, + channel_create = TRUE, leave = FALSE, set_state = TRUE, # files records the paths it was handed; attachments hands # them back out of the poll. Both TRUE is what makes loopback # the round-trip test double for media-carrying consumers. diff --git a/R/matrix.R b/R/matrix.R index e1e6b1f..b1d357f 100644 --- a/R/matrix.R +++ b/R/matrix.R @@ -158,7 +158,7 @@ chat_matrix <- function(app = NULL, path = NULL, save_cursor = TRUE, .send = NULL, .media = NULL, .typing = NULL, .crypto = NULL, .save = NULL, .react = NULL, .info = NULL, .members = NULL, .join = NULL, - .create = NULL, .leave = NULL, + .create = NULL, .leave = NULL, .state = NULL, .channels = NULL, .history = NULL, .pending = NULL, .read = NULL, .identity = NULL, .edit = NULL, .rich = NULL) { @@ -216,6 +216,7 @@ chat_matrix <- function(app = NULL, path = NULL, save_cursor = TRUE, typing_fn = .typing, react_fn = .react, info_fn = .info, members_fn = .members, join_fn = .join, create_fn = .create, leave_fn = .leave, + state_fn = .state, channels_fn = .channels, history_fn = .history, pending_fn = .pending, read_fn = .read, identity_fn = .identity, edit_fn = .edit, @@ -680,6 +681,18 @@ chat_leave.chat_matrix <- function(client, channel, ...) { invisible(channel) } +#' @export +chat_set_state.chat_matrix <- function(client, channel, type, content, + state_key = "", ...) { + # Errors propagate, chat_react()'s reasoning: a state write that + # quietly failed leaves a marker the caller believes is set and no + # reader will ever see. + sess <- mx.client::mx_client_session(client$env$mx) + state_fn <- client$state_fn %||% mx.api::mx_set_state + invisible(as.character(state_fn(sess, channel, type, content, + state_key = state_key))) +} + #' @export chat_members.chat_matrix <- function(client, channel, ...) { # Errors propagate. An empty room and an unanswerable question are @@ -746,7 +759,7 @@ chat_capabilities.chat_matrix <- function(client, ...) { channels = TRUE, history = TRUE, pending = matrix_invites_available(), mark_read = TRUE, set_identity = TRUE, relogin = TRUE, - channel_create = TRUE, leave = TRUE, + channel_create = TRUE, leave = TRUE, set_state = TRUE, files = !isTRUE(client$e2ee), # attachments is FALSE for the same structural reason # thread_replies is: the only event source is diff --git a/R/slack.R b/R/slack.R index 2764f02..ad34be7 100644 --- a/R/slack.R +++ b/R/slack.R @@ -389,7 +389,7 @@ chat_capabilities.chat_slack <- function(client, ...) { mark_read = TRUE, set_identity = TRUE, relogin = FALSE, # conversations.create and conversations.leave exist in the # Web API; this adapter has no verbs for them yet. - channel_create = FALSE, leave = FALSE, + channel_create = FALSE, leave = FALSE, set_state = FALSE, files = FALSE, attachments = FALSE, typing = FALSE, e2ee = FALSE, identity_override = TRUE, rich_markup = character(), markup_dialects = c("plain", "markdown"), diff --git a/inst/tinytest/test_contract.R b/inst/tinytest/test_contract.R index 0d8d198..6a9cb9a 100644 --- a/inst/tinytest/test_contract.R +++ b/inst/tinytest/test_contract.R @@ -338,6 +338,34 @@ local({ expect_error(chat_leave(lo, "general"), "not supported by this adapter") }) +# ---- Channel state on the reference adapter ---- +# A write is durable and keyed by channel/type/state_key; a second +# write to the same key replaces the content whole, never merges. +local({ + lo <- chat_loopback() + expect_true(chat_capabilities(lo)$set_state) + id <- chat_set_state(lo, "general", "ai.example.marker", + list(state = "parked", since = "2026-08-19")) + expect_true(is.character(id) && nzchar(id)) + key <- paste("general", "ai.example.marker", "", sep = "\r") + expect_identical(lo$env$state[[key]], + list(state = "parked", since = "2026-08-19")) + chat_set_state(lo, "general", "ai.example.marker", + list(state = "active")) + expect_identical(lo$env$state[[key]], list(state = "active")) + # Distinct state_keys are distinct slots under one type. + chat_set_state(lo, "general", "ai.example.marker", + list(state = "parked"), state_key = "alt") + expect_identical(lo$env$state[[key]], list(state = "active")) +}) + +# An adapter that cannot write state says so. +local({ + nothing <- structure(list(), class = c("chat_nothing", "chat_client")) + expect_error(chat_set_state(nothing, "c", "t", list()), + "not supported by this adapter") +}) + # An adapter that cannot create says so. local({ nothing <- structure(list(), class = c("chat_nothing", "chat_client")) diff --git a/inst/tinytest/test_matrix.R b/inst/tinytest/test_matrix.R index d29c6df..4a44f24 100644 --- a/inst/tinytest/test_matrix.R +++ b/inst/tinytest/test_matrix.R @@ -1506,6 +1506,36 @@ local({ expect_error(chat_leave(seam_client(.leave = function(...) stop("M_UNKNOWN")), "!a:ex"), "M_UNKNOWN") +# ---- Channel state ---- +# The seam replaces mx.api::mx_set_state. The default state_key is the +# empty string, where most Matrix state lives, and it is passed by name +# so a seam with the real signature receives it in the right slot. +local({ + seen <- NULL + cl <- seam_client(.state = function(session, channel, type, content, + state_key = "") { + seen <<- list(channel = channel, type = type, content = content, + state_key = state_key) + "$st1" + }) + expect_identical(chat_set_state(cl, "!a:ex", "ai.example.marker", + list(state = "parked")), "$st1") + expect_identical(seen$channel, "!a:ex") + expect_identical(seen$type, "ai.example.marker") + expect_identical(seen$content, list(state = "parked")) + expect_identical(seen$state_key, "") + chat_set_state(cl, "!a:ex", "ai.example.marker", list(), + state_key = "alt") + expect_identical(seen$state_key, "alt") +}) + +# A failed write propagates: doing nothing quietly leaves a marker the +# caller believes is set and no reader will ever see. +expect_error( + chat_set_state(seam_client(.state = function(...) stop("M_FORBIDDEN")), + "!a:ex", "ai.example.marker", list()), + "M_FORBIDDEN") + # ---- The record ---- iv <- chat_invite(channel = "!a:ex", inviter = "@ann:ex") expect_inherits(iv, "chat_invite") From 89249b0bc5f20b0d79212bd14030c63b8802253b Mon Sep 17 00:00:00 2001 From: TroyHernandez Date: Wed, 19 Aug 2026 16:34:07 -0500 Subject: [PATCH 2/3] rformat + document --- NAMESPACE | 4 ++++ R/contract.R | 23 +++++++++++------------ R/loopback.R | 20 ++++++++++---------- man/chat_capabilities.Rd | 3 ++- man/chat_matrix.Rd | 1 + 5 files changed, 28 insertions(+), 23 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 0b5167b..c6506b9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -32,6 +32,7 @@ export(chat_relogin) export(chat_resolve) export(chat_send) export(chat_set_identity) +export(chat_set_state) export(chat_slack) export(chat_typing) export(chat_whoami) @@ -98,6 +99,9 @@ S3method(chat_set_identity,chat_irc) S3method(chat_set_identity,chat_matrix) S3method(chat_set_identity,chat_slack) 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,default) S3method(chat_whoami,chat_irc) diff --git a/R/contract.R b/R/contract.R index 7753f43..7ec645a 100644 --- a/R/contract.R +++ b/R/contract.R @@ -474,8 +474,7 @@ chat_message <- function(id, channel, sender, body, ts, thread = NULL, is.character(body)) if (!is.null(attachments)) { ok <- is.list(attachments) && length(attachments) > 0L && - all(vapply(attachments, inherits, logical(1), - "chat_attachment")) + all(vapply(attachments, inherits, logical(1), "chat_attachment")) if (!ok) { stop("attachments must be a non-empty list of ", "chat_attachment records, or NULL.", call. = FALSE) @@ -518,10 +517,10 @@ chat_message <- function(id, channel, sender, body, ts, thread = NULL, #' @examples #' chat_attachment("mxc://ex/abc", name = "plot.png", mime = "image/png") #' @export -chat_attachment <- function(id, name = NA_character_, - mime = NA_character_, bytes = NA_integer_, - url = NA_character_, path = NA_character_, - sha256 = NA_character_, raw = NULL) { +chat_attachment <- function(id, name = NA_character_, mime = NA_character_, + bytes = NA_integer_, url = NA_character_, + path = NA_character_, sha256 = NA_character_, + raw = NULL) { stopifnot(is.character(id), length(id) == 1L, nzchar(id)) structure(list(id = id, name = name, mime = mime, bytes = bytes, url = url, path = path, sha256 = sha256, raw = raw), @@ -531,10 +530,10 @@ chat_attachment <- function(id, name = NA_character_, #' @export print.chat_attachment <- function(x, ...) { cat(sprintf("%s%s%s\n", x$id, - if (is.na(x$name)) "" else sprintf(" (%s)", x$name), - if (is.na(x$bytes)) "" else { - sprintf(", %d bytes", as.integer(x$bytes)) - })) + if (is.na(x$name)) "" else sprintf(" (%s)", x$name), + if (is.na(x$bytes)) "" else { + sprintf(", %d bytes", as.integer(x$bytes)) + })) invisible(x) } @@ -874,8 +873,8 @@ chat_set_identity.default <- function(client, display, ...) { #' @return The state event's identifier where the platform gives one #' (Matrix), invisibly; \code{TRUE} where it does not. #' @export -chat_set_state <- function(client, channel, type, content, - state_key = "", ...) { +chat_set_state <- function(client, channel, type, content, state_key = "", + ...) { UseMethod("chat_set_state") } diff --git a/R/loopback.R b/R/loopback.R index f8255de..e9df0e2 100644 --- a/R/loopback.R +++ b/R/loopback.R @@ -36,8 +36,8 @@ chat_channel_create.chat_loopback <- function(client, name, ...) { # has lost track of its own state, and the reference adapter is # where that should be loudest. if (name %in% chat_channels(client)) { - stop("chat_channel_create(): channel '", name, - "' already exists.", call. = FALSE) + stop("chat_channel_create(): channel '", name, "' already exists.", + call. = FALSE) } client$env$channels <- c(client$env$channels, name) invisible(name) @@ -45,11 +45,11 @@ chat_channel_create.chat_loopback <- function(client, name, ...) { #' @export chat_set_state.chat_loopback <- function(client, channel, type, content, - state_key = "", ...) { + state_key = "", ...) { stopifnot(is.character(channel), length(channel) == 1L, nzchar(channel), is.character(type), length(type) == 1L, nzchar(type), - is.list(content), - is.character(state_key), length(state_key) == 1L) + is.list(content), is.character(state_key), + length(state_key) == 1L) key <- paste(channel, type, state_key, sep = "\r") client$env$state[[key]] <- content invisible(sprintf("loopback-state-%d", length(client$env$state))) @@ -75,11 +75,11 @@ chat_send.chat_loopback <- function(client, channel, text, } attachments <- lapply(seq_along(files), function(i) { chat_attachment( - id = sprintf("loopback-file-%d-%d", - length(client$env$log) + 1L, i), - name = basename(files[[i]]), - bytes = as.integer(file.size(files[[i]])), - path = files[[i]]) + id = sprintf("loopback-file-%d-%d", + length(client$env$log) + 1L, i), + name = basename(files[[i]]), + bytes = as.integer(file.size(files[[i]])), + path = files[[i]]) }) } id <- sprintf("loopback-%d", length(client$env$log) + 1L) diff --git a/man/chat_capabilities.Rd b/man/chat_capabilities.Rd index 4a4e58d..fe7879b 100644 --- a/man/chat_capabilities.Rd +++ b/man/chat_capabilities.Rd @@ -23,7 +23,8 @@ A list with at least: \code{threads} (can post into (\code{\link{chat_whoami}} works, and with it the default \code{\link{chat_addressed}}), \code{channel_create} (\code{\link{chat_channel_create}} works), \code{leave} - (\code{\link{chat_leave}} works), \code{files} (outbound: + (\code{\link{chat_leave}} works), \code{set_state} + (\code{\link{chat_set_state}} works), \code{files} (outbound: \code{chat_send(files =)} works), \code{attachments} (inbound: media comes back out of \code{\link{chat_poll}} as \code{\link{chat_attachment}} records), \code{typing}, diff --git a/man/chat_matrix.Rd b/man/chat_matrix.Rd index 1c97b39..e3a24c5 100644 --- a/man/chat_matrix.Rd +++ b/man/chat_matrix.Rd @@ -24,6 +24,7 @@ chat_matrix( .join = NULL, .create = NULL, .leave = NULL, + .state = NULL, .channels = NULL, .history = NULL, .pending = NULL, From c2ba795700d9209f229bc62fd1ef330f64ed0fdc Mon Sep 17 00:00:00 2001 From: TroyHernandez Date: Wed, 19 Aug 2026 16:34:54 -0500 Subject: [PATCH 3/3] Bump version to 0.0.1.22 --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6a48f25..8191952 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.21 +Version: 0.0.1.22 Date: 2026-08-18 Authors@R: c( person("Troy", "Hernandez", role = c("aut", "cre"),