R/provider-openrouter.R

In ellmer: Chat with Large Language Models

#' @include provider-openai.R
NULL

#' Chat with one of the many models hosted on OpenRouter
#'
#' @description
#' Sign up at <https://openrouter.ai>.
#'
#' Support for features depends on the underlying model that you use; see
#' <https://openrouter.ai/models> for details.
#'
#' @export
#' @family chatbots
#' @inheritParams chat_openai
#' @inherit chat_openai return
#' @examples
#' \dontrun{
#' chat <- chat_openrouter()
#' chat$chat("Tell me three jokes about statisticians")
#' }
chat_openrouter <- function(
  system_prompt = NULL,
  turns = NULL,
  api_key = openrouter_key(),
  model = NULL,
  seed = NULL,
  api_args = list(),
  echo = c("none", "text", "all")
) {
  turns <- normalize_turns(turns, system_prompt)
  model <- set_default(model, "gpt-4o")
  echo <- check_echo(echo)

  if (is_testing() && is.null(seed)) {
    seed <- seed %||% 1014
  }

  provider <- ProviderOpenRouter(
    base_url = "https://openrouter.ai/api/v1",
    model = model,
    seed = seed,
    extra_args = api_args,
    api_key = api_key
  )
  Chat$new(provider = provider, turns = turns, echo = echo)
}

chat_openrouter_test <- function(...) {
  chat_openrouter(..., model = "openai/gpt-4o-mini-2024-07-18")
}

ProviderOpenRouter <- new_class(
  "ProviderOpenRouter",
  parent = ProviderOpenAI,
)

openrouter_key <- function() {
  key_get("OPENROUTER_API_KEY")
}

method(chat_request, ProviderOpenRouter) <- function(
  provider,
  stream = TRUE,
  turns = list(),
  tools = list(),
  type = NULL
) {
  req <- chat_request(
    super(provider, ProviderOpenAI),
    stream = stream,
    turns = turns,
    tools = tools,
    type = type
  )

  # https://openrouter.ai/docs/api-keys
  req <- req_headers(
    req,
    `HTTP-Referer` = "https://ellmer.tidyverse.org",
    `X-Title` = "ellmer"
  )

  req
}

method(value_turn, ProviderOpenRouter) <- function(provider, result, has_type = FALSE) {
  # https://openrouter.ai/docs/errors
  check_openrouter_error(result$error)

  value_turn(
    super(provider, ProviderOpenAI),
    result = result,
    has_type = has_type
  )
}

method(stream_parse, ProviderOpenRouter) <- function(provider, event) {
  if (is.null(event)) {
    cli::cli_abort("Connection closed unexpectedly")
  }

  if (identical(event$data, "[DONE]")) {
    return(NULL)
  }

  result <- jsonlite::parse_json(event$data)
  check_openrouter_error(result$error)
  result
}

check_openrouter_error <- function(error, call = caller_env()) {
  if (is.null(error)) {
    return()
  }
  message <- error$message
  if (is.null(error$metadata$raw$data)) {
    details <- NULL
  } else {
    details <- prettify(error$metadata$raw$data)
    # don't line wrap
    details <- gsub(" ", "\u00a0", details, fixed = TRUE)
  }

  abort(
    c("message", i = if (!is.null(details)) details),
    call = call
  )
}

method(chat_resp_stream, ProviderOpenRouter) <- function(provider, resp) {
  repeat({
    event <- resp_stream_sse(resp)
    if (is.null(event)) {
      break
    }

    # https://openrouter.ai/docs/responses#sse-streaming-comments
    if (!identical(event$data, character())) {
      break
    }
    Sys.sleep(0.1)
  })

  event
}

method(as_json, list(ProviderOpenRouter, ContentText)) <- function(provider, x) {
  if (identical(x@text, "")) {
    # Tool call requests can include a Content with empty text,
    # but it doesn't like it if you send this back
    NULL
  } else {
    list(type = "text", text = x@text)
  }
}