Refactor security data parsing.

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"
+#     )
+#   )
+# }

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))

R/security.R

@@ -1,98 +1,32 @@
-.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(
         security_data,
         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)
+  )
 }

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")
+}