add auth-functions

.Rbuildignore

@@ -7,3 +7,4 @@
 ^_pkgdown\.yml$
 ^docs$
 ^pkgdown$
+^\.auth$

.github/workflows/R-CMD-check-with-auth.yml

@@ -0,0 +1,43 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/master/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    branches: [main, master]
+  pull_request:
+    branches: [main, master]
+
+name: R-CMD-check-with-auth
+
+jobs:
+  R-CMD-check:
+    runs-on: ${{ matrix.config.os }}
+
+    name: ${{ matrix.config.os }} (${{ matrix.config.r }})
+
+    strategy:
+      fail-fast: false
+      matrix:
+        config:
+          - {os: ubuntu-latest,   r: 'release'}
+
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      CARDBOARD_AUTH_IJL: ${{ secrets.CARDBOARD_AUTH_IJL }}
+      R_KEEP_PKG_SOURCE: yes
+
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: r-lib/actions/setup-pandoc@v1
+
+      - uses: r-lib/actions/setup-r@v1
+        with:
+          r-version: ${{ matrix.config.r }}
+          http-user-agent: ${{ matrix.config.http-user-agent }}
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v1
+        with:
+          extra-packages: rcmdcheck
+
+      - uses: r-lib/actions/check-r-package@v1

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: cardboard
 Title: Low-level Interface to the 'Box.com API'
-Version: 0.0.0.9000
+Version: 0.0.0.9001
 Authors@R: c(
     person(
       given = "Ian", 
@@ -34,5 +34,14 @@ Suggests:
     testthat
 VignetteBuilder: knitr
 Imports: 
-    keyring,
-    httr2
+    httr2,
+    askpass,
+    glue,
+    rlang,
+    magrittr,
+    sodium,
+    withr,
+    cli,
+    jsonlite,
+    fs,
+    utils

NAMESPACE

@@ -1,2 +1,29 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(auth_inspect,cardbord_auth_credentials)
+S3method(auth_inspect,cardbord_auth_interactive)
+S3method(auth_inspect,default)
+S3method(auth_to_list,cardbord_auth_credentials)
+S3method(auth_to_list,cardbord_auth_interactive)
+S3method(auth_to_list,default)
+S3method(bx_auth_get,cardbord_auth)
+S3method(bx_auth_get,default)
+S3method(bx_auth_get,list)
+export("%>%")
+export(auth_inspect)
+export(auth_to_list)
+export(bx_auth)
+export(bx_auth_create_credentials)
+export(bx_auth_create_interactive)
+export(bx_auth_decrypt_file)
+export(bx_auth_encrypt_file)
+export(bx_auth_from_list)
+export(bx_auth_get)
+export(bx_auth_inspect)
+export(bx_auth_test)
+export(bx_auth_to_list)
+export(bx_auth_use)
+importFrom(glue,glue)
+importFrom(glue,glue_collapse)
+importFrom(magrittr,"%>%")
+importFrom(rlang,`%||%`)

NEWS.md

@@ -0,0 +1,18 @@
+# cardboard (development version)
+
+* Added functions for making and testing auth functions:
+  - `bx_auth_create_interactive()`
+  - `bx_auth_create_credentials()`
+  - `bx_auth_test()`
+  - `bx_auth_inspect()`
+  - `bx_auth_to_list()`
+  - `bx_auth_from_list()`
+  - `bx_auth_encrypt_file()`
+  - `bx_auth_decrypt_file()`
+  - `bx_auth_get()`
+  - `bx_auth_use()`
+  - `bx_auth()`
+
+  (#4)
+
+* Added a `NEWS.md` file to track changes to the package.

R/auth-create.R

@@ -0,0 +1,105 @@
+#' Make an auth function
+#'
+#' - RMarkdown files are generally rendered in their own R session. By caching
+#' the token, you could first authenticate to Box interactively.
+#' - if you use the default (`NULL`) for `id` and `secret`, you will be asked
+#' interactively. This may be preferable because the `id` and `secret` will not
+#' be saved to your command history.
+#' - `"user"` does not seem to work for credentials-based auth.
+#'
+#' @param id `character` client id, taken from Box app.
+#' @param secret `character` client secret, taken from Box app.
+#' @param cache_disk `logical` for code-based auth, indicates if the token
+#'   should be cached on disk for use in other R sessions.
+#' @param subject_type `character` for credentials-based auth, the type of
+#'   account to use.
+#' @param subject_id `character` for credentials-based auth, the id of the
+#'   account to use.
+#' @param .test `logical` indicates to test by calling the `users/me` resource.
+#'
+#' @return `function` that takes only an `httr2::request` object and returns a
+#'   `httr2::request` object. This function can be used place of
+#'   `httr2::req_oauth_auth_code()` or `httr2::req_oauth_auth_credentials()`.
+#' @export
+#'
+bx_auth_create_interactive <- function(id = NULL, secret = NULL,
+                                       cache_disk = FALSE, .test = TRUE) {
+
+  # create client
+  client <- make_client(id, secret)
+
+  auth_url = "https://app.box.com/api/oauth2/authorize"
+
+  # create auth function
+  req_auth <- function(req) {
+    httr2::req_oauth_auth_code(
+      req,
+      client,
+      auth_url = auth_url,
+      cache_disk = cache_disk
+    )
+  }
+
+  class(req_auth) <- c("cardbord_auth_interactive", "cardbord_auth")
+
+  if (.test) {
+    bx_auth_test(req_auth)
+  }
+
+  req_auth
+}
+
+#' @rdname bx_auth_create_interactive
+#' @export
+#'
+bx_auth_create_credentials <- function(id = NULL, secret = NULL,
+                                       subject_type = c("enterprise", "user"),
+                                       subject_id = NULL,
+                                       cache_disk = FALSE, .test = TRUE) {
+
+  # create client
+  client <- make_client(id, secret)
+
+  subject_type <- match.arg(subject_type)
+  subject_id <-
+    subject_id %||%
+    askpass::askpass(
+      glue("Please enter Box app subject_id ({subject_type} id):")
+    )
+
+  token_params <- list(
+    box_subject_type = subject_type,
+    box_subject_id = subject_id
+  )
+
+  # create auth function
+  req_auth <- function(req) {
+    httr2::req_oauth_client_credentials(
+      req,
+      client,
+      token_params = token_params
+    )
+  }
+
+  class(req_auth) <- c("cardbord_auth_credentials", "cardbord_auth")
+
+  if (.test) {
+    bx_auth_test(req_auth)
+  }
+
+
+  req_auth
+}
+
+make_client <- function(id, secret) {
+
+  id <- id %||% askpass::askpass("Please enter Box app client_id:")
+  secret <- secret %||% askpass::askpass("Please enter Box app client_secret:")
+
+  httr2::oauth_client(
+    id = id,
+    secret = secret,
+    token_url = url_box("oauth2/token")
+  )
+}
+

R/auth-encrypt-decrypt.R

@@ -0,0 +1,102 @@
+# ref: https://gargle.r-lib.org/articles/articles/managing-tokens-securely.html
+
+#' Auth file encryprition
+#'
+#' @inheritParams bx_auth
+#' @inheritParams bx_auth_create_interactive
+#' @param file `character`
+#' @param key `character`
+#' @param nonce `character`
+#'
+#' @return Invisible `auth`, called for side effects.
+#' @export
+#'
+bx_auth_encrypt_file <- function(auth, file, key = NULL, nonce = NULL) {
+
+  key <- key %||% key_gen()
+  key_raw <- as_key_raw(key)
+  nonce_raw <- as_nonce_raw(nonce)
+
+  file_abs <- fs::path_abs(file)
+  if (fs::file_exists(file_abs)) {
+    if (!interactive()) {
+      stop(glue("Not interactive. File: {file_abs} exists. Aborting."))
+    }
+
+    proceed <- utils::askYesNo(glue("File: {file_abs} exists. Overwrite?"))
+    if (!proceed) {
+      stop("File exists. Aborting.")
+    }
+  }
+
+  list_auth <- bx_auth_to_list(auth)
+  json_auth <- to_json(list_auth)
+  raw_auth <- charToRaw(json_auth)
+
+  encrypt_auth <-
+    sodium::data_encrypt(raw_auth, key = key_raw, nonce = nonce_raw)
+  attr(encrypt_auth, "nonce") <- NULL
+
+  writeBin(encrypt_auth, file)
+
+  cli::cat_bullet(
+    glue("auth written to encrypted file: {file_abs}"),
+    bullet = "tick",
+    bullet_col = "green"
+  )
+
+  invisible(auth)
+}
+
+#' @rdname bx_auth_encrypt_file
+#' @export
+#'
+bx_auth_decrypt_file <- function(file, key, nonce = NULL, .test = TRUE) {
+
+  key_raw <- as_key_raw(key)
+  nonce_raw <- as_nonce_raw(nonce)
+
+  encrypt_auth <- readBin(file, "raw", file.size(file))
+  raw_auth <-
+    sodium::data_decrypt(encrypt_auth, key = key_raw, nonce = nonce_raw)
+  json_auth <- rawToChar(raw_auth)
+  list_auth <- from_json(json_auth)
+
+  auth <- bx_auth_from_list(list_auth)
+
+  if (.test) {
+    bx_auth_test(auth)
+  }
+
+  invisible(auth)
+}
+
+
+as_key_raw <- function(key) {
+  sodium::sha256(charToRaw(key))
+}
+
+# TODO: credit gargle
+key_gen <- function() {
+
+  # uncouple from seed
+  withr::local_preserve_seed()
+  set.seed(NULL)
+
+  key <- sample(c(letters, LETTERS, 0:9), 50, replace = TRUE)
+  key <- paste0(key, collapse = "")
+
+  cli::cat_bullet(
+    glue("generated key: {key}"),
+    bullet = "tick",
+    bullet_col = "green"
+  )
+
+  key
+}
+
+as_nonce_raw <- function(nonce) {
+  nonce <- nonce %||% "4XQ5PHbHeoFZrqiPR1Lp4m3b"
+  charToRaw(nonce)
+}
+

R/auth-get.R

@@ -0,0 +1,63 @@
+#' Get auth function
+#'
+#' @param auth can be:
+#'   - `function` with S3 class `cardboard_auth`: uses `auth`.
+#'   - `character`: uses auth function using name of stored in keyring,
+#'      see `bx_keyring_list()`.
+#'   - `list`: uses [bx_auth_from_list()].
+#'   - `NULL`: if `bx_keyring_list()` has exactly one entry, uses it.
+#'
+#' @return `function` with S3 class `cardboard_auth`, fully operational
+#' drop-in replacement for `httr2::req_oauth_auth_code()` or
+#' `httr2::req_oauth_auth_credentials()`.
+#'
+#' @export
+#'
+bx_auth_get <- function(auth) {
+  UseMethod("bx_auth_get")
+}
+
+#' @export
+#'
+bx_auth_get.default <- function(auth) {
+  stop(
+    glue(
+      "No method for class: {glue_collapse(class(auth), sep = ' ')}."
+    ),
+    call. = FALSE
+  )
+}
+
+#' @export
+#'
+bx_auth_get.cardbord_auth <- function(auth) {
+  # no-op
+  auth
+}
+
+#' @export
+#'
+bx_auth_get.list <- function(auth) {
+  bx_auth_from_list(auth)
+}
+
+#' Coerce to auth function
+#'
+#' @param auth Object coerced to auth function.
+#'   - If `NULL`, returns default auth-function returned by `bx_auth()`.
+#'   - If `bx_auth()` returns `NULL`, tries [bx_auth_get()].
+#'
+#' @keywords internal
+#'
+as_auth <- function(auth) {
+  auth <- auth %||% bx_auth()
+
+  if (is.null(auth)) {
+    message("Default auth not set, bx_auth_use()")
+  }
+
+  auth <- bx_auth_get(auth)
+
+  auth
+}
+