Break up chat_request() into smaller generics (#426)

And use that to simplify methods for OpenAI subclasses.

Author: hadley

R/provider-azure.R

@@ -131,24 +131,20 @@ azure_endpoint <- function() {
 }
 
 # https://learn.microsoft.com/en-us/azure/ai-services/openai/reference#chat-completions
-method(chat_request, ProviderAzureOpenAI) <- function(
-  provider,
-  stream = TRUE,
-  turns = list(),
-  tools = list(),
-  type = NULL
-) {
-  req <- request(provider@base_url)
-  req <- req_url_path_append(req, "/chat/completions")
+method(base_request, ProviderAzureOpenAI) <- function(provider) {
+  req <- base_request(super(provider, ProviderOpenAI))
+  req <- req_headers(req, Authorization = NULL)
+
   req <- req_url_query(req, `api-version` = provider@api_version)
   if (nchar(provider@api_key)) {
     req <- req_headers_redacted(req, `api-key` = provider@api_key)
   }
   req <- ellmer_req_credentials(req, provider@credentials)
-  req <- req_retry(req, max_tries = 2)
-  req <- ellmer_req_timeout(req, stream)
-  req <- ellmer_req_user_agent(req)
-  req <- req_error(req, body = function(resp) {
+  req
+}
+
+method(base_request_error, ProviderAzureOpenAI) <- function(provider, req) {
+  req_error(req, body = function(resp) {
     error <- resp_body_json(resp)$error
     msg <- paste0(error$code, ": ", error$message)
     # Try to be helpful in the (common) case that the user or service
@@ -172,37 +168,6 @@ method(chat_request, ProviderAzureOpenAI) <- function(
     }
     msg
   })
-
-  messages <- compact(unlist(as_json(provider, turns), recursive = FALSE))
-  tools <- as_json(provider, unname(tools))
-
-  if (!is.null(type)) {
-    response_format <- list(
-      type = "json_schema",
-      json_schema = list(
-        name = "structured_data",
-        schema = as_json(provider, type),
-        strict = TRUE
-      )
-    )
-  } else {
-    response_format <- NULL
-  }
-
-  params <- chat_params(provider, provider@params)
-  body <- compact(list2(
-    messages = messages,
-    model = provider@model,
-    stream = stream,
-    stream_options = if (stream) list(include_usage = TRUE),
-    tools = tools,
-    response_format = response_format,
-    !!!params
-  ))
-  body <- modify_list(body, provider@extra_args)
-  req <- req_body_json(req, body)
-
-  req
 }
 
 default_azure_credentials <- function(api_key = NULL, token = NULL) {

R/provider-databricks.R

@@ -85,57 +85,52 @@ ProviderDatabricks <- new_class(
   properties = list(credentials = class_function)
 )
 
-method(chat_request, ProviderDatabricks) <- function(
+method(base_request, ProviderDatabricks) <- function(provider) {
+  req <- request(provider@base_url)
+  req <- ellmer_req_credentials(req, provider@credentials)
+  req <- req_retry(req, max_tries = 2)
+  req <- ellmer_req_timeout(req, stream)
+  req <- ellmer_req_user_agent(req, databricks_user_agent())
+  req <- base_request_error(provider, req)
+  req
+}
+
+method(chat_body, ProviderDatabricks) <- function(
   provider,
   stream = TRUE,
   turns = list(),
   tools = list(),
   type = NULL
 ) {
-  req <- request(provider@base_url)
+  body <- chat_body(
+    super(provider, ProviderOpenAI),
+    stream = stream,
+    turns = turns,
+    tools = tools,
+    type = type
+  )
+
+  # Databricks doensn't support stream options
+  body$stream_options <- NULL
+
+  body
+}
+
+method(chat_path, ProviderDatabricks) <- function(provider) {
   # Note: this API endpoint is undocumented and seems to exist primarily for
   # compatibility with the OpenAI Python SDK. The documented endpoint is
   # `/serving-endpoints/<model>/invocations`.
-  req <- req_url_path_append(req, "/serving-endpoints/chat/completions")
-  req <- ellmer_req_credentials(req, provider@credentials)
-  req <- ellmer_req_user_agent(req, databricks_user_agent())
-  req <- req_retry(req, max_tries = 2)
-  req <- ellmer_req_timeout(req, stream)
-  req <- req_error(req, body = function(resp) {
+  "/serving-endpoints/chat/completions"
+}
+
+method(base_request_error, ProviderDatabricks) <- function(provider, req) {
+  req_error(req, body = function(resp) {
     if (resp_content_type(resp) == "application/json") {
       # Databrick's "OpenAI-compatible" API has a slightly incompatible error
       # response format, which we account for here.
       resp_body_json(resp)$message
     }
   })
-
-  messages <- compact(unlist(as_json(provider, turns), recursive = FALSE))
-  tools <- as_json(provider, unname(tools))
-
-  if (!is.null(type)) {
-    response_format <- list(
-      type = "json_schema",
-      json_schema = list(
-        name = "structured_data",
-        schema = as_json(provider, type),
-        strict = TRUE
-      )
-    )
-  } else {
-    response_format <- NULL
-  }
-
-  body <- compact(list(
-    messages = messages,
-    model = provider@model,
-    stream = stream,
-    tools = tools,
-    response_format = response_format
-  ))
-  body <- modify_list(body, provider@extra_args)
-  req <- req_body_json(req, body)
-
-  req
 }
 
 method(as_json, list(ProviderDatabricks, Turn)) <- function(provider, x) {

R/provider-openai.R

@@ -105,29 +105,42 @@ openai_key <- function() {
   key_get("OPENAI_API_KEY")
 }
 
-# https://platform.openai.com/docs/api-reference/chat/create
-method(chat_request, ProviderOpenAI) <- function(
-  provider,
-  stream = TRUE,
-  turns = list(),
-  tools = list(),
-  type = NULL
-) {
+# Base request -----------------------------------------------------------------
+
+method(base_request, ProviderOpenAI) <- function(provider) {
   req <- request(provider@base_url)
-  req <- req_url_path_append(req, "/chat/completions")
   req <- req_auth_bearer_token(req, provider@api_key)
   req <- req_retry(req, max_tries = 2)
   req <- ellmer_req_timeout(req, stream)
   req <- ellmer_req_user_agent(req)
+  req <- base_request_error(provider, req)
+  req
+}
 
-  req <- req_error(req, body = function(resp) {
+method(base_request_error, ProviderOpenAI) <- function(provider, req) {
+  req_error(req, body = function(resp) {
     if (resp_content_type(resp) == "application/json") {
       resp_body_json(resp)$error$message
     } else if (resp_content_type(resp) == "text/plain") {
       resp_body_string(resp)
     }
   })
+}
+
+# Chat endpoint ----------------------------------------------------------------
 
+method(chat_path, ProviderOpenAI) <- function(provider) {
+  "/chat/completions"
+}
+
+# https://platform.openai.com/docs/api-reference/chat/create
+method(chat_body, ProviderOpenAI) <- function(
+  provider,
+  stream = TRUE,
+  turns = list(),
+  tools = list(),
+  type = NULL
+) {
   messages <- compact(unlist(as_json(provider, turns), recursive = FALSE))
   tools <- as_json(provider, unname(tools))
 
@@ -147,7 +160,7 @@ method(chat_request, ProviderOpenAI) <- function(
   params <- chat_params(provider, provider@params)
   params$seed <- params$seed %||% provider@seed
 
-  body <- compact(list2(
+  compact(list2(
     messages = messages,
     model = provider@model,
     !!!params,
@@ -156,12 +169,9 @@ method(chat_request, ProviderOpenAI) <- function(
     tools = tools,
     response_format = response_format
   ))
-  body <- utils::modifyList(body, provider@extra_args)
-  req <- req_body_json(req, body)
-
-  req
 }
 
+
 method(chat_params, ProviderOpenAI) <- function(provider, params) {
   standardise_params(
     params,

R/provider-openrouter.R

@@ -58,21 +58,8 @@ 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
-  )
-
+method(base_request, ProviderOpenRouter) <- function(provider) {
+  req <- base_request(super(provider, ProviderOpenAI))
   # https://openrouter.ai/docs/api-keys
   req <- req_headers(
     req,

R/provider-snowflake.R

@@ -78,57 +78,51 @@ ProviderSnowflakeCortex <- new_class(
   )
 )
 
+method(base_request, ProviderSnowflakeCortex) <- function(provider) {
+  req <- request(provider@base_url)
+  req <- ellmer_req_credentials(req, provider@credentials)
+  req <- req_retry(req, max_tries = 2)
+  req <- ellmer_req_timeout(req, stream)
+  # Snowflake uses the User Agent header to identify "parter applications", so
+  # identify requests as coming from "r_ellmer" (unless an explicit partner
+  # application is set via the ambient SF_PARTNER environment variable).
+  req <- ellmer_req_user_agent(req, Sys.getenv("SF_PARTNER"))
+
+  # Snowflake-specific error response handling:
+  req <- req_error(req, body = function(resp) resp_body_json(resp)$message)
+
+  req
+}
+
+method(chat_path, ProviderSnowflakeCortex) <- function(provider) {
+  "/api/v2/cortex/inference:complete"
+}
+
 # See: https://docs.snowflake.com/en/user-guide/snowflake-cortex/cortex-llm-rest-api#api-reference
-method(chat_request, ProviderSnowflakeCortex) <- function(
+method(chat_body, ProviderSnowflakeCortex) <- function(
   provider,
   stream = TRUE,
   turns = list(),
   tools = list(),
   type = NULL
 ) {
+  call <- quote(chat_snowflake())
   if (length(tools) != 0) {
-    cli::cli_abort(
-      "Tool calling is not supported.",
-      call = quote(chat_snowflake())
-    )
+    cli::cli_abort("Tool calling is not supported.", call = call)
   }
   if (!is.null(type) != 0) {
-    cli::cli_abort(
-      "Structured data extraction is not supported.",
-      call = quote(chat_snowflake())
-    )
+    cli::cli_abort("Structured data extraction is not supported.", call = call)
   }
   if (!stream) {
-    cli::cli_abort(
-      "Non-streaming responses are not supported.",
-      call = quote(chat_snowflake())
-    )
+    cli::cli_abort("Non-streaming responses are not supported.", call = call)
   }
 
-  req <- request(provider@base_url)
-  req <- req_url_path_append(req, "/api/v2/cortex/inference:complete")
-  req <- ellmer_req_credentials(req, provider@credentials)
-  req <- req_retry(req, max_tries = 2)
-  req <- ellmer_req_timeout(req, stream)
-  # Snowflake uses the User Agent header to identify "parter applications", so
-  # identify requests as coming from "r_ellmer" (unless an explicit partner
-  # application is set via the ambient SF_PARTNER environment variable).
-  req <- ellmer_req_user_agent(req, Sys.getenv("SF_PARTNER"))
-
-  # Snowflake-specific error response handling:
-  req <- req_error(req, body = function(resp) resp_body_json(resp)$message)
-
   messages <- as_json(provider, turns)
-
-  body <- list(
+  list(
     messages = messages,
     model = provider@model,
     stream = stream
   )
-  body <- modify_list(body, provider@extra_args)
-  req <- req_body_json(req, body)
-
-  req
 }
 
 # Snowflake -> ellmer --------------------------------------------------------