From bba341e451dc377ddee204c6c0a03f52a338afbe Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 10:38:30 -0500 Subject: [PATCH 01/25] introduce catalog interchange model --- R/catalog.R | 1006 ++++++++++++++++++++++++++++++ R/data-source.R | 4 +- R/definitions.R | 15 + tests/testthat/_snaps/catalog.md | 16 + tests/testthat/test-catalog.R | 158 +++++ 5 files changed, 1198 insertions(+), 1 deletion(-) create mode 100644 R/catalog.R create mode 100644 tests/testthat/_snaps/catalog.md create mode 100644 tests/testthat/test-catalog.R diff --git a/R/catalog.R b/R/catalog.R new file mode 100644 index 0000000..a9070ef --- /dev/null +++ b/R/catalog.R @@ -0,0 +1,1006 @@ +catalog_from_data_dictionary <- function( + dictionary, + source_id = "source:data_dictionary", + call = rlang::caller_env() +) { + dictionary <- as_data_dictionary(dictionary, call = call) + if (is.null(dictionary)) { + return(new_commons_catalog()) + } + + provenance <- new_catalog_provenance("authored", source_id) + source <- new_catalog_source( + id = source_id, + kind = "data_dictionary", + label = dictionary$name, + description = dictionary$description, + details = dictionary$details, + provenance = provenance, + extensions = list(data_dictionary = list( + name = dictionary$name, + description = dictionary$description, + details = dictionary$details + )) + ) + + relations <- lapply( + names(dictionary$tables), + function(name) { + catalog_relation_from_dictionary( + name, + dictionary$tables[[name]], + source_id, + provenance + ) + } + ) + names(relations) <- vapply(relations, `[[`, character(1), "id") + + model_id <- catalog_id("model", source_id, dictionary$name %||% "dictionary") + model <- new_catalog_model( + id = model_id, + source_id = source_id, + name = dictionary$name %||% "dictionary", + description = dictionary$description, + details = dictionary$details, + datasets = names(relations), + relationships = dictionary$relationships, + provenance = provenance, + extensions = list(data_dictionary = list( + relationships = dictionary$relationships + )) + ) + + definitions <- unlist( + lapply(relations, function(relation) { + table <- dictionary$tables[[relation$name]] + lapply( + names(table$definitions), + function(name) { + catalog_definition_from_dictionary( + name, + table$definitions[[name]], + model_id, + relation$id, + provenance + ) + } + ) + }), + recursive = FALSE + ) + if (length(definitions)) { + names(definitions) <- vapply(definitions, `[[`, character(1), "id") + } + + terms <- lapply( + names(dictionary$glossary), + function(name) { + new_catalog_term( + id = catalog_id("term", source_id, name), + source_id = source_id, + name = name, + description = dictionary$glossary[[name]], + provenance = provenance + ) + } + ) + names(terms) <- vapply(terms, `[[`, character(1), "id") + + context <- catalog_context_from_dictionary( + dictionary, + source, + relations, + terms, + provenance + ) + + new_commons_catalog( + sources = list(source), + relations = relations, + models = list(model), + definitions = definitions, + terms = terms, + context = context, + call = call + ) +} + +catalog_to_data_dictionary <- function(catalog, call = rlang::caller_env()) { + validate_commons_catalog(catalog, call = call) + if (length(catalog$sources) == 0) { + return(NULL) + } + + source <- catalog$sources[[1]] + relations <- catalog$relations + table_names <- vapply(relations, `[[`, character(1), "name") + duplicated_names <- unique(table_names[duplicated(table_names)]) + if (length(duplicated_names)) { + cli::cli_abort( + "Catalog relations cannot be projected to a data dictionary because table names are ambiguous: {.val {duplicated_names}}.", + call = call + ) + } + + tables <- lapply( + relations, + catalog_relation_to_dictionary, + definitions = catalog$definitions + ) + names(tables) <- table_names + + relationships <- unlist( + lapply(catalog$models, `[[`, "relationships"), + use.names = FALSE, + recursive = FALSE + ) + glossary <- list() + if (length(catalog$terms)) { + glossary <- vapply( + catalog$terms, + function(term) term$description %||% "", + character(1) + ) + names(glossary) <- vapply(catalog$terms, `[[`, character(1), "name") + } + + new_data_dictionary( + list( + name = source$label, + description = source$description, + details = source$details, + tables = tables, + relationships = relationships, + glossary = glossary + ), + call = call + ) +} + +catalog_definition_registry <- function( + catalog, + source = "", + call = rlang::caller_env() +) { + validate_commons_catalog(catalog, call = call) + rows <- list(no_definitions) + for (definition in catalog$definitions) { + relation <- catalog$relations[[definition$relation_id]] + expression <- catalog_primary_expression(definition$expressions) + rows[[length(rows) + 1]] <- data.frame( + name = definition$name, + table = relation$name, + source = source, + type = definition$logical_type %||% NA_character_, + role = definition$role, + label = definition$label %||% NA_character_, + description = definition$description %||% NA_character_, + details = definition$details %||% NA_character_, + expr = expression$sql, + expanded = expression$sql + ) + } + list(defs = do.call(rbind, rows)) +} + +catalog_context_chunks <- function(catalog, call = rlang::caller_env()) { + validate_commons_catalog(catalog, call = call) + records <- Filter( + function(record) identical(record$delivery, "retrieval"), + catalog$context + ) + unique(vapply(records, `[[`, character(1), "text")) +} + +catalog_calculation_registry <- function(catalog, call = rlang::caller_env()) { + validate_commons_catalog(catalog, call = call) + catalog$calculations +} + +new_commons_catalog <- function( + sources = list(), + relations = list(), + models = list(), + definitions = list(), + calculations = list(), + terms = list(), + context = list(), + diagnostics = list(), + provider = NULL, + call = rlang::caller_env() +) { + catalog <- structure( + list( + sources = catalog_records(sources, "commons_catalog_source", "source", call), + relations = catalog_records( + relations, + "commons_catalog_relation", + "relation", + call + ), + models = catalog_records(models, "commons_catalog_model", "model", call), + definitions = catalog_records( + definitions, + "commons_catalog_definition", + "definition", + call + ), + calculations = catalog_records( + calculations, + "commons_catalog_calculation", + "calculation", + call + ), + terms = catalog_records(terms, "commons_catalog_term", "term", call), + context = catalog_records(context, "commons_catalog_context", "context", call), + diagnostics = catalog_diagnostics(diagnostics, call), + provider = provider + ), + class = "commons_catalog" + ) + validate_commons_catalog(catalog, call = call) + catalog +} + +validate_commons_catalog <- function(catalog, call = rlang::caller_env()) { + if (!inherits(catalog, "commons_catalog")) { + cli::cli_abort("{.arg catalog} must be a commons catalog.", call = call) + } + + source_ids <- names(catalog$sources) + relation_ids <- names(catalog$relations) + model_ids <- names(catalog$models) + entity_ids <- c( + source_ids, + relation_ids, + model_ids, + names(catalog$definitions), + names(catalog$calculations), + names(catalog$terms), + names(catalog$context) + ) + + validate_catalog_references(catalog$relations, "source_id", source_ids, call) + validate_catalog_references(catalog$models, "source_id", source_ids, call) + validate_catalog_references(catalog$terms, "source_id", source_ids, call) + validate_catalog_references(catalog$context, "source_id", source_ids, call) + validate_catalog_references(catalog$calculations, "source_id", source_ids, call) + validate_catalog_references(catalog$definitions, "model_id", model_ids, call) + validate_catalog_references( + catalog$definitions, + "relation_id", + relation_ids, + call + ) + + for (model in catalog$models) { + for (field in c("datasets", "exposed", "dependencies")) { + unknown <- setdiff(model[[field]], relation_ids) + if (length(unknown)) { + catalog_reference_error(model$id, field, unknown, call) + } + } + } + for (definition in catalog$definitions) { + unknown <- setdiff(definition$dependencies, entity_ids) + if (length(unknown)) { + catalog_reference_error(definition$id, "dependencies", unknown, call) + } + } + for (record in catalog$context) { + unknown <- setdiff(record$scope, entity_ids) + if (length(unknown)) { + catalog_reference_error(record$id, "scope", unknown, call) + } + } + for (calculation in catalog$calculations) { + unknown <- setdiff(calculation$dependencies, entity_ids) + if (length(unknown)) { + catalog_reference_error(calculation$id, "dependencies", unknown, call) + } + } + + invisible(catalog) +} + +new_source_path <- function( + components, + roles = names(components), + call = rlang::caller_env() +) { + if (inherits(components, "Id")) { + components <- components@name + roles <- names(components) + } + if (!is.character(components) || length(components) == 0) { + cli::cli_abort("A source path needs character components.", call = call) + } + if (is.null(roles) || !is.character(roles) || length(roles) != length(components)) { + cli::cli_abort("A source path needs one role per component.", call = call) + } + if (anyNA(components) || any(!nzchar(components)) || anyNA(roles) || any(!nzchar(roles))) { + cli::cli_abort("Source path components and roles must not be empty.", call = call) + } + if (anyDuplicated(roles)) { + cli::cli_abort("Source path roles must be unique.", call = call) + } + structure( + list(components = unname(components), roles = unname(roles)), + class = "commons_source_path" + ) +} + +new_catalog_source <- function( + id, + kind, + dialect = NULL, + label = NULL, + description = NULL, + details = NULL, + locator = list(), + selection = list(), + principal = NULL, + role = NULL, + namespace = NULL, + identifier_case = c("preserve", "upper", "lower"), + sample_rows = 0L, + version = NULL, + provenance = new_catalog_provenance("unknown", id), + extensions = list() +) { + identifier_case <- rlang::arg_match(identifier_case) + structure( + list( + id = catalog_string(id, "source id"), + kind = catalog_string(kind, "source kind"), + dialect = dialect, + label = prose_field(label), + description = prose_field(description), + details = prose_field(details), + locator = locator, + selection = selection, + principal = principal, + role = role, + namespace = namespace, + identifier_case = identifier_case, + sample_rows = catalog_count(sample_rows, "sample_rows"), + version = version, + provenance = provenance, + extensions = extensions + ), + class = "commons_catalog_source" + ) +} + +new_catalog_relation <- function( + id, + source_id, + path, + kind = "table", + name = utils::tail(path$components, 1), + label = NULL, + description = NULL, + details = NULL, + aliases = character(), + tags = character(), + synonyms = character(), + columns = list(), + constraints = list(), + access = new_catalog_access(), + version = NULL, + provenance = new_catalog_provenance("unknown", source_id), + field_provenance = list(), + extensions = list() +) { + if (!inherits(path, "commons_source_path")) { + cli::cli_abort("A catalog relation needs a source path.") + } + columns <- catalog_columns(columns) + structure( + list( + id = catalog_string(id, "relation id"), + source_id = catalog_string(source_id, "relation source id"), + path = path, + kind = catalog_string(kind, "relation kind"), + name = catalog_string(name, "relation name"), + label = prose_field(label), + description = prose_field(description), + details = prose_field(details), + aliases = catalog_character(aliases), + tags = catalog_character(tags), + synonyms = catalog_character(synonyms), + columns = columns, + constraints = constraints, + access = access, + version = version, + provenance = provenance, + field_provenance = field_provenance, + extensions = extensions + ), + class = "commons_catalog_relation" + ) +} + +new_catalog_column <- function( + name, + native_type = NULL, + logical_type = NULL, + nullable = NULL, + description = NULL, + details = NULL, + units = NULL, + values = NULL, + range = NULL, + examples = NULL, + restrictions = character(), + tags = character(), + provenance = NULL, + field_provenance = list(), + extensions = list() +) { + structure( + list( + name = catalog_string(name, "column name"), + native_type = native_type, + logical_type = logical_type, + nullable = nullable, + description = prose_field(description), + details = prose_field(details), + units = units, + values = values, + range = range, + examples = examples, + restrictions = catalog_character(restrictions), + tags = catalog_character(tags), + provenance = provenance, + field_provenance = field_provenance, + extensions = extensions + ), + class = "commons_catalog_column" + ) +} + +new_catalog_model <- function( + id, + source_id, + name, + label = NULL, + description = NULL, + details = NULL, + datasets = character(), + relationships = list(), + execution = NULL, + exposed = datasets, + dependencies = datasets, + access = new_catalog_access(), + version = NULL, + fingerprint = NULL, + provenance = new_catalog_provenance("unknown", source_id), + extensions = list() +) { + structure( + list( + id = catalog_string(id, "model id"), + source_id = catalog_string(source_id, "model source id"), + name = catalog_string(name, "model name"), + label = prose_field(label), + description = prose_field(description), + details = prose_field(details), + datasets = catalog_character(datasets), + relationships = relationships, + execution = execution, + exposed = catalog_character(exposed), + dependencies = catalog_character(dependencies), + access = access, + version = version, + fingerprint = fingerprint, + provenance = provenance, + extensions = extensions + ), + class = "commons_catalog_model" + ) +} + +new_catalog_definition <- function( + id, + model_id, + relation_id, + role, + name, + label = NULL, + description = NULL, + details = NULL, + synonyms = character(), + logical_type = NULL, + aggregation = NULL, + expressions = list(), + dependencies = character(), + visibility = c("public", "private"), + native = list(), + provenance = NULL, + extensions = list() +) { + visibility <- rlang::arg_match(visibility) + expressions <- catalog_expressions(expressions) + structure( + list( + id = catalog_string(id, "definition id"), + model_id = catalog_string(model_id, "definition model id"), + relation_id = catalog_string(relation_id, "definition relation id"), + role = catalog_string(role, "definition role"), + name = catalog_string(name, "definition name"), + label = prose_field(label), + description = prose_field(description), + details = prose_field(details), + synonyms = catalog_character(synonyms), + logical_type = logical_type, + aggregation = aggregation, + expressions = expressions, + dependencies = catalog_character(dependencies), + visibility = visibility, + native = native, + provenance = provenance, + extensions = extensions + ), + class = "commons_catalog_definition" + ) +} + +new_catalog_expression <- function(dialect, sql, native = list()) { + structure( + list( + dialect = catalog_string(dialect, "expression dialect"), + sql = catalog_string(sql, "expression SQL"), + native = native + ), + class = "commons_catalog_expression" + ) +} + +new_catalog_calculation <- function( + id, + source_id, + name, + description = NULL, + arguments = list(), + dependencies = character(), + execution, + provenance = NULL, + extensions = list() +) { + structure( + list( + id = catalog_string(id, "calculation id"), + source_id = catalog_string(source_id, "calculation source id"), + name = catalog_string(name, "calculation name"), + description = prose_field(description), + arguments = arguments, + dependencies = catalog_character(dependencies), + execution = execution, + provenance = provenance, + extensions = extensions + ), + class = "commons_catalog_calculation" + ) +} + +new_catalog_term <- function( + id, + source_id, + name, + description, + synonyms = character(), + provenance = NULL, + extensions = list() +) { + structure( + list( + id = catalog_string(id, "term id"), + source_id = catalog_string(source_id, "term source id"), + name = catalog_string(name, "term name"), + description = prose_field(description), + synonyms = catalog_character(synonyms), + provenance = provenance, + extensions = extensions + ), + class = "commons_catalog_term" + ) +} + +new_catalog_context <- function( + id, + source_id, + kind, + text, + scope = character(), + delivery = c("ambient", "first_touch", "retrieval", "evaluation"), + authority = list(kind = "unknown"), + provenance = NULL, + extensions = list() +) { + delivery <- rlang::arg_match(delivery) + structure( + list( + id = catalog_string(id, "context id"), + source_id = catalog_string(source_id, "context source id"), + kind = catalog_string(kind, "context kind"), + text = catalog_string(text, "context text"), + scope = catalog_character(scope), + delivery = delivery, + authority = authority, + provenance = provenance, + extensions = extensions + ), + class = "commons_catalog_context" + ) +} + +new_catalog_access <- function( + state = c("unknown", "queryable", "visible_only"), + evidence = NULL +) { + state <- rlang::arg_match(state) + structure(list(state = state, evidence = evidence), class = "commons_catalog_access") +} + +new_catalog_provenance <- function( + kind = c("unknown", "authored", "certified", "discovered", "inferred"), + source_id, + locator = NULL, + harvested_at = NULL +) { + kind <- rlang::arg_match(kind) + structure( + list( + kind = kind, + source_id = source_id, + locator = locator, + harvested_at = harvested_at + ), + class = "commons_catalog_provenance" + ) +} + +new_catalog_diagnostic <- function( + code, + message, + severity = c("warning", "error", "info"), + entity_id = NULL, + details = list() +) { + severity <- rlang::arg_match(severity) + structure( + list( + code = catalog_string(code, "diagnostic code"), + message = catalog_string(message, "diagnostic message"), + severity = severity, + entity_id = entity_id, + details = details + ), + class = "commons_catalog_diagnostic" + ) +} + +catalog_relation_from_dictionary <- function( + name, + table, + source_id, + provenance +) { + columns <- lapply( + names(table$columns), + function(column_name) { + column <- table$columns[[column_name]] + new_catalog_column( + name = column_name, + native_type = column$type, + logical_type = column$type, + description = column$description, + details = column$details, + units = column$units, + values = column$values, + range = column$range, + examples = column$examples, + restrictions = unlist(column$constraints), + provenance = provenance, + extensions = list(data_dictionary = column) + ) + } + ) + names(columns) <- names(table$columns) + + new_catalog_relation( + id = catalog_id("relation", source_id, name), + source_id = source_id, + path = new_source_path(c(table = name)), + name = name, + label = table$label, + description = table$description, + details = table$details, + columns = columns, + access = new_catalog_access("unknown", "authored dictionary"), + provenance = provenance, + extensions = list(data_dictionary = table) + ) +} + +catalog_definition_from_dictionary <- function( + name, + definition, + model_id, + relation_id, + provenance +) { + new_catalog_definition( + id = catalog_id("definition", relation_id, name), + model_id = model_id, + relation_id = relation_id, + role = definition$role, + name = name, + label = definition$label, + description = definition$description, + details = definition$details, + logical_type = definition$type, + expressions = list(new_catalog_expression( + "data_dictionary", + definition$expanded + )), + native = definition, + provenance = provenance, + extensions = list(data_dictionary = definition) + ) +} + +catalog_context_from_dictionary <- function( + dictionary, + source, + relations, + terms, + provenance +) { + records <- list() + add <- function(record) { + records[[record$id]] <<- record + } + for (field in c("description", "details")) { + text <- source[[field]] + if (is.null(text) || !nzchar(text)) { + next + } + for (delivery in c("ambient", "retrieval")) { + add(new_catalog_context( + id = catalog_id("context", source$id, field, delivery), + source_id = source$id, + kind = paste0("dataset_", field), + text = text, + scope = source$id, + delivery = delivery, + authority = list(kind = "authored"), + provenance = provenance + )) + } + } + for (relation in relations) { + text <- paste(c(relation$description, relation$details), collapse = "\n\n") + if (!nzchar(text)) { + next + } + for (delivery in c("first_touch", "retrieval")) { + add(new_catalog_context( + id = catalog_id("context", relation$id, delivery), + source_id = source$id, + kind = "relation_prose", + text = sprintf("Table `%s`: %s", relation$name, text), + scope = relation$id, + delivery = delivery, + authority = list(kind = "authored"), + provenance = provenance + )) + } + } + for (term in terms) { + text <- sprintf("%s: %s", term$name, term$description) + for (delivery in c("ambient", "retrieval")) { + add(new_catalog_context( + id = catalog_id("context", term$id, delivery), + source_id = source$id, + kind = "glossary_term", + text = text, + scope = term$id, + delivery = delivery, + authority = list(kind = "authored"), + provenance = provenance + )) + } + } + records +} + +catalog_relation_to_dictionary <- function(relation, definitions) { + entry <- relation$extensions$data_dictionary %||% list() + entry$label <- relation$label + entry$description <- relation$description + entry$details <- relation$details + entry$columns <- lapply(relation$columns, catalog_column_to_dictionary) + + relation_definitions <- Filter( + function(definition) identical(definition$relation_id, relation$id), + definitions + ) + entry$definitions <- lapply( + relation_definitions, + catalog_definition_to_dictionary + ) + names(entry$definitions) <- vapply( + relation_definitions, + `[[`, + character(1), + "name" + ) + catalog_compact(entry) +} + +catalog_column_to_dictionary <- function(column) { + out <- column$extensions$data_dictionary %||% list() + out$type <- column$logical_type %||% column$native_type + out$description <- column$description + out$details <- column$details + out$units <- column$units + out$values <- column$values + out$range <- column$range + out$examples <- column$examples + out$constraints <- if (length(column$restrictions)) column$restrictions + catalog_compact(out) +} + +catalog_definition_to_dictionary <- function(definition) { + out <- definition$extensions$data_dictionary %||% definition$native + expression <- catalog_primary_expression(definition$expressions) + out$expr <- definition$native$expr %||% expression$sql + out$type <- definition$logical_type + out$label <- definition$label + out$description <- definition$description + out$details <- definition$details + out$expanded <- NULL + out$role <- NULL + catalog_compact(out) +} + +catalog_primary_expression <- function(expressions) { + if (length(expressions) == 0) { + cli::cli_abort("A projected definition has no expression.") + } + expressions[[1]] +} + +catalog_records <- function(records, class, what, call) { + if (length(records) == 0) { + return(list()) + } + if (inherits(records, class)) { + records <- list(records) + } + valid <- vapply(records, inherits, logical(1), class) + if (!all(valid)) { + cli::cli_abort( + "Every catalog {what} must inherit from {.cls {class}}.", + call = call + ) + } + ids <- vapply(records, `[[`, character(1), "id") + duplicated_ids <- unique(ids[duplicated(ids)]) + if (length(duplicated_ids)) { + cli::cli_abort( + "Catalog {what} IDs must be unique: {.val {duplicated_ids}}.", + call = call + ) + } + names(records) <- ids + records +} + +catalog_columns <- function(columns) { + if (length(columns) == 0) { + return(list()) + } + valid <- vapply(columns, inherits, logical(1), "commons_catalog_column") + if (!all(valid)) { + cli::cli_abort("Every relation column must be a catalog column.") + } + names(columns) <- vapply(columns, `[[`, character(1), "name") + if (anyDuplicated(names(columns))) { + cli::cli_abort("Column names must be unique within a relation.") + } + columns +} + +catalog_expressions <- function(expressions) { + if (length(expressions) == 0) { + return(list()) + } + valid <- vapply( + expressions, + inherits, + logical(1), + "commons_catalog_expression" + ) + if (!all(valid)) { + cli::cli_abort("Every definition expression must be a catalog expression.") + } + expressions +} + +catalog_diagnostics <- function(diagnostics, call) { + if (length(diagnostics) == 0) { + return(list()) + } + valid <- vapply( + diagnostics, + inherits, + logical(1), + "commons_catalog_diagnostic" + ) + if (!all(valid)) { + cli::cli_abort( + "Every catalog diagnostic must be a catalog diagnostic.", + call = call + ) + } + diagnostics +} + +validate_catalog_references <- function(records, field, valid, call) { + for (record in records) { + value <- record[[field]] + if (!value %in% valid) { + catalog_reference_error(record$id, field, value, call) + } + } +} + +catalog_reference_error <- function(id, field, unknown, call) { + cli::cli_abort( + "Catalog entity {.val {id}} has unknown {.field {field}} reference{?s}: {.val {unknown}}.", + call = call + ) +} + +catalog_string <- function(x, what) { + if (!rlang::is_string(x) || !nzchar(x)) { + cli::cli_abort("A catalog {what} must be one non-empty string.") + } + x +} + +catalog_character <- function(x) { + if (is.null(x)) { + return(character()) + } + if (!is.character(x) || anyNA(x)) { + cli::cli_abort("Catalog string collections must be character vectors without missing values.") + } + unique(x[nzchar(x)]) +} + +catalog_count <- function(x, what) { + if (!is.numeric(x) || length(x) != 1 || is.na(x) || x < 0 || x != as.integer(x)) { + cli::cli_abort("Catalog {what} must be one non-negative integer.") + } + as.integer(x) +} + +catalog_id <- function(kind, ...) { + components <- c(kind, unlist(list(...), use.names = FALSE)) + encoded <- vapply( + as.character(components), + utils::URLencode, + character(1), + reserved = TRUE + ) + paste(encoded, collapse = ":") +} + +catalog_compact <- function(x) { + x[!vapply(x, is.null, logical(1))] +} diff --git a/R/data-source.R b/R/data-source.R index b49a272..a29b547 100644 --- a/R/data-source.R +++ b/R/data-source.R @@ -241,7 +241,8 @@ new_data_source <- function( owned, table_ids = table_ids_from_labels(tables), dictionary = NULL, - pending = NULL + pending = NULL, + catalog = catalog_from_data_dictionary(dictionary) ) { # Disconnect only the DuckDB connection we created; a user-supplied connection # has its own owner and lifetime. @@ -263,6 +264,7 @@ new_data_source <- function( table_ids = table_ids, handle = handle, dictionary = dictionary, + catalog = catalog, pending = pending ), class = "commons_data_source" diff --git a/R/definitions.R b/R/definitions.R index f91986b..be61862 100644 --- a/R/definitions.R +++ b/R/definitions.R @@ -174,6 +174,21 @@ definitions_registry <- function(sources, call = rlang::caller_env()) { labels <- rlang::names2(sources) for (i in seq_along(sources)) { source <- sources[[i]] + if (inherits(source$catalog, "commons_catalog")) { + registry <- catalog_definition_registry(source$catalog, labels[[i]], call) + tables <- unique(registry$defs$table) + unknown <- setdiff(tables, source$tables) + if (length(unknown)) { + cli::cli_abort( + "The data dictionary declares definitions on table{?s} {.val {unknown}}, which the data source does not expose.", + call = call + ) + } + if (nrow(registry$defs)) { + rows[[length(rows) + 1]] <- registry$defs + } + next + } for (table in names(source$dictionary$tables)) { definitions <- source$dictionary$tables[[table]]$definitions if (length(definitions) == 0) { diff --git a/tests/testthat/_snaps/catalog.md b/tests/testthat/_snaps/catalog.md new file mode 100644 index 0000000..9fb0e2c --- /dev/null +++ b/tests/testthat/_snaps/catalog.md @@ -0,0 +1,16 @@ +# catalog validation rejects dangling references + + Code + new_commons_catalog(sources = list(source), relations = list(relation)) + Condition + Error: + ! Catalog entity "relation:test" has unknown source_id reference: "source:missing". + +# dictionary projection rejects ambiguous table names + + Code + catalog_to_data_dictionary(catalog) + Condition + Error: + ! Catalog relations cannot be projected to a data dictionary because table names are ambiguous: "orders". + diff --git a/tests/testthat/test-catalog.R b/tests/testthat/test-catalog.R new file mode 100644 index 0000000..dd94376 --- /dev/null +++ b/tests/testthat/test-catalog.R @@ -0,0 +1,158 @@ +test_that("data dictionaries round-trip through commons catalogs", { + dictionary <- new_data_dictionary(list( + name = "Sales", + description = "Commercial data.", + details = "Revenue excludes tax.", + tables = list(list( + name = "orders", + label = "Orders", + description = "One row per order.", + columns = list( + list(name = "id", type = "integer", description = "Order ID."), + list( + name = "amount", + type = "number", + units = "USD", + examples = c(10, 20), + constraints = "non-negative" + ) + ), + definitions = list(list( + name = "revenue", + expr = "SUM(amount)", + type = "number", + description = "Gross revenue." + )) + )), + relationships = list(list( + join = "orders.customer_id = customers.id", + cardinality = "many-to-one" + )), + glossary = list(revenue = "Money earned before refunds.") + )) + + catalog <- catalog_from_data_dictionary(dictionary) + + expect_s3_class(catalog, "commons_catalog") + expect_length(catalog$sources, 1) + expect_length(catalog$relations, 1) + expect_length(catalog$models, 1) + expect_length(catalog$definitions, 1) + expect_length(catalog$terms, 1) + expect_identical(catalog_to_data_dictionary(catalog), dictionary) +}) + +test_that("data dictionary catalogs project to existing runtime surfaces", { + dictionary <- new_data_dictionary(list( + details = "Use booked revenue.", + tables = list(orders = list( + description = "One row per order.", + columns = list(amount = list(type = "number")), + definitions = list(revenue = list( + expr = "SUM(amount)", + type = "number" + )) + )), + glossary = list(booked = "An order with a signed contract.") + )) + catalog <- catalog_from_data_dictionary(dictionary) + + registry <- catalog_definition_registry(catalog, "warehouse") + expect_equal(registry$defs$name, "revenue") + expect_equal(registry$defs$table, "orders") + expect_equal(registry$defs$source, "warehouse") + expect_equal(registry$defs$role, "metric") + expect_equal(registry$defs$expanded, "SUM(amount)") + + expect_setequal( + catalog_context_chunks(catalog), + c( + "Use booked revenue.", + "Table `orders`: One row per order.", + "booked: An order with a signed contract." + ) + ) + expect_length(catalog_calculation_registry(catalog), 0) +}) + +test_that("catalog constructors retain structured identity and access", { + path <- new_source_path(DBI::Id( + catalog = "ANALYTICS", + schema = "PUBLIC", + table = "ORDERS" + )) + source <- new_catalog_source( + "source:snowflake", + "snowflake", + identifier_case = "upper" + ) + relation <- new_catalog_relation( + "relation:orders", + source$id, + path, + access = new_catalog_access("visible_only", "REFERENCES") + ) + catalog <- new_commons_catalog(sources = list(source), relations = list(relation)) + + expect_identical(relation$path$roles, c("catalog", "schema", "table")) + expect_identical( + relation$path$components, + c("ANALYTICS", "PUBLIC", "ORDERS") + ) + expect_equal(relation$access$state, "visible_only") + expect_silent(validate_commons_catalog(catalog)) +}) + +test_that("catalog validation rejects dangling references", { + source <- new_catalog_source("source:test", "test") + relation <- new_catalog_relation( + "relation:test", + "source:missing", + new_source_path(c(table = "test")) + ) + + expect_snapshot( + new_commons_catalog(sources = list(source), relations = list(relation)), + error = TRUE + ) +}) + +test_that("dictionary projection rejects ambiguous table names", { + source <- new_catalog_source("source:test", "test") + relations <- list( + new_catalog_relation( + "relation:a", + source$id, + new_source_path(c(schema = "a", table = "orders")), + name = "orders" + ), + new_catalog_relation( + "relation:b", + source$id, + new_source_path(c(schema = "b", table = "orders")), + name = "orders" + ) + ) + catalog <- new_commons_catalog(sources = list(source), relations = relations) + + expect_snapshot(catalog_to_data_dictionary(catalog), error = TRUE) +}) + +test_that("data sources carry the dictionary catalog", { + source <- data_source( + sales = data.frame(revenue = 1), + dictionary = local_definitions_dict( + definitions = c( + " - name: total_revenue", + " expr: SUM(revenue)", + " type: number" + ) + ) + ) + + expect_s3_class(source$catalog, "commons_catalog") + expect_equal( + catalog_definition_registry(source$catalog)$defs$name, + "total_revenue" + ) +}) From 003cf0dd3c24bf8e68e755796b960bcbbe428066 Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 10:41:12 -0500 Subject: [PATCH 02/25] reconcile catalog metadata safely --- R/catalog-merge.R | 353 +++++++++++++++++++++++++++++++ R/catalog.R | 217 ++++++++++++++++++- tests/testthat/_snaps/catalog.md | 27 +++ tests/testthat/test-catalog.R | 155 ++++++++++++++ 4 files changed, 748 insertions(+), 4 deletions(-) create mode 100644 R/catalog-merge.R diff --git a/R/catalog-merge.R b/R/catalog-merge.R new file mode 100644 index 0000000..b2bac28 --- /dev/null +++ b/R/catalog-merge.R @@ -0,0 +1,353 @@ +catalog_merge <- function(discovered, authored, call = rlang::caller_env()) { + validate_commons_catalog(discovered, call = call) + validate_commons_catalog(authored, call = call) + + reconciled <- catalog_reconcile_relations(discovered, authored, call) + relation_map <- reconciled$map + authored <- catalog_remap_catalog(authored, relation_map) + retained_authored <- authored$relations[setdiff( + names(authored$relations), + names(relation_map) + )] + + new_commons_catalog( + sources = catalog_combine_records( + discovered$sources, + authored$sources, + "source", + call + ), + relations = catalog_combine_records( + reconciled$relations, + retained_authored, + "relation", + call + ), + models = catalog_combine_records( + discovered$models, + authored$models, + "model", + call + ), + definitions = catalog_combine_records( + discovered$definitions, + authored$definitions, + "definition", + call + ), + calculations = catalog_combine_records( + discovered$calculations, + authored$calculations, + "calculation", + call + ), + terms = catalog_combine_records( + discovered$terms, + authored$terms, + "term", + call + ), + context = catalog_combine_records( + discovered$context, + authored$context, + "context", + call + ), + diagnostics = c(discovered$diagnostics, authored$diagnostics), + provider = discovered$provider %||% authored$provider, + call = call + ) +} + +catalog_reconcile_relations <- function(discovered, authored, call) { + relations <- discovered$relations + relation_map <- character() + claimed <- character() + + for (relation in authored$relations) { + candidates <- catalog_relation_candidates( + relation, + discovered$relations, + discovered$sources + ) + if (length(candidates) == 0) { + next + } + if (length(candidates) > 1) { + paths <- vapply( + discovered$relations[candidates], + catalog_path_label, + character(1) + ) + cli::cli_abort( + "Authored relation {.val {catalog_path_label(relation)}} is ambiguous; it matches {.val {paths}}.", + call = call + ) + } + + candidate_id <- candidates[[1]] + if (candidate_id %in% claimed) { + cli::cli_abort( + "Multiple authored relations match discovered relation {.val {catalog_path_label(discovered$relations[[candidate_id]])}}.", + call = call + ) + } + claimed <- c(claimed, candidate_id) + relation_map[[relation$id]] <- candidate_id + relations[[candidate_id]] <- catalog_merge_relation( + relations[[candidate_id]], + relation, + discovered$sources[[relations[[candidate_id]]$source_id]], + call + ) + } + + list(relations = relations, map = relation_map) +} + +catalog_relation_candidates <- function(authored, discovered, sources) { + if (length(discovered) == 0) { + return(character()) + } + ids <- names(discovered) + matched <- vapply(discovered, function(candidate) { + source <- sources[[candidate$source_id]] + catalog_relation_matches(authored, candidate, source$identifier_case) + }, logical(1)) + ids[matched] +} + +catalog_relation_matches <- function(authored, discovered, identifier_case) { + authored_path <- catalog_normalize_identifiers( + authored$path$components, + identifier_case + ) + discovered_path <- catalog_normalize_identifiers( + discovered$path$components, + identifier_case + ) + + if (length(authored_path) > 1) { + if (length(authored_path) > length(discovered_path)) { + return(FALSE) + } + offset <- length(discovered_path) - length(authored_path) + return(identical(authored_path, discovered_path[seq_along(authored_path) + offset])) + } + + authored_names <- catalog_normalize_identifiers( + c(authored$name, authored$aliases, authored_path), + identifier_case + ) + discovered_name <- utils::tail(discovered_path, 1) + discovered_name %in% authored_names +} + +catalog_normalize_identifiers <- function(x, identifier_case) { + switch( + identifier_case, + upper = toupper(x), + lower = tolower(x), + preserve = x + ) +} + +catalog_merge_relation <- function(discovered, authored, source, call) { + columns <- catalog_merge_columns( + discovered$columns, + authored$columns, + source$identifier_case, + call + ) + scalar_fields <- c("label", "description", "details") + fields <- discovered + for (field in scalar_fields) { + fields[[field]] <- catalog_authored_value(authored[[field]], discovered[[field]]) + } + fields$aliases <- unique(c( + discovered$aliases, + authored$aliases, + if (!identical(discovered$name, authored$name)) authored$name + )) + fields$tags <- unique(c(discovered$tags, authored$tags)) + fields$synonyms <- unique(c(discovered$synonyms, authored$synonyms)) + fields$columns <- columns + fields$constraints <- c(discovered$constraints, authored$constraints) + fields$field_provenance <- catalog_merge_field_provenance( + discovered, + authored, + scalar_fields, + c("aliases", "tags", "synonyms") + ) + fields$extensions <- utils::modifyList( + discovered$extensions, + authored$extensions, + keep.null = TRUE + ) + structure(fields, class = class(discovered)) +} + +catalog_merge_columns <- function(discovered, authored, identifier_case, call) { + out <- discovered + normalized <- catalog_normalize_identifiers(names(discovered), identifier_case) + + for (column in authored) { + name <- catalog_normalize_identifiers(column$name, identifier_case) + candidates <- which(normalized == name) + if (length(candidates) > 1) { + cli::cli_abort( + "Authored column {.val {column$name}} ambiguously matches discovered columns {.val {names(discovered)[candidates]}}.", + call = call + ) + } + if (length(candidates) == 0) { + out[[column$name]] <- column + next + } + discovered_name <- names(discovered)[candidates] + out[[discovered_name]] <- catalog_merge_column( + discovered[[discovered_name]], + column + ) + } + out +} + +catalog_merge_column <- function(discovered, authored) { + fields <- discovered + scalar_fields <- c( + "logical_type", + "description", + "details", + "units", + "values", + "range", + "examples" + ) + for (field in scalar_fields) { + fields[[field]] <- catalog_authored_value(authored[[field]], discovered[[field]]) + } + fields$restrictions <- unique(c(discovered$restrictions, authored$restrictions)) + fields$tags <- unique(c(discovered$tags, authored$tags)) + fields$field_provenance <- catalog_merge_field_provenance( + discovered, + authored, + scalar_fields, + c("restrictions", "tags") + ) + fields$extensions <- utils::modifyList( + discovered$extensions, + authored$extensions, + keep.null = TRUE + ) + structure(fields, class = class(discovered)) +} + +catalog_authored_value <- function(authored, discovered) { + if (is.null(authored) || length(authored) == 0) discovered else authored +} + +catalog_merge_field_provenance <- function( + discovered, + authored, + scalar_fields, + additive_fields +) { + out <- discovered$field_provenance + for (field in scalar_fields) { + if (!is.null(authored[[field]]) && length(authored[[field]])) { + out[[field]] <- authored$field_provenance[[field]] %||% authored$provenance + } + } + for (field in additive_fields) { + out[[field]] <- Filter(Negate(is.null), list( + discovered$field_provenance[[field]] %||% discovered$provenance, + authored$field_provenance[[field]] %||% authored$provenance + )) + } + out +} + +catalog_remap_catalog <- function(catalog, relation_map) { + if (length(relation_map) == 0) { + return(catalog) + } + catalog$models <- lapply(catalog$models, catalog_remap_model, relation_map) + names(catalog$models) <- vapply(catalog$models, `[[`, character(1), "id") + catalog$definitions <- lapply( + catalog$definitions, + catalog_remap_definition, + relation_map + ) + names(catalog$definitions) <- vapply( + catalog$definitions, + `[[`, + character(1), + "id" + ) + catalog$calculations <- lapply( + catalog$calculations, + catalog_remap_dependencies, + relation_map + ) + names(catalog$calculations) <- vapply( + catalog$calculations, + `[[`, + character(1), + "id" + ) + catalog$context <- lapply(catalog$context, catalog_remap_context, relation_map) + names(catalog$context) <- vapply(catalog$context, `[[`, character(1), "id") + catalog +} + +catalog_remap_model <- function(model, relation_map) { + for (field in c("datasets", "exposed", "dependencies")) { + model[[field]] <- catalog_remap_ids(model[[field]], relation_map) + } + model +} + +catalog_remap_definition <- function(definition, relation_map) { + definition$relation_id <- catalog_remap_ids( + definition$relation_id, + relation_map + ) + definition$dependencies <- catalog_remap_ids( + definition$dependencies, + relation_map + ) + definition +} + +catalog_remap_dependencies <- function(record, relation_map) { + record$dependencies <- catalog_remap_ids(record$dependencies, relation_map) + record +} + +catalog_remap_context <- function(context, relation_map) { + context$scope <- catalog_remap_ids(context$scope, relation_map) + context +} + +catalog_remap_ids <- function(ids, relation_map) { + mapped <- unname(relation_map[ids]) + replace <- !is.na(mapped) + ids[replace] <- mapped[replace] + unique(ids) +} + +catalog_combine_records <- function(x, y, what, call) { + collisions <- intersect(names(x), names(y)) + if (length(collisions)) { + cli::cli_abort( + "Discovered and authored catalogs have conflicting {what} IDs: {.val {collisions}}.", + call = call + ) + } + c(x, y) +} + +catalog_path_label <- function(relation) { + paste(relation$path$components, collapse = ".") +} diff --git a/R/catalog.R b/R/catalog.R index a9070ef..2230cba 100644 --- a/R/catalog.R +++ b/R/catalog.R @@ -16,6 +16,10 @@ catalog_from_data_dictionary <- function( description = dictionary$description, details = dictionary$details, provenance = provenance, + field_provenance = catalog_field_provenance( + c("label", "description", "details"), + provenance + ), extensions = list(data_dictionary = list( name = dictionary$name, description = dictionary$description, @@ -46,6 +50,10 @@ catalog_from_data_dictionary <- function( datasets = names(relations), relationships = dictionary$relationships, provenance = provenance, + field_provenance = catalog_field_provenance( + c("name", "description", "details", "relationships"), + provenance + ), extensions = list(data_dictionary = list( relationships = dictionary$relationships )) @@ -81,7 +89,11 @@ catalog_from_data_dictionary <- function( source_id = source_id, name = name, description = dictionary$glossary[[name]], - provenance = provenance + provenance = provenance, + field_provenance = catalog_field_provenance( + c("name", "description"), + provenance + ) ) } ) @@ -347,6 +359,7 @@ new_catalog_source <- function( sample_rows = 0L, version = NULL, provenance = new_catalog_provenance("unknown", id), + field_provenance = list(), extensions = list() ) { identifier_case <- rlang::arg_match(identifier_case) @@ -367,6 +380,7 @@ new_catalog_source <- function( sample_rows = catalog_count(sample_rows, "sample_rows"), version = version, provenance = provenance, + field_provenance = field_provenance, extensions = extensions ), class = "commons_catalog_source" @@ -397,6 +411,7 @@ new_catalog_relation <- function( cli::cli_abort("A catalog relation needs a source path.") } columns <- catalog_columns(columns) + constraints <- catalog_constraints(constraints) structure( list( id = catalog_string(id, "relation id"), @@ -477,6 +492,7 @@ new_catalog_model <- function( version = NULL, fingerprint = NULL, provenance = new_catalog_provenance("unknown", source_id), + field_provenance = list(), extensions = list() ) { structure( @@ -496,6 +512,7 @@ new_catalog_model <- function( version = version, fingerprint = fingerprint, provenance = provenance, + field_provenance = field_provenance, extensions = extensions ), class = "commons_catalog_model" @@ -519,6 +536,7 @@ new_catalog_definition <- function( visibility = c("public", "private"), native = list(), provenance = NULL, + field_provenance = list(), extensions = list() ) { visibility <- rlang::arg_match(visibility) @@ -541,6 +559,7 @@ new_catalog_definition <- function( visibility = visibility, native = native, provenance = provenance, + field_provenance = field_provenance, extensions = extensions ), class = "commons_catalog_definition" @@ -567,8 +586,11 @@ new_catalog_calculation <- function( dependencies = character(), execution, provenance = NULL, + field_provenance = list(), extensions = list() ) { + arguments <- catalog_arguments(arguments) + execution <- catalog_execution(execution, arguments) structure( list( id = catalog_string(id, "calculation id"), @@ -579,6 +601,7 @@ new_catalog_calculation <- function( dependencies = catalog_character(dependencies), execution = execution, provenance = provenance, + field_provenance = field_provenance, extensions = extensions ), class = "commons_catalog_calculation" @@ -592,6 +615,7 @@ new_catalog_term <- function( description, synonyms = character(), provenance = NULL, + field_provenance = list(), extensions = list() ) { structure( @@ -602,6 +626,7 @@ new_catalog_term <- function( description = prose_field(description), synonyms = catalog_character(synonyms), provenance = provenance, + field_provenance = field_provenance, extensions = extensions ), class = "commons_catalog_term" @@ -617,6 +642,7 @@ new_catalog_context <- function( delivery = c("ambient", "first_touch", "retrieval", "evaluation"), authority = list(kind = "unknown"), provenance = NULL, + field_provenance = list(), extensions = list() ) { delivery <- rlang::arg_match(delivery) @@ -630,6 +656,7 @@ new_catalog_context <- function( delivery = delivery, authority = authority, provenance = provenance, + field_provenance = field_provenance, extensions = extensions ), class = "commons_catalog_context" @@ -644,6 +671,99 @@ new_catalog_access <- function( structure(list(state = state, evidence = evidence), class = "commons_catalog_access") } +new_catalog_constraint <- function( + kind, + columns, + reference = NULL, + enforcement = c("unknown", "informational", "asserted", "enforced"), + native = list(), + provenance = NULL +) { + enforcement <- rlang::arg_match(enforcement) + structure( + list( + kind = catalog_string(kind, "constraint kind"), + columns = catalog_character(columns), + reference = reference, + enforcement = enforcement, + native = native, + provenance = provenance + ), + class = "commons_catalog_constraint" + ) +} + +new_catalog_argument <- function( + type = c("string", "integer", "number", "logical", "date", "datetime"), + required = TRUE, + binding = c("value", "identifier"), + choices = NULL +) { + type <- rlang::arg_match(type) + binding <- rlang::arg_match(binding) + if (!rlang::is_bool(required)) { + cli::cli_abort("A calculation argument's {.field required} field must be true or false.") + } + choices <- catalog_character(choices) + if (identical(binding, "identifier") && length(choices) == 0) { + cli::cli_abort("Identifier calculation arguments require an explicit allowlist.") + } + structure( + list( + type = type, + required = required, + binding = binding, + choices = choices + ), + class = "commons_catalog_argument" + ) +} + +new_catalog_binding <- function( + argument, + method = c("parameter", "identifier"), + token = NULL +) { + method <- rlang::arg_match(method) + structure( + list( + argument = catalog_string(argument, "binding argument"), + method = method, + token = token + ), + class = "commons_catalog_binding" + ) +} + +new_catalog_execution <- function( + kind = c("verified_sql", "parameterized_sql", "native_metric", "governed_function"), + dialect, + sql = NULL, + bindings = list(), + native = list() +) { + kind <- rlang::arg_match(kind) + if (!is.null(sql)) { + sql <- catalog_string(sql, "execution SQL") + } + if (length(bindings)) { + valid <- vapply(bindings, inherits, logical(1), "commons_catalog_binding") + if (!all(valid)) { + cli::cli_abort("Every execution binding must be a catalog binding.") + } + } + structure( + list( + kind = kind, + dialect = catalog_string(dialect, "execution dialect"), + sql = sql, + bindings = bindings, + native = native + ), + class = "commons_catalog_execution" + ) +} + new_catalog_provenance <- function( kind = c("unknown", "authored", "certified", "discovered", "inferred"), source_id, @@ -704,6 +824,10 @@ catalog_relation_from_dictionary <- function( examples = column$examples, restrictions = unlist(column$constraints), provenance = provenance, + field_provenance = catalog_field_provenance( + names(column)[!vapply(column, is.null, logical(1))], + provenance + ), extensions = list(data_dictionary = column) ) } @@ -721,6 +845,10 @@ catalog_relation_from_dictionary <- function( columns = columns, access = new_catalog_access("unknown", "authored dictionary"), provenance = provenance, + field_provenance = catalog_field_provenance( + names(table)[!vapply(table, is.null, logical(1))], + provenance + ), extensions = list(data_dictionary = table) ) } @@ -748,6 +876,10 @@ catalog_definition_from_dictionary <- function( )), native = definition, provenance = provenance, + field_provenance = catalog_field_provenance( + names(definition)[!vapply(definition, is.null, logical(1))], + provenance + ), extensions = list(data_dictionary = definition) ) } @@ -777,7 +909,8 @@ catalog_context_from_dictionary <- function( scope = source$id, delivery = delivery, authority = list(kind = "authored"), - provenance = provenance + provenance = provenance, + field_provenance = catalog_field_provenance("text", provenance) )) } } @@ -795,7 +928,8 @@ catalog_context_from_dictionary <- function( scope = relation$id, delivery = delivery, authority = list(kind = "authored"), - provenance = provenance + provenance = provenance, + field_provenance = catalog_field_provenance("text", provenance) )) } } @@ -810,7 +944,8 @@ catalog_context_from_dictionary <- function( scope = term$id, delivery = delivery, authority = list(kind = "authored"), - provenance = provenance + provenance = provenance, + field_provenance = catalog_field_provenance("text", provenance) )) } } @@ -931,6 +1066,75 @@ catalog_expressions <- function(expressions) { expressions } +catalog_constraints <- function(constraints) { + if (length(constraints) == 0) { + return(list()) + } + valid <- vapply( + constraints, + inherits, + logical(1), + "commons_catalog_constraint" + ) + if (!all(valid)) { + cli::cli_abort("Every relation constraint must be a catalog constraint.") + } + constraints +} + +catalog_arguments <- function(arguments) { + if (length(arguments) == 0) { + return(list()) + } + if (is.null(names(arguments)) || any(!nzchar(names(arguments))) || anyDuplicated(names(arguments))) { + cli::cli_abort("Calculation arguments must have unique, non-empty names.") + } + valid <- vapply( + arguments, + inherits, + logical(1), + "commons_catalog_argument" + ) + if (!all(valid)) { + cli::cli_abort("Every calculation argument must be a catalog argument.") + } + arguments +} + +catalog_execution <- function(execution, arguments) { + if (!inherits(execution, "commons_catalog_execution")) { + cli::cli_abort("A catalog calculation needs a catalog execution descriptor.") + } + bindings <- execution$bindings + binding_names <- vapply(bindings, `[[`, character(1), "argument") + if (anyDuplicated(binding_names)) { + cli::cli_abort("Each calculation argument can have only one execution binding.") + } + unknown <- setdiff(binding_names, names(arguments)) + missing <- setdiff(names(arguments), binding_names) + if (length(unknown) || length(missing)) { + cli::cli_abort(c( + "Execution bindings must correspond exactly to calculation arguments.", + "x" = if (length(unknown)) "Unknown bindings: {.val {unknown}}.", + "x" = if (length(missing)) "Missing bindings: {.val {missing}}." + )) + } + for (binding in bindings) { + argument <- arguments[[binding$argument]] + expected <- if (identical(argument$binding, "identifier")) { + "identifier" + } else { + "parameter" + } + if (!identical(binding$method, expected)) { + cli::cli_abort( + "Calculation argument {.val {binding$argument}} requires a {.val {expected}} binding." + ) + } + } + execution +} + catalog_diagnostics <- function(diagnostics, call) { if (length(diagnostics) == 0) { return(list()) @@ -1004,3 +1208,8 @@ catalog_id <- function(kind, ...) { catalog_compact <- function(x) { x[!vapply(x, is.null, logical(1))] } + +catalog_field_provenance <- function(fields, provenance) { + fields <- unique(fields[nzchar(fields)]) + stats::setNames(rep(list(provenance), length(fields)), fields) +} diff --git a/tests/testthat/_snaps/catalog.md b/tests/testthat/_snaps/catalog.md index 9fb0e2c..505b923 100644 --- a/tests/testthat/_snaps/catalog.md +++ b/tests/testthat/_snaps/catalog.md @@ -14,3 +14,30 @@ Error: ! Catalog relations cannot be projected to a data dictionary because table names are ambiguous: "orders". +# relative authored relation matches must be unambiguous + + Code + catalog_merge(discovered, authored) + Condition + Error: + ! Authored relation "orders" is ambiguous; it matches "ANALYTICS.PUBLIC.ORDERS" and "ANALYTICS.STAGING.ORDERS". + +# calculations require typed adapter-owned bindings + + Code + new_catalog_calculation("calculation:bad", "source:test", "bad", arguments = arguments, + execution = new_catalog_execution("parameterized_sql", "snowflake", + "SELECT 1", list(new_catalog_binding("month")))) + Condition + Error in `catalog_execution()`: + ! Execution bindings must correspond exactly to calculation arguments. + x Missing bindings: "region". + +--- + + Code + new_catalog_argument("string", binding = "identifier") + Condition + Error in `new_catalog_argument()`: + ! Identifier calculation arguments require an explicit allowlist. + diff --git a/tests/testthat/test-catalog.R b/tests/testthat/test-catalog.R index dd94376..2bb7347 100644 --- a/tests/testthat/test-catalog.R +++ b/tests/testthat/test-catalog.R @@ -156,3 +156,158 @@ test_that("data sources carry the dictionary catalog", { "total_revenue" ) }) + +test_that("authored metadata merges onto qualified discovered relations", { + discovered_provenance <- new_catalog_provenance( + "discovered", + "source:warehouse" + ) + source <- new_catalog_source( + "source:warehouse", + "snowflake", + identifier_case = "upper", + provenance = discovered_provenance + ) + relation <- new_catalog_relation( + "relation:orders", + source$id, + new_source_path(c( + catalog = "ANALYTICS", + schema = "PUBLIC", + table = "ORDERS" + )), + description = "Warehouse description.", + tags = "certified", + columns = list(new_catalog_column( + "AMOUNT", + native_type = "NUMBER", + description = "Warehouse column description.", + provenance = discovered_provenance + )), + access = new_catalog_access("queryable"), + provenance = discovered_provenance + ) + discovered <- new_commons_catalog( + sources = list(source), + relations = list(relation) + ) + authored <- catalog_from_data_dictionary(new_data_dictionary(list( + tables = list(orders = list( + description = "Authored description.", + columns = list(amount = list( + type = "number", + description = "Authored column description." + )) + )) + ))) + + merged <- catalog_merge(discovered, authored) + orders <- merged$relations[["relation:orders"]] + + expect_equal(orders$description, "Authored description.") + expect_equal(orders$access$state, "queryable") + expect_setequal(orders$tags, "certified") + expect_equal(orders$columns$AMOUNT$native_type, "NUMBER") + expect_equal( + orders$columns$AMOUNT$description, + "Authored column description." + ) + expect_equal(merged$models[[1]]$datasets, "relation:orders") + expect_equal(merged$context[[1]]$scope, "relation:orders") +}) + +test_that("relative authored relation matches must be unambiguous", { + source <- new_catalog_source( + "source:warehouse", + "snowflake", + identifier_case = "upper" + ) + relations <- lapply(c("PUBLIC", "STAGING"), function(schema) { + new_catalog_relation( + paste0("relation:", schema), + source$id, + new_source_path(c( + catalog = "ANALYTICS", + schema = schema, + table = "ORDERS" + )) + ) + }) + discovered <- new_commons_catalog( + sources = list(source), + relations = relations + ) + authored <- catalog_from_data_dictionary(new_data_dictionary(list( + tables = list(orders = list(description = "Orders.")) + ))) + + expect_snapshot(catalog_merge(discovered, authored), error = TRUE) +}) + +test_that("constraint enforcement is distinct from constraint kind", { + constraint <- new_catalog_constraint( + "foreign_key", + "customer_id", + reference = list(table = "customers", columns = "id"), + enforcement = "asserted", + native = list(rely = TRUE) + ) + source <- new_catalog_source("source:test", "test") + relation <- new_catalog_relation( + "relation:test", + source$id, + new_source_path(c(table = "orders")), + constraints = list(constraint) + ) + + expect_equal(relation$constraints[[1]]$kind, "foreign_key") + expect_equal(relation$constraints[[1]]$enforcement, "asserted") +}) + +test_that("calculations require typed adapter-owned bindings", { + arguments <- list( + month = new_catalog_argument("date"), + region = new_catalog_argument( + "string", + binding = "identifier", + choices = c("east", "west") + ) + ) + execution <- new_catalog_execution( + "parameterized_sql", + "snowflake", + "SELECT * FROM identifier(?) WHERE month = ?", + list( + new_catalog_binding("month"), + new_catalog_binding("region", "identifier") + ) + ) + calculation <- new_catalog_calculation( + "calculation:revenue", + "source:test", + "revenue", + arguments = arguments, + execution = execution + ) + + expect_equal(calculation$arguments$month$type, "date") + expect_snapshot( + new_catalog_calculation( + "calculation:bad", + "source:test", + "bad", + arguments = arguments, + execution = new_catalog_execution( + "parameterized_sql", + "snowflake", + "SELECT 1", + list(new_catalog_binding("month")) + ) + ), + error = TRUE + ) + expect_snapshot( + new_catalog_argument("string", binding = "identifier"), + error = TRUE + ) +}) From c372128ea4a11c843e7217b454b1c5419f709647 Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 10:50:41 -0500 Subject: [PATCH 03/25] add catalog-aware data source options --- NAMESPACE | 1 + R/catalog-provider.R | 379 ++++++++++++++++++++++++++ R/catalog.R | 51 +++- R/data-source-options.R | 136 +++++++++ R/data-source.R | 162 ++++++++--- R/definitions.R | 7 +- R/prompt.R | 3 + R/tools.R | 67 ++++- man/data_source.Rd | 23 +- man/data_source_options.Rd | 26 ++ tests/testthat/_snaps/data-source.md | 21 +- tests/testthat/test-commons.R | 38 ++- tests/testthat/test-data-dictionary.R | 2 +- tests/testthat/test-data-source.R | 133 ++++++++- tests/testthat/test-pool.R | 2 +- tests/testthat/test-tools.R | 4 +- 16 files changed, 973 insertions(+), 82 deletions(-) create mode 100644 R/catalog-provider.R create mode 100644 R/data-source-options.R create mode 100644 man/data_source_options.Rd diff --git a/NAMESPACE b/NAMESPACE index 518f8e9..9dede77 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,7 @@ export(commons_server) export(commons_ui) export(context_layer) export(data_source) +export(data_source_options) export(list_tables) export(measure) export(read_trajectories) diff --git a/R/catalog-provider.R b/R/catalog-provider.R new file mode 100644 index 0000000..3e5afed --- /dev/null +++ b/R/catalog-provider.R @@ -0,0 +1,379 @@ +new_catalog_provider <- function(con, options, call = rlang::caller_env()) { + started_at <- Sys.time() + backend <- catalog_backend(con) + snapshot <- catalog_connection_snapshot(con, backend) + source_id <- catalog_id( + "source", + backend, + snapshot$principal %||% "unknown", + paste(unlist(snapshot$namespace), collapse = ".") + ) + ids <- catalog_resolve_selection(con, backend, options, call) + if (length(ids) == 0) { + cli::cli_abort( + "The resolved data-source selection contains no queryable objects.", + call = call + ) + } + names <- vapply(ids, catalog_id_name, character(1)) + keep <- !catalog_excluded(names, options$exclude) + ids <- ids[keep] + if (length(ids) == 0) { + cli::cli_abort( + "{.arg exclude} removes every object in the data-source selection.", + call = call + ) + } + + keys <- vapply(ids, catalog_source_path_key, character(1)) + ids <- ids[!duplicated(keys)] + labels <- vapply(ids, catalog_id_label, character(1)) + labels <- catalog_unique_labels(labels, ids, call) + names(ids) <- labels + + provenance <- new_catalog_provenance( + "discovered", + source_id, + harvested_at = Sys.time() + ) + source <- new_catalog_source( + id = source_id, + kind = backend, + dialect = backend, + locator = snapshot$locator, + selection = options, + principal = snapshot$principal, + role = snapshot$role, + namespace = snapshot$namespace, + identifier_case = catalog_identifier_case(backend), + sample_rows = options$sample_rows, + provenance = provenance + ) + relations <- lapply(seq_along(ids), function(i) { + id <- ids[[i]] + path <- new_source_path(id) + new_catalog_relation( + id = catalog_id("relation", source_id, catalog_source_path_key(id)), + source_id = source_id, + path = path, + name = catalog_id_name(id), + access = new_catalog_access("unknown", "listed by the connection"), + provenance = provenance + ) + }) + relation_ids <- vapply(relations, `[[`, character(1), "id") + relation_labels <- stats::setNames(labels, relation_ids) + + provider <- new.env(parent = emptyenv()) + provider$con <- con + provider$backend <- backend + provider$options <- options + provider$snapshot <- snapshot + provider$table_ids <- ids + provider$relation_labels <- relation_labels + provider$catalog <- new_commons_catalog( + sources = list(source), + relations = relations, + provider = provider + ) + provider$startup <- list( + started_at = started_at, + elapsed = as.numeric(difftime(Sys.time(), started_at, units = "secs")) + ) + provider$lazy <- nchar(paste(labels, collapse = "\n"), type = "bytes") > 4000L + provider +} + +catalog_backend <- function(con) { + info <- tryCatch(DBI::dbGetInfo(con), error = function(err) list()) + label <- paste( + c(info$dbms.name, info$dbname, class(con)), + collapse = " " + ) + if (grepl("snowflake", label, ignore.case = TRUE)) { + return("snowflake") + } + if (grepl("databricks|spark", label, ignore.case = TRUE)) { + return("databricks") + } + tolower(info$dbms.name %||% sub("Connection$", "", class(con)[[1]])) +} + +catalog_connection_snapshot <- function(con, backend) { + info <- tryCatch(DBI::dbGetInfo(con), error = function(err) list()) + list( + backend = backend, + locator = catalog_compact(list( + dbname = info$dbname, + host = info$host, + port = info$port + )), + principal = info$username %||% info$user, + role = NULL, + namespace = catalog_compact(list( + catalog = info$dbname, + schema = info$schema + )) + ) +} + +catalog_provider_check <- function(provider, call = rlang::caller_env()) { + current <- catalog_connection_snapshot(provider$con, provider$backend) + if (!identical(current, provider$snapshot)) { + cli::cli_abort( + "The connection identity, role, or current namespace changed after catalog discovery; rebuild the data source.", + call = call + ) + } + invisible(provider) +} + +catalog_resolve_selection <- function(con, backend, options, call) { + includes <- normalize_connection_includes(options$include, call) + if (is.null(includes)) { + return(catalog_default_objects(con, backend, call)) + } + + objects <- list() + for (include in includes) { + if ("table" %in% names(include@name)) { + objects[[length(objects) + 1]] <- include + } else { + expanded <- catalog_list_namespace(con, backend, include, call) + objects <- c(objects, expanded) + } + } + objects +} + +catalog_default_objects <- function(con, backend, call) { + tables <- tryCatch( + DBI::dbListTables(con), + error = function(err) { + cli::cli_abort( + "Failed to discover objects in the connection's current namespace.", + parent = err, + call = call + ) + } + ) + tables <- tables[vapply(tables, function(table) { + isTRUE(DBI::dbExistsTable(con, DBI::Id(table = table))) + }, logical(1))] + if (length(tables) == 0) { + cli::cli_abort( + c( + "The connection has no current-namespace objects.", + "i" = "Set a current catalog/database and schema, or supply {.arg options} with explicit {.arg include} IDs." + ), + call = call + ) + } + lapply(tables, function(table) DBI::Id(table = table)) +} + +catalog_list_namespace <- function(con, backend, prefix, call) { + listed <- tryCatch( + DBI::dbListObjects(con, prefix = prefix), + error = function(err) NULL + ) + if (!is.null(listed) && all(c("table", "is_prefix") %in% names(listed))) { + ids <- unclass(listed$table) + ids <- ids[!listed$is_prefix] + ids <- Filter(function(id) catalog_id_has_prefix(id, prefix), ids) + if (length(ids)) { + return(ids) + } + } + ids <- catalog_information_schema_objects(con, prefix) + if (length(ids)) { + return(ids) + } + cli::cli_abort( + "The {backend} DBI driver cannot enumerate namespace {.val {paste(prefix@name, collapse = '.')}}; select exact table IDs instead.", + call = call + ) +} + +catalog_information_schema_objects <- function(con, prefix) { + components <- prefix@name + catalog <- catalog_path_component(components, "catalog") %||% + catalog_path_component(components, "database") + schema <- catalog_path_component(components, "schema") + table_id <- DBI::Id(schema = "information_schema", table = "tables") + predicates <- c( + if (!is.null(catalog)) { + paste0("table_catalog = ", DBI::dbQuoteString(con, catalog)) + }, + if (!is.null(schema)) { + paste0("table_schema = ", DBI::dbQuoteString(con, schema)) + } + ) + sql <- paste0( + "SELECT table_catalog, table_schema, table_name FROM ", + DBI::dbQuoteIdentifier(con, table_id), + if (length(predicates)) paste0(" WHERE ", paste(predicates, collapse = " AND ")) + ) + rows <- tryCatch(DBI::dbGetQuery(con, sql), error = function(err) NULL) + if (is.null(rows) || nrow(rows) == 0) { + return(list()) + } + rows <- stats::setNames(rows, tolower(names(rows))) + lapply(seq_len(nrow(rows)), function(i) { + values <- list() + if ("catalog" %in% names(components)) { + values$catalog <- rows$table_catalog[[i]] + } + if ("database" %in% names(components)) { + values$database <- rows$table_catalog[[i]] + } + values$schema <- rows$table_schema[[i]] + values$table <- rows$table_name[[i]] + do.call(DBI::Id, values) + }) +} + +catalog_path_component <- function(components, role) { + if (!role %in% names(components)) { + return(NULL) + } + unname(components[[role]]) +} + +catalog_id_has_prefix <- function(id, prefix) { + components <- id@name + expected <- prefix@name + roles <- names(expected) + all(roles %in% names(components)) && identical( + unname(components[roles]), + unname(expected) + ) +} + +catalog_provider_hydrate <- function(provider, table, call = rlang::caller_env()) { + catalog_provider_check(provider, call) + id <- provider$table_ids[[table]] + if (is.null(id)) { + cli::cli_abort( + c( + "No table named {.val {table}}.", + "i" = "Available tables: {.val {names(provider$table_ids)}}." + ), + call = call + ) + } + relation_id <- names(provider$relation_labels)[provider$relation_labels == table] + relation <- provider$catalog$relations[[relation_id]] + if (length(relation$columns)) { + return(relation) + } + + metadata <- tryCatch( + catalog_relation_metadata(provider$con, id), + error = function(err) err + ) + if (inherits(metadata, "condition")) { + relation$access <- new_catalog_access("visible_only", conditionMessage(metadata)) + provider$catalog$relations[[relation_id]] <- relation + cli::cli_abort( + "Table {.val {table}} is visible in catalog metadata but could not be described.", + parent = metadata, + call = call + ) + } + + relation$columns <- metadata$columns + relation$access <- new_catalog_access("queryable", "zero-row metadata query") + provider$catalog$relations[[relation_id]] <- relation + relation +} + +catalog_relation_metadata <- function(con, id) { + result <- DBI::dbSendQuery( + con, + sprintf( + "SELECT * FROM %s WHERE 1 = 0", + DBI::dbQuoteIdentifier(con, id) + ) + ) + on.exit(DBI::dbClearResult(result), add = TRUE) + info <- DBI::dbColumnInfo(result) + columns <- lapply(seq_len(nrow(info)), function(i) { + type <- if ("type" %in% names(info)) info$type[[i]] else NULL + new_catalog_column( + name = info$name[[i]], + native_type = type, + logical_type = type + ) + }) + names(columns) <- vapply(columns, `[[`, character(1), "name") + list(columns = columns) +} + +catalog_provider_search <- function(provider, query, kinds = NULL, limit = 10L) { + catalog_provider_check(provider) + relations <- provider$catalog$relations + if (!is.null(kinds)) { + relations <- Filter(function(x) x$kind %in% kinds, relations) + } + relations <- Filter( + function(x) !identical(x$access$state, "visible_only"), + relations + ) + if (length(relations) == 0) { + return(relations) + } + query_terms <- catalog_search_terms(query) + scores <- vapply(relations, function(relation) { + text <- paste( + relation$name, + relation$label, + relation$description, + relation$tags, + relation$synonyms + ) + terms <- catalog_search_terms(text) + sum(query_terms %in% terms) + sum(grepl( + paste(query_terms, collapse = "|"), + tolower(text) + )) + }, numeric(1)) + order <- order(scores, decreasing = TRUE) + relations[utils::head(order, limit)] +} + +catalog_search_terms <- function(x) { + x <- tolower(paste(x %||% "", collapse = " ")) + unique(Filter(nzchar, strsplit(gsub("[^[:alnum:]_]+", " ", x), " +")[[1]])) +} + +catalog_provider_searchable <- function(source) { + !is.null(source$provider) && isTRUE(source$provider$lazy) +} + +catalog_identifier_case <- function(backend) { + if (identical(backend, "snowflake")) "upper" else "preserve" +} + +catalog_id_name <- function(id) { + unname(utils::tail(id@name, 1)) +} + +catalog_id_label <- function(id) { + paste(unname(id@name), collapse = ".") +} + +catalog_source_path_key <- function(id) { + paste(paste(names(id@name), id@name, sep = "="), collapse = "/") +} + +catalog_unique_labels <- function(labels, ids, call) { + duplicates <- unique(labels[duplicated(labels)]) + if (length(duplicates)) { + cli::cli_abort( + "The selected objects do not have unique rendered names: {.val {duplicates}}.", + call = call + ) + } + labels +} diff --git a/R/catalog.R b/R/catalog.R index 2230cba..2443705 100644 --- a/R/catalog.R +++ b/R/catalog.R @@ -170,19 +170,68 @@ catalog_to_data_dictionary <- function(catalog, call = rlang::caller_env()) { ) } +catalog_to_runtime_dictionary <- function( + catalog, + relation_labels, + call = rlang::caller_env() +) { + validate_commons_catalog(catalog, call = call) + relation_ids <- intersect(names(relation_labels), names(catalog$relations)) + relations <- catalog$relations[relation_ids] + tables <- lapply( + relations, + catalog_relation_to_dictionary, + definitions = catalog$definitions + ) + names(tables) <- unname(relation_labels[relation_ids]) + glossary <- lapply(catalog$terms, `[[`, "description") + names(glossary) <- vapply(catalog$terms, `[[`, character(1), "name") + relationships <- unlist( + lapply(catalog$models, `[[`, "relationships"), + use.names = FALSE, + recursive = FALSE + ) + authored_source <- Filter( + function(source) identical(source$kind, "data_dictionary"), + catalog$sources + ) + source <- if (length(authored_source)) { + authored_source[[1]] + } else { + catalog$sources[[1]] + } + new_data_dictionary( + list( + name = source$label, + description = source$description, + details = source$details, + tables = tables, + relationships = relationships, + glossary = glossary + ), + call = call + ) +} + catalog_definition_registry <- function( catalog, source = "", + table_labels = NULL, call = rlang::caller_env() ) { validate_commons_catalog(catalog, call = call) rows <- list(no_definitions) for (definition in catalog$definitions) { relation <- catalog$relations[[definition$relation_id]] + table <- if (relation$id %in% names(table_labels)) { + unname(table_labels[[relation$id]]) + } else { + relation$name + } expression <- catalog_primary_expression(definition$expressions) rows[[length(rows) + 1]] <- data.frame( name = definition$name, - table = relation$name, + table = table, source = source, type = definition$logical_type %||% NA_character_, role = definition$role, diff --git a/R/data-source-options.R b/R/data-source-options.R new file mode 100644 index 0000000..78da557 --- /dev/null +++ b/R/data-source-options.R @@ -0,0 +1,136 @@ +#' Configure a data source +#' +#' @param include Objects or namespaces to expose. DBI sources accept exact +#' table names, one [DBI::Id()], or a list of IDs. An ID ending before its +#' `table` component selects that namespace and its descendants. Boards +#' accept a named character vector mapping local table names to pin names. +#' @param exclude Unqualified object-name globs to remove after `include` is +#' resolved, such as `"TMP_*"`. +#' @param sample_rows The number of live rows to include when a table is +#' described. The default, `0`, reads schema metadata only. +#' +#' @return A `commons_data_source_options` object for [data_source()]. +#' @export +data_source_options <- function( + include = NULL, + exclude = NULL, + sample_rows = 0L +) { + if (!is.null(exclude) && (!is.character(exclude) || anyNA(exclude))) { + cli::cli_abort("{.arg exclude} must be a character vector without missing values.") + } + structure( + list( + include = include, + exclude = unique(exclude[nzchar(exclude)]), + sample_rows = catalog_count(sample_rows, "sample_rows") + ), + class = "commons_data_source_options" + ) +} + +as_data_source_options <- function( + options, + tables = NULL, + kind, + call = rlang::caller_env() +) { + if (!is.null(options) && !is.null(tables)) { + cli::cli_abort( + "Supply only one of {.arg options} and the deprecated {.arg tables}.", + call = call + ) + } + if (!is.null(tables)) { + rlang::warn( + "`tables` is deprecated; use `options = data_source_options(include = ...)` instead.", + .frequency = "once", + .frequency_id = "commons-data-source-tables" + ) + include <- if (identical(kind, "connection")) { + lapply(table_entries(tables, call), table_entry_id, call = call) + } else { + tables + } + options <- data_source_options(include = include) + } + if (is.null(options)) { + options <- data_source_options() + } + if (!inherits(options, "commons_data_source_options")) { + cli::cli_abort( + "{.arg options} must come from {.fn data_source_options}.", + call = call + ) + } + if (identical(kind, "board") && is.null(options$include)) { + cli::cli_abort( + "Board data sources require {.arg options} with an explicit {.arg include} mapping.", + call = call + ) + } + options +} + +normalize_connection_includes <- function(include, call = rlang::caller_env()) { + if (is.null(include)) { + return(NULL) + } + entries <- if (inherits(include, "Id")) { + list(include) + } else if (is.character(include)) { + lapply(include, function(x) DBI::Id(table = x)) + } else if (is.list(include)) { + include + } else { + cli::cli_abort( + "Connection {.arg include} must be table names, a {.cls DBI::Id}, or a list of IDs.", + call = call + ) + } + valid <- vapply(entries, inherits, logical(1), "Id") + if (!all(valid)) { + cli::cli_abort("Every connection {.arg include} entry must be a {.cls DBI::Id}.", call = call) + } + for (id in entries) { + components <- id@name + if (length(components) == 0 || anyNA(components) || any(!nzchar(components))) { + cli::cli_abort("{.cls DBI::Id} include entries must have non-empty components.", call = call) + } + if (any(grepl("[*?]", components))) { + cli::cli_abort( + "Wildcards are not allowed inside {.cls DBI::Id}; put unqualified globs in {.arg exclude}.", + call = call + ) + } + } + entries +} + +select_flat_names <- function(names, options, call = rlang::caller_env()) { + include <- options$include %||% names + if (!is.character(include) || anyNA(include) || any(!nzchar(include))) { + cli::cli_abort("Flat-source {.arg include} must contain non-empty names.", call = call) + } + missing <- setdiff(unname(include), names) + if (length(missing)) { + cli::cli_abort("{.arg include} names unknown object{?s}: {.val {missing}}.", call = call) + } + include[!catalog_excluded(unname(include), options$exclude)] +} + +catalog_excluded <- function(names, patterns) { + if (length(patterns) == 0) { + return(rep(FALSE, length(names))) + } + Reduce(`|`, lapply(patterns, function(pattern) { + grepl(catalog_glob_regex(pattern), names) + })) +} + +catalog_glob_regex <- function(pattern) { + escaped <- gsub("([][{}()+.^$|\\\\])", "\\\\\\1", pattern) + escaped <- gsub("\\*", ".*", escaped) + escaped <- gsub("\\?", ".", escaped) + paste0("^", escaped, "$") +} diff --git a/R/data-source.R b/R/data-source.R index a29b547..3bfe288 100644 --- a/R/data-source.R +++ b/R/data-source.R @@ -28,17 +28,17 @@ #' @param ... A single DBI connection, a single `pins` board, or named data #' frames to register as tables. When passing data frames, each name becomes #' a table name the agent can query. -#' @param tables Which tables to expose, used when a connection or a board is -#' supplied. +#' @param tables Deprecated. Use `options = data_source_options(include = ...)`. #' -#' For a connection, a character vector of table names, schema-qualified -#' strings like `"schema.table"`, or `DBI::Id` objects. Defaults to every -#' table returned by [DBI::dbListTables()]. Strings containing dots are -#' interpreted as schema-qualified names; use `DBI::Id(table = "a.b")` for -#' literal table names containing dots. +#' Existing connection values retain their former behavior: strings with +#' dots are treated as schema-qualified names. Existing board values retain +#' their local-name-to-pin-name mapping. +#' @param options Selection, exclusion, and sampling controls from +#' [data_source_options()]. DBI connections discover their current namespace +#' by default. Boards require an explicit named `include` mapping. #' -#' For a board, a named character vector of pins to read: the names become -#' table names, and the values are pin names passed to [pins::pin_read()]. +#' Selection controls which objects commons describes to the model. The +#' connection's grants remain the security boundary for SQL execution. #' @param dictionary An optional path to a data dictionary describing the #' source's tables and columns, in the #' [data-dict.yaml](https://data-dict.tidyverse.org/) format. See the @@ -85,10 +85,16 @@ #' list_tables(src) #' #' @export -data_source <- function(..., tables = NULL, dictionary = NULL) { +data_source <- function( + ..., + tables = NULL, + dictionary = NULL, + options = NULL +) { dots <- rlang::list2(...) dictionary <- as_data_dictionary(dictionary) kind <- data_source_kind(dots) + options <- as_data_source_options(options, tables, kind) local_commons_span( "commons_data_source_create", @@ -96,17 +102,24 @@ data_source <- function(..., tables = NULL, dictionary = NULL) { ) if (kind == "connection") { - return(data_source_connection(dots[[1]], tables, dictionary = dictionary)) + return(data_source_connection(dots[[1]], options, dictionary = dictionary)) } if (kind == "board") { - return(data_source_board(dots[[1]], tables, dictionary = dictionary)) + return(data_source_board(dots[[1]], options, dictionary = dictionary)) } - data_source_frames(dots, dictionary) + data_source_frames(dots, dictionary, options) } -data_source_frames <- function(dots, dictionary, call = rlang::caller_env()) { +data_source_frames <- function( + dots, + dictionary, + options, + call = rlang::caller_env() +) { check_named_frames(dots, call = call) + selected <- select_flat_names(names(dots), options, call) + dots <- dots[selected] local_commons_span( "commons_data_source_load_frames", attributes = list("commons.data_source.n_tables" = length(dots)) @@ -122,7 +135,13 @@ data_source_frames <- function(dots, dictionary, call = rlang::caller_env()) { } duckdb_lock_down(con) - new_data_source(con, names(dots), owned = TRUE, dictionary = dictionary) + new_data_source( + con, + names(dots), + owned = TRUE, + dictionary = dictionary, + options = options + ) } data_source_kind <- function(dots) { @@ -137,19 +156,16 @@ data_source_kind <- function(dots) { data_source_connection <- function( con, - tables, + options, dictionary = NULL, call = rlang::caller_env() ) { span <- local_commons_span("commons_data_source_list_tables") - - if (is.null(tables)) { - listed <- DBI::dbListTables(con) - commons_span_set_attribute(span, "commons.data_source.n_tables", length(listed)) - return(new_data_source(con, listed, owned = FALSE, dictionary = dictionary)) - } - - table_registry <- normalize_table_registry(tables, call = call) + provider <- new_catalog_provider(con, options, call) + table_registry <- list( + labels = names(provider$table_ids), + ids = provider$table_ids + ) check_table_ids_exist(con, table_registry, call = call) commons_span_set_attribute( span, @@ -157,37 +173,50 @@ data_source_connection <- function( length(table_registry$labels) ) + authored <- catalog_from_data_dictionary(dictionary) + if (length(authored$sources)) { + provider$catalog <- catalog_merge(provider$catalog, authored, call = call) + } new_data_source( con, table_registry$labels, owned = FALSE, table_ids = table_registry$ids, - dictionary = dictionary + dictionary = dictionary, + catalog = provider$catalog, + provider = provider, + options = options, + relation_labels = provider$relation_labels ) } data_source_board <- function( board, - tables, + options, dictionary = NULL, call = rlang::caller_env() ) { + tables <- options$include if (!rlang::is_named(tables) || !is.character(tables)) { cli::cli_abort( - "{.arg tables} must be a named character vector of pin names.", + "Board {.arg include} must be a named character vector of pin names.", call = call ) } if (length(tables) == 0) { - cli::cli_abort("{.arg tables} must name at least one pin.", call = call) + cli::cli_abort("Board {.arg include} must name at least one pin.", call = call) } duplicated_labels <- unique(names(tables)[duplicated(names(tables))]) if (length(duplicated_labels)) { cli::cli_abort( - "{.arg tables} must not contain duplicate names: {.val {duplicated_labels}}.", + "Board {.arg include} must not contain duplicate names: {.val {duplicated_labels}}.", call = call ) } + tables <- tables[!catalog_excluded(names(tables), options$exclude)] + if (length(tables) == 0) { + cli::cli_abort("{.arg exclude} removes every selected pin.", call = call) + } local_commons_span( "commons_data_source_list_pins", @@ -207,7 +236,8 @@ data_source_board <- function( names(tables), owned = TRUE, dictionary = dictionary, - pending = new_pending_pins(board, tables) + pending = new_pending_pins(board, tables), + options = options ) } @@ -235,6 +265,16 @@ list_tables <- function(data_source) { data_source$tables } +source_runtime_dictionary <- function(source) { + if (is.null(source$provider)) { + return(source$dictionary) + } + catalog_to_runtime_dictionary( + source$provider$catalog, + source$relation_labels + ) +} + new_data_source <- function( con, tables, @@ -242,7 +282,10 @@ new_data_source <- function( table_ids = table_ids_from_labels(tables), dictionary = NULL, pending = NULL, - catalog = catalog_from_data_dictionary(dictionary) + catalog = catalog_from_data_dictionary(dictionary), + provider = NULL, + options = data_source_options(), + relation_labels = character() ) { # Disconnect only the DuckDB connection we created; a user-supplied connection # has its own owner and lifetime. @@ -265,6 +308,9 @@ new_data_source <- function( handle = handle, dictionary = dictionary, catalog = catalog, + provider = provider, + options = options, + relation_labels = relation_labels, pending = pending ), class = "commons_data_source" @@ -428,7 +474,7 @@ pending_tables_in_error <- function(source, err) { )] } -source_describe <- function(source, table, n_sample = 5) { +source_describe <- function(source, table, n_sample = NULL) { id <- source$table_ids[[table]] if (is.null(id)) { cli::cli_abort(c( @@ -437,20 +483,46 @@ source_describe <- function(source, table, n_sample = 5) { )) } source_ensure_tables(source, table) - - sample <- DBI::dbGetQuery( - source$con, - sprintf( - "SELECT * FROM %s LIMIT %d", - DBI::dbQuoteIdentifier(source$con, id), - n_sample + n_sample <- n_sample %||% source$options$sample_rows + n_sample <- catalog_count(n_sample, "sample_rows") + if (!is.null(source$provider)) { + relation <- catalog_provider_hydrate(source$provider, table) + schema <- data.frame( + column = names(relation$columns), + type = vapply( + relation$columns, + function(x) x$logical_type %||% x$native_type %||% "unknown", + character(1) + ), + row.names = NULL ) - ) - schema <- data.frame( - column = names(sample), - type = vapply(sample, function(x) class(x)[[1]], character(1)), - row.names = NULL - ) + } else { + metadata <- catalog_relation_metadata(source$con, id) + schema <- data.frame( + column = names(metadata$columns), + type = vapply( + metadata$columns, + function(x) x$logical_type %||% x$native_type %||% "unknown", + character(1) + ), + row.names = NULL + ) + } + sample <- if (n_sample > 0) { + DBI::dbGetQuery( + source$con, + sprintf( + "SELECT * FROM %s LIMIT %d", + DBI::dbQuoteIdentifier(source$con, id), + n_sample + ) + ) + } else { + stats::setNames( + as.data.frame(rep(list(logical()), nrow(schema))), + schema$column + ) + } list(schema = schema, sample = sample) } diff --git a/R/definitions.R b/R/definitions.R index be61862..d1401ed 100644 --- a/R/definitions.R +++ b/R/definitions.R @@ -175,7 +175,12 @@ definitions_registry <- function(sources, call = rlang::caller_env()) { for (i in seq_along(sources)) { source <- sources[[i]] if (inherits(source$catalog, "commons_catalog")) { - registry <- catalog_definition_registry(source$catalog, labels[[i]], call) + registry <- catalog_definition_registry( + source$catalog, + labels[[i]], + source$relation_labels, + call + ) tables <- unique(registry$defs$table) unknown <- setdiff(tables, source$tables) if (length(unknown)) { diff --git a/R/prompt.R b/R/prompt.R index 129121f..14e2bf8 100644 --- a/R/prompt.R +++ b/R/prompt.R @@ -181,5 +181,8 @@ tables_text <- function(sources) { } table_bullets <- function(source) { + if (catalog_provider_searchable(source)) { + return("The selected catalog is large. Use `search_catalog` to find tables before calling `describe_table`.") + } paste(sprintf("- %s", list_tables(source)), collapse = "\n") } diff --git a/R/tools.R b/R/tools.R index 8b51487..e5e218e 100644 --- a/R/tools.R +++ b/R/tools.R @@ -9,6 +9,13 @@ build_commons_tools <- function(self, private) { if (registry_has_metrics(private$definitions)) { list(tool_call_metrics(private)) }, + if (any(vapply( + private$sources, + catalog_provider_searchable, + logical(1) + ))) { + list(tool_search_catalog(private)) + }, list( tool_search_context(private), tool_describe_table(private), @@ -18,6 +25,49 @@ build_commons_tools <- function(self, private) { ) } +tool_search_catalog <- function(private) { + ellmer::tool( + function(query, kinds = NULL, source = NULL) { + src <- resolve_sql_source(private$sources, source) + if (is.null(src$provider)) { + return("This data source does not have a searchable catalog.") + } + results <- catalog_provider_search(src$provider, query, kinds) + body <- if (length(results)) { + paste(vapply(results, function(relation) { + label <- src$relation_labels[[relation$id]] %||% relation$name + summary <- relation$description %||% relation$label %||% "No description." + sprintf("- `%s` (%s): %s", label, relation$kind, summary) + }, character(1)), collapse = "\n") + } else { + sprintf("No catalog objects found for \"%s\".", query) + } + tool_result( + body, + title = "Searched the data catalog", + icon = maybe_icon("search"), + markdown = body + ) + }, + "Search the selected data catalog by business meaning, object name, tags, and synonyms. Results are stable object names for describe_table.", + arguments = list( + query = ellmer::type_string("The data you need, in plain language."), + kinds = ellmer::type_array( + ellmer::type_string(), + "Optional object kinds such as table or view.", + required = FALSE + ), + source = sql_source_type(private$sources) + ), + name = "search_catalog", + annotations = ellmer::tool_annotations( + title = "Search the data catalog", + icon = maybe_icon("search"), + read_only_hint = TRUE + ) + ) +} + # Measures are never listed in the system prompt, and definitions past their # ambient cap aren't either; a search tool over a fully visible pool would # just cost the model a verification round trip. @@ -330,12 +380,15 @@ search_context_tool <- function(context, query) { describe_table_tool <- function(source, table, source_name = NULL, tracker = NULL) { d <- source_describe(source, table) - entry <- source$dictionary$tables[[table]] + dictionary <- source_runtime_dictionary(source) + entry <- dictionary$tables[[table]] - sample <- sprintf( - "Sample rows:\n\n%s", - df_to_markdown(d$sample, max_rows = 5) - ) + sample <- if (nrow(d$sample)) { + sprintf( + "Sample rows:\n\n%s", + df_to_markdown(d$sample, max_rows = 5) + ) + } if (is.null(entry)) { parts <- c( sprintf("Columns of `%s`:\n\n%s", table, df_to_markdown(d$schema)), @@ -349,7 +402,7 @@ describe_table_tool <- function(source, table, source_name = NULL, tracker = NUL dictionary_columns_text(entry$columns, live = d$schema) ) parts <- c( - dictionary_entry_parts(source$dictionary, table, columns), + dictionary_entry_parts(dictionary, table, columns), sample ) } @@ -393,7 +446,7 @@ run_sql_tool <- function( # text, which is reliable in a way column matching is not; a false positive # appends a harmless note. dictionary_sql_entries <- function(source, sql, source_name, tracker) { - dictionary <- source$dictionary + dictionary <- source_runtime_dictionary(source) tables <- names(dictionary$tables) hits <- tables[vapply( tables, diff --git a/man/data_source.Rd b/man/data_source.Rd index 500ba9e..d43be34 100644 --- a/man/data_source.Rd +++ b/man/data_source.Rd @@ -4,29 +4,30 @@ \alias{data_source} \title{Create a data source} \usage{ -data_source(..., tables = NULL, dictionary = NULL) +data_source(..., tables = NULL, dictionary = NULL, options = NULL) } \arguments{ \item{...}{A single DBI connection, a single \code{pins} board, or named data frames to register as tables. When passing data frames, each name becomes a table name the agent can query.} -\item{tables}{Which tables to expose, used when a connection or a board is -supplied. +\item{tables}{Deprecated. Use \code{options = data_source_options(include = ...)}. -For a connection, a character vector of table names, schema-qualified -strings like \code{"schema.table"}, or \code{DBI::Id} objects. Defaults to every -table returned by \code{\link[DBI:dbListTables]{DBI::dbListTables()}}. Strings containing dots are -interpreted as schema-qualified names; use \code{DBI::Id(table = "a.b")} for -literal table names containing dots. - -For a board, a named character vector of pins to read: the names become -table names, and the values are pin names passed to \code{\link[pins:pin_read]{pins::pin_read()}}.} +Existing connection values retain their former behavior: strings with +dots are treated as schema-qualified names. Existing board values retain +their local-name-to-pin-name mapping.} \item{dictionary}{An optional path to a data dictionary describing the source's tables and columns, in the \href{https://data-dict.tidyverse.org/}{data-dict.yaml} format. See the \verb{Data dictionaries} section.} + +\item{options}{Selection, exclusion, and sampling controls from +\code{\link[=data_source_options]{data_source_options()}}. DBI connections discover their current namespace +by default. Boards require an explicit named \code{include} mapping. + +Selection controls which objects commons describes to the model. The +connection's grants remain the security boundary for SQL execution.} } \value{ A \code{commons_data_source} object. diff --git a/man/data_source_options.Rd b/man/data_source_options.Rd new file mode 100644 index 0000000..7d174d3 --- /dev/null +++ b/man/data_source_options.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data-source-options.R +\name{data_source_options} +\alias{data_source_options} +\title{Configure a data source} +\usage{ +data_source_options(include = NULL, exclude = NULL, sample_rows = 0L) +} +\arguments{ +\item{include}{Objects or namespaces to expose. DBI sources accept exact +table names, one \code{\link[DBI:Id]{DBI::Id()}}, or a list of IDs. An ID ending before its +\code{table} component selects that namespace and its descendants. Boards +accept a named character vector mapping local table names to pin names.} + +\item{exclude}{Unqualified object-name globs to remove after \code{include} is +resolved, such as \code{"TMP_*"}.} + +\item{sample_rows}{The number of live rows to include when a table is +described. The default, \code{0}, reads schema metadata only.} +} +\value{ +A \code{commons_data_source_options} object for \code{\link[=data_source]{data_source()}}. +} +\description{ +Configure a data source +} diff --git a/tests/testthat/_snaps/data-source.md b/tests/testthat/_snaps/data-source.md index 197eadc..18cb6b1 100644 --- a/tests/testthat/_snaps/data-source.md +++ b/tests/testthat/_snaps/data-source.md @@ -7,6 +7,23 @@ ! No table named "nope". i Available tables: "sales". +# DBI identifiers remain exact rather than patterns + + Code + normalize_connection_includes(DBI::Id(table = "orders*")) + Condition + Error: + ! Wildcards are not allowed inside ; put unqualified globs in `exclude`. + +# default connection discovery stays in the current namespace + + Code + data_source(con) + Condition + Error in `data_source()`: + ! The connection has no current-namespace objects. + i Set a current catalog/database and schema, or supply `options` with explicit `include` IDs. + # data_source errors for tables absent from the connection Code @@ -38,7 +55,7 @@ data_source(board) Condition Error in `data_source()`: - ! `tables` must be a named character vector of pin names. + ! Board data sources require `options` with an explicit `include` mapping. --- @@ -46,7 +63,7 @@ data_source(board, tables = stats::setNames(character(0), character(0))) Condition Error in `data_source()`: - ! `tables` must name at least one pin. + ! Board `include` must name at least one pin. # check_board_pins_exist resolves, flags missing, and flags ambiguous names diff --git a/tests/testthat/test-commons.R b/tests/testthat/test-commons.R index e7dca5c..9ebecf0 100644 --- a/tests/testthat/test-commons.R +++ b/tests/testthat/test-commons.R @@ -98,6 +98,28 @@ test_that("commons() registers only the tools the agent's composition earns", { ) }) +test_that("large connection catalogs are searched and hydrated lazily", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + DBI::dbExecute(con, "CREATE TABLE subscriptions (renewal_date DATE)") + src <- data_source(con) + relation_id <- names(src$provider$catalog$relations)[[1]] + relation <- src$provider$catalog$relations[[relation_id]] + relation$description <- "Customer renewals and recurring revenue." + src$provider$catalog$relations[[relation_id]] <- relation + src$provider$lazy <- TRUE + + agent <- test_agent(data_sources = src) + search <- agent_tool(agent, "search_catalog") + result <- search("customer renewals") + + expect_match(result@value, "subscriptions") + expect_match(agent$get_system_prompt(), "search_catalog") + expect_length(src$provider$catalog$relations[[relation_id]]$columns, 0) + agent_tool(agent, "describe_table")("subscriptions") + expect_length(src$provider$catalog$relations[[relation_id]]$columns, 1) +}) + test_that("commons() configures run_r network access", { restricted <- agent_tool(test_agent(), "run_r") full <- agent_tool(test_agent(network = "full"), "run_r") @@ -206,7 +228,12 @@ test_that("the system prompt includes schema-qualified table labels", { agent <- commons( test_client(), - data_sources = data_source(con, tables = "crm.sales") + data_sources = data_source( + con, + options = data_source_options( + include = DBI::Id(schema = "crm", table = "sales") + ) + ) ) expect_match(agent$get_system_prompt(), "- crm.sales", fixed = TRUE) @@ -543,7 +570,9 @@ test_that("prewarm() warms board pins in the background without loading them", { ) src <- data_source( board, - tables = c(orders = "team-orders", reps = "team-reps") + options = data_source_options( + include = c(orders = "team-orders", reps = "team-reps") + ) ) agent <- test_agent(data_sources = list(sales_db = src)) @@ -566,7 +595,10 @@ test_that("a measure injected a board source loads its pins when it runs", { skip_if_not_installed("pins") board <- board_with_pins("team-orders" = data.frame(id = 1:3)) - src <- data_source(board, tables = c(orders = "team-orders")) + src <- data_source( + board, + options = data_source_options(include = c(orders = "team-orders")) + ) layer <- semantic_layer( measure( diff --git a/tests/testthat/test-data-dictionary.R b/tests/testthat/test-data-dictionary.R index f753826..4d0b127 100644 --- a/tests/testthat/test-data-dictionary.R +++ b/tests/testthat/test-data-dictionary.R @@ -166,7 +166,7 @@ test_that("describe_table merges the dictionary with the live schema", { expect_match(res@value, "- product_line (character)", fixed = TRUE) expect_match(res@value, "not present in the table: booked_at", fixed = TRUE) expect_match(res@value, "sales.rep = reps.name (many-to-one)", fixed = TRUE) - expect_match(res@value, "Sample rows", fixed = TRUE) + expect_no_match(res@value, "Sample rows", fixed = TRUE) }) test_that("a SQL query delivers a table's entry once", { diff --git a/tests/testthat/test-data-source.R b/tests/testthat/test-data-source.R index 6c55b4b..9326e59 100644 --- a/tests/testthat/test-data-source.R +++ b/tests/testthat/test-data-source.R @@ -31,7 +31,10 @@ test_that("data_source wraps an existing connection without copying", { expect_identical(src$con, con) expect_setequal(list_tables(src), c("sales", "reps")) - src_one <- data_source(con, tables = "sales") + expect_warning( + src_one <- data_source(con, tables = "sales"), + "deprecated" + ) expect_equal(list_tables(src_one), "sales") }) @@ -42,7 +45,13 @@ test_that("data_source supports schema-qualified connection tables", { DBI::dbExecute(con, "CREATE TABLE crm.sales (order_id VARCHAR, revenue DOUBLE)") DBI::dbExecute(con, "INSERT INTO crm.sales VALUES ('o01', 100)") - src <- data_source(con, tables = "crm.sales") + src <- data_source( + con, + options = data_source_options( + include = DBI::Id(schema = "crm", table = "sales"), + sample_rows = 5 + ) + ) expect_equal(list_tables(src), "crm.sales") d <- source_describe(src, "crm.sales") @@ -59,7 +68,10 @@ test_that("data_source supports explicit DBI identifiers", { src <- data_source( con, - tables = list(DBI::Id(schema = "crm", table = "sales")) + options = data_source_options( + include = DBI::Id(schema = "crm", table = "sales"), + sample_rows = 5 + ) ) expect_equal(list_tables(src), "crm.sales") @@ -67,15 +79,120 @@ test_that("data_source supports explicit DBI identifiers", { expect_equal(d$sample$order_id, "o01") }) -test_that("data_source keeps default connection discovery unvalidated", { +test_that("data_source_options selects exact objects and namespace prefixes", { con <- DBI::dbConnect(duckdb::duckdb()) withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) DBI::dbExecute(con, "CREATE SCHEMA crm") - DBI::dbExecute(con, "CREATE TABLE crm.sales (order_id VARCHAR)") + DBI::dbExecute(con, "CREATE TABLE crm.customers (id INTEGER)") + DBI::dbExecute(con, "CREATE TABLE crm.TMP_IMPORT (id INTEGER)") + DBI::dbExecute(con, 'CREATE TABLE "literal.dot" (id INTEGER)') - src <- data_source(con) + namespace <- data_source( + con, + options = data_source_options( + include = DBI::Id(schema = "crm"), + exclude = "TMP_*" + ) + ) + literal <- data_source( + con, + options = data_source_options(include = "literal.dot") + ) + three_level <- data_source( + con, + options = data_source_options( + include = DBI::Id(catalog = "memory", schema = "crm"), + exclude = "TMP_*" + ) + ) - expect_equal(list_tables(src), "sales") + expect_equal(list_tables(namespace), "crm.customers") + expect_equal(list_tables(literal), "literal.dot") + expect_equal(list_tables(three_level), "memory.crm.customers") + expect_equal(source_describe(literal, "literal.dot")$schema$column, "id") +}) + +test_that("data_source_options applies to flat data sources", { + src <- data_source( + orders = data.frame(id = 1), + TMP_IMPORT = data.frame(id = 2), + customers = data.frame(id = 3), + options = data_source_options( + include = c("orders", "TMP_IMPORT"), + exclude = "TMP_*" + ) + ) + + expect_equal(list_tables(src), "orders") +}) + +test_that("DBI identifiers remain exact rather than patterns", { + expect_snapshot( + normalize_connection_includes(DBI::Id(table = "orders*")), + error = TRUE + ) +}) + +test_that("sample_rows opts into bounded live values", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + DBI::dbWriteTable(con, "orders", data.frame(id = 1:5)) + + metadata_only <- data_source(con) + sampled <- data_source( + con, + options = data_source_options(include = "orders", sample_rows = 2) + ) + + expect_equal(nrow(source_describe(metadata_only, "orders")$sample), 0) + expect_equal(nrow(source_describe(sampled, "orders")$sample), 2) +}) + +test_that("connection discovery merges an authored dictionary", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + DBI::dbExecute(con, "CREATE SCHEMA crm") + DBI::dbExecute(con, "CREATE TABLE crm.orders (amount DOUBLE)") + dictionary <- new_data_dictionary(list( + tables = list(orders = list( + description = "One row per order.", + columns = list(amount = list( + type = "number", + description = "Booked revenue." + )), + definitions = list(revenue = list( + expr = "SUM(amount)", + type = "number" + )) + )) + )) + + src <- data_source( + con, + options = data_source_options( + include = DBI::Id(schema = "crm", table = "orders") + ), + dictionary = dictionary + ) + + runtime <- source_runtime_dictionary(src) + expect_equal( + runtime$tables[["crm.orders"]]$description, + "One row per order." + ) + expect_equal( + definitions_registry(list(warehouse = src))$defs$table, + "crm.orders" + ) +}) + +test_that("default connection discovery stays in the current namespace", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + DBI::dbExecute(con, "CREATE SCHEMA crm") + DBI::dbExecute(con, "CREATE TABLE crm.sales (order_id VARCHAR)") + + expect_snapshot(data_source(con), error = TRUE) }) test_that("data_source errors for tables absent from the connection", { @@ -307,7 +424,7 @@ test_that("a failed pin read surfaces at use and is retried, not cached", { suppressMessages( pins::pin_write(board, data.frame(id = 1:5), "team-orders", type = "rds") ) - expect_equal(nrow(source_describe(src, "orders")$sample), 5) + expect_equal(nrow(source_describe(src, "orders", n_sample = 5)$sample), 5) }) test_that("a pin that isn't a data frame errors clearly", { diff --git a/tests/testthat/test-pool.R b/tests/testthat/test-pool.R index 71ed3f1..5be533f 100644 --- a/tests/testthat/test-pool.R +++ b/tests/testthat/test-pool.R @@ -131,7 +131,7 @@ test_that("board-source metrics query without pre-binding the board", { board <- board_with_pins(sales = test_sales()) src <- data_source( board, - tables = c(sales = "sales"), + options = data_source_options(include = c(sales = "sales")), dictionary = local_definitions_dict() ) registry <- definitions_registry(list(sales_db = src)) diff --git a/tests/testthat/test-tools.R b/tests/testthat/test-tools.R index 05c4e5e..7604f18 100644 --- a/tests/testthat/test-tools.R +++ b/tests/testthat/test-tools.R @@ -122,10 +122,10 @@ test_that("format_measure_value collects a lazy dbplyr table", { expect_match(out, "EMEA") }) -test_that("describe_table_tool reports columns and samples", { +test_that("describe_table_tool reports columns without sampling by default", { res <- describe_table_tool(test_source(), "sales") expect_match(res@value, "order_id") - expect_match(res@value, "Sample rows") + expect_no_match(res@value, "Sample rows") }) test_that("search_context_tool handles a missing context layer", { From d3fa579c85e2957dab5f6035188183bd91f731cd Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 11:20:42 -0500 Subject: [PATCH 04/25] integrate native warehouse semantics --- DESCRIPTION | 6 +- R/calculations.R | 255 +++++++++ R/catalog-databricks.R | 546 +++++++++++++++++++ R/catalog-provider.R | 97 +++- R/catalog-snowflake.R | 568 ++++++++++++++++++++ R/catalog.R | 23 +- R/commons.R | 8 +- R/context-layer.R | 135 ++++- R/data-source.R | 1 - R/definitions.R | 13 +- R/pool.R | 429 ++++++++++++++- R/prompt.R | 34 +- R/tools.R | 126 ++++- inst/prompts/system-prompt.md | 1 + tests/testthat/_snaps/calculations.md | 28 + tests/testthat/_snaps/catalog-databricks.md | 18 + tests/testthat/_snaps/data-source.md | 13 +- tests/testthat/helper-calculations.R | 52 ++ tests/testthat/test-calculations.R | 70 +++ tests/testthat/test-catalog-databricks.R | 147 +++++ tests/testthat/test-catalog-snowflake.R | 114 ++++ tests/testthat/test-catalog.R | 2 +- tests/testthat/test-context-layer.R | 59 ++ tests/testthat/test-data-source.R | 19 +- tests/testthat/test-tools.R | 38 ++ 25 files changed, 2725 insertions(+), 77 deletions(-) create mode 100644 R/calculations.R create mode 100644 R/catalog-databricks.R create mode 100644 R/catalog-snowflake.R create mode 100644 tests/testthat/_snaps/calculations.md create mode 100644 tests/testthat/_snaps/catalog-databricks.md create mode 100644 tests/testthat/helper-calculations.R create mode 100644 tests/testthat/test-calculations.R create mode 100644 tests/testthat/test-catalog-databricks.R create mode 100644 tests/testthat/test-catalog-snowflake.R diff --git a/DESCRIPTION b/DESCRIPTION index 8b67c35..bf4b1e1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -35,7 +35,8 @@ Imports: rlang (>= 1.2.0), roxygen2, S7, - utils + utils, + yaml Suggests: bsicons, dbplyr, @@ -51,8 +52,7 @@ Suggests: shinychat (> 0.4.0), testthat (>= 3.0.0), vitals, - withr, - yaml + withr VignetteBuilder: knitr Remotes: posit-dev/shinychat, diff --git a/R/calculations.R b/R/calculations.R new file mode 100644 index 0000000..28b31a4 --- /dev/null +++ b/R/calculations.R @@ -0,0 +1,255 @@ +catalog_calculations_registry <- function(sources) { + registry <- list() + labels <- rlang::names2(sources) + for (i in seq_along(sources)) { + source <- sources[[i]] + catalog <- source$provider$catalog %||% source$catalog + if (!inherits(catalog, "commons_catalog")) { + next + } + for (calculation in catalog$calculations) { + if (!catalog_calculation_available(catalog, calculation)) { + next + } + key <- paste(i, calculation$id, sep = ":") + registry[[key]] <- list( + calculation = calculation, + source = source, + source_name = labels[[i]] + ) + } + } + registry +} + +catalog_calculation_available <- function(catalog, calculation) { + dependencies <- c(catalog$models, catalog$relations)[calculation$dependencies] + !any(vapply( + dependencies, + function(dependency) identical(dependency$access$state, "visible_only"), + logical(1) + )) +} + +calculation_pool_text <- function(entry, show_source = FALSE) { + calculation <- entry$calculation + arguments <- if (length(calculation$arguments)) { + paste(vapply(names(calculation$arguments), function(name) { + argument <- calculation$arguments[[name]] + choices <- if (length(argument$choices)) { + sprintf("; one of %s", paste(argument$choices, collapse = ", ")) + } else { + "" + } + sprintf( + "- `%s` (%s, %s%s)", + name, + argument$type, + if (argument$required) "required" else "optional", + choices + ) + }, character(1)), collapse = "\n") + } else { + "No arguments." + } + paste( + c( + sprintf("### %s", calculation$name), + calculation$description, + if (show_source) sprintf("Source: `%s`", entry$source_name), + sprintf("Run with `call_calculation(name = \"%s\")`.", calculation$name), + arguments + ), + collapse = "\n" + ) +} + +call_catalog_calculation <- function( + registry, + name, + arguments = "{}", + source_name = NULL, + handles = NULL +) { + entry <- resolve_catalog_calculation(registry, name, source_name) + calculation <- entry$calculation + values <- validate_catalog_calculation_args( + calculation, + parse_json_args(arguments) + ) + execution <- calculation$execution + if (identical(execution$kind, "native_metric")) { + cli::cli_abort( + "Calculation {.val {name}} is a native metric; run it with {.fn call_metrics}." + ) + } + prepared <- prepare_catalog_calculation( + execution, + calculation$arguments, + values, + entry$source$con + ) + result <- source_query_bind(entry$source, prepared$sql, prepared$params) + advert <- register_handle(handles, result) + tool_result( + paste(c(df_to_markdown(result), advert), collapse = "\n\n"), + title = sprintf( + "Ran a trusted calculation: %s%s", + html_escape(calculation$name), + source_label(if (nzchar(entry$source_name)) entry$source_name else NULL) + ), + icon = maybe_icon("shield-check"), + markdown = sprintf( + "```sql\n%s\n```\n\n%s", + prepared$sql, + df_to_markdown(result) + ), + html = measure_display_html(values, result), + tag = "A", + show_tag = FALSE + ) +} + +resolve_catalog_calculation <- function( + registry, + name, + source_name = NULL, + call = rlang::caller_env() +) { + matches <- Filter(function(entry) { + identical(entry$calculation$name, name) && + (is.null(source_name) || identical(entry$source_name, source_name)) + }, registry) + if (length(matches) == 1) { + return(matches[[1]]) + } + if (length(matches) > 1) { + cli::cli_abort( + "Calculation {.val {name}} exists in several data sources; supply {.arg source}.", + call = call + ) + } + available <- unique(vapply( + registry, + function(entry) entry$calculation$name, + character(1) + )) + cli::cli_abort( + c( + "No trusted calculation named {.val {name}}.", + "i" = "Available calculations: {.val {available}}." + ), + call = call + ) +} + +validate_catalog_calculation_args <- function( + calculation, + values, + call = rlang::caller_env() +) { + arguments <- calculation$arguments + extra <- setdiff(names(values), names(arguments)) + required <- names(arguments)[vapply(arguments, `[[`, logical(1), "required")] + missing <- setdiff(required, names(values)) + if (length(extra) || length(missing)) { + cli::cli_abort(c( + "Arguments do not match trusted calculation {.val {calculation$name}}.", + "x" = if (length(extra)) "Unknown arguments: {.val {extra}}.", + "x" = if (length(missing)) "Missing arguments: {.val {missing}}." + ), call = call) + } + out <- list() + for (name in names(arguments)) { + argument <- arguments[[name]] + value <- values[[name]] + if (is.null(value)) { + out[[name]] <- NULL + next + } + out[[name]] <- validate_catalog_calculation_value( + value, + argument, + name, + call + ) + } + out +} + +validate_catalog_calculation_value <- function(value, argument, name, call) { + if (length(value) != 1 || is.na(value)) { + cli::cli_abort( + "Calculation argument {.arg {name}} must be one non-missing value.", + call = call + ) + } + valid <- switch( + argument$type, + string = is.character(value), + integer = is.numeric(value) && is.finite(value) && value == as.integer(value), + number = is.numeric(value) && is.finite(value), + logical = is.logical(value), + date = is.character(value) && grepl("^[0-9]{4}-[0-9]{2}-[0-9]{2}$", value) && !is.na(as.Date(value)), + datetime = is.character(value) && grepl("^[0-9]{4}-[0-9]{2}-[0-9]{2}[T ]", value) + ) + if (!isTRUE(valid)) { + cli::cli_abort( + "Calculation argument {.arg {name}} must be a {.val {argument$type}} value.", + call = call + ) + } + if (length(argument$choices) && !as.character(value) %in% argument$choices) { + cli::cli_abort( + c( + "Calculation argument {.arg {name}} is not an allowed value.", + "i" = "Allowed values: {.val {argument$choices}}." + ), + call = call + ) + } + value +} + +prepare_catalog_calculation <- function(execution, arguments, values, con) { + sql <- execution$sql + if (is.null(sql) || !nzchar(sql)) { + cli::cli_abort("The trusted calculation has no executable SQL.") + } + params <- list() + for (binding in execution$bindings) { + argument <- arguments[[binding$argument]] + value <- values[[binding$argument]] + if (identical(binding$method, "identifier")) { + quoted <- as.character(DBI::dbQuoteIdentifier(con, as.character(value))) + sql <- calculation_replace_token(sql, binding$token, quoted) + } else { + if (!is.null(binding$token)) { + sql <- calculation_replace_token(sql, binding$token, "?") + } + params <- c(params, list(value)) + } + } + list(sql = sql, params = params) +} + +calculation_replace_token <- function(sql, token, replacement) { + count <- lengths(regmatches(sql, gregexpr(token, sql, fixed = TRUE))) + if (count != 1) { + cli::cli_abort( + "A trusted calculation binding token must occur exactly once in its SQL." + ) + } + sub(token, replacement, sql, fixed = TRUE) +} + +source_query_bind <- function(source, sql, params) { + if (length(params) == 0) { + return(source_query(source, sql)) + } + check_query(sql) + result <- DBI::dbSendQuery(source$con, sql) + on.exit(DBI::dbClearResult(result), add = TRUE) + DBI::dbBind(result, params) + DBI::dbFetch(result) +} diff --git a/R/catalog-databricks.R b/R/catalog-databricks.R new file mode 100644 index 0000000..286bb12 --- /dev/null +++ b/R/catalog-databricks.R @@ -0,0 +1,546 @@ +databricks_connection_snapshot <- function(con) { + row <- DBI::dbGetQuery( + con, + paste( + "SELECT current_user() AS principal,", + "current_catalog() AS catalog_name, current_schema() AS schema_name,", + "current_version() AS version" + ) + ) + names(row) <- tolower(names(row)) + list( + backend = "databricks", + locator = list(), + principal = row$principal[[1]], + role = NULL, + version = row$version[[1]], + capabilities = list( + describe_json = TRUE, + unity_information_schema = !identical( + tolower(row$catalog_name[[1]]), + "hive_metastore" + ) + ), + namespace = catalog_compact(list( + catalog = row$catalog_name[[1]], + schema = row$schema_name[[1]] + )) + ) +} + +databricks_default_objects <- function(con, call) { + namespace <- databricks_connection_snapshot(con)$namespace + if (!all(c("catalog", "schema") %in% names(namespace))) { + cli::cli_abort( + c( + "The Databricks connection has no current catalog and schema.", + "i" = "Set both on the connection or supply {.arg options} with explicit {.arg include} IDs." + ), + call = call + ) + } + databricks_list_namespace(con, do.call(DBI::Id, namespace), call) +} + +databricks_list_namespace <- function(con, prefix, call) { + components <- prefix@name + catalog <- catalog_path_component(components, "catalog") + schema <- catalog_path_component(components, "schema") + if (is.null(catalog)) { + cli::cli_abort( + "Databricks namespace selection must include a {.field catalog}.", + call = call + ) + } + if (identical(tolower(catalog), "hive_metastore")) { + return(databricks_list_hive_metastore(con, catalog, schema, call)) + } + predicates <- c( + paste0("table_catalog = ", DBI::dbQuoteString(con, catalog)), + "table_schema <> 'information_schema'", + if (!is.null(schema)) { + paste0("table_schema = ", DBI::dbQuoteString(con, schema)) + } + ) + rows <- tryCatch( + DBI::dbGetQuery( + con, + paste( + "SELECT table_catalog, table_schema, table_name, table_type, comment", + "FROM system.information_schema.tables WHERE", + paste(predicates, collapse = " AND ") + ) + ), + error = function(err) { + cli::cli_abort( + "Failed to list Unity Catalog objects in {.val {paste(prefix@name, collapse = '.')}}.", + parent = err, + call = call + ) + } + ) + lapply(seq_len(nrow(rows)), function(i) { + id <- DBI::Id( + catalog = rows$table_catalog[[i]], + schema = rows$table_schema[[i]], + table = rows$table_name[[i]] + ) + kind <- if (grepl("VIEW", rows$table_type[[i]], ignore.case = TRUE)) { + "view" + } else { + "table" + } + catalog_tag_id( + id, + kind, + if (!is.na(rows$comment[[i]])) rows$comment[[i]] + ) + }) +} + +databricks_list_hive_metastore <- function(con, catalog, schema, call) { + if (is.null(schema)) { + cli::cli_abort( + "Selecting {.val hive_metastore} requires a schema-level {.cls DBI::Id}.", + call = call + ) + } + target <- DBI::Id(catalog = catalog, schema = schema) + rows <- tryCatch( + DBI::dbGetQuery(con, paste("SHOW TABLES IN", DBI::dbQuoteIdentifier(con, target))), + error = function(err) { + cli::cli_abort( + "Failed to list hive_metastore schema {.val {schema}}.", + parent = err, + call = call + ) + } + ) + names(rows) <- tolower(names(rows)) + table_name <- rows$tablename %||% rows$table_name + lapply(table_name, function(name) { + catalog_tag_id( + DBI::Id(catalog = catalog, schema = schema, table = name), + "unknown" + ) + }) +} + +databricks_import_semantics <- function(provider) { + selected_ids <- names(provider$relation_labels) + for (relation_id in selected_ids) { + relation <- provider$catalog$relations[[relation_id]] + if (!relation$kind %in% c("view", "unknown")) { + next + } + specification <- databricks_read_metric_yaml(provider$con, relation$path) + if (is.null(specification)) { + next + } + if (!databricks_metric_version_supported(specification$version)) { + diagnostic <- new_catalog_diagnostic( + "databricks_metric_view_version", + sprintf( + "Metric view %s uses unsupported YAML version %s.", + relation$name, + specification$version + ), + entity_id = relation$id, + details = list(version = specification$version) + ) + provider$catalog$diagnostics[[length(provider$catalog$diagnostics) + 1]] <- diagnostic + next + } + relation$kind <- "metric_view" + relation$description <- specification$comment %||% relation$description + provider$catalog$relations[[relation_id]] <- relation + databricks_import_metric_model(provider, relation, specification) + } + validate_commons_catalog(provider$catalog) + invisible(provider) +} + +databricks_metric_version_supported <- function(version) { + as.character(version) %in% c("0.1", "1.0", "1.1") +} + +databricks_read_metric_yaml <- function(con, path) { + components <- stats::setNames(path$components, path$roles) + if (!all(c("catalog", "schema", "table") %in% names(components))) { + return(NULL) + } + definition <- databricks_view_definition( + con, + components[["catalog"]], + components[["schema"]], + components[["table"]] + ) + if (is.null(definition)) { + metadata <- databricks_describe_json(con, path) + definition <- metadata$view_text %||% metadata$viewText + } + if (is.null(definition)) { + return(NULL) + } + specification <- tryCatch( + yaml::yaml.load(definition), + error = function(err) NULL + ) + if (!is.list(specification) || + is.null(specification$version) || + is.null(specification$source) || + (is.null(specification$fields) && + is.null(specification$dimensions) && + is.null(specification$measures))) { + return(NULL) + } + specification +} + +databricks_describe_json <- function(con, path) { + id <- source_path_id(path) + text <- tryCatch( + DBI::dbGetQuery( + con, + paste( + "DESCRIBE TABLE EXTENDED", + DBI::dbQuoteIdentifier(con, id), + "AS JSON" + ) + )[[1]][[1]], + error = function(err) NULL + ) + if (is.null(text)) { + return(list()) + } + tryCatch( + jsonlite::fromJSON(text, simplifyVector = FALSE), + error = function(err) list() + ) +} + +databricks_view_definition <- function(con, catalog, schema, table) { + predicates <- paste( + c( + paste0("table_catalog = ", DBI::dbQuoteString(con, catalog)), + paste0("table_schema = ", DBI::dbQuoteString(con, schema)), + paste0("table_name = ", DBI::dbQuoteString(con, table)) + ), + collapse = " AND " + ) + length_row <- tryCatch( + DBI::dbGetQuery( + con, + paste( + "SELECT length(view_definition) AS definition_length", + "FROM system.information_schema.views WHERE", + predicates + ) + ), + error = function(err) NULL + ) + if (is.null(length_row) || nrow(length_row) == 0 || is.na(length_row[[1]][[1]])) { + return(NULL) + } + length <- as.integer(length_row[[1]][[1]]) + if (length > 200000L) { + return(NULL) + } + starts <- seq.int(1L, max(1L, length), by = 900L) + expressions <- sprintf( + "substring(view_definition, %d, 900) AS chunk_%d", + starts, + seq_along(starts) + ) + row <- DBI::dbGetQuery( + con, + paste( + "SELECT", + paste(expressions, collapse = ", "), + "FROM system.information_schema.views WHERE", + predicates + ) + ) + paste(unlist(row[1, ], use.names = FALSE), collapse = "") +} + +databricks_import_metric_model <- function(provider, relation, specification) { + catalog <- provider$catalog + source <- catalog$sources[[relation$source_id]] + provenance <- new_catalog_provenance( + "certified", + source$id, + locator = catalog_path_label(relation), + harvested_at = Sys.time() + ) + dataset <- databricks_metric_dataset( + catalog, + source, + specification$source, + provenance + ) + catalog <- dataset$catalog + dependencies <- dataset$relation_id + joins <- databricks_flatten_joins(specification$joins %||% list()) + for (join in joins) { + joined <- databricks_metric_dataset( + catalog, + source, + join$source, + provenance + ) + catalog <- joined$catalog + dependencies <- c(dependencies, joined$relation_id) + } + assertions <- Filter(function(join) length(join$rely) > 0, joins) + for (join in assertions) { + root <- catalog$relations[[dataset$relation_id]] + root$constraints[[length(root$constraints) + 1]] <- new_catalog_constraint( + "join_cardinality", + character(), + reference = join$source, + enforcement = "asserted", + native = join$rely, + provenance = provenance + ) + catalog$relations[[dataset$relation_id]] <- root + } + model <- new_catalog_model( + id = catalog_id("model", relation$id), + source_id = source$id, + name = relation$name, + description = specification$comment, + datasets = unique(dependencies), + relationships = specification$joins %||% list(), + execution = list( + kind = "databricks_metric_view", + object = relation$path, + parameters = specification$parameters %||% list() + ), + exposed = relation$id, + dependencies = unique(dependencies), + access = relation$access, + version = as.character(specification$version), + fingerprint = catalog_fingerprint(specification), + provenance = provenance, + extensions = list(databricks = specification) + ) + catalog$models[[model$id]] <- model + definitions <- databricks_metric_definitions( + specification, + model, + relation, + provenance + ) + for (definition in definitions) { + catalog$definitions[[definition$id]] <- definition + } + context <- databricks_metric_context(specification, model, source, provenance) + for (record in context) { + catalog$context[[record$id]] <- record + } + provider$catalog <- catalog +} + +databricks_metric_dataset <- function(catalog, source, value, provenance) { + is_query <- grepl("\\s|^select\\b", value, ignore.case = TRUE) + parts <- if (is_query) character() else strsplit(value, ".", fixed = TRUE)[[1]] + if (length(parts) == 3) { + path <- new_source_path(parts, c("catalog", "schema", "table")) + kind <- "table" + } else { + path <- new_source_path( + c(model_dataset = catalog_fingerprint(value)), + "model_dataset" + ) + kind <- "governed_query" + } + existing <- Filter( + function(relation) identical(relation$path, path), + catalog$relations + ) + if (length(existing)) { + relation_id <- existing[[1]]$id + } else { + relation_id <- catalog_id( + "relation", + source$id, + paste(path$components, collapse = ".") + ) + catalog$relations[[relation_id]] <- new_catalog_relation( + relation_id, + source$id, + path, + kind = kind, + access = new_catalog_access("unknown", "metric-view dependency"), + provenance = provenance, + extensions = list(databricks = list(source = value)) + ) + } + list(catalog = catalog, relation_id = relation_id) +} + +databricks_flatten_joins <- function(joins) { + out <- list() + visit <- function(join) { + out[[length(out) + 1]] <<- join + for (child in join$joins %||% list()) { + visit(child) + } + } + for (join in joins) { + visit(join) + } + out +} + +databricks_metric_definitions <- function( + specification, + model, + relation, + provenance +) { + out <- list() + entries <- list( + dimension = c(specification$fields, specification$dimensions), + metric = specification$measures + ) + for (role in names(entries)) { + for (item in entries[[role]] %||% list()) { + if (is.null(item$name) || grepl("\\*", item$expr %||% "")) { + next + } + definition <- new_catalog_definition( + id = catalog_id("definition", model$id, item$name), + model_id = model$id, + relation_id = relation$id, + role = role, + name = item$name, + label = item$display_name, + description = item$comment, + synonyms = unlist(item$synonyms), + expressions = list(new_catalog_expression( + "databricks", + item$expr, + item + )), + dependencies = model$datasets, + native = list(definition = item), + provenance = provenance, + extensions = list(databricks = item) + ) + out[[definition$id]] <- definition + } + } + out +} + +databricks_metric_context <- function( + specification, + model, + source, + provenance +) { + texts <- unique(c( + specification$comment, + specification$ai_context, + if (!is.null(specification$filter)) { + paste("Model-wide filter:", specification$filter) + } + )) + texts <- texts[!is.na(texts) & nzchar(texts)] + out <- list() + for (i in seq_along(texts)) { + for (delivery in c("first_touch", "retrieval")) { + context <- new_catalog_context( + catalog_id("context", model$id, i, delivery), + source$id, + "metric_view_context", + texts[[i]], + scope = model$id, + delivery = delivery, + authority = list(kind = "certified"), + provenance = provenance + ) + out[[context$id]] <- context + } + } + out +} + +databricks_relation_metadata <- function(con, id) { + rows <- DBI::dbGetQuery( + con, + paste("DESCRIBE TABLE", DBI::dbQuoteIdentifier(con, id)) + ) + names(rows) <- tolower(names(rows)) + rows <- rows[ + !is.na(rows$col_name) & + nzchar(rows$col_name) & + !startsWith(rows$col_name, "#"), + , + drop = FALSE + ] + columns <- lapply(seq_len(nrow(rows)), function(i) { + new_catalog_column( + rows$col_name[[i]], + native_type = rows$data_type[[i]], + logical_type = rows$data_type[[i]], + description = if ("comment" %in% names(rows) && !is.na(rows$comment[[i]])) { + rows$comment[[i]] + } + ) + }) + names(columns) <- vapply(columns, `[[`, character(1), "name") + list( + columns = columns, + constraints = databricks_relation_constraints(con, id), + kind = NULL + ) +} + +databricks_relation_constraints <- function(con, id) { + components <- id@name + if (!all(c("catalog", "schema", "table") %in% names(components)) || + identical(tolower(components[["catalog"]]), "hive_metastore")) { + return(list()) + } + predicates <- paste( + c( + paste0("tc.table_catalog = ", DBI::dbQuoteString(con, components[["catalog"]])), + paste0("tc.table_schema = ", DBI::dbQuoteString(con, components[["schema"]])), + paste0("tc.table_name = ", DBI::dbQuoteString(con, components[["table"]])) + ), + collapse = " AND " + ) + rows <- tryCatch( + DBI::dbGetQuery( + con, + paste( + "SELECT tc.constraint_name, tc.constraint_type, tc.enforced,", + "k.column_name, k.ordinal_position", + "FROM system.information_schema.table_constraints tc", + "JOIN system.information_schema.key_column_usage k USING", + "(constraint_catalog, constraint_schema, constraint_name, table_catalog, table_schema, table_name)", + "WHERE", predicates, + "ORDER BY tc.constraint_name, k.ordinal_position" + ) + ), + error = function(err) NULL + ) + if (is.null(rows) || nrow(rows) == 0) { + return(list()) + } + lapply(split(rows, rows$constraint_name), function(group) { + new_catalog_constraint( + tolower(gsub(" ", "_", group$constraint_type[[1]])), + group$column_name, + enforcement = if (identical(group$enforced[[1]], "YES")) { + "enforced" + } else { + "informational" + }, + native = group + ) + }) +} diff --git a/R/catalog-provider.R b/R/catalog-provider.R index 3e5afed..909ab49 100644 --- a/R/catalog-provider.R +++ b/R/catalog-provider.R @@ -1,6 +1,7 @@ new_catalog_provider <- function(con, options, call = rlang::caller_env()) { started_at <- Sys.time() backend <- catalog_backend(con) + catalog_progress("discovering", backend, started_at) snapshot <- catalog_connection_snapshot(con, backend) source_id <- catalog_id( "source", @@ -47,6 +48,7 @@ new_catalog_provider <- function(con, options, call = rlang::caller_env()) { namespace = snapshot$namespace, identifier_case = catalog_identifier_case(backend), sample_rows = options$sample_rows, + version = snapshot$version, provenance = provenance ) relations <- lapply(seq_along(ids), function(i) { @@ -56,7 +58,9 @@ new_catalog_provider <- function(con, options, call = rlang::caller_env()) { id = catalog_id("relation", source_id, catalog_source_path_key(id)), source_id = source_id, path = path, + kind = attr(id, "commons_kind") %||% "unknown", name = catalog_id_name(id), + description = attr(id, "commons_description"), access = new_catalog_access("unknown", "listed by the connection"), provenance = provenance ) @@ -76,11 +80,13 @@ new_catalog_provider <- function(con, options, call = rlang::caller_env()) { relations = relations, provider = provider ) + provider$lazy <- nchar(paste(labels, collapse = "\n"), type = "bytes") > 4000L + catalog_import_backend(provider) provider$startup <- list( started_at = started_at, elapsed = as.numeric(difftime(Sys.time(), started_at, units = "secs")) ) - provider$lazy <- nchar(paste(labels, collapse = "\n"), type = "bytes") > 4000L + catalog_progress("ready", backend, started_at) provider } @@ -100,6 +106,12 @@ catalog_backend <- function(con) { } catalog_connection_snapshot <- function(con, backend) { + if (identical(backend, "snowflake")) { + return(snowflake_connection_snapshot(con)) + } + if (identical(backend, "databricks")) { + return(databricks_connection_snapshot(con)) + } info <- tryCatch(DBI::dbGetInfo(con), error = function(err) list()) list( backend = backend, @@ -147,6 +159,12 @@ catalog_resolve_selection <- function(con, backend, options, call) { } catalog_default_objects <- function(con, backend, call) { + if (identical(backend, "snowflake")) { + return(snowflake_default_objects(con, call)) + } + if (identical(backend, "databricks")) { + return(databricks_default_objects(con, call)) + } tables <- tryCatch( DBI::dbListTables(con), error = function(err) { @@ -173,6 +191,12 @@ catalog_default_objects <- function(con, backend, call) { } catalog_list_namespace <- function(con, backend, prefix, call) { + if (identical(backend, "snowflake")) { + return(snowflake_list_namespace(con, prefix, call)) + } + if (identical(backend, "databricks")) { + return(databricks_list_namespace(con, prefix, call)) + } listed <- tryCatch( DBI::dbListObjects(con, prefix = prefix), error = function(err) NULL @@ -267,28 +291,66 @@ catalog_provider_hydrate <- function(provider, table, call = rlang::caller_env() if (length(relation$columns)) { return(relation) } + if (identical(relation$kind, "semantic_view")) { + definitions <- Filter( + function(x) identical(x$relation_id, relation$id) && + identical(x$visibility, "public"), + provider$catalog$definitions + ) + relation$columns <- lapply(definitions, function(definition) { + new_catalog_column( + definition$name, + logical_type = definition$logical_type, + description = definition$description, + provenance = definition$provenance + ) + }) + names(relation$columns) <- vapply( + relation$columns, + `[[`, + character(1), + "name" + ) + provider$catalog$relations[[relation_id]] <- relation + return(relation) + } metadata <- tryCatch( catalog_relation_metadata(provider$con, id), error = function(err) err ) if (inherits(metadata, "condition")) { + metadata$message <- gsub( + "\\r?\\n[ \\t]*\\r?\\n", + "\n", + conditionMessage(metadata), + perl = TRUE + ) relation$access <- new_catalog_access("visible_only", conditionMessage(metadata)) provider$catalog$relations[[relation_id]] <- relation cli::cli_abort( - "Table {.val {table}} is visible in catalog metadata but could not be described.", + "Table {.val {table}} could not be described.", parent = metadata, call = call ) } relation$columns <- metadata$columns + relation$constraints <- metadata$constraints %||% relation$constraints + relation$kind <- metadata$kind %||% relation$kind relation$access <- new_catalog_access("queryable", "zero-row metadata query") provider$catalog$relations[[relation_id]] <- relation relation } catalog_relation_metadata <- function(con, id) { + backend <- catalog_backend(con) + if (identical(backend, "snowflake")) { + return(snowflake_relation_metadata(con, id)) + } + if (identical(backend, "databricks")) { + return(databricks_relation_metadata(con, id)) + } result <- DBI::dbSendQuery( con, sprintf( @@ -307,7 +369,7 @@ catalog_relation_metadata <- function(con, id) { ) }) names(columns) <- vapply(columns, `[[`, character(1), "name") - list(columns = columns) + list(columns = columns, constraints = list(), kind = NULL) } catalog_provider_search <- function(provider, query, kinds = NULL, limit = 10L) { @@ -377,3 +439,32 @@ catalog_unique_labels <- function(labels, ids, call) { } labels } + +catalog_tag_id <- function(id, kind = "table", description = NULL) { + attr(id, "commons_kind") <- kind + attr(id, "commons_description") <- description + id +} + +catalog_progress <- function(stage, backend, started_at) { + condition <- structure( + list( + message = sprintf("%s catalog %s", backend, stage), + stage = stage, + backend = backend, + elapsed = as.numeric(difftime(Sys.time(), started_at, units = "secs")) + ), + class = c("commons_catalog_progress", "condition") + ) + signalCondition(condition) + invisible(condition) +} + +catalog_import_backend <- function(provider) { + if (identical(provider$backend, "snowflake")) { + snowflake_import_semantics(provider) + } else if (identical(provider$backend, "databricks")) { + databricks_import_semantics(provider) + } + invisible(provider) +} diff --git a/R/catalog-snowflake.R b/R/catalog-snowflake.R new file mode 100644 index 0000000..86b2efd --- /dev/null +++ b/R/catalog-snowflake.R @@ -0,0 +1,568 @@ +snowflake_connection_snapshot <- function(con) { + row <- DBI::dbGetQuery( + con, + paste( + "SELECT CURRENT_USER() AS principal, CURRENT_ROLE() AS role,", + "CURRENT_DATABASE() AS database_name, CURRENT_SCHEMA() AS schema_name,", + "CURRENT_ACCOUNT() AS account_name" + ) + ) + names(row) <- tolower(names(row)) + list( + backend = "snowflake", + locator = list(account = row$account_name[[1]]), + principal = row$principal[[1]], + role = row$role[[1]], + namespace = catalog_compact(list( + catalog = row$database_name[[1]], + schema = row$schema_name[[1]] + )) + ) +} + +snowflake_default_objects <- function(con, call) { + snapshot <- snowflake_connection_snapshot(con) + namespace <- snapshot$namespace + if (!all(c("catalog", "schema") %in% names(namespace))) { + cli::cli_abort( + c( + "The Snowflake connection has no current database and schema.", + "i" = "Set both on the connection or supply {.arg options} with explicit {.arg include} IDs." + ), + call = call + ) + } + snowflake_list_namespace(con, do.call(DBI::Id, namespace), call) +} + +snowflake_list_namespace <- function(con, prefix, call) { + components <- prefix@name + catalog <- catalog_path_component(components, "catalog") %||% + catalog_path_component(components, "database") + schema <- catalog_path_component(components, "schema") + if (is.null(catalog)) { + cli::cli_abort( + "Snowflake namespace selection must include a {.field catalog} (database).", + call = call + ) + } + target <- if (is.null(schema)) { + paste("IN DATABASE", DBI::dbQuoteIdentifier(con, catalog)) + } else { + id <- DBI::Id(catalog = catalog, schema = schema) + paste("IN SCHEMA", DBI::dbQuoteIdentifier(con, id)) + } + commands <- c( + table = paste("SHOW TERSE TABLES", target), + view = paste("SHOW TERSE VIEWS", target), + semantic_view = paste("SHOW SEMANTIC VIEWS", target) + ) + objects <- list() + for (kind in names(commands)) { + rows <- tryCatch( + DBI::dbGetQuery(con, commands[[kind]]), + error = function(err) NULL + ) + if (is.null(rows) || nrow(rows) == 0) { + next + } + names(rows) <- tolower(names(rows)) + for (i in seq_len(nrow(rows))) { + id <- DBI::Id( + catalog = rows$database_name[[i]], + schema = rows$schema_name[[i]], + table = rows$name[[i]] + ) + objects[[length(objects) + 1]] <- catalog_tag_id( + id, + kind, + if ("comment" %in% names(rows) && !is.na(rows$comment[[i]])) { + rows$comment[[i]] + } + ) + } + } + if (length(objects) == 0) { + return(objects) + } + keys <- vapply(objects, catalog_source_path_key, character(1)) + priority <- vapply(objects, function(id) { + match(attr(id, "commons_kind"), c("semantic_view", "view", "table")) + }, integer(1)) + objects[order(priority)][!duplicated(keys[order(priority)])] +} + +snowflake_import_semantics <- function(provider) { + selected_ids <- names(provider$relation_labels) + for (relation_id in selected_ids) { + relation <- provider$catalog$relations[[relation_id]] + if (!relation$kind %in% c("semantic_view", "unknown")) { + next + } + specification <- snowflake_read_semantic_yaml(provider$con, relation$path) + if (is.null(specification)) { + specification <- snowflake_describe_semantic_view( + provider$con, + relation$path + ) + } + if (is.null(specification)) { + next + } + relation$kind <- "semantic_view" + relation$description <- specification$description %||% relation$description + provider$catalog$relations[[relation_id]] <- relation + snowflake_import_semantic_model(provider, relation, specification) + } + validate_commons_catalog(provider$catalog) + invisible(provider) +} + +snowflake_describe_semantic_view <- function(con, path) { + id <- source_path_id(path) + rows <- tryCatch( + DBI::dbGetQuery( + con, + paste("DESC SEMANTIC VIEW", DBI::dbQuoteIdentifier(con, id)) + ), + error = function(err) NULL + ) + if (is.null(rows) || nrow(rows) == 0) { + return(NULL) + } + names(rows) <- tolower(names(rows)) + specification <- list(name = catalog_id_name(id), tables = list()) + table_rows <- rows[rows$object_kind %in% "TABLE", , drop = FALSE] + for (name in unique(table_rows$object_name)) { + properties <- snowflake_desc_properties( + table_rows[table_rows$object_name == name, , drop = FALSE] + ) + table <- list( + name = name, + base_table = list( + database = properties$base_table_database_name, + schema = properties$base_table_schema_name, + table = properties$base_table_name + ), + primary_key = list(columns = snowflake_json_value(properties$primary_key)) + ) + specification$tables[[name]] <- table + } + kinds <- c( + DIMENSION = "dimensions", + TIME_DIMENSION = "time_dimensions", + FACT = "facts", + METRIC = "metrics", + DERIVED_METRIC = "metrics", + FILTER = "filters" + ) + for (kind in names(kinds)) { + kind_rows <- rows[rows$object_kind %in% kind, , drop = FALSE] + groups <- split( + kind_rows, + paste(kind_rows$parent_entity, kind_rows$object_name, sep = "\r") + ) + for (group in groups) { + properties <- snowflake_desc_properties(group) + item <- list( + name = group$object_name[[1]], + expr = properties$expression, + data_type = properties$data_type, + description = properties$comment, + synonyms = snowflake_json_value(properties$synonyms), + labels = snowflake_json_value(properties$labels), + access_modifier = switch( + properties$access_modifier %||% "PUBLIC", + PRIVATE = "private_access", + "public_access" + ) + ) + parent <- group$parent_entity[[1]] + if (is.na(parent)) { + specification[[kinds[[kind]]]] <- c( + specification[[kinds[[kind]]]], + list(item) + ) + } else { + specification$tables[[parent]][[kinds[[kind]]]] <- c( + specification$tables[[parent]][[kinds[[kind]]]], + list(item) + ) + } + } + } + specification$extensions <- list(snowflake_desc = rows) + specification +} + +snowflake_desc_properties <- function(rows) { + values <- as.list(rows$property_value) + names(values) <- tolower(rows$property) + values[!duplicated(names(values))] +} + +snowflake_json_value <- function(value) { + if (is.null(value) || is.na(value)) { + return(NULL) + } + tryCatch( + jsonlite::fromJSON(value, simplifyVector = TRUE), + error = function(err) value + ) +} + +snowflake_relation_metadata <- function(con, id) { + quoted <- DBI::dbQuoteIdentifier(con, id) + rows <- DBI::dbGetQuery(con, paste("DESC TABLE", quoted)) + names(rows) <- tolower(names(rows)) + rows <- rows[toupper(rows$kind) == "COLUMN", , drop = FALSE] + columns <- lapply(seq_len(nrow(rows)), function(i) { + new_catalog_column( + name = rows$name[[i]], + native_type = rows$type[[i]], + logical_type = rows$type[[i]], + nullable = if ("null?" %in% names(rows)) rows[["null?"]][[i]] == "Y" else NULL, + description = if ("comment" %in% names(rows) && !is.na(rows$comment[[i]])) { + rows$comment[[i]] + } + ) + }) + names(columns) <- vapply(columns, `[[`, character(1), "name") + constraints <- snowflake_desc_constraints(rows) + constraints <- c(constraints, snowflake_foreign_keys(con, id)) + list(columns = columns, constraints = constraints, kind = "table") +} + +snowflake_desc_constraints <- function(rows) { + out <- list() + fields <- c("primary key" = "primary_key", "unique key" = "unique") + for (field in names(fields)) { + if (!field %in% names(rows)) { + next + } + columns <- rows$name[toupper(rows[[field]]) %in% "Y"] + if (length(columns)) { + out[[length(out) + 1]] <- new_catalog_constraint( + fields[[field]], + columns, + enforcement = "informational", + native = list(source = "DESC TABLE") + ) + } + } + out +} + +snowflake_foreign_keys <- function(con, id) { + rows <- tryCatch( + DBI::dbGetQuery( + con, + paste("SHOW IMPORTED KEYS IN TABLE", DBI::dbQuoteIdentifier(con, id)) + ), + error = function(err) NULL + ) + if (is.null(rows) || nrow(rows) == 0) { + return(list()) + } + names(rows) <- tolower(names(rows)) + groups <- split(rows, rows$fk_name) + lapply(groups, function(group) { + new_catalog_constraint( + "foreign_key", + group$fk_column_name, + reference = list( + path = new_source_path( + c( + group$pk_database_name[[1]], + group$pk_schema_name[[1]], + group$pk_table_name[[1]] + ), + c("catalog", "schema", "table") + ), + columns = group$pk_column_name + ), + enforcement = "informational", + native = group + ) + }) +} + +snowflake_read_semantic_yaml <- function(con, path) { + id <- do.call(DBI::Id, as.list(stats::setNames( + path$components, + path$roles + ))) + label <- as.character(DBI::dbQuoteIdentifier(con, id)) + sql <- paste0( + "SELECT SYSTEM$READ_YAML_FROM_SEMANTIC_VIEW(", + DBI::dbQuoteString(con, label), + ") AS specification" + ) + text <- tryCatch( + DBI::dbGetQuery(con, sql)[[1]][[1]], + error = function(err) NULL + ) + if (is.null(text)) { + return(NULL) + } + tryCatch(yaml::yaml.load(text), error = function(err) NULL) +} + +snowflake_import_semantic_model <- function(provider, relation, specification) { + catalog <- provider$catalog + source <- catalog$sources[[relation$source_id]] + provenance <- new_catalog_provenance( + "certified", + source$id, + locator = catalog_path_label(relation), + harvested_at = Sys.time() + ) + model_id <- catalog_id("model", relation$id) + datasets <- character() + logical_tables <- character() + + for (table in specification$tables %||% list()) { + dataset <- snowflake_semantic_dataset(catalog, source, table, provenance) + catalog <- dataset$catalog + datasets <- c(datasets, dataset$relation_id) + logical_tables[[table$name]] <- dataset$relation_id + } + + model <- new_catalog_model( + id = model_id, + source_id = source$id, + name = specification$name %||% relation$name, + description = specification$description, + datasets = datasets, + relationships = specification$relationships %||% list(), + execution = list( + kind = "snowflake_semantic_view", + object = relation$path + ), + exposed = relation$id, + dependencies = datasets, + access = relation$access, + fingerprint = catalog_fingerprint(specification), + provenance = provenance, + extensions = list(snowflake = specification) + ) + catalog$models[[model$id]] <- model + + definitions <- snowflake_semantic_definitions( + specification, + model, + relation, + logical_tables, + provenance + ) + for (definition in definitions) { + catalog$definitions[[definition$id]] <- definition + } + contexts <- snowflake_semantic_context( + specification, + model, + source, + provenance + ) + for (context in contexts) { + catalog$context[[context$id]] <- context + } + calculations <- snowflake_verified_calculations( + specification, + model, + source, + provenance + ) + for (calculation in calculations) { + catalog$calculations[[calculation$id]] <- calculation + } + provider$catalog <- catalog +} + +snowflake_semantic_dataset <- function(catalog, source, table, provenance) { + base <- table$base_table %||% list() + if (all(c("database", "schema", "table") %in% names(base))) { + path <- new_source_path( + c(base$database, base$schema, base$table), + c("catalog", "schema", "table") + ) + kind <- "table" + } else { + path <- new_source_path( + c(model = table$name), + "model_dataset" + ) + kind <- "governed_query" + } + existing <- Filter( + function(relation) identical(relation$path, path), + catalog$relations + ) + if (length(existing)) { + relation_id <- existing[[1]]$id + } else { + relation_id <- catalog_id( + "relation", + source$id, + paste(path$components, collapse = ".") + ) + constraints <- if (length(table$primary_key$columns)) { + list(new_catalog_constraint( + "primary_key", + unlist(table$primary_key$columns), + enforcement = "asserted", + native = table$primary_key, + provenance = provenance + )) + } else { + list() + } + catalog$relations[[relation_id]] <- new_catalog_relation( + relation_id, + source$id, + path, + kind = kind, + name = table$name, + description = table$description, + synonyms = unlist(table$synonyms), + constraints = constraints, + access = new_catalog_access("unknown", "semantic-view dependency"), + provenance = provenance, + extensions = list(snowflake = table) + ) + } + list(catalog = catalog, relation_id = relation_id) +} + +snowflake_semantic_definitions <- function( + specification, + model, + relation, + logical_tables, + provenance +) { + out <- list() + roles <- c( + dimensions = "dimension", + time_dimensions = "time_dimension", + facts = "fact", + metrics = "metric", + filters = "filter" + ) + add <- function(item, role, parent = NULL) { + if ("filter" %in% tolower(unlist(item$labels))) { + role <- "filter" + } + visibility <- if (identical(item$access_modifier, "private_access")) { + "private" + } else { + "public" + } + dependency <- if (is.null(parent)) { + model$datasets + } else { + logical_tables[[parent]] + } + definition <- new_catalog_definition( + id = catalog_id("definition", model$id, parent %||% "model", item$name), + model_id = model$id, + relation_id = relation$id, + role = role, + name = item$name, + label = item$label, + description = item$description, + synonyms = unlist(item$synonyms), + logical_type = item$data_type, + expressions = list(new_catalog_expression( + "snowflake", + item$expr %||% item$name, + item + )), + dependencies = dependency, + visibility = visibility, + native = list(parent = parent, definition = item), + provenance = provenance, + extensions = list(snowflake = item) + ) + out[[definition$id]] <<- definition + } + for (table in specification$tables %||% list()) { + for (field in names(roles)) { + for (item in table[[field]] %||% list()) { + add(item, roles[[field]], table$name) + } + } + } + for (item in specification$metrics %||% list()) { + add(item, "metric") + } + out +} + +snowflake_semantic_context <- function( + specification, + model, + source, + provenance +) { + instructions <- c( + specification$custom_instructions, + unlist(specification$module_custom_instructions, use.names = FALSE) + ) + instructions <- unique(unlist(instructions, use.names = FALSE)) + instructions <- instructions[!is.na(instructions) & nzchar(instructions)] + out <- list() + for (i in seq_along(instructions)) { + for (delivery in c("first_touch", "retrieval")) { + context <- new_catalog_context( + catalog_id("context", model$id, "instruction", i, delivery), + source$id, + "instruction", + instructions[[i]], + scope = model$id, + delivery = delivery, + authority = list(kind = "certified"), + provenance = provenance + ) + out[[context$id]] <- context + } + } + out +} + +snowflake_verified_calculations <- function( + specification, + model, + source, + provenance +) { + out <- list() + for (query in specification$verified_queries %||% list()) { + if (is.null(query$sql) || !nzchar(query$sql)) { + next + } + name <- query$name %||% query$question + calculation <- new_catalog_calculation( + catalog_id("calculation", model$id, name), + source$id, + name, + description = query$question, + dependencies = model$id, + execution = new_catalog_execution( + "verified_sql", + "snowflake", + query$sql, + native = query + ), + provenance = provenance, + extensions = list(snowflake = query) + ) + out[[calculation$id]] <- calculation + } + out +} + +catalog_fingerprint <- function(x) { + raw <- serialize(x, NULL, version = 3) + paste0(length(raw), "-", sum(as.integer(raw) * seq_along(raw)) %% 2147483647) +} diff --git a/R/catalog.R b/R/catalog.R index 2443705..e59c9e8 100644 --- a/R/catalog.R +++ b/R/catalog.R @@ -222,6 +222,9 @@ catalog_definition_registry <- function( validate_commons_catalog(catalog, call = call) rows <- list(no_definitions) for (definition in catalog$definitions) { + if (identical(definition$visibility, "private")) { + next + } relation <- catalog$relations[[definition$relation_id]] table <- if (relation$id %in% names(table_labels)) { unname(table_labels[[relation$id]]) @@ -229,17 +232,27 @@ catalog_definition_registry <- function( relation$name } expression <- catalog_primary_expression(definition$expressions) + model <- catalog$models[[definition$model_id]] + role <- if (identical(definition$role, "time_dimension")) { + "dimension" + } else { + definition$role + } rows[[length(rows) + 1]] <- data.frame( name = definition$name, table = table, source = source, type = definition$logical_type %||% NA_character_, - role = definition$role, + role = role, label = definition$label %||% NA_character_, description = definition$description %||% NA_character_, details = definition$details %||% NA_character_, expr = expression$sql, - expanded = expression$sql + expanded = expression$sql, + execution = model$execution$kind %||% "data_dictionary", + model_id = definition$model_id, + definition_id = definition$id, + native_parent = definition$native$parent %||% NA_character_ ) } list(defs = do.call(rbind, rows)) @@ -774,6 +787,12 @@ new_catalog_binding <- function( token = NULL ) { method <- rlang::arg_match(method) + if (!is.null(token)) { + token <- catalog_string(token, "binding token") + } + if (identical(method, "identifier") && is.null(token)) { + cli::cli_abort("Identifier execution bindings require an explicit token.") + } structure( list( argument = catalog_string(argument, "binding argument"), diff --git a/R/commons.R b/R/commons.R index 92f34ce..fd011d4 100644 --- a/R/commons.R +++ b/R/commons.R @@ -203,6 +203,7 @@ Commons <- R6::R6Class( private$context_layer <- augment_context_layer(context_layer, sources) private$first_touch <- new.env(parent = emptyenv()) private$definitions <- definitions_registry(sources) + private$calculations <- catalog_calculations_registry(sources) private$registry <- semantic_layer$measures private$fn_sources <- semantic_layer$fn_sources private$injections <- resolve_injections( @@ -221,7 +222,8 @@ Commons <- R6::R6Class( "commons.agent.n_data_sources" = length(sources), "commons.agent.has_context_layer" = !is.null(context_layer), "commons.agent.n_measures" = length(semantic_layer$measures), - "commons.agent.n_definitions" = nrow(private$definitions$defs) + "commons.agent.n_definitions" = nrow(private$definitions$defs), + "commons.agent.n_calculations" = length(private$calculations) ) ) @@ -244,7 +246,8 @@ Commons <- R6::R6Class( private$sources, system_prompt, private$definitions, - measures = private$registry + measures = private$registry, + calculations = private$calculations ) ) }, @@ -310,6 +313,7 @@ Commons <- R6::R6Class( context_layer = NULL, registry = NULL, definitions = NULL, + calculations = NULL, fn_sources = NULL, injections = NULL, conversation_id = NULL, diff --git a/R/context-layer.R b/R/context-layer.R index 45a9058..cdcae4d 100644 --- a/R/context-layer.R +++ b/R/context-layer.R @@ -25,14 +25,19 @@ context_layer <- function(files = character()) { # Read eagerly so a bad path fails at construction; index lazily (see # context_store()). docs <- character(0) + metadata <- list() for (path in files) { md <- strip_frontmatter(paste(readLines(path, warn = FALSE), collapse = "\n")) if (nzchar(trimws(md))) { docs <- c(docs, md) + metadata <- c(metadata, list(list(list( + kind = "file", + path = normalizePath(path, mustWork = FALSE) + )))) } } - new_context_layer(docs) + new_context_layer(docs, metadata = metadata) } # Dictionary prose doubles as searchable context, inserted at natural YAML @@ -41,25 +46,103 @@ context_layer <- function(files = character()) { # stays out of the store: first touch owns it, and indexing it would pay for # a second copy the agent already has. augment_context_layer <- function(context_layer, sources) { - chunks <- unlist(lapply( - sources, - function(source) dictionary_context_chunks(source$dictionary) - )) + labels <- rlang::names2(sources) + chunks <- character() + chunk_sources <- list() + chunk_metadata <- list() + for (i in seq_along(sources)) { + source <- sources[[i]] + label <- labels[[i]] + dictionary <- source_runtime_dictionary(source) + dictionary_chunks <- dictionary_context_chunks(dictionary) + catalog <- source$provider$catalog %||% source$catalog + records <- if (inherits(catalog, "commons_catalog")) { + Filter( + function(record) identical(record$delivery, "retrieval"), + catalog$context + ) + } else { + list() + } + catalog_chunks <- vapply(records, `[[`, character(1), "text") + one <- c(dictionary_chunks, catalog_chunks) + chunks <- c(chunks, one) + scope <- if (nzchar(label)) label else character() + chunk_sources <- c(chunk_sources, rep(list(scope), length(one))) + chunk_metadata <- c( + chunk_metadata, + lapply(dictionary_chunks, function(x) { + list(list(kind = "data_dictionary", source = label)) + }), + lapply(records, function(record) { + list(list( + id = record$id, + kind = record$kind, + scope = record$scope, + authority = record$authority, + provenance = record$provenance + )) + }) + ) + } if (length(chunks) == 0) { return(context_layer) } layer <- context_layer %||% context_layer() - new_context_layer(c(layer$docs, chunks)) + context_layer_merge( + layer$docs, + layer$sources, + layer$metadata, + chunks, + chunk_sources, + chunk_metadata + ) } -new_context_layer <- function(docs) { +new_context_layer <- function( + docs, + sources = rep(list(character()), length(docs)), + metadata = rep(list(list()), length(docs)) +) { + if (!is.list(sources)) { + sources <- lapply(sources, function(source) { + if (is.na(source) || !nzchar(source)) character() else source + }) + } structure( - list(docs = docs, cache = new.env(parent = emptyenv())), + list( + docs = docs, + sources = sources, + metadata = metadata, + cache = new.env(parent = emptyenv()) + ), class = "commons_context_layer" ) } +context_layer_merge <- function( + docs, + sources, + metadata, + new_docs, + new_sources, + new_metadata +) { + for (i in seq_along(new_docs)) { + hit <- match(new_docs[[i]], docs) + if (is.na(hit)) { + docs <- c(docs, new_docs[[i]]) + sources <- c(sources, list(new_sources[[i]])) + metadata <- c(metadata, list(new_metadata[[i]])) + } else { + sources[[hit]] <- unique(c(sources[[hit]], new_sources[[i]])) + metadata[[hit]] <- c(metadata[[hit]], new_metadata[[i]]) + } + } + new_context_layer(docs, sources, metadata) +} + dictionary_context_chunks <- function(dictionary) { if (is.null(dictionary)) { return(character(0)) @@ -103,27 +186,49 @@ strip_frontmatter <- function(md) { # it's deferred to the first search. The cache environment is created fresh # whenever a layer's docs change, so layers sharing docs share a store and # layers that differ never do. -context_store <- function(layer) { - if (is.null(layer$cache$store)) { +context_store <- function(layer, source = NULL) { + key <- if (is.null(source)) "store" else paste0("store:", source) + if (is.null(layer$cache[[key]])) { local_commons_span( "commons_context_store_build", attributes = list("commons.context.n_docs" = length(layer$docs)) ) + keep <- if (is.null(source)) { + rep(TRUE, length(layer$docs)) + } else { + vapply( + layer$sources, + function(sources) length(sources) == 0 || source %in% sources, + logical(1) + ) + } + docs <- layer$docs[keep] store <- ragnar::ragnar_store_create(embed = NULL) - for (doc in layer$docs) { + for (doc in docs) { ragnar::ragnar_store_insert(store, ragnar::markdown_chunk(doc)) } ragnar::ragnar_store_build_index(store, type = "fts") - layer$cache$store <- store + layer$cache[[key]] <- store } - layer$cache$store + layer$cache[[key]] } -context_search <- function(layer, query, n = 3) { +context_search <- function(layer, query, n = 3, source = NULL) { if (length(layer$docs) == 0) { return(character(0)) } - res <- ragnar::ragnar_retrieve_bm25(context_store(layer), query, top_k = n) + if (!is.null(source) && !any(vapply( + layer$sources, + function(sources) length(sources) == 0 || source %in% sources, + logical(1) + ))) { + return(character(0)) + } + res <- ragnar::ragnar_retrieve_bm25( + context_store(layer, source), + query, + top_k = n + ) if (nrow(res) == 0) { return(character(0)) } diff --git a/R/data-source.R b/R/data-source.R index 3bfe288..d4f0e35 100644 --- a/R/data-source.R +++ b/R/data-source.R @@ -166,7 +166,6 @@ data_source_connection <- function( labels = names(provider$table_ids), ids = provider$table_ids ) - check_table_ids_exist(con, table_registry, call = call) commons_span_set_attribute( span, "commons.data_source.n_tables", diff --git a/R/definitions.R b/R/definitions.R index d1401ed..2c228d0 100644 --- a/R/definitions.R +++ b/R/definitions.R @@ -223,7 +223,11 @@ definition_fields <- c( "description", "details", "expr", - "expanded" + "expanded", + "execution", + "model_id", + "definition_id", + "native_parent" ) no_definitions <- data.frame( @@ -246,6 +250,7 @@ definition_rows <- function(definitions, table, source) { character(1) ) } + out$execution[is.na(out$execution)] <- "data_dictionary" out } @@ -284,6 +289,12 @@ expand_definitions <- function(sql, defs, call = rlang::caller_env()) { applied <- NULL for (token in tokens) { def <- resolve_definition_token(token, sql, defs, call = call) + if (!identical(def$execution[[1]], "data_dictionary")) { + cli::cli_abort( + "Governed definition {.val {token}} uses native semantic execution and cannot be expanded into free-form SQL; use {.fn call_metrics}.", + call = call + ) + } # gsub replacement treats backslashes specially; the expansion is # literal SQL. replacement <- gsub( diff --git a/R/pool.R b/R/pool.R index 2eb5ecb..32cf20f 100644 --- a/R/pool.R +++ b/R/pool.R @@ -10,13 +10,33 @@ call_metrics_impl <- function( dimensions = NULL, filters = NULL, where = NULL, - source_name = NULL + source_name = NULL, + arguments = "{}" ) { source <- resolve_sql_source(sources, source_name) label <- source_name %||% rlang::names2(sources)[[1]] defs <- registry_defs(registry, label) metric_defs <- resolve_pool_names(metrics, defs, role = "metric") + executions <- unique(metric_defs$execution) + if (length(executions) != 1) { + cli::cli_abort("Metrics in one query must use the same native execution path.") + } + if (!identical(executions, "data_dictionary")) { + return(call_native_metrics( + executions, + metric_defs, + defs, + source, + handles, + metrics, + dimensions, + filters, + where, + arguments, + source_name + )) + } tables <- unique(metric_defs$table) if (length(tables) > 1) { cli::cli_abort( @@ -27,7 +47,7 @@ call_metrics_impl <- function( ) } on_table <- defs[defs$table == tables, ] - columns <- names(source$dictionary$tables[[tables]]$columns) + columns <- names(source_runtime_dictionary(source)$tables[[tables]]$columns) con <- source$con id <- DBI::dbQuoteIdentifier(con, source$table_ids[[tables]]) @@ -85,6 +105,343 @@ call_metrics_impl <- function( ) } +native_metric_query <- function(source, model_id, sql) { + result <- tryCatch(source_query(source, sql), error = function(err) err) + if (inherits(result, "condition")) { + message <- conditionMessage(result) + state <- if (grepl( + "permission|not authorized|insufficient privilege|access denied", + message, + ignore.case = TRUE + )) { + "visible_only" + } else { + "unknown" + } + catalog_model_access(source, model_id, state, message) + rlang::cnd_signal(result) + } + catalog_model_access(source, model_id, "queryable", "native query succeeded") + result +} + +catalog_model_access <- function(source, model_id, state, evidence) { + model <- source$provider$catalog$models[[model_id]] + model$access <- new_catalog_access(state, evidence) + source$provider$catalog$models[[model_id]] <- model + for (relation_id in model$exposed) { + relation <- source$provider$catalog$relations[[relation_id]] + relation$access <- new_catalog_access(state, evidence) + source$provider$catalog$relations[[relation_id]] <- relation + } + invisible(source) +} + +call_native_metrics <- function( + execution, + metric_defs, + defs, + source, + handles, + metrics, + dimensions, + filters, + where, + arguments, + source_name +) { + model_ids <- unique(metric_defs$model_id) + if (length(model_ids) != 1) { + cli::cli_abort("Metrics in one query must belong to the same semantic model.") + } + on_model <- defs[defs$model_id == model_ids, ] + sql <- switch( + execution, + snowflake_semantic_view = snowflake_metric_sql( + source, + model_ids, + metric_defs, + on_model, + dimensions, + filters, + where, + arguments + ), + databricks_metric_view = databricks_metric_sql( + source, + model_ids, + metric_defs, + on_model, + dimensions, + filters, + where, + arguments + ), + cli::cli_abort("Unsupported native metric execution kind {.val {execution}}.") + ) + result <- native_metric_query(source, model_ids, sql) + metric_tool_result( + result, + sql, + handles, + metrics, + dimensions, + filters, + source_name + ) +} + +snowflake_metric_sql <- function( + source, + model_id, + metrics, + defs, + dimensions, + filters, + where, + arguments = "{}" +) { + if (!identical(arguments, "{}") && length(parse_json_args(arguments))) { + cli::cli_abort("This Snowflake semantic view does not expose runtime parameters.") + } + con <- source$con + model <- source$provider$catalog$models[[model_id]] + object <- source_path_id(model$execution$object) + dimension_defs <- resolve_pool_names( + dimensions, + defs, + role = "dimension" + ) + filter_defs <- resolve_pool_names(filters, defs, role = "filter") + parts <- c( + as.character(DBI::dbQuoteIdentifier(con, object)), + if (nrow(dimension_defs)) { + paste( + "DIMENSIONS", + paste(native_definition_references(dimension_defs, con), collapse = ", ") + ) + }, + paste( + "METRICS", + paste(native_definition_references(metrics, con), collapse = ", ") + ) + ) + conditions <- c( + native_definition_references(filter_defs, con), + native_where_conditions(where, defs, con) + ) + if (length(conditions)) { + parts <- c(parts, paste("WHERE", paste(conditions, collapse = " AND "))) + } + paste0("SELECT * FROM SEMANTIC_VIEW(\n ", paste(parts, collapse = "\n "), "\n)") +} + +databricks_metric_sql <- function( + source, + model_id, + metrics, + defs, + dimensions, + filters, + where, + arguments = "{}" +) { + if (length(filters)) { + cli::cli_abort("Databricks metric views do not expose named runtime filters.") + } + con <- source$con + model <- source$provider$catalog$models[[model_id]] + object <- source_path_id(model$execution$object) + object_sql <- databricks_metric_source( + object, + model$execution$parameters, + arguments, + con + ) + dimension_defs <- resolve_pool_names( + dimensions, + defs, + role = "dimension" + ) + dimension_names <- vapply( + dimension_defs$name, + function(name) as.character(DBI::dbQuoteIdentifier(con, name)), + character(1) + ) + metric_sql <- vapply(metrics$name, function(name) { + quoted <- DBI::dbQuoteIdentifier(con, name) + sprintf("MEASURE(%s) AS %s", quoted, quoted) + }, character(1)) + sql <- paste( + "SELECT", + paste(c(dimension_names, metric_sql), collapse = ", "), + "FROM", + object_sql + ) + conditions <- native_where_conditions(where, defs, con) + if (length(conditions)) { + sql <- paste(sql, "WHERE", paste(conditions, collapse = " AND ")) + } + if (length(dimension_names)) { + sql <- paste(sql, "GROUP BY", paste(dimension_names, collapse = ", ")) + } + sql +} + +databricks_metric_source <- function(object, parameters, arguments, con) { + quoted <- as.character(DBI::dbQuoteIdentifier(con, object)) + values <- parse_json_args(arguments %||% "{}") + if (length(parameters) == 0) { + if (length(values)) { + cli::cli_abort("This metric view does not accept parameters.") + } + return(quoted) + } + parameter_names <- vapply(parameters, `[[`, character(1), "name") + extra <- setdiff(names(values), parameter_names) + required <- parameter_names[!vapply( + parameters, + function(parameter) "default" %in% names(parameter), + logical(1) + )] + missing <- setdiff(required, names(values)) + if (length(extra) || length(missing)) { + cli::cli_abort(c( + "Metric-view parameters do not match the model.", + "x" = if (length(extra)) "Unknown parameters: {.val {extra}}.", + "x" = if (length(missing)) "Missing parameters: {.val {missing}}." + )) + } + supplied <- intersect(parameter_names, names(values)) + if (length(supplied) == 0) { + return(quoted) + } + sql <- vapply(supplied, function(name) { + parameter <- parameters[[match(name, parameter_names)]] + paste( + DBI::dbQuoteIdentifier(con, name), + "=>", + databricks_parameter_value(values[[name]], parameter$data_type, con) + ) + }, character(1)) + paste0(quoted, "(", paste(sql, collapse = ", "), ")") +} + +databricks_parameter_value <- function(value, type, con) { + if (length(value) != 1 || is.null(value) || is.na(value)) { + cli::cli_abort("Metric-view parameter values must be non-missing scalars.") + } + normalized <- tolower(trimws(type)) + if (grepl("^(tinyint|smallint|int|integer|bigint)$", normalized)) { + if (!is.numeric(value) || value != as.integer(value)) { + cli::cli_abort("Metric-view parameter type {.val {type}} requires an integer.") + } + return(as.character(as.integer(value))) + } + if (grepl("^(float|double|real|decimal|decimal\\([0-9]+,[0-9]+\\))$", normalized)) { + if (!is.numeric(value) || !is.finite(value)) { + cli::cli_abort("Metric-view parameter type {.val {type}} requires a number.") + } + return(as.character(value)) + } + if (normalized %in% c("boolean", "bool")) { + if (!is.logical(value)) { + cli::cli_abort("Metric-view parameter type {.val {type}} requires true or false.") + } + return(if (value) "TRUE" else "FALSE") + } + if (normalized == "date") { + if (!is.character(value) || is.na(as.Date(value))) { + cli::cli_abort("Metric-view date parameters require an ISO date string.") + } + return(paste0("CAST(", DBI::dbQuoteString(con, value), " AS DATE)")) + } + if (normalized %in% c("timestamp", "timestamp_ntz", "datetime")) { + if (!is.character(value) || !grepl("^[0-9]{4}-[0-9]{2}-[0-9]{2}", value)) { + cli::cli_abort("Metric-view timestamp parameters require an ISO timestamp string.") + } + cast <- if (normalized == "timestamp_ntz") "TIMESTAMP_NTZ" else "TIMESTAMP" + return(paste0("CAST(", DBI::dbQuoteString(con, value), " AS ", cast, ")")) + } + if (grepl("^(string|varchar|char)(\\([0-9]+\\))?$", normalized)) { + if (!is.character(value)) { + cli::cli_abort("Metric-view parameter type {.val {type}} requires a string.") + } + return(as.character(DBI::dbQuoteString(con, value))) + } + cli::cli_abort("Unsupported metric-view parameter type {.val {type}}.") +} + +native_definition_references <- function(defs, con) { + vapply(seq_len(nrow(defs)), function(i) { + parent <- defs$native_parent[[i]] + if (is.na(parent) || !nzchar(parent)) { + return(as.character(DBI::dbQuoteIdentifier(con, defs$name[[i]]))) + } + as.character(DBI::dbQuoteIdentifier( + con, + DBI::Id(schema = parent, table = defs$name[[i]]) + )) + }, character(1)) +} + +native_where_conditions <- function(where, defs, con) { + vapply(normalize_where(where), function(triple) { + for (field in c("column", "op", "value")) { + value <- triple[[field]] + if (length(value) != 1 || is.na(value) || !nzchar(as.character(value))) { + cli::cli_abort("Each {.arg where} entry needs {.field column}, {.field op}, and {.field value}.") + } + triple[[field]] <- as.character(value) + } + if (!triple$op %in% where_ops) { + cli::cli_abort("{.arg where} operator must be one of {.val {where_ops}}.") + } + dimension <- resolve_pool_name(triple$column, defs, "dimension") + reference <- native_definition_references(dimension, con) + value <- if (grepl("^-?[0-9]+(\\.[0-9]+)?$", triple$value)) { + triple$value + } else { + as.character(DBI::dbQuoteString(con, triple$value)) + } + sprintf("(%s %s %s)", reference, triple$op, value) + }, character(1)) +} + +source_path_id <- function(path) { + do.call(DBI::Id, as.list(stats::setNames(path$components, path$roles))) +} + +metric_tool_result <- function( + result, + sql, + handles, + metrics, + dimensions, + filters, + source_name +) { + advert <- register_handle(handles, result) + args <- drop_nulls(list( + metrics = metrics, + dimensions = dimensions, + filters = filters + )) + tool_result( + paste(c(df_to_markdown(result), advert), collapse = "\n\n"), + title = sprintf( + "Ran a trusted calculation: %s%s", + html_escape(paste(metrics, collapse = ", ")), + source_label(source_name) + ), + icon = maybe_icon("shield-check"), + markdown = sprintf("```sql\n%s\n```\n\n%s", sql, df_to_markdown(result)), + html = measure_display_html(args, result), + tag = "A", + show_tag = FALSE + ) +} + registry_has_metrics <- function(registry) { any(registry$defs$role == "metric") } @@ -209,10 +566,11 @@ search_pool_text <- function( measures, registry, query, - source_names = character() + source_names = character(), + calculations = list() ) { defs <- registry_defs(registry) - if (length(measures) == 0 && nrow(defs) == 0) { + if (length(measures) == 0 && nrow(defs) == 0 && length(calculations) == 0) { return("The semantic layer is empty.") } @@ -223,6 +581,15 @@ search_pool_text <- function( function(td) paste(tool_name(td), tool_description(td)), character(1) ), + vapply(calculations, function(entry) { + calculation <- entry$calculation + paste( + calculation$name, + calculation$description, + names(calculation$arguments), + entry$source_name + ) + }, character(1)), paste( defs$name, defs$table, @@ -244,8 +611,16 @@ search_pool_text <- function( function(hit) { if (hit <= length(measures)) { measure_schema_text(measures[[hit]], source_names = source_names) + } else if (hit <= length(measures) + length(calculations)) { + calculation_pool_text( + calculations[[hit - length(measures)]], + show_source = length(source_names) > 1 + ) } else { - definition_pool_text(defs[hit - length(measures), ], defs) + definition_pool_text( + defs[hit - length(measures) - length(calculations), ], + defs + ) } }, character(1) @@ -255,23 +630,35 @@ search_pool_text <- function( definition_pool_text <- function(def, defs) { role <- def$role - invoke <- switch( - role, - filter = sprintf( - "Apply in run_sql (e.g. `WHERE {{%s}}`) or as a call_metrics filter.", - def$name - ), - metric = sprintf( - "Query with call_metrics (metrics = [\"%s\"]) or in run_sql as `SELECT {{%s}} AS %s`.", - def$name, - def$name, - def$name - ), - sprintf( - "Use in run_sql SELECT or GROUP BY as `{{%s}}`, or as a call_metrics dimension.", - def$name + invoke <- if (!identical(def$execution[[1]], "data_dictionary")) { + switch( + role, + metric = sprintf( + "Query with call_metrics (metrics = [\"%s\"]).", + def$name + ), + filter = sprintf("Use as a call_metrics filter: %s.", def$name), + sprintf("Use as a call_metrics dimension: %s.", def$name) ) - ) + } else { + switch( + role, + filter = sprintf( + "Apply in run_sql (e.g. `WHERE {{%s}}`) or as a call_metrics filter.", + def$name + ), + metric = sprintf( + "Query with call_metrics (metrics = [\"%s\"]) or in run_sql as `SELECT {{%s}} AS %s`.", + def$name, + def$name, + def$name + ), + sprintf( + "Use in run_sql SELECT or GROUP BY as `{{%s}}`, or as a call_metrics dimension.", + def$name + ) + ) + } siblings <- NULL if (identical(role, "metric")) { diff --git a/R/prompt.R b/R/prompt.R index 14e2bf8..90c7fe0 100644 --- a/R/prompt.R +++ b/R/prompt.R @@ -2,16 +2,18 @@ commons_system_prompt <- function( sources, system_prompt, definitions = NULL, - measures = list() + measures = list(), + calculations = list() ) { definitions <- definitions %||% definitions_registry(sources) template <- read_system_prompt(system_prompt) - data <- system_prompt_data(sources, definitions, measures) + data <- system_prompt_data(sources, definitions, measures, calculations) render_system_prompt(template, data) } -system_prompt_data <- function(sources, definitions, measures) { +system_prompt_data <- function(sources, definitions, measures, calculations) { has_measures <- length(measures) > 0 + has_calculations <- length(calculations) > 0 has_metrics <- registry_has_metrics(definitions) has_definitions <- nrow(registry_defs(definitions)) > 0 dictionary_context <- dictionary_context_text(sources) @@ -20,10 +22,12 @@ system_prompt_data <- function(sources, definitions, measures) { list( date = as.character(Sys.Date()), has_measures = has_measures, + has_calculations = has_calculations, has_metrics = has_metrics, has_definitions = has_definitions, - has_governed_operations = has_measures || has_definitions, - has_search_pool = pool_searchable(measures, definitions), + has_governed_operations = has_measures || has_definitions || + has_calculations, + has_search_pool = pool_searchable(measures, definitions, calculations), has_multiple_sources = length(sources) > 1, has_dictionary_context = nzchar(dictionary_context) || nzchar(glossary_context), @@ -33,13 +37,12 @@ system_prompt_data <- function(sources, definitions, measures) { dictionary_context = dictionary_context, glossary_context = glossary_context, definition_index = definition_index_text(definitions), - definition_action = - "- Apply a definition as a `{{name}}` token in `run_sql` SQL.", + definition_action = definition_action_text(definitions), definition_guidance = paste( "# Governed definitions", paste0( - "Trusted expressions from the data dictionary are indexed here by ", - "table; each table's dictionary entry delivers its full definitions. ", + "Governed definitions are indexed here by table. Native semantic ", + "metrics run through `call_metrics`. For data-dictionary expressions: ", "Write them as `{{name}}` tokens anywhere in `run_sql` SQL ", "(`{{table.name}}` when a name exists on several tables); each expands ", "to its governed SQL before the query runs. Expansion can't add an ", @@ -51,6 +54,19 @@ system_prompt_data <- function(sources, definitions, measures) { ) } +definition_action_text <- function(definitions) { + defs <- registry_defs(definitions) + c( + if (any(defs$execution == "data_dictionary")) { + "- Apply a data-dictionary definition as a `{{name}}` token in `run_sql` SQL." + }, + if (any(defs$execution != "data_dictionary")) { + "- Run native semantic metrics with `call_metrics`; do not copy their SQL expressions into `run_sql`." + } + ) |> + paste(collapse = "\n") +} + render_system_prompt <- function( template, data, diff --git a/R/tools.R b/R/tools.R index e5e218e..a518305 100644 --- a/R/tools.R +++ b/R/tools.R @@ -2,10 +2,17 @@ # surface should imply operations it doesn't have. build_commons_tools <- function(self, private) { c( - if (pool_searchable(private$registry, private$definitions)) { + if (pool_searchable( + private$registry, + private$definitions, + private$calculations + )) { list(tool_search_pool(private)) }, if (length(private$registry) > 0) list(tool_call_measure(private)), + if (length(private$calculations) > 0) { + list(tool_call_calculation(private)) + }, if (registry_has_metrics(private$definitions)) { list(tool_call_metrics(private)) }, @@ -71,8 +78,9 @@ tool_search_catalog <- function(private) { # Measures are never listed in the system prompt, and definitions past their # ambient cap aren't either; a search tool over a fully visible pool would # just cost the model a verification round trip. -pool_searchable <- function(measures, definitions) { - length(measures) > 0 || definitions_overflow(definitions) +pool_searchable <- function(measures, definitions, calculations = list()) { + length(measures) > 0 || length(calculations) > 0 || + definitions_overflow(definitions) } tool_search_pool <- function(private) { @@ -83,6 +91,9 @@ tool_search_pool <- function(private) { } kinds <- c( if (length(private$registry) > 0) "measures (run with call_measure)", + if (length(private$calculations) > 0) { + "trusted warehouse calculations (run with call_calculation)" + }, if (nrow(registry_defs(private$definitions)) > 0) { "governed definitions (apply as {{name}} tokens in run_sql, or through call_metrics)" } @@ -93,7 +104,8 @@ tool_search_pool <- function(private) { private$registry, private$definitions, query, - source_names + source_names, + private$calculations ) tool_result( body, @@ -126,6 +138,7 @@ tool_call_metrics <- function(private) { dimensions = NULL, filters = NULL, where = NULL, + arguments = "{}", source = NULL ) { call_metrics_impl( @@ -136,12 +149,17 @@ tool_call_metrics <- function(private) { dimensions = dimensions, filters = filters, where = where, + arguments = arguments, source_name = source ) }, sprintf( "Compute governed metrics, optionally grouped and filtered. Metric, dimension, and filter names come from %s; commons compiles and runs the query.", - if (pool_searchable(private$registry, private$definitions)) { + if (pool_searchable( + private$registry, + private$definitions, + private$calculations + )) { "the system prompt or search_pool" } else { "the system prompt" @@ -176,6 +194,10 @@ tool_call_metrics <- function(private) { "Simple column predicates, e.g. a date range.", required = FALSE ), + arguments = ellmer::type_string( + "A JSON object of native semantic-model parameter values.", + required = FALSE + ), source = sql_source_type(private$sources) ), name = "call_metrics", @@ -187,6 +209,36 @@ tool_call_metrics <- function(private) { ) } +tool_call_calculation <- function(private) { + ellmer::tool( + function(name, arguments = "{}", source = NULL) { + call_catalog_calculation( + private$calculations, + name, + arguments, + source, + private$handles + ) + }, + "Run an exact trusted warehouse calculation returned by search_pool. Arguments are typed and bound without SQL interpolation.", + arguments = list( + name = ellmer::type_string( + "The calculation name, exactly as returned by search_pool." + ), + arguments = ellmer::type_string( + "A JSON object using exactly the calculation's argument names." + ), + source = sql_source_type(private$sources) + ), + name = "call_calculation", + annotations = ellmer::tool_annotations( + title = "Run a trusted calculation", + icon = maybe_icon("shield-check"), + read_only_hint = TRUE + ) + ) +} + tool_call_measure <- function(private) { ellmer::tool( function(name, arguments = "{}") { @@ -219,12 +271,15 @@ tool_call_measure <- function(private) { tool_search_context <- function(private) { ellmer::tool( - function(query) search_context_tool(private$context_layer, query), + function(query, source = NULL) { + search_context_tool(private$context_layer, query, source) + }, "Search context for metric definitions, data notes, and table relationships.", arguments = list( query = ellmer::type_string( "What you need context about, in plain language." - ) + ), + source = sql_source_type(private$sources) ), name = "search_context", annotations = ellmer::tool_annotations( @@ -301,7 +356,9 @@ run_sql_description <- function(definitions, measures = list()) { if (length(measures) > 0) { "Use this when no registered measure answers the question." }, - if (!is.null(definitions) && nrow(registry_defs(definitions)) > 0) { + if (!is.null(definitions) && any( + registry_defs(definitions)$execution == "data_dictionary" + )) { paste0( "Governed definitions can be written as {{name}} tokens anywhere ", "in the SQL; each expands to its trusted expression before the ", @@ -360,11 +417,11 @@ call_measure_tool <- function( ) } -search_context_tool <- function(context, query) { +search_context_tool <- function(context, query, source = NULL) { if (is.null(context)) { return("No context layer is configured for this agent.") } - hits <- context_search(context, query) + hits <- context_search(context, query, source = source) body <- if (length(hits)) { paste(hits, collapse = "\n\n---\n\n") } else { @@ -381,7 +438,12 @@ search_context_tool <- function(context, query) { describe_table_tool <- function(source, table, source_name = NULL, tracker = NULL) { d <- source_describe(source, table) dictionary <- source_runtime_dictionary(source) - entry <- dictionary$tables[[table]] + entry <- dictionary$tables[[table]] %||% NULL + context <- if (!table_touched(tracker, source_name, table)) { + catalog_first_touch_text(source, table) + } else { + character() + } sample <- if (nrow(d$sample)) { sprintf( @@ -392,10 +454,10 @@ describe_table_tool <- function(source, table, source_name = NULL, tracker = NUL if (is.null(entry)) { parts <- c( sprintf("Columns of `%s`:\n\n%s", table, df_to_markdown(d$schema)), + context, sample ) } else { - mark_table_touched(tracker, source_name, table) columns <- sprintf( "Columns of `%s`:\n\n%s", table, @@ -403,9 +465,11 @@ describe_table_tool <- function(source, table, source_name = NULL, tracker = NUL ) parts <- c( dictionary_entry_parts(dictionary, table, columns), + context, sample ) } + mark_table_touched(tracker, source_name, table) body <- paste(parts, collapse = "\n\n") tool_result( @@ -447,7 +511,7 @@ run_sql_tool <- function( # appends a harmless note. dictionary_sql_entries <- function(source, sql, source_name, tracker) { dictionary <- source_runtime_dictionary(source) - tables <- names(dictionary$tables) + tables <- source$tables hits <- tables[vapply( tables, function(table) grepl(word_pattern(table), sql, ignore.case = TRUE), @@ -465,11 +529,43 @@ dictionary_sql_entries <- function(source, sql, source_name, tracker) { for (table in hits) { mark_table_touched(tracker, source_name, table) } - vapply( + unname(vapply( hits, - function(table) dictionary_entry_text(dictionary, table), + function(table) paste( + c( + if (!is.null(dictionary$tables[[table]])) { + dictionary_entry_text(dictionary, table) + }, + catalog_first_touch_text(source, table) + ), + collapse = "\n\n" + ), character(1) + )) +} + +catalog_first_touch_text <- function(source, table) { + catalog <- source$provider$catalog %||% source$catalog + if (!inherits(catalog, "commons_catalog")) { + return(character()) + } + relation_ids <- names(source$relation_labels)[source$relation_labels == table] + if (length(relation_ids) == 0) { + return(character()) + } + model_ids <- names(Filter( + function(model) any(relation_ids %in% model$exposed), + catalog$models + )) + scopes <- c(relation_ids, model_ids) + records <- Filter( + function(record) { + identical(record$delivery, "first_touch") && + (length(record$scope) == 0 || any(record$scope %in% scopes)) + }, + catalog$context ) + unique(vapply(records, `[[`, character(1), "text")) } # Which tables' dictionary entries this conversation has already seen, so diff --git a/inst/prompts/system-prompt.md b/inst/prompts/system-prompt.md index 8ec56c8..081b19d 100644 --- a/inst/prompts/system-prompt.md +++ b/inst/prompts/system-prompt.md @@ -19,6 +19,7 @@ Do not announce tool calls; before your final response to the user, you should o {[ if (has_measures) "- Run a measure with `call_measure`." else "" ]} {[ if (has_metrics) "- Compute a metric with `call_metrics`." else "" ]} +{[ if (has_calculations) "- Run an exact warehouse calculation with `call_calculation`." else "" ]} {[ if (has_definitions) definition_action else "" ]} diff --git a/tests/testthat/_snaps/calculations.md b/tests/testthat/_snaps/calculations.md new file mode 100644 index 0000000..761cc67 --- /dev/null +++ b/tests/testthat/_snaps/calculations.md @@ -0,0 +1,28 @@ +# catalog calculation values are bound and identifiers are allowlisted + + Code + call_catalog_calculation(registry, "sales_value", + "{\"region\":\"EMEA\",\"column\":\"order_id; DROP TABLE sales\"}") + Condition + Error in `call_catalog_calculation()`: + ! Calculation argument `column` is not an allowed value. + i Allowed values: "order_id" and "revenue". + +--- + + Code + call_catalog_calculation(registry, "sales_value", "{\"column\":\"order_id\"}") + Condition + Error in `call_catalog_calculation()`: + ! Arguments do not match trusted calculation "sales_value". + x Missing arguments: "region". + +# catalog calculations do not trust rejected execution + + Code + call_catalog_calculation(registry, "sales_count") + Condition + Error in `source_query()`: + ! The query contains a disallowed operation: `DELETE`. + i Only read-only SELECT queries are allowed. + diff --git a/tests/testthat/_snaps/catalog-databricks.md b/tests/testthat/_snaps/catalog-databricks.md new file mode 100644 index 0000000..e22926d --- /dev/null +++ b/tests/testthat/_snaps/catalog-databricks.md @@ -0,0 +1,18 @@ +# Databricks metric-view parameters are typed and quoted + + Code + databricks_metric_source(object, parameters, "{}", con) + Condition + Error in `databricks_metric_source()`: + ! Metric-view parameters do not match the model. + x Missing parameters: "discount". + +--- + + Code + databricks_metric_source(object, parameters, "{\"discount\":\"not a number\"}", + con) + Condition + Error in `databricks_parameter_value()`: + ! Metric-view parameter type "double" requires a number. + diff --git a/tests/testthat/_snaps/data-source.md b/tests/testthat/_snaps/data-source.md index 18cb6b1..779f4b8 100644 --- a/tests/testthat/_snaps/data-source.md +++ b/tests/testthat/_snaps/data-source.md @@ -27,10 +27,17 @@ # data_source errors for tables absent from the connection Code - data_source(con, tables = "nope") + source_describe(src, "nope") Condition - Error in `data_source()`: - ! `tables` names table not on the connection: "nope". + Error in `source_describe()`: + ! Table "nope" could not be described. + Caused by error in `DBI::dbSendQuery()`: + ! Catalog Error: Table with name nope does not exist! + Did you mean "pg_enum"? + LINE 1: SELECT * FROM nope WHERE 1 = 0 + ^ + i Context: rapi_prepare + i Error type: CATALOG # data_source rejects a board label colliding with a built-in relation diff --git a/tests/testthat/helper-calculations.R b/tests/testthat/helper-calculations.R new file mode 100644 index 0000000..88a67cd --- /dev/null +++ b/tests/testthat/helper-calculations.R @@ -0,0 +1,52 @@ +calculation_test_source <- function(parameterized = FALSE) { + source <- test_source() + catalog_source <- new_catalog_source( + "source:test", + "duckdb", + dialect = "duckdb" + ) + if (parameterized) { + arguments <- list( + region = new_catalog_argument("string"), + column = new_catalog_argument( + "string", + binding = "identifier", + choices = c("order_id", "revenue") + ) + ) + execution <- new_catalog_execution( + "parameterized_sql", + "duckdb", + "SELECT {{region}} AS region, {{column}} FROM sales LIMIT 1", + bindings = list( + new_catalog_binding("region", token = "{{region}}"), + new_catalog_binding("column", "identifier", "{{column}}") + ) + ) + calculation <- new_catalog_calculation( + "calculation:sales_value", + catalog_source$id, + "sales_value", + "Return a selected sales value by region.", + arguments = arguments, + execution = execution + ) + } else { + calculation <- new_catalog_calculation( + "calculation:sales_count", + catalog_source$id, + "sales_count", + "Count all sales.", + execution = new_catalog_execution( + "verified_sql", + "duckdb", + "SELECT count(*) AS n FROM sales" + ) + ) + } + source$catalog <- new_commons_catalog( + sources = list(catalog_source), + calculations = list(calculation) + ) + source +} diff --git a/tests/testthat/test-calculations.R b/tests/testthat/test-calculations.R new file mode 100644 index 0000000..cde9b76 --- /dev/null +++ b/tests/testthat/test-calculations.R @@ -0,0 +1,70 @@ +test_that("catalog calculations enter search_pool and execute as trusted", { + source <- calculation_test_source() + registry <- catalog_calculations_registry(list(warehouse = source)) + + found <- search_pool_text( + list(), + empty_definitions(), + "count all sales", + "warehouse", + registry + ) + result <- call_catalog_calculation( + registry, + "sales_count", + handles = new_handle_store() + ) + + expect_match(found, "call_calculation") + expect_match(found, "sales_count") + expect_match(result@value, "6") + expect_equal(result@extra$commons_tag, "A") +}) + +test_that("catalog calculation values are bound and identifiers are allowlisted", { + source <- calculation_test_source(parameterized = TRUE) + registry <- catalog_calculations_registry(list(warehouse = source)) + payload <- "EMEA'; DROP TABLE sales; --" + + result <- call_catalog_calculation( + registry, + "sales_value", + jsonlite::toJSON( + list(region = payload, column = "order_id"), + auto_unbox = TRUE + ) + ) + + expect_match(result@value, "DROP TABLE sales", fixed = TRUE) + expect_equal(DBI::dbGetQuery(source$con, "SELECT count(*) AS n FROM sales")$n, 6) + expect_snapshot( + call_catalog_calculation( + registry, + "sales_value", + '{"region":"EMEA","column":"order_id; DROP TABLE sales"}' + ), + error = TRUE + ) + expect_snapshot( + call_catalog_calculation( + registry, + "sales_value", + '{"column":"order_id"}' + ), + error = TRUE + ) +}) + +test_that("catalog calculations do not trust rejected execution", { + source <- calculation_test_source() + calculation <- source$catalog$calculations[[1]] + calculation$execution$sql <- "DELETE FROM sales" + source$catalog$calculations[[1]] <- calculation + registry <- catalog_calculations_registry(list(warehouse = source)) + + expect_snapshot( + call_catalog_calculation(registry, "sales_count"), + error = TRUE + ) + expect_equal(DBI::dbGetQuery(source$con, "SELECT count(*) AS n FROM sales")$n, 6) +}) diff --git a/tests/testthat/test-catalog-databricks.R b/tests/testthat/test-catalog-databricks.R new file mode 100644 index 0000000..99318b5 --- /dev/null +++ b/tests/testthat/test-catalog-databricks.R @@ -0,0 +1,147 @@ +test_that("Databricks metric-view YAML imports governed assets", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + source <- new_catalog_source( + "source:databricks", + "databricks", + dialect = "databricks" + ) + relation <- new_catalog_relation( + "relation:sales_metrics", + source$id, + new_source_path( + c("main", "analytics", "sales_metrics"), + c("catalog", "schema", "table") + ), + kind = "metric_view" + ) + provider <- new.env(parent = emptyenv()) + provider$con <- con + provider$catalog <- new_commons_catalog( + sources = list(source), + relations = list(relation) + ) + specification <- yaml::yaml.load(paste( + "version: 1.1", + "comment: Governed sales metrics.", + "source: samples.tpch.orders", + "parameters:", + " - name: minimum_amount", + " data_type: double", + " default: 0", + "filter: o_totalprice > minimum_amount", + "joins:", + " - name: customer", + " source: samples.tpch.customer", + " on: source.o_custkey = customer.c_custkey", + " rely:", + " at_most_one_match: true", + "fields:", + " - name: region", + " expr: customer.c_mktsegment", + " comment: Customer segment.", + "measures:", + " - name: revenue", + " expr: SUM(o_totalprice)", + " display_name: Total Revenue", + " synonyms: [sales]", + " window:", + " - order: region", + " range: cumulative", + sep = "\n" + )) + + databricks_import_metric_model(provider, relation, specification) + catalog <- provider$catalog + registry <- catalog_definition_registry( + catalog, + table_labels = c( + "relation:sales_metrics" = "main.analytics.sales_metrics" + ) + ) + + expect_length(catalog$models, 1) + expect_length(catalog$models[[1]]$datasets, 2) + expect_setequal(registry$defs$name, c("region", "revenue")) + expect_equal(unique(registry$defs$execution), "databricks_metric_view") + expect_equal(catalog$models[[1]]$version, "1.1") + expect_true(length(catalog$models[[1]]$execution$parameters) == 1) + expect_true(length(catalog$context) >= 2) + root <- catalog$relations[[catalog$models[[1]]$datasets[[1]]]] + expect_equal(root$constraints[[1]]$enforcement, "asserted") +}) + +test_that("Databricks measures compile through MEASURE", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + path <- new_source_path( + c("main", "analytics", "sales_metrics"), + c("catalog", "schema", "table") + ) + provider <- new.env(parent = emptyenv()) + provider$catalog <- new_commons_catalog() + provider$catalog$models[["model:sales"]] <- new_catalog_model( + "model:sales", + "source:test", + "sales_metrics", + execution = list(kind = "databricks_metric_view", object = path) + ) + source <- list(con = con, provider = provider) + defs <- data.frame( + name = c("revenue", "region"), + role = c("metric", "dimension"), + stringsAsFactors = FALSE + ) + + sql <- databricks_metric_sql( + source, + "model:sales", + defs[1, , drop = FALSE], + defs, + dimensions = "region", + filters = NULL, + where = NULL + ) + + expect_match(sql, "MEASURE(revenue) AS revenue", fixed = TRUE) + expect_match(sql, "main.analytics.sales_metrics", fixed = TRUE) + expect_match(sql, "GROUP BY region", fixed = TRUE) +}) + +test_that("Databricks metric-view parameters are typed and quoted", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + object <- DBI::Id(catalog = "main", schema = "default", table = "metrics") + parameters <- list( + list(name = "discount", data_type = "double"), + list(name = "region", data_type = "string", default = "all") + ) + + sql <- databricks_metric_source( + object, + parameters, + '{"discount":0.15,"region":"EMEA\' OR 1=1 --"}', + con + ) + + expect_match(sql, "discount => 0.15", fixed = TRUE) + expect_match(sql, "'EMEA'' OR 1=1 --'", fixed = TRUE) + expect_snapshot( + databricks_metric_source(object, parameters, "{}", con), + error = TRUE + ) + expect_snapshot( + databricks_metric_source( + object, + parameters, + '{"discount":"not a number"}', + con + ), + error = TRUE + ) +}) + +test_that("Databricks metric-view versions fail closed", { + expect_false(databricks_metric_version_supported("9.9")) + expect_true(databricks_metric_version_supported("1.1")) +}) diff --git a/tests/testthat/test-catalog-snowflake.R b/tests/testthat/test-catalog-snowflake.R new file mode 100644 index 0000000..04a945c --- /dev/null +++ b/tests/testthat/test-catalog-snowflake.R @@ -0,0 +1,114 @@ +test_that("Snowflake semantic YAML imports governed assets", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + source <- new_catalog_source( + "source:snowflake", + "snowflake", + dialect = "snowflake", + identifier_case = "upper" + ) + relation <- new_catalog_relation( + "relation:sales_model", + source$id, + new_source_path( + c("ANALYTICS", "PUBLIC", "SALES_MODEL"), + c("catalog", "schema", "table") + ), + kind = "semantic_view" + ) + provider <- new.env(parent = emptyenv()) + provider$con <- con + provider$catalog <- new_commons_catalog( + sources = list(source), + relations = list(relation) + ) + provider$relation_labels <- c( + "relation:sales_model" = "ANALYTICS.PUBLIC.SALES_MODEL" + ) + specification <- yaml::yaml.load(paste( + "name: SALES_MODEL", + "description: Governed sales metrics.", + "tables:", + " - name: ORDERS", + " description: One row per order.", + " base_table:", + " database: RAW", + " schema: PUBLIC", + " table: ORDERS", + " primary_key:", + " columns: [ORDER_ID]", + " dimensions:", + " - name: REGION", + " expr: REGION", + " data_type: VARCHAR", + " metrics:", + " - name: REVENUE", + " description: Booked revenue.", + " expr: SUM(AMOUNT)", + " access_modifier: public_access", + " - name: PRIVATE_MARGIN", + " expr: SUM(MARGIN)", + " access_modifier: private_access", + "module_custom_instructions:", + " sql_generation: Use fiscal years.", + "verified_queries:", + " - name: revenue_by_region", + " question: What is revenue by region?", + " sql: SELECT REGION, AGG(REVENUE) FROM SALES_MODEL GROUP BY REGION", + sep = "\n" + )) + + snowflake_import_semantic_model(provider, relation, specification) + catalog <- provider$catalog + registry <- catalog_definition_registry( + catalog, + table_labels = provider$relation_labels + ) + + expect_length(catalog$models, 1) + expect_length(catalog$calculations, 1) + expect_length(catalog$context, 2) + expect_setequal(registry$defs$name, c("REGION", "REVENUE")) + expect_false("PRIVATE_MARGIN" %in% registry$defs$name) + dependency <- catalog$relations[[catalog$models[[1]]$datasets]] + expect_equal(dependency$constraints[[1]]$enforcement, "asserted") +}) + +test_that("Snowflake metrics compile through SEMANTIC_VIEW", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + path <- new_source_path( + c("ANALYTICS", "PUBLIC", "SALES_MODEL"), + c("catalog", "schema", "table") + ) + provider <- new.env(parent = emptyenv()) + provider$catalog <- new_commons_catalog() + provider$catalog$models[["model:sales"]] <- new_catalog_model( + "model:sales", + "source:test", + "SALES_MODEL", + execution = list(kind = "snowflake_semantic_view", object = path) + ) + source <- list(con = con, provider = provider) + defs <- data.frame( + name = c("REVENUE", "REGION"), + role = c("metric", "dimension"), + native_parent = c("ORDERS", "ORDERS"), + stringsAsFactors = FALSE + ) + + sql <- snowflake_metric_sql( + source, + "model:sales", + defs[1, , drop = FALSE], + defs, + dimensions = "REGION", + filters = NULL, + where = NULL + ) + + expect_match(sql, "SEMANTIC_VIEW", fixed = TRUE) + expect_match(sql, "DIMENSIONS", fixed = TRUE) + expect_match(sql, "METRICS", fixed = TRUE) + expect_match(sql, "ORDERS.REVENUE", fixed = TRUE) +}) diff --git a/tests/testthat/test-catalog.R b/tests/testthat/test-catalog.R index 2bb7347..42a7162 100644 --- a/tests/testthat/test-catalog.R +++ b/tests/testthat/test-catalog.R @@ -279,7 +279,7 @@ test_that("calculations require typed adapter-owned bindings", { "SELECT * FROM identifier(?) WHERE month = ?", list( new_catalog_binding("month"), - new_catalog_binding("region", "identifier") + new_catalog_binding("region", "identifier", "{{region}}") ) ) calculation <- new_catalog_calculation( diff --git a/tests/testthat/test-context-layer.R b/tests/testthat/test-context-layer.R index d4f2019..9d517fd 100644 --- a/tests/testthat/test-context-layer.R +++ b/tests/testthat/test-context-layer.R @@ -77,3 +77,62 @@ test_that("context_layer skips a frontmatter-only file", { layer <- context_layer(files = path) expect_length(context_search(layer, "provenance"), 0) }) + +test_that("context retrieval is scoped to a selected source", { + layer <- new_context_layer( + c( + "Shared fiscal calendar guidance.", + "Alpha renewals use booked annual value.", + "Beta churn uses active subscriptions." + ), + sources = list(character(), "alpha", "beta") + ) + + expect_match(context_search(layer, "renewals", source = "alpha"), "Alpha") + expect_length(context_search(layer, "renewals", source = "beta"), 0) + expect_match(context_search(layer, "fiscal", source = "beta"), "Shared") +}) + +test_that("merged context deduplicates text without losing source metadata", { + layer <- context_layer_merge( + docs = "Revenue excludes tax.", + sources = list("alpha"), + metadata = list(list(list(id = "context:alpha"))), + new_docs = "Revenue excludes tax.", + new_sources = list("beta"), + new_metadata = list(list(list(id = "context:beta"))) + ) + + expect_length(layer$docs, 1) + expect_setequal(layer$sources[[1]], c("alpha", "beta")) + expect_length(layer$metadata[[1]], 2) +}) + +test_that("evaluation-only catalog context never enters retrieval", { + source <- test_source() + catalog_source <- new_catalog_source("source:test", "duckdb") + source$catalog <- new_commons_catalog( + sources = list(catalog_source), + context = list( + new_catalog_context( + "context:runtime", + catalog_source$id, + "instruction", + "Revenue uses booked value.", + delivery = "retrieval" + ), + new_catalog_context( + "context:benchmark", + catalog_source$id, + "benchmark", + "The benchmark answer is secret.", + delivery = "evaluation" + ) + ) + ) + + layer <- augment_context_layer(NULL, list(warehouse = source)) + + expect_match(context_search(layer, "booked"), "Revenue") + expect_length(context_search(layer, "benchmark secret"), 0) +}) diff --git a/tests/testthat/test-data-source.R b/tests/testthat/test-data-source.R index 9326e59..43141fa 100644 --- a/tests/testthat/test-data-source.R +++ b/tests/testthat/test-data-source.R @@ -186,6 +186,22 @@ test_that("connection discovery merges an authored dictionary", { ) }) +test_that("catalog discovery exposes startup progress", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + DBI::dbExecute(con, "CREATE TABLE orders (id INTEGER)") + stages <- character() + + withCallingHandlers( + data_source(con), + commons_catalog_progress = function(condition) { + stages <<- c(stages, condition$stage) + } + ) + + expect_equal(stages, c("discovering", "ready")) +}) + test_that("default connection discovery stays in the current namespace", { con <- DBI::dbConnect(duckdb::duckdb()) withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) @@ -200,7 +216,8 @@ test_that("data_source errors for tables absent from the connection", { withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) DBI::dbWriteTable(con, "sales", test_sales()) - expect_snapshot(data_source(con, tables = "nope"), error = TRUE) + src <- suppressWarnings(data_source(con, tables = "nope")) + expect_snapshot(source_describe(src, "nope"), error = TRUE) }) test_that("source_query rejects non-SELECT statements", { diff --git a/tests/testthat/test-tools.R b/tests/testthat/test-tools.R index 7604f18..7b3694a 100644 --- a/tests/testthat/test-tools.R +++ b/tests/testthat/test-tools.R @@ -128,6 +128,44 @@ test_that("describe_table_tool reports columns without sampling by default", { expect_no_match(res@value, "Sample rows") }) +test_that("semantic context arrives only on first table touch", { + source <- test_source() + catalog_source <- new_catalog_source("source:test", "duckdb") + relation <- new_catalog_relation( + "relation:sales", + catalog_source$id, + new_source_path(c(table = "sales")) + ) + model <- new_catalog_model( + "model:sales", + catalog_source$id, + "sales_model", + datasets = relation$id, + exposed = relation$id + ) + source$catalog <- new_commons_catalog( + sources = list(catalog_source), + relations = list(relation), + models = list(model), + context = list(new_catalog_context( + "context:sales", + catalog_source$id, + "instruction", + "Use booked revenue for sales reporting.", + scope = model$id, + delivery = "first_touch" + )) + ) + source$relation_labels <- c("relation:sales" = "sales") + tracker <- new.env(parent = emptyenv()) + + first <- describe_table_tool(source, "sales", tracker = tracker) + second <- describe_table_tool(source, "sales", tracker = tracker) + + expect_match(first@value, "booked revenue") + expect_no_match(second@value, "booked revenue") +}) + test_that("search_context_tool handles a missing context layer", { expect_match(search_context_tool(NULL, "anything"), "No context layer") }) From ec99cf977f26ee7e3aa98a1ebe12e109b4bde55f Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 11:33:47 -0500 Subject: [PATCH 05/25] enforce semantic scope and access --- DESCRIPTION | 1 + R/calculations.R | 55 ++++- R/catalog-databricks.R | 145 +++++++++++-- R/catalog-merge.R | 3 +- R/catalog-provider.R | 238 ++++++++++++++++++++- R/catalog-snowflake.R | 170 ++++++++++++++- R/catalog.R | 12 +- R/data-dictionary.R | 15 +- R/data-source.R | 10 + R/definitions.R | 4 +- R/pool.R | 88 +++++++- R/prompt.R | 28 +++ R/tools.R | 2 +- inst/prompts/system-prompt.md | 4 + tests/testthat/_snaps/calculations.md | 19 ++ tests/testthat/_snaps/catalog-snowflake.md | 17 ++ tests/testthat/test-calculations.R | 16 ++ tests/testthat/test-catalog-databricks.R | 21 ++ tests/testthat/test-catalog-snowflake.R | 40 ++++ tests/testthat/test-catalog.R | 129 +++++++++++ tests/testthat/test-data-dictionary.R | 25 +++ tests/testthat/test-prompt.R | 20 ++ tests/testthat/test-tools.R | 20 ++ 23 files changed, 1039 insertions(+), 43 deletions(-) create mode 100644 tests/testthat/_snaps/catalog-snowflake.md diff --git a/DESCRIPTION b/DESCRIPTION index bf4b1e1..037ce93 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -42,6 +42,7 @@ Suggests: dbplyr, dplyr, htmltools, + odbc, otel (>= 0.2.0), otelsdk (>= 0.2.0), pins, diff --git a/R/calculations.R b/R/calculations.R index 28b31a4..64114d3 100644 --- a/R/calculations.R +++ b/R/calculations.R @@ -31,6 +31,11 @@ catalog_calculation_available <- function(catalog, calculation) { )) } +catalog_calculation_entry_available <- function(entry) { + catalog <- entry$source$provider$catalog %||% entry$source$catalog + catalog_calculation_available(catalog, entry$calculation) +} + calculation_pool_text <- function(entry, show_source = FALSE) { calculation <- entry$calculation arguments <- if (length(calculation$arguments)) { @@ -72,6 +77,11 @@ call_catalog_calculation <- function( handles = NULL ) { entry <- resolve_catalog_calculation(registry, name, source_name) + if (!catalog_calculation_entry_available(entry)) { + cli::cli_abort( + "Trusted calculation {.val {name}} is not queryable by this connection." + ) + } calculation <- entry$calculation values <- validate_catalog_calculation_args( calculation, @@ -89,7 +99,24 @@ call_catalog_calculation <- function( values, entry$source$con ) - result <- source_query_bind(entry$source, prepared$sql, prepared$params) + result <- tryCatch( + source_query_bind(entry$source, prepared$sql, prepared$params), + error = function(err) err + ) + if (inherits(result, "condition")) { + state <- if (grepl( + "permission|not authorized|insufficient privilege|access denied", + conditionMessage(result), + ignore.case = TRUE + )) { + "visible_only" + } else { + "unknown" + } + catalog_calculation_access(entry, state, conditionMessage(result)) + rlang::cnd_signal(result) + } + catalog_calculation_access(entry, "queryable", "trusted query succeeded") advert <- register_handle(handles, result) tool_result( paste(c(df_to_markdown(result), advert), collapse = "\n\n"), @@ -110,6 +137,32 @@ call_catalog_calculation <- function( ) } +catalog_calculation_access <- function(entry, state, evidence) { + provider <- entry$source$provider + if (is.null(provider)) { + return(invisible(entry)) + } + catalog <- provider$catalog + for (id in entry$calculation$dependencies) { + if (id %in% names(catalog$models)) { + model <- catalog$models[[id]] + model$access <- new_catalog_access(state, evidence) + catalog$models[[id]] <- model + for (relation_id in model$exposed) { + relation <- catalog$relations[[relation_id]] + relation$access <- new_catalog_access(state, evidence) + catalog$relations[[relation_id]] <- relation + } + } else if (id %in% names(catalog$relations)) { + relation <- catalog$relations[[id]] + relation$access <- new_catalog_access(state, evidence) + catalog$relations[[id]] <- relation + } + } + provider$catalog <- catalog + invisible(entry) +} + resolve_catalog_calculation <- function( registry, name, diff --git a/R/catalog-databricks.R b/R/catalog-databricks.R index 286bb12..caa2006 100644 --- a/R/catalog-databricks.R +++ b/R/catalog-databricks.R @@ -14,13 +14,6 @@ databricks_connection_snapshot <- function(con) { principal = row$principal[[1]], role = NULL, version = row$version[[1]], - capabilities = list( - describe_json = TRUE, - unity_information_schema = !identical( - tolower(row$catalog_name[[1]]), - "hive_metastore" - ) - ), namespace = catalog_compact(list( catalog = row$catalog_name[[1]], schema = row$schema_name[[1]] @@ -55,6 +48,14 @@ databricks_list_namespace <- function(con, prefix, call) { if (identical(tolower(catalog), "hive_metastore")) { return(databricks_list_hive_metastore(con, catalog, schema, call)) } + odbc_objects <- if (!is.null(schema)) { + catalog_odbc_objects(con, catalog, schema) + } + odbc_types <- if (!is.null(odbc_objects) && nrow(odbc_objects)) { + stats::setNames(tolower(odbc_objects$type), odbc_objects$name) + } else { + character() + } predicates <- c( paste0("table_catalog = ", DBI::dbQuoteString(con, catalog)), "table_schema <> 'information_schema'", @@ -85,7 +86,10 @@ databricks_list_namespace <- function(con, prefix, call) { schema = rows$table_schema[[i]], table = rows$table_name[[i]] ) - kind <- if (grepl("VIEW", rows$table_type[[i]], ignore.case = TRUE)) { + odbc_type <- odbc_types[[rows$table_name[[i]]]] %||% "" + kind <- if (grepl("metric", odbc_type, ignore.case = TRUE)) { + "metric_view" + } else if (grepl("VIEW", rows$table_type[[i]], ignore.case = TRUE)) { "view" } else { "table" @@ -130,11 +134,24 @@ databricks_import_semantics <- function(provider) { selected_ids <- names(provider$relation_labels) for (relation_id in selected_ids) { relation <- provider$catalog$relations[[relation_id]] - if (!relation$kind %in% c("view", "unknown")) { + if (!relation$kind %in% c("metric_view", "view", "unknown")) { next } specification <- databricks_read_metric_yaml(provider$con, relation$path) if (is.null(specification)) { + if (identical(relation$kind, "metric_view")) { + relation$access <- new_catalog_access( + "visible_only", + "metric-view metadata could not be read" + ) + provider$catalog$relations[[relation$id]] <- relation + catalog_provider_diagnostic( + provider, + "databricks_metric_view_unreadable", + sprintf("Skipped metric view %s because its YAML could not be read.", relation$name), + entity_id = relation$id + ) + } next } if (!databricks_metric_version_supported(specification$version)) { @@ -156,10 +173,46 @@ databricks_import_semantics <- function(provider) { provider$catalog$relations[[relation_id]] <- relation databricks_import_metric_model(provider, relation, specification) } + databricks_import_associated_semantics(provider) validate_commons_catalog(provider$catalog) invisible(provider) } +databricks_import_associated_semantics <- function(provider) { + prefixes <- catalog_association_prefixes(provider) + for (prefix in prefixes) { + candidates <- databricks_list_namespace( + provider$con, + prefix, + rlang::caller_env() + ) + candidates <- Filter( + function(id) attr(id, "commons_kind") %in% c("metric_view", "view"), + candidates + ) + for (id in candidates) { + path <- new_source_path(id) + specification <- databricks_read_metric_yaml(provider$con, path) + if (is.null(specification) || + !databricks_metric_version_supported(specification$version)) { + next + } + relation <- catalog_add_associated_relation(provider, id, "metric_view") + imported <- any(vapply( + provider$catalog$models, + function(model) relation$id %in% model$exposed, + logical(1) + )) + if (imported) { + next + } + databricks_import_metric_model(provider, relation, specification) + catalog_filter_associated_model(provider, relation$id) + } + } + invisible(provider) +} + databricks_metric_version_supported <- function(version) { as.character(version) %in% c("0.1", "1.0", "1.1") } @@ -469,6 +522,37 @@ databricks_metric_context <- function( } databricks_relation_metadata <- function(con, id) { + extended <- databricks_describe_json(con, new_source_path(id)) + details <- extended$columns %||% list() + if (length(details) == 0) { + details <- databricks_report_columns(con, id) + } + columns <- lapply(details, function(column) { + restrictions <- databricks_column_restrictions( + extended, + column$name + ) + type <- databricks_type_text(column$type) + new_catalog_column( + column$name, + native_type = type, + logical_type = type, + nullable = column$nullable, + description = column$comment, + display = if (length(restrictions)) "restricted", + restrictions = restrictions, + extensions = list(databricks = column) + ) + }) + names(columns) <- vapply(columns, `[[`, character(1), "name") + list( + columns = columns, + constraints = databricks_relation_constraints(con, id), + kind = NULL + ) +} + +databricks_report_columns <- function(con, id) { rows <- DBI::dbGetQuery( con, paste("DESCRIBE TABLE", DBI::dbQuoteIdentifier(con, id)) @@ -481,21 +565,38 @@ databricks_relation_metadata <- function(con, id) { , drop = FALSE ] - columns <- lapply(seq_len(nrow(rows)), function(i) { - new_catalog_column( - rows$col_name[[i]], - native_type = rows$data_type[[i]], - logical_type = rows$data_type[[i]], - description = if ("comment" %in% names(rows) && !is.na(rows$comment[[i]])) { - rows$comment[[i]] - } + lapply(seq_len(nrow(rows)), function(i) { + list( + name = rows$col_name[[i]], + type = rows$data_type[[i]], + comment = if (!is.na(rows$comment[[i]])) rows$comment[[i]] else NULL, + nullable = NULL ) }) - names(columns) <- vapply(columns, `[[`, character(1), "name") - list( - columns = columns, - constraints = databricks_relation_constraints(con, id), - kind = NULL +} + +databricks_column_restrictions <- function(metadata, name) { + masks <- metadata$column_masks %||% list() + matches <- Filter( + function(mask) identical(mask$column_name, name), + masks + ) + if (length(matches)) "column_mask" else character() +} + +databricks_type_text <- function(type) { + if (is.character(type)) { + return(type) + } + if (!is.list(type) || is.null(type$name)) { + return("unknown") + } + switch( + type$name, + decimal = sprintf("decimal(%s,%s)", type$precision, type$scale), + varchar = sprintf("varchar(%s)", type$length), + char = sprintf("char(%s)", type$length), + type$name ) } diff --git a/R/catalog-merge.R b/R/catalog-merge.R index b2bac28..f9307e8 100644 --- a/R/catalog-merge.R +++ b/R/catalog-merge.R @@ -222,7 +222,8 @@ catalog_merge_column <- function(discovered, authored) { "units", "values", "range", - "examples" + "examples", + "display" ) for (field in scalar_fields) { fields[[field]] <- catalog_authored_value(authored[[field]], discovered[[field]]) diff --git a/R/catalog-provider.R b/R/catalog-provider.R index 909ab49..2694998 100644 --- a/R/catalog-provider.R +++ b/R/catalog-provider.R @@ -3,6 +3,7 @@ new_catalog_provider <- function(con, options, call = rlang::caller_env()) { backend <- catalog_backend(con) catalog_progress("discovering", backend, started_at) snapshot <- catalog_connection_snapshot(con, backend) + capabilities <- catalog_backend_capabilities(con, backend, snapshot) source_id <- catalog_id( "source", backend, @@ -10,6 +11,12 @@ new_catalog_provider <- function(con, options, call = rlang::caller_env()) { paste(unlist(snapshot$namespace), collapse = ".") ) ids <- catalog_resolve_selection(con, backend, options, call) + if (length(ids) > catalog_object_limit) { + cli::cli_abort(c( + "The data-source selection resolves to {length(ids)} objects, above the supported limit of {catalog_object_limit}.", + "i" = "Narrow {.arg include} to fewer catalog or schema prefixes." + ), call = call) + } if (length(ids) == 0) { cli::cli_abort( "The resolved data-source selection contains no queryable objects.", @@ -27,7 +34,7 @@ new_catalog_provider <- function(con, options, call = rlang::caller_env()) { } keys <- vapply(ids, catalog_source_path_key, character(1)) - ids <- ids[!duplicated(keys)] + ids <- catalog_collapse_selected_ids(ids, keys) labels <- vapply(ids, catalog_id_label, character(1)) labels <- catalog_unique_labels(labels, ids, call) names(ids) <- labels @@ -51,6 +58,7 @@ new_catalog_provider <- function(con, options, call = rlang::caller_env()) { version = snapshot$version, provenance = provenance ) + source$extensions$capabilities <- capabilities relations <- lapply(seq_along(ids), function(i) { id <- ids[[i]] path <- new_source_path(id) @@ -73,8 +81,13 @@ new_catalog_provider <- function(con, options, call = rlang::caller_env()) { provider$backend <- backend provider$options <- options provider$snapshot <- snapshot + provider$capabilities <- capabilities provider$table_ids <- ids provider$relation_labels <- relation_labels + provider$selection_modes <- stats::setNames( + vapply(ids, function(id) attr(id, "commons_selection") %||% "exact", character(1)), + relation_ids + ) provider$catalog <- new_commons_catalog( sources = list(source), relations = relations, @@ -90,6 +103,32 @@ new_catalog_provider <- function(con, options, call = rlang::caller_env()) { provider } +catalog_object_limit <- 25000L + +catalog_backend_capabilities <- function(con, backend, snapshot) { + hierarchy <- if (requireNamespace("odbc", quietly = TRUE) && + inherits(con, "OdbcConnection")) { + tryCatch(odbc::odbcListObjectTypes(con), error = function(err) NULL) + } + list( + odbc_hierarchy = hierarchy, + describe_json = if (identical(backend, "databricks")) "probe_on_use" else NULL, + native_semantics = backend %in% c("snowflake", "databricks"), + version = snapshot$version + ) +} + +catalog_odbc_objects <- function(con, catalog = NULL, schema = NULL) { + if (!requireNamespace("odbc", quietly = TRUE) || + !inherits(con, "OdbcConnection")) { + return(NULL) + } + tryCatch( + odbc::odbcListObjects(con, catalog = catalog, schema = schema), + error = function(err) NULL + ) +} + catalog_backend <- function(con) { info <- tryCatch(DBI::dbGetInfo(con), error = function(err) list()) label <- paste( @@ -143,21 +182,56 @@ catalog_provider_check <- function(provider, call = rlang::caller_env()) { catalog_resolve_selection <- function(con, backend, options, call) { includes <- normalize_connection_includes(options$include, call) if (is.null(includes)) { - return(catalog_default_objects(con, backend, call)) + objects <- catalog_default_objects(con, backend, call) + return(lapply(objects, catalog_selection_id, "namespace")) } objects <- list() for (include in includes) { if ("table" %in% names(include@name)) { - objects[[length(objects) + 1]] <- include + objects[[length(objects) + 1]] <- catalog_selection_id(include, "exact") } else { expanded <- catalog_list_namespace(con, backend, include, call) + expanded <- lapply(expanded, catalog_selection_id, "namespace") objects <- c(objects, expanded) } } objects } +catalog_selection_id <- function(id, mode) { + attr(id, "commons_selection") <- mode + id +} + +catalog_collapse_selected_ids <- function(ids, keys) { + unique_keys <- unique(keys) + lapply(unique_keys, function(key) { + matches <- which(keys == key) + kinds <- vapply( + ids[matches], + function(candidate) attr(candidate, "commons_kind") %||% "unknown", + character(1) + ) + priority <- match( + kinds, + c("semantic_view", "metric_view", "view", "table", "unknown") + ) + id <- ids[[matches[[which.min(priority)]]]] + modes <- vapply( + ids[matches], + function(candidate) attr(candidate, "commons_selection") %||% "exact", + character(1) + ) + attr(id, "commons_selection") <- if ("namespace" %in% modes) { + "namespace" + } else { + "exact" + } + id + }) +} + catalog_default_objects <- function(con, backend, call) { if (identical(backend, "snowflake")) { return(snowflake_default_objects(con, call)) @@ -468,3 +542,161 @@ catalog_import_backend <- function(provider) { } invisible(provider) } + +catalog_association_prefixes <- function(provider) { + relation_ids <- names(provider$selection_modes)[ + provider$selection_modes == "exact" + ] + relations <- provider$catalog$relations[relation_ids] + relations <- Filter(function(relation) { + !relation$kind %in% c("semantic_view", "metric_view") && + "table" %in% relation$path$roles + }, relations) + prefixes <- lapply(relations, function(relation) { + keep <- relation$path$roles != "table" + do.call(DBI::Id, as.list(stats::setNames( + relation$path$components[keep], + relation$path$roles[keep] + ))) + }) + keys <- vapply(prefixes, catalog_source_path_key, character(1)) + prefixes[!duplicated(keys)] +} + +catalog_add_associated_relation <- function(provider, id, kind) { + path <- new_source_path(id) + existing <- Filter( + function(relation) identical(relation$path, path), + provider$catalog$relations + ) + if (length(existing)) { + return(existing[[1]]) + } + source <- provider$catalog$sources[[1]] + provenance <- new_catalog_provenance( + "discovered", + source$id, + harvested_at = Sys.time() + ) + relation <- new_catalog_relation( + catalog_id("relation", source$id, catalog_source_path_key(id)), + source$id, + path, + kind = kind, + name = catalog_id_name(id), + description = attr(id, "commons_description"), + access = new_catalog_access("unknown", "associated semantic object"), + provenance = provenance + ) + provider$catalog$relations[[relation$id]] <- relation + relation +} + +catalog_filter_associated_model <- function(provider, relation_id) { + models <- Filter( + function(model) relation_id %in% model$exposed, + provider$catalog$models + ) + if (length(models) == 0) { + return(invisible(provider)) + } + model <- models[[1]] + selected <- names(provider$selection_modes) + selected_paths <- vapply( + provider$catalog$relations[selected], + function(relation) catalog_source_path_key(source_path_id(relation$path)), + character(1) + ) + definitions <- Filter( + function(definition) identical(definition$model_id, model$id), + provider$catalog$definitions + ) + calculations <- Filter( + function(calculation) model$id %in% calculation$dependencies, + provider$catalog$calculations + ) + keep_definitions <- vapply( + definitions, + function(definition) { + catalog_dependencies_selected( + provider$catalog, + definition$dependencies, + selected_paths + ) + }, + logical(1) + ) + keep_calculations <- rep( + catalog_dependencies_selected( + provider$catalog, + model$dependencies, + selected_paths + ), + length(calculations) + ) + skipped <- c( + vapply(definitions[!keep_definitions], `[[`, character(1), "name"), + vapply(calculations[!keep_calculations], `[[`, character(1), "name") + ) + provider$catalog$definitions <- provider$catalog$definitions[ + !names(provider$catalog$definitions) %in% names(definitions) | + names(provider$catalog$definitions) %in% names(definitions)[keep_definitions] + ] + provider$catalog$calculations <- provider$catalog$calculations[ + !names(provider$catalog$calculations) %in% names(calculations) | + names(provider$catalog$calculations) %in% names(calculations)[keep_calculations] + ] + if (length(skipped)) { + diagnostic <- new_catalog_diagnostic( + "semantic_dependency_out_of_scope", + sprintf( + "Skipped associated semantic assets with dependencies outside the selection: %s.", + paste(skipped, collapse = ", ") + ), + entity_id = model$id, + details = list(skipped = skipped) + ) + provider$catalog$diagnostics[[length(provider$catalog$diagnostics) + 1]] <- diagnostic + } + surface <- c(names(definitions)[keep_definitions], names(calculations)[keep_calculations]) + if (length(surface) == 0) { + provider$catalog$models[[model$id]] <- NULL + provider$catalog$relations[[relation_id]] <- NULL + provider$catalog$context <- Filter( + function(context) !model$id %in% context$scope, + provider$catalog$context + ) + } + validate_commons_catalog(provider$catalog) + invisible(provider) +} + +catalog_dependencies_selected <- function(catalog, ids, selected_paths) { + dependencies <- catalog$relations[ids] + length(dependencies) == length(ids) && all(vapply( + dependencies, + function(relation) { + catalog_source_path_key(source_path_id(relation$path)) %in% selected_paths + }, + logical(1) + )) +} + +catalog_provider_diagnostic <- function( + provider, + code, + message, + severity = "warning", + entity_id = NULL, + details = list() +) { + diagnostic <- new_catalog_diagnostic( + code, + message, + severity, + entity_id, + details + ) + provider$catalog$diagnostics[[length(provider$catalog$diagnostics) + 1]] <- diagnostic + invisible(diagnostic) +} diff --git a/R/catalog-snowflake.R b/R/catalog-snowflake.R index 86b2efd..86c3791 100644 --- a/R/catalog-snowflake.R +++ b/R/catalog-snowflake.R @@ -107,6 +107,19 @@ snowflake_import_semantics <- function(provider) { ) } if (is.null(specification)) { + if (identical(relation$kind, "semantic_view")) { + relation$access <- new_catalog_access( + "visible_only", + "semantic metadata could not be read" + ) + provider$catalog$relations[[relation$id]] <- relation + catalog_provider_diagnostic( + provider, + "snowflake_semantic_view_unreadable", + sprintf("Skipped semantic view %s because its metadata could not be read.", relation$name), + entity_id = relation$id + ) + } next } relation$kind <- "semantic_view" @@ -114,10 +127,61 @@ snowflake_import_semantics <- function(provider) { provider$catalog$relations[[relation_id]] <- relation snowflake_import_semantic_model(provider, relation, specification) } + snowflake_import_associated_semantics(provider) validate_commons_catalog(provider$catalog) invisible(provider) } +snowflake_import_associated_semantics <- function(provider) { + prefixes <- catalog_association_prefixes(provider) + for (prefix in prefixes) { + candidates <- snowflake_list_namespace( + provider$con, + prefix, + rlang::caller_env() + ) + candidates <- Filter( + function(id) identical(attr(id, "commons_kind"), "semantic_view"), + candidates + ) + for (id in candidates) { + relation <- catalog_add_associated_relation( + provider, + id, + "semantic_view" + ) + imported <- any(vapply( + provider$catalog$models, + function(model) relation$id %in% model$exposed, + logical(1) + )) + if (imported) { + next + } + specification <- snowflake_read_semantic_yaml(provider$con, relation$path) + if (is.null(specification)) { + specification <- snowflake_describe_semantic_view( + provider$con, + relation$path + ) + } + if (is.null(specification)) { + provider$catalog$relations[[relation$id]] <- NULL + catalog_provider_diagnostic( + provider, + "snowflake_associated_view_unreadable", + sprintf("Skipped associated semantic view %s because its metadata could not be read.", relation$name), + entity_id = relation$id + ) + next + } + snowflake_import_semantic_model(provider, relation, specification) + catalog_filter_associated_model(provider, relation$id) + } + } + invisible(provider) +} + snowflake_describe_semantic_view <- function(con, path) { id <- source_path_id(path) rows <- tryCatch( @@ -217,6 +281,7 @@ snowflake_relation_metadata <- function(con, id) { names(rows) <- tolower(names(rows)) rows <- rows[toupper(rows$kind) == "COLUMN", , drop = FALSE] columns <- lapply(seq_len(nrow(rows)), function(i) { + restrictions <- snowflake_column_restrictions(rows[i, , drop = FALSE]) new_catalog_column( name = rows$name[[i]], native_type = rows$type[[i]], @@ -224,15 +289,97 @@ snowflake_relation_metadata <- function(con, id) { nullable = if ("null?" %in% names(rows)) rows[["null?"]][[i]] == "Y" else NULL, description = if ("comment" %in% names(rows) && !is.na(rows$comment[[i]])) { rows$comment[[i]] - } + }, + display = if (length(restrictions)) "restricted", + restrictions = restrictions, + extensions = list(snowflake = as.list(rows[i, , drop = FALSE])) ) }) names(columns) <- vapply(columns, `[[`, character(1), "name") - constraints <- snowflake_desc_constraints(rows) - constraints <- c(constraints, snowflake_foreign_keys(con, id)) + properties <- snowflake_constraint_properties(con, id) + constraints <- snowflake_key_constraints(properties) + if (length(constraints) == 0) { + constraints <- snowflake_desc_constraints(rows) + } + constraints <- c( + constraints, + snowflake_foreign_keys(con, id, properties) + ) list(columns = columns, constraints = constraints, kind = "table") } +snowflake_constraint_properties <- function(con, id) { + components <- id@name + if (!all(c("catalog", "schema", "table") %in% names(components))) { + return(NULL) + } + catalog <- components[["catalog"]] + constraints <- DBI::Id( + catalog = catalog, + schema = "INFORMATION_SCHEMA", + table = "TABLE_CONSTRAINTS" + ) + columns <- DBI::Id( + catalog = catalog, + schema = "INFORMATION_SCHEMA", + table = "KEY_COLUMN_USAGE" + ) + sql <- paste( + "SELECT tc.constraint_name, tc.constraint_type, tc.enforced, tc.rely,", + "k.column_name, k.ordinal_position", + "FROM", DBI::dbQuoteIdentifier(con, constraints), "tc", + "JOIN", DBI::dbQuoteIdentifier(con, columns), "k", + "ON tc.constraint_catalog = k.constraint_catalog", + "AND tc.constraint_schema = k.constraint_schema", + "AND tc.constraint_name = k.constraint_name", + "AND tc.table_catalog = k.table_catalog", + "AND tc.table_schema = k.table_schema", + "AND tc.table_name = k.table_name", + "WHERE tc.table_schema =", DBI::dbQuoteString(con, components[["schema"]]), + "AND tc.table_name =", DBI::dbQuoteString(con, components[["table"]]), + "ORDER BY tc.constraint_name, k.ordinal_position" + ) + rows <- tryCatch(DBI::dbGetQuery(con, sql), error = function(err) NULL) + if (!is.null(rows)) names(rows) <- tolower(names(rows)) + rows +} + +snowflake_key_constraints <- function(rows) { + if (is.null(rows) || nrow(rows) == 0) { + return(list()) + } + rows <- rows[rows$constraint_type != "FOREIGN KEY", , drop = FALSE] + lapply(split(rows, rows$constraint_name), function(group) { + new_catalog_constraint( + tolower(gsub(" ", "_", group$constraint_type[[1]])), + group$column_name, + enforcement = snowflake_constraint_enforcement(group), + native = group + ) + }) +} + +snowflake_constraint_enforcement <- function(rows) { + if (identical(rows$enforced[[1]], "YES")) { + return("enforced") + } + if (identical(rows$rely[[1]], "YES")) { + return("asserted") + } + "informational" +} + +snowflake_column_restrictions <- function(row) { + fields <- intersect( + c("policy name", "privacy domain", "masking policy"), + names(row) + ) + fields[vapply(fields, function(field) { + value <- row[[field]][[1]] + !is.na(value) && nzchar(as.character(value)) + }, logical(1))] +} + snowflake_desc_constraints <- function(rows) { out <- list() fields <- c("primary key" = "primary_key", "unique key" = "unique") @@ -253,7 +400,7 @@ snowflake_desc_constraints <- function(rows) { out } -snowflake_foreign_keys <- function(con, id) { +snowflake_foreign_keys <- function(con, id, properties = NULL) { rows <- tryCatch( DBI::dbGetQuery( con, @@ -267,6 +414,9 @@ snowflake_foreign_keys <- function(con, id) { names(rows) <- tolower(names(rows)) groups <- split(rows, rows$fk_name) lapply(groups, function(group) { + property <- if (!is.null(properties)) { + properties[properties$constraint_name == group$fk_name[[1]], , drop = FALSE] + } new_catalog_constraint( "foreign_key", group$fk_column_name, @@ -281,7 +431,11 @@ snowflake_foreign_keys <- function(con, id) { ), columns = group$pk_column_name ), - enforcement = "informational", + enforcement = if (!is.null(property) && nrow(property)) { + snowflake_constraint_enforcement(property) + } else { + "informational" + }, native = group ) }) @@ -337,11 +491,15 @@ snowflake_import_semantic_model <- function(provider, relation, specification) { relationships = specification$relationships %||% list(), execution = list( kind = "snowflake_semantic_view", - object = relation$path + object = relation$path, + variables = specification$variables %||% list() ), exposed = relation$id, dependencies = datasets, access = relation$access, + version = as.character( + specification$version %||% specification$semantic_model_version %||% NA_character_ + ), fingerprint = catalog_fingerprint(specification), provenance = provenance, extensions = list(snowflake = specification) diff --git a/R/catalog.R b/R/catalog.R index e59c9e8..27ddebd 100644 --- a/R/catalog.R +++ b/R/catalog.R @@ -225,6 +225,10 @@ catalog_definition_registry <- function( if (identical(definition$visibility, "private")) { next } + model <- catalog$models[[definition$model_id]] + if (identical(model$access$state, "visible_only")) { + next + } relation <- catalog$relations[[definition$relation_id]] table <- if (relation$id %in% names(table_labels)) { unname(table_labels[[relation$id]]) @@ -232,7 +236,6 @@ catalog_definition_registry <- function( relation$name } expression <- catalog_primary_expression(definition$expressions) - model <- catalog$models[[definition$model_id]] role <- if (identical(definition$role, "time_dimension")) { "dimension" } else { @@ -510,12 +513,16 @@ new_catalog_column <- function( values = NULL, range = NULL, examples = NULL, + display = NULL, restrictions = character(), tags = character(), provenance = NULL, field_provenance = list(), extensions = list() ) { + if (!is.null(display) && !identical(display, "restricted")) { + cli::cli_abort("Catalog column {.field display} must be {.val restricted} or null.") + } structure( list( name = catalog_string(name, "column name"), @@ -528,6 +535,7 @@ new_catalog_column <- function( values = values, range = range, examples = examples, + display = display, restrictions = catalog_character(restrictions), tags = catalog_character(tags), provenance = provenance, @@ -890,6 +898,7 @@ catalog_relation_from_dictionary <- function( values = column$values, range = column$range, examples = column$examples, + display = column$display, restrictions = unlist(column$constraints), provenance = provenance, field_provenance = catalog_field_provenance( @@ -1053,6 +1062,7 @@ catalog_column_to_dictionary <- function(column) { out$values <- column$values out$range <- column$range out$examples <- column$examples + out$display <- column$display out$constraints <- if (length(column$restrictions)) column$restrictions catalog_compact(out) } diff --git a/R/data-dictionary.R b/R/data-dictionary.R index 069b69f..fb280a5 100644 --- a/R/data-dictionary.R +++ b/R/data-dictionary.R @@ -183,15 +183,22 @@ dictionary_columns_text <- function(columns, live = NULL) { dictionary_column_line <- function(name, spec, live_type = NULL) { spec <- spec %||% list() + restricted <- identical(spec$display, "restricted") qualifier <- paste( - c(spec$type %||% live_type, spec$units, unlist(spec$constraints)), + c( + spec$type %||% live_type, + spec$units, + unlist(spec$constraints), + if (restricted) "restricted" + ), collapse = ", " ) facts <- c( spec$description, - dictionary_values_fact(spec$values), - dictionary_range_fact(spec$range), - dictionary_examples_fact(spec$examples), + if (!restricted) dictionary_values_fact(spec$values), + if (!restricted) dictionary_range_fact(spec$range), + if (!restricted) dictionary_examples_fact(spec$examples), + if (restricted) "Do not select or display this column by default.", spec$details ) detail <- flatten_inline(paste(facts, collapse = " ")) diff --git a/R/data-source.R b/R/data-source.R index d4f0e35..1e38c02 100644 --- a/R/data-source.R +++ b/R/data-source.R @@ -522,9 +522,19 @@ source_describe <- function(source, table, n_sample = NULL) { schema$column ) } + restricted <- source_restricted_columns(source, table) + sample <- sample[setdiff(names(sample), restricted)] list(schema = schema, sample = sample) } +source_restricted_columns <- function(source, table) { + columns <- source_runtime_dictionary(source)$tables[[table]]$columns + names(Filter( + function(column) identical(column$display, "restricted"), + columns + )) +} + source_query <- function(source, sql) { check_query(sql) if (is.null(source$pending)) { diff --git a/R/definitions.R b/R/definitions.R index 2c228d0..d7f1f44 100644 --- a/R/definitions.R +++ b/R/definitions.R @@ -181,7 +181,9 @@ definitions_registry <- function(sources, call = rlang::caller_env()) { source$relation_labels, call ) - tables <- unique(registry$defs$table) + tables <- unique(registry$defs$table[ + registry$defs$execution == "data_dictionary" + ]) unknown <- setdiff(tables, source$tables) if (length(unknown)) { cli::cli_abort( diff --git a/R/pool.R b/R/pool.R index 32cf20f..4d58642 100644 --- a/R/pool.R +++ b/R/pool.R @@ -154,6 +154,10 @@ call_native_metrics <- function( if (length(model_ids) != 1) { cli::cli_abort("Metrics in one query must belong to the same semantic model.") } + model <- source$provider$catalog$models[[model_ids]] + if (identical(model$access$state, "visible_only")) { + cli::cli_abort("The selected semantic model is not queryable by this connection.") + } on_model <- defs[defs$model_id == model_ids, ] sql <- switch( execution, @@ -201,9 +205,6 @@ snowflake_metric_sql <- function( where, arguments = "{}" ) { - if (!identical(arguments, "{}") && length(parse_json_args(arguments))) { - cli::cli_abort("This Snowflake semantic view does not expose runtime parameters.") - } con <- source$con model <- source$provider$catalog$models[[model_id]] object <- source_path_id(model$execution$object) @@ -224,6 +225,11 @@ snowflake_metric_sql <- function( paste( "METRICS", paste(native_definition_references(metrics, con), collapse = ", ") + ), + snowflake_variable_clause( + model$execution$variables %||% list(), + arguments, + con ) ) conditions <- c( @@ -236,6 +242,81 @@ snowflake_metric_sql <- function( paste0("SELECT * FROM SEMANTIC_VIEW(\n ", paste(parts, collapse = "\n "), "\n)") } +snowflake_variable_clause <- function(variables, arguments, con) { + values <- parse_json_args(arguments %||% "{}") + if (length(variables) == 0) { + if (length(values)) { + cli::cli_abort("This Snowflake semantic view does not accept variables.") + } + return(NULL) + } + variable_names <- vapply(variables, `[[`, character(1), "name") + extra <- setdiff(names(values), variable_names) + required <- variable_names[!vapply( + variables, + function(variable) "default_value" %in% names(variable), + logical(1) + )] + missing <- setdiff(required, names(values)) + if (length(extra) || length(missing)) { + cli::cli_abort(c( + "Semantic-view variables do not match the model.", + "x" = if (length(extra)) "Unknown variables: {.val {extra}}.", + "x" = if (length(missing)) "Missing variables: {.val {missing}}." + )) + } + supplied <- intersect(variable_names, names(values)) + if (length(supplied) == 0) { + return(NULL) + } + sql <- vapply(supplied, function(name) { + variable <- variables[[match(name, variable_names)]] + paste( + DBI::dbQuoteIdentifier(con, name), + "=>", + snowflake_variable_value(values[[name]], variable$data_type, con) + ) + }, character(1)) + paste("VARIABLES", paste(sql, collapse = ", ")) +} + +snowflake_variable_value <- function(value, type, con) { + normalized <- tolower(gsub("\\s+", "", type)) + if (grepl("^(number|decimal|numeric)(\\([0-9]+(,[0-9]+)?\\))?$", normalized) || + normalized %in% c("float", "float4", "float8", "double", "real")) { + if (!is.numeric(value) || length(value) != 1 || !is.finite(value)) { + cli::cli_abort("Semantic-view variable type {.val {type}} requires a number.") + } + return(as.character(value)) + } + if (normalized %in% c("boolean", "bool")) { + if (!is.logical(value) || length(value) != 1 || is.na(value)) { + cli::cli_abort("Semantic-view variable type {.val {type}} requires true or false.") + } + return(if (value) "TRUE" else "FALSE") + } + if (normalized == "date") { + if (!is.character(value) || length(value) != 1 || is.na(as.Date(value))) { + cli::cli_abort("Semantic-view date variables require an ISO date string.") + } + return(paste0("TO_DATE(", DBI::dbQuoteString(con, value), ")")) + } + if (grepl("^(timestamp|timestamp_ntz|timestamp_ltz|timestamp_tz)", normalized)) { + if (!is.character(value) || length(value) != 1 || + !grepl("^[0-9]{4}-[0-9]{2}-[0-9]{2}[T ]", value)) { + cli::cli_abort("Semantic-view timestamp variables require an ISO timestamp string.") + } + return(paste0("TO_TIMESTAMP(", DBI::dbQuoteString(con, value), ")")) + } + if (grepl("^(string|text|varchar|char)", normalized)) { + if (!is.character(value) || length(value) != 1 || is.na(value)) { + cli::cli_abort("Semantic-view variable type {.val {type}} requires a string.") + } + return(as.character(DBI::dbQuoteString(con, value))) + } + cli::cli_abort("Unsupported semantic-view variable type {.val {type}}.") +} + databricks_metric_sql <- function( source, model_id, @@ -569,6 +650,7 @@ search_pool_text <- function( source_names = character(), calculations = list() ) { + calculations <- Filter(catalog_calculation_entry_available, calculations) defs <- registry_defs(registry) if (length(measures) == 0 && nrow(defs) == 0 && length(calculations) == 0) { return("The semantic layer is empty.") diff --git a/R/prompt.R b/R/prompt.R index 90c7fe0..e190414 100644 --- a/R/prompt.R +++ b/R/prompt.R @@ -18,6 +18,7 @@ system_prompt_data <- function(sources, definitions, measures, calculations) { has_definitions <- nrow(registry_defs(definitions)) > 0 dictionary_context <- dictionary_context_text(sources) glossary_context <- glossary_context_text(sources) + diagnostics <- catalog_diagnostics_text(sources) list( date = as.character(Sys.Date()), @@ -32,10 +33,12 @@ system_prompt_data <- function(sources, definitions, measures, calculations) { has_dictionary_context = nzchar(dictionary_context) || nzchar(glossary_context), has_glossary_context = nzchar(glossary_context), + has_catalog_diagnostics = nzchar(diagnostics), definitions_complete = !definitions_overflow(definitions), tables = tables_text(sources), dictionary_context = dictionary_context, glossary_context = glossary_context, + catalog_diagnostics = diagnostics, definition_index = definition_index_text(definitions), definition_action = definition_action_text(definitions), definition_guidance = paste( @@ -54,6 +57,31 @@ system_prompt_data <- function(sources, definitions, measures, calculations) { ) } +catalog_diagnostics_text <- function(sources) { + labels <- rlang::names2(sources) + lines <- character() + for (i in seq_along(sources)) { + catalog <- sources[[i]]$provider$catalog %||% sources[[i]]$catalog + if (!inherits(catalog, "commons_catalog")) { + next + } + diagnostics <- Filter( + function(diagnostic) diagnostic$severity %in% c("warning", "error"), + catalog$diagnostics + ) + if (length(diagnostics) == 0) { + next + } + prefix <- if (length(sources) > 1) paste0(labels[[i]], ": ") else "" + lines <- c(lines, vapply( + diagnostics, + function(diagnostic) paste0("- ", prefix, diagnostic$message), + character(1) + )) + } + paste(unique(lines), collapse = "\n") +} + definition_action_text <- function(definitions) { defs <- registry_defs(definitions) c( diff --git a/R/tools.R b/R/tools.R index a518305..18fdae7 100644 --- a/R/tools.R +++ b/R/tools.R @@ -554,7 +554,7 @@ catalog_first_touch_text <- function(source, table) { return(character()) } model_ids <- names(Filter( - function(model) any(relation_ids %in% model$exposed), + function(model) any(relation_ids %in% c(model$exposed, model$datasets)), catalog$models )) scopes <- c(relation_ids, model_ids) diff --git a/inst/prompts/system-prompt.md b/inst/prompts/system-prompt.md index 081b19d..6ecec5a 100644 --- a/inst/prompts/system-prompt.md +++ b/inst/prompts/system-prompt.md @@ -50,6 +50,10 @@ When a chart would communicate the answer better than text, render one with `run {[tables]} +{[ if (has_catalog_diagnostics) "# Catalog limitations" else "" ]} + +{[ if (has_catalog_diagnostics) catalog_diagnostics else "" ]} + {[ if (has_dictionary_context) "# About the data" else "" ]} diff --git a/tests/testthat/_snaps/calculations.md b/tests/testthat/_snaps/calculations.md index 761cc67..ce75d7f 100644 --- a/tests/testthat/_snaps/calculations.md +++ b/tests/testthat/_snaps/calculations.md @@ -17,6 +17,25 @@ ! Arguments do not match trusted calculation "sales_value". x Missing arguments: "region". +--- + + Code + call_catalog_calculation(registry, "sales_value", + "{\"region\":\"EMEA\",\"column\":\"order_id\",\"extra\":1}") + Condition + Error in `call_catalog_calculation()`: + ! Arguments do not match trusted calculation "sales_value". + x Unknown arguments: "extra". + +--- + + Code + call_catalog_calculation(registry, "sales_value", + "{\"region\":12,\"column\":\"order_id\"}") + Condition + Error in `call_catalog_calculation()`: + ! Calculation argument `region` must be a "string" value. + # catalog calculations do not trust rejected execution Code diff --git a/tests/testthat/_snaps/catalog-snowflake.md b/tests/testthat/_snaps/catalog-snowflake.md new file mode 100644 index 0000000..7088968 --- /dev/null +++ b/tests/testthat/_snaps/catalog-snowflake.md @@ -0,0 +1,17 @@ +# Snowflake semantic-view variables are typed and quoted + + Code + snowflake_variable_clause(variables, "{}", con) + Condition + Error in `snowflake_variable_clause()`: + ! Semantic-view variables do not match the model. + x Missing variables: "threshold". + +--- + + Code + snowflake_variable_clause(variables, "{\"threshold\":\"not numeric\"}", con) + Condition + Error in `snowflake_variable_value()`: + ! Semantic-view variable type "NUMBER(10,2)" requires a number. + diff --git a/tests/testthat/test-calculations.R b/tests/testthat/test-calculations.R index cde9b76..7cf3c22 100644 --- a/tests/testthat/test-calculations.R +++ b/tests/testthat/test-calculations.R @@ -53,6 +53,22 @@ test_that("catalog calculation values are bound and identifiers are allowlisted" ), error = TRUE ) + expect_snapshot( + call_catalog_calculation( + registry, + "sales_value", + '{"region":"EMEA","column":"order_id","extra":1}' + ), + error = TRUE + ) + expect_snapshot( + call_catalog_calculation( + registry, + "sales_value", + '{"region":12,"column":"order_id"}' + ), + error = TRUE + ) }) test_that("catalog calculations do not trust rejected execution", { diff --git a/tests/testthat/test-catalog-databricks.R b/tests/testthat/test-catalog-databricks.R index 99318b5..b9912ce 100644 --- a/tests/testthat/test-catalog-databricks.R +++ b/tests/testthat/test-catalog-databricks.R @@ -145,3 +145,24 @@ test_that("Databricks metric-view versions fail closed", { expect_false(databricks_metric_version_supported("9.9")) expect_true(databricks_metric_version_supported("1.1")) }) + +test_that("Databricks JSON metadata preserves types and column masks", { + metadata <- list( + columns = list(list( + name = "email", + type = list(name = "varchar", length = 255), + nullable = TRUE + )), + column_masks = list(list( + column_name = "email", + mask_function = list(function_name = "mask_email") + )) + ) + + expect_equal(databricks_type_text(metadata$columns[[1]]$type), "varchar(255)") + expect_equal( + databricks_column_restrictions(metadata, "email"), + "column_mask" + ) + expect_length(databricks_column_restrictions(metadata, "customer_id"), 0) +}) diff --git a/tests/testthat/test-catalog-snowflake.R b/tests/testthat/test-catalog-snowflake.R index 04a945c..9640889 100644 --- a/tests/testthat/test-catalog-snowflake.R +++ b/tests/testthat/test-catalog-snowflake.R @@ -112,3 +112,43 @@ test_that("Snowflake metrics compile through SEMANTIC_VIEW", { expect_match(sql, "METRICS", fixed = TRUE) expect_match(sql, "ORDERS.REVENUE", fixed = TRUE) }) + +test_that("Snowflake masking metadata marks restricted columns", { + row <- data.frame( + check.names = FALSE, + "policy name" = "MASK_EMAIL", + "privacy domain" = NA_character_ + ) + + expect_equal(snowflake_column_restrictions(row), "policy name") +}) + +test_that("Snowflake semantic-view variables are typed and quoted", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + variables <- list( + list(name = "threshold", data_type = "NUMBER(10,2)"), + list(name = "region", data_type = "VARCHAR", default_value = "all") + ) + + clause <- snowflake_variable_clause( + variables, + '{"threshold":100.5,"region":"EMEA\' OR 1=1 --"}', + con + ) + + expect_match(clause, "threshold => 100.5", fixed = TRUE) + expect_match(clause, "'EMEA'' OR 1=1 --'", fixed = TRUE) + expect_snapshot( + snowflake_variable_clause(variables, "{}", con), + error = TRUE + ) + expect_snapshot( + snowflake_variable_clause( + variables, + '{"threshold":"not numeric"}', + con + ), + error = TRUE + ) +}) diff --git a/tests/testthat/test-catalog.R b/tests/testthat/test-catalog.R index 42a7162..714f483 100644 --- a/tests/testthat/test-catalog.R +++ b/tests/testthat/test-catalog.R @@ -311,3 +311,132 @@ test_that("calculations require typed adapter-owned bindings", { error = TRUE ) }) + +test_that("namespace selection takes precedence over duplicate exact selection", { + exact <- catalog_selection_id(DBI::Id(schema = "main", table = "orders"), "exact") + namespace <- catalog_selection_id( + catalog_tag_id(DBI::Id(schema = "main", table = "orders"), "table"), + "namespace" + ) + + selected <- catalog_collapse_selected_ids( + list(exact, namespace), + rep(catalog_source_path_key(exact), 2) + ) + + expect_length(selected, 1) + expect_equal(attr(selected[[1]], "commons_selection"), "namespace") + expect_equal(attr(selected[[1]], "commons_kind"), "table") +}) + +test_that("associated semantic definitions respect physical dependency closure", { + catalog_source <- new_catalog_source("source:test", "snowflake") + orders <- new_catalog_relation( + "relation:orders", + catalog_source$id, + new_source_path(c("DB", "PUBLIC", "ORDERS"), c("catalog", "schema", "table")) + ) + customers <- new_catalog_relation( + "relation:customers", + catalog_source$id, + new_source_path(c("DB", "PUBLIC", "CUSTOMERS"), c("catalog", "schema", "table")) + ) + semantic <- new_catalog_relation( + "relation:model", + catalog_source$id, + new_source_path(c("DB", "PUBLIC", "SALES"), c("catalog", "schema", "table")), + kind = "semantic_view" + ) + model <- new_catalog_model( + "model:sales", + catalog_source$id, + "SALES", + datasets = c(orders$id, customers$id), + execution = list(kind = "snowflake_semantic_view"), + exposed = semantic$id, + dependencies = c(orders$id, customers$id) + ) + kept <- new_catalog_definition( + "definition:orders", + model$id, + semantic$id, + "metric", + "ORDER_COUNT", + expressions = list(new_catalog_expression("snowflake", "COUNT(*)")), + dependencies = orders$id + ) + skipped <- new_catalog_definition( + "definition:customers", + model$id, + semantic$id, + "metric", + "CUSTOMER_COUNT", + expressions = list(new_catalog_expression("snowflake", "COUNT(*)")), + dependencies = customers$id + ) + calculation <- new_catalog_calculation( + "calculation:sales", + catalog_source$id, + "sales_query", + dependencies = model$id, + execution = new_catalog_execution("verified_sql", "snowflake", "SELECT 1") + ) + provider <- new.env(parent = emptyenv()) + provider$selection_modes <- c("relation:orders" = "exact") + provider$catalog <- new_commons_catalog( + sources = list(catalog_source), + relations = list(orders, customers, semantic), + models = list(model), + definitions = list(kept, skipped), + calculations = list(calculation) + ) + + catalog_filter_associated_model(provider, semantic$id) + + expect_equal(names(provider$catalog$definitions), kept$id) + expect_length(provider$catalog$calculations, 0) + expect_length(provider$catalog$models, 1) + expect_equal(provider$catalog$diagnostics[[1]]$code, "semantic_dependency_out_of_scope") + registry <- definitions_registry(list(warehouse = list( + catalog = provider$catalog, + tables = "DB.PUBLIC.ORDERS", + relation_labels = c("relation:orders" = "DB.PUBLIC.ORDERS") + ))) + expect_equal(registry$defs$name, "ORDER_COUNT") +}) + +test_that("private and visible-only semantic definitions stay out of the registry", { + source <- new_catalog_source("source:test", "snowflake") + relation <- new_catalog_relation( + "relation:model", + source$id, + new_source_path(c(table = "MODEL")) + ) + model <- new_catalog_model( + "model:test", + source$id, + "MODEL", + datasets = relation$id, + execution = list(kind = "snowflake_semantic_view"), + access = new_catalog_access("visible_only") + ) + definition <- new_catalog_definition( + "definition:test", + model$id, + relation$id, + "metric", + "REVENUE", + expressions = list(new_catalog_expression("snowflake", "SUM(REVENUE)")) + ) + catalog <- new_commons_catalog( + sources = list(source), + relations = list(relation), + models = list(model), + definitions = list(definition) + ) + + expect_equal(nrow(catalog_definition_registry(catalog)$defs), 0) + catalog$models[[model$id]]$access <- new_catalog_access("queryable") + catalog$definitions[[definition$id]]$visibility <- "private" + expect_equal(nrow(catalog_definition_registry(catalog)$defs), 0) +}) diff --git a/tests/testthat/test-data-dictionary.R b/tests/testthat/test-data-dictionary.R index 4d0b127..f37dfd3 100644 --- a/tests/testthat/test-data-dictionary.R +++ b/tests/testthat/test-data-dictionary.R @@ -281,3 +281,28 @@ test_that("agent tools share first-touch state", { fixed = TRUE ) }) + +test_that("restricted columns suppress representative and sampled values", { + dictionary <- new_data_dictionary(list( + tables = list(sales = list(columns = list( + order_id = list(type = "number"), + rep = list( + type = "string", + display = "restricted", + examples = c("Ada", "Bo") + ) + ))) + )) + source <- data_source( + sales = test_sales(), + dictionary = dictionary, + options = data_source_options(sample_rows = 2) + ) + + description <- describe_table_tool(source, "sales") + + expect_match(description@value, "rep .*restricted") + expect_match(description@value, "Do not select or display") + expect_no_match(description@value, "Ada|Bo") + expect_false("rep" %in% names(source_describe(source, "sales")$sample)) +}) diff --git a/tests/testthat/test-prompt.R b/tests/testthat/test-prompt.R index 243960b..f884805 100644 --- a/tests/testthat/test-prompt.R +++ b/tests/testthat/test-prompt.R @@ -68,3 +68,23 @@ test_that("the packaged prompt omits run_r result handles", { expect_no_match(prompt, "r1", fixed = TRUE) }) + +test_that("catalog diagnostics surface concise model-facing limitations", { + source <- test_source() + catalog_source <- new_catalog_source("source:test", "duckdb") + source$catalog <- new_commons_catalog( + sources = list(catalog_source), + diagnostics = list(new_catalog_diagnostic( + "unsupported_semantics", + "Skipped one unsupported governed filter." + )) + ) + + prompt <- commons_system_prompt( + list(warehouse = source), + default_system_prompt() + ) + + expect_match(prompt, "# Catalog limitations", fixed = TRUE) + expect_match(prompt, "Skipped one unsupported governed filter", fixed = TRUE) +}) diff --git a/tests/testthat/test-tools.R b/tests/testthat/test-tools.R index 7b3694a..141c513 100644 --- a/tests/testthat/test-tools.R +++ b/tests/testthat/test-tools.R @@ -98,6 +98,26 @@ test_that("run_sql_tool runs SQL and tags the result", { expect_match(res@extra$display$markdown, "SELECT count") }) +test_that("free-form SQL stays untrusted beside governed metadata", { + source <- test_source() + catalog_source <- new_catalog_source("source:test", "duckdb") + source$catalog <- new_commons_catalog( + sources = list(catalog_source), + context = list(new_catalog_context( + "context:trusted", + catalog_source$id, + "instruction", + "Revenue is a certified semantic metric.", + delivery = "retrieval", + authority = list(kind = "certified") + )) + ) + + result <- run_sql_tool(source, "SELECT sum(revenue) AS revenue FROM sales") + + expect_equal(result@extra$commons_tag, "B") +}) + test_that("run_sql_tool registers its result as a handle", { store <- new_handle_store() res <- run_sql_tool( From 71687a400c0a8cef3dfede44a6066b96d8ee2a86 Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 11:44:18 -0500 Subject: [PATCH 06/25] import scoped Genie Agent context --- NAMESPACE | 1 + R/calculations.R | 2 +- R/catalog-provider.R | 7 + R/catalog.R | 13 +- R/data-source-options.R | 11 +- R/genie.R | 837 ++++++++++++++++++++++++++ man/data_source_options.Rd | 10 +- man/genie_agent.Rd | 24 + tests/testthat/_snaps/genie.md | 33 + tests/testthat/fixtures/genie-v2.json | 96 +++ tests/testthat/helper-genie.R | 36 ++ tests/testthat/test-genie.R | 186 ++++++ 12 files changed, 1250 insertions(+), 6 deletions(-) create mode 100644 R/genie.R create mode 100644 man/genie_agent.Rd create mode 100644 tests/testthat/_snaps/genie.md create mode 100644 tests/testthat/fixtures/genie-v2.json create mode 100644 tests/testthat/helper-genie.R create mode 100644 tests/testthat/test-genie.R diff --git a/NAMESPACE b/NAMESPACE index 9dede77..5e0ee89 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,7 @@ export(commons_ui) export(context_layer) export(data_source) export(data_source_options) +export(genie_agent) export(list_tables) export(measure) export(read_trajectories) diff --git a/R/calculations.R b/R/calculations.R index 64114d3..9c3fdba 100644 --- a/R/calculations.R +++ b/R/calculations.R @@ -217,7 +217,7 @@ validate_catalog_calculation_args <- function( argument <- arguments[[name]] value <- values[[name]] if (is.null(value)) { - out[[name]] <- NULL + out[[name]] <- argument$default next } out[[name]] <- validate_catalog_calculation_value( diff --git a/R/catalog-provider.R b/R/catalog-provider.R index 2694998..f1aa505 100644 --- a/R/catalog-provider.R +++ b/R/catalog-provider.R @@ -385,6 +385,7 @@ catalog_provider_hydrate <- function(provider, table, call = rlang::caller_env() character(1), "name" ) + relation <- genie_apply_column_overrides(relation) provider$catalog$relations[[relation_id]] <- relation return(relation) } @@ -413,6 +414,7 @@ catalog_provider_hydrate <- function(provider, table, call = rlang::caller_env() relation$constraints <- metadata$constraints %||% relation$constraints relation$kind <- metadata$kind %||% relation$kind relation$access <- new_catalog_access("queryable", "zero-row metadata query") + relation <- genie_apply_column_overrides(relation) provider$catalog$relations[[relation_id]] <- relation relation } @@ -539,6 +541,11 @@ catalog_import_backend <- function(provider) { snowflake_import_semantics(provider) } else if (identical(provider$backend, "databricks")) { databricks_import_semantics(provider) + if (!is.null(provider$options$genie)) { + genie_import(provider, provider$options$genie) + } + } else if (!is.null(provider$options$genie)) { + cli::cli_abort("{.arg genie} is supported only for Databricks connections.") } invisible(provider) } diff --git a/R/catalog.R b/R/catalog.R index 27ddebd..120b562 100644 --- a/R/catalog.R +++ b/R/catalog.R @@ -767,7 +767,8 @@ new_catalog_argument <- function( type = c("string", "integer", "number", "logical", "date", "datetime"), required = TRUE, binding = c("value", "identifier"), - choices = NULL + choices = NULL, + default = NULL ) { type <- rlang::arg_match(type) binding <- rlang::arg_match(binding) @@ -778,12 +779,20 @@ new_catalog_argument <- function( if (identical(binding, "identifier") && length(choices) == 0) { cli::cli_abort("Identifier calculation arguments require an explicit allowlist.") } + if (!is.null(default)) { + default <- validate_catalog_calculation_value( + default, + list(type = type, choices = choices), + "default" + ) + } structure( list( type = type, required = required, binding = binding, - choices = choices + choices = choices, + default = default ), class = "commons_catalog_argument" ) diff --git a/R/data-source-options.R b/R/data-source-options.R index 78da557..210b88a 100644 --- a/R/data-source-options.R +++ b/R/data-source-options.R @@ -8,22 +8,29 @@ #' resolved, such as `"TMP_*"`. #' @param sample_rows The number of live rows to include when a table is #' described. The default, `0`, reads schema metadata only. +#' @param genie An optional configuration from [genie_agent()] for importing +#' context from one Databricks Genie Agent. #' #' @return A `commons_data_source_options` object for [data_source()]. #' @export data_source_options <- function( include = NULL, exclude = NULL, - sample_rows = 0L + sample_rows = 0L, + genie = NULL ) { if (!is.null(exclude) && (!is.character(exclude) || anyNA(exclude))) { cli::cli_abort("{.arg exclude} must be a character vector without missing values.") } + if (!is.null(genie) && !inherits(genie, "commons_genie_agent")) { + cli::cli_abort("{.arg genie} must come from {.fn genie_agent}.") + } structure( list( include = include, exclude = unique(exclude[nzchar(exclude)]), - sample_rows = catalog_count(sample_rows, "sample_rows") + sample_rows = catalog_count(sample_rows, "sample_rows"), + genie = genie ), class = "commons_data_source_options" ) diff --git a/R/genie.R b/R/genie.R new file mode 100644 index 0000000..90ddb8a --- /dev/null +++ b/R/genie.R @@ -0,0 +1,837 @@ +#' Configure a Databricks Genie Agent +#' +#' @param id The Genie Agent ID. +#' @param workspace An optional Databricks workspace URL. When omitted, +#' `DATABRICKS_HOST` or the selected Databricks CLI profile supplies it. +#' @param profile An optional Databricks CLI profile. Profile credentials remain +#' in the CLI credential store and are not retained by commons. +#' +#' @return A configuration object for the `genie` argument of +#' [data_source_options()]. +#' @export +genie_agent <- function(id, workspace = NULL, profile = NULL) { + if (!is.character(id) || length(id) != 1 || is.na(id) || + !grepl("^[[:xdigit:]]{32}$", id)) { + cli::cli_abort("{.arg id} must be a 32-character Genie Agent ID.") + } + workspace <- genie_optional_string(workspace, "workspace") + profile <- genie_optional_string(profile, "profile") + if (!is.null(workspace)) { + workspace <- sub("/+$", "", workspace) + if (!grepl("^https://", workspace)) { + cli::cli_abort("{.arg workspace} must be an HTTPS URL.") + } + } + structure( + list(id = tolower(id), workspace = workspace, profile = profile), + class = "commons_genie_agent" + ) +} + +genie_import <- function(provider, config, fetch = genie_fetch) { + fetched <- fetch(config) + specification <- genie_parse_serialized(fetched$response$serialized_space) + catalog <- provider$catalog + source <- catalog$sources[[1]] + provenance <- new_catalog_provenance( + "authored", + source$id, + locator = paste0("genie:", config$id), + harvested_at = Sys.time() + ) + scope <- genie_import_assets(provider, specification, provenance) + catalog <- provider$catalog + source <- catalog$sources[[1]] + source$extensions$genie[[config$id]] <- list( + id = config$id, + title = fetched$response$title %||% fetched$response$display_name, + warehouse_id = fetched$response$warehouse_id, + etag = fetched$response$etag, + serialized_version = specification$version, + fingerprint = catalog_fingerprint(specification), + retrieval_principal = fetched$principal, + configuration_principal = genie_configuration_principal(fetched$response) + ) + catalog$sources[[source$id]] <- source + provider$catalog <- catalog + genie_reconcile_identity(provider, fetched, config) + if (length(scope) == 0) { + catalog_provider_diagnostic( + provider, + "genie_scope_empty", + "The Genie Agent has no data sources inside this data-source selection.", + details = list(agent_id = config$id) + ) + validate_commons_catalog(provider$catalog) + return(invisible(provider)) + } + + model <- genie_model(provider, specification, scope, provenance, config$id) + provider$catalog$models[[model$id]] <- model + genie_import_instructions(provider, specification, model, provenance, config$id) + genie_import_benchmarks(provider, specification, model, provenance, config$id) + validate_commons_catalog(provider$catalog) + invisible(provider) +} + +genie_fetch <- function(config) { + if (!is.null(config$profile)) { + return(genie_fetch_cli(config)) + } + genie_fetch_rest(config) +} + +genie_fetch_cli <- function(config) { + cli_path <- Sys.which("databricks") + if (!nzchar(cli_path)) { + cli::cli_abort( + "The Databricks CLI is required to use a {.arg profile} for Genie import." + ) + } + endpoint <- sprintf( + "/api/2.0/genie/spaces/%s?include_serialized_space=true", + config$id + ) + response <- genie_cli_json( + cli_path, + c("api", "get", endpoint, "--profile", config$profile, "--output", "json"), + "fetch the Genie Agent" + ) + principal <- genie_cli_json( + cli_path, + c("current-user", "me", "--profile", config$profile, "--output", "json"), + "read the Databricks profile identity" + ) + principal <- principal$user_name %||% principal$userName + list(response = response, principal = principal) +} + +genie_cli_json <- function(command, args, action) { + result <- processx::run(command, args, error_on_status = FALSE) + if (result$status != 0) { + cli::cli_abort( + "Could not {action}.", + parent = simpleError(trimws(result$stderr)) + ) + } + tryCatch( + jsonlite::fromJSON(result$stdout, simplifyVector = FALSE), + error = function(err) cli::cli_abort( + "Databricks returned invalid JSON while trying to {action}.", + parent = err + ) + ) +} + +genie_fetch_rest <- function(config) { + workspace <- config$workspace %||% Sys.getenv("DATABRICKS_HOST", unset = NA) + token <- Sys.getenv("DATABRICKS_TOKEN", unset = NA) + if (is.na(workspace) || !nzchar(workspace) || is.na(token) || !nzchar(token)) { + cli::cli_abort(c( + "Genie import needs Databricks REST credentials.", + "i" = "Supply {.arg profile}, or set {.envvar DATABRICKS_HOST} and {.envvar DATABRICKS_TOKEN}." + )) + } + workspace <- sub("/+$", "", workspace) + agent_url <- sprintf("%s/api/2.0/genie/spaces/%s", workspace, config$id) + response <- genie_perform( + httr2::request(agent_url) |> + httr2::req_url_query(include_serialized_space = "true") |> + httr2::req_auth_bearer_token(token), + "fetch the Genie Agent" + ) + identity <- genie_perform( + httr2::request(paste0(workspace, "/api/2.0/preview/scim/v2/Me")) |> + httr2::req_auth_bearer_token(token), + "read the Databricks REST identity" + ) + list( + response = httr2::resp_body_json(response, simplifyVector = FALSE), + principal = httr2::resp_body_json(identity, simplifyVector = FALSE)$userName + ) +} + +genie_perform <- function(request, action) { + tryCatch( + httr2::req_perform(request), + error = function(err) cli::cli_abort( + "Could not {action}. Confirm that this identity can edit the Genie Agent.", + parent = err + ) + ) +} + +genie_parse_serialized <- function(serialized) { + if (!is.character(serialized) || length(serialized) != 1 || is.na(serialized)) { + cli::cli_abort( + "The Genie response does not contain a serialized Agent definition. Confirm that this identity can edit the Agent." + ) + } + if (nchar(serialized, type = "bytes") > 5 * 1024^2) { + cli::cli_abort("The serialized Genie Agent is larger than the 5 MiB import limit.") + } + specification <- tryCatch( + jsonlite::fromJSON(serialized, simplifyVector = FALSE), + error = function(err) cli::cli_abort( + "The serialized Genie Agent is not valid JSON.", + parent = err + ) + ) + genie_validate_shape(specification) + version <- as.character(specification$version) + if (!version %in% c("1", "2")) { + cli::cli_abort("Genie serialized version {.val {version}} is not supported.") + } + specification +} + +genie_validate_shape <- function(value, depth = 0L, state = new.env()) { + state$nodes <- (state$nodes %||% 0L) + 1L + if (depth > 40L || state$nodes > 50000L) { + cli::cli_abort("The serialized Genie Agent exceeds the import complexity limit.") + } + if (is.character(value) && any(nchar(value, type = "bytes") > 250000L)) { + cli::cli_abort("A string in the serialized Genie Agent exceeds 250 kB.") + } + if (is.list(value)) { + for (item in value) { + genie_validate_shape(item, depth + 1L, state) + } + } + invisible(value) +} + +genie_import_assets <- function(provider, specification, provenance) { + data_sources <- specification$data_sources %||% list() + assets <- c(data_sources$tables %||% list(), data_sources$metric_views %||% list()) + scope <- character() + for (asset in assets) { + identifier <- if (is.character(asset)) asset else asset$identifier + relation <- genie_selected_relation(provider, identifier) + if (is.null(relation)) { + catalog_provider_diagnostic( + provider, + "genie_asset_out_of_scope", + sprintf("Skipped Genie data source %s because it is outside the selection.", identifier %||% ""), + details = list(identifier = identifier) + ) + next + } + scope <- c(scope, relation$id) + if (is.list(asset)) { + description <- genie_text(asset$description) + if (nzchar(description)) { + relation$description <- description + } + relation$synonyms <- unique(c(relation$synonyms, genie_character(asset$synonyms))) + relation$extensions$genie <- asset + relation <- genie_apply_column_overrides(relation) + provider$catalog$relations[[relation$id]] <- relation + genie_add_context( + provider, + "genie_data_source", + paste0("Data source `", identifier, "`: ", description), + relation$id, + provenance + ) + } + } + unique(scope) +} + +genie_selected_relation <- function(provider, identifier) { + if (!is.character(identifier) || length(identifier) != 1 || is.na(identifier)) { + return(NULL) + } + parts <- strsplit(identifier, ".", fixed = TRUE)[[1]] + if (length(parts) != 3 || any(!nzchar(parts))) { + return(NULL) + } + selected <- provider$catalog$relations[names(provider$relation_labels)] + matches <- Filter(function(relation) { + identical(tolower(relation$path$components), tolower(parts)) + }, selected) + if (length(matches) != 1) NULL else matches[[1]] +} + +genie_apply_column_overrides <- function(relation) { + configs <- relation$extensions$genie$column_configs %||% list() + if (length(configs) == 0 || length(relation$columns) == 0) { + return(relation) + } + for (config in configs) { + name <- config$column_name %||% config$name + index <- which(tolower(names(relation$columns)) == tolower(name %||% "")) + if (length(index) != 1) { + next + } + column <- relation$columns[[index]] + description <- genie_text(config$description) + if (nzchar(description)) { + column$description <- description + } + if (isTRUE(config$exclude) || isTRUE(config$excluded)) { + column$display <- "restricted" + column$restrictions <- unique(c(column$restrictions, "excluded_by_genie")) + } + column$extensions$genie <- config + relation$columns[[index]] <- column + } + relation +} + +genie_model <- function(provider, specification, scope, provenance, agent_id) { + source <- provider$catalog$sources[[1]] + title <- specification$title %||% paste("Genie Agent", agent_id) + new_catalog_model( + id = catalog_id("model", source$id, "genie", agent_id), + source_id = source$id, + name = title, + datasets = scope, + relationships = specification$instructions$join_specs %||% list(), + exposed = scope, + dependencies = scope, + version = as.character(specification$version), + fingerprint = catalog_fingerprint(specification), + provenance = provenance, + extensions = list(genie = specification) + ) +} + +genie_import_instructions <- function( + provider, + specification, + model, + provenance, + agent_id +) { + instructions <- specification$instructions %||% list() + for (entry in instructions$text_instructions %||% list()) { + genie_add_context( + provider, + "genie_instruction", + genie_text(entry$content %||% entry), + model$id, + provenance + ) + } + for (entry in instructions$join_specs %||% list()) { + genie_add_context( + provider, + "genie_join", + genie_join_text(entry), + model$id, + provenance + ) + } + for (entry in instructions$example_question_sqls %||% list()) { + genie_import_example(provider, entry, model, provenance) + } + for (entry in instructions$sample_questions %||% list()) { + genie_add_context( + provider, + "genie_sample_question", + genie_text(entry$question %||% entry), + model$id, + provenance + ) + } + genie_import_snippets(provider, instructions$sql_snippets, model, provenance) + genie_import_functions( + provider, + instructions$sql_functions %||% list(), + model, + provenance, + agent_id + ) +} + +genie_import_example <- function(provider, entry, model, provenance) { + question <- genie_text(entry$question %||% entry$display_name) + sql <- genie_text(entry$sql) + text <- paste(c( + if (nzchar(question)) paste("Question:", question), + if (nzchar(sql)) paste("Example SQL:", sql) + ), collapse = "\n") + genie_add_context( + provider, + "genie_example_query", + text, + model$id, + provenance + ) + parameters <- entry$parameters %||% list() + if (length(parameters) == 0 || !nzchar(sql)) { + return(invisible(NULL)) + } + calculation <- genie_parameterized_calculation( + provider, + entry, + model, + provenance + ) + if (inherits(calculation, "commons_catalog_calculation")) { + provider$catalog$calculations[[calculation$id]] <- calculation + } + invisible(calculation) +} + +genie_parameterized_calculation <- function(provider, entry, model, provenance) { + sql <- genie_text(entry$sql) + dependencies <- genie_query_dependencies(sql, provider) + if (is.null(dependencies)) { + catalog_provider_diagnostic( + provider, + "genie_query_scope_unknown", + "Kept a parameterized Genie example as context because its table dependencies could not be confined to the selection.", + entity_id = model$id + ) + return(NULL) + } + arguments <- list() + bindings <- list() + prepared <- sql + for (i in seq_along(entry$parameters)) { + parameter <- entry$parameters[[i]] + name <- parameter$name + type <- genie_argument_type(parameter$type_hint %||% parameter$type) + if (is.null(type) || !is.character(name) || length(name) != 1 || + !grepl("^[A-Za-z_][A-Za-z0-9_]*$", name)) { + catalog_provider_diagnostic( + provider, + "genie_parameter_unsupported", + "Kept a parameterized Genie example as context because one parameter has an unsupported name or type.", + entity_id = model$id + ) + return(NULL) + } + default <- genie_parameter_default(parameter, type) + token <- sprintf("{{commons_genie_%s_%s}}", i, name) + prepared <- genie_replace_parameter(prepared, name, token) + if (lengths(regmatches(prepared, gregexpr(token, prepared, fixed = TRUE))) != 1) { + catalog_provider_diagnostic( + provider, + "genie_parameter_occurrence", + sprintf("Kept a Genie example as context because parameter %s must occur exactly once.", name), + entity_id = model$id + ) + return(NULL) + } + arguments[[name]] <- new_catalog_argument( + type, + required = is.null(default), + default = default + ) + bindings[[length(bindings) + 1]] <- new_catalog_binding(name, token = token) + } + name <- genie_calculation_name(entry$name %||% entry$question %||% entry$id) + new_catalog_calculation( + catalog_id("calculation", model$id, name), + model$source_id, + name, + description = genie_text(entry$question %||% entry$description), + arguments = arguments, + dependencies = unique(c(model$id, dependencies)), + execution = new_catalog_execution( + "parameterized_sql", + "databricks", + prepared, + bindings = bindings, + native = entry + ), + provenance = provenance, + extensions = list(genie = entry) + ) +} + +genie_query_dependencies <- function(sql, provider) { + clean <- strip_sql_literals(sql) + pattern <- "(?i)\\b(?:from|join)\\s+((?:`[^`]+`|[A-Za-z_][A-Za-z0-9_$]*)(?:\\.(?:`[^`]+`|[A-Za-z_][A-Za-z0-9_$]*)){0,2})" + matches <- regmatches(clean, gregexpr(pattern, clean, perl = TRUE))[[1]] + if (length(matches) == 0 || identical(matches, "")) { + return(NULL) + } + identifiers <- sub("(?i)^\\s*(?:from|join)\\s+", "", matches, perl = TRUE) + ctes <- regmatches(clean, gregexpr("(?i)(?:\\bwith|,)\\s*([A-Za-z_][A-Za-z0-9_$]*)\\s+as\\s*\\(", clean, perl = TRUE))[[1]] + ctes <- sub("(?i)^(?:\\s*with|,)\\s*([A-Za-z_][A-Za-z0-9_$]*).*", "\\1", ctes, perl = TRUE) + identifiers <- identifiers[!tolower(identifiers) %in% tolower(ctes)] + if (length(identifiers) == 0) { + return(NULL) + } + relation_ids <- vapply(identifiers, function(identifier) { + parts <- gsub("`", "", strsplit(identifier, ".", fixed = TRUE)[[1]], fixed = TRUE) + parts <- genie_resolve_identifier(parts, provider$snapshot$namespace) + if (length(parts) != 3) { + return(NA_character_) + } + relation <- genie_selected_relation(provider, paste(parts, collapse = ".")) + if (is.null(relation)) NA_character_ else relation$id + }, character(1)) + if (anyNA(relation_ids)) NULL else unique(relation_ids) +} + +genie_replace_parameter <- function(sql, name, token) { + literals <- gregexpr(sql_literal_pattern, sql, perl = TRUE) + code <- regmatches(sql, literals, invert = TRUE)[[1]] + pattern <- sprintf("(^|[^A-Za-z0-9_]):%s([^A-Za-z0-9_]|$)", name) + replacement <- paste0("\\1", token, "\\2") + regmatches(sql, literals, invert = TRUE) <- + list(gsub(pattern, replacement, code, perl = TRUE)) + sql +} + +genie_resolve_identifier <- function(parts, namespace) { + current <- unlist(namespace, use.names = TRUE) + if (length(parts) == 1 && all(c("catalog", "schema") %in% names(current))) { + return(c(current[["catalog"]], current[["schema"]], parts)) + } + if (length(parts) == 2 && "catalog" %in% names(current)) { + return(c(current[["catalog"]], parts)) + } + parts +} + +genie_import_snippets <- function(provider, snippets, model, provenance) { + if (is.null(snippets)) { + return(invisible(NULL)) + } + groups <- list( + filter = snippets$filters, + dimension = snippets$expressions, + metric = snippets$measures + ) + for (role in names(groups)) { + for (entry in groups[[role]] %||% list()) { + sql <- genie_text(entry$sql) + genie_add_context( + provider, + paste0("genie_", role), + paste(c(entry$display_name %||% entry$alias, sql), collapse = ": "), + model$id, + provenance + ) + if (length(model$datasets) != 1 || !nzchar(sql)) { + next + } + name <- entry$display_name %||% entry$alias %||% entry$id + if (is.null(name) || !nzchar(name)) { + next + } + definition <- new_catalog_definition( + catalog_id("definition", model$id, role, name), + model$id, + model$datasets[[1]], + role, + name, + description = genie_text(entry$comment %||% entry$instruction), + synonyms = genie_character(entry$synonyms), + expressions = list(new_catalog_expression("databricks", sql, entry)), + dependencies = model$datasets, + provenance = provenance, + extensions = list(genie = entry) + ) + provider$catalog$definitions[[definition$id]] <- definition + } + } + if (length(model$datasets) != 1 && any(lengths(groups) > 0)) { + catalog_provider_diagnostic( + provider, + "genie_snippet_relation_ambiguous", + "Kept Genie SQL snippets as context because they do not identify one selected relation.", + entity_id = model$id + ) + } + invisible(NULL) +} + +genie_import_functions <- function( + provider, + functions, + model, + provenance, + agent_id +) { + for (entry in functions) { + item <- if (is.character(entry)) list(identifier = entry) else entry + identifier <- item$identifier %||% item$name + signature <- genie_function_signature(provider$con, item) + if (is.null(signature) || length(strsplit(identifier %||% "", ".", fixed = TRUE)[[1]]) != 3) { + catalog_provider_diagnostic( + provider, + "genie_function_signature_unavailable", + sprintf("Kept Genie SQL function %s as context because its callable signature is unavailable.", identifier %||% ""), + entity_id = model$id + ) + genie_add_context( + provider, + "genie_sql_function", + paste("SQL function:", identifier %||% ""), + model$id, + provenance + ) + next + } + arguments <- list() + bindings <- list() + for (parameter in signature$parameters) { + arguments[[parameter$name]] <- new_catalog_argument( + parameter$type, + required = is.null(parameter$default), + default = parameter$default + ) + bindings[[length(bindings) + 1]] <- new_catalog_binding(parameter$name) + } + quoted <- as.character(DBI::dbQuoteIdentifier( + provider$con, + do.call(DBI::Id, as.list(stats::setNames( + strsplit(identifier, ".", fixed = TRUE)[[1]], + c("catalog", "schema", "table") + ))) + )) + placeholders <- paste(rep("?", length(arguments)), collapse = ", ") + sql <- if (identical(signature$kind, "table")) { + sprintf("SELECT * FROM %s(%s)", quoted, placeholders) + } else { + sprintf("SELECT %s(%s) AS value", quoted, placeholders) + } + name <- genie_calculation_name(item$display_name %||% tail(strsplit(identifier, ".", fixed = TRUE)[[1]], 1)) + calculation <- new_catalog_calculation( + catalog_id("calculation", model$id, agent_id, name), + model$source_id, + name, + description = genie_text(item$description), + arguments = arguments, + dependencies = model$id, + execution = new_catalog_execution( + "governed_function", + "databricks", + sql, + bindings = bindings, + native = item + ), + provenance = provenance, + extensions = list(genie = item) + ) + provider$catalog$calculations[[calculation$id]] <- calculation + } + invisible(NULL) +} + +genie_function_signature <- function(con, item) { + if (length(item$parameters %||% list())) { + parameters <- lapply(item$parameters, genie_function_parameter) + if (any(vapply(parameters, is.null, logical(1)))) { + return(NULL) + } + return(list( + kind = tolower(item$function_type %||% item$kind %||% "scalar"), + parameters = parameters + )) + } + identifier <- item$identifier %||% item$name + parts <- strsplit(identifier %||% "", ".", fixed = TRUE)[[1]] + if (length(parts) != 3) { + return(NULL) + } + quoted <- as.character(DBI::dbQuoteIdentifier( + con, + do.call(DBI::Id, as.list(stats::setNames(parts, c("catalog", "schema", "table")))) + )) + report <- tryCatch( + DBI::dbGetQuery(con, paste("DESCRIBE FUNCTION EXTENDED", quoted)), + error = function(err) NULL + ) + if (is.null(report) || nrow(report) == 0) { + return(NULL) + } + lines <- as.character(report[[1]]) + input <- sub("^Input:\\s*", "", lines[grepl("^Input:", lines)]) + type <- sub("^Type:\\s*", "", lines[grepl("^Type:", lines)]) + parameters <- genie_parse_function_input(input[[1]] %||% "") + if (is.null(parameters)) { + return(NULL) + } + list( + kind = if (any(grepl("table", type, ignore.case = TRUE))) "table" else "scalar", + parameters = parameters + ) +} + +genie_parse_function_input <- function(input) { + if (!nzchar(trimws(input))) { + return(list()) + } + entries <- strsplit(input, ",", fixed = TRUE)[[1]] + parameters <- lapply(entries, function(entry) { + parts <- strsplit(trimws(entry), "\\s+")[[1]] + if (length(parts) < 2) { + return(NULL) + } + type <- genie_argument_type(parts[[2]]) + if (is.null(type)) return(NULL) + list(name = parts[[1]], type = type, default = NULL) + }) + if (any(vapply(parameters, is.null, logical(1)))) NULL else parameters +} + +genie_function_parameter <- function(parameter) { + type <- genie_argument_type(parameter$type_hint %||% parameter$type %||% parameter$data_type) + name <- parameter$name + if (is.null(type) || !is.character(name) || length(name) != 1 || + !grepl("^[A-Za-z_][A-Za-z0-9_]*$", name)) { + return(NULL) + } + list( + name = name, + type = type, + default = genie_parameter_default(parameter, type) + ) +} + +genie_import_benchmarks <- function( + provider, + specification, + model, + provenance, + agent_id +) { + benchmarks <- specification$benchmarks %||% list() + if (!is.null(benchmarks$questions)) benchmarks <- benchmarks$questions + for (i in seq_along(benchmarks)) { + entry <- benchmarks[[i]] + text <- paste(c( + genie_text(entry$question), + genie_text(entry$answer$sql %||% entry$sql) + ), collapse = "\n") + genie_add_context( + provider, + "genie_benchmark", + text, + model$id, + provenance, + delivery = "evaluation", + suffix = paste(agent_id, i) + ) + } + invisible(NULL) +} + +genie_add_context <- function( + provider, + kind, + text, + scope, + provenance, + delivery = c("first_touch", "retrieval"), + suffix = NULL +) { + if (!is.character(text) || length(text) != 1 || is.na(text) || !nzchar(trimws(text))) { + return(invisible(NULL)) + } + source <- provider$catalog$sources[[1]] + for (where in delivery) { + context <- new_catalog_context( + catalog_id("context", source$id, kind, catalog_fingerprint(text), suffix, where), + source$id, + kind, + text, + scope = scope, + delivery = where, + authority = list(kind = "authored", system = "databricks_genie"), + provenance = provenance + ) + provider$catalog$context[[context$id]] <- context + } + invisible(NULL) +} + +genie_reconcile_identity <- function(provider, fetched, config) { + execution <- provider$snapshot$principal + retrieval <- fetched$principal + configured <- genie_configuration_principal(fetched$response) + identities <- Filter( + function(value) is.character(value) && length(value) == 1 && nzchar(value), + list(execution = execution, retrieval = retrieval, configured = configured) + ) + if (length(unique(tolower(unlist(identities)))) > 1) { + catalog_provider_diagnostic( + provider, + "genie_identity_mismatch", + "The Genie retrieval, Agent owner, and DBI execution identities differ; warehouse grants still control execution.", + severity = "info", + details = c(identities, list(agent_id = config$id)) + ) + } + invisible(NULL) +} + +genie_configuration_principal <- function(response) { + principal <- response$creator_user_name %||% response$owner_user_name + if (is.null(principal) && grepl("^/Users/", response$parent_path %||% "")) { + principal <- sub("^/Users/", "", response$parent_path) + } + principal +} + +genie_join_text <- function(entry) { + sql <- genie_text(entry$sql %||% entry$condition) + paste(c("Join guidance", entry$left, entry$right, sql), collapse = ": ") +} + +genie_argument_type <- function(type) { + type <- toupper(as.character(type %||% "")) + if (grepl("^(STRING|CHAR|VARCHAR)", type)) return("string") + if (grepl("^(TINYINT|SMALLINT|INT|INTEGER)$", type)) return("integer") + if (grepl("^(BIGINT|LONG|FLOAT|DOUBLE|REAL|DECIMAL|NUMERIC)", type)) return("number") + if (grepl("^(BOOL|BOOLEAN)$", type)) return("logical") + if (grepl("^DATE$", type)) return("date") + if (grepl("^(TIMESTAMP|DATETIME)", type)) return("datetime") + NULL +} + +genie_parameter_default <- function(parameter, type) { + value <- parameter$default + if (is.null(value)) { + value <- parameter$default_value$values + } + while (is.list(value) && length(value) == 1) { + value <- value[[1]] + } + if (is.null(value)) return(NULL) + value <- switch( + type, + integer = as.integer(value), + number = as.numeric(value), + logical = if (is.logical(value)) value else tolower(value) == "true", + as.character(value) + ) + if (length(value) != 1 || is.na(value)) NULL else value +} + +genie_calculation_name <- function(value) { + value <- genie_text(value) + if (!nzchar(value)) value <- "genie_query" + value +} + +genie_text <- function(value) { + values <- genie_character(value) + paste(values[nzchar(values)], collapse = "\n") +} + +genie_character <- function(value) { + if (is.null(value)) return(character()) + if (is.character(value)) return(unname(value[!is.na(value)])) + if (is.list(value)) { + return(unlist(lapply(value, genie_character), use.names = FALSE)) + } + as.character(value) +} + +genie_optional_string <- function(value, name) { + if (is.null(value)) return(NULL) + if (!is.character(value) || length(value) != 1 || is.na(value) || !nzchar(value)) { + cli::cli_abort("{.arg {name}} must be one non-empty string or null.") + } + value +} diff --git a/man/data_source_options.Rd b/man/data_source_options.Rd index 7d174d3..69e1b66 100644 --- a/man/data_source_options.Rd +++ b/man/data_source_options.Rd @@ -4,7 +4,12 @@ \alias{data_source_options} \title{Configure a data source} \usage{ -data_source_options(include = NULL, exclude = NULL, sample_rows = 0L) +data_source_options( + include = NULL, + exclude = NULL, + sample_rows = 0L, + genie = NULL +) } \arguments{ \item{include}{Objects or namespaces to expose. DBI sources accept exact @@ -17,6 +22,9 @@ resolved, such as \code{"TMP_*"}.} \item{sample_rows}{The number of live rows to include when a table is described. The default, \code{0}, reads schema metadata only.} + +\item{genie}{An optional configuration from \code{\link[=genie_agent]{genie_agent()}} for importing +context from one Databricks Genie Agent.} } \value{ A \code{commons_data_source_options} object for \code{\link[=data_source]{data_source()}}. diff --git a/man/genie_agent.Rd b/man/genie_agent.Rd new file mode 100644 index 0000000..5084d06 --- /dev/null +++ b/man/genie_agent.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/genie.R +\name{genie_agent} +\alias{genie_agent} +\title{Configure a Databricks Genie Agent} +\usage{ +genie_agent(id, workspace = NULL, profile = NULL) +} +\arguments{ +\item{id}{The Genie Agent ID.} + +\item{workspace}{An optional Databricks workspace URL. When omitted, +\code{DATABRICKS_HOST} or the selected Databricks CLI profile supplies it.} + +\item{profile}{An optional Databricks CLI profile. Profile credentials remain +in the CLI credential store and are not retained by commons.} +} +\value{ +A configuration object for the \code{genie} argument of +\code{\link[=data_source_options]{data_source_options()}}. +} +\description{ +Configure a Databricks Genie Agent +} diff --git a/tests/testthat/_snaps/genie.md b/tests/testthat/_snaps/genie.md new file mode 100644 index 0000000..370b5b7 --- /dev/null +++ b/tests/testthat/_snaps/genie.md @@ -0,0 +1,33 @@ +# Genie Agent configuration retains no credentials + + Code + genie_agent("not-an-id") + Condition + Error in `genie_agent()`: + ! `id` must be a 32-character Genie Agent ID. + +# Genie parsing is bounded and versions fail closed + + Code + genie_parse_serialized("{\"version\": 99}") + Condition + Error in `genie_parse_serialized()`: + ! Genie serialized version "99" is not supported. + +--- + + Code + genie_parse_serialized(paste0("{\"version\": 2, \"text\": \"", paste(rep("x", + 250001), collapse = ""), "\"}")) + Condition + Error in `genie_validate_shape()`: + ! A string in the serialized Genie Agent exceeds 250 kB. + +# Genie permission failures are independent of DBI metadata + + Code + genie_import(provider, genie_agent("01f190d76f64158d8a1dd3618e1f10d0"), fetch) + Condition + Error in `fetch()`: + ! The REST identity cannot edit this Agent. + diff --git a/tests/testthat/fixtures/genie-v2.json b/tests/testthat/fixtures/genie-v2.json new file mode 100644 index 0000000..1fadeee --- /dev/null +++ b/tests/testthat/fixtures/genie-v2.json @@ -0,0 +1,96 @@ +{ + "version": 2, + "data_sources": { + "tables": [ + { + "identifier": "samples.nyctaxi.trips", + "description": ["One row is one taxi trip."], + "column_configs": [ + { + "column_name": "pickup_zip", + "description": ["Pickup postal code."] + }, + { + "column_name": "rider_email", + "exclude": true + } + ], + "future_asset_field": {"keep": true} + }, + { + "identifier": "samples.private.riders", + "description": ["This asset is deliberately outside the selection."] + } + ] + }, + "instructions": { + "text_instructions": [ + { + "id": "instruction-1", + "content": ["Treat cancelled rides as non-revenue trips."] + } + ], + "join_specs": [ + { + "left": "samples.nyctaxi.trips", + "right": "samples.nyctaxi.zones", + "sql": ["trips.pickup_zip = zones.zip", "--rt=FROM_RELATIONSHIP_TYPE_MANY_TO_ONE--"] + } + ], + "sample_questions": [ + {"question": ["Which pickup areas are busiest?"]} + ], + "example_question_sqls": [ + { + "id": "static-example", + "question": ["How many trips are there?"], + "sql": ["SELECT count(*) FROM samples.nyctaxi.trips"] + }, + { + "id": "parameter-example", + "name": "trips_by_zip", + "question": ["How many trips began in a postal code?"], + "sql": ["SELECT count(*) AS trips FROM samples.nyctaxi.trips WHERE pickup_zip = :zip"], + "parameters": [ + { + "name": "zip", + "type_hint": "STRING", + "description": ["Pickup postal code."], + "default_value": {"values": ["10001"]} + } + ] + } + ], + "sql_snippets": { + "filters": [ + { + "id": "completed", + "display_name": "completed_trips", + "sql": ["cancelled_at IS NULL"], + "comment": ["Trips that were not cancelled."] + } + ], + "expressions": [], + "measures": [] + }, + "sql_functions": [ + { + "identifier": "samples.nyctaxi.normalize_zip", + "display_name": "normalize_zip", + "function_type": "scalar", + "parameters": [ + {"name": "zip", "type_hint": "STRING"} + ] + } + ] + }, + "benchmarks": { + "questions": [ + { + "question": ["Benchmark question"], + "answer": {"sql": ["SELECT 42"]} + } + ] + }, + "future_top_level_field": {"keep": true} +} diff --git a/tests/testthat/helper-genie.R b/tests/testthat/helper-genie.R new file mode 100644 index 0000000..1a97bc3 --- /dev/null +++ b/tests/testthat/helper-genie.R @@ -0,0 +1,36 @@ +genie_test_provider <- function() { + con <- DBI::dbConnect(duckdb::duckdb()) + source <- new_catalog_source( + "source:databricks", + "databricks", + dialect = "databricks", + principal = "executor@example.com", + namespace = list(catalog = "samples", schema = "nyctaxi") + ) + columns <- list( + new_catalog_column("pickup_zip"), + new_catalog_column("rider_email", examples = "rider@example.com") + ) + relation <- new_catalog_relation( + "relation:trips", + source$id, + new_source_path( + c("samples", "nyctaxi", "trips"), + c("catalog", "schema", "table") + ), + columns = columns + ) + provider <- new.env(parent = emptyenv()) + provider$con <- con + provider$catalog <- new_commons_catalog( + sources = list(source), + relations = list(relation), + provider = provider + ) + provider$relation_labels <- c("relation:trips" = "trips") + provider$snapshot <- list( + principal = "executor@example.com", + namespace = list(catalog = "samples", schema = "nyctaxi") + ) + provider +} diff --git a/tests/testthat/test-genie.R b/tests/testthat/test-genie.R new file mode 100644 index 0000000..0b0dd6d --- /dev/null +++ b/tests/testthat/test-genie.R @@ -0,0 +1,186 @@ +test_that("Genie Agent configuration retains no credentials", { + config <- genie_agent( + "01f190d76f64158d8a1dd3618e1f10d0", + workspace = "https://example.cloud.databricks.com/", + profile = "example" + ) + + expect_equal(config$workspace, "https://example.cloud.databricks.com") + expect_equal(config$profile, "example") + expect_false(any(grepl("token|credential", names(config), ignore.case = TRUE))) + expect_snapshot(genie_agent("not-an-id"), error = TRUE) +}) + +test_that("serialized Genie context is scoped and routed by authority", { + fixture <- paste( + readLines(test_path("fixtures", "genie-v2.json"), warn = FALSE), + collapse = "\n" + ) + provider <- genie_test_provider() + fetch <- function(config) list( + response = list( + serialized_space = fixture, + title = "Taxi Agent", + warehouse_id = "warehouse-id", + creator_user_name = "owner@example.com" + ), + principal = "retriever@example.com" + ) + + genie_import( + provider, + genie_agent("01f190d76f64158d8a1dd3618e1f10d0"), + fetch = fetch + ) + + catalog <- provider$catalog + relation <- catalog$relations[["relation:trips"]] + model <- catalog$models[[1]] + deliveries <- vapply(catalog$context, `[[`, character(1), "delivery") + calculation_names <- vapply(catalog$calculations, `[[`, character(1), "name") + + expect_equal(relation$description, "One row is one taxi trip.") + expect_equal(relation$columns$pickup_zip$description, "Pickup postal code.") + expect_equal(relation$columns$rider_email$display, "restricted") + expect_equal(model$datasets, "relation:trips") + expect_true("trips_by_zip" %in% calculation_names) + expect_true("normalize_zip" %in% calculation_names) + expect_false("static-example" %in% calculation_names) + expect_true("evaluation" %in% deliveries) + expect_true(all(c("first_touch", "retrieval") %in% deliveries)) + expect_true(model$extensions$genie$future_top_level_field$keep) + expect_true(any(vapply( + catalog$diagnostics, + function(x) x$code == "genie_asset_out_of_scope", + logical(1) + ))) + expect_true(any(vapply( + catalog$diagnostics, + function(x) x$code == "genie_identity_mismatch", + logical(1) + ))) +}) + +test_that("Genie parameters are typed, defaulted, and bound", { + fixture <- paste( + readLines(test_path("fixtures", "genie-v2.json"), warn = FALSE), + collapse = "\n" + ) + provider <- genie_test_provider() + fetch <- function(config) list( + response = list(serialized_space = fixture), + principal = "executor@example.com" + ) + genie_import( + provider, + genie_agent("01f190d76f64158d8a1dd3618e1f10d0"), + fetch = fetch + ) + calculation <- Filter( + function(x) x$name == "trips_by_zip", + provider$catalog$calculations + )[[1]] + + values <- validate_catalog_calculation_args(calculation, list()) + prepared <- prepare_catalog_calculation( + calculation$execution, + calculation$arguments, + values, + provider$con + ) + + expect_equal(values$zip, "10001") + expect_equal(prepared$params, list("10001")) + expect_match(prepared$sql, "pickup_zip = ?", fixed = TRUE) + expect_false(grepl("10001", prepared$sql, fixed = TRUE)) +}) + +test_that("Genie parsing is bounded and versions fail closed", { + expect_snapshot( + genie_parse_serialized('{"version": 99}'), + error = TRUE + ) + parsed <- genie_parse_serialized('{"version": 2, "text": "ok"}') + expect_equal(parsed[c("version", "text")], list(version = 2L, text = "ok")) + expect_snapshot( + genie_parse_serialized(paste0( + '{"version": 2, "text": "', + paste(rep("x", 250001), collapse = ""), + '"}' + )), + error = TRUE + ) +}) + +test_that("Genie changes are fetched for each provider construction", { + provider <- genie_test_provider() + calls <- 0L + fetch <- function(config) { + calls <<- calls + 1L + list( + response = list(serialized_space = sprintf( + '{"version":2,"data_sources":{"tables":[{"identifier":"samples.nyctaxi.trips"}]},"instructions":{"text_instructions":[{"content":["revision %s"]}]}}', + calls + )), + principal = "executor@example.com" + ) + } + config <- genie_agent("01f190d76f64158d8a1dd3618e1f10d0") + + genie_import(provider, config, fetch) + first <- provider$catalog$models[[1]]$fingerprint + provider <- genie_test_provider() + genie_import(provider, config, fetch) + second <- provider$catalog$models[[1]]$fingerprint + + expect_equal(calls, 2L) + expect_false(identical(first, second)) +}) + +test_that("Genie permission failures are independent of DBI metadata", { + provider <- genie_test_provider() + fetch <- function(config) { + cli::cli_abort("The REST identity cannot edit this Agent.") + } + + expect_snapshot( + genie_import( + provider, + genie_agent("01f190d76f64158d8a1dd3618e1f10d0"), + fetch + ), + error = TRUE + ) + expect_length(provider$catalog$relations, 1) +}) + +test_that("live Genie import honors the selected relation", { + skip_if_not(identical(Sys.getenv("COMMONS_LIVE_DATABRICKS"), "true")) + required <- c( + "COMMONS_DATABRICKS_GENIE_ID", + "COMMONS_DATABRICKS_GENIE_PROFILE", + "COMMONS_DATABRICKS_CATALOG", + "COMMONS_DATABRICKS_SCHEMA", + "COMMONS_DATABRICKS_TABLE" + ) + skip_if(any(!nzchar(Sys.getenv(required)))) + con <- DBI::dbConnect(odbc::odbc(), "Databricks") + withr::defer(DBI::dbDisconnect(con)) + source <- data_source( + con, + options = data_source_options( + include = DBI::Id( + catalog = Sys.getenv("COMMONS_DATABRICKS_CATALOG"), + schema = Sys.getenv("COMMONS_DATABRICKS_SCHEMA"), + table = Sys.getenv("COMMONS_DATABRICKS_TABLE") + ), + genie = genie_agent( + Sys.getenv("COMMONS_DATABRICKS_GENIE_ID"), + profile = Sys.getenv("COMMONS_DATABRICKS_GENIE_PROFILE") + ) + ) + ) + + expect_true(length(source$provider$catalog$context) > 0) + expect_true(length(source$provider$catalog$sources[[1]]$extensions$genie) > 0) +}) From 31620af4fc29b865e0c3cd3efacb6c5101f91444 Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 11:49:33 -0500 Subject: [PATCH 07/25] add Apache Ossie interchange --- R/catalog-ossie.R | 783 ++++++++++++++++++ tests/testthat/_snaps/catalog-ossie.md | 16 + tests/testthat/fixtures/ossie-databricks.yaml | 69 ++ tests/testthat/test-catalog-ossie.R | 155 ++++ 4 files changed, 1023 insertions(+) create mode 100644 R/catalog-ossie.R create mode 100644 tests/testthat/_snaps/catalog-ossie.md create mode 100644 tests/testthat/fixtures/ossie-databricks.yaml create mode 100644 tests/testthat/test-catalog-ossie.R diff --git a/R/catalog-ossie.R b/R/catalog-ossie.R new file mode 100644 index 0000000..992a63b --- /dev/null +++ b/R/catalog-ossie.R @@ -0,0 +1,783 @@ +catalog_from_ossie <- function( + input, + source_id = "source:ossie", + call = rlang::caller_env() +) { + document <- ossie_read(input, call) + version <- as.character(document$version %||% "") + if (!version %in% c("0.1.1", "0.2.0.dev0")) { + cli::cli_abort( + "Apache Ossie version {.val {version}} is not supported.", + call = call + ) + } + models <- document$semantic_model + if (!is.list(models) || length(models) == 0) { + cli::cli_abort( + "An Apache Ossie document must contain at least one semantic model.", + call = call + ) + } + provenance <- new_catalog_provenance("authored", source_id) + source <- new_catalog_source( + source_id, + "ossie", + label = ossie_input_label(input), + version = version, + provenance = provenance, + extensions = list(ossie = list(document = document)) + ) + catalog <- new_commons_catalog(sources = list(source)) + for (raw_model in models) { + catalog <- ossie_import_model(catalog, raw_model, source, provenance, call) + } + validate_commons_catalog(catalog, call) + catalog +} + +catalog_to_ossie <- function( + catalog, + version = "0.2.0.dev0", + call = rlang::caller_env() +) { + validate_commons_catalog(catalog, call) + if (!version %in% c("0.1.1", "0.2.0.dev0")) { + cli::cli_abort("Apache Ossie version {.val {version}} is not supported.", call = call) + } + source <- catalog$sources[[1]] + document <- source$extensions$ossie$document %||% list() + document$version <- version + diagnostics <- list() + exported <- lapply(catalog$models, function(model) { + result <- ossie_export_model(catalog, model) + diagnostics <<- c(diagnostics, result$diagnostics) + result$model + }) + document$semantic_model <- unname(exported) + for (calculation in catalog$calculations) { + diagnostics[[length(diagnostics) + 1]] <- new_catalog_diagnostic( + "ossie_calculation_omitted", + sprintf("Trusted calculation %s has no Apache Ossie core representation.", calculation$name), + severity = "info", + entity_id = calculation$id + ) + } + for (term in catalog$terms) { + diagnostics[[length(diagnostics) + 1]] <- new_catalog_diagnostic( + "ossie_term_omitted", + sprintf("Glossary term %s has no Apache Ossie core representation.", term$name), + severity = "info", + entity_id = term$id + ) + } + for (context in catalog$context) { + if (is.null(context$extensions$ossie) && + !ossie_context_representable(context, catalog)) { + diagnostics[[length(diagnostics) + 1]] <- new_catalog_diagnostic( + "ossie_context_omitted", + sprintf("Context record %s is not scoped to an exported semantic model.", context$id), + severity = "info", + entity_id = context$id + ) + } + } + structure( + list(document = document, diagnostics = diagnostics), + class = "commons_ossie_export" + ) +} + +ossie_read <- function(input, call) { + if (is.list(input)) { + return(input) + } + if (!is.character(input) || length(input) != 1 || is.na(input) || !nzchar(input)) { + cli::cli_abort( + "{.arg input} must be an Apache Ossie object or one YAML or JSON path.", + call = call + ) + } + if (!file.exists(input)) { + cli::cli_abort("Apache Ossie file {.path {input}} does not exist.", call = call) + } + if (file.info(input)$size > 10 * 1024^2) { + cli::cli_abort("Apache Ossie files must not exceed 10 MiB.", call = call) + } + if (grepl("\\.json$", input, ignore.case = TRUE)) { + tryCatch( + jsonlite::fromJSON(input, simplifyVector = FALSE), + error = function(err) cli::cli_abort( + "Could not parse Apache Ossie JSON.", + parent = err, + call = call + ) + ) + } else { + tryCatch( + yaml::read_yaml(input), + error = function(err) cli::cli_abort( + "Could not parse Apache Ossie YAML.", + parent = err, + call = call + ) + ) + } +} + +ossie_import_model <- function(catalog, raw, source, provenance, call) { + if (!rlang::is_string(raw$name) || !is.list(raw$datasets) || + length(raw$datasets) == 0) { + cli::cli_abort( + "Every Apache Ossie semantic model needs a name and at least one dataset.", + call = call + ) + } + model_id <- catalog_id("model", source$id, raw$name) + relation_ids <- character() + dataset_map <- character() + definitions <- list() + contexts <- list() + for (dataset in raw$datasets) { + imported <- ossie_import_dataset( + dataset, + model_id, + source, + provenance, + call + ) + if (imported$relation$id %in% names(catalog$relations)) { + cli::cli_abort( + "Apache Ossie dataset {.val {dataset$name}} duplicates another dataset ID.", + call = call + ) + } + catalog$relations[[imported$relation$id]] <- imported$relation + relation_ids <- c(relation_ids, imported$relation$id) + dataset_map[[dataset$name]] <- imported$relation$id + definitions <- c(definitions, imported$definitions) + contexts <- c(contexts, imported$context) + } + relationships <- ossie_validate_relationships(raw$relationships, dataset_map, call) + model <- new_catalog_model( + model_id, + source$id, + raw$name, + description = raw$description, + datasets = relation_ids, + relationships = relationships, + exposed = relation_ids, + dependencies = relation_ids, + version = source$version, + fingerprint = catalog_fingerprint(raw), + provenance = provenance, + extensions = ossie_import_extensions(raw) + ) + catalog$models[[model$id]] <- model + metrics <- lapply(raw$metrics %||% list(), function(metric) { + ossie_import_metric(metric, model, dataset_map, provenance, call) + }) + for (definition in c(definitions, metrics)) { + catalog$definitions[[definition$id]] <- definition + } + contexts <- c( + contexts, + ossie_ai_context_records( + raw$ai_context, + source$id, + model$id, + "ossie_model_context", + provenance + ), + ossie_relationship_context( + relationships, + source$id, + model$id, + provenance + ) + ) + for (context in contexts) { + catalog$context[[context$id]] <- context + } + ossie_add_relationship_constraints(catalog, relationships, dataset_map, provenance) +} + +ossie_import_dataset <- function(dataset, model_id, source, provenance, call) { + if (!rlang::is_string(dataset$name) || !rlang::is_string(dataset$source)) { + cli::cli_abort( + "Every Apache Ossie dataset needs string {.field name} and {.field source} fields.", + call = call + ) + } + path <- ossie_source_path(dataset$source) + relation_id <- catalog_id("relation", model_id, dataset$name) + definitions <- lapply(dataset$fields %||% list(), function(field) { + ossie_import_field(field, model_id, relation_id, provenance, call) + }) + direct <- Filter(ossie_definition_is_column, definitions) + columns <- lapply(direct, function(definition) { + new_catalog_column( + definition$name, + logical_type = ossie_to_logical_type(definition$logical_type), + description = definition$description, + provenance = provenance, + extensions = list(ossie = definition$extensions$ossie) + ) + }) + constraints <- list() + if (length(dataset$primary_key %||% character())) { + constraints[[length(constraints) + 1]] <- new_catalog_constraint( + "primary_key", + unlist(dataset$primary_key), + enforcement = "unknown", + provenance = provenance + ) + } + for (key in dataset$unique_keys %||% list()) { + constraints[[length(constraints) + 1]] <- new_catalog_constraint( + "unique", + unlist(key), + enforcement = "unknown", + provenance = provenance + ) + } + context <- ossie_ai_context_records( + dataset$ai_context, + source$id, + relation_id, + "ossie_dataset_context", + provenance + ) + for (definition in definitions) { + context <- c(context, ossie_ai_context_records( + definition$extensions$ossie$ai_context, + source$id, + definition$id, + "ossie_field_context", + provenance + )) + } + list( + relation = new_catalog_relation( + relation_id, + source$id, + path, + kind = if ("model_dataset" %in% path$roles) "governed_query" else "table", + name = dataset$name, + description = dataset$description, + synonyms = ossie_ai_synonyms(dataset$ai_context), + columns = columns, + constraints = constraints, + access = new_catalog_access("unknown", "Apache Ossie model"), + provenance = provenance, + extensions = ossie_import_extensions(dataset) + ), + definitions = definitions, + context = context + ) +} + +ossie_import_field <- function(field, model_id, relation_id, provenance, call) { + if (!rlang::is_string(field$name)) { + cli::cli_abort("Every Apache Ossie field needs a string name.", call = call) + } + expressions <- ossie_import_expressions(field$expression, field$name, call) + is_time <- field$dimension$is_time + if (is.null(is_time)) { + is_time <- field$datatype %in% c("Date", "Time", "DateTime", "DateTimeTz") + } + new_catalog_definition( + catalog_id("definition", model_id, relation_id, field$name), + model_id, + relation_id, + if (isTRUE(is_time)) "time_dimension" else "dimension", + field$name, + label = field$label, + description = field$description, + synonyms = ossie_ai_synonyms(field$ai_context), + logical_type = field$datatype, + expressions = expressions, + dependencies = relation_id, + provenance = provenance, + extensions = ossie_import_extensions(field) + ) +} + +ossie_import_metric <- function(metric, model, dataset_map, provenance, call) { + if (!rlang::is_string(metric$name)) { + cli::cli_abort("Every Apache Ossie metric needs a string name.", call = call) + } + expressions <- ossie_import_expressions(metric$expression, metric$name, call) + relation_id <- ossie_metric_relation(expressions, dataset_map) + new_catalog_definition( + catalog_id("definition", model$id, "metric", metric$name), + model$id, + relation_id, + "metric", + metric$name, + description = metric$description, + synonyms = ossie_ai_synonyms(metric$ai_context), + logical_type = metric$datatype, + expressions = expressions, + dependencies = model$datasets, + provenance = provenance, + extensions = ossie_import_extensions(metric) + ) +} + +ossie_import_expressions <- function(expression, name, call) { + dialects <- expression$dialects + if (!is.list(dialects) || length(dialects) == 0) { + cli::cli_abort( + "Apache Ossie field or metric {.val {name}} needs at least one expression dialect.", + call = call + ) + } + lapply(dialects, function(item) { + if (!rlang::is_string(item$dialect) || !rlang::is_string(item$expression)) { + cli::cli_abort( + "Every Apache Ossie expression needs string dialect and expression fields.", + call = call + ) + } + new_catalog_expression(tolower(item$dialect), item$expression, item) + }) +} + +ossie_validate_relationships <- function(relationships, dataset_map, call) { + out <- relationships %||% list() + for (relationship in out) { + required <- c("name", "from", "to", "from_columns", "to_columns") + if (any(vapply(relationship[required], is.null, logical(1))) || + !relationship$from %in% names(dataset_map) || + !relationship$to %in% names(dataset_map) || + length(relationship$from_columns) != length(relationship$to_columns)) { + cli::cli_abort("An Apache Ossie relationship is incomplete or refers to an unknown dataset.", call = call) + } + } + out +} + +ossie_add_relationship_constraints <- function( + catalog, + relationships, + dataset_map, + provenance +) { + for (relationship in relationships) { + relation_id <- dataset_map[[relationship$from]] + relation <- catalog$relations[[relation_id]] + relation$constraints[[length(relation$constraints) + 1]] <- + new_catalog_constraint( + "foreign_key", + unlist(relationship$from_columns), + reference = list( + relation_id = dataset_map[[relationship$to]], + columns = unlist(relationship$to_columns) + ), + enforcement = "unknown", + native = relationship, + provenance = provenance + ) + catalog$relations[[relation_id]] <- relation + } + catalog +} + +ossie_source_path <- function(source) { + parts <- strsplit(source, ".", fixed = TRUE)[[1]] + if (length(parts) == 3 && all(grepl("^[A-Za-z_][A-Za-z0-9_$]*$", parts))) { + return(new_source_path(parts, c("catalog", "schema", "table"))) + } + new_source_path(c(model_dataset = catalog_fingerprint(source)), "model_dataset") +} + +ossie_metric_relation <- function(expressions, dataset_map) { + sql <- paste(vapply(expressions, `[[`, character(1), "sql"), collapse = "\n") + matches <- names(dataset_map)[vapply(names(dataset_map), function(name) { + grepl(paste0("\\b", name, "\\s*\\."), strip_sql_literals(sql), perl = TRUE) + }, logical(1))] + if (length(matches) == 1) dataset_map[[matches]] else unname(dataset_map[[1]]) +} + +ossie_definition_is_column <- function(definition) { + any(vapply(definition$expressions, function(expression) { + identical(expression$sql, definition$name) + }, logical(1))) +} + +ossie_ai_context_records <- function( + ai_context, + source_id, + scope, + kind, + provenance +) { + if (is.null(ai_context)) return(list()) + texts <- if (is.character(ai_context)) { + ai_context + } else { + c(ai_context$instructions, unlist(ai_context$examples %||% list())) + } + texts <- unique(texts[!is.na(texts) & nzchar(texts)]) + out <- list() + for (i in seq_along(texts)) { + for (delivery in c("first_touch", "retrieval")) { + context <- new_catalog_context( + catalog_id("context", scope, kind, i, delivery), + source_id, + kind, + texts[[i]], + scope, + delivery, + authority = list(kind = "authored", system = "apache_ossie"), + provenance = provenance, + extensions = list(ossie = ai_context) + ) + out[[context$id]] <- context + } + } + out +} + +ossie_relationship_context <- function( + relationships, + source_id, + model_id, + provenance +) { + out <- list() + for (relationship in relationships) { + records <- ossie_ai_context_records( + relationship$ai_context, + source_id, + model_id, + "ossie_relationship_context", + provenance + ) + out <- c(out, records) + } + out +} + +ossie_import_extensions <- function(value) { + out <- list(ossie = value) + for (extension in value$custom_extensions %||% list()) { + vendor <- tolower(extension$vendor_name %||% "") + data <- ossie_extension_data(extension$data) + if (nzchar(vendor)) out[[vendor]] <- data + } + out +} + +ossie_extension_data <- function(data) { + if (!is.character(data) || length(data) != 1) return(data) + tryCatch( + jsonlite::fromJSON(data, simplifyVector = FALSE), + error = function(err) data + ) +} + +ossie_export_model <- function(catalog, model) { + raw <- model$extensions$ossie %||% list() + diagnostics <- list() + raw$name <- model$name + raw$description <- model$description + raw$ai_context <- ossie_export_ai_context( + catalog, + model$id, + raw$ai_context + ) + datasets <- lapply(model$datasets, function(id) { + result <- ossie_export_dataset(catalog, model, catalog$relations[[id]]) + diagnostics <<- c(diagnostics, result$diagnostics) + result$dataset + }) + raw$datasets <- unname(datasets) + raw$relationships <- model$relationships + metrics <- Filter( + function(definition) identical(definition$model_id, model$id) && + identical(definition$role, "metric"), + catalog$definitions + ) + metric_results <- lapply(metrics, ossie_export_definition, catalog = catalog) + diagnostics <- c( + diagnostics, + unlist(lapply(metric_results, `[[`, "diagnostics"), recursive = FALSE) + ) + raw$metrics <- unname(Filter( + Negate(is.null), + lapply(metric_results, `[[`, "definition") + )) + omitted_metrics <- metrics[vapply( + metric_results, + function(result) is.null(result$definition), + logical(1) + )] + for (definition in omitted_metrics) { + raw$custom_extensions <- ossie_append_extension( + raw$custom_extensions, + "COMMONS", + list(definition = ossie_plain(definition)) + ) + } + unsupported <- Filter( + function(definition) identical(definition$model_id, model$id) && + !definition$role %in% c("metric", "dimension", "time_dimension"), + catalog$definitions + ) + for (definition in unsupported) { + diagnostics[[length(diagnostics) + 1]] <- new_catalog_diagnostic( + "ossie_definition_extension_only", + sprintf("Definition %s is preserved only in a COMMONS extension.", definition$name), + severity = "info", + entity_id = definition$id + ) + raw$custom_extensions <- ossie_append_extension( + raw$custom_extensions, + "COMMONS", + list(definition = ossie_plain(definition)) + ) + } + native <- Filter(Negate(is.null), model$extensions[c("snowflake", "databricks")]) + for (vendor in names(native)) { + if (!vendor %in% ossie_extension_vendors(raw$custom_extensions)) { + raw$custom_extensions <- ossie_append_extension( + raw$custom_extensions, + toupper(vendor), + native[[vendor]] + ) + diagnostics[[length(diagnostics) + 1]] <- new_catalog_diagnostic( + "ossie_native_extension", + sprintf("Model %s native execution metadata is represented as a %s extension.", model$name, toupper(vendor)), + severity = "info", + entity_id = model$id + ) + } + } + list(model = catalog_compact(raw), diagnostics = diagnostics) +} + +ossie_extension_vendors <- function(extensions) { + tolower(vapply(extensions %||% list(), function(extension) { + extension$vendor_name %||% "" + }, character(1))) +} + +ossie_export_dataset <- function(catalog, model, relation) { + raw <- relation$extensions$ossie %||% list() + raw$name <- relation$name + raw$source <- ossie_relation_source(relation) + raw$description <- relation$description + raw$ai_context <- ossie_export_ai_context( + catalog, + relation$id, + raw$ai_context + ) + constraints <- relation$constraints + primary <- Filter(function(x) x$kind == "primary_key", constraints) + unique_keys <- Filter(function(x) x$kind == "unique", constraints) + raw$primary_key <- if (length(primary)) primary[[1]]$columns + raw$unique_keys <- if (length(unique_keys)) lapply(unique_keys, `[[`, "columns") + fields <- Filter(function(definition) { + identical(definition$model_id, model$id) && + identical(definition$relation_id, relation$id) && + definition$role %in% c("dimension", "time_dimension") + }, catalog$definitions) + field_results <- lapply(fields, ossie_export_definition, catalog = catalog) + diagnostics <- unlist( + lapply(field_results, `[[`, "diagnostics"), + recursive = FALSE + ) + raw$fields <- unname(Filter( + Negate(is.null), + lapply(field_results, `[[`, "definition") + )) + omitted_fields <- fields[vapply( + field_results, + function(result) is.null(result$definition), + logical(1) + )] + for (definition in omitted_fields) { + raw$custom_extensions <- ossie_append_extension( + raw$custom_extensions, + "COMMONS", + list(definition = ossie_plain(definition)) + ) + } + unrepresented <- Filter(function(column) { + !column$name %in% vapply(fields, `[[`, character(1), "name") + }, relation$columns) + if (length(unrepresented)) { + raw$custom_extensions <- ossie_append_extension( + raw$custom_extensions, + "COMMONS", + list(columns = lapply(unrepresented, ossie_plain)) + ) + diagnostics[[length(diagnostics) + 1]] <- new_catalog_diagnostic( + "ossie_columns_extension_only", + sprintf("Relation %s has physical columns without semantic fields; they are preserved in a COMMONS extension.", relation$name), + severity = "info", + entity_id = relation$id + ) + } + list(dataset = catalog_compact(raw), diagnostics = diagnostics) +} + +ossie_export_definition <- function(definition, catalog) { + raw <- definition$extensions$ossie %||% list() + supported_names <- c( + "ansi_sql", "snowflake", "mdx", "tableau", "databricks", "maql", "bigquery" + ) + supported <- Filter( + function(expression) tolower(expression$dialect) %in% supported_names, + definition$expressions + ) + unsupported <- Filter( + function(expression) !tolower(expression$dialect) %in% supported_names, + definition$expressions + ) + diagnostics <- list() + if (length(unsupported)) { + raw$custom_extensions <- ossie_append_extension( + raw$custom_extensions, + "COMMONS", + list(expressions = lapply(unsupported, ossie_plain)) + ) + diagnostics[[1]] <- new_catalog_diagnostic( + "ossie_expression_extension_only", + sprintf("Definition %s has expression dialects preserved only in a COMMONS extension.", definition$name), + severity = "info", + entity_id = definition$id + ) + } + if (length(supported) == 0) { + return(list(definition = NULL, diagnostics = diagnostics)) + } + raw$name <- definition$name + raw$label <- definition$label + raw$description <- definition$description + raw$datatype <- ossie_from_logical_type(definition$logical_type) + raw$expression <- list(dialects = lapply(supported, function(expression) { + list( + dialect = toupper(expression$dialect), + expression = expression$sql + ) + })) + if (definition$role %in% c("dimension", "time_dimension")) { + raw$dimension <- list(is_time = identical(definition$role, "time_dimension")) + } + if (length(definition$synonyms)) { + ai <- raw$ai_context + if (is.character(ai)) ai <- list(instructions = ai) + ai$synonyms <- definition$synonyms + raw$ai_context <- ai + } + raw$ai_context <- ossie_export_ai_context( + catalog, + definition$id, + raw$ai_context + ) + list(definition = catalog_compact(raw), diagnostics = diagnostics) +} + +ossie_export_ai_context <- function(catalog, entity_id, raw) { + contexts <- Filter(function(context) { + entity_id %in% context$scope && + !identical(context$delivery, "evaluation") && + is.null(context$extensions$ossie) + }, catalog$context) + texts <- unique(vapply(contexts, `[[`, character(1), "text")) + if (length(texts) == 0) return(raw) + if (is.character(raw)) raw <- list(instructions = raw) + instructions <- unique(c(raw$instructions, texts)) + raw$instructions <- paste(instructions[nzchar(instructions)], collapse = "\n\n") + raw +} + +ossie_context_representable <- function(context, catalog) { + if (identical(context$delivery, "evaluation")) return(FALSE) + entities <- c( + names(catalog$models), + names(catalog$relations), + names(catalog$definitions) + ) + any(context$scope %in% entities) +} + +ossie_relation_source <- function(relation) { + source <- relation$extensions$ossie$source + if (!is.null(source)) return(source) + if ("model_dataset" %in% relation$path$roles) { + return(relation$extensions$databricks$source %||% + relation$extensions$snowflake$source %||% + relation$name) + } + paste(relation$path$components, collapse = ".") +} + +ossie_append_extension <- function(extensions, vendor, data) { + c( + extensions %||% list(), + list(list( + vendor_name = vendor, + data = as.character(jsonlite::toJSON( + data, + auto_unbox = TRUE, + null = "null", + na = "null" + )) + )) + ) +} + +ossie_plain <- function(value) { + if (!is.list(value)) return(unname(value)) + out <- lapply(unclass(value), ossie_plain) + names(out) <- names(value) + out +} + +ossie_ai_synonyms <- function(ai_context) { + if (!is.list(ai_context)) return(character()) + unlist(ai_context$synonyms %||% list(), use.names = FALSE) +} + +ossie_to_logical_type <- function(type) { + switch( + type %||% "", + String = "string", + Integer = "integer", + Decimal = "number", + Float = "number", + Boolean = "logical", + Date = "date", + Time = "time", + DateTime = "datetime", + DateTimeTz = "datetime_tz", + Opaque = "opaque", + type + ) +} + +ossie_from_logical_type <- function(type) { + switch( + tolower(type %||% ""), + string = "String", + integer = "Integer", + decimal = "Decimal", + number = "Decimal", + float = "Float", + logical = "Boolean", + boolean = "Boolean", + date = "Date", + time = "Time", + datetime = "DateTime", + datetime_tz = "DateTimeTz", + opaque = "Opaque", + NULL + ) +} + +ossie_input_label <- function(input) { + if (is.character(input) && length(input) == 1) basename(input) else "Apache Ossie" +} diff --git a/tests/testthat/_snaps/catalog-ossie.md b/tests/testthat/_snaps/catalog-ossie.md new file mode 100644 index 0000000..72ee980 --- /dev/null +++ b/tests/testthat/_snaps/catalog-ossie.md @@ -0,0 +1,16 @@ +# Apache Ossie versions and relationship references fail closed + + Code + catalog_from_ossie(list(version = "9.9", semantic_model = list())) + Condition + Error: + ! Apache Ossie version "9.9" is not supported. + +--- + + Code + catalog_from_ossie(invalid) + Condition + Error: + ! An Apache Ossie relationship is incomplete or refers to an unknown dataset. + diff --git a/tests/testthat/fixtures/ossie-databricks.yaml b/tests/testthat/fixtures/ossie-databricks.yaml new file mode 100644 index 0000000..42d58c3 --- /dev/null +++ b/tests/testthat/fixtures/ossie-databricks.yaml @@ -0,0 +1,69 @@ +# Adapted from Apache Ossie's Databricks converter fixture A (Apache-2.0). +version: "0.2.0.dev0" +future_document_field: retained +semantic_model: + - name: sales + description: Sales orders with customer attributes + ai_context: + instructions: Use this model for governed sales analysis. + datasets: + - name: orders + source: samples.tpch.orders + primary_key: [o_orderkey] + description: One row per order + fields: + - name: o_orderkey + expression: + dialects: + - dialect: DATABRICKS + expression: o_orderkey + datatype: Integer + description: Order identifier + - name: o_orderdate + expression: + dialects: + - dialect: DATABRICKS + expression: o_orderdate + - dialect: ANSI_SQL + expression: CAST(o_orderdate AS DATE) + datatype: Date + label: Order Date + ai_context: + synonyms: [order date, date] + - name: customer + source: samples.tpch.customer + primary_key: [c_custkey] + fields: + - name: c_name + expression: + dialects: + - dialect: DATABRICKS + expression: c_name + description: Customer name + relationships: + - name: orders_to_customer + from: orders + to: customer + from_columns: [o_custkey] + to_columns: [c_custkey] + ai_context: + instructions: Each order has at most one customer. + metrics: + - name: total_revenue + expression: + dialects: + - dialect: DATABRICKS + expression: SUM(orders.o_totalprice) + datatype: Decimal + description: Total order revenue + ai_context: + synonyms: [revenue, total revenue, sales] + - name: order_count + expression: + dialects: + - dialect: DATABRICKS + expression: COUNT(*) + description: Number of orders + custom_extensions: + - vendor_name: DATABRICKS + data: '{"metric_view_version":"1.1","future_extension":{"keep":true}}' diff --git a/tests/testthat/test-catalog-ossie.R b/tests/testthat/test-catalog-ossie.R new file mode 100644 index 0000000..9d92650 --- /dev/null +++ b/tests/testthat/test-catalog-ossie.R @@ -0,0 +1,155 @@ +test_that("Apache Ossie models import into the common catalog", { + catalog <- catalog_from_ossie(test_path("fixtures", "ossie-databricks.yaml")) + model <- catalog$models[[1]] + orders <- Filter(function(x) x$name == "orders", catalog$relations)[[1]] + definitions <- Filter( + function(x) identical(x$model_id, model$id), + catalog$definitions + ) + + expect_equal(catalog$sources[[1]]$version, "0.2.0.dev0") + expect_setequal(vapply(catalog$relations, `[[`, character(1), "name"), c("orders", "customer")) + expect_setequal( + vapply(definitions, `[[`, character(1), "name"), + c("o_orderkey", "o_orderdate", "c_name", "total_revenue", "order_count") + ) + expect_equal(orders$constraints[[1]]$kind, "primary_key") + expect_equal(orders$constraints[[2]]$kind, "foreign_key") + expect_equal(orders$constraints[[2]]$enforcement, "unknown") + expect_true(length(catalog$context) >= 4) + expect_true(model$extensions$databricks$future_extension$keep) +}) + +test_that("Apache Ossie round trips unknown fields and dialect variants", { + catalog <- catalog_from_ossie(test_path("fixtures", "ossie-databricks.yaml")) + exported <- catalog_to_ossie(catalog) + document <- exported$document + model <- document$semantic_model[[1]] + date <- Filter( + function(x) identical(x$name, "o_orderdate"), + model$datasets[[1]]$fields + )[[1]] + + expect_equal(document$future_document_field, "retained") + expect_setequal( + vapply(date$expression$dialects, `[[`, character(1), "dialect"), + c("DATABRICKS", "ANSI_SQL") + ) + expect_true(model$custom_extensions[[1]]$vendor_name == "DATABRICKS") + expect_length(exported$diagnostics, 0) + + round_trip <- catalog_from_ossie(document) + expect_equal(length(round_trip$models), 1) + expect_equal(length(round_trip$definitions), 5) +}) + +test_that("Apache Ossie parses JSON without a Python dependency", { + input <- yaml::read_yaml(test_path("fixtures", "ossie-databricks.yaml")) + path <- withr::local_tempfile(fileext = ".json") + jsonlite::write_json(input, path, auto_unbox = TRUE, pretty = TRUE) + + catalog <- catalog_from_ossie(path) + + expect_equal(catalog$models[[1]]$name, "sales") + expect_equal(catalog$sources[[1]]$kind, "ossie") +}) + +test_that("Snowflake Ossie extensions retain native payloads", { + document <- list( + version = "0.2.0.dev0", + semantic_model = list(list( + name = "lending", + datasets = list(list( + name = "loans", + source = "LENDING.PUBLIC.LOANS", + fields = list(list( + name = "loan_id", + expression = list(dialects = list(list( + dialect = "SNOWFLAKE", + expression = "loan_id" + ))) + )) + )), + custom_extensions = list(list( + vendor_name = "SNOWFLAKE", + data = '{"semantic_view":"LENDING.PUBLIC.LOAN_METRICS","verified_queries":["count_loans"]}' + )) + )) + ) + + catalog <- catalog_from_ossie(document) + exported <- catalog_to_ossie(catalog) + + expect_equal( + catalog$models[[1]]$extensions$snowflake$semantic_view, + "LENDING.PUBLIC.LOAN_METRICS" + ) + expect_equal( + exported$document$semantic_model[[1]]$custom_extensions[[1]]$vendor_name, + "SNOWFLAKE" + ) +}) + +test_that("Apache Ossie versions and relationship references fail closed", { + expect_snapshot( + catalog_from_ossie(list(version = "9.9", semantic_model = list())), + error = TRUE + ) + invalid <- list( + version = "0.2.0.dev0", + semantic_model = list(list( + name = "bad", + datasets = list(list(name = "orders", source = "db.schema.orders")), + relationships = list(list( + name = "missing", + from = "orders", + to = "customers", + from_columns = "customer_id", + to_columns = "id" + )) + )) + ) + expect_snapshot(catalog_from_ossie(invalid), error = TRUE) +}) + +test_that("Apache Ossie export reports extension-only and omitted constructs", { + catalog <- catalog_from_ossie(test_path("fixtures", "ossie-databricks.yaml")) + source <- catalog$sources[[1]] + term <- new_catalog_term( + "term:revenue", + source$id, + "revenue", + "Money earned." + ) + calculation <- new_catalog_calculation( + "calculation:verified", + source$id, + "verified", + execution = new_catalog_execution("verified_sql", "databricks", "SELECT 1") + ) + catalog$terms[[term$id]] <- term + catalog$calculations[[calculation$id]] <- calculation + definition <- catalog$definitions[[1]] + definition$expressions <- list(new_catalog_expression( + "private_dialect", + "order_id" + )) + catalog$definitions[[definition$id]] <- definition + evaluation <- new_catalog_context( + "context:evaluation", + source$id, + "evaluation", + "Expected answer", + scope = catalog$models[[1]]$id, + delivery = "evaluation" + ) + catalog$context[[evaluation$id]] <- evaluation + + exported <- catalog_to_ossie(catalog) + codes <- vapply(exported$diagnostics, `[[`, character(1), "code") + + expect_true("ossie_calculation_omitted" %in% codes) + expect_true("ossie_term_omitted" %in% codes) + expect_true("ossie_expression_extension_only" %in% codes) + expect_true("ossie_context_omitted" %in% codes) +}) From 9f325f48fb9076fe4d1125bead43c3ca8adea63a Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 12:33:38 -0500 Subject: [PATCH 08/25] complete catalog interoperability --- NAMESPACE | 2 + R/calculations.R | 1 + R/catalog-databricks.R | 95 +++--- R/catalog-merge.R | 168 ++++++++++- R/catalog-ossie.R | 247 +++++++++++++--- R/catalog-provider.R | 146 +++++++++- R/catalog-snowflake.R | 133 ++++++--- R/catalog.R | 6 +- R/citations.R | 2 +- R/data-dictionary.R | 10 + R/data-source.R | 37 ++- R/genie.R | 41 ++- R/tools.R | 56 +++- man/data_source.Rd | 9 +- man/genie_agent.Rd | 6 +- man/ossie_model.Rd | 18 ++ man/write_ossie.Rd | 21 ++ tests/testthat/_snaps/data-source.md | 8 + tests/testthat/_snaps/genie.md | 2 +- .../fixtures/databricks-metric-view.yaml | 22 ++ .../snowflake-semantic-recordings.yaml | 61 ++++ tests/testthat/helper-catalog-snowflake.R | 23 ++ tests/testthat/helper-genie.R | 4 +- tests/testthat/test-catalog-databricks.R | 99 +++++-- tests/testthat/test-catalog-ossie.R | 130 ++++++++- tests/testthat/test-catalog-snowflake.R | 75 ++++- tests/testthat/test-catalog.R | 83 ++++++ tests/testthat/test-data-source.R | 110 +++++++ tests/testthat/test-genie.R | 54 +++- vignettes/database-catalogs.Rmd | 270 ++++++++++++++++++ 30 files changed, 1740 insertions(+), 199 deletions(-) create mode 100644 man/ossie_model.Rd create mode 100644 man/write_ossie.Rd create mode 100644 tests/testthat/fixtures/databricks-metric-view.yaml create mode 100644 tests/testthat/fixtures/snowflake-semantic-recordings.yaml create mode 100644 tests/testthat/helper-catalog-snowflake.R create mode 100644 vignettes/database-catalogs.Rmd diff --git a/NAMESPACE b/NAMESPACE index 5e0ee89..d0c9599 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,8 +9,10 @@ export(data_source_options) export(genie_agent) export(list_tables) export(measure) +export(ossie_model) export(read_trajectories) export(semantic_layer) +export(write_ossie) importFrom(R6,R6Class) importFrom(coro,async_generator) importFrom(coro,await_each) diff --git a/R/calculations.R b/R/calculations.R index 9c3fdba..63b48b3 100644 --- a/R/calculations.R +++ b/R/calculations.R @@ -297,6 +297,7 @@ calculation_replace_token <- function(sql, token, replacement) { } source_query_bind <- function(source, sql, params) { + if (!is.null(source$provider)) catalog_provider_check(source$provider) if (length(params) == 0) { return(source_query(source, sql)) } diff --git a/R/catalog-databricks.R b/R/catalog-databricks.R index caa2006..470cf57 100644 --- a/R/catalog-databricks.R +++ b/R/catalog-databricks.R @@ -132,49 +132,68 @@ databricks_list_hive_metastore <- function(con, catalog, schema, call) { databricks_import_semantics <- function(provider) { selected_ids <- names(provider$relation_labels) - for (relation_id in selected_ids) { - relation <- provider$catalog$relations[[relation_id]] - if (!relation$kind %in% c("metric_view", "view", "unknown")) { - next - } - specification <- databricks_read_metric_yaml(provider$con, relation$path) - if (is.null(specification)) { - if (identical(relation$kind, "metric_view")) { - relation$access <- new_catalog_access( - "visible_only", - "metric-view metadata could not be read" - ) - provider$catalog$relations[[relation$id]] <- relation - catalog_provider_diagnostic( - provider, - "databricks_metric_view_unreadable", - sprintf("Skipped metric view %s because its YAML could not be read.", relation$name), - entity_id = relation$id - ) - } - next - } - if (!databricks_metric_version_supported(specification$version)) { - diagnostic <- new_catalog_diagnostic( - "databricks_metric_view_version", + exact_ids <- selected_ids[provider$selection_modes[selected_ids] == "exact"] + for (relation_id in exact_ids) { + databricks_import_semantic_relation(provider, relation_id) + } + databricks_import_associated_semantics(provider) + validate_commons_catalog(provider$catalog) + invisible(provider) +} + +databricks_import_semantic_relation <- function(provider, relation_id) { + relation <- provider$catalog$relations[[relation_id]] + if (is.null(relation) || + !relation$kind %in% c("metric_view", "view", "unknown") || + isTRUE(relation$extensions$commons$semantic_attempted) || + any(vapply(provider$catalog$models, function(model) { + relation_id %in% model$exposed + }, logical(1)))) { + return(invisible(provider)) + } + specification <- databricks_read_metric_yaml(provider$con, relation$path) + if (is.null(specification)) { + relation$extensions$commons$semantic_attempted <- TRUE + provider$catalog$relations[[relation$id]] <- relation + if (identical(relation$kind, "metric_view")) { + relation$access <- new_catalog_access( + "visible_only", + "metric-view metadata could not be read" + ) + provider$catalog$relations[[relation$id]] <- relation + catalog_provider_diagnostic( + provider, + "databricks_metric_view_unreadable", sprintf( - "Metric view %s uses unsupported YAML version %s.", - relation$name, - specification$version + "Skipped metric view %s because its YAML could not be read.", + relation$name ), - entity_id = relation$id, - details = list(version = specification$version) + entity_id = relation$id ) - provider$catalog$diagnostics[[length(provider$catalog$diagnostics) + 1]] <- diagnostic - next } - relation$kind <- "metric_view" - relation$description <- specification$comment %||% relation$description - provider$catalog$relations[[relation_id]] <- relation - databricks_import_metric_model(provider, relation, specification) + return(invisible(provider)) } - databricks_import_associated_semantics(provider) - validate_commons_catalog(provider$catalog) + if (!databricks_metric_version_supported(specification$version)) { + relation$extensions$commons$semantic_attempted <- TRUE + provider$catalog$relations[[relation$id]] <- relation + catalog_provider_diagnostic( + provider, + "databricks_metric_view_version", + sprintf( + "Metric view %s uses unsupported YAML version %s.", + relation$name, + specification$version + ), + entity_id = relation$id, + details = list(version = specification$version) + ) + return(invisible(provider)) + } + relation$kind <- "metric_view" + relation$description <- specification$comment %||% relation$description + relation$extensions$commons$semantic_attempted <- TRUE + provider$catalog$relations[[relation_id]] <- relation + databricks_import_metric_model(provider, relation, specification) invisible(provider) } diff --git a/R/catalog-merge.R b/R/catalog-merge.R index f9307e8..2ebdc4e 100644 --- a/R/catalog-merge.R +++ b/R/catalog-merge.R @@ -1,14 +1,23 @@ -catalog_merge <- function(discovered, authored, call = rlang::caller_env()) { +catalog_merge <- function( + discovered, + authored, + relation_ids = names(discovered$relations), + call = rlang::caller_env() +) { validate_commons_catalog(discovered, call = call) validate_commons_catalog(authored, call = call) + candidates <- discovered + candidates$relations <- candidates$relations[relation_ids] + authored <- catalog_scope_authored(authored, candidates) - reconciled <- catalog_reconcile_relations(discovered, authored, call) + reconciled <- catalog_reconcile_relations( + discovered, + authored, + call, + relation_ids + ) relation_map <- reconciled$map authored <- catalog_remap_catalog(authored, relation_map) - retained_authored <- authored$relations[setdiff( - names(authored$relations), - names(relation_map) - )] new_commons_catalog( sources = catalog_combine_records( @@ -19,7 +28,7 @@ catalog_merge <- function(discovered, authored, call = rlang::caller_env()) { ), relations = catalog_combine_records( reconciled$relations, - retained_authored, + list(), "relation", call ), @@ -59,7 +68,144 @@ catalog_merge <- function(discovered, authored, call = rlang::caller_env()) { ) } -catalog_reconcile_relations <- function(discovered, authored, call) { +catalog_scope_authored <- function(authored, discovered) { + relation_names <- vapply( + authored$relations, + `[[`, + character(1), + "name" + ) + keep_relations <- names(authored$relations)[vapply( + authored$relations, + function(relation) { + length(catalog_relation_candidates( + relation, + discovered$relations, + discovered$sources + )) > 0 + }, + logical(1) + )] + dropped_relations <- setdiff(names(authored$relations), keep_relations) + dropped_relation_names <- unname(relation_names[dropped_relations]) + authored$relations <- authored$relations[keep_relations] + authored$relations <- lapply( + authored$relations, + catalog_scope_relation_constraints, + dropped_relation_ids = dropped_relations, + dropped_relation_names = dropped_relation_names + ) + + keep_models <- logical(length(authored$models)) + names(keep_models) <- names(authored$models) + for (id in names(authored$models)) { + model <- authored$models[[id]] + for (field in c("datasets", "exposed", "dependencies")) { + model[[field]] <- setdiff(model[[field]], dropped_relations) + } + dataset_names <- vapply( + authored$relations[model$datasets], + `[[`, + character(1), + "name" + ) + keep_relationships <- vapply( + model$relationships, + catalog_relationship_in_scope, + logical(1), + dataset_names = dataset_names, + dropped_dataset_names = dropped_relation_names + ) + model$relationships <- model$relationships[keep_relationships] + keep_models[[id]] <- length(model$datasets) > 0 || length(model$exposed) > 0 + authored$models[[id]] <- model + } + dropped_models <- names(keep_models)[!keep_models] + authored$models <- authored$models[keep_models] + + keep_definitions <- vapply(authored$definitions, function(definition) { + definition$relation_id %in% keep_relations && + definition$model_id %in% names(authored$models) && + !any(definition$dependencies %in% c(dropped_relations, dropped_models)) + }, logical(1)) + dropped_definitions <- names(authored$definitions)[!keep_definitions] + authored$definitions <- authored$definitions[keep_definitions] + + authored$calculations <- Filter(function(calculation) { + !any(calculation$dependencies %in% c( + dropped_relations, + dropped_models, + dropped_definitions + )) + }, authored$calculations) + dropped <- c(dropped_relations, dropped_models, dropped_definitions) + authored$context <- Filter(function(context) { + !any(context$scope %in% dropped) && + catalog_relationship_context_in_scope(context, authored) + }, authored$context) + validate_commons_catalog(authored) + authored +} + +catalog_relationship_context_in_scope <- function(context, catalog) { + relationship <- context$extensions$ossie_relationship + if (is.null(relationship)) return(TRUE) + model_ids <- intersect(context$scope, names(catalog$models)) + if (length(model_ids) != 1) return(FALSE) + model <- catalog$models[[model_ids[[1]]]] + dataset_names <- vapply( + catalog$relations[model$datasets], + `[[`, + character(1), + "name" + ) + all(c(relationship$from, relationship$to) %in% dataset_names) +} + +catalog_scope_relation_constraints <- function( + relation, + dropped_relation_ids, + dropped_relation_names +) { + keep <- vapply(relation$constraints, function(constraint) { + reference <- constraint$reference + if (is.null(reference)) return(TRUE) + !any(reference$relation_id %in% dropped_relation_ids) && + !any(reference$table %in% dropped_relation_names) + }, logical(1)) + relation$constraints <- relation$constraints[keep] + relation +} + +catalog_relationship_in_scope <- function( + relationship, + dataset_names, + dropped_dataset_names +) { + endpoints <- unlist(c(relationship$from, relationship$to), use.names = FALSE) + if (length(endpoints)) { + return(all(endpoints %in% dataset_names)) + } + text <- paste(unlist( + relationship[c("join", "condition", "sql")], + use.names = FALSE + ), collapse = " ") + !any(vapply(dropped_dataset_names, function(name) { + pattern <- paste0( + "(? 4000L catalog_import_backend(provider) + catalog_provider_finalize_access(provider, call) + provider$options <- catalog_forget_credentials(provider$options) provider$startup <- list( started_at = started_at, elapsed = as.numeric(difftime(Sys.time(), started_at, units = "secs")) ) + catalog_provider_record(provider, "discovery", started_at) catalog_progress("ready", backend, started_at) provider } +catalog_forget_credentials <- function(options) { + if (!is.null(options$genie)) options$genie$token <- NULL + options +} + catalog_object_limit <- 25000L catalog_backend_capabilities <- function(con, backend, snapshot) { @@ -349,6 +358,8 @@ catalog_id_has_prefix <- function(id, prefix) { } catalog_provider_hydrate <- function(provider, table, call = rlang::caller_env()) { + started_at <- Sys.time() + on.exit(catalog_provider_record(provider, "hydrate", started_at, table), add = TRUE) catalog_provider_check(provider, call) id <- provider$table_ids[[table]] if (is.null(id)) { @@ -362,10 +373,15 @@ catalog_provider_hydrate <- function(provider, table, call = rlang::caller_env() } relation_id <- names(provider$relation_labels)[provider$relation_labels == table] relation <- provider$catalog$relations[[relation_id]] + catalog_import_relation_semantics(provider, relation_id) + relation <- provider$catalog$relations[[relation_id]] if (length(relation$columns)) { return(relation) } - if (identical(relation$kind, "semantic_view")) { + semantic_model <- any(vapply(provider$catalog$models, function(model) { + relation$id %in% model$exposed + }, logical(1))) + if (semantic_model) { definitions <- Filter( function(x) identical(x$relation_id, relation$id) && identical(x$visibility, "public"), @@ -419,6 +435,123 @@ catalog_provider_hydrate <- function(provider, table, call = rlang::caller_env() relation } +catalog_provider_probe_authored <- function( + provider, + authored, + call = rlang::caller_env() +) { + for (relation in authored$relations) { + candidates <- catalog_relation_candidates( + relation, + provider$catalog$relations[names(provider$relation_labels)], + provider$catalog$sources + ) + if (length(candidates) != 1) next + catalog_provider_probe_relation(provider, candidates[[1]]) + } + catalog_provider_finalize_access(provider, call) +} + +catalog_provider_probe_relation <- function(provider, relation_id) { + relation <- provider$catalog$relations[[relation_id]] + if (relation$access$state != "unknown" || + relation$kind %in% c("semantic_view", "governed_query")) { + return(invisible(provider)) + } + started_at <- Sys.time() + result <- catalog_relation_queryability(provider$con, relation$path) + catalog_provider_record( + provider, + "authorize", + started_at, + catalog_path_label(relation) + ) + if (inherits(result, "condition")) { + relation$access <- new_catalog_access("visible_only", conditionMessage(result)) + catalog_provider_diagnostic( + provider, + "authored_relation_unqueryable", + sprintf( + "Skipped authored metadata for %s because the relation is not queryable.", + catalog_path_label(relation) + ), + severity = "info", + entity_id = relation$id + ) + } else { + relation$access <- new_catalog_access("queryable", "zero-row authorization probe") + } + provider$catalog$relations[[relation$id]] <- relation + invisible(provider) +} + +catalog_relation_queryability <- function(con, path) { + tryCatch( + { + result <- DBI::dbSendQuery( + con, + paste( + "SELECT * FROM", + DBI::dbQuoteIdentifier(con, source_path_id(path)), + "WHERE 1 = 0" + ) + ) + on.exit(DBI::dbClearResult(result), add = TRUE) + TRUE + }, + error = function(err) err + ) +} + +catalog_provider_finalize_access <- function( + provider, + call = rlang::caller_env() +) { + selected <- names(provider$relation_labels) + visible_only <- selected[vapply( + provider$catalog$relations[selected], + function(relation) identical(relation$access$state, "visible_only"), + logical(1) + )] + if (length(visible_only)) { + labels <- unname(provider$relation_labels[visible_only]) + provider$table_ids <- provider$table_ids[setdiff( + names(provider$table_ids), + labels + )] + provider$relation_labels <- provider$relation_labels[setdiff( + names(provider$relation_labels), + visible_only + )] + provider$selection_modes <- provider$selection_modes[setdiff( + names(provider$selection_modes), + visible_only + )] + } + if (length(provider$table_ids) == 0) { + cli::cli_abort( + "The resolved data-source selection contains no accessible objects.", + call = call + ) + } + provider$lazy <- nchar( + paste(names(provider$table_ids), collapse = "\n"), + type = "bytes" + ) > 4000L + invisible(provider) +} + +catalog_provider_record <- function(provider, operation, started_at, object = NULL) { + provider$telemetry[[length(provider$telemetry) + 1]] <- list( + operation = operation, + object = object, + elapsed = as.numeric(difftime(Sys.time(), started_at, units = "secs")), + principal = provider$snapshot$principal, + role = provider$snapshot$role + ) + invisible(provider) +} + catalog_relation_metadata <- function(con, id) { backend <- catalog_backend(con) if (identical(backend, "snowflake")) { @@ -550,6 +683,15 @@ catalog_import_backend <- function(provider) { invisible(provider) } +catalog_import_relation_semantics <- function(provider, relation_id) { + if (identical(provider$backend, "snowflake")) { + snowflake_import_semantic_relation(provider, relation_id) + } else if (identical(provider$backend, "databricks")) { + databricks_import_semantic_relation(provider, relation_id) + } + invisible(provider) +} + catalog_association_prefixes <- function(provider) { relation_ids <- names(provider$selection_modes)[ provider$selection_modes == "exact" diff --git a/R/catalog-snowflake.R b/R/catalog-snowflake.R index 86c3791..1b419d2 100644 --- a/R/catalog-snowflake.R +++ b/R/catalog-snowflake.R @@ -94,44 +94,61 @@ snowflake_list_namespace <- function(con, prefix, call) { snowflake_import_semantics <- function(provider) { selected_ids <- names(provider$relation_labels) - for (relation_id in selected_ids) { - relation <- provider$catalog$relations[[relation_id]] - if (!relation$kind %in% c("semantic_view", "unknown")) { - next - } - specification <- snowflake_read_semantic_yaml(provider$con, relation$path) - if (is.null(specification)) { - specification <- snowflake_describe_semantic_view( - provider$con, - relation$path - ) - } - if (is.null(specification)) { - if (identical(relation$kind, "semantic_view")) { - relation$access <- new_catalog_access( - "visible_only", - "semantic metadata could not be read" - ) - provider$catalog$relations[[relation$id]] <- relation - catalog_provider_diagnostic( - provider, - "snowflake_semantic_view_unreadable", - sprintf("Skipped semantic view %s because its metadata could not be read.", relation$name), - entity_id = relation$id - ) - } - next - } - relation$kind <- "semantic_view" - relation$description <- specification$description %||% relation$description - provider$catalog$relations[[relation_id]] <- relation - snowflake_import_semantic_model(provider, relation, specification) + exact_ids <- selected_ids[provider$selection_modes[selected_ids] == "exact"] + for (relation_id in exact_ids) { + snowflake_import_semantic_relation(provider, relation_id) } snowflake_import_associated_semantics(provider) validate_commons_catalog(provider$catalog) invisible(provider) } +snowflake_import_semantic_relation <- function(provider, relation_id) { + relation <- provider$catalog$relations[[relation_id]] + if (is.null(relation) || + !relation$kind %in% c("semantic_view", "unknown") || + isTRUE(relation$extensions$commons$semantic_attempted) || + any(vapply(provider$catalog$models, function(model) { + relation_id %in% model$exposed + }, logical(1)))) { + return(invisible(provider)) + } + specification <- snowflake_read_semantic_yaml(provider$con, relation$path) + if (is.null(specification)) { + specification <- snowflake_describe_semantic_view( + provider$con, + relation$path + ) + } + if (is.null(specification)) { + relation$extensions$commons$semantic_attempted <- TRUE + provider$catalog$relations[[relation$id]] <- relation + if (identical(relation$kind, "semantic_view")) { + relation$access <- new_catalog_access( + "visible_only", + "semantic metadata could not be read" + ) + provider$catalog$relations[[relation$id]] <- relation + catalog_provider_diagnostic( + provider, + "snowflake_semantic_view_unreadable", + sprintf( + "Skipped semantic view %s because its metadata could not be read.", + relation$name + ), + entity_id = relation$id + ) + } + return(invisible(provider)) + } + relation$kind <- "semantic_view" + relation$description <- specification$description %||% relation$description + relation$extensions$commons$semantic_attempted <- TRUE + provider$catalog$relations[[relation_id]] <- relation + snowflake_import_semantic_model(provider, relation, specification) + invisible(provider) +} + snowflake_import_associated_semantics <- function(provider) { prefixes <- catalog_association_prefixes(provider) for (prefix in prefixes) { @@ -522,6 +539,10 @@ snowflake_import_semantic_model <- function(provider, relation, specification) { source, provenance ) + contexts <- c( + contexts, + snowflake_verified_context(specification, model, source, provenance) + ) for (context in contexts) { catalog$context[[context$id]] <- context } @@ -664,6 +685,7 @@ snowflake_semantic_context <- function( provenance ) { instructions <- c( + specification$description, specification$custom_instructions, unlist(specification$module_custom_instructions, use.names = FALSE) ) @@ -696,7 +718,7 @@ snowflake_verified_calculations <- function( ) { out <- list() for (query in specification$verified_queries %||% list()) { - if (is.null(query$sql) || !nzchar(query$sql)) { + if (!snowflake_verified_query_executable(query$sql)) { next } name <- query$name %||% query$question @@ -720,6 +742,51 @@ snowflake_verified_calculations <- function( out } +snowflake_verified_context <- function( + specification, + model, + source, + provenance +) { + out <- list() + for (i in seq_along(specification$verified_queries %||% list())) { + query <- specification$verified_queries[[i]] + text <- paste(c( + query$question, + if (!is.null(query$sql) && nzchar(query$sql)) { + paste("Verified SQL:", query$sql) + } + ), collapse = "\n") + if (!nzchar(text)) next + context <- new_catalog_context( + catalog_id("context", model$id, "verified_query", i), + source$id, + "verified_query", + text, + scope = model$id, + delivery = "retrieval", + authority = list(kind = "certified"), + provenance = provenance, + extensions = list(snowflake = query) + ) + out[[context$id]] <- context + } + out +} + +snowflake_verified_query_executable <- function(sql) { + if (!is.character(sql) || length(sql) != 1 || is.na(sql) || !nzchar(sql)) { + return(FALSE) + } + tryCatch( + { + check_query(sql) + TRUE + }, + error = function(err) FALSE + ) +} + catalog_fingerprint <- function(x) { raw <- serialize(x, NULL, version = 3) paste0(length(raw), "-", sum(as.integer(raw) * seq_along(raw)) %% 2147483647) diff --git a/R/catalog.R b/R/catalog.R index 120b562..d6d26c1 100644 --- a/R/catalog.R +++ b/R/catalog.R @@ -1046,7 +1046,11 @@ catalog_relation_to_dictionary <- function(relation, definitions) { entry$columns <- lapply(relation$columns, catalog_column_to_dictionary) relation_definitions <- Filter( - function(definition) identical(definition$relation_id, relation$id), + function(definition) { + identical(definition$relation_id, relation$id) && + !definition$name %in% names(relation$columns) && + !is.null(definition$logical_type) + }, definitions ) entry$definitions <- lapply( diff --git a/R/citations.R b/R/citations.R index d84eda6..1893515 100644 --- a/R/citations.R +++ b/R/citations.R @@ -29,7 +29,7 @@ build_citation_corpus <- function(context_layer, registry, sources) { ) } for (i in seq_along(sources)) { - dictionary <- sources[[i]]$dictionary + dictionary <- source_runtime_dictionary(sources[[i]]) add( "data dictionary", c( diff --git a/R/data-dictionary.R b/R/data-dictionary.R index fb280a5..738fc05 100644 --- a/R/data-dictionary.R +++ b/R/data-dictionary.R @@ -21,6 +21,16 @@ as_data_dictionary <- function(x, call = rlang::caller_env()) { ) } +as_authored_metadata <- function(x, call = rlang::caller_env()) { + if (inherits(x, "commons_catalog")) return(x) + as_data_dictionary(x, call) +} + +catalog_from_authored_metadata <- function(x) { + if (inherits(x, "commons_catalog")) return(x) + catalog_from_data_dictionary(x) +} + new_data_dictionary <- function(raw, call = rlang::caller_env()) { raw <- raw %||% list() structure( diff --git a/R/data-source.R b/R/data-source.R index 1e38c02..a86465e 100644 --- a/R/data-source.R +++ b/R/data-source.R @@ -41,8 +41,8 @@ #' connection's grants remain the security boundary for SQL execution. #' @param dictionary An optional path to a data dictionary describing the #' source's tables and columns, in the -#' [data-dict.yaml](https://data-dict.tidyverse.org/) format. See the -#' `Data dictionaries` section. +#' [data-dict.yaml](https://data-dict.tidyverse.org/) format, or an Apache +#' Ossie model from [ossie_model()]. See the `Data dictionaries` section. #' #' @section Data dictionaries: #' A data dictionary describes a data source's tables and columns: what each @@ -68,6 +68,11 @@ #' query runs. Definitions are validated against the live source and #' delivered through all three channels above. #' +#' [ossie_model()] reads Apache Ossie YAML or JSON into the same authored +#' metadata layer. Matching and selection rules are identical to data-dict; +#' [write_ossie()] exports the representable merged catalog and reports lossy +#' constructs as diagnostics. +#' #' @section Trust: #' The `run_sql` tool runs only read-only `SELECT` queries; statements that #' would modify data or schema (`INSERT`, `UPDATE`, `DROP`, and similar) are @@ -92,7 +97,7 @@ data_source <- function( options = NULL ) { dots <- rlang::list2(...) - dictionary <- as_data_dictionary(dictionary) + dictionary <- as_authored_metadata(dictionary) kind <- data_source_kind(dots) options <- as_data_source_options(options, tables, kind) @@ -162,6 +167,16 @@ data_source_connection <- function( ) { span <- local_commons_span("commons_data_source_list_tables") provider <- new_catalog_provider(con, options, call) + authored <- catalog_from_authored_metadata(dictionary) + if (length(authored$sources)) { + catalog_provider_probe_authored(provider, authored, call = call) + provider$catalog <- catalog_merge( + provider$catalog, + authored, + relation_ids = names(provider$relation_labels), + call = call + ) + } table_registry <- list( labels = names(provider$table_ids), ids = provider$table_ids @@ -171,11 +186,6 @@ data_source_connection <- function( "commons.data_source.n_tables", length(table_registry$labels) ) - - authored <- catalog_from_data_dictionary(dictionary) - if (length(authored$sources)) { - provider$catalog <- catalog_merge(provider$catalog, authored, call = call) - } new_data_source( con, table_registry$labels, @@ -184,7 +194,7 @@ data_source_connection <- function( dictionary = dictionary, catalog = provider$catalog, provider = provider, - options = options, + options = provider$options, relation_labels = provider$relation_labels ) } @@ -281,11 +291,17 @@ new_data_source <- function( table_ids = table_ids_from_labels(tables), dictionary = NULL, pending = NULL, - catalog = catalog_from_data_dictionary(dictionary), + catalog = catalog_from_authored_metadata(dictionary), provider = NULL, options = data_source_options(), relation_labels = character() ) { + if (!is.null(provider) && length(catalog$sources)) { + dictionary <- catalog_to_runtime_dictionary(catalog, relation_labels) + } else if (inherits(dictionary, "commons_catalog")) { + dictionary <- catalog_to_data_dictionary(catalog) + } + # Disconnect only the DuckDB connection we created; a user-supplied connection # has its own owner and lifetime. handle <- NULL @@ -536,6 +552,7 @@ source_restricted_columns <- function(source, table) { } source_query <- function(source, sql) { + if (!is.null(source$provider)) catalog_provider_check(source$provider) check_query(sql) if (is.null(source$pending)) { return(DBI::dbGetQuery(source$con, sql)) diff --git a/R/genie.R b/R/genie.R index 90ddb8a..567f14a 100644 --- a/R/genie.R +++ b/R/genie.R @@ -5,17 +5,26 @@ #' `DATABRICKS_HOST` or the selected Databricks CLI profile supplies it. #' @param profile An optional Databricks CLI profile. Profile credentials remain #' in the CLI credential store and are not retained by commons. +#' @param token An optional zero-argument function that returns a short-lived +#' Databricks access token. This supports per-session credentials on Posit +#' Connect without retaining the returned token in catalog metadata. #' #' @return A configuration object for the `genie` argument of #' [data_source_options()]. #' @export -genie_agent <- function(id, workspace = NULL, profile = NULL) { +genie_agent <- function(id, workspace = NULL, profile = NULL, token = NULL) { if (!is.character(id) || length(id) != 1 || is.na(id) || !grepl("^[[:xdigit:]]{32}$", id)) { cli::cli_abort("{.arg id} must be a 32-character Genie Agent ID.") } workspace <- genie_optional_string(workspace, "workspace") profile <- genie_optional_string(profile, "profile") + if (!is.null(token) && !is.function(token)) { + cli::cli_abort("{.arg token} must be a zero-argument function or null.") + } + if (!is.null(profile) && !is.null(token)) { + cli::cli_abort("Supply only one of {.arg profile} and {.arg token}.") + } if (!is.null(workspace)) { workspace <- sub("/+$", "", workspace) if (!grepl("^https://", workspace)) { @@ -23,7 +32,7 @@ genie_agent <- function(id, workspace = NULL, profile = NULL) { } } structure( - list(id = tolower(id), workspace = workspace, profile = profile), + list(id = tolower(id), workspace = workspace, profile = profile, token = token), class = "commons_genie_agent" ) } @@ -125,8 +134,13 @@ genie_cli_json <- function(command, args, action) { genie_fetch_rest <- function(config) { workspace <- config$workspace %||% Sys.getenv("DATABRICKS_HOST", unset = NA) - token <- Sys.getenv("DATABRICKS_TOKEN", unset = NA) - if (is.na(workspace) || !nzchar(workspace) || is.na(token) || !nzchar(token)) { + token <- if (is.function(config$token)) { + config$token() + } else { + Sys.getenv("DATABRICKS_TOKEN", unset = NA) + } + if (is.na(workspace) || !nzchar(workspace) || !rlang::is_string(token) || + is.na(token) || !nzchar(token)) { cli::cli_abort(c( "Genie import needs Databricks REST credentials.", "i" = "Supply {.arg profile}, or set {.envvar DATABRICKS_HOST} and {.envvar DATABRICKS_TOKEN}." @@ -217,6 +231,23 @@ genie_import_assets <- function(provider, specification, provenance) { ) next } + catalog_import_relation_semantics(provider, relation$id) + relation <- provider$catalog$relations[[relation$id]] + catalog_provider_probe_relation(provider, relation$id) + relation <- provider$catalog$relations[[relation$id]] + if (identical(relation$access$state, "visible_only")) { + catalog_provider_diagnostic( + provider, + "genie_asset_unqueryable", + sprintf( + "Skipped Genie data source %s because the DBI identity cannot query it.", + identifier + ), + severity = "info", + entity_id = relation$id + ) + next + } scope <- c(scope, relation$id) if (is.list(asset)) { description <- genie_text(asset$description) @@ -594,7 +625,7 @@ genie_import_functions <- function( } else { sprintf("SELECT %s(%s) AS value", quoted, placeholders) } - name <- genie_calculation_name(item$display_name %||% tail(strsplit(identifier, ".", fixed = TRUE)[[1]], 1)) + name <- genie_calculation_name(item$display_name %||% utils::tail(strsplit(identifier, ".", fixed = TRUE)[[1]], 1)) calculation <- new_catalog_calculation( catalog_id("calculation", model$id, agent_id, name), model$source_id, diff --git a/R/tools.R b/R/tools.R index 18fdae7..faf3efb 100644 --- a/R/tools.R +++ b/R/tools.R @@ -1,19 +1,20 @@ # Register only the tools the agent's composition earns; nothing about its # surface should imply operations it doesn't have. build_commons_tools <- function(self, private) { + native_semantics <- catalog_semantics_possible(private$sources) c( if (pool_searchable( private$registry, private$definitions, private$calculations - )) { + ) || native_semantics) { list(tool_search_pool(private)) }, if (length(private$registry) > 0) list(tool_call_measure(private)), - if (length(private$calculations) > 0) { + if (length(private$calculations) > 0 || native_semantics) { list(tool_call_calculation(private)) }, - if (registry_has_metrics(private$definitions)) { + if (registry_has_metrics(private$definitions) || native_semantics) { list(tool_call_metrics(private)) }, if (any(vapply( @@ -32,6 +33,13 @@ build_commons_tools <- function(self, private) { ) } +catalog_semantics_possible <- function(sources) { + any(vapply(sources, function(source) { + !is.null(source$provider) && + isTRUE(source$provider$capabilities$native_semantics) + }, logical(1))) +} + tool_search_catalog <- function(private) { ellmer::tool( function(query, kinds = NULL, source = NULL) { @@ -96,16 +104,21 @@ tool_search_pool <- function(private) { }, if (nrow(registry_defs(private$definitions)) > 0) { "governed definitions (apply as {{name}} tokens in run_sql, or through call_metrics)" + }, + if (catalog_semantics_possible(private$sources)) { + "native semantics discovered by describe_table" } ) ellmer::tool( function(query) { + definitions <- definitions_registry(private$sources) + calculations <- catalog_calculations_registry(private$sources) body <- search_pool_text( private$registry, - private$definitions, + definitions, query, source_names, - private$calculations + calculations ) tool_result( body, @@ -141,8 +154,9 @@ tool_call_metrics <- function(private) { arguments = "{}", source = NULL ) { + definitions <- definitions_registry(private$sources) call_metrics_impl( - private$definitions, + definitions, private$sources, private$handles, metrics = metrics, @@ -213,7 +227,7 @@ tool_call_calculation <- function(private) { ellmer::tool( function(name, arguments = "{}", source = NULL) { call_catalog_calculation( - private$calculations, + catalog_calculations_registry(private$sources), name, arguments, source, @@ -293,12 +307,14 @@ tool_search_context <- function(private) { tool_describe_table <- function(private) { ellmer::tool( function(table, source = NULL) { - describe_table_tool( + result <- describe_table_tool( resolve_sql_source(private$sources, source), table, source_name = source, tracker = private$first_touch ) + catalog_runtime_refresh(private) + result }, "Describe a table: columns, types, and sample rows. Use this before writing SQL against an unfamiliar table.", arguments = list( @@ -320,8 +336,9 @@ tool_run_sql <- function(private) { ellmer::tool( function(sql, source = NULL) { src <- resolve_sql_source(private$sources, source) + definitions <- definitions_registry(private$sources) expansion <- expand_for_run_sql( - private$definitions, + definitions, private$sources, source, sql @@ -350,6 +367,27 @@ tool_run_sql <- function(private) { ) } +catalog_runtime_refresh <- function(private) { + private$definitions <- definitions_registry(private$sources) + private$calculations <- catalog_calculations_registry(private$sources) + private$context_layer <- augment_context_layer( + private$context_layer, + private$sources + ) + private$corpus <- build_citation_corpus( + private$context_layer, + private$registry, + private$sources + ) + if (!is.null(private$citation_request)) { + private$citation_request$request <- citation_request_text( + private$registry, + private$definitions + ) + } + invisible(private) +} + run_sql_description <- function(definitions, measures = list()) { parts <- c( "Run a read-only SELECT query against a data source.", diff --git a/man/data_source.Rd b/man/data_source.Rd index d43be34..a5ab090 100644 --- a/man/data_source.Rd +++ b/man/data_source.Rd @@ -19,8 +19,8 @@ their local-name-to-pin-name mapping.} \item{dictionary}{An optional path to a data dictionary describing the source's tables and columns, in the -\href{https://data-dict.tidyverse.org/}{data-dict.yaml} format. See the -\verb{Data dictionaries} section.} +\href{https://data-dict.tidyverse.org/}{data-dict.yaml} format, or an Apache +Ossie model from \code{\link[=ossie_model]{ossie_model()}}. See the \verb{Data dictionaries} section.} \item{options}{Selection, exclusion, and sampling controls from \code{\link[=data_source_options]{data_source_options()}}. DBI connections discover their current namespace @@ -85,6 +85,11 @@ expressions with declared types that the model applies as \code{{{name}}} tokens in \code{run_sql} queries, expanded to their trusted SQL before the query runs. Definitions are validated against the live source and delivered through all three channels above. + +\code{\link[=ossie_model]{ossie_model()}} reads Apache Ossie YAML or JSON into the same authored +metadata layer. Matching and selection rules are identical to data-dict; +\code{\link[=write_ossie]{write_ossie()}} exports the representable merged catalog and reports lossy +constructs as diagnostics. } \section{Trust}{ diff --git a/man/genie_agent.Rd b/man/genie_agent.Rd index 5084d06..b6581b0 100644 --- a/man/genie_agent.Rd +++ b/man/genie_agent.Rd @@ -4,7 +4,7 @@ \alias{genie_agent} \title{Configure a Databricks Genie Agent} \usage{ -genie_agent(id, workspace = NULL, profile = NULL) +genie_agent(id, workspace = NULL, profile = NULL, token = NULL) } \arguments{ \item{id}{The Genie Agent ID.} @@ -14,6 +14,10 @@ genie_agent(id, workspace = NULL, profile = NULL) \item{profile}{An optional Databricks CLI profile. Profile credentials remain in the CLI credential store and are not retained by commons.} + +\item{token}{An optional zero-argument function that returns a short-lived +Databricks access token. This supports per-session credentials on Posit +Connect without retaining the returned token in catalog metadata.} } \value{ A configuration object for the \code{genie} argument of diff --git a/man/ossie_model.Rd b/man/ossie_model.Rd new file mode 100644 index 0000000..f112f7e --- /dev/null +++ b/man/ossie_model.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/catalog-ossie.R +\name{ossie_model} +\alias{ossie_model} +\title{Read an Apache Ossie semantic model} +\usage{ +ossie_model(path) +} +\arguments{ +\item{path}{A YAML or JSON Apache Ossie model.} +} +\value{ +An authored semantic model for the \code{dictionary} argument of +\code{\link[=data_source]{data_source()}}. +} +\description{ +Read an Apache Ossie semantic model +} diff --git a/man/write_ossie.Rd b/man/write_ossie.Rd new file mode 100644 index 0000000..9b2a4aa --- /dev/null +++ b/man/write_ossie.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/catalog-ossie.R +\name{write_ossie} +\alias{write_ossie} +\title{Write an Apache Ossie semantic model} +\usage{ +write_ossie(x, path, overwrite = FALSE) +} +\arguments{ +\item{x}{A commons data source or an object returned by \code{\link[=ossie_model]{ossie_model()}}.} + +\item{path}{A destination ending in \code{.yaml}, \code{.yml}, or \code{.json}.} + +\item{overwrite}{Whether to replace an existing file.} +} +\value{ +The export diagnostics, invisibly. +} +\description{ +Write an Apache Ossie semantic model +} diff --git a/tests/testthat/_snaps/data-source.md b/tests/testthat/_snaps/data-source.md index 779f4b8..958978d 100644 --- a/tests/testthat/_snaps/data-source.md +++ b/tests/testthat/_snaps/data-source.md @@ -15,6 +15,14 @@ Error: ! Wildcards are not allowed inside ; put unqualified globs in `exclude`. +# provider identity is checked before every query + + Code + source_query(source, "SELECT * FROM orders") + Condition + Error in `source_query()`: + ! The connection identity, role, or current namespace changed after catalog discovery; rebuild the data source. + # default connection discovery stays in the current namespace Code diff --git a/tests/testthat/_snaps/genie.md b/tests/testthat/_snaps/genie.md index 370b5b7..0721d2f 100644 --- a/tests/testthat/_snaps/genie.md +++ b/tests/testthat/_snaps/genie.md @@ -26,7 +26,7 @@ # Genie permission failures are independent of DBI metadata Code - genie_import(provider, genie_agent("01f190d76f64158d8a1dd3618e1f10d0"), fetch) + genie_import(provider, genie_agent("0123456789abcdef0123456789abcdef"), fetch) Condition Error in `fetch()`: ! The REST identity cannot edit this Agent. diff --git a/tests/testthat/fixtures/databricks-metric-view.yaml b/tests/testthat/fixtures/databricks-metric-view.yaml new file mode 100644 index 0000000..e26478a --- /dev/null +++ b/tests/testthat/fixtures/databricks-metric-view.yaml @@ -0,0 +1,22 @@ +version: 1.1 +comment: Governed sales metrics. +source: samples.tpch.orders +parameters: + - {name: minimum_amount, data_type: double, default: 0} +filter: o_totalprice > minimum_amount +joins: + - name: customer + source: samples.tpch.customer + on: source.o_custkey = customer.c_custkey + rely: {at_most_one_match: true} +fields: + - name: region + expr: customer.c_mktsegment + comment: Customer segment. +measures: + - name: revenue + expr: SUM(o_totalprice) + display_name: Total Revenue + synonyms: [sales] + window: + - {order: region, range: cumulative} diff --git a/tests/testthat/fixtures/snowflake-semantic-recordings.yaml b/tests/testthat/fixtures/snowflake-semantic-recordings.yaml new file mode 100644 index 0000000..0f0a4fa --- /dev/null +++ b/tests/testthat/fixtures/snowflake-semantic-recordings.yaml @@ -0,0 +1,61 @@ +# Sanitized structural recordings of the three semantic views visible during development. +recordings: + - recorded_shape: {tables: 2, relationships: 0, metrics: 0} + semantic_view: + name: MODEL_A + description: A two-dataset environmental model. + tables: + - name: OBSERVATIONS + base_table: {database: SOURCE_A, schema: PUBLIC, table: OBSERVATIONS} + dimensions: + - {name: REGION, expr: REGION, data_type: VARCHAR} + - {name: OBSERVED_AT, expr: OBSERVED_AT, data_type: TIMESTAMP} + - name: SPECIES + base_table: {database: SOURCE_A, schema: PUBLIC, table: SPECIES} + dimensions: + - {name: SPECIES_NAME, expr: SPECIES_NAME, data_type: VARCHAR} + facts: + - {name: WIDTH, expr: WIDTH, data_type: NUMBER} + - recorded_shape: {tables: 2, relationships: 1, metrics: 0} + semantic_view: + name: MODEL_B + tables: + - name: ENTITIES + base_table: {database: SOURCE_B, schema: ERP, table: ENTITIES} + primary_key: {columns: [ENTITY_ID]} + dimensions: + - {name: ENTITY_NAME, expr: ENTITY_NAME, data_type: VARCHAR} + filters: + - {name: ACTIVE_ENTITY, expr: IS_ACTIVE, data_type: BOOLEAN} + - name: EVENTS + base_table: {database: SOURCE_B, schema: ERP, table: EVENTS} + dimensions: + - {name: EVENT_TYPE, expr: EVENT_TYPE, data_type: VARCHAR} + time_dimensions: + - {name: EVENT_AT, expr: EVENT_AT, data_type: TIMESTAMP} + facts: + - {name: EVENT_VALUE, expr: EVENT_VALUE, data_type: NUMBER} + metrics: + - {name: EVENT_COUNT, expr: COUNT(*), data_type: NUMBER} + relationships: + - name: EVENTS_TO_ENTITIES + left_table: EVENTS + right_table: ENTITIES + relationship_columns: + - {left_column: ENTITY_ID, right_column: ENTITY_ID} + - recorded_shape: {tables: 1, relationships: 0, metrics: 0} + semantic_view: + name: MODEL_C + tables: + - name: RECORDS + base_table: {database: SOURCE_C, schema: PUBLIC, table: RECORDS} + primary_key: {columns: [ID]} + dimensions: + - {name: CATEGORY, expr: CATEGORY, data_type: VARCHAR} + - {name: STATUS, expr: STATUS, data_type: VARCHAR} + facts: + - {name: AMOUNT, expr: AMOUNT, data_type: NUMBER} + - {name: BALANCE, expr: BALANCE, data_type: NUMBER} + metrics: + - {name: TOTAL_RECORDS, expr: COUNT(*), data_type: NUMBER} + - {name: TOTAL_AMOUNT, expr: SUM(AMOUNT), data_type: NUMBER} diff --git a/tests/testthat/helper-catalog-snowflake.R b/tests/testthat/helper-catalog-snowflake.R new file mode 100644 index 0000000..f8337a5 --- /dev/null +++ b/tests/testthat/helper-catalog-snowflake.R @@ -0,0 +1,23 @@ +snowflake_test_provider <- function(name) { + con <- DBI::dbConnect(duckdb::duckdb()) + source <- new_catalog_source( + "source:snowflake", + "snowflake", + dialect = "snowflake", + identifier_case = "upper" + ) + relation <- new_catalog_relation( + paste0("relation:", name), + source$id, + new_source_path(c("DB", "PUBLIC", name), c("catalog", "schema", "table")), + kind = "semantic_view" + ) + provider <- new.env(parent = emptyenv()) + provider$con <- con + provider$catalog <- new_commons_catalog( + sources = list(source), + relations = list(relation) + ) + provider$relation_labels <- stats::setNames(name, relation$id) + provider +} diff --git a/tests/testthat/helper-genie.R b/tests/testthat/helper-genie.R index 1a97bc3..3c29bdf 100644 --- a/tests/testthat/helper-genie.R +++ b/tests/testthat/helper-genie.R @@ -18,7 +18,8 @@ genie_test_provider <- function() { c("samples", "nyctaxi", "trips"), c("catalog", "schema", "table") ), - columns = columns + columns = columns, + access = new_catalog_access("queryable", "test fixture") ) provider <- new.env(parent = emptyenv()) provider$con <- con @@ -28,6 +29,7 @@ genie_test_provider <- function() { provider = provider ) provider$relation_labels <- c("relation:trips" = "trips") + provider$telemetry <- list() provider$snapshot <- list( principal = "executor@example.com", namespace = list(catalog = "samples", schema = "nyctaxi") diff --git a/tests/testthat/test-catalog-databricks.R b/tests/testthat/test-catalog-databricks.R index b9912ce..be15cdb 100644 --- a/tests/testthat/test-catalog-databricks.R +++ b/tests/testthat/test-catalog-databricks.R @@ -21,34 +21,9 @@ test_that("Databricks metric-view YAML imports governed assets", { sources = list(source), relations = list(relation) ) - specification <- yaml::yaml.load(paste( - "version: 1.1", - "comment: Governed sales metrics.", - "source: samples.tpch.orders", - "parameters:", - " - name: minimum_amount", - " data_type: double", - " default: 0", - "filter: o_totalprice > minimum_amount", - "joins:", - " - name: customer", - " source: samples.tpch.customer", - " on: source.o_custkey = customer.c_custkey", - " rely:", - " at_most_one_match: true", - "fields:", - " - name: region", - " expr: customer.c_mktsegment", - " comment: Customer segment.", - "measures:", - " - name: revenue", - " expr: SUM(o_totalprice)", - " display_name: Total Revenue", - " synonyms: [sales]", - " window:", - " - order: region", - " range: cumulative", - sep = "\n" + specification <- yaml::read_yaml(test_path( + "fixtures", + "databricks-metric-view.yaml" )) databricks_import_metric_model(provider, relation, specification) @@ -71,6 +46,74 @@ test_that("Databricks metric-view YAML imports governed assets", { expect_equal(root$constraints[[1]]$enforcement, "asserted") }) +test_that("namespace metric views hydrate their semantics lazily", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + source <- new_catalog_source( + "source:databricks", + "databricks", + dialect = "databricks" + ) + relation <- new_catalog_relation( + "relation:sales_metrics", + source$id, + new_source_path( + c("main", "analytics", "sales_metrics"), + c("catalog", "schema", "table") + ), + kind = "metric_view" + ) + provider <- new.env(parent = emptyenv()) + provider$con <- con + provider$catalog <- new_commons_catalog( + sources = list(source), + relations = list(relation) + ) + provider$relation_labels <- c( + "relation:sales_metrics" = "main.analytics.sales_metrics" + ) + provider$selection_modes <- c("relation:sales_metrics" = "namespace") + reads <- 0L + local_mocked_bindings( + databricks_read_metric_yaml = function(con, path) { + reads <<- reads + 1L + yaml::read_yaml(test_path("fixtures", "databricks-metric-view.yaml")) + } + ) + + databricks_import_semantics(provider) + expect_equal(reads, 0L) + expect_length(provider$catalog$models, 0) + + databricks_import_semantic_relation(provider, relation$id) + expect_equal(reads, 1L) + expect_length(provider$catalog$models, 1) + expect_true(length(provider$catalog$definitions) > 0) +}) + +test_that("live Databricks catalog discovery is opt in", { + skip_if_not(identical(Sys.getenv("COMMONS_LIVE_DATABRICKS"), "true")) + required <- c( + "COMMONS_DATABRICKS_CATALOG", + "COMMONS_DATABRICKS_SCHEMA", + "COMMONS_DATABRICKS_TABLE" + ) + skip_if(any(!nzchar(Sys.getenv(required)))) + con <- DBI::dbConnect(odbc::odbc(), "Databricks") + withr::defer(DBI::dbDisconnect(con)) + source <- data_source( + con, + options = data_source_options(include = DBI::Id( + catalog = Sys.getenv("COMMONS_DATABRICKS_CATALOG"), + schema = Sys.getenv("COMMONS_DATABRICKS_SCHEMA"), + table = Sys.getenv("COMMONS_DATABRICKS_TABLE") + )) + ) + + expect_true(length(source$provider$catalog$relations) > 0) + expect_equal(nrow(source_describe(source, list_tables(source))$sample), 0) +}) + test_that("Databricks measures compile through MEASURE", { con <- DBI::dbConnect(duckdb::duckdb()) withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) diff --git a/tests/testthat/test-catalog-ossie.R b/tests/testthat/test-catalog-ossie.R index 9d92650..5ecc6cd 100644 --- a/tests/testthat/test-catalog-ossie.R +++ b/tests/testthat/test-catalog-ossie.R @@ -54,9 +54,102 @@ test_that("Apache Ossie parses JSON without a Python dependency", { expect_equal(catalog$sources[[1]]$kind, "ossie") }) +test_that("Apache Ossie models are public authored metadata", { + document <- list( + version = "0.1.1", + semantic_model = list(list( + name = "sales", + datasets = list(list( + name = "orders", + source = "orders", + description = "One row per order.", + fields = list(list( + name = "amount", + expression = list(dialects = list(list( + dialect = "ANSI_SQL", + expression = "amount" + ))) + )) + )), + metrics = list(list( + name = "revenue", + expression = list(dialects = list(list( + dialect = "ANSI_SQL", + expression = "SUM(amount)" + ))) + )) + )) + ) + input <- withr::local_tempfile(fileext = ".yaml") + yaml::write_yaml(document, input) + model <- ossie_model(input) + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + DBI::dbWriteTable(con, "orders", data.frame(amount = c(10, 20))) + + source <- data_source( + con, + dictionary = model, + options = data_source_options(include = "orders") + ) + + expect_s3_class(source$dictionary, "commons_data_dictionary") + expect_equal(source$dictionary$tables$orders$description, "One row per order.") + expect_setequal( + definitions_registry(list(warehouse = source))$defs$name, + c("amount", "revenue") + ) +}) + +test_that("Apache Ossie dependencies are filtered with selected datasets", { + authored <- ossie_model(test_path("fixtures", "ossie-databricks.yaml")) + source <- new_catalog_source( + "source:databricks", + "databricks", + identifier_case = "lower" + ) + orders <- new_catalog_relation( + "relation:orders", + source$id, + new_source_path(c( + catalog = "samples", + schema = "tpch", + table = "orders" + )) + ) + discovered <- new_commons_catalog( + sources = list(source), + relations = list(orders) + ) + + merged <- catalog_merge(discovered, authored) + definitions <- vapply(merged$definitions, `[[`, character(1), "name") + kinds <- vapply(merged$context, `[[`, character(1), "kind") + + expect_equal(names(merged$relations), orders$id) + expect_equal(merged$relations[[orders$id]]$constraints[[1]]$kind, "primary_key") + expect_length(merged$relations[[orders$id]]$constraints, 1) + expect_length(merged$models[[1]]$relationships, 0) + expect_false("total_revenue" %in% definitions) + expect_false("ossie_relationship_context" %in% kinds) +}) + +test_that("Apache Ossie models write to YAML and JSON", { + model <- ossie_model(test_path("fixtures", "ossie-databricks.yaml")) + yaml_path <- withr::local_tempfile(fileext = ".yaml") + json_path <- withr::local_tempfile(fileext = ".json") + + expect_invisible(write_ossie(model, yaml_path)) + expect_invisible(write_ossie(model, json_path)) + expect_s3_class(ossie_model(yaml_path), "commons_catalog") + expect_s3_class(ossie_model(json_path), "commons_catalog") + expect_error(write_ossie(model, yaml_path), "already exists") + expect_invisible(write_ossie(model, yaml_path, overwrite = TRUE)) +}) + test_that("Snowflake Ossie extensions retain native payloads", { document <- list( - version = "0.2.0.dev0", + version = "0.1.1", semantic_model = list(list( name = "lending", datasets = list(list( @@ -67,26 +160,45 @@ test_that("Snowflake Ossie extensions retain native payloads", { expression = list(dialects = list(list( dialect = "SNOWFLAKE", expression = "loan_id" + ))), + dimension = list(is_time = FALSE) + ), list( + name = "balance", + expression = list(dialects = list(list( + dialect = "SNOWFLAKE", + expression = "balance" ))) )) )), custom_extensions = list(list( - vendor_name = "SNOWFLAKE", - data = '{"semantic_view":"LENDING.PUBLIC.LOAN_METRICS","verified_queries":["count_loans"]}' + vendor = "SNOWFLAKE", + content = paste0( + '{"custom_instructions":"Use booked balances.",', + '"verified_queries":[{"name":"count_loans",', + '"question":"How many loans?","sql":"SELECT COUNT(*) FROM loans"}]}' + ) )) )) ) catalog <- catalog_from_ossie(document) exported <- catalog_to_ossie(catalog) - - expect_equal( - catalog$models[[1]]$extensions$snowflake$semantic_view, - "LENDING.PUBLIC.LOAN_METRICS" + definitions <- catalog$definitions + roles <- setNames( + vapply(definitions, `[[`, character(1), "role"), + vapply(definitions, `[[`, character(1), "name") ) + context <- vapply(catalog$context, `[[`, character(1), "text") + extension <- exported$document$semantic_model[[1]]$custom_extensions[[1]] + + expect_equal(unname(roles[c("loan_id", "balance")]), c("dimension", "fact")) + expect_true(any(grepl("Use booked balances", context, fixed = TRUE))) + expect_true(any(grepl("How many loans", context, fixed = TRUE))) + expect_equal(exported$document$version, "0.1.1") + expect_equal(extension$vendor, "SNOWFLAKE") expect_equal( - exported$document$semantic_model[[1]]$custom_extensions[[1]]$vendor_name, - "SNOWFLAKE" + jsonlite::fromJSON(extension$content)$custom_instructions, + "Use booked balances." ) }) diff --git a/tests/testthat/test-catalog-snowflake.R b/tests/testthat/test-catalog-snowflake.R index 9640889..9c0635b 100644 --- a/tests/testthat/test-catalog-snowflake.R +++ b/tests/testthat/test-catalog-snowflake.R @@ -67,13 +67,86 @@ test_that("Snowflake semantic YAML imports governed assets", { expect_length(catalog$models, 1) expect_length(catalog$calculations, 1) - expect_length(catalog$context, 2) + expect_length(catalog$context, 5) expect_setequal(registry$defs$name, c("REGION", "REVENUE")) expect_false("PRIVATE_MARGIN" %in% registry$defs$name) dependency <- catalog$relations[[catalog$models[[1]]$datasets]] expect_equal(dependency$constraints[[1]]$enforcement, "asserted") }) +test_that("Snowflake imports all three recorded semantic-view shapes", { + recordings <- yaml::read_yaml(test_path( + "fixtures", + "snowflake-semantic-recordings.yaml" + ))$recordings + + for (recording in recordings) { + provider <- snowflake_test_provider(recording$semantic_view$name) + relation <- provider$catalog$relations[[1]] + snowflake_import_semantic_model( + provider, + relation, + recording$semantic_view + ) + + expect_equal( + length(provider$catalog$models[[1]]$datasets), + recording$recorded_shape$tables + ) + expect_true(length(provider$catalog$definitions) > 0) + expect_silent(validate_commons_catalog(provider$catalog)) + } +}) + +test_that("Snowflake calls only read-only verified queries", { + provider <- snowflake_test_provider("VERIFIED_MODEL") + relation <- provider$catalog$relations[[1]] + specification <- list( + name = "VERIFIED_MODEL", + tables = list(list( + name = "ORDERS", + base_table = list(database = "DB", schema = "PUBLIC", table = "ORDERS") + )), + verified_queries = list( + list(name = "order_count", question = "How many orders?", sql = "SELECT COUNT(*) FROM ORDERS"), + list(name = "unsafe_example", question = "Refresh the table", sql = "CALL REFRESH_ORDERS()") + ) + ) + + snowflake_import_semantic_model(provider, relation, specification) + + expect_equal( + unname(vapply(provider$catalog$calculations, `[[`, character(1), "name")), + "order_count" + ) + contexts <- vapply(provider$catalog$context, `[[`, character(1), "text") + expect_true(any(grepl("Refresh the table", contexts, fixed = TRUE))) +}) + +test_that("live Snowflake semantic discovery is opt in", { + skip_if_not(identical(Sys.getenv("COMMONS_LIVE_SNOWFLAKE"), "true")) + required <- c( + "COMMONS_SNOWFLAKE_DATABASE", + "COMMONS_SNOWFLAKE_SCHEMA", + "COMMONS_SNOWFLAKE_TABLE" + ) + skip_if(any(!nzchar(Sys.getenv(required)))) + con <- DBI::dbConnect(odbc::snowflake()) + withr::defer(DBI::dbDisconnect(con)) + source <- data_source( + con, + options = data_source_options(include = DBI::Id( + catalog = Sys.getenv("COMMONS_SNOWFLAKE_DATABASE"), + schema = Sys.getenv("COMMONS_SNOWFLAKE_SCHEMA"), + table = Sys.getenv("COMMONS_SNOWFLAKE_TABLE") + )) + ) + + expect_true(length(source$provider$catalog$relations) > 0) + expect_equal(nrow(source_describe(source, list_tables(source))$sample), 0) +}) + + test_that("Snowflake metrics compile through SEMANTIC_VIEW", { con <- DBI::dbConnect(duckdb::duckdb()) withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) diff --git a/tests/testthat/test-catalog.R b/tests/testthat/test-catalog.R index 714f483..643fa65 100644 --- a/tests/testthat/test-catalog.R +++ b/tests/testthat/test-catalog.R @@ -244,6 +244,57 @@ test_that("relative authored relation matches must be unambiguous", { expect_snapshot(catalog_merge(discovered, authored), error = TRUE) }) +test_that("authored metadata is limited to selected discovered relations", { + source <- new_catalog_source( + "source:warehouse", + "snowflake", + identifier_case = "upper" + ) + orders <- new_catalog_relation( + "relation:orders", + source$id, + new_source_path(c(catalog = "DB", schema = "PUBLIC", table = "ORDERS")) + ) + discovered <- new_commons_catalog( + sources = list(source), + relations = list(orders) + ) + authored <- catalog_from_data_dictionary(new_data_dictionary(list( + description = "Company-wide definitions.", + tables = list( + orders = list( + description = "Selected orders.", + definitions = list(order_count = list( + expr = "COUNT(*)", + type = "number" + )) + ), + secret = list( + description = "Unselected secrets.", + definitions = list(secret_count = list( + expr = "COUNT(*)", + type = "number" + )) + ) + ), + relationships = list(list(join = "orders.secret_id = secret.id")), + glossary = list(company = "Applies across the source.") + ))) + + merged <- catalog_merge(discovered, authored) + text <- vapply(merged$context, `[[`, character(1), "text") + + expect_equal(names(merged$relations), orders$id) + expect_equal( + unname(vapply(merged$definitions, `[[`, character(1), "name")), + "order_count" + ) + expect_length(merged$models[[1]]$relationships, 0) + expect_false(any(grepl("secret", text, ignore.case = TRUE))) + expect_true(any(grepl("Company-wide", text, fixed = TRUE))) + expect_true(any(grepl("Applies across", text, fixed = TRUE))) +}) + test_that("constraint enforcement is distinct from constraint kind", { constraint <- new_catalog_constraint( "foreign_key", @@ -440,3 +491,35 @@ test_that("private and visible-only semantic definitions stay out of the registr catalog$definitions[[definition$id]]$visibility <- "private" expect_equal(nrow(catalog_definition_registry(catalog)$defs), 0) }) + +test_that("native semantic columns do not duplicate projected definitions", { + source <- new_catalog_source("source:test", "snowflake") + relation <- new_catalog_relation( + "relation:model", + source$id, + new_source_path(c(table = "MODEL")), + columns = list(new_catalog_column("REGION")) + ) + model <- new_catalog_model( + "model:test", + source$id, + "MODEL", + datasets = relation$id + ) + definition <- new_catalog_definition( + "definition:region", + model$id, + relation$id, + "dimension", + "REGION", + expressions = list(new_catalog_expression("snowflake", "REGION")) + ) + + table <- catalog_relation_to_dictionary( + relation, + stats::setNames(list(definition), definition$id) + ) + + expect_equal(names(table$columns), "REGION") + expect_length(table$definitions, 0) +}) diff --git a/tests/testthat/test-data-source.R b/tests/testthat/test-data-source.R index 43141fa..b5eb4e7 100644 --- a/tests/testthat/test-data-source.R +++ b/tests/testthat/test-data-source.R @@ -148,6 +148,58 @@ test_that("sample_rows opts into bounded live values", { expect_equal(nrow(source_describe(sampled, "orders")$sample), 2) }) +test_that("selection limits model context rather than connection grants", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + DBI::dbWriteTable(con, "selected", data.frame(id = 1)) + DBI::dbWriteTable(con, "not_selected", data.frame(id = 2)) + source <- data_source( + con, + options = data_source_options(include = "selected") + ) + + expect_equal(list_tables(source), "selected") + expect_equal(source_query(source, "SELECT * FROM not_selected")$id, 2) +}) + +test_that("provider identity is checked before every query", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + DBI::dbWriteTable(con, "orders", data.frame(id = 1)) + source <- data_source( + con, + options = data_source_options(include = "orders") + ) + source$provider$snapshot$principal <- "different-principal" + + expect_snapshot(source_query(source, "SELECT * FROM orders"), error = TRUE) +}) + +test_that("catalog telemetry covers discovery and hydration", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + DBI::dbWriteTable(con, "orders", data.frame(id = 1)) + source <- data_source( + con, + options = data_source_options(include = "orders") + ) + + source_describe(source, "orders") + operations <- vapply( + source$provider$telemetry, + `[[`, + character(1), + "operation" + ) + + expect_equal(operations, c("discovery", "hydrate")) + expect_true(all(vapply( + source$provider$telemetry, + function(event) event$elapsed >= 0, + logical(1) + ))) +}) + test_that("connection discovery merges an authored dictionary", { con <- DBI::dbConnect(duckdb::duckdb()) withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) @@ -184,6 +236,64 @@ test_that("connection discovery merges an authored dictionary", { definitions_registry(list(warehouse = src))$defs$table, "crm.orders" ) + expect_equal( + src$provider$catalog$relations[[names(src$relation_labels)]]$access$state, + "queryable" + ) + expect_true("authorize" %in% vapply( + src$provider$telemetry, + `[[`, + character(1), + "operation" + )) +}) + +test_that("unqueryable relations do not receive authored metadata", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + DBI::dbWriteTable(con, "orders", data.frame(id = 1)) + DBI::dbWriteTable(con, "secret", data.frame(id = 1)) + dictionary <- new_data_dictionary(list(tables = list( + orders = list(definitions = list(order_count = list( + expr = "COUNT(*)", + type = "number" + ))), + secret = list( + description = "Not available to this viewer.", + definitions = list(secret_count = list( + expr = "COUNT(*)", + type = "number" + )) + ) + ))) + local_mocked_bindings( + catalog_relation_queryability = function(con, path) { + if (identical(utils::tail(path$components, 1), "secret")) { + return(simpleError("not authorized")) + } + TRUE + } + ) + + source <- data_source( + con, + dictionary = dictionary, + options = data_source_options(include = c("orders", "secret")) + ) + context <- vapply( + source$provider$catalog$context, + `[[`, + character(1), + "text" + ) + + expect_equal(list_tables(source), "orders") + expect_equal(names(source$dictionary$tables), "orders") + expect_equal( + definitions_registry(list(warehouse = source))$defs$name, + "order_count" + ) + expect_false(any(grepl("Not available", context, fixed = TRUE))) }) test_that("catalog discovery exposes startup progress", { diff --git a/tests/testthat/test-genie.R b/tests/testthat/test-genie.R index 0b0dd6d..3af3db6 100644 --- a/tests/testthat/test-genie.R +++ b/tests/testthat/test-genie.R @@ -1,16 +1,29 @@ test_that("Genie Agent configuration retains no credentials", { config <- genie_agent( - "01f190d76f64158d8a1dd3618e1f10d0", + "0123456789abcdef0123456789abcdef", workspace = "https://example.cloud.databricks.com/", profile = "example" ) expect_equal(config$workspace, "https://example.cloud.databricks.com") expect_equal(config$profile, "example") - expect_false(any(grepl("token|credential", names(config), ignore.case = TRUE))) + expect_null(config$token) expect_snapshot(genie_agent("not-an-id"), error = TRUE) }) +test_that("Genie token callbacks are forgotten after import", { + token <- function() "short-lived-token" + config <- genie_agent( + "0123456789abcdef0123456789abcdef", + workspace = "https://example.cloud.databricks.com", + token = token + ) + options <- data_source_options(genie = config) + + expect_identical(options$genie$token, token) + expect_null(catalog_forget_credentials(options)$genie$token) +}) + test_that("serialized Genie context is scoped and routed by authority", { fixture <- paste( readLines(test_path("fixtures", "genie-v2.json"), warn = FALSE), @@ -29,7 +42,7 @@ test_that("serialized Genie context is scoped and routed by authority", { genie_import( provider, - genie_agent("01f190d76f64158d8a1dd3618e1f10d0"), + genie_agent("0123456789abcdef0123456789abcdef"), fetch = fetch ) @@ -73,7 +86,7 @@ test_that("Genie parameters are typed, defaulted, and bound", { ) genie_import( provider, - genie_agent("01f190d76f64158d8a1dd3618e1f10d0"), + genie_agent("0123456789abcdef0123456789abcdef"), fetch = fetch ) calculation <- Filter( @@ -125,7 +138,7 @@ test_that("Genie changes are fetched for each provider construction", { principal = "executor@example.com" ) } - config <- genie_agent("01f190d76f64158d8a1dd3618e1f10d0") + config <- genie_agent("0123456789abcdef0123456789abcdef") genie_import(provider, config, fetch) first <- provider$catalog$models[[1]]$fingerprint @@ -146,7 +159,7 @@ test_that("Genie permission failures are independent of DBI metadata", { expect_snapshot( genie_import( provider, - genie_agent("01f190d76f64158d8a1dd3618e1f10d0"), + genie_agent("0123456789abcdef0123456789abcdef"), fetch ), error = TRUE @@ -154,6 +167,35 @@ test_that("Genie permission failures are independent of DBI metadata", { expect_length(provider$catalog$relations, 1) }) +test_that("Genie context requires DBI query access", { + fixture <- paste( + readLines(test_path("fixtures", "genie-v2.json"), warn = FALSE), + collapse = "\n" + ) + provider <- genie_test_provider() + provider$catalog$relations[["relation:trips"]]$access <- new_catalog_access() + local_mocked_bindings( + catalog_relation_queryability = function(con, path) { + simpleError("not authorized") + } + ) + fetch <- function(config) list( + response = list(serialized_space = fixture), + principal = "executor@example.com" + ) + + genie_import( + provider, + genie_agent("0123456789abcdef0123456789abcdef"), + fetch + ) + codes <- vapply(provider$catalog$diagnostics, `[[`, character(1), "code") + + expect_length(provider$catalog$models, 0) + expect_length(provider$catalog$context, 0) + expect_true("genie_asset_unqueryable" %in% codes) +}) + test_that("live Genie import honors the selected relation", { skip_if_not(identical(Sys.getenv("COMMONS_LIVE_DATABRICKS"), "true")) required <- c( diff --git a/vignettes/database-catalogs.Rmd b/vignettes/database-catalogs.Rmd new file mode 100644 index 0000000..11b9d09 --- /dev/null +++ b/vignettes/database-catalogs.Rmd @@ -0,0 +1,270 @@ +--- +title: "Database catalogs and semantic models" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Database catalogs and semantic models} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r} +#| include: false +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + eval = FALSE +) +``` + +A DBI connection is enough for commons to discover table and column metadata. +Snowflake semantic views and Databricks metric views also contribute governed +calculations and business context. No intermediate `data-dict.yaml` is needed. + +## Selecting objects + +Use `DBI::Id()` to distinguish identifier components. An ID with a `table` +component selects one exact object. An ID ending at `schema` or `catalog` +selects that namespace and its descendants. + +```r +source <- data_source( + con, + options = data_source_options( + include = list( + DBI::Id(catalog = "ANALYTICS", schema = "PUBLIC"), + DBI::Id( + catalog = "REFERENCE", + schema = "PUBLIC", + table = "CALENDAR" + ) + ), + exclude = c("TMP_*", "BACKUP_?") + ) +) +``` + +Character values are exact table names relative to the connection's current +namespace. Dots and wildcard characters in a character value are literal. +Unqualified `*` and `?` globs are supported only by `exclude`. + +With no `include`, commons uses the current catalog/database and schema. Supply +an explicit ID when either is unset. Snowflake calls its top identifier level a +database; Unity Catalog calls it a catalog. `DBI::Id(catalog = ...)` is the +portable representation for both. + +Discovery retains a full, session-local manifest. Small selections appear in +the prompt; larger selections are searched with `search_catalog`. Columns and +namespace-selected semantic documents remain lazy until `describe_table` +touches an object; exact semantic-object selections import immediately. +Databricks may take several +minutes to start a stopped SQL warehouse on the first connection or query; wait +for that call rather than retrying it. + +An exact physical-table selection can import an associated semantic model only +when that model's dependencies are inside the selection. Selecting a semantic +view or metric view exactly imports its declared dependency closure for +compilation, but does not silently add those physical tables to the model-facing +table list. Metadata that can be listed but not described is marked +`visible_only`; successful hydration changes `unknown` access to `queryable`. + +By default, schema discovery returns no live rows. When authored metadata is +present, commons may issue a zero-row `SELECT` to confirm that the current +identity can query each matching physical relation before disclosing its +table-scoped facts. Sampling is explicit and bounded: + +```r +data_source( + con, + options = data_source_options( + include = DBI::Id(schema = "PUBLIC", table = "ORDERS"), + sample_rows = 3 + ) +) +``` + +Restricted columns do not contribute sampled or authored example values. + +## Semantic context + +Snowflake imports semantic-view datasets, relationships, dimensions, time +dimensions, facts, metrics, filters, instructions, variables, and read-only +verified queries. Databricks imports metric-view sources, joins, dimensions, +measures, filters, parameters, and supported window metadata. Native metrics +run through the warehouse's semantic SQL syntax. Unsupported or out-of-scope +assets are omitted with a catalog diagnostic rather than treated as trusted. + +To add the business context from one Databricks Genie Agent, provide its ID. +The REST identity must be able to edit the Agent because the serialized +definition is not available through the ordinary conversation API. + +```r +source <- data_source( + con, + options = data_source_options( + include = DBI::Id( + catalog = "samples", + schema = "nyctaxi", + table = "trips" + ), + genie = genie_agent( + "0123456789abcdef0123456789abcdef", + profile = "my-databricks-profile" + ) + ) +) +``` + +Genie prose, snippets, joins, examples, and functions are reconciled against +the selected Unity Catalog objects. Static SQL examples are context; +parameterized examples and governed functions are callable only when commons +can type and bind every argument. Benchmarks remain evaluation-only. Genie +Ontology and workspace-wide instructions are not imported because Databricks +does not currently publish a context-export contract for them. + +An authored data dictionary can supplement discovery. Authored descriptions +win when the table identity matches; discovered types and additive metadata are +retained. Ambiguous matches fail rather than merging by guesswork. Table-scoped +authored material is filtered against physical relations that pass a zero-row +authorization probe under the viewer's identity. Dataset description, details, +glossary, and other global authored context apply to every viewer of the +application. + +```r +data_source( + con, + dictionary = "data-dict.yaml", + options = data_source_options( + include = DBI::Id(schema = "PUBLIC", table = "ORDERS") + ) +) +``` + +Apache Ossie YAML or JSON can supply the same authored layer without becoming +commons' runtime representation: + +```r +source <- data_source( + con, + dictionary = ossie_model("semantic-model.yaml"), + options = data_source_options( + include = DBI::Id(schema = "PUBLIC", table = "ORDERS") + ) +) + +diagnostics <- write_ossie(source, "merged-semantic-model.yaml") +``` + +`write_ossie()` returns diagnostics for catalog constructs that Ossie cannot +represent directly. Set `overwrite = TRUE` to replace an existing file. + +`tables` is deprecated. The mechanical migration is: + +```r +# Before +data_source(con, tables = "ORDERS") + +# After +data_source(con, options = data_source_options(include = "ORDERS")) +``` + +## Permission boundary + +`include`, `exclude`, context retrieval, and evaluation-harness filtering +control relevance and disclosure to the model. They do not revoke warehouse +permissions. `run_sql` can query any object allowed by the DBI connection even +when the object is absent from `include`. Use a least-privilege warehouse role +and read-only connection when that distinction matters. + +Catalog prose, sampled rows, query results, and traces can leave the warehouse +for the configured model and observability providers. Review those systems' +retention and access policies before enabling sampling or sensitive context. + +## Posit Connect and Viewer OAuth + +Viewer OAuth gives each interactive viewer their own warehouse identity. Build +the token, ODBC connection, data source, catalog, and commons agent inside the +Shiny session. Do not put any of them in process-global state. + +```r +server <- function(input, output, session) { + workspace <- paste0( + "https://", + sub("^https://|/$", "", Sys.getenv("DATABRICKS_HOST")) + ) + + con <- DBI::dbConnect( + odbc::databricks(), + httpPath = Sys.getenv("DATABRICKS_PATH") + ) + session$onSessionEnded(function() DBI::dbDisconnect(con)) + + source <- data_source( + con, + options = data_source_options( + include = DBI::Id( + catalog = "main", + schema = "analytics" + ), + genie = genie_agent( + Sys.getenv("DATABRICKS_GENIE_AGENT_ID"), + workspace = workspace, + token = function() { + connectcreds::connect_viewer_token(workspace)$access_token + } + ) + ) + ) + + agent <- commons(chat, data_sources = list(warehouse = source)) +} +``` + +With a Viewer integration associated with the content, `odbc::databricks()` +obtains the viewer token through `connectcreds`; the callback supplies a fresh +token separately to the Genie REST import. Replace the first argument to +`genie_agent()` with the Agent ID. The callback is invoked during import and +removed from the resulting source and catalog metadata. + +Snowflake uses the same session pattern: + +```r +con <- DBI::dbConnect(odbc::snowflake()) +``` + +`odbc::snowflake()` likewise obtains the Viewer OAuth token automatically. Its +account, warehouse, database, and schema can come from the deployment's +Snowflake connection configuration or environment. + +Connect returns a refreshed access token on each credential exchange, but an +existing ODBC connection does not acquire that new token automatically. A +long-running session should handle an authentication failure by disconnecting, +exchanging credentials again, and rebuilding the connection, source, catalog, +and agent. Commons keeps no catalog cache across data sources, principals, or +roles; a connection identity, role, or namespace change invalidates its +session-local provider. + +Discovery is deliberately serialized within a source rather than pooled across +viewers. A selection is capped at 25,000 objects, import failures are retained +as diagnostics, and discovery/hydration timings stay in the session-local +provider telemetry. This avoids a cross-principal cache; measured local startup +was dominated by warehouse authentication and startup rather than catalog +normalization. + +[Viewer integrations](https://docs.posit.co/connect/user/oauth-integrations/) +support interactive authenticated content, not rendered/static content, +anonymous access, or share links. Service-account integrations give every +viewer the same warehouse identity and support interactive and rendered +content. Databricks also supports workload identity and recommends it for +non-interactive content because it avoids a stored long-lived secret. Snowflake +service-account OAuth uses an external identity provider and a mapped Snowflake +user. In every case, the effective Snowflake or Databricks grants determine +what commons can discover and query. + +See the Connect administration guides for +[Databricks](https://docs.posit.co/connect/admin/integrations/oauth-integrations/databricks/) +and +[Snowflake](https://docs.posit.co/connect/admin/integrations/oauth-integrations/snowflake/), +and the vendor specifications for +[Snowflake semantic views](https://docs.snowflake.com/en/user-guide/views-semantic/semantic-view-yaml-spec) +and +[Databricks metric views](https://docs.databricks.com/aws/en/metric-views/). From aa883dcf8422d58ff03c1d7bbc6400efb438dae8 Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 12:40:10 -0500 Subject: [PATCH 09/25] complete lazy semantic hydration --- R/calculations.R | 10 ++- R/catalog-provider.R | 69 +++++++++++++----- R/data-source.R | 28 ++++++-- R/definitions.R | 11 +-- R/pool.R | 5 +- R/tools.R | 5 +- tests/testthat/_snaps/data-source.md | 37 ++++++++++ tests/testthat/_snaps/pool.md | 8 +++ tests/testthat/helper-catalog-provider.R | 82 +++++++++++++++++++++ tests/testthat/test-catalog.R | 18 ++++- tests/testthat/test-data-source.R | 90 ++++++++++++++++++++++++ tests/testthat/test-pool.R | 53 ++++++++++++++ 12 files changed, 379 insertions(+), 37 deletions(-) create mode 100644 tests/testthat/_snaps/pool.md create mode 100644 tests/testthat/helper-catalog-provider.R diff --git a/R/calculations.R b/R/calculations.R index 63b48b3..bc6055c 100644 --- a/R/calculations.R +++ b/R/calculations.R @@ -3,7 +3,7 @@ catalog_calculations_registry <- function(sources) { labels <- rlang::names2(sources) for (i in seq_along(sources)) { source <- sources[[i]] - catalog <- source$provider$catalog %||% source$catalog + catalog <- source_catalog(source) if (!inherits(catalog, "commons_catalog")) { next } @@ -32,7 +32,7 @@ catalog_calculation_available <- function(catalog, calculation) { } catalog_calculation_entry_available <- function(entry) { - catalog <- entry$source$provider$catalog %||% entry$source$catalog + catalog <- source_catalog(entry$source) catalog_calculation_available(catalog, entry$calculation) } @@ -152,11 +152,17 @@ catalog_calculation_access <- function(entry, state, evidence) { relation <- catalog$relations[[relation_id]] relation$access <- new_catalog_access(state, evidence) catalog$relations[[relation_id]] <- relation + if (identical(state, "visible_only")) { + catalog_provider_drop_relation(provider, relation_id) + } } } else if (id %in% names(catalog$relations)) { relation <- catalog$relations[[id]] relation$access <- new_catalog_access(state, evidence) catalog$relations[[id]] <- relation + if (identical(state, "visible_only")) { + catalog_provider_drop_relation(provider, id) + } } } provider$catalog <- catalog diff --git a/R/catalog-provider.R b/R/catalog-provider.R index 7758728..8a1dda2 100644 --- a/R/catalog-provider.R +++ b/R/catalog-provider.R @@ -419,6 +419,17 @@ catalog_provider_hydrate <- function(provider, table, call = rlang::caller_env() ) relation$access <- new_catalog_access("visible_only", conditionMessage(metadata)) provider$catalog$relations[[relation_id]] <- relation + catalog_provider_diagnostic( + provider, + "catalog_relation_unqueryable", + sprintf( + "Removed %s because it could not be described by this connection.", + table + ), + severity = "info", + entity_id = relation_id + ) + catalog_provider_drop_relation(provider, relation_id) cli::cli_abort( "Table {.val {table}} could not be described.", parent = metadata, @@ -513,20 +524,8 @@ catalog_provider_finalize_access <- function( function(relation) identical(relation$access$state, "visible_only"), logical(1) )] - if (length(visible_only)) { - labels <- unname(provider$relation_labels[visible_only]) - provider$table_ids <- provider$table_ids[setdiff( - names(provider$table_ids), - labels - )] - provider$relation_labels <- provider$relation_labels[setdiff( - names(provider$relation_labels), - visible_only - )] - provider$selection_modes <- provider$selection_modes[setdiff( - names(provider$selection_modes), - visible_only - )] + for (relation_id in visible_only) { + catalog_provider_drop_relation(provider, relation_id) } if (length(provider$table_ids) == 0) { cli::cli_abort( @@ -541,6 +540,29 @@ catalog_provider_finalize_access <- function( invisible(provider) } +catalog_provider_drop_relation <- function(provider, relation_id) { + label <- provider$relation_labels[[relation_id]] + if (!is.null(label)) { + provider$table_ids <- provider$table_ids[setdiff( + names(provider$table_ids), + label + )] + } + provider$relation_labels <- provider$relation_labels[setdiff( + names(provider$relation_labels), + relation_id + )] + provider$selection_modes <- provider$selection_modes[setdiff( + names(provider$selection_modes), + relation_id + )] + provider$lazy <- nchar( + paste(names(provider$table_ids), collapse = "\n"), + type = "bytes" + ) > 4000L + invisible(provider) +} + catalog_provider_record <- function(provider, operation, started_at, object = NULL) { provider$telemetry[[length(provider$telemetry) + 1]] <- list( operation = operation, @@ -764,6 +786,11 @@ catalog_filter_associated_model <- function(provider, relation_id) { function(calculation) model$id %in% calculation$dependencies, provider$catalog$calculations ) + complete_model <- catalog_dependencies_selected( + provider$catalog, + model$dependencies, + selected_paths + ) keep_definitions <- vapply( definitions, function(definition) { @@ -776,11 +803,7 @@ catalog_filter_associated_model <- function(provider, relation_id) { logical(1) ) keep_calculations <- rep( - catalog_dependencies_selected( - provider$catalog, - model$dependencies, - selected_paths - ), + complete_model, length(calculations) ) skipped <- c( @@ -795,6 +818,14 @@ catalog_filter_associated_model <- function(provider, relation_id) { !names(provider$catalog$calculations) %in% names(calculations) | names(provider$catalog$calculations) %in% names(calculations)[keep_calculations] ] + if (!complete_model) { + model$relationships <- list() + provider$catalog$models[[model$id]] <- model + provider$catalog$context <- Filter( + function(context) !model$id %in% context$scope, + provider$catalog$context + ) + } if (length(skipped)) { diagnostic <- new_catalog_diagnostic( "semantic_dependency_out_of_scope", diff --git a/R/data-source.R b/R/data-source.R index a86465e..114f96b 100644 --- a/R/data-source.R +++ b/R/data-source.R @@ -271,7 +271,7 @@ new_pending_pins <- function(board, tables) { #' @export list_tables <- function(data_source) { check_data_source(data_source) - data_source$tables + source_tables(data_source) } source_runtime_dictionary <- function(source) { @@ -279,11 +279,27 @@ source_runtime_dictionary <- function(source) { return(source$dictionary) } catalog_to_runtime_dictionary( - source$provider$catalog, - source$relation_labels + source_catalog(source), + source_relation_labels(source) ) } +source_catalog <- function(source) { + source$provider$catalog %||% source$catalog +} + +source_table_ids <- function(source) { + source$provider$table_ids %||% source$table_ids +} + +source_tables <- function(source) { + names(source_table_ids(source)) +} + +source_relation_labels <- function(source) { + source$provider$relation_labels %||% source$relation_labels +} + new_data_source <- function( con, tables, @@ -406,7 +422,7 @@ source_ensure_tables <- function(source, tables, call = rlang::caller_env()) { } source_ensure_all <- function(source, call = rlang::caller_env()) { - source_ensure_tables(source, source$tables, call = call) + source_ensure_tables(source, source_tables(source), call = call) } # Warm the pins on-disk cache in a background process rather than loading into @@ -490,11 +506,11 @@ pending_tables_in_error <- function(source, err) { } source_describe <- function(source, table, n_sample = NULL) { - id <- source$table_ids[[table]] + id <- source_table_ids(source)[[table]] if (is.null(id)) { cli::cli_abort(c( "No table named {.val {table}}.", - i = "Available tables: {.val {source$tables}}." + i = "Available tables: {.val {source_tables(source)}}." )) } source_ensure_tables(source, table) diff --git a/R/definitions.R b/R/definitions.R index d7f1f44..bb74546 100644 --- a/R/definitions.R +++ b/R/definitions.R @@ -174,17 +174,18 @@ definitions_registry <- function(sources, call = rlang::caller_env()) { labels <- rlang::names2(sources) for (i in seq_along(sources)) { source <- sources[[i]] - if (inherits(source$catalog, "commons_catalog")) { + catalog <- source_catalog(source) + if (inherits(catalog, "commons_catalog")) { registry <- catalog_definition_registry( - source$catalog, + catalog, labels[[i]], - source$relation_labels, + source_relation_labels(source), call ) tables <- unique(registry$defs$table[ registry$defs$execution == "data_dictionary" ]) - unknown <- setdiff(tables, source$tables) + unknown <- setdiff(tables, source_tables(source)) if (length(unknown)) { cli::cli_abort( "The data dictionary declares definitions on table{?s} {.val {unknown}}, which the data source does not expose.", @@ -201,7 +202,7 @@ definitions_registry <- function(sources, call = rlang::caller_env()) { if (length(definitions) == 0) { next } - if (!table %in% source$tables) { + if (!table %in% source_tables(source)) { cli::cli_abort( "The data dictionary declares definitions on table {.val {table}}, which the data source does not expose.", diff --git a/R/pool.R b/R/pool.R index 4d58642..5cc9ea0 100644 --- a/R/pool.R +++ b/R/pool.R @@ -49,7 +49,7 @@ call_metrics_impl <- function( on_table <- defs[defs$table == tables, ] columns <- names(source_runtime_dictionary(source)$tables[[tables]]$columns) con <- source$con - id <- DBI::dbQuoteIdentifier(con, source$table_ids[[tables]]) + id <- DBI::dbQuoteIdentifier(con, source_table_ids(source)[[tables]]) dim_names <- strip_token_braces(dimensions %||% character()) dims <- vapply( @@ -133,6 +133,9 @@ catalog_model_access <- function(source, model_id, state, evidence) { relation <- source$provider$catalog$relations[[relation_id]] relation$access <- new_catalog_access(state, evidence) source$provider$catalog$relations[[relation_id]] <- relation + if (identical(state, "visible_only")) { + catalog_provider_drop_relation(source$provider, relation_id) + } } invisible(source) } diff --git a/R/tools.R b/R/tools.R index faf3efb..4a53e1a 100644 --- a/R/tools.R +++ b/R/tools.R @@ -549,7 +549,7 @@ run_sql_tool <- function( # appends a harmless note. dictionary_sql_entries <- function(source, sql, source_name, tracker) { dictionary <- source_runtime_dictionary(source) - tables <- source$tables + tables <- source_tables(source) hits <- tables[vapply( tables, function(table) grepl(word_pattern(table), sql, ignore.case = TRUE), @@ -587,7 +587,8 @@ catalog_first_touch_text <- function(source, table) { if (!inherits(catalog, "commons_catalog")) { return(character()) } - relation_ids <- names(source$relation_labels)[source$relation_labels == table] + labels <- source_relation_labels(source) + relation_ids <- names(labels)[labels == table] if (length(relation_ids) == 0) { return(character()) } diff --git a/tests/testthat/_snaps/data-source.md b/tests/testthat/_snaps/data-source.md index 958978d..cc140ae 100644 --- a/tests/testthat/_snaps/data-source.md +++ b/tests/testthat/_snaps/data-source.md @@ -23,6 +23,34 @@ Error in `source_query()`: ! The connection identity, role, or current namespace changed after catalog discovery; rebuild the data source. +# failed lazy hydration removes the object for the session + + Code + source_describe(fixture$source, "warehouse_object") + Condition + Error in `source_describe()`: + ! Table "warehouse_object" could not be described. + Caused by error in `catalog_relation_metadata()`: + ! permission denied + +--- + + Code + source_describe(fixture$source, "warehouse_object") + Condition + Error in `source_describe()`: + ! No table named "warehouse_object". + i Available tables: . + +# catalog providers reject selections above their object bound + + Code + new_catalog_provider(con, data_source_options()) + Condition + Error: + ! The data-source selection resolves to 2 objects, above the supported limit of 1. + i Narrow `include` to fewer catalog or schema prefixes. + # default connection discovery stays in the current namespace Code @@ -47,6 +75,15 @@ i Context: rapi_prepare i Error type: CATALOG +# tables and options cannot be supplied together + + Code + data_source(orders = data.frame(id = 1), tables = "orders", options = data_source_options( + include = "orders")) + Condition + Error in `data_source()`: + ! Supply only one of `options` and the deprecated `tables`. + # data_source rejects a board label colliding with a built-in relation Code diff --git a/tests/testthat/_snaps/pool.md b/tests/testthat/_snaps/pool.md new file mode 100644 index 0000000..c666a2a --- /dev/null +++ b/tests/testthat/_snaps/pool.md @@ -0,0 +1,8 @@ +# rejected native metrics leave no trusted or callable surface + + Code + call_metrics_impl(registry, list(warehouse = fixture$source), new_handle_store(), + metrics = "record_count") + Condition + Error in `source_query()`: + ! permission denied diff --git a/tests/testthat/helper-catalog-provider.R b/tests/testthat/helper-catalog-provider.R new file mode 100644 index 0000000..bab24e9 --- /dev/null +++ b/tests/testthat/helper-catalog-provider.R @@ -0,0 +1,82 @@ +catalog_provider_test_source <- function(kind = "table") { + con <- DBI::dbConnect(duckdb::duckdb()) + source_record <- new_catalog_source("source:test", "duckdb") + relation <- new_catalog_relation( + "relation:test", + source_record$id, + new_source_path(c(table = "warehouse_object")), + kind = kind + ) + catalog <- new_commons_catalog( + sources = list(source_record), + relations = list(relation) + ) + provider <- new.env(parent = emptyenv()) + provider$con <- con + provider$backend <- "duckdb" + provider$options <- data_source_options() + provider$snapshot <- catalog_connection_snapshot(con, "duckdb") + provider$capabilities <- list(native_semantics = TRUE) + provider$table_ids <- list( + warehouse_object = DBI::Id(table = "warehouse_object") + ) + provider$relation_labels <- c("relation:test" = "warehouse_object") + provider$selection_modes <- c("relation:test" = "namespace") + provider$telemetry <- list() + provider$catalog <- catalog + provider$lazy <- FALSE + source <- new_data_source( + con, + "warehouse_object", + owned = FALSE, + table_ids = provider$table_ids, + catalog = catalog, + provider = provider, + relation_labels = provider$relation_labels + ) + list( + source = source, + provider = provider, + relation = relation, + source_record = source_record, + con = con + ) +} + +catalog_provider_add_metric <- function(fixture, context = NULL) { + model <- new_catalog_model( + "model:test", + fixture$source_record$id, + "warehouse_model", + datasets = fixture$relation$id, + execution = list( + kind = "snowflake_semantic_view", + object = fixture$relation$path + ), + exposed = fixture$relation$id, + dependencies = fixture$relation$id + ) + definition <- new_catalog_definition( + "definition:test", + model$id, + fixture$relation$id, + "metric", + "record_count", + expressions = list(new_catalog_expression("snowflake", "COUNT(*)")), + dependencies = fixture$relation$id + ) + fixture$provider$catalog$models[[model$id]] <- model + fixture$provider$catalog$definitions[[definition$id]] <- definition + if (!is.null(context)) { + record <- new_catalog_context( + "context:test", + fixture$source_record$id, + "instruction", + context, + scope = model$id, + delivery = "retrieval" + ) + fixture$provider$catalog$context[[record$id]] <- record + } + invisible(fixture) +} diff --git a/tests/testthat/test-catalog.R b/tests/testthat/test-catalog.R index 643fa65..dd4f4dd 100644 --- a/tests/testthat/test-catalog.R +++ b/tests/testthat/test-catalog.R @@ -405,7 +405,11 @@ test_that("associated semantic definitions respect physical dependency closure", datasets = c(orders$id, customers$id), execution = list(kind = "snowflake_semantic_view"), exposed = semantic$id, - dependencies = c(orders$id, customers$id) + dependencies = c(orders$id, customers$id), + relationships = list(list( + left_table = "ORDERS", + right_table = "CUSTOMERS" + )) ) kept <- new_catalog_definition( "definition:orders", @@ -439,7 +443,15 @@ test_that("associated semantic definitions respect physical dependency closure", relations = list(orders, customers, semantic), models = list(model), definitions = list(kept, skipped), - calculations = list(calculation) + calculations = list(calculation), + context = list(new_catalog_context( + "context:sales", + catalog_source$id, + "instruction", + "Use customer tiers from the unselected table.", + scope = model$id, + delivery = "retrieval" + )) ) catalog_filter_associated_model(provider, semantic$id) @@ -447,6 +459,8 @@ test_that("associated semantic definitions respect physical dependency closure", expect_equal(names(provider$catalog$definitions), kept$id) expect_length(provider$catalog$calculations, 0) expect_length(provider$catalog$models, 1) + expect_length(provider$catalog$models[[1]]$relationships, 0) + expect_length(provider$catalog$context, 0) expect_equal(provider$catalog$diagnostics[[1]]$code, "semantic_dependency_out_of_scope") registry <- definitions_registry(list(warehouse = list( catalog = provider$catalog, diff --git a/tests/testthat/test-data-source.R b/tests/testthat/test-data-source.R index b5eb4e7..ac6dddc 100644 --- a/tests/testthat/test-data-source.R +++ b/tests/testthat/test-data-source.R @@ -200,6 +200,66 @@ test_that("catalog telemetry covers discovery and hydration", { ))) }) +test_that("lazy semantic hydration reaches runtime definitions and context", { + fixture <- catalog_provider_test_source("semantic_view") + withr::defer(DBI::dbDisconnect(fixture$con, shutdown = TRUE)) + local_mocked_bindings( + catalog_import_relation_semantics = function(provider, relation_id) { + catalog_provider_add_metric(fixture, "Use the governed record count.") + } + ) + + expect_equal(nrow(definitions_registry(list(warehouse = fixture$source))$defs), 0) + source_describe(fixture$source, "warehouse_object") + registry <- definitions_registry(list(warehouse = fixture$source)) + layer <- augment_context_layer(NULL, list(warehouse = fixture$source)) + + expect_equal(registry$defs$name, "record_count") + expect_true("Use the governed record count." %in% layer$docs) + expect_null(names(fixture$source$catalog$definitions)) +}) + +test_that("failed lazy hydration removes the object for the session", { + fixture <- catalog_provider_test_source() + withr::defer(DBI::dbDisconnect(fixture$con, shutdown = TRUE)) + local_mocked_bindings( + catalog_relation_metadata = function(con, id) { + cli::cli_abort("permission denied") + } + ) + + expect_snapshot( + source_describe(fixture$source, "warehouse_object"), + error = TRUE + ) + + expect_length(list_tables(fixture$source), 0) + expect_snapshot( + source_describe(fixture$source, "warehouse_object"), + error = TRUE + ) + expect_equal( + fixture$provider$catalog$diagnostics[[1]]$code, + "catalog_relation_unqueryable" + ) +}) + +test_that("catalog providers reject selections above their object bound", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + local_mocked_bindings( + catalog_object_limit = 1L, + catalog_resolve_selection = function(con, backend, options, call) { + list(DBI::Id(table = "one"), DBI::Id(table = "two")) + } + ) + + expect_snapshot( + new_catalog_provider(con, data_source_options()), + error = TRUE + ) +}) + test_that("connection discovery merges an authored dictionary", { con <- DBI::dbConnect(duckdb::duckdb()) withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) @@ -383,6 +443,36 @@ test_that("data_source defers reading a board's pins until first use", { expect_length(DBI::dbListTables(src$con), 0) }) +test_that("board selections use data_source_options mappings", { + skip_if_not_installed("pins") + board <- board_with_pins( + "team-orders" = data.frame(id = 1:3), + "team-reps" = data.frame(rep = c("Ada", "Bo")) + ) + + src <- data_source( + board, + options = data_source_options( + include = c(orders = "team-orders", reps = "team-reps"), + exclude = "reps" + ) + ) + + expect_equal(list_tables(src), "orders") + expect_equal(names(src$pending$pins), "orders") +}) + +test_that("tables and options cannot be supplied together", { + expect_snapshot( + data_source( + orders = data.frame(id = 1), + tables = "orders", + options = data_source_options(include = "orders") + ), + error = TRUE + ) +}) + test_that("source_describe loads only the table it describes", { skip_if_not_installed("pins") diff --git a/tests/testthat/test-pool.R b/tests/testthat/test-pool.R index 5be533f..dacc632 100644 --- a/tests/testthat/test-pool.R +++ b/tests/testthat/test-pool.R @@ -36,6 +36,59 @@ test_that("call_metrics without dimensions returns a grand total", { expect_equal(get_handle(store, "r1")$big_revenue, 1950) }) +test_that("native metrics become trusted only after successful execution", { + fixture <- catalog_provider_test_source("semantic_view") + withr::defer(DBI::dbDisconnect(fixture$con, shutdown = TRUE)) + catalog_provider_add_metric(fixture) + registry <- definitions_registry(list(warehouse = fixture$source)) + local_mocked_bindings( + source_query = function(source, sql) data.frame(record_count = 3) + ) + + result <- call_metrics_impl( + registry, + list(warehouse = fixture$source), + new_handle_store(), + metrics = "record_count" + ) + + expect_equal(result@extra$commons_tag, "A") + expect_equal( + fixture$provider$catalog$models[["model:test"]]$access$state, + "queryable" + ) +}) + +test_that("rejected native metrics leave no trusted or callable surface", { + fixture <- catalog_provider_test_source("semantic_view") + withr::defer(DBI::dbDisconnect(fixture$con, shutdown = TRUE)) + catalog_provider_add_metric(fixture) + registry <- definitions_registry(list(warehouse = fixture$source)) + local_mocked_bindings( + source_query = function(source, sql) cli::cli_abort("permission denied") + ) + + expect_snapshot( + call_metrics_impl( + registry, + list(warehouse = fixture$source), + new_handle_store(), + metrics = "record_count" + ), + error = TRUE + ) + + expect_equal( + fixture$provider$catalog$models[["model:test"]]$access$state, + "visible_only" + ) + expect_length(list_tables(fixture$source), 0) + expect_equal( + nrow(definitions_registry(list(warehouse = fixture$source))$defs), + 0 + ) +}) + test_that("names arriving in token braces are accepted", { store <- new_handle_store() metrics_caller(store = store)( From 846092cd814a0aa4b5fd1def3b4988c46b63b2fc Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 12:45:01 -0500 Subject: [PATCH 10/25] tighten catalog interchange boundaries --- R/catalog-ossie.R | 6 ++- R/catalog-provider.R | 3 +- R/data-source-options.R | 9 +++- R/data-source.R | 26 ++++++++++ man/write_ossie.Rd | 5 +- tests/testthat/_snaps/catalog-ossie.md | 8 +++ tests/testthat/_snaps/data-source.md | 8 +++ tests/testthat/helper-catalog-provider.R | 26 +++++++++- tests/testthat/test-catalog-ossie.R | 12 +++++ tests/testthat/test-data-source.R | 66 ++++++++++++++++++++++++ vignettes/database-catalogs.Rmd | 3 +- 11 files changed, 165 insertions(+), 7 deletions(-) diff --git a/R/catalog-ossie.R b/R/catalog-ossie.R index 8039721..c54bdf8 100644 --- a/R/catalog-ossie.R +++ b/R/catalog-ossie.R @@ -14,10 +14,12 @@ ossie_model <- function(path) { #' @param x A commons data source or an object returned by [ossie_model()]. #' @param path A destination ending in `.yaml`, `.yml`, or `.json`. #' @param overwrite Whether to replace an existing file. +#' @param version Apache Ossie version to write. `NULL` preserves an imported +#' model's version and otherwise writes the current commons default. #' #' @return The export diagnostics, invisibly. #' @export -write_ossie <- function(x, path, overwrite = FALSE) { +write_ossie <- function(x, path, overwrite = FALSE, version = NULL) { catalog <- if (inherits(x, "commons_data_source")) { x$provider$catalog %||% x$catalog } else { @@ -34,7 +36,7 @@ write_ossie <- function(x, path, overwrite = FALSE) { if (file.exists(path) && !isTRUE(overwrite)) { cli::cli_abort("File {.path {path}} already exists; set {.arg overwrite} to true to replace it.") } - exported <- catalog_to_ossie(catalog) + exported <- catalog_to_ossie(catalog, version = version) if (grepl("\\.json$", path, ignore.case = TRUE)) { jsonlite::write_json( exported$document, diff --git a/R/catalog-provider.R b/R/catalog-provider.R index 8a1dda2..01c8ecd 100644 --- a/R/catalog-provider.R +++ b/R/catalog-provider.R @@ -384,7 +384,8 @@ catalog_provider_hydrate <- function(provider, table, call = rlang::caller_env() if (semantic_model) { definitions <- Filter( function(x) identical(x$relation_id, relation$id) && - identical(x$visibility, "public"), + identical(x$visibility, "public") && + x$role %in% c("dimension", "time_dimension", "fact"), provider$catalog$definitions ) relation$columns <- lapply(definitions, function(definition) { diff --git a/R/data-source-options.R b/R/data-source-options.R index 210b88a..751fe20 100644 --- a/R/data-source-options.R +++ b/R/data-source-options.R @@ -123,7 +123,14 @@ select_flat_names <- function(names, options, call = rlang::caller_env()) { if (length(missing)) { cli::cli_abort("{.arg include} names unknown object{?s}: {.val {missing}}.", call = call) } - include[!catalog_excluded(unname(include), options$exclude)] + selected <- include[!catalog_excluded(unname(include), options$exclude)] + if (length(selected) == 0) { + cli::cli_abort( + "The resolved flat-source selection contains no objects.", + call = call + ) + } + selected } catalog_excluded <- function(names, patterns) { diff --git a/R/data-source.R b/R/data-source.R index 114f96b..3d45b87 100644 --- a/R/data-source.R +++ b/R/data-source.R @@ -125,6 +125,7 @@ data_source_frames <- function( check_named_frames(dots, call = call) selected <- select_flat_names(names(dots), options, call) dots <- dots[selected] + dictionary <- catalog_scope_flat_authored(dictionary, names(dots), "frames") local_commons_span( "commons_data_source_load_frames", attributes = list("commons.data_source.n_tables" = length(dots)) @@ -232,6 +233,7 @@ data_source_board <- function( attributes = list("commons.data_source.n_tables" = length(tables)) ) check_board_pins_exist(board, tables, call = call) + dictionary <- catalog_scope_flat_authored(dictionary, names(tables), "board") # Lock the connection down before any writes; lock_configuration() only # freezes SET statements, so later dbWriteTable() from a deferred read still @@ -300,6 +302,30 @@ source_relation_labels <- function(source) { source$provider$relation_labels %||% source$relation_labels } +catalog_scope_flat_authored <- function(metadata, tables, kind) { + authored <- catalog_from_authored_metadata(metadata) + if (length(authored$sources) == 0) { + return(authored) + } + source <- new_catalog_source( + catalog_id("source", kind, "selection"), + kind + ) + relations <- lapply(tables, function(table) { + new_catalog_relation( + catalog_id("relation", source$id, table), + source$id, + new_source_path(c(table = table)), + name = table + ) + }) + discovered <- new_commons_catalog( + sources = list(source), + relations = relations + ) + catalog_scope_authored(authored, discovered) +} + new_data_source <- function( con, tables, diff --git a/man/write_ossie.Rd b/man/write_ossie.Rd index 9b2a4aa..12b2d62 100644 --- a/man/write_ossie.Rd +++ b/man/write_ossie.Rd @@ -4,7 +4,7 @@ \alias{write_ossie} \title{Write an Apache Ossie semantic model} \usage{ -write_ossie(x, path, overwrite = FALSE) +write_ossie(x, path, overwrite = FALSE, version = NULL) } \arguments{ \item{x}{A commons data source or an object returned by \code{\link[=ossie_model]{ossie_model()}}.} @@ -12,6 +12,9 @@ write_ossie(x, path, overwrite = FALSE) \item{path}{A destination ending in \code{.yaml}, \code{.yml}, or \code{.json}.} \item{overwrite}{Whether to replace an existing file.} + +\item{version}{Apache Ossie version to write. \code{NULL} preserves an imported +model's version and otherwise writes the current commons default.} } \value{ The export diagnostics, invisibly. diff --git a/tests/testthat/_snaps/catalog-ossie.md b/tests/testthat/_snaps/catalog-ossie.md index 72ee980..6aff6e4 100644 --- a/tests/testthat/_snaps/catalog-ossie.md +++ b/tests/testthat/_snaps/catalog-ossie.md @@ -1,3 +1,11 @@ +# Apache Ossie export version is selectable + + Code + write_ossie(model, path, overwrite = TRUE, version = "9.9") + Condition + Error in `write_ossie()`: + ! Apache Ossie version "9.9" is not supported. + # Apache Ossie versions and relationship references fail closed Code diff --git a/tests/testthat/_snaps/data-source.md b/tests/testthat/_snaps/data-source.md index cc140ae..53e0ae9 100644 --- a/tests/testthat/_snaps/data-source.md +++ b/tests/testthat/_snaps/data-source.md @@ -7,6 +7,14 @@ ! No table named "nope". i Available tables: "sales". +# flat selections cannot resolve to no objects + + Code + data_source(orders = data.frame(id = 1), options = data_source_options(exclude = "*")) + Condition + Error in `data_source()`: + ! The resolved flat-source selection contains no objects. + # DBI identifiers remain exact rather than patterns Code diff --git a/tests/testthat/helper-catalog-provider.R b/tests/testthat/helper-catalog-provider.R index bab24e9..1ef2537 100644 --- a/tests/testthat/helper-catalog-provider.R +++ b/tests/testthat/helper-catalog-provider.R @@ -43,7 +43,7 @@ catalog_provider_test_source <- function(kind = "table") { ) } -catalog_provider_add_metric <- function(fixture, context = NULL) { +catalog_provider_add_metric <- function(fixture, context = NULL, fields = FALSE) { model <- new_catalog_model( "model:test", fixture$source_record$id, @@ -67,6 +67,30 @@ catalog_provider_add_metric <- function(fixture, context = NULL) { ) fixture$provider$catalog$models[[model$id]] <- model fixture$provider$catalog$definitions[[definition$id]] <- definition + if (isTRUE(fields)) { + definitions <- list( + new_catalog_definition( + "definition:dimension", + model$id, + fixture$relation$id, + "dimension", + "region", + expressions = list(new_catalog_expression("snowflake", "region")) + ), + new_catalog_definition( + "definition:filter", + model$id, + fixture$relation$id, + "filter", + "current_records", + expressions = list(new_catalog_expression("snowflake", "is_current")) + ) + ) + fixture$provider$catalog$definitions <- c( + fixture$provider$catalog$definitions, + stats::setNames(definitions, vapply(definitions, `[[`, character(1), "id")) + ) + } if (!is.null(context)) { record <- new_catalog_context( "context:test", diff --git a/tests/testthat/test-catalog-ossie.R b/tests/testthat/test-catalog-ossie.R index 5ecc6cd..69aed0b 100644 --- a/tests/testthat/test-catalog-ossie.R +++ b/tests/testthat/test-catalog-ossie.R @@ -147,6 +147,18 @@ test_that("Apache Ossie models write to YAML and JSON", { expect_invisible(write_ossie(model, yaml_path, overwrite = TRUE)) }) +test_that("Apache Ossie export version is selectable", { + model <- ossie_model(test_path("fixtures", "ossie-databricks.yaml")) + path <- withr::local_tempfile(fileext = ".yaml") + + expect_invisible(write_ossie(model, path, version = "0.1.1")) + expect_equal(yaml::read_yaml(path)$version, "0.1.1") + expect_snapshot( + write_ossie(model, path, overwrite = TRUE, version = "9.9"), + error = TRUE + ) +}) + test_that("Snowflake Ossie extensions retain native payloads", { document <- list( version = "0.1.1", diff --git a/tests/testthat/test-data-source.R b/tests/testthat/test-data-source.R index ac6dddc..eb02269 100644 --- a/tests/testthat/test-data-source.R +++ b/tests/testthat/test-data-source.R @@ -126,6 +126,54 @@ test_that("data_source_options applies to flat data sources", { expect_equal(list_tables(src), "orders") }) +test_that("flat selections also scope authored metadata", { + dictionary <- new_data_dictionary(list( + description = "Company-wide guidance.", + tables = list( + orders = list( + description = "Selected orders.", + definitions = list(order_count = list( + expr = "COUNT(*)", + type = "number" + )) + ), + secret = list( + description = "Unselected secrets.", + definitions = list(secret_count = list( + expr = "COUNT(*)", + type = "number" + )) + ) + ) + )) + + source <- data_source( + orders = data.frame(id = 1), + secret = data.frame(id = 2), + dictionary = dictionary, + options = data_source_options(include = "orders") + ) + context <- vapply(source$catalog$context, `[[`, character(1), "text") + + expect_equal(names(source$dictionary$tables), "orders") + expect_equal( + definitions_registry(list(warehouse = source))$defs$name, + "order_count" + ) + expect_false(any(grepl("secret", context, ignore.case = TRUE))) + expect_true(any(grepl("Company-wide", context, fixed = TRUE))) +}) + +test_that("flat selections cannot resolve to no objects", { + expect_snapshot( + data_source( + orders = data.frame(id = 1), + options = data_source_options(exclude = "*") + ), + error = TRUE + ) +}) + test_that("DBI identifiers remain exact rather than patterns", { expect_snapshot( normalize_connection_includes(DBI::Id(table = "orders*")), @@ -219,6 +267,24 @@ test_that("lazy semantic hydration reaches runtime definitions and context", { expect_null(names(fixture$source$catalog$definitions)) }) +test_that("semantic hydration describes fields rather than calculations", { + fixture <- catalog_provider_test_source("semantic_view") + withr::defer(DBI::dbDisconnect(fixture$con, shutdown = TRUE)) + local_mocked_bindings( + catalog_import_relation_semantics = function(provider, relation_id) { + catalog_provider_add_metric(fixture, fields = TRUE) + } + ) + + described <- source_describe(fixture$source, "warehouse_object") + + expect_equal(described$schema$column, "region") + expect_setequal( + definitions_registry(list(warehouse = fixture$source))$defs$name, + c("record_count", "region", "current_records") + ) +}) + test_that("failed lazy hydration removes the object for the session", { fixture <- catalog_provider_test_source() withr::defer(DBI::dbDisconnect(fixture$con, shutdown = TRUE)) diff --git a/vignettes/database-catalogs.Rmd b/vignettes/database-catalogs.Rmd index 11b9d09..3de2b03 100644 --- a/vignettes/database-catalogs.Rmd +++ b/vignettes/database-catalogs.Rmd @@ -155,7 +155,8 @@ diagnostics <- write_ossie(source, "merged-semantic-model.yaml") ``` `write_ossie()` returns diagnostics for catalog constructs that Ossie cannot -represent directly. Set `overwrite = TRUE` to replace an existing file. +represent directly. Set `version = "0.1.1"` when targeting Snowflake's current +Ossie import boundary. Set `overwrite = TRUE` to replace an existing file. `tables` is deprecated. The mechanical migration is: From 2f5476a4a2280d7293c04316d62b70ee79741dcf Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 12:49:40 -0500 Subject: [PATCH 11/25] resolve relative warehouse semantics --- R/catalog-provider.R | 56 ++++++++++++++++++++++++- R/pool.R | 27 ++++++++---- tests/testthat/_snaps/data-source.md | 9 ++++ tests/testthat/_snaps/pool.md | 1 + tests/testthat/test-catalog-snowflake.R | 37 ++++++++++++++++ tests/testthat/test-data-source.R | 38 ++++++++++++++++- 6 files changed, 157 insertions(+), 11 deletions(-) diff --git a/R/catalog-provider.R b/R/catalog-provider.R index 01c8ecd..6f434da 100644 --- a/R/catalog-provider.R +++ b/R/catalog-provider.R @@ -10,7 +10,7 @@ new_catalog_provider <- function(con, options, call = rlang::caller_env()) { snapshot$principal %||% "unknown", paste(unlist(snapshot$namespace), collapse = ".") ) - ids <- catalog_resolve_selection(con, backend, options, call) + ids <- catalog_resolve_selection(con, backend, snapshot, options, call) if (length(ids) > catalog_object_limit) { cli::cli_abort(c( "The data-source selection resolves to {length(ids)} objects, above the supported limit of {catalog_object_limit}.", @@ -188,7 +188,7 @@ catalog_provider_check <- function(provider, call = rlang::caller_env()) { invisible(provider) } -catalog_resolve_selection <- function(con, backend, options, call) { +catalog_resolve_selection <- function(con, backend, snapshot, options, call) { includes <- normalize_connection_includes(options$include, call) if (is.null(includes)) { objects <- catalog_default_objects(con, backend, call) @@ -197,6 +197,12 @@ catalog_resolve_selection <- function(con, backend, options, call) { objects <- list() for (include in includes) { + include <- catalog_complete_connection_id( + include, + backend, + snapshot, + call + ) if ("table" %in% names(include@name)) { objects[[length(objects) + 1]] <- catalog_selection_id(include, "exact") } else { @@ -208,6 +214,52 @@ catalog_resolve_selection <- function(con, backend, options, call) { objects } +catalog_complete_connection_id <- function(id, backend, snapshot, call) { + if (!backend %in% c("snowflake", "databricks")) { + return(id) + } + components <- as.list(id@name) + top_roles <- intersect(c("catalog", "database"), names(components)) + if (length(top_roles) > 1) { + cli::cli_abort( + "A {.cls DBI::Id} cannot contain both {.field catalog} and {.field database}.", + call = call + ) + } + current_top <- snapshot$namespace$catalog %||% + snapshot$namespace$database + if ("schema" %in% names(components) && length(top_roles) == 0) { + if (is.null(current_top)) { + cli::cli_abort( + "A relative {.cls DBI::Id} needs a current catalog/database or an explicit {.field catalog} component.", + call = call + ) + } + components <- c(list(catalog = current_top), components) + top_roles <- "catalog" + } + if ("table" %in% names(components) && !"schema" %in% names(components)) { + if (length(top_roles)) { + cli::cli_abort( + "A {.cls DBI::Id} with a catalog/database and table must also contain a {.field schema}.", + call = call + ) + } + current_schema <- snapshot$namespace$schema + if (is.null(current_top) || is.null(current_schema)) { + cli::cli_abort( + "A relative table {.cls DBI::Id} needs a current catalog/database and schema.", + call = call + ) + } + components <- c( + list(catalog = current_top, schema = current_schema), + components + ) + } + do.call(DBI::Id, components) +} + catalog_selection_id <- function(id, mode) { attr(id, "commons_selection") <- mode id diff --git a/R/pool.R b/R/pool.R index 5cc9ea0..dec36be 100644 --- a/R/pool.R +++ b/R/pool.R @@ -214,7 +214,7 @@ snowflake_metric_sql <- function( dimension_defs <- resolve_pool_names( dimensions, defs, - role = "dimension" + role = c("dimension", "time_dimension") ) filter_defs <- resolve_pool_names(filters, defs, role = "filter") parts <- c( @@ -345,7 +345,7 @@ databricks_metric_sql <- function( dimension_defs <- resolve_pool_names( dimensions, defs, - role = "dimension" + role = c("dimension", "time_dimension") ) dimension_names <- vapply( dimension_defs$name, @@ -481,7 +481,11 @@ native_where_conditions <- function(where, defs, con) { if (!triple$op %in% where_ops) { cli::cli_abort("{.arg where} operator must be one of {.val {where_ops}}.") } - dimension <- resolve_pool_name(triple$column, defs, "dimension") + dimension <- resolve_pool_name( + triple$column, + defs, + c("dimension", "time_dimension", "fact") + ) reference <- native_definition_references(dimension, con) value <- if (grepl("^-?[0-9]+(\\.[0-9]+)?$", triple$value)) { triple$value @@ -546,21 +550,28 @@ resolve_pool_names <- function(names, defs, role) { resolve_pool_name <- function(name, defs, role) { named <- defs[defs$name == name, ] - matched <- named[which(named$role == role), ] + matched <- named[which(named$role %in% role), ] if (nrow(matched)) { return(matched[1, ]) } + role_label <- paste(role, collapse = ", ") + expected <- if (length(role) == 1) { + paste("a", role) + } else { + paste("one of", role_label) + } if (nrow(named)) { cli::cli_abort( - "{.val {name}} is a {named$role[[1]]}, not a {role}; apply it as + "{.val {name}} is a {named$role[[1]]}, not {expected}; apply it as {.code {{{{{name}}}}}} in SQL instead." ) } - available <- defs$name[which(defs$role == role)] + available <- defs$name[which(defs$role %in% role)] + governed <- if (length(role) == 1) role else role_label cli::cli_abort( c( - "No governed {role} is named {.val {name}}.", - i = "Available {role}s: {.val {available}}." + "No governed {governed} is named {.val {name}}.", + i = "Available values: {.val {available}}." ) ) } diff --git a/tests/testthat/_snaps/data-source.md b/tests/testthat/_snaps/data-source.md index 53e0ae9..f73a984 100644 --- a/tests/testthat/_snaps/data-source.md +++ b/tests/testthat/_snaps/data-source.md @@ -7,6 +7,15 @@ ! No table named "nope". i Available tables: "sales". +# warehouse IDs resolve against the current namespace + + Code + catalog_complete_connection_id(DBI::Id(catalog = "ANALYTICS", table = "ORDERS"), + "snowflake", snapshot, call) + Condition + Error: + ! A with a catalog/database and table must also contain a schema. + # flat selections cannot resolve to no objects Code diff --git a/tests/testthat/_snaps/pool.md b/tests/testthat/_snaps/pool.md index c666a2a..2639675 100644 --- a/tests/testthat/_snaps/pool.md +++ b/tests/testthat/_snaps/pool.md @@ -6,3 +6,4 @@ Condition Error in `source_query()`: ! permission denied + diff --git a/tests/testthat/test-catalog-snowflake.R b/tests/testthat/test-catalog-snowflake.R index 9c0635b..60b43ea 100644 --- a/tests/testthat/test-catalog-snowflake.R +++ b/tests/testthat/test-catalog-snowflake.R @@ -186,6 +186,43 @@ test_that("Snowflake metrics compile through SEMANTIC_VIEW", { expect_match(sql, "ORDERS.REVENUE", fixed = TRUE) }) +test_that("Snowflake native queries accept time dimensions and facts", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + path <- new_source_path( + c("ANALYTICS", "PUBLIC", "SALES_MODEL"), + c("catalog", "schema", "table") + ) + provider <- new.env(parent = emptyenv()) + provider$catalog <- new_commons_catalog() + provider$catalog$models[["model:sales"]] <- new_catalog_model( + "model:sales", + "source:test", + "SALES_MODEL", + execution = list(kind = "snowflake_semantic_view", object = path) + ) + source <- list(con = con, provider = provider) + defs <- data.frame( + name = c("REVENUE", "ORDER_DATE", "ORDER_TOTAL"), + role = c("metric", "time_dimension", "fact"), + native_parent = rep("ORDERS", 3), + stringsAsFactors = FALSE + ) + + sql <- snowflake_metric_sql( + source, + "model:sales", + defs[1, , drop = FALSE], + defs, + dimensions = "ORDER_DATE", + filters = NULL, + where = list(list(column = "ORDER_TOTAL", op = ">", value = "10")) + ) + + expect_match(sql, "ORDERS.ORDER_DATE", fixed = TRUE) + expect_match(sql, "ORDERS.ORDER_TOTAL", fixed = TRUE) +}) + test_that("Snowflake masking metadata marks restricted columns", { row <- data.frame( check.names = FALSE, diff --git a/tests/testthat/test-data-source.R b/tests/testthat/test-data-source.R index eb02269..f9a9f9c 100644 --- a/tests/testthat/test-data-source.R +++ b/tests/testthat/test-data-source.R @@ -112,6 +112,42 @@ test_that("data_source_options selects exact objects and namespace prefixes", { expect_equal(source_describe(literal, "literal.dot")$schema$column, "id") }) +test_that("warehouse IDs resolve against the current namespace", { + snapshot <- list(namespace = list(catalog = "ANALYTICS", schema = "PUBLIC")) + call <- rlang::caller_env() + + table <- catalog_complete_connection_id( + DBI::Id(table = "ORDERS"), + "snowflake", + snapshot, + call + ) + schema_table <- catalog_complete_connection_id( + DBI::Id(schema = "FINANCE", table = "LEDGER"), + "databricks", + snapshot, + call + ) + + expect_equal( + table@name, + c(catalog = "ANALYTICS", schema = "PUBLIC", table = "ORDERS") + ) + expect_equal( + schema_table@name, + c(catalog = "ANALYTICS", schema = "FINANCE", table = "LEDGER") + ) + expect_snapshot( + catalog_complete_connection_id( + DBI::Id(catalog = "ANALYTICS", table = "ORDERS"), + "snowflake", + snapshot, + call + ), + error = TRUE + ) +}) + test_that("data_source_options applies to flat data sources", { src <- data_source( orders = data.frame(id = 1), @@ -315,7 +351,7 @@ test_that("catalog providers reject selections above their object bound", { withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) local_mocked_bindings( catalog_object_limit = 1L, - catalog_resolve_selection = function(con, backend, options, call) { + catalog_resolve_selection = function(con, backend, snapshot, options, call) { list(DBI::Id(table = "one"), DBI::Id(table = "two")) } ) From 8feb07ee42cb5d454846f646904ff8b96dddf84c Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 12:52:22 -0500 Subject: [PATCH 12/25] confine catalog search scope --- R/catalog-provider.R | 10 +++++++++- R/tools.R | 2 +- tests/testthat/test-data-source.R | 21 +++++++++++++++++++++ 3 files changed, 31 insertions(+), 2 deletions(-) diff --git a/R/catalog-provider.R b/R/catalog-provider.R index 6f434da..bebdd82 100644 --- a/R/catalog-provider.R +++ b/R/catalog-provider.R @@ -658,7 +658,7 @@ catalog_relation_metadata <- function(con, id) { catalog_provider_search <- function(provider, query, kinds = NULL, limit = 10L) { catalog_provider_check(provider) - relations <- provider$catalog$relations + relations <- provider$catalog$relations[names(provider$relation_labels)] if (!is.null(kinds)) { relations <- Filter(function(x) x$kind %in% kinds, relations) } @@ -670,6 +670,9 @@ catalog_provider_search <- function(provider, query, kinds = NULL, limit = 10L) return(relations) } query_terms <- catalog_search_terms(query) + if (length(query_terms) == 0) { + return(list()) + } scores <- vapply(relations, function(relation) { text <- paste( relation$name, @@ -684,6 +687,11 @@ catalog_provider_search <- function(provider, query, kinds = NULL, limit = 10L) tolower(text) )) }, numeric(1)) + relations <- relations[scores > 0] + scores <- scores[scores > 0] + if (length(relations) == 0) { + return(relations) + } order <- order(scores, decreasing = TRUE) relations[utils::head(order, limit)] } diff --git a/R/tools.R b/R/tools.R index 4a53e1a..6588ad1 100644 --- a/R/tools.R +++ b/R/tools.R @@ -50,7 +50,7 @@ tool_search_catalog <- function(private) { results <- catalog_provider_search(src$provider, query, kinds) body <- if (length(results)) { paste(vapply(results, function(relation) { - label <- src$relation_labels[[relation$id]] %||% relation$name + label <- source_relation_labels(src)[[relation$id]] %||% relation$name summary <- relation$description %||% relation$label %||% "No description." sprintf("- `%s` (%s): %s", label, relation$kind, summary) }, character(1)), collapse = "\n") diff --git a/tests/testthat/test-data-source.R b/tests/testthat/test-data-source.R index f9a9f9c..c84f0aa 100644 --- a/tests/testthat/test-data-source.R +++ b/tests/testthat/test-data-source.R @@ -284,6 +284,27 @@ test_that("catalog telemetry covers discovery and hydration", { ))) }) +test_that("catalog search exposes only relevant selected objects", { + fixture <- catalog_provider_test_source() + withr::defer(DBI::dbDisconnect(fixture$con, shutdown = TRUE)) + fixture$provider$catalog$relations[[fixture$relation$id]]$description <- + "Public order activity." + internal <- new_catalog_relation( + "relation:internal", + fixture$source_record$id, + new_source_path(c(table = "internal_customers")), + description = "Secret customer details." + ) + fixture$provider$catalog$relations[[internal$id]] <- internal + + expect_equal( + names(catalog_provider_search(fixture$provider, "order")), + fixture$relation$id + ) + expect_length(catalog_provider_search(fixture$provider, "secret"), 0) + expect_length(catalog_provider_search(fixture$provider, ""), 0) +}) + test_that("lazy semantic hydration reaches runtime definitions and context", { fixture <- catalog_provider_test_source("semantic_view") withr::defer(DBI::dbDisconnect(fixture$con, shutdown = TRUE)) From 2abbd32898beaf435d001e1f6996fe93557d3c9f Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 12:52:58 -0500 Subject: [PATCH 13/25] deduplicate refreshed catalog context --- R/context-layer.R | 14 +++++++++++++- tests/testthat/test-context-layer.R | 10 ++++++++++ 2 files changed, 23 insertions(+), 1 deletion(-) diff --git a/R/context-layer.R b/R/context-layer.R index cdcae4d..126ab83 100644 --- a/R/context-layer.R +++ b/R/context-layer.R @@ -137,12 +137,24 @@ context_layer_merge <- function( metadata <- c(metadata, list(new_metadata[[i]])) } else { sources[[hit]] <- unique(c(sources[[hit]], new_sources[[i]])) - metadata[[hit]] <- c(metadata[[hit]], new_metadata[[i]]) + metadata[[hit]] <- context_metadata_merge( + metadata[[hit]], + new_metadata[[i]] + ) } } new_context_layer(docs, sources, metadata) } +context_metadata_merge <- function(x, y) { + for (item in y) { + if (!any(vapply(x, identical, logical(1), item))) { + x[[length(x) + 1]] <- item + } + } + x +} + dictionary_context_chunks <- function(dictionary) { if (is.null(dictionary)) { return(character(0)) diff --git a/tests/testthat/test-context-layer.R b/tests/testthat/test-context-layer.R index 9d517fd..9db2f18 100644 --- a/tests/testthat/test-context-layer.R +++ b/tests/testthat/test-context-layer.R @@ -106,6 +106,16 @@ test_that("merged context deduplicates text without losing source metadata", { expect_length(layer$docs, 1) expect_setequal(layer$sources[[1]], c("alpha", "beta")) expect_length(layer$metadata[[1]], 2) + + refreshed <- context_layer_merge( + layer$docs, + layer$sources, + layer$metadata, + "Revenue excludes tax.", + list("beta"), + list(list(list(id = "context:beta"))) + ) + expect_length(refreshed$metadata[[1]], 2) }) test_that("evaluation-only catalog context never enters retrieval", { From 9331b6f6f922c98a5d387763d8e4a7dd74b8bace Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 12:54:40 -0500 Subject: [PATCH 14/25] invalidate stale catalog authority --- R/commons.R | 2 ++ R/context-layer.R | 2 +- R/data-source.R | 16 ++++++++++++++++ R/tools.R | 4 +++- tests/testthat/test-data-source.R | 5 +++++ 5 files changed, 27 insertions(+), 2 deletions(-) diff --git a/R/commons.R b/R/commons.R index fd011d4..4abc5ce 100644 --- a/R/commons.R +++ b/R/commons.R @@ -253,6 +253,7 @@ Commons <- R6::R6Class( }, chat = function(..., echo = NULL) { + catalog_sources_check(private$sources) if (private$tracing) { local_conversation_turn_span(private$conversation_id) } @@ -265,6 +266,7 @@ Commons <- R6::R6Class( stream = c("text", "content"), controller = NULL ) { + catalog_sources_check(private$sources) stream <- super$stream_async( ..., tool_mode = tool_mode, diff --git a/R/context-layer.R b/R/context-layer.R index 126ab83..eb12fb9 100644 --- a/R/context-layer.R +++ b/R/context-layer.R @@ -55,7 +55,7 @@ augment_context_layer <- function(context_layer, sources) { label <- labels[[i]] dictionary <- source_runtime_dictionary(source) dictionary_chunks <- dictionary_context_chunks(dictionary) - catalog <- source$provider$catalog %||% source$catalog + catalog <- source_catalog(source) records <- if (inherits(catalog, "commons_catalog")) { Filter( function(record) identical(record$delivery, "retrieval"), diff --git a/R/data-source.R b/R/data-source.R index 3d45b87..1afaf30 100644 --- a/R/data-source.R +++ b/R/data-source.R @@ -287,10 +287,12 @@ source_runtime_dictionary <- function(source) { } source_catalog <- function(source) { + source_provider_check(source) source$provider$catalog %||% source$catalog } source_table_ids <- function(source) { + source_provider_check(source) source$provider$table_ids %||% source$table_ids } @@ -302,6 +304,20 @@ source_relation_labels <- function(source) { source$provider$relation_labels %||% source$relation_labels } +source_provider_check <- function(source, call = rlang::caller_env()) { + if (!is.null(source$provider)) { + catalog_provider_check(source$provider, call) + } + invisible(source) +} + +catalog_sources_check <- function(sources, call = rlang::caller_env()) { + for (source in sources) { + source_provider_check(source, call) + } + invisible(sources) +} + catalog_scope_flat_authored <- function(metadata, tables, kind) { authored <- catalog_from_authored_metadata(metadata) if (length(authored$sources) == 0) { diff --git a/R/tools.R b/R/tools.R index 6588ad1..f302834 100644 --- a/R/tools.R +++ b/R/tools.R @@ -256,6 +256,7 @@ tool_call_calculation <- function(private) { tool_call_measure <- function(private) { ellmer::tool( function(name, arguments = "{}") { + catalog_sources_check(private$sources) call_measure_tool( private$registry, name, @@ -286,6 +287,7 @@ tool_call_measure <- function(private) { tool_search_context <- function(private) { ellmer::tool( function(query, source = NULL) { + catalog_sources_check(private$sources) search_context_tool(private$context_layer, query, source) }, "Search context for metric definitions, data notes, and table relationships.", @@ -583,7 +585,7 @@ dictionary_sql_entries <- function(source, sql, source_name, tracker) { } catalog_first_touch_text <- function(source, table) { - catalog <- source$provider$catalog %||% source$catalog + catalog <- source_catalog(source) if (!inherits(catalog, "commons_catalog")) { return(character()) } diff --git a/tests/testthat/test-data-source.R b/tests/testthat/test-data-source.R index c84f0aa..1f9b4b8 100644 --- a/tests/testthat/test-data-source.R +++ b/tests/testthat/test-data-source.R @@ -257,6 +257,11 @@ test_that("provider identity is checked before every query", { source$provider$snapshot$principal <- "different-principal" expect_snapshot(source_query(source, "SELECT * FROM orders"), error = TRUE) + expect_error(list_tables(source), "identity, role, or current namespace changed") + expect_error( + definitions_registry(list(warehouse = source)), + "identity, role, or current namespace changed" + ) }) test_that("catalog telemetry covers discovery and hydration", { From 751f755d43978761a7ab1b7318c2508acd5272b5 Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 12:56:31 -0500 Subject: [PATCH 15/25] disambiguate governed definitions --- R/pool.R | 68 ++++++++++++++++++++++++++++------- tests/testthat/_snaps/pool.md | 9 +++++ tests/testthat/test-pool.R | 23 ++++++++++++ 3 files changed, 88 insertions(+), 12 deletions(-) diff --git a/R/pool.R b/R/pool.R index dec36be..ef4bb8a 100644 --- a/R/pool.R +++ b/R/pool.R @@ -549,10 +549,24 @@ resolve_pool_names <- function(names, defs, role) { } resolve_pool_name <- function(name, defs, role) { - named <- defs[defs$name == name, ] + aliases <- lapply(seq_len(nrow(defs)), function(i) { + pool_definition_aliases(defs[i, , drop = FALSE]) + }) + named <- defs[vapply(aliases, function(x) name %in% x, logical(1)), ] matched <- named[which(named$role %in% role), ] - if (nrow(matched)) { - return(matched[1, ]) + if (nrow(matched) == 1) { + return(matched) + } + if (nrow(matched) > 1) { + choices <- vapply( + seq_len(nrow(matched)), + function(i) pool_definition_key(matched[i, , drop = FALSE]), + character(1) + ) + cli::cli_abort(c( + "Governed name {.val {name}} is ambiguous.", + "i" = "Use a qualified name: {.val {unique(choices)}}." + )) } role_label <- paste(role, collapse = ", ") expected <- if (length(role) == 1) { @@ -576,6 +590,32 @@ resolve_pool_name <- function(name, defs, role) { ) } +pool_definition_aliases <- function(def) { + parent <- def$native_parent[[1]] + parent <- if (is.na(parent) || !nzchar(parent)) NULL else parent + unique(c( + def$name[[1]], + if (!is.null(parent)) paste(parent, def$name[[1]], sep = "."), + paste(def$table[[1]], def$name[[1]], sep = "."), + if (!is.null(parent)) { + paste(def$table[[1]], parent, def$name[[1]], sep = ".") + } + )) +} + +pool_definition_key <- function(def) { + utils::tail(pool_definition_aliases(def), 1) +} + +definition_pool_reference <- function(def, defs) { + same <- defs[ + defs$name == def$name[[1]] & defs$role == def$role[[1]], + , + drop = FALSE + ] + if (nrow(same) == 1) def$name[[1]] else pool_definition_key(def) +} + dimension_sql <- function(name, defs, columns, con) { named <- defs[defs$name == name, ] if (nrow(named)) { @@ -726,15 +766,16 @@ search_pool_text <- function( definition_pool_text <- function(def, defs) { role <- def$role + reference <- definition_pool_reference(def, defs) invoke <- if (!identical(def$execution[[1]], "data_dictionary")) { switch( role, metric = sprintf( "Query with call_metrics (metrics = [\"%s\"]).", - def$name + reference ), - filter = sprintf("Use as a call_metrics filter: %s.", def$name), - sprintf("Use as a call_metrics dimension: %s.", def$name) + filter = sprintf("Use as a call_metrics filter: %s.", reference), + sprintf("Use as a call_metrics dimension: %s.", reference) ) } else { switch( @@ -745,7 +786,7 @@ definition_pool_text <- function(def, defs) { ), metric = sprintf( "Query with call_metrics (metrics = [\"%s\"]) or in run_sql as `SELECT {{%s}} AS %s`.", - def$name, + reference, def$name, def$name ), @@ -760,11 +801,14 @@ definition_pool_text <- function(def, defs) { if (identical(role, "metric")) { same_table <- defs[defs$table == def$table & defs$name != def$name, ] if (nrow(same_table)) { - items <- sprintf( - "{{%s}} (%s)", - same_table$name, - same_table$role - ) + items <- vapply(seq_len(nrow(same_table)), function(i) { + sibling <- same_table[i, , drop = FALSE] + sprintf( + "{{%s}} (%s)", + definition_pool_reference(sibling, defs), + sibling$role + ) + }, character(1)) siblings <- sprintf( "Filters and dimensions on this table: %s.", paste(items, collapse = ", ") diff --git a/tests/testthat/_snaps/pool.md b/tests/testthat/_snaps/pool.md index 2639675..c0fd075 100644 --- a/tests/testthat/_snaps/pool.md +++ b/tests/testthat/_snaps/pool.md @@ -7,3 +7,12 @@ Error in `source_query()`: ! permission denied +# native definitions require qualification only when ambiguous + + Code + resolve_pool_name("REVENUE", defs, "metric") + Condition + Error in `resolve_pool_name()`: + ! Governed name "REVENUE" is ambiguous. + i Use a qualified name: "DB.PUBLIC.MODEL_A.ORDERS.REVENUE" and "DB.PUBLIC.MODEL_B.ORDERS.REVENUE". + diff --git a/tests/testthat/test-pool.R b/tests/testthat/test-pool.R index dacc632..8fbf707 100644 --- a/tests/testthat/test-pool.R +++ b/tests/testthat/test-pool.R @@ -130,6 +130,29 @@ test_that("call_metrics validates names with actionable errors", { ) }) +test_that("native definitions require qualification only when ambiguous", { + defs <- data.frame( + name = c("REVENUE", "REVENUE"), + table = c("DB.PUBLIC.MODEL_A", "DB.PUBLIC.MODEL_B"), + role = c("metric", "metric"), + native_parent = c("ORDERS", "ORDERS"), + stringsAsFactors = FALSE + ) + + expect_snapshot(resolve_pool_name("REVENUE", defs, "metric"), error = TRUE) + resolved <- resolve_pool_name( + "DB.PUBLIC.MODEL_B.ORDERS.REVENUE", + defs, + "metric" + ) + + expect_equal(resolved$table, "DB.PUBLIC.MODEL_B") + expect_equal( + definition_pool_reference(defs[2, , drop = FALSE], defs), + "DB.PUBLIC.MODEL_B.ORDERS.REVENUE" + ) +}) + test_that("metrics in one call must share a table", { path <- withr::local_tempfile(fileext = ".yaml") writeLines( From 1a4712b8d00c8f399a6b1cb91ae834b74854ebc1 Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 12:58:34 -0500 Subject: [PATCH 16/25] apply exclusions before catalog limits --- R/catalog-provider.R | 12 ++++++------ R/data-source.R | 4 ++-- tests/testthat/_snaps/data-source.md | 2 +- tests/testthat/test-data-source.R | 5 +++++ 4 files changed, 14 insertions(+), 9 deletions(-) diff --git a/R/catalog-provider.R b/R/catalog-provider.R index bebdd82..0bab93b 100644 --- a/R/catalog-provider.R +++ b/R/catalog-provider.R @@ -11,12 +11,6 @@ new_catalog_provider <- function(con, options, call = rlang::caller_env()) { paste(unlist(snapshot$namespace), collapse = ".") ) ids <- catalog_resolve_selection(con, backend, snapshot, options, call) - if (length(ids) > catalog_object_limit) { - cli::cli_abort(c( - "The data-source selection resolves to {length(ids)} objects, above the supported limit of {catalog_object_limit}.", - "i" = "Narrow {.arg include} to fewer catalog or schema prefixes." - ), call = call) - } if (length(ids) == 0) { cli::cli_abort( "The resolved data-source selection contains no queryable objects.", @@ -26,6 +20,12 @@ new_catalog_provider <- function(con, options, call = rlang::caller_env()) { names <- vapply(ids, catalog_id_name, character(1)) keep <- !catalog_excluded(names, options$exclude) ids <- ids[keep] + if (length(ids) > catalog_object_limit) { + cli::cli_abort(c( + "The data-source selection resolves to {length(ids)} objects, above the supported limit of {catalog_object_limit}.", + "i" = "Narrow {.arg include} or {.arg exclude} to fewer objects." + ), call = call) + } if (length(ids) == 0) { cli::cli_abort( "{.arg exclude} removes every object in the data-source selection.", diff --git a/R/data-source.R b/R/data-source.R index 1afaf30..ee7939d 100644 --- a/R/data-source.R +++ b/R/data-source.R @@ -10,8 +10,8 @@ #' * Named data frames are loaded into an in-process DuckDB database. Use this #' when the data isn't already in a database. #' * A `pins` board, e.g. [pins::board_connect()], is read into the same -#' in-process database: each pin in `tables` becomes a table. Pin names are -#' validated against the board at construction (a single listing call), but +#' in-process database: each pin selected by `options` becomes a table. Pin +#' names are validated against the board at construction (a single listing call), but #' each pin is downloaded only when its table is first used---by the #' `describe_table` tool, a SQL query that references it, or a measure that #' takes the source's connection. [commons_server()] starts a background diff --git a/tests/testthat/_snaps/data-source.md b/tests/testthat/_snaps/data-source.md index f73a984..2c5fcea 100644 --- a/tests/testthat/_snaps/data-source.md +++ b/tests/testthat/_snaps/data-source.md @@ -66,7 +66,7 @@ Condition Error: ! The data-source selection resolves to 2 objects, above the supported limit of 1. - i Narrow `include` to fewer catalog or schema prefixes. + i Narrow `include` or `exclude` to fewer objects. # default connection discovery stays in the current namespace diff --git a/tests/testthat/test-data-source.R b/tests/testthat/test-data-source.R index 1f9b4b8..fac4307 100644 --- a/tests/testthat/test-data-source.R +++ b/tests/testthat/test-data-source.R @@ -386,6 +386,11 @@ test_that("catalog providers reject selections above their object bound", { new_catalog_provider(con, data_source_options()), error = TRUE ) + provider <- new_catalog_provider( + con, + data_source_options(exclude = "two") + ) + expect_equal(names(provider$table_ids), "one") }) test_that("connection discovery merges an authored dictionary", { From 8cc5dfd19071b8ad85b5aaa155b4e6e89476b165 Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 12:59:07 -0500 Subject: [PATCH 17/25] clarify native semantic fields --- R/pool.R | 14 ++++++++++++-- R/tools.R | 4 +++- tests/testthat/test-pool.R | 20 +++++++++++++++++++- 3 files changed, 34 insertions(+), 4 deletions(-) diff --git a/R/pool.R b/R/pool.R index ef4bb8a..1abf05d 100644 --- a/R/pool.R +++ b/R/pool.R @@ -775,6 +775,10 @@ definition_pool_text <- function(def, defs) { reference ), filter = sprintf("Use as a call_metrics filter: %s.", reference), + fact = sprintf( + "Use in a call_metrics where predicate as column %s.", + reference + ), sprintf("Use as a call_metrics dimension: %s.", reference) ) } else { @@ -799,7 +803,13 @@ definition_pool_text <- function(def, defs) { siblings <- NULL if (identical(role, "metric")) { - same_table <- defs[defs$table == def$table & defs$name != def$name, ] + same_table <- defs[ + defs$table == def$table & + defs$name != def$name & + defs$role %in% c("filter", "dimension", "fact"), + , + drop = FALSE + ] if (nrow(same_table)) { items <- vapply(seq_len(nrow(same_table)), function(i) { sibling <- same_table[i, , drop = FALSE] @@ -810,7 +820,7 @@ definition_pool_text <- function(def, defs) { ) }, character(1)) siblings <- sprintf( - "Filters and dimensions on this table: %s.", + "Related governed fields on this table: %s.", paste(items, collapse = ", ") ) } diff --git a/R/tools.R b/R/tools.R index f302834..e9d9e02 100644 --- a/R/tools.R +++ b/R/tools.R @@ -196,7 +196,9 @@ tool_call_metrics <- function(private) { ), where = ellmer::type_array( ellmer::type_object( - column = ellmer::type_string("A documented column name."), + column = ellmer::type_string( + "A documented column or governed dimension or fact name." + ), op = ellmer::type_enum( c("=", "!=", "<", "<=", ">", ">="), "Comparison operator." diff --git a/tests/testthat/test-pool.R b/tests/testthat/test-pool.R index 8fbf707..b151ce1 100644 --- a/tests/testthat/test-pool.R +++ b/tests/testthat/test-pool.R @@ -153,6 +153,24 @@ test_that("native definitions require qualification only when ambiguous", { ) }) +test_that("native facts are advertised as predicates rather than dimensions", { + def <- data.frame( + name = "ORDER_TOTAL", + table = "DB.PUBLIC.MODEL", + role = "fact", + native_parent = "ORDERS", + execution = "snowflake_semantic_view", + description = NA_character_, + details = NA_character_, + stringsAsFactors = FALSE + ) + + text <- definition_pool_text(def, def) + + expect_match(text, "where predicate", fixed = TRUE) + expect_no_match(text, "dimension", fixed = TRUE) +}) + test_that("metrics in one call must share a table", { path <- withr::local_tempfile(fileext = ".yaml") writeLines( @@ -290,7 +308,7 @@ test_that("search_pool spans measures and definitions", { expect_match(out, "{{big_revenue}} --- metric on table `sales`", fixed = TRUE) expect_match(out, "call_metrics", fixed = TRUE) # A metric hit advertises what it can be sliced by. - expect_match(out, "Filters and dimensions on this table", fixed = TRUE) + expect_match(out, "Related governed fields on this table", fixed = TRUE) expect_match(out, "{{emea}} (filter)", fixed = TRUE) out <- search_pool_text(measures, registry, "how many orders") From 40266c75c4de1f743f02df350619b41d046d173b Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 13:01:37 -0500 Subject: [PATCH 18/25] prove query access during hydration --- R/catalog-provider.R | 58 ++++++++++++++++++++++-- R/pool.R | 7 ++- tests/testthat/_snaps/data-source.md | 12 ++++- tests/testthat/helper-catalog-provider.R | 1 + tests/testthat/test-data-source.R | 25 +++++++++- 5 files changed, 96 insertions(+), 7 deletions(-) diff --git a/R/catalog-provider.R b/R/catalog-provider.R index 0bab93b..adb8da2 100644 --- a/R/catalog-provider.R +++ b/R/catalog-provider.R @@ -427,6 +427,8 @@ catalog_provider_hydrate <- function(provider, table, call = rlang::caller_env() relation <- provider$catalog$relations[[relation_id]] catalog_import_relation_semantics(provider, relation_id) relation <- provider$catalog$relations[[relation_id]] + catalog_provider_authorize_hydration(provider, relation_id, table, call) + relation <- provider$catalog$relations[[relation_id]] if (length(relation$columns)) { return(relation) } @@ -470,13 +472,12 @@ catalog_provider_hydrate <- function(provider, table, call = rlang::caller_env() conditionMessage(metadata), perl = TRUE ) - relation$access <- new_catalog_access("visible_only", conditionMessage(metadata)) provider$catalog$relations[[relation_id]] <- relation catalog_provider_diagnostic( provider, - "catalog_relation_unqueryable", + "catalog_relation_metadata_unavailable", sprintf( - "Removed %s because it could not be described by this connection.", + "Removed %s because its metadata could not be described by this connection.", table ), severity = "info", @@ -493,12 +494,61 @@ catalog_provider_hydrate <- function(provider, table, call = rlang::caller_env() relation$columns <- metadata$columns relation$constraints <- metadata$constraints %||% relation$constraints relation$kind <- metadata$kind %||% relation$kind - relation$access <- new_catalog_access("queryable", "zero-row metadata query") relation <- genie_apply_column_overrides(relation) provider$catalog$relations[[relation_id]] <- relation relation } +catalog_provider_authorize_hydration <- function( + provider, + relation_id, + table, + call = rlang::caller_env() +) { + relation <- provider$catalog$relations[[relation_id]] + if (identical(relation$access$state, "queryable")) { + return(invisible(provider)) + } + started_at <- Sys.time() + result <- catalog_relation_queryability(provider$con, relation$path) + catalog_provider_record(provider, "authorize", started_at, table) + if (inherits(result, "condition")) { + result$message <- gsub( + "\\r?\\n[ \\t]*\\r?\\n", + "\n", + conditionMessage(result), + perl = TRUE + ) + relation$access <- new_catalog_access( + "visible_only", + conditionMessage(result) + ) + provider$catalog$relations[[relation_id]] <- relation + catalog_provider_diagnostic( + provider, + "catalog_relation_unqueryable", + sprintf( + "Removed %s because it could not be queried by this connection.", + table + ), + severity = "info", + entity_id = relation_id + ) + catalog_provider_drop_relation(provider, relation_id) + cli::cli_abort( + "Table {.val {table}} could not be queried.", + parent = result, + call = call + ) + } + relation$access <- new_catalog_access( + "queryable", + "zero-row authorization query" + ) + provider$catalog$relations[[relation_id]] <- relation + invisible(provider) +} + catalog_provider_probe_authored <- function( provider, authored, diff --git a/R/pool.R b/R/pool.R index 1abf05d..f9ac4ca 100644 --- a/R/pool.R +++ b/R/pool.R @@ -592,7 +592,12 @@ resolve_pool_name <- function(name, defs, role) { pool_definition_aliases <- function(def) { parent <- def$native_parent[[1]] - parent <- if (is.na(parent) || !nzchar(parent)) NULL else parent + parent <- if (is.null(parent) || length(parent) != 1 || + is.na(parent) || !nzchar(parent)) { + NULL + } else { + parent + } unique(c( def$name[[1]], if (!is.null(parent)) paste(parent, def$name[[1]], sep = "."), diff --git a/tests/testthat/_snaps/data-source.md b/tests/testthat/_snaps/data-source.md index 2c5fcea..039d72e 100644 --- a/tests/testthat/_snaps/data-source.md +++ b/tests/testthat/_snaps/data-source.md @@ -59,6 +59,16 @@ ! No table named "warehouse_object". i Available tables: . +# metadata visibility does not establish query access + + Code + source_describe(fixture$source, "warehouse_object") + Condition + Error in `source_describe()`: + ! Table "warehouse_object" could not be queried. + Caused by error: + ! not authorized + # catalog providers reject selections above their object bound Code @@ -83,7 +93,7 @@ source_describe(src, "nope") Condition Error in `source_describe()`: - ! Table "nope" could not be described. + ! Table "nope" could not be queried. Caused by error in `DBI::dbSendQuery()`: ! Catalog Error: Table with name nope does not exist! Did you mean "pg_enum"? diff --git a/tests/testthat/helper-catalog-provider.R b/tests/testthat/helper-catalog-provider.R index 1ef2537..0b05566 100644 --- a/tests/testthat/helper-catalog-provider.R +++ b/tests/testthat/helper-catalog-provider.R @@ -1,5 +1,6 @@ catalog_provider_test_source <- function(kind = "table") { con <- DBI::dbConnect(duckdb::duckdb()) + DBI::dbWriteTable(con, "warehouse_object", data.frame(region = "EMEA")) source_record <- new_catalog_source("source:test", "duckdb") relation <- new_catalog_relation( "relation:test", diff --git a/tests/testthat/test-data-source.R b/tests/testthat/test-data-source.R index fac4307..78aab79 100644 --- a/tests/testthat/test-data-source.R +++ b/tests/testthat/test-data-source.R @@ -281,7 +281,7 @@ test_that("catalog telemetry covers discovery and hydration", { "operation" ) - expect_equal(operations, c("discovery", "hydrate")) + expect_equal(operations, c("discovery", "authorize", "hydrate")) expect_true(all(vapply( source$provider$telemetry, function(event) event$elapsed >= 0, @@ -366,6 +366,29 @@ test_that("failed lazy hydration removes the object for the session", { source_describe(fixture$source, "warehouse_object"), error = TRUE ) + expect_equal( + fixture$provider$catalog$diagnostics[[1]]$code, + "catalog_relation_metadata_unavailable" + ) +}) + +test_that("metadata visibility does not establish query access", { + fixture <- catalog_provider_test_source() + withr::defer(DBI::dbDisconnect(fixture$con, shutdown = TRUE)) + local_mocked_bindings( + catalog_relation_queryability = function(con, path) { + simpleError("not authorized") + }, + catalog_relation_metadata = function(con, id) { + list(columns = list(id = new_catalog_column("id"))) + } + ) + + expect_snapshot( + source_describe(fixture$source, "warehouse_object"), + error = TRUE + ) + expect_length(list_tables(fixture$source), 0) expect_equal( fixture$provider$catalog$diagnostics[[1]]$code, "catalog_relation_unqueryable" From b029b6261f8100f66f87b8c908adb8ae250eda8c Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 13:02:51 -0500 Subject: [PATCH 19/25] fail closed on cross-dataset metrics --- R/catalog-ossie.R | 31 +++++++++++++++++++++++++++-- tests/testthat/test-catalog-ossie.R | 31 +++++++++++++++++++++++++++++ 2 files changed, 60 insertions(+), 2 deletions(-) diff --git a/R/catalog-ossie.R b/R/catalog-ossie.R index c54bdf8..1f472a0 100644 --- a/R/catalog-ossie.R +++ b/R/catalog-ossie.R @@ -245,6 +245,18 @@ ossie_import_model <- function(catalog, raw, source, provenance, call) { }) for (definition in c(definitions, metrics)) { catalog$definitions[[definition$id]] <- definition + if (identical(definition$native$callable, FALSE)) { + diagnostic <- new_catalog_diagnostic( + "ossie_metric_not_callable", + sprintf( + "Metric %s spans an unresolved Apache Ossie dataset scope and remains interchange-only.", + definition$name + ), + severity = "info", + entity_id = definition$id + ) + catalog$diagnostics[[length(catalog$diagnostics) + 1]] <- diagnostic + } } metric_context <- unlist(lapply(metrics, function(definition) { ossie_ai_context_records( @@ -401,6 +413,8 @@ ossie_import_metric <- function(metric, model, dataset_map, provenance, call) { } expressions <- ossie_import_expressions(metric$expression, metric$name, call) relation_id <- ossie_metric_relation(expressions, dataset_map) + callable <- !is.null(relation_id) + relation_id <- relation_id %||% unname(dataset_map[[1]]) new_catalog_definition( catalog_id("definition", model$id, "metric", metric$name), model$id, @@ -412,6 +426,8 @@ ossie_import_metric <- function(metric, model, dataset_map, provenance, call) { logical_type = metric$datatype, expressions = expressions, dependencies = model$datasets, + visibility = if (callable) "public" else "private", + native = list(callable = callable), provenance = provenance, extensions = ossie_import_extensions(metric) ) @@ -489,9 +505,20 @@ ossie_source_path <- function(source) { ossie_metric_relation <- function(expressions, dataset_map) { sql <- paste(vapply(expressions, `[[`, character(1), "sql"), collapse = "\n") matches <- names(dataset_map)[vapply(names(dataset_map), function(name) { - grepl(paste0("\\b", name, "\\s*\\."), strip_sql_literals(sql), perl = TRUE) + grepl( + paste0("\\b", escape_regex(name), "\\s*\\."), + strip_sql_literals(sql), + ignore.case = TRUE, + perl = TRUE + ) }, logical(1))] - if (length(matches) == 1) dataset_map[[matches]] else unname(dataset_map[[1]]) + if (length(matches) == 1) { + return(dataset_map[[matches]]) + } + if (length(dataset_map) == 1) { + return(unname(dataset_map[[1]])) + } + NULL } ossie_definition_is_column <- function(definition) { diff --git a/tests/testthat/test-catalog-ossie.R b/tests/testthat/test-catalog-ossie.R index 69aed0b..5c06444 100644 --- a/tests/testthat/test-catalog-ossie.R +++ b/tests/testthat/test-catalog-ossie.R @@ -134,6 +134,37 @@ test_that("Apache Ossie dependencies are filtered with selected datasets", { expect_false("ossie_relationship_context" %in% kinds) }) +test_that("cross-dataset Ossie metrics remain interchange-only", { + document <- list( + version = "0.1.1", + semantic_model = list(list( + name = "sales", + datasets = list( + list(name = "orders", source = "db.public.orders"), + list(name = "customers", source = "db.public.customers") + ), + metrics = list(list( + name = "blended_value", + expression = list(dialects = list(list( + dialect = "ANSI_SQL", + expression = "SUM(orders.amount) + SUM(customers.value)" + ))) + )) + )) + ) + + catalog <- catalog_from_ossie(document) + definition <- catalog$definitions[[1]] + + expect_equal(definition$visibility, "private") + expect_equal(nrow(catalog_definition_registry(catalog)$defs), 0) + expect_equal( + catalog$diagnostics[[1]]$code, + "ossie_metric_not_callable" + ) + expect_length(catalog_to_ossie(catalog)$document$semantic_model[[1]]$metrics, 1) +}) + test_that("Apache Ossie models write to YAML and JSON", { model <- ossie_model(test_path("fixtures", "ossie-databricks.yaml")) yaml_path <- withr::local_tempfile(fileext = ".yaml") From 38f9d43eb80dbcf011fa55bbd19e6a2715ff042a Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 13:07:34 -0500 Subject: [PATCH 20/25] preserve namespaced Ossie semantics --- R/catalog-ossie.R | 147 ++++++++++++++++++++++++---- tests/testthat/test-catalog-ossie.R | 11 +++ 2 files changed, 141 insertions(+), 17 deletions(-) diff --git a/R/catalog-ossie.R b/R/catalog-ossie.R index 1f472a0..009991c 100644 --- a/R/catalog-ossie.R +++ b/R/catalog-ossie.R @@ -721,23 +721,16 @@ ossie_export_model <- function(catalog, model, version) { version ) } - native <- Filter(Negate(is.null), model$extensions[c("snowflake", "databricks")]) - for (vendor in names(native)) { - if (!vendor %in% ossie_extension_vendors(raw$custom_extensions)) { - raw$custom_extensions <- ossie_append_extension( - raw$custom_extensions, - toupper(vendor), - native[[vendor]], - version - ) - diagnostics[[length(diagnostics) + 1]] <- new_catalog_diagnostic( - "ossie_native_extension", - sprintf("Model %s native execution metadata is represented as a %s extension.", model$name, toupper(vendor)), - severity = "info", - entity_id = model$id - ) - } - } + extensions <- ossie_export_extensions( + raw, + model$extensions, + version, + "model", + model$name, + model$id + ) + raw <- extensions$raw + diagnostics <- c(diagnostics, extensions$diagnostics) list(model = catalog_compact(raw), diagnostics = diagnostics) } @@ -752,6 +745,12 @@ ossie_export_dataset <- function(catalog, model, relation, version) { raw$name <- relation$name raw$source <- ossie_relation_source(relation) raw$description <- relation$description + if (length(relation$synonyms)) { + ai <- raw$ai_context + if (is.character(ai)) ai <- list(instructions = ai) + ai$synonyms <- unique(c(ossie_ai_synonyms(ai), relation$synonyms)) + raw$ai_context <- ai + } raw$ai_context <- ossie_export_ai_context( catalog, relation$id, @@ -811,6 +810,42 @@ ossie_export_dataset <- function(catalog, model, relation, version) { entity_id = relation$id ) } + extended_constraints <- Filter( + function(constraint) !ossie_constraint_represented( + constraint, + relation, + model, + catalog + ), + constraints + ) + if (length(extended_constraints)) { + raw$custom_extensions <- ossie_append_extension( + raw$custom_extensions, + "COMMONS", + list(constraints = lapply(extended_constraints, ossie_plain)), + version + ) + diagnostics[[length(diagnostics) + 1]] <- new_catalog_diagnostic( + "ossie_constraints_extension_only", + sprintf( + "Relation %s has constraint semantics preserved only in a COMMONS extension.", + relation$name + ), + severity = "info", + entity_id = relation$id + ) + } + extensions <- ossie_export_extensions( + raw, + relation$extensions, + version, + "relation", + relation$name, + relation$id + ) + raw <- extensions$raw + diagnostics <- c(diagnostics, extensions$diagnostics) list(dataset = catalog_compact(raw), diagnostics = diagnostics) } @@ -869,9 +904,87 @@ ossie_export_definition <- function(definition, catalog, version) { definition$id, raw$ai_context ) + extensions <- ossie_export_extensions( + raw, + definition$extensions, + version, + "definition", + definition$name, + definition$id + ) + raw <- extensions$raw + diagnostics <- c(diagnostics, extensions$diagnostics) list(definition = catalog_compact(raw), diagnostics = diagnostics) } +ossie_export_extensions <- function( + raw, + extensions, + version, + entity_kind, + entity_name, + entity_id +) { + existing <- ossie_extension_vendors(raw$custom_extensions) + extension_names <- names(extensions) + extension_names <- extension_names[ + !tolower(extension_names) %in% c("ossie", existing) + ] + diagnostics <- list() + for (name in extension_names) { + if (is.null(extensions[[name]])) { + next + } + vendor <- toupper(name) + raw$custom_extensions <- ossie_append_extension( + raw$custom_extensions, + vendor, + ossie_plain(extensions[[name]]), + version + ) + code <- if (tolower(name) %in% c("snowflake", "databricks")) { + "ossie_native_extension" + } else { + "ossie_extension_only" + } + diagnostic <- new_catalog_diagnostic( + code, + sprintf( + "%s %s metadata is represented as a %s extension.", + entity_kind, + entity_name, + vendor + ), + severity = "info", + entity_id = entity_id + ) + diagnostics[[length(diagnostics) + 1]] <- diagnostic + } + list(raw = raw, diagnostics = diagnostics) +} + +ossie_constraint_represented <- function(constraint, relation, model, catalog) { + if (constraint$kind %in% c("primary_key", "unique")) { + return(identical(constraint$enforcement, "unknown")) + } + if (!identical(constraint$kind, "foreign_key") || + !identical(constraint$enforcement, "unknown") || + !rlang::is_string(constraint$reference$relation_id)) { + return(FALSE) + } + target <- catalog$relations[[constraint$reference$relation_id]] + if (is.null(target)) return(FALSE) + any(vapply(model$relationships, function(relationship) { + identical(relationship$from, relation$name) && + identical(relationship$to, target$name) && + identical(unlist(relationship$from_columns), constraint$columns) && + identical( + unlist(relationship$to_columns), + constraint$reference$columns + ) + }, logical(1))) +} + ossie_export_ai_context <- function(catalog, entity_id, raw) { contexts <- Filter(function(context) { entity_id %in% context$scope && diff --git a/tests/testthat/test-catalog-ossie.R b/tests/testthat/test-catalog-ossie.R index 5c06444..3f66498 100644 --- a/tests/testthat/test-catalog-ossie.R +++ b/tests/testthat/test-catalog-ossie.R @@ -299,6 +299,9 @@ test_that("Apache Ossie export reports extension-only and omitted constructs", { delivery = "evaluation" ) catalog$context[[evaluation$id]] <- evaluation + catalog$models[[1]]$extensions$genie <- list(rule = "Use fiscal years.") + catalog$relations[[1]]$synonyms <- "purchases" + catalog$relations[[1]]$constraints[[1]]$enforcement <- "asserted" exported <- catalog_to_ossie(catalog) codes <- vapply(exported$diagnostics, `[[`, character(1), "code") @@ -307,4 +310,12 @@ test_that("Apache Ossie export reports extension-only and omitted constructs", { expect_true("ossie_term_omitted" %in% codes) expect_true("ossie_expression_extension_only" %in% codes) expect_true("ossie_context_omitted" %in% codes) + expect_true("ossie_extension_only" %in% codes) + expect_true("ossie_constraints_extension_only" %in% codes) + vendors <- ossie_extension_vendors( + exported$document$semantic_model[[1]]$custom_extensions + ) + expect_true("genie" %in% vendors) + dataset <- exported$document$semantic_model[[1]]$datasets[[1]] + expect_true("purchases" %in% ossie_ai_synonyms(dataset$ai_context)) }) From 8196259729a6d1260312993883ed6a54afb88405 Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 13:09:35 -0500 Subject: [PATCH 21/25] retain unselected definition validation --- R/data-source.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/data-source.R b/R/data-source.R index ee7939d..d89adae 100644 --- a/R/data-source.R +++ b/R/data-source.R @@ -125,7 +125,9 @@ data_source_frames <- function( check_named_frames(dots, call = call) selected <- select_flat_names(names(dots), options, call) dots <- dots[selected] - dictionary <- catalog_scope_flat_authored(dictionary, names(dots), "frames") + if (!is.null(options$include) || length(options$exclude)) { + dictionary <- catalog_scope_flat_authored(dictionary, names(dots), "frames") + } local_commons_span( "commons_data_source_load_frames", attributes = list("commons.data_source.n_tables" = length(dots)) From 024d415c97923a508f1a2ad86fc4b2e49264894b Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 13:17:11 -0500 Subject: [PATCH 22/25] harden live semantic hydration --- R/catalog-provider.R | 186 +++++++++++++++++++++++++++--- R/catalog.R | 10 +- R/data-source.R | 2 +- man/data_source.Rd | 4 +- tests/testthat/test-catalog.R | 39 +++++++ tests/testthat/test-data-source.R | 69 +++++++++++ 6 files changed, 287 insertions(+), 23 deletions(-) diff --git a/R/catalog-provider.R b/R/catalog-provider.R index adb8da2..8256626 100644 --- a/R/catalog-provider.R +++ b/R/catalog-provider.R @@ -510,8 +510,11 @@ catalog_provider_authorize_hydration <- function( return(invisible(provider)) } started_at <- Sys.time() - result <- catalog_relation_queryability(provider$con, relation$path) + result <- catalog_provider_queryability(provider, relation) catalog_provider_record(provider, "authorize", started_at, table) + if (identical(result, NA)) { + return(invisible(provider)) + } if (inherits(result, "condition")) { result$message <- gsub( "\\r?\\n[ \\t]*\\r?\\n", @@ -519,11 +522,26 @@ catalog_provider_authorize_hydration <- function( conditionMessage(result), perl = TRUE ) - relation$access <- new_catalog_access( - "visible_only", - conditionMessage(result) - ) + state <- catalog_query_failure_state(result) + relation$access <- new_catalog_access(state, conditionMessage(result)) provider$catalog$relations[[relation_id]] <- relation + if (identical(state, "unknown")) { + catalog_provider_diagnostic( + provider, + "catalog_relation_query_unverified", + sprintf( + "Could not yet verify query access to %s; retry after the connection is ready.", + table + ), + severity = "info", + entity_id = relation_id + ) + cli::cli_abort( + "Table {.val {table}} could not be queried.", + parent = result, + call = call + ) + } catalog_provider_diagnostic( provider, "catalog_relation_unqueryable", @@ -554,6 +572,7 @@ catalog_provider_probe_authored <- function( authored, call = rlang::caller_env() ) { + authorized <- character() for (relation in authored$relations) { candidates <- catalog_relation_candidates( relation, @@ -561,8 +580,15 @@ catalog_provider_probe_authored <- function( provider$catalog$sources ) if (length(candidates) != 1) next - catalog_provider_probe_relation(provider, candidates[[1]]) + relation_id <- candidates[[1]] + catalog_provider_probe_relation(provider, relation_id) + discovered <- provider$catalog$relations[[relation_id]] + if (identical(discovered$access$state, "queryable") || + discovered$kind %in% c("semantic_view", "metric_view", "governed_query")) { + authorized <- c(authorized, relation_id) + } } + provider$authored_relation_ids <- unique(authorized) catalog_provider_finalize_access(provider, call) } @@ -581,17 +607,31 @@ catalog_provider_probe_relation <- function(provider, relation_id) { catalog_path_label(relation) ) if (inherits(result, "condition")) { - relation$access <- new_catalog_access("visible_only", conditionMessage(result)) - catalog_provider_diagnostic( - provider, - "authored_relation_unqueryable", - sprintf( - "Skipped authored metadata for %s because the relation is not queryable.", - catalog_path_label(relation) - ), - severity = "info", - entity_id = relation$id - ) + state <- catalog_query_failure_state(result) + relation$access <- new_catalog_access(state, conditionMessage(result)) + if (identical(state, "visible_only")) { + catalog_provider_diagnostic( + provider, + "authored_relation_unqueryable", + sprintf( + "Skipped authored metadata for %s because the relation is not queryable.", + catalog_path_label(relation) + ), + severity = "info", + entity_id = relation$id + ) + } else { + catalog_provider_diagnostic( + provider, + "authored_relation_query_unverified", + sprintf( + "Skipped authored metadata for %s because query access could not yet be verified.", + catalog_path_label(relation) + ), + severity = "info", + entity_id = relation$id + ) + } } else { relation$access <- new_catalog_access("queryable", "zero-row authorization probe") } @@ -617,6 +657,118 @@ catalog_relation_queryability <- function(con, path) { ) } +catalog_query_failure_state <- function(error) { + if (grepl( + "permission|not authorized|insufficient privilege|access denied|not permitted", + conditionMessage(error), + ignore.case = TRUE + )) { + "visible_only" + } else { + "unknown" + } +} + +catalog_provider_queryability <- function(provider, relation) { + if (relation$kind %in% c("semantic_view", "metric_view") && + provider$backend %in% c("snowflake", "databricks")) { + return(catalog_semantic_relation_queryability(provider, relation)) + } + catalog_relation_queryability(provider$con, relation$path) +} + +catalog_semantic_relation_queryability <- function(provider, relation) { + sql <- catalog_semantic_authorization_sql(provider, relation) + if (is.null(sql)) return(NA) + tryCatch( + { + result <- DBI::dbSendQuery(provider$con, sql) + on.exit(DBI::dbClearResult(result), add = TRUE) + TRUE + }, + error = function(err) err + ) +} + +catalog_semantic_authorization_sql <- function(provider, relation) { + models <- Filter( + function(model) relation$id %in% model$exposed, + provider$catalog$models + ) + if (length(models) != 1) return(NULL) + model <- models[[1]] + definitions <- Filter( + function(definition) { + identical(definition$model_id, model$id) && + identical(definition$visibility, "public") + }, + provider$catalog$definitions + ) + fields <- Filter( + function(definition) definition$role %in% c("dimension", "time_dimension"), + definitions + ) + metrics <- Filter( + function(definition) identical(definition$role, "metric"), + definitions + ) + definition <- if (length(fields)) { + fields[[1]] + } else if (length(metrics)) { + metrics[[1]] + } else { + return(NULL) + } + + object <- DBI::dbQuoteIdentifier( + provider$con, + source_path_id(model$execution$object) + ) + name <- DBI::dbQuoteIdentifier(provider$con, definition$name) + if (identical(provider$backend, "databricks")) { + parameters <- model$execution$parameters %||% list() + required <- vapply( + parameters, + function(parameter) !"default" %in% names(parameter), + logical(1) + ) + if (any(required)) return(NULL) + expression <- if (identical(definition$role, "metric")) { + paste0("MEASURE(", name, ")") + } else { + name + } + return(paste("SELECT", expression, "FROM", object, "LIMIT 0")) + } + + variables <- model$execution$variables %||% list() + required <- vapply( + variables, + function(variable) !"default_value" %in% names(variable), + logical(1) + ) + if (any(required)) return(NULL) + parent <- definition$native$parent + reference <- if (rlang::is_string(parent)) { + DBI::dbQuoteIdentifier( + provider$con, + DBI::Id(schema = parent, table = definition$name) + ) + } else { + name + } + clause <- if (identical(definition$role, "metric")) "METRICS" else "DIMENSIONS" + paste0( + "SELECT * FROM SEMANTIC_VIEW(\n ", + object, + "\n ", + clause, + " ", + reference, + "\n) LIMIT 0" + ) +} + catalog_provider_finalize_access <- function( provider, call = rlang::caller_env() diff --git a/R/catalog.R b/R/catalog.R index d6d26c1..46b729c 100644 --- a/R/catalog.R +++ b/R/catalog.R @@ -138,7 +138,8 @@ catalog_to_data_dictionary <- function(catalog, call = rlang::caller_env()) { tables <- lapply( relations, catalog_relation_to_dictionary, - definitions = catalog$definitions + definitions = catalog$definitions, + models = catalog$models ) names(tables) <- table_names @@ -181,7 +182,8 @@ catalog_to_runtime_dictionary <- function( tables <- lapply( relations, catalog_relation_to_dictionary, - definitions = catalog$definitions + definitions = catalog$definitions, + models = catalog$models ) names(tables) <- unname(relation_labels[relation_ids]) glossary <- lapply(catalog$terms, `[[`, "description") @@ -1038,7 +1040,7 @@ catalog_context_from_dictionary <- function( records } -catalog_relation_to_dictionary <- function(relation, definitions) { +catalog_relation_to_dictionary <- function(relation, definitions, models = list()) { entry <- relation$extensions$data_dictionary %||% list() entry$label <- relation$label entry$description <- relation$description @@ -1047,7 +1049,9 @@ catalog_relation_to_dictionary <- function(relation, definitions) { relation_definitions <- Filter( function(definition) { + model <- models[[definition$model_id]] identical(definition$relation_id, relation$id) && + identical(model$execution$kind %||% "data_dictionary", "data_dictionary") && !definition$name %in% names(relation$columns) && !is.null(definition$logical_type) }, diff --git a/R/data-source.R b/R/data-source.R index d89adae..fcb54f2 100644 --- a/R/data-source.R +++ b/R/data-source.R @@ -176,7 +176,7 @@ data_source_connection <- function( provider$catalog <- catalog_merge( provider$catalog, authored, - relation_ids = names(provider$relation_labels), + relation_ids = provider$authored_relation_ids, call = call ) } diff --git a/man/data_source.Rd b/man/data_source.Rd index a5ab090..72c9b18 100644 --- a/man/data_source.Rd +++ b/man/data_source.Rd @@ -44,8 +44,8 @@ the database directly. \item Named data frames are loaded into an in-process DuckDB database. Use this when the data isn't already in a database. \item A \code{pins} board, e.g. \code{\link[pins:board_connect]{pins::board_connect()}}, is read into the same -in-process database: each pin in \code{tables} becomes a table. Pin names are -validated against the board at construction (a single listing call), but +in-process database: each pin selected by \code{options} becomes a table. Pin +names are validated against the board at construction (a single listing call), but each pin is downloaded only when its table is first used---by the \code{describe_table} tool, a SQL query that references it, or a measure that takes the source's connection. \code{\link[=commons_server]{commons_server()}} starts a background diff --git a/tests/testthat/test-catalog.R b/tests/testthat/test-catalog.R index dd4f4dd..cf88861 100644 --- a/tests/testthat/test-catalog.R +++ b/tests/testthat/test-catalog.R @@ -506,6 +506,45 @@ test_that("private and visible-only semantic definitions stay out of the registr expect_equal(nrow(catalog_definition_registry(catalog)$defs), 0) }) +test_that("native semantic definitions stay out of dictionary definitions", { + source <- new_catalog_source("source:test", "snowflake") + relation <- new_catalog_relation( + "relation:model", + source$id, + new_source_path(c(table = "MODEL")) + ) + model <- new_catalog_model( + "model:test", + source$id, + "MODEL", + datasets = relation$id, + execution = list(kind = "snowflake_semantic_view") + ) + definition <- new_catalog_definition( + "definition:latitude", + model$id, + relation$id, + "dimension", + "LATITUDE", + logical_type = "number", + expressions = list(new_catalog_expression("snowflake", "LATITUDE")) + ) + catalog <- new_commons_catalog( + sources = list(source), + relations = list(relation), + models = list(model), + definitions = list(definition) + ) + + dictionary <- catalog_to_runtime_dictionary( + catalog, + c("relation:model" = "MODEL") + ) + + expect_length(dictionary$tables$MODEL$definitions, 0) + expect_equal(catalog_definition_registry(catalog)$defs$name, "LATITUDE") +}) + test_that("native semantic columns do not duplicate projected definitions", { source <- new_catalog_source("source:test", "snowflake") relation <- new_catalog_relation( diff --git a/tests/testthat/test-data-source.R b/tests/testthat/test-data-source.R index 78aab79..2e92459 100644 --- a/tests/testthat/test-data-source.R +++ b/tests/testthat/test-data-source.R @@ -395,6 +395,75 @@ test_that("metadata visibility does not establish query access", { ) }) +test_that("transient query failures remain retryable", { + fixture <- catalog_provider_test_source() + withr::defer(DBI::dbDisconnect(fixture$con, shutdown = TRUE)) + local_mocked_bindings( + catalog_relation_queryability = function(con, path) { + simpleError("warehouse is starting") + } + ) + + expect_error( + source_describe(fixture$source, "warehouse_object"), + "could not be queried" + ) + + expect_equal(list_tables(fixture$source), "warehouse_object") + expect_equal( + fixture$provider$catalog$relations[[fixture$relation$id]]$access$state, + "unknown" + ) + expect_equal( + fixture$provider$catalog$diagnostics[[1]]$code, + "catalog_relation_query_unverified" + ) +}) + +test_that("authored facts wait for a successful access probe", { + con <- DBI::dbConnect(duckdb::duckdb()) + withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) + DBI::dbWriteTable(con, "orders", data.frame(id = 1)) + dictionary <- new_data_dictionary(list(tables = list( + orders = list(description = "Publisher-only description.") + ))) + local_mocked_bindings( + catalog_relation_queryability = function(con, path) { + simpleError("warehouse is starting") + } + ) + + source <- data_source( + con, + dictionary = dictionary, + options = data_source_options(include = "orders") + ) + + expect_equal(list_tables(source), "orders") + expect_null(source$dictionary$tables$orders$description) + expect_equal( + source$provider$catalog$diagnostics[[1]]$code, + "authored_relation_query_unverified" + ) +}) + +test_that("semantic authorization selects one governed field", { + fixture <- catalog_provider_test_source("semantic_view") + withr::defer(DBI::dbDisconnect(fixture$con, shutdown = TRUE)) + fixture$provider$backend <- "snowflake" + catalog_provider_add_metric(fixture, fields = TRUE) + + sql <- catalog_semantic_authorization_sql( + fixture$provider, + fixture$relation + ) + + expect_match(sql, "SEMANTIC_VIEW", fixed = TRUE) + expect_match(sql, "DIMENSIONS", fixed = TRUE) + expect_match(sql, "region", fixed = TRUE) + expect_false(grepl("record_count", sql, fixed = TRUE)) +}) + test_that("catalog providers reject selections above their object bound", { con <- DBI::dbConnect(duckdb::duckdb()) withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) From 3046648efabd1f8d30634756c350e34bae6aac7b Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 13:20:44 -0500 Subject: [PATCH 23/25] bound semantic discovery losslessly --- R/catalog-databricks.R | 6 +++ R/catalog-ossie.R | 77 +++++++++++++++++++++++++++++ R/catalog-provider.R | 21 ++++++++ R/catalog-snowflake.R | 6 +++ tests/testthat/test-catalog-ossie.R | 3 ++ tests/testthat/test-catalog.R | 20 ++++++++ vignettes/database-catalogs.Rmd | 6 +++ 7 files changed, 139 insertions(+) diff --git a/R/catalog-databricks.R b/R/catalog-databricks.R index 470cf57..d05318f 100644 --- a/R/catalog-databricks.R +++ b/R/catalog-databricks.R @@ -209,6 +209,12 @@ databricks_import_associated_semantics <- function(provider) { function(id) attr(id, "commons_kind") %in% c("metric_view", "view"), candidates ) + candidates <- catalog_bound_semantic_candidates( + provider, + candidates, + prefix, + "Databricks" + ) for (id in candidates) { path <- new_source_path(id) specification <- databricks_read_metric_yaml(provider$con, path) diff --git a/R/catalog-ossie.R b/R/catalog-ossie.R index 009991c..97178c8 100644 --- a/R/catalog-ossie.R +++ b/R/catalog-ossie.R @@ -721,6 +721,16 @@ ossie_export_model <- function(catalog, model, version) { version ) } + metadata <- ossie_export_commons_metadata( + raw, + list(label = model$label, details = model$details), + version, + "model", + model$name, + model$id + ) + raw <- metadata$raw + diagnostics <- c(diagnostics, metadata$diagnostics) extensions <- ossie_export_extensions( raw, model$extensions, @@ -836,6 +846,21 @@ ossie_export_dataset <- function(catalog, model, relation, version) { entity_id = relation$id ) } + metadata <- ossie_export_commons_metadata( + raw, + list( + label = relation$label, + details = relation$details, + aliases = relation$aliases, + tags = relation$tags + ), + version, + "relation", + relation$name, + relation$id + ) + raw <- metadata$raw + diagnostics <- c(diagnostics, metadata$diagnostics) extensions <- ossie_export_extensions( raw, relation$extensions, @@ -904,6 +929,23 @@ ossie_export_definition <- function(definition, catalog, version) { definition$id, raw$ai_context ) + metadata <- ossie_export_commons_metadata( + raw, + list( + details = definition$details, + aggregation = definition$aggregation, + visibility = if (!identical(definition$visibility, "public") && + is.null(definition$extensions$ossie)) { + definition$visibility + } + ), + version, + "definition", + definition$name, + definition$id + ) + raw <- metadata$raw + diagnostics <- c(diagnostics, metadata$diagnostics) extensions <- ossie_export_extensions( raw, definition$extensions, @@ -963,6 +1005,41 @@ ossie_export_extensions <- function( list(raw = raw, diagnostics = diagnostics) } +ossie_export_commons_metadata <- function( + raw, + metadata, + version, + entity_kind, + entity_name, + entity_id +) { + metadata <- metadata[vapply( + metadata, + function(value) !is.null(value) && length(value) > 0, + logical(1) + )] + if (length(metadata) == 0) { + return(list(raw = raw, diagnostics = list())) + } + raw$custom_extensions <- ossie_append_extension( + raw$custom_extensions, + "COMMONS", + list(metadata = ossie_plain(metadata)), + version + ) + diagnostic <- new_catalog_diagnostic( + "ossie_metadata_extension_only", + sprintf( + "%s %s metadata is preserved only in a COMMONS extension.", + entity_kind, + entity_name + ), + severity = "info", + entity_id = entity_id + ) + list(raw = raw, diagnostics = list(diagnostic)) +} + ossie_constraint_represented <- function(constraint, relation, model, catalog) { if (constraint$kind %in% c("primary_key", "unique")) { return(identical(constraint$enforcement, "unknown")) diff --git a/R/catalog-provider.R b/R/catalog-provider.R index 8256626..7118f07 100644 --- a/R/catalog-provider.R +++ b/R/catalog-provider.R @@ -977,6 +977,27 @@ catalog_import_relation_semantics <- function(provider, relation_id) { invisible(provider) } +catalog_bound_semantic_candidates <- function( + provider, + candidates, + prefix, + backend +) { + if (length(candidates) <= catalog_object_limit) return(candidates) + catalog_provider_diagnostic( + provider, + "semantic_candidate_limit", + sprintf( + "Skipped associated %s semantic discovery in %s because it contains more than %s candidates; select the semantic object explicitly.", + backend, + paste(prefix@name, collapse = "."), + catalog_object_limit + ), + severity = "info" + ) + list() +} + catalog_association_prefixes <- function(provider) { relation_ids <- names(provider$selection_modes)[ provider$selection_modes == "exact" diff --git a/R/catalog-snowflake.R b/R/catalog-snowflake.R index 1b419d2..484354f 100644 --- a/R/catalog-snowflake.R +++ b/R/catalog-snowflake.R @@ -161,6 +161,12 @@ snowflake_import_associated_semantics <- function(provider) { function(id) identical(attr(id, "commons_kind"), "semantic_view"), candidates ) + candidates <- catalog_bound_semantic_candidates( + provider, + candidates, + prefix, + "Snowflake" + ) for (id in candidates) { relation <- catalog_add_associated_relation( provider, diff --git a/tests/testthat/test-catalog-ossie.R b/tests/testthat/test-catalog-ossie.R index 3f66498..3dc020a 100644 --- a/tests/testthat/test-catalog-ossie.R +++ b/tests/testthat/test-catalog-ossie.R @@ -300,7 +300,9 @@ test_that("Apache Ossie export reports extension-only and omitted constructs", { ) catalog$context[[evaluation$id]] <- evaluation catalog$models[[1]]$extensions$genie <- list(rule = "Use fiscal years.") + catalog$models[[1]]$details <- "Model details." catalog$relations[[1]]$synonyms <- "purchases" + catalog$relations[[1]]$tags <- "certified" catalog$relations[[1]]$constraints[[1]]$enforcement <- "asserted" exported <- catalog_to_ossie(catalog) @@ -312,6 +314,7 @@ test_that("Apache Ossie export reports extension-only and omitted constructs", { expect_true("ossie_context_omitted" %in% codes) expect_true("ossie_extension_only" %in% codes) expect_true("ossie_constraints_extension_only" %in% codes) + expect_true("ossie_metadata_extension_only" %in% codes) vendors <- ossie_extension_vendors( exported$document$semantic_model[[1]]$custom_extensions ) diff --git a/tests/testthat/test-catalog.R b/tests/testthat/test-catalog.R index cf88861..212d227 100644 --- a/tests/testthat/test-catalog.R +++ b/tests/testthat/test-catalog.R @@ -470,6 +470,26 @@ test_that("associated semantic definitions respect physical dependency closure", expect_equal(registry$defs$name, "ORDER_COUNT") }) +test_that("associated semantic candidate inspection is bounded", { + provider <- new.env(parent = emptyenv()) + provider$catalog <- new_commons_catalog() + candidates <- list(DBI::Id(table = "one"), DBI::Id(table = "two")) + local_mocked_bindings(catalog_object_limit = 1L) + + bounded <- catalog_bound_semantic_candidates( + provider, + candidates, + DBI::Id(schema = "public"), + "Test" + ) + + expect_length(bounded, 0) + expect_equal( + provider$catalog$diagnostics[[1]]$code, + "semantic_candidate_limit" + ) +}) + test_that("private and visible-only semantic definitions stay out of the registry", { source <- new_catalog_source("source:test", "snowflake") relation <- new_catalog_relation( diff --git a/vignettes/database-catalogs.Rmd b/vignettes/database-catalogs.Rmd index 3de2b03..36bdc80 100644 --- a/vignettes/database-catalogs.Rmd +++ b/vignettes/database-catalogs.Rmd @@ -60,6 +60,12 @@ Databricks may take several minutes to start a stopped SQL warehouse on the first connection or query; wait for that call rather than retrying it. +Snowflake can list catalog and semantic metadata without an active warehouse, +but zero-row authorization probes and native semantic queries require one. +Configure a warehouse on the connection or run `USE WAREHOUSE` before the first +description or metric call. A missing or starting warehouse leaves access +`unknown` and retryable; it is not cached as a permission denial. + An exact physical-table selection can import an associated semantic model only when that model's dependencies are inside the selection. Selecting a semantic view or metric view exactly imports its declared dependency closure for From 6f27fe4216f5481721e1d478deb9c89f34b99829 Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 16:36:27 -0500 Subject: [PATCH 24/25] more informative error without options --- R/catalog-snowflake.R | 21 +++++++++++++++------ tests/testthat/_snaps/catalog-snowflake.md | 9 +++++++++ tests/testthat/test-catalog-snowflake.R | 20 ++++++++++++++++++++ 3 files changed, 44 insertions(+), 6 deletions(-) diff --git a/R/catalog-snowflake.R b/R/catalog-snowflake.R index 484354f..5bd19f8 100644 --- a/R/catalog-snowflake.R +++ b/R/catalog-snowflake.R @@ -13,21 +13,30 @@ snowflake_connection_snapshot <- function(con) { locator = list(account = row$account_name[[1]]), principal = row$principal[[1]], role = row$role[[1]], - namespace = catalog_compact(list( - catalog = row$database_name[[1]], - schema = row$schema_name[[1]] - )) + namespace = snowflake_namespace( + row$database_name[[1]], + row$schema_name[[1]] + ) ) } +snowflake_namespace <- function(database, schema) { + namespace <- list(catalog = database, schema = schema) + namespace[vapply( + namespace, + function(value) rlang::is_string(value) && nzchar(value), + logical(1) + )] +} + snowflake_default_objects <- function(con, call) { snapshot <- snowflake_connection_snapshot(con) namespace <- snapshot$namespace if (!all(c("catalog", "schema") %in% names(namespace))) { cli::cli_abort( c( - "The Snowflake connection has no current database and schema.", - "i" = "Set both on the connection or supply {.arg options} with explicit {.arg include} IDs." + "The Snowflake connection does not have both a current database and schema.", + "i" = "Set both on the connection or select a namespace with {.code data_source_options(include = DBI::Id(catalog = \"...\", schema = \"...\"))}." ), call = call ) diff --git a/tests/testthat/_snaps/catalog-snowflake.md b/tests/testthat/_snaps/catalog-snowflake.md index 7088968..25379d2 100644 --- a/tests/testthat/_snaps/catalog-snowflake.md +++ b/tests/testthat/_snaps/catalog-snowflake.md @@ -1,3 +1,12 @@ +# Snowflake reports a missing current namespace + + Code + snowflake_default_objects(NULL, rlang::current_env()) + Condition + Error: + ! The Snowflake connection does not have both a current database and schema. + i Set both on the connection or select a namespace with `data_source_options(include = DBI::Id(catalog = "...", schema = "..."))`. + # Snowflake semantic-view variables are typed and quoted Code diff --git a/tests/testthat/test-catalog-snowflake.R b/tests/testthat/test-catalog-snowflake.R index 60b43ea..bf82cf2 100644 --- a/tests/testthat/test-catalog-snowflake.R +++ b/tests/testthat/test-catalog-snowflake.R @@ -1,3 +1,23 @@ +test_that("Snowflake reports a missing current namespace", { + local_mocked_bindings( + dbGetQuery = function(...) { + data.frame( + principal = "USER", + role = "ROLE", + database_name = NA_character_, + schema_name = NA_character_, + account_name = "ACCOUNT" + ) + }, + .package = "DBI" + ) + + expect_snapshot( + snowflake_default_objects(NULL, rlang::current_env()), + error = TRUE + ) +}) + test_that("Snowflake semantic YAML imports governed assets", { con <- DBI::dbConnect(duckdb::duckdb()) withr::defer(DBI::dbDisconnect(con, shutdown = TRUE)) From 2f277f1cba94f4786b77d0fb126473e2bcbdc8c2 Mon Sep 17 00:00:00 2001 From: Simon Couch Date: Wed, 5 Aug 2026 16:45:08 -0500 Subject: [PATCH 25/25] fail early with no warehouse --- R/catalog-provider.R | 12 +++++++---- R/catalog-snowflake.R | 16 ++++++++++++--- tests/testthat/_snaps/catalog-snowflake.md | 9 ++++++++ tests/testthat/test-catalog-snowflake.R | 24 +++++++++++++++++++++- 4 files changed, 53 insertions(+), 8 deletions(-) diff --git a/R/catalog-provider.R b/R/catalog-provider.R index 7118f07..e699ee2 100644 --- a/R/catalog-provider.R +++ b/R/catalog-provider.R @@ -2,7 +2,7 @@ new_catalog_provider <- function(con, options, call = rlang::caller_env()) { started_at <- Sys.time() backend <- catalog_backend(con) catalog_progress("discovering", backend, started_at) - snapshot <- catalog_connection_snapshot(con, backend) + snapshot <- catalog_connection_snapshot(con, backend, call) capabilities <- catalog_backend_capabilities(con, backend, snapshot) source_id <- catalog_id( "source", @@ -153,9 +153,13 @@ catalog_backend <- function(con) { tolower(info$dbms.name %||% sub("Connection$", "", class(con)[[1]])) } -catalog_connection_snapshot <- function(con, backend) { +catalog_connection_snapshot <- function( + con, + backend, + call = rlang::caller_env() +) { if (identical(backend, "snowflake")) { - return(snowflake_connection_snapshot(con)) + return(snowflake_connection_snapshot(con, call)) } if (identical(backend, "databricks")) { return(databricks_connection_snapshot(con)) @@ -178,7 +182,7 @@ catalog_connection_snapshot <- function(con, backend) { } catalog_provider_check <- function(provider, call = rlang::caller_env()) { - current <- catalog_connection_snapshot(provider$con, provider$backend) + current <- catalog_connection_snapshot(provider$con, provider$backend, call) if (!identical(current, provider$snapshot)) { cli::cli_abort( "The connection identity, role, or current namespace changed after catalog discovery; rebuild the data source.", diff --git a/R/catalog-snowflake.R b/R/catalog-snowflake.R index 5bd19f8..3c4fc09 100644 --- a/R/catalog-snowflake.R +++ b/R/catalog-snowflake.R @@ -1,13 +1,23 @@ -snowflake_connection_snapshot <- function(con) { +snowflake_connection_snapshot <- function(con, call = rlang::caller_env()) { row <- DBI::dbGetQuery( con, paste( "SELECT CURRENT_USER() AS principal, CURRENT_ROLE() AS role,", "CURRENT_DATABASE() AS database_name, CURRENT_SCHEMA() AS schema_name,", - "CURRENT_ACCOUNT() AS account_name" + "CURRENT_ACCOUNT() AS account_name, CURRENT_WAREHOUSE() AS warehouse_name" ) ) names(row) <- tolower(names(row)) + if (!rlang::is_string(row$warehouse_name[[1]]) || + !nzchar(row$warehouse_name[[1]])) { + cli::cli_abort( + c( + "The Snowflake connection has no active warehouse.", + "i" = "Configure one on the connection or run {.code DBI::dbExecute(con, \"USE WAREHOUSE \")} before calling {.fn data_source}." + ), + call = call + ) + } list( backend = "snowflake", locator = list(account = row$account_name[[1]]), @@ -30,7 +40,7 @@ snowflake_namespace <- function(database, schema) { } snowflake_default_objects <- function(con, call) { - snapshot <- snowflake_connection_snapshot(con) + snapshot <- snowflake_connection_snapshot(con, call) namespace <- snapshot$namespace if (!all(c("catalog", "schema") %in% names(namespace))) { cli::cli_abort( diff --git a/tests/testthat/_snaps/catalog-snowflake.md b/tests/testthat/_snaps/catalog-snowflake.md index 25379d2..244d3df 100644 --- a/tests/testthat/_snaps/catalog-snowflake.md +++ b/tests/testthat/_snaps/catalog-snowflake.md @@ -7,6 +7,15 @@ ! The Snowflake connection does not have both a current database and schema. i Set both on the connection or select a namespace with `data_source_options(include = DBI::Id(catalog = "...", schema = "..."))`. +# Snowflake requires an active warehouse + + Code + snowflake_connection_snapshot(NULL, rlang::current_env()) + Condition + Error: + ! The Snowflake connection has no active warehouse. + i Configure one on the connection or run `DBI::dbExecute(con, "USE WAREHOUSE ")` before calling `data_source()`. + # Snowflake semantic-view variables are typed and quoted Code diff --git a/tests/testthat/test-catalog-snowflake.R b/tests/testthat/test-catalog-snowflake.R index bf82cf2..b8b7c5a 100644 --- a/tests/testthat/test-catalog-snowflake.R +++ b/tests/testthat/test-catalog-snowflake.R @@ -6,7 +6,8 @@ test_that("Snowflake reports a missing current namespace", { role = "ROLE", database_name = NA_character_, schema_name = NA_character_, - account_name = "ACCOUNT" + account_name = "ACCOUNT", + warehouse_name = "WAREHOUSE" ) }, .package = "DBI" @@ -18,6 +19,27 @@ test_that("Snowflake reports a missing current namespace", { ) }) +test_that("Snowflake requires an active warehouse", { + local_mocked_bindings( + dbGetQuery = function(...) { + data.frame( + principal = "USER", + role = "ROLE", + database_name = "DATABASE", + schema_name = "SCHEMA", + account_name = "ACCOUNT", + warehouse_name = NA_character_ + ) + }, + .package = "DBI" + ) + + expect_snapshot( + snowflake_connection_snapshot(NULL, rlang::current_env()), + error = TRUE + ) +}) + test_that("Snowflake semantic YAML imports governed assets", { con <- DBI::dbConnect(duckdb::duckdb()) withr::defer(DBI::dbDisconnect(con, shutdown = TRUE))