R/secret-ops.R

Defines functions read_secret write_secret secret_verify_integrity secret_tag secret_nonce secret_encrypt secret_decrypt ask_secret

Documented in read_secret write_secret

#' Secrets
#'
#' Store secrets using [write_secret()] and retrieve them using [read_secret()].
#'
#' @param service A service that the secret is meant for i.e. what is it for?
#' @param name The secret type i.e. what type of secret is it?
#' @param key The key used to encrypt/decrypt the secret
#' @param app The entity which is managing the secret
#' @param secret The secret value
#' @param ... This argument is not used and the function will error if
#'   any values are provided
#' @export
read_secret <- function(service, name, ...,
                        key = read_vault_key(), app = "vault") {
  ellipsis::check_dots_empty()
  stopifnot(is_string(service))
  stopifnot(is_string(name))
  stopifnot(is_string(key))
  stopifnot(is_string(app))

  query <- paste(
    sep = "\n",
    "SELECT value, nonce, tag",
    "FROM secrets",
    "WHERE app = :app AND service = :service AND name = :name;"
  )
  params <- list(app = app, service = service, name = name)

  con <- local_vault_connection()
  vault_ensure(con)
  result <- RSQLite::dbGetQuery(con, query, params = params)
  if (!nrow(result)) {
    return(NULL)
  }

  value <- result[["value"]]
  nonce <- result[["nonce"]]
  tag <- result[["tag"]]
  secret <- secret_decrypt(value, key, nonce)
  secret_verify_integrity(secret, key, tag)
}

#' @export
#' @rdname read_secret
write_secret <- function(service, name, secret = ask_secret(), ...,
                         key = read_vault_key(), app = "vault") {
  ellipsis::check_dots_empty()
  stopifnot(is_string(service))
  stopifnot(is_string(name))
  stopifnot(is_string(secret))
  stopifnot(is_string(key))
  stopifnot(is_string(app))

  nonce <- secret_nonce()
  value <- secret_encrypt(secret, key, nonce)
  tag <- secret_tag(secret, key)

  statement <- paste(
    sep = "\n",
    "REPLACE INTO secrets (app, service, name, value, nonce, tag)",
    "VALUES (:app, :service, :name, :value, :nonce, :tag);"
  )

  params <- list(
    app = app,
    service = service,
    name = name,
    value = value,
    nonce = nonce,
    tag = tag
  )

  con <- local_vault_connection()
  vault_ensure(con)
  RSQLite::dbExecute(con, statement, params = params)
  invisible()
}

secret_verify_integrity <- function(secret, key, tag) {
  key <- sodium::hex2bin(key)
  tag <- sodium::hex2bin(tag)
  retag <- sodium::data_tag(charToRaw(secret), key)
  stopifnot(identical(tag, retag))
  secret
}

secret_tag <- function(secret, key) {
  secret <- charToRaw(secret)
  key <- sodium::hex2bin(key)
  sodium::bin2hex(sodium::data_tag(secret, key))
}

secret_nonce <- function() {
  sodium::bin2hex(sodium::random(24))
}

secret_encrypt <- function(secret, key, nonce) {
  secret <- charToRaw(secret)
  key <- sodium::hex2bin(key)
  nonce <- sodium::hex2bin(nonce)
  out <- sodium::data_encrypt(secret, key, nonce)
  attributes(out) <- NULL
  sodium::bin2hex(out)
}

secret_decrypt <- function(value, key, nonce) {
  value <- sodium::hex2bin(value)
  key <- sodium::hex2bin(key)
  nonce <- sodium::hex2bin(nonce)
  out <- sodium::data_decrypt(value, key, nonce)
  secret(rawToChar(out))
}

ask_secret <- function() {
  if (!interactive()) {
    glubort("Cannot ask for secret in non-interactive session")
  }
  askpass::askpass(prompt = "Please enter your secret: ")
}
shunsambongi/vault documentation built on March 19, 2020, 4:58 p.m.