R/install-bitbucket.R

In remotes: R Package Installation from Remote Repositories, Including 'GitHub'

#' Install a package directly from Bitbucket
#'
#' This function is vectorised so you can install multiple packages in
#' a single command.
#'
#' @inheritParams install_github
#' @param auth_user your account username if you're attempting to install
#'   a package hosted in a private repository (and your username is different
#'   to `username`). Defaults to the `BITBUCKET_USER` environment
#'   variable.
#' @param password your password. Defaults to the `BITBUCKET_PASSWORD`
#'   environment variable. See details for further information on setting
#'   up a password.
#' @param repo Repository address in the format
#'   `username/repo[/subdir][@@ref]`. Alternatively, you can
#'   specify `subdir` and/or `ref` using the respective parameters
#'   (see below); if both are specified, the values in `repo` take
#'   precedence.
#' @param ref Desired git reference; could be a commit, tag, or branch name.
#'   Defaults to HEAD.
#' @seealso Bitbucket API docs:
#'   <https://confluence.atlassian.com/bitbucket/use-the-bitbucket-cloud-rest-apis-222724129.html>
#'
#' @details To install from a private repo, or more generally, access the
#' Bitbucket API with your own credentials, you will need to get an access
#' token. You can create an access token following the instructions found in
#' the
#' \href{https://support.atlassian.com/bitbucket-cloud/docs/app-passwords/}{Bitbucket
#' App Passwords documentation}. The App Password requires read-only access to
#' your repositories and pull requests. Then store your password in the
#' environment variable `BITBUCKET_PASSWORD` (e.g. `evelynwaugh:swordofhonour`)
#'
#' Note that on Windows, authentication requires the "libcurl" download
#' method. You can set the default download method via the
#' `download.file.method` option:
#' ```
#' options(download.file.method = "libcurl")
#' ```
#' In particular, if unset, RStudio sets the download method to "wininet".
#' To override this, you might want to set it to "libcurl" in your
#' R profile, see [base::Startup]. The caveat of the "libcurl" method is
#' that it does _not_ set the system proxies automatically, see
#' "Setting Proxies" in [utils::download.file()].
#'
#' @inheritParams install_github
#' @family package installation
#' @export
#' @examples
#' \dontrun{
#' install_bitbucket("sulab/mygene.r@@default")
#' install_bitbucket("djnavarro/lsr")
#' }
install_bitbucket <- function(repo, ref = "HEAD", subdir = NULL,
                              auth_user = bitbucket_user(), password = bitbucket_password(),
                              host = "api.bitbucket.org/2.0",
                              dependencies = NA,
                              upgrade = c("default", "ask", "always", "never"),
                              force = FALSE,
                              quiet = FALSE,
                              build = TRUE, build_opts = c("--no-resave-data", "--no-manual", "--no-build-vignettes"),
                              build_manual = FALSE, build_vignettes = FALSE,
                              repos = getOption("repos"),
                              type = getOption("pkgType"),
                              ...) {

  remotes <- lapply(repo, bitbucket_remote, ref = ref,
    subdir = subdir, auth_user = auth_user, password = password, host = host)

  install_remotes(remotes, auth_user = auth_user, password = password, host = host,
                  dependencies = dependencies,
                  upgrade = upgrade,
                  force = force,
                  quiet = quiet,
                  build = build,
                  build_opts = build_opts,
                  build_manual = build_manual,
                  build_vignettes = build_vignettes,
                  repos = repos,
                  type = type,
                  ...)
}

bitbucket_remote <- function(repo, ref = "HEAD", subdir = NULL,
                             auth_user = bitbucket_user(), password = bitbucket_password(),
                             sha = NULL, host = "api.bitbucket.org/2.0", ...) {

  meta <- parse_git_repo(repo)

  remote("bitbucket",
    repo = meta$repo,
    subdir = meta$subdir %||% subdir,
    username = meta$username,
    ref = meta$ref %||% ref,
    sha = sha,
    auth_user = auth_user,
    password = password,
    host = host
  )
}

#' @export
remote_download.bitbucket_remote <- function(x, quiet = FALSE) {
  if (!quiet) {
    message("Downloading bitbucket repo ", x$username, "/", x$repo, "@", x$ref)
  }

  dest <- tempfile(fileext = paste0(".tar.gz"))

  url <- bitbucket_download_url(x$username, x$repo, x$ref, host = x$host, auth = basic_auth(x))

  download(dest, url, basic_auth = basic_auth(x))
}

#' @export
remote_metadata.bitbucket_remote <- function(x, bundle = NULL, source = NULL, sha = NULL) {
  if (!is.null(bundle)) {
    # Might be able to get from archive
    sha <- git_extract_sha1_tar(bundle)
  } else if (is.na(sha)) {
    sha <- NULL
  }

  list(
    RemoteType = "bitbucket",
    RemoteHost = x$host,
    RemoteRepo = x$repo,
    RemoteUsername = x$username,
    RemoteRef = x$ref,
    RemoteSha = sha,
    RemoteSubdir = x$subdir
  )
}

#' @export
remote_package_name.bitbucket_remote <- function(remote, ...) {

  bitbucket_DESCRIPTION(
    username = remote$username, repo = remote$repo,
    subdir = remote$subdir, ref = remote$ref,
    host = remote$host, auth = basic_auth(remote)
  )$Package
}

#' @export
remote_sha.bitbucket_remote <- function(remote, ...) {
  bitbucket_commit(username = remote$username, repo = remote$repo,
    host = remote$host, ref = remote$ref, auth = basic_auth(remote))$hash %||% NA_character_
}

#' @export
format.bitbucket_remote <- function(x, ...) {
  "Bitbucket"
}

bitbucket_commit <- function(username, repo, ref = "HEAD",
  host = "api.bitbucket.org/2.0", auth = NULL) {

  url <- build_url(host, "repositories", username, repo, "commit", ref)

  tmp <- tempfile()
  download(tmp, url, basic_auth = auth)

  json$parse_file(tmp)
}

bitbucket_DESCRIPTION <- function(username, repo, subdir = NULL, ref = "HEAD", host = "https://api.bitbucket.org/2.0", auth = NULL,...) {

  url <- build_url(host, "repositories", username, repo, "src", ref, subdir, "DESCRIPTION")

  tmp <- tempfile()
  download(tmp, url, basic_auth = auth)

  read_dcf(tmp)
}

basic_auth <- function(x) {
  if (!is.null(x$password)) {
    list(
      user = x$auth_user %||% x$username,
      password = x$password
    )
  } else {
    NULL
  }
}


bitbucket_download_url <- function(username, repo, ref = "HEAD",
  host = "api.bitbucket.org/2.0", auth = NULL) {

  url <- build_url(host, "repositories", username, repo)

  tmp <- tempfile()
  download(tmp, url, basic_auth = auth)

  paste0(build_url(json$parse_file(tmp)$links$html$href, "get", ref), ".tar.gz")
}

bitbucket_password <- function(quiet = TRUE) {
  pass <- Sys.getenv("BITBUCKET_PASSWORD")
  if (identical(pass, "")) return(NULL)
  if (!quiet) message("Using bitbucket password from envvar BITBUCKET_PASSWORD")
  pass
}

bitbucket_user <- function(quiet = TRUE) {
  user <- Sys.getenv("BITBUCKET_USER")
  if (identical(user, "")) return(NULL)
  if (!quiet) message("Using bitbucket user from envvar BITBUCKET_USER")
  user
}