R/proxy.R

In shunsambongi/himitsu: Read and Write Secrets

backends_env <- new.env(parent = emptyenv())

register_backend <- function(backend, proxy_generator) {
  backends_env[[backend]] <- proxy_generator
}

#' @export
backends <- function() {
  names(backends_env)
}


#' @export
proxy <- function(backend, ...) {
  proxy_generator <- backends_env[[backend]]
  if (is.null(proxy_generator)) {
    stop("Unsupported backend ", backend, call. = FALSE)
  }
  proxy_generator$new(...)
}

#' Secret Proxy
#'
#' @description
#' Abstract class for creating secret proxies
#'
#' @export
himitsu_proxy <- R6::R6Class(
  classname = "himitsu_proxy",
  cloneable = FALSE,
  public = list(
    #' @description
    #' Constructor
    initialize = function() {
      stop("Cannot instantiate abstract class", call. = FALSE)
    },

    #' @description
    #' Read secret value from source
    read = function() {
      out <- private$read_()
      if (!is.null(out)) out <- vec_cast(out, new_secret())
      out
    },

    #' @description
    #' Write secret value to source
    #'
    #' @param value secret
    write = function(value) {
      allow_disclosure({
        value <- as.character(value)
      })
      old <- self$read()
      private$write_(value)
      invisible(old)
    },

    #' @description
    #' Print the proxy
    print = function() {
      cat_line("<proxy>")
      cat_line(format(secret("")))
      invisible(self)
    }
  ),

  private = list(
    read_ = function() stop_not_implemented(),
    write_ = function(value) stop_not_implemented()
  )
)

#' @export
disclose.himitsu_proxy <- function(x, ...) {
  disclose(x$read())
}

#' @export
as.character.himitsu_proxy <- function(x, ...) {
  as.character(x$read())
}

#' @export
read_secret.himitsu_proxy <- function(x, ...) {
  x$read()
}

#' @export
write_secret.himitsu_proxy <- function(value, x, ...) {
  x$write(value)
}