Start porting to use gargle; first commit

.gitignore

@@ -5,3 +5,4 @@
 
 ~/[email protected]_google_apis_auth.RDS
 .httr-oauth
+accounts.google.com

DESCRIPTION

@@ -8,19 +8,21 @@ Date: 2019-05-30
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
-Suggests:
-    rmarkdown,
-    knitr,
-    testthat,
+Suggests: 
     covr,
+    httptest,
+    knitr,
+    rmarkdown,
+    testthat (>= 2.1.0),
     withr
 VignetteBuilder: rmarkdown
-Imports:
+Imports: 
     rlang,
     purrr,
     httr,
     dplyr,
     lubridate,
-    tidyr
+    tidyr,
+    gargle
 RoxygenNote: 6.1.1
 Roxygen: list(markdown = TRUE)

R/authenticate.R

@@ -18,3 +18,16 @@ get_google_token <- function(google_app){
     scope = 'https://www.googleapis.com/auth/calendar.readonly'
   )
 }
+
+
+options(gargle_quiet = FALSE)
+get_google_token <- function(email = NULL, google_app = NULL){
+  if (missing(google_app) || is.null(google_app)) {
+    google_app <- rstudio_app
+  }
+  gargle::token_fetch(
+    scopes = 'https://www.googleapis.com/auth/calendar.readonly',
+    app = google_app,
+    email = email
+  )
+}

R/read_google_calendar.R

@@ -61,32 +61,16 @@ squash_without_warning <- function(x)suppressWarnings(squash(x))
 utils::globalVariables(c(".", "created", "updated", "start_date", "end_date", "end_dateTime", "start_dateTime"))
 
 
-#' Read list of google calendar events.
-#'
-#' @inheritParams get_gcal_list
-#'
-#' @param id calendar id, obtained from [get_gcal_list()]
-#' @param max_results Maximum number of results retrieved per query
-#' @param days_in_past Restrict results to date range, number of days in past
-#' @param days_in_future Restrict results to date range, number of days into future
-#'
-#' @references https://developers.google.com/google-apps/calendar/v3/reference/events/list
-#' @family gcal functions
-#' @export
-get_gcal_events <- function(id, google_token, max_results = 250, days_in_past = 90, days_in_future = 90){
-  message("Reading calendar ", id)
-  time_min <- Sys.time() - days_in_past * 24 * 3600
-  time_max <- Sys.time() + days_in_future * 24 * 3600
-
+call_gcal_api <- function(id, google_token, time_min, time_max, max_results = 250){
+  api = "https://www.googleapis.com/calendar/v3/calendars"
   time_min <- strftime(time_min, tz = "UTC", "%Y-%m-%dT%H:%M:00Z")
   time_max <- strftime(time_max, tz = "UTC", "%Y-%m-%dT%H:%M:00Z")
-
-  api = "https://www.googleapis.com/calendar/v3/calendars"
   url <- sprintf(
     "%s/%s/events?maxResults=%d&timeMin=%s&timeMax=%s&orderBy=startTime&singleEvents=true",
     api, id, max_results, time_min, time_max
   )
   r <- GET(url, config(token = google_token))
+  httr::stop_for_status(r)
   r <- content(r)
 
   items <- r$items
@@ -100,12 +84,40 @@ get_gcal_events <- function(id, google_token, max_results = 250, days_in_past =
     message(".", appendLF = FALSE)
     new_url <- sprintf("%s&pageToken=%s", url, r[["nextPageToken"]])
     r <- GET(new_url, config(token = google_token))
+    httr::stop_for_status(r)
     r <- content(r)
     new_items <- r$items
     items <- append(items, new_items)
   }
-  if (retrieved_more) message()
+  items
+}
+
 
+#' Read list of google calendar events.
+#'
+#' @inheritParams get_gcal_list
+#'
+#' @param id calendar id, obtained from [get_gcal_list()]
+#' @param days_in_past Restrict results to date range, number of days in past
+#' @param days_in_future Restrict results to date range, number of days into future
+#' @param now Reference time stamp, defaulting to [Sys.time()]
+#' @param max_results Maximum number of results retrieved per query
+#'
+#' @references https://developers.google.com/google-apps/calendar/v3/reference/events/list
+#' @family gcal functions
+#' @export
+get_gcal_events <- function(id, google_token, days_in_past = 90, days_in_future = 90, now = Sys.time(), max_results = 250){
+  message("Reading calendar ", id)
+  time_min <- now - days_in_past * 24 * 3600
+  time_max <- now + days_in_future * 24 * 3600
+
+  items <- call_gcal_api(
+    id = id,
+    google_token = google_token,
+    time_min = time_min,
+    time_max = time_max,
+    max_results = max_results
+  )
 
   drop_attendees <- function(x){
     x %>%
@@ -128,12 +140,12 @@ get_gcal_events <- function(id, google_token, max_results = 250, days_in_past =
 
   events %>%
     mutate(
-      created = transform_or_na(., "created", as_datetime),
-      updated = transform_or_na(., "updated", as_datetime),
-      start_date = transform_or_na(., "start_date"),
-      end_date = transform_or_na(., "end_date"),
-      start_dateTime = as_datetime(start_dateTime),
-      end_dateTime = as_datetime(end_dateTime)
+      created        = transform_or_na(., "created", as_datetime),
+      updated        = transform_or_na(., "updated", as_datetime),
+      start_date     = transform_or_na(., "start_date"),
+      end_date       = transform_or_na(., "end_date"),
+      start_dateTime = transform_or_na(., "start_dateTime", as_datetime),
+      end_dateTime   = transform_or_na(., "end_dateTime", as_datetime)
     )
 }
 

discovery-doc-ingest/drive-example.R

@@ -0,0 +1,32 @@
+library(tidyverse)
+
+## necessary only during gargle development to get devtools' shim for
+## system.file()
+devtools::load_all()
+
+source(
+  system.file("discovery-doc-ingest", "ingest-functions.R", package = "gcalendr")
+)
+
+x <- download_discovery_document("calendar:v3")
+dd <- read_discovery_document(x)
+
+methods <- get_raw_methods(dd)
+
+methods <- methods %>% map(groom_properties,  dd)
+methods <- methods %>% map(add_schema_params, dd)
+methods <- methods %>% map(add_global_params, dd)
+
+
+.endpoints <- methods
+attr(.endpoints, "base_url") <- dd$rootUrl
+## View(.endpoints)
+
+# usually you would execute this from *within* the target package,
+# but I cannot do so in this example
+# please excuse the shenanigans to temporarily target the googledrive project
+if (basename(getwd()) == "gcalendr") {
+  usethis::use_data(.endpoints, internal = TRUE, overwrite = TRUE)
+} else {
+  warning("Execute this code only from inside the `gcalendr` project")
+}

discovery-doc-ingest/ingest-functions.R

@@ -0,0 +1,209 @@
+library(tidyverse)
+
+#' Get versioned IDs from API Discovery Service
+#'
+#' @return A character vector.
+#' @keywords internal
+#' @examples
+#' get_discovery_ids()
+#' grep("drive", get_discovery_ids(), value = TRUE)
+#' grep("sheets", get_discovery_ids(), value = TRUE)
+#' grep("gmail", get_discovery_ids(), value = TRUE)
+#' grep("bigquery", get_discovery_ids(), value = TRUE)
+get_discovery_ids <- function() {
+  apis <- httr::content(
+    httr::GET("https://www.googleapis.com/discovery/v1/apis")
+  )
+  map_chr(apis[["items"]], "id")
+}
+
+#' Download a Discovery Document
+#'
+#' @param id Versioned ID string for target API. Use [get_discovery_ids()] to
+#'   see them all and find the one you want.
+#' @param path Target filepath. Default filename is formed from the API's
+#'   versioned ID and the Discovery Document's revision date. Default parent
+#'   directory is the current package's `data-raw/` directory, if such exists,
+#'   or current working directory, otherwise.
+#'
+#' @return Filepath
+#' @keywords internal
+#' @examples
+#' download_discovery_document("drive:v3")
+#' download_discovery_document("sheets:v4")
+#' download_discovery_document("gmail:v1")
+#' download_discovery_document("bigquery:v2")
+#' download_discovery_document("docs:v1")
+#' download_discovery_document("youtube:v3")
+download_discovery_document <- function(id, path = NULL) {
+  av <- set_names(as.list(strsplit(id, split =":")[[1]]), c("api", "version"))
+  ## https://developers.google.com/discovery/v1/reference/apis/getRest
+  getRest_url <-
+    "https://www.googleapis.com/discovery/v1/apis/{api}/{version}/rest"
+  url <- glue::glue_data(av, getRest_url)
+  dd <- httr::GET(url)
+  httr::stop_for_status(dd, glue::glue("find Discovery Document for ID '{id}'"))
+
+  if (is.null(path)) {
+    dd_content <- httr::content(dd)
+    api_date <- dd_content[c("revision", "id")]
+    api_date <- c(
+      id = sub(":", "-", api_date$id),
+      revision = as.character(as.Date(api_date$revision, format = "%Y%m%d"))
+    )
+    json_filename <- fs::path(paste(api_date, collapse = "_"), ext = "json")
+    data_raw <- rprojroot::find_package_root_file("data-raw")
+    path <- if (fs::dir_exists(data_raw)) {
+      fs::path(data_raw, json_filename)
+    } else {
+      json_filename
+    }
+  }
+
+  writeLines(httr::content(dd, as = "text"), path)
+  path
+}
+
+#' Read a Discovery Document
+#'
+#' @param path Path to a JSON Discovery Document
+#'
+#' @return A list
+#' @examples
+#' drive <- "data-raw/drive-v3_2019-02-07.json"
+#' dd <- read_discovery_document(drive)
+read_discovery_document <- function(path) {
+  jsonlite::fromJSON(path)
+}
+
+#' Get raw methods
+#'
+#' https://developers.google.com/discovery/v1/using#discovery-doc-methods
+#'
+#' @param dd List representing a Discovery Document
+#'
+#' @return a named list with one element per method
+#' @examples
+#' drive <- "data-raw/drive-v3_2019-02-07.json"
+#' dd <- read_discovery_document(drive)
+#' ee <- get_raw_methods(dd)
+get_raw_methods <- function(dd) {
+  dd %>%
+    pluck("resources") %>%
+    map("methods") %>%
+    flatten() %>%
+    set_names(map_chr(., "id"))
+}
+
+#' Groom method properties
+#'
+#' Tweak raw method properties to make them more useful to us downstream:
+#'
+#'   * Prepend the API's `servicePath` to `path`s.
+#'   * Remove the constant stem `"https://www.googleapis.com/auth/"` from
+#'     scopes and collapse multiple scopes into one comma-separated string.
+#'   * Elevate any `$ref` part of `request` or `response` to be the actual
+#'     data for `request` or `response`.
+#'   * Reorder the properties so they appear in a predictable order. However,
+#'     we do not turn missing properties into explicitly missing properties,
+#'     i.e. we don't guarantee all methods have the same properties.
+#'
+#' We don't touch the `parameters` list here, because it needs enough work to
+#' justify having separate functions for that.
+#'
+#' @param methods A named list of raw methods, from [get_raw_methods()]
+#' @param dd A Discovery Document as a list, from [read_discovery_document()]
+#'
+#' @return A named list of "less raw" methods
+groom_properties <- function(method, dd) {
+  method$path <- fs::path(dd$servicePath, method$path)
+
+  condense_scopes <- function(scopes) {
+    scopes %>%
+      str_remove("https://www.googleapis.com/auth/") %>%
+      str_c(collapse = ", ")
+  }
+  method$scopes <- condense_scopes(method$scopes)
+
+  ## I am currently ignoring the fact that `request` sometimes has both
+  ## a `$ref` and a `parameterName` part in the original JSON
+  if (has_name(method, "request")) {
+    method$request <- method$request$`$ref`
+  }
+  if (has_name(method, "response")) {
+    method$response <- method$response$`$ref`
+  }
+
+  # all of the properties in the RestMethod schema, in order of usefulness
+  property_names <- c(
+    "id", "httpMethod", "path", "parameters", "scopes", "description",
+    "request", "response",
+    "mediaUpload", "supportsMediaDownload", "supportsMediaUpload",
+    "useMediaDownloadService",
+    "etagRequired", "parameterOrder", "supportsSubscription"
+  )
+
+  method[intersect(property_names, names(method))]
+}
+
+#' Expand schema placeholders
+#'
+#' Adds the properties associated with a `request` schema to a method's
+#' parameter list.
+#'
+#' Some methods can send an instance of a API resource in the body of a request.
+#' This is indicated by the presence of a schema in the method's `request`
+#' property. For example, the `drive.files.copy` method permits a "Files
+#' resource" in the request body. This is how you convey the desired `name` of
+#' the new copy.
+#'
+#' In practice, this means you can drop such metadata in the body. That is, you
+#' don't actually have to label this explicitly as having `kind = drive#file`
+#' (although that would probably be more proper!), nor do you have to include
+#' all the possible pieces of metadata that constitute a "Files resource". Just
+#' specify the bits that you need to.
+#'
+#' https://developers.google.com/drive/api/v3/reference/files/copy
+#' https://developers.google.com/drive/api/v3/reference/files#resource
+#'
+#' This function consults the method's `request` and, if it holds a schema, the
+#' schema metadata is appended to the method's existing parameters. This way our
+#' request building functions recognize the keys and know that such info belongs
+#' in the body (vs. the url or the query).
+#'
+#' @param method A single method
+#' @param dd A Discovery Document as a list, from [read_discovery_document()]
+#'
+#' @return The input method, but with a potentially expanded parameter list.
+add_schema_params <- function(method, dd) {
+  req <- pluck(method, "request")
+  if (is.null(req)) {
+    return(method)
+  }
+
+  id <- method$id
+  schema_params <- dd[[c("schemas", req, "properties")]]
+  schema_params <- modify(schema_params, ~ `[[<-`(.x, "location", "body"))
+
+  message(glue::glue("{id} gains {req} schema params\n"))
+  method$parameters <- c(method$parameters, schema_params)
+  method
+}
+
+#' Add API-wide parameters
+#'
+#' Certain parameters are sensible for any request to a specific API and,
+#' indeed, are usually common across APIs. Examples are "fields", "key", and
+#' "oauth_token". This function appends these parameters to a method's parameter
+#' list. Yes, this means some info is repeated in all methods, but this way our
+#' methods are more self-contained and our request building functions can be
+#' simpler.
+#'
+#' @param method A single method
+#' @param dd A Discovery Document as a list, from [read_discovery_document()]
+#'
+#' @return The input method, but with an expanded parameter list.
+add_global_params <- function(method, dd) {
+  method[["parameters"]] <- c(method[["parameters"]], dd[["parameters"]])
+  method
+}