From 533984d3e3d67cee9be091463e96a4d874e7e118 Mon Sep 17 00:00:00 2001 From: Jon Harmon Date: Mon, 16 Oct 2023 16:31:02 -0500 Subject: [PATCH] Refactor security data parsing. --- R/as_bk_data.R | 207 +++++++++++++++++++++ R/generate.R | 29 +-- R/security.R | 96 ++-------- R/utils.R | 16 ++ inst/templates/010-call.R | 2 +- inst/templates/020-security.R | 8 +- man/as_bk_data.Rd | 21 +++ tests/testthat/_fixtures/trello-010-call.R | 5 +- tests/testthat/test-utils.R | 11 ++ 9 files changed, 286 insertions(+), 109 deletions(-) create mode 100644 R/as_bk_data.R create mode 100644 man/as_bk_data.Rd diff --git a/R/as_bk_data.R b/R/as_bk_data.R new file mode 100644 index 0000000..8d01cf5 --- /dev/null +++ b/R/as_bk_data.R @@ -0,0 +1,207 @@ +#' Prepare rapid objects for beekeeper +#' +#' Convert `rapid` objects to lists of properties to use in beekeeper templates. +#' +#' @inheritParams rlang::args_dots_empty +#' @param x The object to coerce. Currently supports conversion of +#' [security_scheme_collection()] objects. +#' +#' @return A list. +#' @keywords internal +as_bk_data <- S7::new_generic( + "as_bk_data", + dispatch_args = "x" +) + +S7::method(as_bk_data, rapid::security_scheme_collection) <- function(x) { + if (!length(x)) { + return(list()) + } + security_schemes <- .security_schemes_collect(x) + return(.security_scheme_collection_finalize(security_schemes)) +} + +.security_schemes_collect <- function(x) { + purrr::pmap( + list( + x@name, + x@details, + x@description %|0|% rep(NA_character_, length(x@name)) + ), + .security_scheme_rotate + ) +} + +.security_scheme_rotate <- function(name, details, description) { + security_scheme <- c( + list( + name = snakecase::to_snake_case(name), + description = description + ), + as_bk_data(details) + ) + security_scheme$description <- .security_scheme_description_fill( + description, + security_scheme$type + ) + return(security_scheme) +} + +.security_scheme_description_fill <- function(description, type) { + if (is.na(description)) { + return( + switch( + type, + api_key = .security_scheme_description_api_key(), + NA_character_ + ) + ) + } + return(description) +} + +.security_scheme_description_api_key <- function() { + paste( + "An API key provided by the API provider.", + "This key is not clearly documented in the API description.", + "Check the API documentation for details." + ) +} + +.security_scheme_collection_finalize <- function(security_schemes) { + security_scheme_data <- c( + list( + has_security = TRUE, + security_schemes = security_schemes + ), + .security_args_compile(security_schemes) + ) + return(security_scheme_data) +} + +.security_args_compile <- function(security_schemes) { + security_args <- sort(unique(purrr::map_chr(security_schemes, "arg_name"))) + return(list( + security_arg_names = security_args, + security_arg_list = .collapse_comma( + glue::glue("{security_args} = {security_args}") + ), + security_arg_helps = .security_arg_help_generate( + security_schemes, + security_args + ) + )) +} + +.security_arg_help_generate <- function(security_schemes, security_args) { + security_arg_description <- rlang::set_names( + purrr::map_chr(security_schemes, "description"), + purrr::map_chr(security_schemes, "arg_name") + ) + security_arg_description <- unname(security_arg_description[security_args]) + return( + purrr::map2( + security_arg_description, + security_args, + function(arg_description, arg_name) { + list(name = arg_name, description = arg_description) + } + ) + ) +} + +S7::method(as_bk_data, rapid::security_scheme_details) <- function(x) { + purrr::map(x, as_bk_data) +} + +S7::method(as_bk_data, rapid::api_key_security_scheme) <- function(x) { + if (length(x)) { + return( + list( + parameter_name = x@parameter_name, + arg_name = stringr::str_remove( + snakecase::to_snake_case(x@parameter_name), + "^x_" + ), + location = x@location, + type = "api_key", + api_key = TRUE + ) + ) + } + return(list()) +} + +S7::method(as_bk_data, S7::class_any) <- function(x) { + cli::cli_warn( + "No method for as_bk_data() for class {.cls class(x)}." + ) + return(list()) +} + +# S7::method(as_bk_data, rapid::oauth2_authorization_code_flow) <- function(x) { +# if (!length(x)) { +# return(list()) +# } +# return( +# list( +# refresh_url = x@refresh_url, +# scopes = as_bk_data(x@scopes), +# authorization_url = x@authorization_url, +# token_url = x@token_url +# ) +# ) +# } + +# S7::method(as_bk_data, rapid::oauth2_implicit_flow) <- function(x) { +# if (!length(x)) { +# return(list()) +# } +# return( +# list( +# refresh_url = x@refresh_url, +# scopes = as_bk_data(x@scopes), +# authorization_url = x@authorization_url +# ) +# ) +# } + +# S7::method(as_bk_data, rapid::scopes) <- function(x) { +# if (!length(x)) { +# return(list()) +# } +# return( +# list( +# name = x@name, +# description = x@description +# ) +# ) +# } + +# S7::method(as_bk_data, rapid::oauth2_token_flow) <- function(x) { +# if (!length(x)) { +# return(list()) +# } +# return( +# list( +# refresh_url = x@refresh_url, +# scopes = as_bk_data(x@scopes), +# token_url = x@token_url +# ) +# ) +# } + +# S7::method(as_bk_data, rapid::oauth2_security_scheme) <- function(x) { +# if (!length(x)) { +# return(list()) +# } +# return( +# list( +# implicit_flow = as_bk_data(x@implicit_flow), +# password_flow = as_bk_data(x@password_flow), +# client_credentials_flow = as_bk_data(x@client_credentials_flow), +# authorization_code_flow = as_bk_data(x@authorization_code_flow), +# type = "oauth2" +# ) +# ) +# } diff --git a/R/generate.R b/R/generate.R index 7455e4f..eadfa27 100644 --- a/R/generate.R +++ b/R/generate.R @@ -17,15 +17,7 @@ generate_pkg <- function(config_file = "_beekeeper.yml", config <- .read_config(config_file) api_definition <- .read_api_definition(config_file, config$rapid_file) .prepare_r() - - touched_files <- .generate_basics( - api_title = config$api_title, - api_abbr = config$api_abbr, - base_url = api_definition@servers@url, - pkg_agent = pkg_agent, - security_schemes = api_definition@components@security_schemes - ) - + touched_files <- .generate_basics(config, api_definition, pkg_agent) return(invisible(touched_files)) } @@ -35,17 +27,16 @@ generate_pkg <- function(config_file = "_beekeeper.yml", ) } -.generate_basics <- function(api_title, - api_abbr, - base_url, - pkg_agent, - security_schemes) { - security_data <- .generate_security(api_abbr, security_schemes) +.generate_basics <- function(config, api_definition, pkg_agent) { + security_data <- .generate_security( + config$api_abbr, + api_definition@components@security_schemes + ) data <- list( - api_title = .stabilize_chr_scalar_nonempty(api_title), - api_abbr = .stabilize_chr_scalar_nonempty(api_abbr), - base_url = .stabilize_chr_scalar_nonempty(base_url), + api_title = .stabilize_chr_scalar_nonempty(config$api_title), + api_abbr = .stabilize_chr_scalar_nonempty(config$api_abbr), + base_url = .stabilize_chr_scalar_nonempty(api_definition@servers@url), pkg_agent = .stabilize_chr_scalar_nonempty(pkg_agent) ) data <- c(data, security_data) @@ -58,7 +49,7 @@ generate_pkg <- function(config_file = "_beekeeper.yml", .bk_use_template( template = "test-010-call.R", dir = "tests/testthat", - data = list(api_abbr = api_abbr) + data = list(api_abbr = config$api_abbr) ) ) return(invisible(touched_files)) diff --git a/R/security.R b/R/security.R index b00c321..ad56235 100644 --- a/R/security.R +++ b/R/security.R @@ -1,53 +1,6 @@ -.check_api_key <- function(security_schemes) { - api_key_scheme_idx <- purrr::map_lgl( - security_schemes@details, - function(x) { - inherits(x, "rapid::api_key_security_scheme") - } - ) - if (any(api_key_scheme_idx)) { - return( - .extract_api_key_details(security_schemes, api_key_scheme_idx) - ) - } - return(list()) -} - -.extract_api_key_details <- function(security_schemes, api_key_scheme_idx) { - purrr::pmap( - list( - security_schemes@name[api_key_scheme_idx], - security_schemes@details[api_key_scheme_idx], - security_schemes@description[api_key_scheme_idx] - ), - function(security_scheme_name, details, description) { - if (is.na(description)) { - description <- "An API key provided by the API provider. This key is not clearly documented in the API description. Check the API documentation for details." - } - list( - name = snakecase::to_snake_case(security_scheme_name), - arg_name = stringr::str_remove( - snakecase::to_snake_case(details@parameter_name), - "^x_" - ), - location = details@location, - parameter_name = details@parameter_name, - description = description - ) - } - ) -} - .generate_security <- function(api_abbr, security_schemes) { - security_data <- list() - api_key_data <- .check_api_key(security_schemes) - if (length(api_key_data)) { - security_data$api_schemes <- api_key_data - security_data$has_security <- TRUE - security_arg_names <- sort( - unique(purrr::map_chr(api_key_data, "arg_name")) - ) - security_data$security_arg_names <- security_arg_names + security_data <- as_bk_data(security_schemes) + if (length(security_data)) { .bk_use_template( template = "020-security.R", data = c( @@ -55,44 +8,25 @@ api_abbr = api_abbr ) ) - security_data$security_args <- glue::glue_collapse( - glue::glue( - "{security_arg_names} = {security_arg_names}" - ), - sep = ",\n" - ) - - # For help. - security_arg_description <- rlang::set_names( - purrr::map_chr(api_key_data, "description"), - purrr::map_chr(api_key_data, "arg_name") - ) - security_arg_description <- unname( - security_arg_description[security_arg_names] - ) - security_data$security_arg_helps <- purrr::map2( - security_arg_description, - security_arg_names, - function(arg_description, arg_name) { - list( - name = arg_name, - description = arg_description - ) - } + security_data$security_signature <- .security_signature_generate( + security_data$security_arg_names, api_abbr ) + } + return(security_data) +} - env_vars <- toupper(glue::glue( - "{api_abbr}_{security_arg_names}" - )) - security_data$security_signature <- glue::glue_collapse( +.security_signature_generate <- function(security_arg_names, api_abbr) { + env_vars <- toupper(glue::glue( + "{api_abbr}_{security_arg_names}" + )) + return( + .collapse_comma_newline( c( "", glue::glue( "{security_arg_names} = Sys.getenv(\"{env_vars}\")" ) - ), - sep = ",\n" + ) ) - } - return(security_data) + ) } diff --git a/R/utils.R b/R/utils.R index c21a264..7029846 100644 --- a/R/utils.R +++ b/R/utils.R @@ -42,3 +42,19 @@ call = call ) } + +`%|0|%` <- function(x, y) { + if (!length(x)) { + y + } else { + x + } +} + +.collapse_comma <- function(x) { + glue::glue_collapse(x, sep = ", ") +} + +.collapse_comma_newline <- function(x) { + glue::glue_collapse(x, sep = ",\n") +} diff --git a/inst/templates/010-call.R b/inst/templates/010-call.R index 19ca9cd..78ed831 100644 --- a/inst/templates/010-call.R +++ b/inst/templates/010-call.R @@ -19,6 +19,6 @@ method = method, user_agent = "{{pkg_agent}}"{{#has_security}}, security_fn = {{api_abbr}}_security, - security_args = list({{security_args}}){{/has_security}} + security_args = list({{security_arg_list}}){{/has_security}} ) } diff --git a/inst/templates/020-security.R b/inst/templates/020-security.R index 3cfe73f..0b3866c 100644 --- a/inst/templates/020-security.R +++ b/inst/templates/020-security.R @@ -13,17 +13,17 @@ return(req) } -{{#api_schemes}} +{{#security_schemes}} {{#description}} # {{description}} {{/description}} -{{api_abbr}}_security_{{name}} <- function(req, {{arg_name}}) { +{{api_abbr}}_security_{{name}} <- function(req, {{#api_key}}{{arg_name}}) { nectar::security_api_key( req, location = "{{location}}", parameter_name = "{{parameter_name}}", api_key = {{arg_name}} ) -} +}{{/api_key}} -{{/api_schemes}} +{{/security_schemes}} diff --git a/man/as_bk_data.Rd b/man/as_bk_data.Rd new file mode 100644 index 0000000..94f060a --- /dev/null +++ b/man/as_bk_data.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/as_bk_data.R +\name{as_bk_data} +\alias{as_bk_data} +\title{Prepare rapid objects for beekeeper} +\usage{ +as_bk_data(x, ...) +} +\arguments{ +\item{x}{The object to coerce. Currently supports conversion of +\code{\link[=security_scheme_collection]{security_scheme_collection()}} objects.} + +\item{...}{These dots are for future extensions and must be empty.} +} +\value{ +A list. +} +\description{ +Convert \code{rapid} objects to lists of properties to use in beekeeper templates. +} +\keyword{internal} diff --git a/tests/testthat/_fixtures/trello-010-call.R b/tests/testthat/_fixtures/trello-010-call.R index 5edcbd1..bdaad81 100644 --- a/tests/testthat/_fixtures/trello-010-call.R +++ b/tests/testthat/_fixtures/trello-010-call.R @@ -22,9 +22,6 @@ trello_call_api <- function(path, method = method, user_agent = "TESTPKG (https://example.com)", security_fn = trello_security, - security_args = list( - key = key, - token = token - ) + security_args = list(key = key, token = token) ) } diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 62d4f2c..589527a 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -5,3 +5,14 @@ test_that(".assert_is_pkg() errors informatively for non-packages", { transform = scrub_tempdir ) }) + +test_that("%|0|% works", { + expect_identical( + character() %|0|% "foo", + "foo" + ) + expect_identical( + "foo" %|0|% "bar", + "foo" + ) +})