Add security requirements objects

DESCRIPTION

@@ -52,6 +52,7 @@ Collate:
     'info-license.R'
     'info.R'
     'rapid-package.R'
+    'security_requirements.R'
     'servers-server_variables.R'
     'servers-string_replacements.R'
     'servers.R'

NAMESPACE

@@ -12,6 +12,7 @@ export(as_oauth2_security_scheme)
 export(as_oauth2_token_flow)
 export(as_rapid)
 export(as_scopes)
+export(as_security_requirements)
 export(as_security_scheme)
 export(as_security_scheme_collection)
 export(as_security_scheme_details)
@@ -28,6 +29,7 @@ export(oauth2_security_scheme)
 export(oauth2_token_flow)
 export(rapid)
 export(scopes)
+export(security_requirements)
 export(security_scheme_collection)
 export(security_scheme_details)
 export(server_variables)

R/as.R

@@ -35,7 +35,7 @@
       "{.arg {x_arg}} must have names {.or {.val {valid_names}}}.",
       "*" = "Any other names are ignored."
     ),
-    class = "rapid_missing_names",
+    class = "rapid_error_missing_names",
     call = call
   )
 }

R/components-security_scheme-oauth2-scopes.R

@@ -39,12 +39,10 @@ scopes <- S7::new_class(
   ),
   constructor = function(name = character(),
                          description = character()) {
-    name <- name %|0|% character()
-    description <- description %|0|% character()
     S7::new_object(
       S7::S7_object(),
-      name = name %||% character(),
-      description = description %||% character()
+      name = name %|0|% character(),
+      description = description %|0|% character()
     )
   },
   validator = function(self) {

R/properties.R

@@ -47,3 +47,29 @@ enum_property <- function(x_arg) {
     }
   )
 }
+
+list_of_characters <- function(x_arg, ...) {
+  S7::new_property(
+    name = x_arg,
+    class = class_list,
+    setter = function(self, value) {
+      call <- rlang::caller_env(3)
+      value <- as.list(value)
+      value <- purrr::map(
+        value,
+        function(x) {
+          x <- x %|0|% character()
+          stbl::stabilize_chr(
+            x,
+            allow_na = FALSE,
+            x_arg = x_arg,
+            call = call,
+            ...
+          )
+        }
+      )
+      S7::prop(self, x_arg) <- value
+      self
+    }
+  )
+}

R/security_requirements.R

@@ -0,0 +1,125 @@
+#' @include properties.R
+NULL
+
+#' Security schemes required to execute an operation
+#'
+#' The object lists the required security schemes to execute an operation or
+#' operations.
+#'
+#' @inheritParams rlang::args_dots_empty
+#' @param name Character vector (required). The names must correspond to
+#'   security schemes declared in the `security_schemes` property of a
+#'   [component_collection()].
+#' @param required_scopes A list of character vectors, each of which describe
+#'   the scopes required for this security scheme. The vector corresponding to a
+#'   given `name` can be empty.
+#'
+#' @return A `security_requirements` S7 object with references of security
+#'   required for operations.
+#' @export
+#' @examples
+#' security_requirements()
+#' security_requirements(
+#'   name = c("oauth2", "internalApiKey"),
+#'   required_scopes = list(
+#'     c("user", "user:email", "user:follow"),
+#'     character()
+#'   )
+#' )
+security_requirements <- S7::new_class(
+  "security_requirements",
+  package = "rapid",
+  properties = list(
+    name = class_character,
+    required_scopes = list_of_characters("required_scopes"),
+    rapid_class_requirement = S7::new_property(
+      getter = function(self) {
+        "security_scheme"
+      }
+    )
+  ),
+  constructor = function(name = character(), ..., required_scopes = list()) {
+    name <- name %|0|% character()
+    required_scopes <- required_scopes %|0|%
+      purrr::rep_along(name, list(character()))
+    S7::new_object(
+      S7::S7_object(),
+      name = name,
+      required_scopes = required_scopes
+    )
+  },
+  validator = function(self) {
+    validate_parallel(
+      self,
+      "name",
+      required = "required_scopes"
+    )
+  }
+)
+
+S7::method(length, security_requirements) <- function(x) {
+  length(x@name)
+}
+
+#' Coerce lists to as_security_requirements objects
+#'
+#' `as_security_requirements()` turns an existing object into a
+#' `security_requirements` object. This is in contrast with
+#' [security_requirements()], which builds a `security_requirements` from
+#' individual properties.
+#'
+#' @inheritParams rlang::args_dots_empty
+#' @inheritParams rlang::args_error_context
+#' @param x The object to coerce. Must be empty or be a list containing a single
+#'   list named "security_schemes", or a name that can be coerced to
+#'   "security_schemes" via [snakecase::to_snake_case()]. Additional names are
+#'   ignored.
+#'
+#' @return A `security_requirements` object as returned by
+#'   [security_requirements()].
+#' @export
+#'
+#' @examples
+#' as_security_requirements()
+#' as_security_requirements(
+#'   list(
+#'     list(
+#'       oauth2 = c("user", "user:email", "user:follow")
+#'     ),
+#'     list(internalApiKey = list())
+#'   )
+#' )
+as_security_requirements <- S7::new_generic(
+  "as_security_requirements",
+  dispatch_args = "x"
+)
+
+S7::method(as_security_requirements, security_requirements) <- function(x) {
+  x
+}
+
+S7::method(as_security_requirements, class_list) <- function(x, ..., arg = rlang::caller_arg(x)) {
+  force(arg)
+  x <- .list_remove_wrappers(x)
+
+  if (!rlang::is_named2(x)) {
+    cli::cli_abort(
+      "{.arg {arg}} must be a named list.",
+    )
+  }
+  security_requirements(
+    name = names(x),
+    required_scopes = unname(x)
+  )
+}
+
+S7::method(as_security_requirements, class_missing | NULL) <- function(x) {
+  security_requirements()
+}
+
+S7::method(as_security_requirements, class_any) <- function(x, ..., arg = rlang::caller_arg(x)) {
+  cli::cli_abort(
+    "Can't coerce {.arg {arg}} {.cls {class(x)}} to {.cls security_requirements}.",
+    class = "rapid_error_unknown_coercion"
+  )
+}

R/utils.R

@@ -26,3 +26,11 @@
 .empty_to_na <- function(x) {
   x %|0|% NA
 }
+
+.list_remove_wrappers <- function(x) {
+  if (is.list(x) && !rlang::is_named(x)) {
+    x <- purrr::list_c(x)
+    x <- .list_remove_wrappers(x)
+  }
+  x
+}

R/validate_in.R

@@ -43,9 +43,20 @@ validate_in_fixed <- function(obj,
   }
 }
 
-.msg_some_not_in_fixed <- function(value_name, enums, missing_msgs) {
+.msg_some_not_in_fixed <- function(value_name,
+                                   enums,
+                                   missing_msgs,
+                                   enum_name = "the designated values") {
+  enum_name <- cli::format_inline(enum_name)
   c(
-    cli::format_inline("{.arg {value_name}} must be one of {.or {.val {enums}}}."),
+    cli::format_inline("{.arg {value_name}} must be one of {enum_name}."),
     missing_msgs
   )
 }
+
+validate_in_specific <- function(values, enums, value_name, ...) {
+  missing_msgs <- .check_all_in_enums(values, rep(list(enums), length(values)))
+  if (length(missing_msgs)) {
+    return(.msg_some_not_in_fixed(value_name, enums, missing_msgs, ...))
+  }
+}

R/zz-rapid.R

@@ -11,9 +11,11 @@ NULL
 #' @param servers A `servers` object defined by [servers()].
 #' @param components A `component_collection` object defined by
 #'   [component_collection()].
+#' @param security A `security_requirements` object defined by
+#'   [security_requirements()].
 #'
-#' @return A `rapid` S7 object, with properties `info`, `servers`, and
-#'   `components`.
+#' @return A `rapid` S7 object, with properties `info`, `servers`, `components`,
+#'   and `security`.
 #' @export
 #'
 #' @seealso [as_rapid()] for coercing objects to `rapid`.
@@ -55,26 +57,47 @@ rapid <- S7::new_class(
   properties = list(
     info = info,
     servers = servers,
-    components = component_collection
+    components = component_collection,
+    security = security_requirements
   ),
   constructor = function(info = class_missing,
                          ...,
                          servers = class_missing,
-                         components = component_collection()) {
+                         components = component_collection(),
+                         security = security_requirements()) {
     check_dots_empty()
     S7::new_object(
       S7::S7_object(),
       info = as_info(info),
       servers = as_servers(servers),
-      components = as_component_collection(components)
+      components = as_component_collection(components),
+      security = as_security_requirements(security)
     )
   },
   validator = function(self) {
-    validate_lengths(
-      self,
-      key_name = "info",
-      optional_any = c("components", "servers")
+    c(
+      msgs <- validate_lengths(
+        self,
+        key_name = "info",
+        optional_any = c("components", "security", "servers")
+      ),
+      validate_in_specific(
+        values = self@security@name,
+        enums = self@components@security_schemes@name,
+        value_name = "security",
+        enum_name = "the {.arg security_schemes} defined in {.arg components}"
+      )
     )
+
+    # if (!all(self@security@name %in% self@components@security_schemes@name)) {
+    #   msgs <- c(
+    #     msgs,
+    #     cli::format_inline(
+    #       "{.arg security} must reference {.arg security_schemes} defined in {.arg components}."
+    #     )
+    #   )
+    # }
+    # msgs
   }
 )
 
@@ -108,10 +131,10 @@ S7::method(as_rapid, rapid) <- function(x) {
 S7::method(as_rapid, class_list) <- function(x) {
   rlang::try_fetch(
     {.as_class(x, rapid)},
-    rapid_missing_names = function(cnd) {
+    rapid_error_missing_names = function(cnd) {
       cli::cli_abort(
         "{.arg x} must be comprised of properly formed, supported elements.",
-        class = "rapid_unsupported_elements",
+        class = "rapid_error_unsupported_elements",
         parent = cnd
       )
     }

_pkgdown.yml

@@ -22,7 +22,7 @@ reference:
     - as_string_replacements
     - server_variables
     - as_server_variables
-  - title: components class
+  - title: component_collection class
     contents:
     - component_collection
     - as_component_collection
@@ -43,3 +43,7 @@ reference:
     - as_oauth2_token_flow
     - scopes
     - as_scopes
+  - title: security_requirements class
+    contents:
+    - security_requirements
+    - as_security_requirements