R/key.R

In shunsambongi/vault: Locally store encrypted secrets

# vec ---------------------------------------------------------------------

new_key <- function(x = character()) {
  new_secret(x, subclass = "vault_key")
}

methods::setOldClass(c("vault_key", "vault_secret", "vctrs_vctr"))

#' `key` vector
#'
#' This creates a character vector that represents keys that can be used to
#' encrypt/decrypt a secret. Usually, you will only need a single key at a time.
#' A key is similar to a [secret()], but is stricter with what values are
#' allowed. Currently, this checks that the input is a character vector with
#' only hexadecimal characters, and has 64 characters total. This represents a
#' 32-byte binary key.
#'
#' @param x
#'   * For `key()`: A hexadecimal character vector where `all(nchar(x) == 64)`
#'   * For `is_key()`: An object to test
#'   * For `as_key()`: An object to cast
#' @return An S3 vector of class `vault_key`
#' @export
#' @seealso
#'   * [generate_key()] to automatically generate a single key.
#'   * [use_vault_key()] to generate a default key used by this package.
key <- function(x = character()) {
  x <- vec_cast(x, character())
  validate_key(new_key(x))
}

#' @export
#' @rdname key
is_key <- function(x) {
  inherits(x, "vault_key")
}

#' @export
#' @rdname key
as_key <- function(x) {
  vec_cast(x, new_key())
}

#' @export
vec_ptype_abbr.vault_key <- function(x) "key"

#' @export
vec_ptype_full.vault_key <- function(x) "key"

#' @method vec_ptype2 vault_key
#' @export
#' @export vec_ptype2.vault_key
#' @rdname vault-vctrs
vec_ptype2.vault_key <- function(x, y, ...) {
  UseMethod("vec_ptype2.vault_key", y)
}

#' @method vec_ptype2.vault_key default
#' @export
vec_ptype2.vault_key.default <- function(x, y, ..., x_arg = "x", y_arg = "y") {
  vec_default_ptype2(x, y, x_arg = x_arg, y_arg = y_arg)
}

#' @method vec_ptype2.vault_key vault_key
#' @export
vec_ptype2.vault_key.vault_key <- function(x, y, ...) new_key()

#' @method vec_cast vault_key
#' @export
#' @export vec_cast.vault_key
#' @rdname vault-vctrs
vec_cast.vault_key <- function(x, to, ...) {
  UseMethod("vec_cast.vault_key")
}

#' @method vec_cast.vault_key default
#' @export
vec_cast.vault_key.default <- function(x, to, ...) vec_default_cast(x, to)

#' @method vec_cast.vault_key vault_key
#' @export
vec_cast.vault_key.vault_key <- function(x, to, ...) x

#' @method vec_cast.vault_key character
#' @export
vec_cast.vault_key.character <- function(x, to, ...) {
  key(x)
}

#' @method vec_cast.vault_key vault_secret
#' @export
vec_cast.vault_key.vault_secret <- function(x, to, ...) {
  key(vec_data(x))
}

#' @method vec_cast.vault_secret vault_key
#' @export
vec_cast.vault_secret.vault_key <- function(x, to, ...) {
  secret(vec_data(x))
}



#' Check if character vector is valid for a key
#'
#' The method is based on benchmark results.
#' See `bench/bench-is-32-byte-hexstring.R`.
#'
#' @keywords internal
is_32_byte_hexstring <- function(x) {
  x <- vec_data(x)
  if (requireNamespace("stringr", quietly = TRUE)) {
    coalesce(stringr::str_detect(x, "^[A-Fa-f0-9]{64}$"), FALSE)
  } else {
    unname(grepl("^[a-f0-9]{64}$", tolower(x)))
  }
}

validate_key <- function(x) {
  not_valid <- !is_32_byte_hexstring(x)
  if (any(not_valid)) {
    glubort(
      "Invalid key: a valid key must:",
      "* be exactly 64 characters long",
      "* only contain hexadecimal characters (i.e. 0-9, A-F)",
      .sep = "\n",
      class = "vault_invalid_key"
    )
  }
  x
}


# ops ---------------------------------------------------------------------

#' Generate a secret key
#'
#' Use this key to encrypt/decrypt secrets. Don't share this with people.
#'
#' @export
generate_key <- function() {
  new_key(sodium::bin2hex(sodium::random(n = 32)))
}



#' Default key for `vault`
#'
#' @description
#' Use this function to create a key which this package can use by default to
#' encrypt/decrypt your secrets. `vault` will read its default key from the
#' `VAULT_KEY` environment variable.
#'
#' Other packages can get a similar behavior for their own package by
#' using [use_pkg_key()] and [read_pkg_key()].
#'
#' @param scope Edit globally for the current user, or locally for the current
#'   project
#' @param pkg Name of package
#' @param envvar Name of environment variable to use
#' @export
use_vault_key <- function(scope = c("user", "project")) {
  use_pkg_key("vault", "VAULT_KEY", scope = scope)
}

read_vault_key <- function() {
  out <- read_pkg_key("VAULT_KEY")
  if (is.null(out)) {
    call <- ui_code("use_vault_key()")
    ui_stop("No key found. Please setup a key using {call}.")
  }
  out
}

#' @rdname use_vault_key
#' @export
use_pkg_key <- function(pkg, envvar, scope = c("user", "project")) {
  stopifnot(is_string(pkg))
  stopifnot(is_string(envvar))
  key <- generate_key()
  ui_done("Generated new secret key")
  usethis::edit_r_environ(scope = scope)
  filename <- ui_value(".Renviron")
  pkg <- ui_field(pkg)
  todo <- paste0(
    "Include this code in {filename} to make {pkg} recognize the newly ",
    "generated key."
  )
  ui_todo(todo)

  code <- "{envvar}={placeholder}"
  placeholder <- "<newly_generated_secret_key>"
  ui_code_block(code, copy = FALSE)
  if (clipr::clipr_available()) {
    code <- glue::glue(code, placeholder = unclass(key))
    clipr::write_clip(code)
    ui_line("  [Copied to clipboard]")
    info <- paste0(
      "The placeholder {ui_value(placeholder)} is replaced by the actual ",
      "key value."
    )
    ui_info(info)
  }
  invisible(key)
}

#' @rdname use_vault_key
#' @export
read_pkg_key <- function(envvar) {
  out <- Sys.getenv(envvar, NA_character_)
  if (is.na(out)) {
    return(NULL)
  }
  key(out)
}