🌵 Adds GitHub API route to get application access token

.Renviron.example

@@ -4,3 +4,7 @@
 # might be more appropriately kept as project-specific values.)
 # Contact a member of SU Data Science to get the required values for these.
 AZ_STORAGE_EP =
+AZ_TABLE_EP =
+RESKIT_GITHUB_APP_PAT=
+RESKIT_GITHUB_APP_PRIVATE_KEY=
+RESKIT_GITHUB_APP_ID=

DESCRIPTION

@@ -27,7 +27,7 @@ Roxygen: list(markdown = TRUE)
 Config/testthat/edition: 3
 Depends: R (>= 4.5.0)
 Imports:
-    azkit (>= 0.3.0),
+    azkit (>= 0.3.2),
     base64enc,
     dplyr,
     forcats,

R/get_github_file.R

@@ -1,48 +1,137 @@
-#' Read in a file from the NHP Outputs app GitHub repo
+#' Read in a file from a Strategy Unit GitHub repo
 #'
+#' @param repo string. The name of the repository in which to find the file
+#' @param folder string. The folder where the file is located. Set to `""` to
+#'   use the root folder of the repo.
 #' @param file string. The name of the file to read in
-#' @param folder string. The folder where the file is located. `"inst"` by
-#'   default. Set to `""` to use the root folder of the repo.
+#' @param pat A GitHub Personal Access Token. Generated by [get_github_pat] by
+#'  default, via a custom Strategy Unit app, but you might pass in a personal
+#'  token if you prefer or if that pipeline is not working. If you have a token
+#'  stored as an environment variable called "RESKIT_GH_APP_PAT", this will be
+#'  be used, saving the need to make any API calls.
 #' @returns The file contents as a stream, to be passed to a reader function
 #' @keywords internal
-get_outputs_gh_file <- function(file, folder = "inst") {
-  httr2::request("https://api.github.com") |>
+get_su_gh_file <- function(repo, folder, file, pat = get_github_pat()) {
+  ua_string <- "The-Strategy-Unit/nhp_reskit R package"
+  resp <- httr2::request("https://api.github.com") |>
     httr2::req_url_path_append("repos") |>
     httr2::req_url_path_append("The-Strategy-Unit") |>
-    httr2::req_url_path_append("nhp_outputs") |>
+    httr2::req_url_path_append(repo) |>
     httr2::req_url_path_append("contents") |>
     httr2::req_url_path_append(folder) |>
     httr2::req_url_path_append(file) |>
+    httr2::req_headers(`User-Agent` = ua_string) |>
+    httr2::req_headers(`X-GitHub-Api-Version` = "2026-03-10") |>
+    httr2::req_headers(`Accept` = "application/vnd.github+json") |>
+    httr2::req_auth_bearer_token(pat) |>
     httr2::req_perform() |>
-    httr2::resp_check_status() |>
-    httr2::resp_body_json() |>
-    purrr::pluck("content") |>
-    base64enc::base64decode()
+    httr2::resp_check_status()
+
+  base64enc::base64decode(httr2::resp_body_json(resp)[["content"]])
 }
 
 
-#' Read in a file from the TPMAs GitHub repo
+#' Read in a file from the NHP Outputs app GitHub repo
 #'
-#' @param file string. The name of the file to read in
-#' @param folder string. The folder where the file is located. `"reference"` by
-#'   default. Set to `""` to use the root folder of the repo.
-#' @returns The file contents as a stream, to be passed to a reader function
+#' @param ... Pass the name of the file in via `...`
 #' @keywords internal
-get_tpmas_gh_file <- function(file, folder = "reference") {
-  httr2::request("https://api.github.com") |>
-    httr2::req_url_path_append("repos") |>
-    httr2::req_url_path_append("The-Strategy-Unit") |>
-    httr2::req_url_path_append("TPMAs") |>
-    httr2::req_url_path_append("contents") |>
-    httr2::req_url_path_append(folder) |>
-    httr2::req_url_path_append(file) |>
-    httr2::req_perform() |>
-    httr2::resp_check_status() |>
-    httr2::resp_body_json() |>
-    purrr::pluck("content") |>
-    base64enc::base64decode()
+get_outputs_gh_file <- function(...) {
+  purrr::partial(get_su_gh_file, repo = "nhp_outputs", folder = "inst")(...)
 }
 
 
+#' Read in a file from the TPMAs GitHub repo
+#'
+#' @inheritParams get_outputs_gh_file
+#' @keywords internal
+get_tpmas_gh_file <- function(...) {
+  purrr::partial(get_su_gh_file, repo = "TPMAs", folder = "reference")(...)
+}
+
 possibly_get_outputs_gh_file <- \(...) purrr::possibly(get_outputs_gh_file)(...)
 possibly_get_tpmas_gh_file <- \(...) purrr::possibly(get_tpmas_gh_file)(...)
+
+
+#' Return a GitHub access token
+#'
+#' If the envvar "RESKIT_GH_APP_PAT" is set, this will be used as the token.
+#' Otherwise, the envvars "RESKIT_GH_APP_ID" and "RESKIT_GH_APP_PRIVATE_KEY"
+#'  must be set. The former as a string, the latter as a path to a PEM key.
+#' @returns A personal access token (PAT) with permissions granted to the app
+#' @keywords internal
+get_github_pat <- function() {
+  pat <- Sys.getenv("RESKIT_GH_APP_PAT")
+  if (nzchar(pat)) {
+    pat
+  } else {
+    msg1 <- "Environment variable {.var RESKIT_GH_APP_ID} is not set"
+    msg2 <- "Environment variable {.var RESKIT_GH_APP_PRIVATE_KEY} is not set"
+    azkit::check_nzchar(Sys.getenv("RESKIT_GH_APP_ID"), msg1)
+    azkit::check_nzchar(Sys.getenv("RESKIT_GH_APP_PRIVATE_KEY"), msg2)
+    get_github_pat_via_api()
+  }
+}
+
+
+#' Return a GitHub PAT via the API using the reskit authentication GitHub app
+#'
+#' The envvars "RESKIT_GH_APP_ID" and "RESKIT_GH_APP_PRIVATE_KEY" must
+#'  be set. The former as a string, the latter as a path to a PEM key.
+#' @returns An access token (PAT) as a string
+#' @keywords internal
+get_github_pat_via_api <- function() {
+  ua_string <- "The-Strategy-Unit/nhp_reskit R package"
+  jwt <- get_github_jwt()
+  installation_id <- get_github_app_installation_id(jwt)
+  req <- httr2::request("https://api.github.com/")
+  resp <- req |>
+    httr2::req_url_path_append("app") |>
+    httr2::req_url_path_append("installations") |>
+    httr2::req_url_path_append(installation_id) |>
+    httr2::req_url_path_append("access_tokens") |>
+    httr2::req_auth_bearer_token(jwt) |>
+    httr2::req_headers(`User-Agent` = ua_string) |>
+    httr2::req_headers(`X-GitHub-Api-Version` = "2026-03-10") |>
+    httr2::req_headers(`Accept` = "application/vnd.github+json") |>
+    httr2::req_method("POST") |>
+    httr2::req_perform() |>
+    httr2::resp_check_status()
+
+  httr2::resp_body_json(resp)[["token"]]
+}
+
+
+#' Returns the installation ID for the reskit GitHub app
+#'
+#' The envvars "RESKIT_GH_APP_ID" and "RESKIT_GH_APP_PRIVATE_KEY" must
+#'  be set. The former as a string, the latter as a path to a PEM key.
+#' @param jwt JWT for the app. Defaults to the output of `get_github_jwt()`.
+#' @returns An installation ID as an integer
+#' @keywords internal
+get_github_app_installation_id <- function(jwt = get_github_jwt()) {
+  ua_string <- "The-Strategy-Unit/nhp_reskit R package"
+  req <- httr2::request("https://api.github.com/")
+  resp <- req |>
+    httr2::req_url_path_append("app") |>
+    httr2::req_url_path_append("installations") |>
+    httr2::req_auth_bearer_token(jwt) |>
+    httr2::req_headers(`User-Agent` = ua_string) |>
+    httr2::req_headers(`X-GitHub-Api-Version` = "2026-03-10") |>
+    httr2::req_headers(`Accept` = "application/vnd.github+json") |>
+    httr2::req_perform() |>
+    httr2::resp_check_status()
+  httr2::resp_body_json(resp)[[1]][["id"]]
+}
+
+
+#' Returns a GitHub JWT for the reskit authentication app
+#'
+#' The envvars "RESKIT_GH_APP_ID" and "RESKIT_GH_APP_PRIVATE_KEY" must
+#'  be set. The former as a string, the latter as a path to a PEM key.
+#' @returns A JSON Web Token (JWT) as a string
+#' @keywords internal
+get_github_jwt <- function() {
+  claim <- httr2::jwt_claim(Sys.getenv("RESKIT_GH_APP_ID"))
+  key <- openssl::read_key(Sys.getenv("RESKIT_GH_APP_PRIVATE_KEY"))
+  httr2::jwt_encode_sig(claim, key)
+}

R/get_principal_pods.R

@@ -1,35 +1,20 @@
 #' Prepare a lookup table with activity type labels and PoD labels for each PoD
 #'
-#' @param use_local logical. Whether to use a local file (internal to the
-#'  reskit package) or attempt to pull the lookup file from GitHub. Default is
-#'  `FALSE`, meaning it will use the GitHub route. If you want to always use a
-#'  local file (for example, for fully offline working), you can set the
-#'  `reskit.local.lookups` option to `TRUE` using
-#'  `options(reskit.local.lookups = TRUE)` or `withr::with_options()`
 #' @returns A tibble
 #' @export
-get_detailed_pods <- function(use_local = FALSE) {
-  use_local <- getOption("reskit.local.lookups") %||% use_local
-  yaml_data <- system.file("pod_measures.yml", package = "reskit") |>
-    yaml12::read_yaml()
-  yaml_data_from_gh <- NULL
-  if (!use_local) {
-    yaml_raw <- possibly_get_outputs_gh_file("golem-config.yml")
-    if (!is.null(yaml_raw)) {
-      yaml_data_from_gh <- yaml12::parse_yaml(readr::read_lines(yaml_raw)) |>
-        purrr::pluck("default")
-    }
-  }
-  yaml_data <- yaml_data_from_gh %||% yaml_data
+get_detailed_pods <- function() {
+  yaml_raw <- possibly_get_outputs_gh_file("golem-config.yml")
+  msg <- "Unable to read POD lookup file from GitHub"
+  azkit::check_that(yaml_raw, is_not_null, msg)
+  yaml_data <- yaml12::parse_yaml(readr::read_lines(yaml_raw))[["default"]]
   yaml_data |>
     purrr::pluck("pod_measures") |>
     purrr::map(list_to_tbl) |>
     purrr::list_rbind() |>
     dplyr::mutate(
       dplyr::across("pod_label", forcats::fct_inorder),
-      dplyr::across("activity_type_label", \(x) sub("patients$", "patient", x)),
       dplyr::across("activity_type_label", \(x) {
-        forcats::fct(x, levels = c("Inpatient", "Outpatient", "A&E"))
+        forcats::fct(x, levels = c("Inpatients", "Outpatients", "A&E"))
       })
     )
 }
@@ -42,8 +27,8 @@ get_detailed_pods <- function(use_local = FALSE) {
 #' @rdname get_detailed_pods
 #' @returns A tibble
 #' @export
-get_principal_pods <- function(use_local = FALSE) {
-  get_detailed_pods(use_local) |>
+get_principal_pods <- function() {
+  get_detailed_pods() |>
     dplyr::filter(dplyr::if_any("activity_type_label", \(x) x != "A&E")) |>
     dplyr::add_row(
       activity_type_label = "A&E",
@@ -53,7 +38,7 @@ get_principal_pods <- function(use_local = FALSE) {
     dplyr::mutate(
       dplyr::across("pod_label", forcats::fct_inorder),
       dplyr::across("activity_type_label", \(x) {
-        forcats::fct(x, levels = c("Inpatient", "Outpatient", "A&E"))
+        forcats::fct(x, levels = c("Inpatients", "Outpatients", "A&E"))
       })
     )
 }

R/helpers.R

@@ -120,6 +120,7 @@ relabel_ip_activity_types <- function(tbl) {
   tbl |>
     dplyr::mutate(
       dplyr::across("activity_type_label", \(x) {
+        x <- sub("s$", "", x)
         dplyr::if_else(
           x == "Inpatient",
           paste0(x, " ", uppercase_init(.data[["measure"]])),
@@ -177,36 +178,38 @@ get_tretspef_lookup <- function() {
 
 #' Prepare a lookup table for all current TPMAs
 #'
-#' @param use_local logical. Whether to use a local file (internal to the
-#'  reskit package) or attempt to pull the lookup file from GitHub. Default is
-#'  `FALSE`, meaning it will use the GitHub route. If you want to always use a
-#'  local file (for example, for fully offline working), you can set the
-#'  `reskit.local.lookups` option to `TRUE` using
-#'  `options(reskit.local.lookups = TRUE)` or `withr::with_options()`
-#' @returns A 4-column tibble, with columns `activity_type`, `change_factor`,
-#'  `strategy` and `tpma_label`
+#' @returns A 4-column tibble, with columns `strategy`, `activity_type`,
+#'  `change_factor` and `tpma_label`
 #' @export
-get_tpma_label_lookup <- function(use_local = FALSE) {
-  read_cols <- "cccc----c"
-  use_local <- getOption("reskit.local.lookups") %||% use_local
-  csv_data <- system.file("mitigator-lookup.csv", package = "reskit") |>
-    readr::read_csv(col_types = read_cols)
-  csv_data_from_gh <- NULL
-  if (!use_local) {
-    csv_data_raw <- possibly_get_tpmas_gh_file("mitigator-lookup.csv")
-    if (!is.null(csv_data_raw)) {
-      csv_data_from_gh <- readr::read_csv(csv_data_raw, col_types = read_cols)
-    }
-  }
-  csv_data <- csv_data_from_gh %||% csv_data
+get_tpma_label_lookup <- function() {
+  csv_data_raw <- possibly_get_tpmas_gh_file("tpma-lookup.csv")
+  msg <- "Unable to read TPMA lookup table from GitHub"
+  azkit::check_that(csv_data_raw, is_not_null, msg)
+  csv_data <- readr::read_csv(csv_data_raw, col_types = "-ccccc---c")
   csv_data |>
     dplyr::filter(dplyr::if_any("active_to", is.na)) |>
     dplyr::select(!"active_to") |>
-    dplyr::rename(
-      change_factor = "mitigator_type",
-      strategy = "mitigator_variable",
-      tpma_label = "mitigator_name"
-    )
+    dplyr::mutate(
+      tpma_label = glue::glue("{tpma_name} ({tpma_subtype})"),
+      dplyr::across("tpma_type", \(x) tolower(sub(" ", "_", x))),
+      dplyr::across("activity_type", convert_activity_type),
+      .keep = "unused"
+    ) |>
+    dplyr::rename(change_factor = "tpma_type", strategy = "tpma_variable")
+}
+
+
+#' Converts "In|Outpatients", "A&E" strings to "ip", "op" and "aae"
+#' @param x A character vector
+#' @returns A character vector
+#' @keywords internal
+convert_activity_type <- function(x) {
+  dplyr::recode_values(
+    x,
+    "A&E" ~ "aae",
+    "Inpatients" ~ "ip",
+    "Outpatients" ~ "op"
+  )
 }
 
 
@@ -216,3 +219,5 @@ get_tpma_label_lookup <- function(use_local = FALSE) {
 #' @returns A character vector: all values of x that match the regex in rx
 #' @keywords internal
 gregv <- \(x, rx, g = parent.frame()) grepv(glue::glue_data(g, rx), x)
+
+is_not_null <- \(x) !is.null(x)