From 3fb2cd880f84ee144364587025a49eefc3123fdd Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Sat, 17 Jun 2023 11:06:17 +0200 Subject: [PATCH 1/4] Introduce explicit helpers to write or read a token --- NAMESPACE | 2 + R/gm_auth.R | 89 ++++++++++++++++++++++++++++++++++- man/gm_token_write.Rd | 84 +++++++++++++++++++++++++++++++++ tests/testthat/test-gm_auth.R | 33 +++++++++++++ 4 files changed, 207 insertions(+), 1 deletion(-) create mode 100644 man/gm_token_write.Rd diff --git a/NAMESPACE b/NAMESPACE index 92ffe9c..4a29778 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -102,6 +102,8 @@ export(gm_thread) export(gm_threads) export(gm_to) export(gm_token) +export(gm_token_read) +export(gm_token_write) export(gm_trash_message) export(gm_trash_thread) export(gm_untrash_message) diff --git a/R/gm_auth.R b/R/gm_auth.R index 5e4de38..655a96b 100644 --- a/R/gm_auth.R +++ b/R/gm_auth.R @@ -397,6 +397,93 @@ fixup_gmail_scopes <- function(scopes) { ifelse(is.na(m), scopes, haystack[m]) } +# gm_token_write / gm_token_read() ---- + +#' Write/read a gmailr user token +#' +#' @description `r lifecycle::badge("experimental")` +#' + +#' This pair of functions writes an OAuth2 user token to file and reads it back +#' in. This is rarely necessary when working in your primary, interactive +#' computing environment. In that setting, it is recommended to lean into the +#' automatic token caching built-in to gmailr / gargle. However, when preparing +#' a user token for use elsewhere, such as in CI or in a deployed data product, +#' it can be useful to take the full control granted by `gm_token_write()` and +#' `gm_token_read()`. +#' +#' Below is an outline of the intended workflow, but you will need to fill in +#' particulars, such as filepaths and environment variables: +#' * Do auth in your primary, interactive environment as the target user, with +#' the desired OAuth client and scopes. +#' ``` r +#' gm_auth_configure() +#' gm_auth("jane@example.com", cache = FALSE) +#' ```` +#' * Confirm you are logged in as the intended user: +#' ``` r +#' gm_profile() +#' ```` +#' * Write the current token to file: +#' ``` r +#' gm_token_write( +#' path = "path/to/gmailr-token.rds", +#' key = "GMAILR_KEY" +#' ) +#' ``` +#' * In the deployed, non-interactive setting, read the token from file and +#' tell gmailr to use it: +#' ``` r +#' gm_auth(token = gm_token_read( +#' path = "path/to/gmailr-token.rds", +#' key = "GMAILR_KEY" +#' ) +#' ``` +#' +#' @section Security: + +#' `gm_token_write()` and `gm_token_read()` have a more security-oriented +#' implementation than the default token caching strategy. OAuth2 user tokens +#' are somewhat opaque by definition, because they aren't written to file in a +#' particularly transparent format. However, `gm_token_write()` always applies +#' some additional obfuscation to make such credentials even more resilient +#' against scraping by an automated tool. However, a knowledgeable R programmer +#' could decode the credential with some effort. The default behaviour of +#' `gm_token_write()` (called without `key`) is suitable for tokens stored in a +#' relatively secure place, such as on Posit Connect within your organization. +#' +#' To prepare a stored credential for exposure in a more public setting, such as +#' on GitHub or CRAN, you must actually encrypt it, using a `key` known only to +#' you. You should make this encryption `key` available on both the reading and +#' writing side via an environment variable. +#' +#' @inheritParams gm_auth +#' @param path The path to write to (`gm_token_write()`) or to read from +#' (`gm_token_read()`). +#' @inheritParams gargle::gargle_secret +#' +#' @export +gm_token_write <- function(token = gm_token(), + path = "gmailr-token.rds", + key = NULL) { + if (inherits(token, "request")) { + token <- token$auth_token + } + stopifnot(inherits(token, "Token2.0")) + check_required(path) + key <- key %||% gmailr_obfuscate_key() + + gargle::secret_write_rds(token, path, key) +} + +#' @rdname gm_token_write +#' @export +gm_token_read <- function(path = "gmailr-token.rds", key = NULL) { + stopifnot(file.exists(path)) + key <- key %||% gmailr_obfuscate_key() + gargle::secret_read_rds(path, key) +} + # unexported helpers that are nice for internal use ---- gm_auth_testing <- function() { can_decrypt <- gargle::secret_has_key("GMAILR_KEY") @@ -416,7 +503,7 @@ gm_auth_testing <- function() { ) } - gm_auth(token = gargle::secret_read_rds( + gm_auth(token = gm_token_read( system.file("secret", "gmailr-dev-token", package = "gmailr"), key = "GMAILR_KEY" )) diff --git a/man/gm_token_write.Rd b/man/gm_token_write.Rd new file mode 100644 index 0000000..0c7e01b --- /dev/null +++ b/man/gm_token_write.Rd @@ -0,0 +1,84 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gm_auth.R +\name{gm_token_write} +\alias{gm_token_write} +\alias{gm_token_read} +\title{Write/read a gmailr user token} +\usage{ +gm_token_write(token = gm_token(), path = "gmailr-token.rds", key = NULL) + +gm_token_read(path = "gmailr-token.rds", key = NULL) +} +\arguments{ +\item{token}{A token with class \link[httr:Token-class]{Token2.0} or an object of +httr's class \code{request}, i.e. a token that has been prepared with +\code{\link[httr:config]{httr::config()}} and has a \link[httr:Token-class]{Token2.0} in the +\code{auth_token} component.} + +\item{path}{The path to write to (\code{gm_token_write()}) or to read from +(\code{gm_token_read()}).} + +\item{key}{Encryption key, as implemented by httr2's \href{https://httr2.r-lib.org/reference/secrets.html}{secret functions}. This should +almost always be the name of an environment variable whose value was +generated with \code{secret_make_key()} (which is an inlined copy of +\code{httr2::secret_make_key()}).} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +This pair of functions writes an OAuth2 user token to file and reads it back +in. This is rarely necessary when working in your primary, interactive +computing environment. In that setting, it is recommended to lean into the +automatic token caching built-in to gmailr / gargle. However, when preparing +a user token for use elsewhere, such as in CI or in a deployed data product, +it can be useful to take the full control granted by \code{gm_token_write()} and +\code{gm_token_read()}. + +Below is an outline of the intended workflow, but you will need to fill in +particulars, such as filepaths and environment variables: +\itemize{ +\item Do auth in your primary, interactive environment as the target user, with +the desired OAuth client and scopes. + +\if{html}{\out{
}}\preformatted{gm_auth_configure() +gm_auth("jane@example.com", cache = FALSE) +}\if{html}{\out{
}} +\item Confirm you are logged in as the intended user: + +\if{html}{\out{
}}\preformatted{gm_profile() +}\if{html}{\out{
}} +\item Write the current token to file: + +\if{html}{\out{
}}\preformatted{gm_token_write( + path = "path/to/gmailr-token.rds", + key = "GMAILR_KEY" +) +}\if{html}{\out{
}} +\item In the deployed, non-interactive setting, read the token from file and +tell gmailr to use it: + +\if{html}{\out{
}}\preformatted{gm_auth(token = gm_token_read( + path = "path/to/gmailr-token.rds", + key = "GMAILR_KEY" +) +}\if{html}{\out{
}} +} +} +\section{Security}{ + +\code{gm_token_write()} and \code{gm_token_read()} have a more security-oriented +implementation than the default token caching strategy. OAuth2 user tokens +are somewhat opaque by definition, because they aren't written to file in a +particularly transparent format. However, \code{gm_token_write()} always applies +some additional obfuscation to make such credentials even more resilient +against scraping by an automated tool. However, a knowledgeable R programmer +could decode the credential with some effort. The default behaviour of +\code{gm_token_write()} (called without \code{key}) is suitable for tokens stored in a +relatively secure place, such as on Posit Connect within your organization. + +To prepare a stored credential for exposure in a more public setting, such as +on GitHub or CRAN, you must actually encrypt it, using a \code{key} known only to +you. You should make this encryption \code{key} available on both the reading and +writing side via an environment variable. +} + diff --git a/tests/testthat/test-gm_auth.R b/tests/testthat/test-gm_auth.R index 1746174..64decd3 100644 --- a/tests/testthat/test-gm_auth.R +++ b/tests/testthat/test-gm_auth.R @@ -138,3 +138,36 @@ test_that("gm_scopes() passes unrecognized scopes through", { ) ) }) + +# gm_token_write / gm_token_read() ---- + +test_that("gm_token_write() / gm_token_read() roundtrip, built-in key", { + fauxen_in <- gargle::gargle2.0_token( + email = "a@example.org", + credentials = list(a = 1) + ) + tmp <- withr::local_tempfile(pattern = "fauxen-") + + gm_token_write(fauxen_in, tmp) + fauxen_out <- gm_token_read(tmp) + + expect_error(readRDS(tmp)) + expect_equal(fauxen_in, fauxen_out) +}) + +test_that("gm_token_write() / gm_token_read() roundtrip, explicit key", { + fauxen_in <- gargle::gargle2.0_token( + email = "b@example.org", + credentials = list(b = 1) + ) + tmp <- withr::local_tempfile(pattern = "fauxen-") + withr::local_envvar(GMAILR_ABCXYZ_KEY = gargle::secret_make_key()) + + gm_token_write(fauxen_in, tmp, key = "GMAILR_ABCXYZ_KEY") + + expect_error(readRDS(tmp)) + expect_error(gm_token_read(tmp)) + + fauxen_out <- gm_token_read(tmp, "GMAILR_ABCXYZ_KEY") + expect_equal(fauxen_in, fauxen_out) +}) From 4ced5c2f7826a932e6ccb795be8a126e6b26fbb6 Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Mon, 19 Jun 2023 11:06:37 +0200 Subject: [PATCH 2/4] Work on docs --- R/gm_auth.R | 6 +++++- _pkgdown.yml | 10 ++++++---- man/gm_token_write.Rd | 8 ++++---- 3 files changed, 15 insertions(+), 9 deletions(-) diff --git a/R/gm_auth.R b/R/gm_auth.R index 655a96b..5658ce4 100644 --- a/R/gm_auth.R +++ b/R/gm_auth.R @@ -460,7 +460,11 @@ fixup_gmail_scopes <- function(scopes) { #' @inheritParams gm_auth #' @param path The path to write to (`gm_token_write()`) or to read from #' (`gm_token_read()`). -#' @inheritParams gargle::gargle_secret +#' @param key Encryption key, as implemented by httr2's [secret +#' functions](https://httr2.r-lib.org/reference/secrets.html). If absent, a +#' built-in `key` is used. If supplied, the `key` should almost always be the +#' name of an environment variable whose value was generated with +#' `gargle::secret_make_key()` or `httr2::secret_make_key()`). #' #' @export gm_token_write <- function(token = gm_token(), diff --git a/_pkgdown.yml b/_pkgdown.yml index a680d4e..6921c6e 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -17,17 +17,19 @@ news: href: https://www.tidyverse.org/articles/2019/08/gmailr-1-0-0/ reference: -- title: Authentication +- title: Authentication and authorization desc: > - These functions are used to configure and establish authentication to the gmail API. `gm_auth_configure()` and `gm_auth()` are the most important for most users. + These functions are used to auth with the gmail API. `gm_auth_configure()` and `gm_auth()` are the most important for most users. contents: - - matches("auth") + - gm_auth + - gm_deauth + - gm_auth_configure - gm_scopes - gm_has_token - gm_profile - gm_token - - gm_has_token - gmailr-configuration + - gm_token_write - title: Messages desc: > These functions create, modify, query and delete email messages. diff --git a/man/gm_token_write.Rd b/man/gm_token_write.Rd index 0c7e01b..49ddec8 100644 --- a/man/gm_token_write.Rd +++ b/man/gm_token_write.Rd @@ -18,10 +18,10 @@ httr's class \code{request}, i.e. a token that has been prepared with \item{path}{The path to write to (\code{gm_token_write()}) or to read from (\code{gm_token_read()}).} -\item{key}{Encryption key, as implemented by httr2's \href{https://httr2.r-lib.org/reference/secrets.html}{secret functions}. This should -almost always be the name of an environment variable whose value was -generated with \code{secret_make_key()} (which is an inlined copy of -\code{httr2::secret_make_key()}).} +\item{key}{Encryption key, as implemented by httr2's \href{https://httr2.r-lib.org/reference/secrets.html}{secret functions}. If absent, a +built-in \code{key} is used. If supplied, the \code{key} should almost always be the +name of an environment variable whose value was generated with +\code{gargle::secret_make_key()} or \code{httr2::secret_make_key()}).} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} From ca7489e9b20a265ce615f4db8233eaae96fb9aaa Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Mon, 19 Jun 2023 17:04:04 +0200 Subject: [PATCH 3/4] Work on docs --- R/gm_auth.R | 13 ++++++++----- man/gm_token_write.Rd | 13 ++++++++----- 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/R/gm_auth.R b/R/gm_auth.R index 5658ce4..fb6cf27 100644 --- a/R/gm_auth.R +++ b/R/gm_auth.R @@ -454,17 +454,20 @@ fixup_gmail_scopes <- function(scopes) { #' #' To prepare a stored credential for exposure in a more public setting, such as #' on GitHub or CRAN, you must actually encrypt it, using a `key` known only to -#' you. You should make this encryption `key` available on both the reading and -#' writing side via an environment variable. +#' you. You must make the encryption `key` available via a secure environment +#' variable in any setting where you wish to decrypt and use the token, such as +#' on GitHub Actions. #' #' @inheritParams gm_auth #' @param path The path to write to (`gm_token_write()`) or to read from #' (`gm_token_read()`). #' @param key Encryption key, as implemented by httr2's [secret #' functions](https://httr2.r-lib.org/reference/secrets.html). If absent, a -#' built-in `key` is used. If supplied, the `key` should almost always be the -#' name of an environment variable whose value was generated with -#' `gargle::secret_make_key()` or `httr2::secret_make_key()`). +#' built-in `key` is used. If supplied, the `key` should usually be the name +#' of an environment variable whose value was generated with +#' `gargle::secret_make_key()` (which is a copy of +#' `httr2::secret_make_key()`). The `key` argument of `gm_token_read()` must +#' match the `key` used in `gm_token_write()`. #' #' @export gm_token_write <- function(token = gm_token(), diff --git a/man/gm_token_write.Rd b/man/gm_token_write.Rd index 49ddec8..d9622ad 100644 --- a/man/gm_token_write.Rd +++ b/man/gm_token_write.Rd @@ -19,9 +19,11 @@ httr's class \code{request}, i.e. a token that has been prepared with (\code{gm_token_read()}).} \item{key}{Encryption key, as implemented by httr2's \href{https://httr2.r-lib.org/reference/secrets.html}{secret functions}. If absent, a -built-in \code{key} is used. If supplied, the \code{key} should almost always be the -name of an environment variable whose value was generated with -\code{gargle::secret_make_key()} or \code{httr2::secret_make_key()}).} +built-in \code{key} is used. If supplied, the \code{key} should usually be the name +of an environment variable whose value was generated with +\code{gargle::secret_make_key()} (which is a copy of +\code{httr2::secret_make_key()}). The \code{key} argument of \code{gm_token_read()} must +match the \code{key} used in \code{gm_token_write()}.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} @@ -78,7 +80,8 @@ relatively secure place, such as on Posit Connect within your organization. To prepare a stored credential for exposure in a more public setting, such as on GitHub or CRAN, you must actually encrypt it, using a \code{key} known only to -you. You should make this encryption \code{key} available on both the reading and -writing side via an environment variable. +you. You must make the encryption \code{key} available via a secure environment +variable in any setting where you wish to decrypt and use the token, such as +on GitHub Actions. } From 7bdbf2abd05e8354c80f079644098bdeab532a03 Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Mon, 19 Jun 2023 17:09:07 +0200 Subject: [PATCH 4/4] Add NEWS bullet --- NEWS.md | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 2c6e8b2..789c038 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,7 @@ ## Syncing up with gargle -Versions 1.3.0, 1.4.0, and 1.5.0 of gargle introduced some changes around OAuth and gmailr is syncing up that: +Versions 1.3.0, 1.4.0, and 1.5.1 of gargle introduced some changes around OAuth and gmailr is syncing up that: * `gm_oauth_client()` is a new function to replace the now-deprecated `gm_oauth_app()`. This is somewhat about a vocabulary change ("client" instead @@ -56,6 +56,11 @@ Versions 1.3.0, 1.4.0, and 1.5.0 of gargle introduced some changes around OAuth Since the lack of an OAuth client undoubtedly remains the most common reason for `gm_auth()` to fail, its error message includes some specific content if no OAuth client has been configured. + +* `gm_token_write()` + `gm_token_read()` is a new matched pair of functions that + make it much easier to explicitly store a token obtained in an interactive + session then reuse that token elsewhere, such in CI or in a deployed product + (#190). * `gm_scopes()` can now take a character vector of scopes, each of which can be an actual scope or a short alias, e.g., `"gmail.readonly"`, which identifies a