tests/testthat/test-model-registry.R

In aisdk: Unified Interface for AI Model Providers

# Model Registry Schema Validation Tests
# Tests for JSON schema v2 under inst/extdata/models/

# Ensure we test the current source tree, not an installed package
# When running via test_file() the installed package may be stale.
utils_models_path <- file.path("..", "..", "R", "utils_models.R")
if (file.exists(utils_models_path)) {
  source(utils_models_path, local = TRUE)
}

# ---- Helpers -----------------------------------------------------------------

.models_dir <- function() {
  # Prefer source tree during development / devtools::test()
  candidates <- c(
    "inst/extdata/models",
    file.path("..", "inst", "extdata", "models"),
    file.path("..", "..", "inst", "extdata", "models")
  )
  for (p in candidates) {
    if (dir.exists(p)) {
      return(p)
    }
  }
  # Fallback to installed package
  system.file("extdata", "models", package = "aisdk")
}

.json_files <- function() {
  d <- .models_dir()
  if (dir.exists(d)) {
    list.files(d, pattern = "\\.json$", full.names = TRUE)
  } else {
    character(0)
  }
}

.provider_name <- function(path) {
  tools::file_path_sans_ext(basename(path))
}

.all_models <- function() {
  files <- .json_files()
  result <- list()
  for (f in files) {
    provider <- .provider_name(f)
    result[[provider]] <- jsonlite::read_json(f)
  }
  result
}

# Flatten all models into a list for vectorised checks
.flatten_models <- function() {
  by_provider <- .all_models()
  rows <- list()
  for (p in names(by_provider)) {
    for (m in by_provider[[p]]) {
      rows[[length(rows) + 1]] <- list(
        provider = p,
        model = m
      )
    }
  }
  rows
}

ALLOWED_TYPES <- c(
  "language", "chat", "embedding", "image", "audio",
  "multimodal", "video", "moderation", "rerank"
)

KNOWN_CAPABILITY_KEYS <- c(
  "reasoning", "vision_input", "image_output", "image_edit",
  "audio_input", "audio_output", "function_call",
  "structured_output", "web_search"
)

# ---- 1. JSON parsability -----------------------------------------------------

test_that("every provider JSON file parses and returns a non-empty list", {
  files <- .json_files()
  expect_true(length(files) > 0, info = "No provider JSON files found")

  for (f in files) {
    parsed <- jsonlite::read_json(f)
    expect_true(is.list(parsed),
      info = sprintf("%s should parse to a list", basename(f))
    )
    expect_true(length(parsed) > 0,
      info = sprintf("%s should contain at least one model", basename(f))
    )
  }
})

# ---- 2. ID uniqueness --------------------------------------------------------

test_that("model IDs are unique within each provider file", {
  by_provider <- .all_models()

  for (p in names(by_provider)) {
    ids <- vapply(by_provider[[p]], function(m) m$id %||% NA_character_, character(1))
    expect_equal(
      anyDuplicated(ids), 0L,
      info = sprintf("Provider '%s' contains duplicate model IDs: %s",
        p, paste(ids[duplicated(ids)], collapse = ", "))
    )
  }
})

# ---- 3. Required fields ------------------------------------------------------

test_that("every model has non-empty id and type strings", {
  flat <- .flatten_models()

  for (item in flat) {
    p <- item$provider
    m <- item$model

    expect_true(
      is.character(m$id) && length(m$id) == 1 && nzchar(m$id),
      info = sprintf("Provider '%s' model missing valid 'id'", p)
    )
    expect_true(
      is.character(m$type) && length(m$type) == 1 && nzchar(m$type),
      info = sprintf("Provider '%s' model '%s' missing valid 'type'", p, m$id)
    )
  }
})

# ---- 4. Type whitelist -------------------------------------------------------

test_that("model type is one of the allowed values", {
  flat <- .flatten_models()

  for (item in flat) {
    p <- item$provider
    m <- item$model
    expect_true(
      m$type %in% ALLOWED_TYPES,
      info = sprintf(
        "Provider '%s' model '%s' has invalid type '%s'",
        p, m$id, m$type
      )
    )
  }
})

# ---- 5. Capabilities schema --------------------------------------------------

test_that("capabilities object has only known boolean keys", {
  flat <- .flatten_models()

  for (item in flat) {
    p <- item$provider
    m <- item$model
    caps <- m$capabilities

    if (is.null(caps)) {
      next
    }

    expect_true(
      is.list(caps),
      info = sprintf(
        "Provider '%s' model '%s' capabilities should be a list/object",
        p, m$id
      )
    )

    for (key in names(caps)) {
      expect_true(
        key %in% KNOWN_CAPABILITY_KEYS,
        info = sprintf(
          "Provider '%s' model '%s' has unknown capability key '%s'",
          p, m$id, key
        )
      )

      val <- caps[[key]]
      expect_true(
        is.logical(val) && length(val) == 1 && !is.na(val),
        info = sprintf(
          "Provider '%s' model '%s' capability '%s' should be boolean (not NULL/string/NA)",
          p, m$id, key
        )
      )
    }
  }
})

# ---- 6. Token validation -----------------------------------------------------

test_that("context token fields are valid positive integers when present", {
  flat <- .flatten_models()

  for (item in flat) {
    p <- item$provider
    m <- item$model
    ctx <- m$context

    if (is.null(ctx)) {
      next
    }

    for (field in c("context_window", "max_input_tokens", "max_output_tokens")) {
      val <- ctx[[field]]
      if (is.null(val)) {
        next
      }

      expect_true(
        is.numeric(val) && length(val) == 1 && !is.na(val) && val > 0,
        info = sprintf(
          "Provider '%s' model '%s' %s must be a positive integer (or absent)",
          p, m$id, field
        )
      )
    }

    cw <- ctx$context_window
    mo <- ctx$max_output_tokens
    if (!is.null(cw) && !is.null(mo)) {
      expect_true(
        as.numeric(mo) <= as.numeric(cw),
        info = sprintf(
          "Provider '%s' model '%s' max_output_tokens (%s) should not exceed context_window (%s)",
          p, m$id, mo, cw
        )
      )
    }
  }
})

test_that("OpenAI model token limits match documented current values", {
  models <- .all_models()[["openai"]]
  by_id <- setNames(models, vapply(models, function(m) m$id, character(1)))

  expect_equal(by_id[["gpt-5.5"]]$context$context_window, 1050000)
  expect_equal(by_id[["gpt-5.5"]]$context$max_output_tokens, 128000)

  expect_equal(by_id[["gpt-5.4-mini"]]$context$context_window, 400000)
  expect_equal(by_id[["gpt-5.4-mini"]]$context$max_output_tokens, 128000)

  expect_equal(by_id[["gpt-5-mini"]]$context$context_window, 400000)
  expect_equal(by_id[["gpt-5-mini"]]$context$max_output_tokens, 128000)

  expect_equal(by_id[["gpt-4.1"]]$context$context_window, 1047576)
  expect_equal(by_id[["gpt-4.1"]]$context$max_output_tokens, 32768)
})

test_that("Gemini model token limits match documented current values", {
  models <- .all_models()[["gemini"]]
  by_id <- setNames(models, vapply(models, function(m) m$id, character(1)))

  expect_null(by_id[["gemini-3-pro"]])
  expect_null(by_id[["gemini-3.1-pro-preview"]])
  expect_null(by_id[["gemini-3.1-flash-lite-preview"]])

  expect_equal(by_id[["gemini-3-pro-preview"]]$context$context_window, 1048576)
  expect_equal(by_id[["gemini-3-pro-preview"]]$context$max_output_tokens, 65536)

  expect_equal(by_id[["gemini-3-flash-preview"]]$context$context_window, 1048576)
  expect_equal(by_id[["gemini-3-flash-preview"]]$context$max_output_tokens, 65536)

  expect_equal(by_id[["gemini-2.5-flash"]]$context$context_window, 1048576)
  expect_equal(by_id[["gemini-2.5-flash"]]$context$max_output_tokens, 65536)

  expect_equal(by_id[["gemini-2.0-flash"]]$context$context_window, 1048576)
  expect_equal(by_id[["gemini-2.0-flash"]]$context$max_output_tokens, 8192)
})

# ---- 7. Pricing validation ---------------------------------------------------

test_that("pricing fields are valid when present", {
  flat <- .flatten_models()

  for (item in flat) {
    p <- item$provider
    m <- item$model
    price <- m$pricing

    if (is.null(price)) {
      next
    }

    for (field in c("input", "output")) {
      val <- price[[field]]
      if (is.null(val)) {
        next
      }
      expect_true(
        is.numeric(val) && length(val) == 1 && !is.na(val) && val >= 0,
        info = sprintf(
          "Provider '%s' model '%s' pricing$%s must be non-negative numeric",
          p, m$id, field
        )
      )
    }

    unit <- price$unit
    if (!is.null(unit)) {
      expect_true(
        is.character(unit) && length(unit) == 1 && nzchar(unit) &&
          grepl("tokens", unit, fixed = TRUE),
        info = sprintf(
          "Provider '%s' model '%s' pricing$unit ('%s') must contain 'tokens'",
          p, m$id, unit
        )
      )
    }
  }
})

# ---- 8. Capability consistency -----------------------------------------------

test_that("image_output=TRUE models are not solely embedding or moderation", {
  flat <- .flatten_models()

  for (item in flat) {
    p <- item$provider
    m <- item$model
    caps <- m$capabilities %||% list()

    if (isTRUE(caps$image_output)) {
      expect_false(
        m$type %in% c("embedding", "moderation"),
        info = sprintf(
          "Provider '%s' model '%s' has image_output=TRUE but type='%s'",
          p, m$id, m$type
        )
      )
    }
  }
})

test_that("image_edit=TRUE implies image_output=TRUE", {
  flat <- .flatten_models()

  for (item in flat) {
    p <- item$provider
    m <- item$model
    caps <- m$capabilities %||% list()

    if (isTRUE(caps$image_edit)) {
      expect_true(
        isTRUE(caps$image_output),
        info = sprintf(
          "Provider '%s' model '%s' has image_edit=TRUE but image_output=FALSE",
          p, m$id
        )
      )
    }
  }
})

# ---- 9. list_models() integration --------------------------------------------

test_that("list_models() returns a data.frame without error", {
  df <- list_models()
  expect_true(is.data.frame(df))
  expect_gt(nrow(df), 0)
})

test_that("list_models() includes known provider files", {
  df <- list_models()
  known_providers <- c("deepseek", "stepfun", "volcengine")
  present_providers <- unique(df$provider)

  for (kp in known_providers) {
    expect_true(
      kp %in% present_providers,
      info = sprintf("Provider '%s' missing from list_models() output", kp)
    )
  }
})

test_that("list_models() returns expected columns", {
  df <- list_models()
  expected <- c(
    "provider", "id", "type", "family", "description",
    "reasoning", "vision_input", "image_output", "image_edit",
    "audio_input", "audio_output", "function_call", "structured_output",
    "web_search", "context_window", "max_output", "input_price", "output_price"
  )
  for (col in expected) {
    expect_true(
      col %in% names(df),
      info = sprintf("Expected column '%s' missing from list_models()", col)
    )
  }
})

test_that("list_models() has no NA in provider or id columns", {
  df <- list_models()
  expect_false(any(is.na(df$provider)),
    info = "list_models()$provider contains NA values"
  )
  expect_false(any(is.na(df$id)),
    info = "list_models()$id contains NA values"
  )
})

# ---- 10. get_model_info() integration ----------------------------------------

test_that("get_model_info returns a list for an existing model", {
  info <- get_model_info("deepseek", "deepseek-v4-flash")
  expect_true(is.list(info))
  expect_equal(info$id, "deepseek-v4-flash")
})

test_that("get_model_info returns NULL for nonexistent provider or model", {
  expect_null(get_model_info("nonexistent", "foo"))
  expect_null(get_model_info("deepseek", "nonexistent-model-id"))
})

# ---- 11. Backward compatibility ----------------------------------------------

test_that("no JSON file contains the old 'vision' capability key at top level", {
  files <- .json_files()

  for (f in files) {
    raw <- readLines(f, warn = FALSE)
    text <- paste(raw, collapse = "\n")
    # Match the exact key '"vision":' but not '"vision_input":' etc.
    has_legacy <- grepl('"vision"\\s*:', text)
    expect_false(
      has_legacy,
      info = sprintf(
        "File '%s' still contains legacy 'vision' key; migrate to 'vision_input'",
        basename(f)
      )
    )
  }
})

test_that("list_models() uses vision_input instead of legacy vision", {
  df <- list_models()
  expect_true("vision_input" %in% names(df))
  expect_type(df$vision_input, "logical")
  # Legacy 'vision' column should no longer exist
  expect_false("vision" %in% names(df))
})