R/write-docker.R

In tidymodels/vetiver-r: Version, Share, Deploy, and Monitor Models

DEFAULT_RSPM_REPO_ID <-  "1" # cran
DEFAULT_RSPM <-  "https://packagemanager.rstudio.com"

#' Write a Dockerfile for a vetiver model
#'
#' After creating a Plumber file with [vetiver_write_plumber()], use
#' `vetiver_write_docker()` to create a Dockerfile plus a `vetiver_renv.lock`
#' file for a pinned [vetiver_model()].
#'
#' @inheritParams vetiver_api
#' @param plumber_file A path for your Plumber file, created via
#' [vetiver_write_plumber()]. Defaults to `plumber.R` in the working directory.
#' @param path A path to write the Dockerfile and `lockfile`, capturing the
#' model's package dependencies. Defaults to the working directory.
#' @param ... Not currently used.
#' @param lockfile The generated lockfile in `path`. Defaults to
#' `"vetiver_renv.lock"`.
#' @param rspm A logical to use the
#' [RStudio Public Package Manager](https://packagemanager.rstudio.com/) for
#' `renv::restore()` in the Docker image. Defaults to `TRUE`.
#' @param base_image The base Docker image to start with. Defaults to
#' `rocker/r-ver` for the version of R you are working with, but models like
#' keras will require a different base image.
#' @param port The server port for listening: a number such as 8080 or an
#' expression like `'as.numeric(Sys.getenv("PORT"))'` when the port is injected
#' as an environment variable.
#' @param expose Add `EXPOSE` to the Dockerfile? This is helpful for using
#' Docker Desktop but does not work with an expression for `port`.
#' @param additional_pkgs A character vector of additional package names to add
#' to the Docker image. For example, some boards like [pins::board_s3()] require
#' additional software; you can use `required_pkgs(board)` here.
#'
#' @return The content of the Dockerfile, invisibly.
#' @export
#'
#' @examplesIf interactive() || identical(Sys.getenv("IN_PKGDOWN"), "true")
#'
#' library(pins)
#' tmp_plumber <- tempfile()
#' b <- board_temp(versioned = TRUE)
#' cars_lm <- lm(mpg ~ ., data = mtcars)
#' v <- vetiver_model(cars_lm, "cars_linear")
#' vetiver_pin_write(b, v)
#' vetiver_write_plumber(b, "cars_linear", file = tmp_plumber)
#'
#' ## default port
#' vetiver_write_docker(v, tmp_plumber, tempdir())
#' ## install more pkgs, like those required to access board
#' vetiver_write_docker(v, tmp_plumber, tempdir(),
#'                      additional_pkgs = required_pkgs(b))
#' ## port from env variable
#' vetiver_write_docker(v, tmp_plumber, tempdir(),
#'                      port = 'as.numeric(Sys.getenv("PORT"))',
#'                      expose = FALSE)
#'
vetiver_write_docker <- function(vetiver_model,
                                 plumber_file = "plumber.R",
                                 path = ".",
                                 ...,
                                 lockfile = "vetiver_renv.lock",
                                 rspm = TRUE,
                                 base_image = glue::glue("FROM rocker/r-ver:{getRversion()}"),
                                 port = 8000,
                                 expose = TRUE,
                                 additional_pkgs = character(0)) {

    check_dots_empty()

    if (!fs::file_exists(plumber_file)) {
        cli::cli_abort(
            c(
                "{.arg plumber_file} does not exist at {.path {plumber_file}}",
                "i" = "Create your Plumber file with {.fn vetiver_write_plumber}"
            )
        )
    }

    keras <- "keras" %in% vetiver_model$metadata$required_pkgs
    default_image <- base_image == eval(fn_fmls()$base_image)
    if (keras && default_image) {
        cli::cli_warn(c(
            "Your {.arg vetiver_model} object contains a keras model",
            "i" = "Be sure to use an appropriate {.arg base_image} such as `rocker/cuda`"
        ))
    }

    plumber_file <- fs::path_rel(plumber_file)
    withr::local_dir(path)
    rspm_env <- ifelse(
        rspm,
        "ENV RENV_CONFIG_REPOS_OVERRIDE https://packagemanager.rstudio.com/cran/latest\n",
        ""
    )

    pkgs <- c(additional_pkgs, vetiver_model$metadata$required_pkgs)
    pkgs <- vetiver_required_pkgs(pkgs)
    lockfile_pkgs <-
        renv$snapshot(
            lockfile = lockfile,
            packages = pkgs,
            prompt = FALSE,
            force = TRUE
        )

    sys_reqs <- glue_sys_reqs(names(lockfile_pkgs$Packages))
    copy_renv <- glue("COPY {lockfile} renv.lock")
    copy_plumber <- glue("COPY {plumber_file} /opt/ml/plumber.R")
    expose <- ifelse(expose, glue("EXPOSE {port}"), "")
    entrypoint <- glue('ENTRYPOINT ["R", "-e", ',
                       '"pr <- plumber::plumb(\'/opt/ml/plumber.R\'); ',
                       'pr$run(host = \'0.0.0.0\', port = {port})"]')


    ret <- compact(list(
        "# Generated by the vetiver package; edit with care\n",
        ## https://github.com/rstudio/plumber/blob/main/Dockerfile:
        base_image,
        rspm_env,
        sys_reqs,
        "",
        copy_renv,
        'RUN Rscript -e "install.packages(\'renv\')"',
        'RUN Rscript -e "renv::restore()"',
        copy_plumber,
        expose,
        entrypoint
    ))

    readr::write_lines(ret, file = "Dockerfile")
}

docker_pkgs <- c("pins", "plumber", "rapidoc", "vetiver", "renv")
drop_pkgs <- "stats"

vetiver_required_pkgs <- function(pkgs) {
    pkgs <- c(docker_pkgs, pkgs)
    pkgs <- setdiff(pkgs, drop_pkgs)
    sort(unique(pkgs))
}

glue_sys_reqs <- function(pkgs, call = rlang::caller_env()) {
    rlang::check_installed(c("curl", "jsonlite"))
    rspm <- Sys.getenv("RSPM_ROOT", DEFAULT_RSPM)
    rspm_repo_id <- Sys.getenv("RSPM_REPO_ID", DEFAULT_RSPM_REPO_ID)
    rspm_repo_url <- glue("{rspm}/__api__/repos/{rspm_repo_id}")

    pkgnames <- glue_collapse(pkgs, sep = "&pkgname=")

    req_url <- glue(
        "{rspm_repo_url}/sysreqs?all=false",
        "&pkgname={pkgnames}&distribution=ubuntu&release=20.04"
    )
    res <- curl::curl_fetch_memory(req_url)
    sys_reqs <- jsonlite::fromJSON(rawToChar(res$content), simplifyVector = FALSE)
    if (!is.null(sys_reqs$error)) {
        rlang::abort(sys_reqs$error, call = call)
    }
    sys_reqs <- map(sys_reqs$requirements, pluck, "requirements", "packages")
    sys_reqs <- sort(unique(unlist(sys_reqs)))
    if (is.null(sys_reqs)) {
        return(NULL)
    }
    sys_reqs <- glue_collapse(sys_reqs, sep = " \\\n  ")
    glue(
        "RUN apt-get update -qq && ",
        "apt-get install -y --no-install-recommends \\\n  ",
        sys_reqs,
        " \\\n  && apt-get clean",
        .trim = FALSE
    )
}

#' Generate files necessary to build a Docker container for a vetiver model
#'
#' Deploying a vetiver model via Docker requires several files. Use this
#' function to create these needed files in the directory located at `path`.
#'
#' @inheritParams vetiver_write_plumber
#' @inheritParams vetiver_deploy_rsconnect
#' @param path A path to write the Plumber file, Dockerfile, and lockfile,
#' capturing the model's dependencies.
#' @param docker_args A list of optional arguments passed to
#' [vetiver_write_docker()] such as the `lockfile` name or whether to use
#' `rspm`. Do not pass `additional_pkgs` here, as this function uses
#' `additional_pkgs = required_pkgs(board)`.
#' @details
#' The function `vetiver_prepare_docker()` uses:
#' - [vetiver_write_plumber()] to create a Plumber file and
#' - [vetiver_write_docker()] to create a Dockerfile and renv lockfile
#'
#' These modular functions are available for more advanced use cases. For
#' models such as keras and torch, you will need to edit the generated
#' Dockerfile to, for example, `COPY requirements.txt requirements.txt` or
#' similar.
#'
#' @return An invisible `TRUE`.
#'
#' @examplesIf interactive() || identical(Sys.getenv("IN_PKGDOWN"), "true")
#' library(pins)
#' b <- board_temp(versioned = TRUE)
#' cars_lm <- lm(mpg ~ ., data = mtcars)
#' v <- vetiver_model(cars_lm, "cars_linear")
#' vetiver_pin_write(b, v)
#'
#' vetiver_prepare_docker(b, "cars_linear", path = tempdir())
#'
#' @export
vetiver_prepare_docker <- function(board, name, version = NULL,
                                   path = ".",
                                   predict_args = list(),
                                   docker_args = list()) {
    withr::local_dir(path)
    if (has_name(docker_args, "additional_pkgs")) {
        abort(c(
            "Do not pass `additional_pkgs` to `docker_args`",
            "This function uses `additional_pkgs = required_pkgs(board)`",
            "For more complex use cases, call `vetiver_write_docker()` itself"
        ))
    }
    vetiver_write_plumber(
        board = board,
        name = name,
        version = version,
        !!!predict_args,
        rsconnect = FALSE
    )
    v <- vetiver_pin_read(board = board, name = name, version = version)
    inject(vetiver_write_docker(
        v,
        !!!docker_args,
        additional_pkgs = required_pkgs(board))
    )
    invisible(TRUE)
}