diff --git a/DESCRIPTION b/DESCRIPTION index 1d8e869..9b7ffb8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: mcptools Title: Model Context Protocol Servers and Clients -Version: 0.1.1.9000 +Version: 0.1.1.9001 Authors@R: c( person("Simon", "Couch", , "simon.couch@posit.co", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-5676-5107")), @@ -43,4 +43,4 @@ Config/Needs/website: tidyverse/tidytemplate Config/testthat/edition: 3 Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.2 +RoxygenNote: 7.3.3 diff --git a/NEWS.md b/NEWS.md index 2949f00..2c0d5fe 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # mcptools (development version) +`mcp_server()` gains logical argument `session_tools`, allowing users to opt-out of presenting R sessions tools to clients. + # mcptools 0.1.1 Addressed an issue in tests on `r-devel-linux-x86_64-fedora-clang`. diff --git a/R/server.R b/R/server.R index 5977e93..2365f62 100644 --- a/R/server.R +++ b/R/server.R @@ -51,11 +51,14 @@ #' Examples for Claude Code on WSL and Claude Desktop on Windows are shown #' at . #' -#' @param tools A list of tools created with [ellmer::tool()] that will be -#' available from the server or a file path to an .R file that, when sourced, -#' will return a list of tools. Any list that could be passed to -#' `Chat$set_tools()` can be passed here. By default, the package won't serve -#' any tools other than those needed to communicate with interactive R sessions. +#' @param tools Optional collection of tools to expose. Supply either a list +#' of objects created by [ellmer::tool()] or a path to an `.R` file that, +#' when sourced, yields such a list. Defaults to `NULL`, which serves only +#' the built-in session tools when `session_tools` is `TRUE`. +#' @param ... Reserved for future use; currently ignored. +#' @param session_tools Logical value whether to include the built-in session +#' tools (`list_r_sessions`, `select_r_session`) that work with +#' `mcp_session()`. Defaults to `TRUE`. #' #' @returns #' `mcp_server()` and `mcp_session()` are both called primarily for side-effects. @@ -102,21 +105,32 @@ #' #' @name server #' @export -mcp_server <- function(tools = NULL) { +mcp_server <- function(tools = NULL, ..., session_tools = TRUE) { # TODO: should this actually be a check for being called within Rscript or not? check_not_interactive() - set_server_tools(tools) + the$sessions_enabled <- isTRUE(session_tools) + set_server_tools(tools, session_tools = the$sessions_enabled) cv <- nanonext::cv() + reader_socket <- nanonext::read_stdin() on.exit(nanonext::reap(reader_socket)) nanonext::pipe_notify(reader_socket, cv, remove = TRUE, flag = TRUE) + client <- nanonext::recv_aio(reader_socket, mode = "string", cv = cv) + + if (!the$sessions_enabled) { + while (nanonext::wait(cv)) { + if (!nanonext::unresolved(client)) { + handle_message_from_client(client$data) + client <- nanonext::recv_aio(reader_socket, mode = "string", cv = cv) + } + } + return() + } the$server_socket <- nanonext::socket("poly") on.exit(nanonext::reap(the$server_socket), add = TRUE) nanonext::dial(the$server_socket, url = sprintf("%s%d", the$socket_url, 1L)) - - client <- nanonext::recv_aio(reader_socket, mode = "string", cv = cv) session <- nanonext::recv_aio(the$server_socket, mode = "string", cv = cv) while (nanonext::wait(cv)) { @@ -178,10 +192,11 @@ handle_message_from_client <- function(line) { } else if (data$method == "tools/call") { tool_name <- data$params$name if ( - # two tools provided by mcptools itself which must be executed in - # the server rather than a session (#18) - tool_name %in% - c("list_r_sessions", "select_r_session") || + !the$sessions_enabled || + # two tools provided by mcptools itself which must be executed in + # the server rather than a session (#18) + tool_name %in% c("list_r_sessions", "select_r_session") || + # when session handling is disabled, never forward to sessions # with no sessions available, just execute tools in the server (#36) !nanonext::stat(the$server_socket, "pipes") ) { diff --git a/R/tools.R b/R/tools.R index f02d255..5c0a6f1 100644 --- a/R/tools.R +++ b/R/tools.R @@ -1,7 +1,16 @@ -set_server_tools <- function(x, x_arg = caller_arg(x), call = caller_env()) { +set_server_tools <- function( + x, + session_tools = TRUE, + x_arg = caller_arg(x), + call = caller_env() +) { if (is.null(x)) { - the$server_tools <- c(list(list_r_sessions_tool, select_r_session_tool)) - return() + if (session_tools) { + the$server_tools <- c(list(list_r_sessions_tool, select_r_session_tool)) + return() + } else { + cli::cli_abort("No tools selected to serve.", call = call) + } } # evaluate eagerly so that caller arg is correct if `looks_like_r_file()` @@ -22,7 +31,11 @@ set_server_tools <- function(x, x_arg = caller_arg(x), call = caller_env()) { ) } - if (!is_list(x) || !all(vapply(x, inherits, logical(1), "ellmer::ToolDef"))) { + if (!is.list(x)) { + x <- list(x) + } + + if (!all(vapply(x, inherits, logical(1), "ellmer::ToolDef"))) { msg <- "{.arg {x_arg}} must be a list of tools created with {.fn ellmer::tool} or a .R file path that returns a list of ellmer tools when sourced." @@ -39,19 +52,22 @@ set_server_tools <- function(x, x_arg = caller_arg(x), call = caller_env()) { ) ) { cli::cli_abort( - "The tool names {.field list_r_sessions} and {.field select_r_session} are + "The tool names {.field list_r_sessions} and {.field select_r_session} are reserved by {.pkg mcptools}.", call = call ) } - the$server_tools <- c( - x, - list( - list_r_sessions_tool, - select_r_session_tool + if (session_tools) { + x <- c( + x, + list( + list_r_sessions_tool, + select_r_session_tool + ) ) - ) + } + the$server_tools <- x } looks_like_r_file <- function(x) { diff --git a/man/server.Rd b/man/server.Rd index e321b26..6dba642 100644 --- a/man/server.Rd +++ b/man/server.Rd @@ -6,16 +6,21 @@ \alias{mcp_session} \title{R as a server: Configure R-based tools with LLM-enabled apps} \usage{ -mcp_server(tools = NULL) +mcp_server(tools = NULL, ..., session_tools = TRUE) mcp_session() } \arguments{ -\item{tools}{A list of tools created with \code{\link[ellmer:tool]{ellmer::tool()}} that will be -available from the server or a file path to an .R file that, when sourced, -will return a list of tools. Any list that could be passed to -\code{Chat$set_tools()} can be passed here. By default, the package won't serve -any tools other than those needed to communicate with interactive R sessions.} +\item{tools}{Optional collection of tools to expose. Supply either a list +of objects created by \code{\link[ellmer:tool]{ellmer::tool()}} or a path to an \code{.R} file that, +when sourced, yields such a list. Defaults to \code{NULL}, which serves only +the built-in session tools when \code{session_tools} is \code{TRUE}.} + +\item{...}{Reserved for future use; currently ignored.} + +\item{session_tools}{Logical value whether to include the built-in session +tools (\code{list_r_sessions}, \code{select_r_session}) that work with +\code{mcp_session()}. Defaults to \code{TRUE}.} } \value{ \code{mcp_server()} and \code{mcp_session()} are both called primarily for side-effects. diff --git a/tests/testthat/_snaps/tools.md b/tests/testthat/_snaps/tools.md index 3550c52..adc4c25 100644 --- a/tests/testthat/_snaps/tools.md +++ b/tests/testthat/_snaps/tools.md @@ -27,11 +27,10 @@ # set_server_tools errors informatively Code - set_server_tools(tls$value[[1]]) + set_server_tools(123) Condition Error: - ! `tls$value[[1]]` must be a list of tools created with `ellmer::tool()` or a .R file path that returns a list of ellmer tools when sourced. - i Did you mean to wrap `tls$value[[1]]` in `list()`? + ! `123` must be a list of tools created with `ellmer::tool()` or a .R file path that returns a list of ellmer tools when sourced. --- diff --git a/tests/testthat/test-tools.R b/tests/testthat/test-tools.R index 2252384..1ab4314 100644 --- a/tests/testthat/test-tools.R +++ b/tests/testthat/test-tools.R @@ -45,8 +45,11 @@ test_that("set_server_tools errors informatively", { local = TRUE ) - # needs to be wrapped in `list()` - expect_snapshot(set_server_tools(tls$value[[1]]), error = TRUE) + # input must be a ToolDef or list of ToolDefs + expect_snapshot(set_server_tools(123), error = TRUE) + + # check can accept a single ToolDef + expect_no_error(set_server_tools(tls$value[[1]])) # select_r_session and list_r_sessions are reserved names tls$value[[1]]@name <- "select_r_session"