R/secret-vec.R

In shunsambongi/vault: Locally store encrypted secrets

new_secret <- function(x = character(), subclass = NULL) {
  vec_assert(x, character())
  new_vctr(x, class = c(subclass, "vault_secret"))
}

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

#' `secret` vector
#'
#' This creates a character vector that represents secrets so when it is
#' printed, it does show the actual value. This is to help so that the value
#' does get exposed in output dumps, logs, Rstudio user interface, etc.
#'
#' @param x
#'   * For `secret()`: A character vector
#'   * For `is_secret()`: An object to test
#'   * For `as_secret()`: An object to cast
#' @return An S3 vector of class `vault_secret`
#' @export
#' @examples
#' secret("MyStrong(!)Password")
secret <- function(x = character()) {
  x <- vec_cast(x, character())
  new_secret(x)
}

#' @export
#' @rdname secret
is_secret <- function(x) {
  inherits(x, "vault_secret")
}

#' @export
#' @rdname secret
as_secret <- function(x) {
  vec_cast(x, new_secret())
}

#' @export
format.vault_secret <- function(x, ...) {
  out <- rep(strrep("*", 7), length(x))
  out[is.na(x)] <- NA
  out
}

#' @export
vec_ptype_abbr.vault_secret <- function(x, ...) {
  "scrt"
}

#' @export
vec_ptype_full.vault_secret <- function(x, ...) {
  "secret"
}

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

#' @method vec_ptype2.vault_secret default
#' @export
vec_ptype2.vault_secret.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_secret vault_secret
#' @export
vec_ptype2.vault_secret.vault_secret <- function(x, y, ...) new_secret()

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

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

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

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