Add chat_set_state() for durable typed channel state

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

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)

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},
@@ -473,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)
@@ -517,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),
@@ -530,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)
 }
 
@@ -848,6 +848,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

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)

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"))
 }
 
@@ -32,13 +36,25 @@ 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)
 }
 
+#' @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"),
@@ -59,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)
@@ -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.

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

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

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

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

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},

man/chat_matrix.Rd

@@ -24,6 +24,7 @@ chat_matrix(
   .join = NULL,
   .create = NULL,
   .leave = NULL,
+  .state = NULL,
   .channels = NULL,
   .history = NULL,
   .pending = NULL,