vmxr 0.2.0

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: vmxr
 Title: VeloMetrix R Client
-Version: 0.1.1.9000
+Version: 0.2.0
 Authors@R: c(
     person(given = "Eric", family = "Novik", email = "eric@generable.com", role = c("aut", "cre")),
     person(given = "Juho", family = "Timonen", role = "ctb"),

NAMESPACE

@@ -6,6 +6,7 @@ S3method(print,vmx_model_data)
 S3method(print,vmx_resource)
 S3method(vmx_wait,default)
 S3method(vmx_wait,vmx_dataset)
+S3method(vmx_wait,vmx_dosing_input)
 S3method(vmx_wait,vmx_model_build_run)
 S3method(vmx_wait,vmx_nca_analysis)
 S3method(vmx_wait,vmx_prep_status)
@@ -26,6 +27,7 @@ export(vmx_dataset_download)
 export(vmx_dataset_files)
 export(vmx_dataset_tags)
 export(vmx_datasets)
+export(vmx_dosing)
 export(vmx_dosing_input)
 export(vmx_dosing_input_status)
 export(vmx_fit_global_estimates)

NEWS.md

@@ -1,4 +1,37 @@
-# vmxr 0.1.1.9000 (development)
+# vmxr 0.2.0
+
+* Collection functions continue to return all matching rows. Cursor pages are
+  followed automatically with strict envelope validation and repeated-cursor
+  detection, so malformed pagination fails instead of truncating results or
+  looping forever.
+* Estimate helpers now preserve the server-selected point statistic, interval
+  kind, interval level, and additive tagged metadata. They no longer hardcode
+  posterior/credible semantics or silently pad malformed parallel arrays.
+  Observed-vs-predicted helpers consume the current `Estimate` envelope and
+  retain PK/PD units and marker identity.
+* Successful responses are checked for required IDs, array alignment, page
+  consistency, declared table types, and other contract-critical shape
+  invariants. Malformed success payloads raise `vmx_response_error` rather than
+  being silently recycled, truncated, or attached to the wrong resource.
+* PK-only modeling previews now send `pd_markers = []`, matching PK-only model
+  build submission. Simulation inputs validate canonical `simdose_` IDs and
+  subject records, and dosing inputs can be passed to `vmx_wait()`.
+* `vmx_dosing()` exposes the separate dosing-event domain, and
+  `vmx_model_data()` includes `$dosing` while validating required table
+  availability metadata.
+* Polling stops immediately on any terminal state, surfaces safe server failure
+  copy, rejects unknown statuses and invalid controls, and uses resource-specific
+  long-running defaults. NCA, simulation, dosing-input, and model-build defaults
+  include a persistence cushion beyond their worker execution ceilings.
+* Nullable update fields can be explicitly cleared without allowing `NULL` for
+  required fields. OIDC caches now reject structurally invalid tokens and fail
+  loudly if secure atomic replacement does not succeed.
+* Prep-question tibbles now retain defaults, grouping, resolution hints,
+  referents, rationales, and data previews. Prep answers support idempotency
+  keys, data-version exports require the canonical matching envelope, and
+  create helpers reject malformed upload compositions, retry identifiers,
+  simulation bounds, and ambiguous scalar inputs before dispatch.
+* Study listing now exposes the API's `created_since` filter.
 
 * `vmx_login()` device-code prompt now matches the actual flow (GEN-2378).
   Because the browser is opened at `verification_uri_complete` (the URL that

R/client.R

@@ -30,15 +30,24 @@
 #' @return An object of class `vmx_client`.
 #' @export
 vmx_client <- function(base_url = NULL, token = NULL, ...) {
-  base_url <- trimws(base_url %||% Sys.getenv("VMX_API_BASE_URL", unset = ""))
-  token <- trimws(token %||% Sys.getenv("VMX_API_TOKEN", unset = ""))
+  base_url <- base_url %||% Sys.getenv("VMX_API_BASE_URL", unset = "")
+  token <- token %||% Sys.getenv("VMX_API_TOKEN", unset = "")
 
-  if (!nzchar(base_url)) {
+  if (!is.character(base_url) || length(base_url) != 1L ||
+      is.na(base_url) || !nzchar(trimws(base_url))) {
     vmx_abort(
-      "No API base URL. Set `base_url=` or the VMX_API_BASE_URL env var.",
+      "Set `base_url=` or VMX_API_BASE_URL to one non-empty URL.",
       class = "vmx_usage_error"
     )
   }
+  if (!is.character(token) || length(token) != 1L || is.na(token)) {
+    vmx_abort(
+      "`token` / VMX_API_TOKEN must be one string.",
+      class = "vmx_usage_error"
+    )
+  }
+  base_url <- trimws(base_url)
+  token <- trimws(token)
   # Resolve the bearer token via a *provider closure* re-invoked on every request
   # (see vmx_req), not a single string baked in here. A frozen OIDC access token
   # expires a few minutes into a persistent `con` and every later call then 401s

R/data_versions.R

@@ -6,7 +6,7 @@
 #' @param include_archived Include archived versions.
 #' @param eligible_for_modeling Optional modeling-eligibility filter.
 #' @param client A `vmx_client`.
-#' @return A tibble.
+#' @return A tibble containing all matching data versions.
 #' @export
 vmx_data_versions <- function(treatment = NULL, study = NULL,
                               include_archived = FALSE,
@@ -18,7 +18,7 @@ vmx_data_versions <- function(treatment = NULL, study = NULL,
     include_archived = include_archived,
     eligible_for_modeling = eligible_for_modeling
   )
-  vmx_items_to_tibble(vmx_paginate(client, "/data-versions", params))
+  vmx_paginate(client, "/data-versions", params)
 }
 
 #' Fetch one data version
@@ -27,7 +27,11 @@ vmx_data_versions <- function(treatment = NULL, study = NULL,
 #' @return A `vmx_data_version`.
 #' @export
 vmx_data_version <- function(id, client = vmx_client()) {
-  data <- vmx_get(client, paste0("/data-versions/", vmx_id(id, "dv")))
+  data_version_id <- vmx_id(id, "dv")
+  data <- vmx_get(client, paste0("/data-versions/", data_version_id))
+  vmx_validate_response_id(
+    data, "data_version_id", data_version_id, "data version"
+  )
   new_vmx_resource(data, "vmx_data_version", "data_version_id")
 }
 
@@ -46,12 +50,29 @@ vmx_data_version <- function(id, client = vmx_client()) {
 #' @export
 vmx_data_version_create <- function(dataset, uploads, prior_config = NULL,
                                     client = vmx_client()) {
+  dataset_id <- vmx_id(dataset, "ds", "dataset")
+  uploads <- vmx_nonempty_strings(
+    uploads, "uploads", unique = TRUE
+  )
+  upload_ids <- vapply(
+    uploads,
+    vmx_id,
+    character(1),
+    prefix = "upl",
+    arg = "uploads"
+  ) |> unname()
   body <- vmx_compact(list(
-    upload_ids = as.list(uploads),
+    upload_ids = as.list(upload_ids),
     prior_config_data_version_id = vmx_opt_id(prior_config, "dv", "prior_config")
   ))
-  data <- vmx_post(client, paste0("/datasets/", vmx_id(dataset, "ds", "dataset"),
-                                  "/data-versions"), body)
+  data <- vmx_post(
+    client,
+    paste0("/datasets/", dataset_id, "/data-versions"),
+    body
+  )
+  vmx_validate_response_id(
+    data, "dataset_id", dataset_id, "data-version creation"
+  )
   new_vmx_resource(data, "vmx_prep_status", "dataset_id")
 }
 
@@ -71,7 +92,21 @@ vmx_data_version_create <- function(dataset, uploads, prior_config = NULL,
 vmx_data_version_table <- function(dv, domain = c("subjects", "pk", "dosing", "pd", "labs", "covariates"),
                                    client = vmx_client()) {
   domain <- match.arg(domain)
-  tbl <- vmx_get(client, paste0("/data-versions/", vmx_id(dv, "dv"), "/tables/", domain))
+  dv_id <- vmx_id(dv, "dv")
+  tbl <- vmx_get(client, paste0("/data-versions/", dv_id, "/tables/", domain))
+  vmx_validate_response_id(tbl, "data_version_id", dv_id, "data-version table")
+  returned_domain <- vmx_response_scalar(
+    vmx_response_field(tbl, "domain", "data-version table.domain"),
+    "data-version table.domain",
+    type = "character",
+    nonempty = TRUE
+  )
+  if (!identical(returned_domain, domain)) {
+    vmx_abort_response(
+      "data-version table field 'domain' does not match the requested domain.",
+      field = "domain"
+    )
+  }
   vmx_dvtable_to_tibble(tbl)
 }
 
@@ -87,18 +122,46 @@ vmx_data_version_table <- function(dv, domain = c("subjects", "pk", "dosing", "p
 #' @return The export envelope (list), or, when `dest` is set, `dest` invisibly.
 #' @export
 vmx_data_version_export <- function(dv, dest = NULL, client = vmx_client()) {
-  envelope <- vmx_get(client, paste0("/data-versions/", vmx_id(dv, "dv"), "/export"))
+  data_version_id <- vmx_id(dv, "dv")
+  envelope <- vmx_get(
+    client, paste0("/data-versions/", data_version_id, "/export")
+  )
+  vmx_validate_response_id(
+    envelope, "data_version_id", data_version_id, "data-version export"
+  )
+  url <- vmx_response_scalar(
+    vmx_response_field(
+      envelope, "download_url", "data-version export.download_url"
+    ),
+    "data-version export.download_url",
+    type = "character",
+    nonempty = TRUE
+  )
   if (is.null(dest)) {
     return(envelope)
   }
-  url <- envelope$download_url %||% envelope$url
-  if (is.null(url)) {
-    vmx_abort("Export envelope did not contain a download URL.", class = "vmx_api_error")
+  if (!is.character(dest) || length(dest) != 1L || is.na(dest) ||
+      !nzchar(trimws(dest))) {
+    vmx_abort(
+      "`dest` must be one non-empty file path.",
+      class = "vmx_usage_error"
+    )
   }
   # Anonymous request: the signed URL carries its own credentials; sending the
   # API bearer to GCS would leak the token and is rejected anyway.
-  httr2::request(url) |>
-    httr2::req_perform(path = dest)
+  tryCatch(
+    httr2::request(url) |>
+      httr2::req_perform(path = dest),
+    error = function(e) {
+      # Do not attach the transport condition: it may contain the signed URL
+      # (and therefore its temporary credentials).
+      vmx_abort(
+        "Data-version export download failed.",
+        class = "vmx_api_error",
+        reason = "export_download_failed"
+      )
+    }
+  )
   invisible(dest)
 }
 
@@ -125,7 +188,13 @@ vmx_data_version_unarchive <- function(dv, client = vmx_client()) {
 #' @noRd
 vmx_set_dv_archive <- function(dv, archived, reason, client) {
   body <- vmx_compact(list(archived = archived, reason = reason))
-  data <- vmx_patch(client, paste0("/data-versions/", vmx_id(dv, "dv"), "/archive"), body)
+  data_version_id <- vmx_id(dv, "dv")
+  data <- vmx_patch(
+    client, paste0("/data-versions/", data_version_id, "/archive"), body
+  )
+  vmx_validate_response_id(
+    data, "data_version_id", data_version_id, "data-version archive update"
+  )
   new_vmx_resource(data, "vmx_data_version", "data_version_id")
 }
 
@@ -140,7 +209,7 @@ vmx_subjects <- function(dv, client = vmx_client()) {
   vmx_data_version_table(dv, "subjects", client = client)
 }
 
-#' PK observations + events table
+#' PK observations table
 #' @param dv A data-version id or `vmx_data_version`.
 #' @param client A `vmx_client`.
 #' @return A tibble.
@@ -149,6 +218,15 @@ vmx_pk <- function(dv, client = vmx_client()) {
   vmx_data_version_table(dv, "pk", client = client)
 }
 
+#' Dosing events table
+#' @param dv A data-version id or `vmx_data_version`.
+#' @param client A `vmx_client`.
+#' @return A tibble.
+#' @export
+vmx_dosing <- function(dv, client = vmx_client()) {
+  vmx_data_version_table(dv, "dosing", client = client)
+}
+
 #' PD observations table
 #' @param dv A data-version id or `vmx_data_version`.
 #' @param client A `vmx_client`.
@@ -160,26 +238,27 @@ vmx_pd <- function(dv, client = vmx_client()) {
 
 #' Fetch model-ready tidy tables for a data version
 #'
-#' Returns a `vmx_model_data` bundle with `$subjects`, `$pk`, `$pd` (each a
-#' tibble, or `NULL` when the DataVersion has no such prepared table), and
-#' `$meta` (units, time bases, PD-marker manifest, subject count) read from the
-#' DataVersion. Only domains flagged in the DV's `table_availability` are
-#' fetched, so absent optional tables don't 404.
+#' Returns a `vmx_model_data` bundle with `$subjects`, `$pk`, `$dosing`, and
+#' `$pd` (each a tibble, or `NULL` when the DataVersion has no such prepared
+#' table), and `$meta` (units, time bases, PD-marker manifest, subject count)
+#' read from the DataVersion. Only domains flagged in the DV's
+#' `table_availability` are fetched, so absent optional tables don't 404.
 #'
 #' @param dv A data-version id or `vmx_data_version`.
 #' @param client A `vmx_client`.
 #' @return A `vmx_model_data` object.
 #' @export
 vmx_model_data <- function(dv, client = vmx_client()) {
   dv_obj <- if (inherits(dv, "vmx_data_version")) dv else vmx_data_version(vmx_id(dv, "dv"), client = client)
-  avail <- dv_obj$table_availability %||% list()
+  avail <- vmx_table_availability(dv_obj)
   fetch <- function(domain) {
     if (isTRUE(avail[[domain]])) vmx_data_version_table(dv_obj, domain, client = client) else NULL
   }
   structure(
     list(
       subjects = fetch("subjects"),
       pk = fetch("pk"),
+      dosing = fetch("dosing"),
       pd = fetch("pd"),
       meta = list(
         data_version_id = dv_obj$data_version_id,
@@ -195,13 +274,37 @@ vmx_model_data <- function(dv, client = vmx_client()) {
   )
 }
 
+vmx_table_availability <- function(dv) {
+  avail <- vmx_response_field(
+    dv, "table_availability", "data version.table_availability"
+  )
+  required <- c("subjects", "pk", "dosing", "pd", "labs", "covariates")
+  if (!is.list(avail) || is.null(names(avail)) ||
+      any(!nzchar(names(avail))) || anyDuplicated(names(avail)) ||
+      !all(required %in% names(avail))) {
+    vmx_abort_response(
+      "field 'data version.table_availability' is missing required domains.",
+      field = "table_availability"
+    )
+  }
+  for (domain in names(avail)) {
+    vmx_response_scalar(
+      avail[[domain]],
+      paste0("data version.table_availability.", domain),
+      type = "logical"
+    )
+  }
+  avail
+}
+
 #' @export
 print.vmx_model_data <- function(x, ...) {
   cli::cli_text("{.cls <vmx_model_data>} {x$meta$data_version_id %||% ''}")
   dims <- function(t) if (is.null(t)) "-" else paste0(nrow(t), "x", ncol(t))
   cli::cli_bullets(c(
     "*" = "subjects: {dims(x$subjects)}",
     "*" = "pk: {dims(x$pk)}",
+    "*" = "dosing: {dims(x$dosing)}",
     "*" = "pd: {dims(x$pd)}"
   ))
   invisible(x)