Merge pull request #135 from jennybc/get-via-csv-fix

Add param to check if sheet is public before making req

.Rbuildignore

@@ -1,8 +1,10 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
 ^\.httr-oauth$
+^\.httr-oauth_REVOKED$
 ^vignettes/\.httr-oauth$
 ^tests/testthat/\.httr-oauth$
+^tests/testthat/\.httr-oauth_REVOKED$
 vignettes/basic-usage.Rmd
 ^\.travis\.yml$
 ^internal-projects$

.gitignore

@@ -1,7 +1,7 @@
 .Rproj.user
 .Rhistory
 .RData
-.httr-oauth
+.httr-oauth*
 googlesheets.Rproj
 jenny-scratch/*
 tests/testthat/googlesheets_token.rds

R/consume-data.R

@@ -46,7 +46,8 @@ get_via_csv <- function(ss, ws = 1, ..., verbose = TRUE) {
                "file and then read it into R."))
   }
 
-  req <- gsheets_GET(this_ws$exportcsv, to_xml = FALSE)
+  req <- gsheets_GET(this_ws$exportcsv, to_xml = FALSE, 
+                     use_auth = !ss$is_public)
 
   if(req$headers$`content-type` != "text/csv") {
     stop1 <- "Cannot access this sheet via csv."

R/gs_auth.R

@@ -123,7 +123,7 @@ google_user <- function() {
 #' @export
 gs_user <- function(verbose = TRUE) {
 
-  if(token_exists()) {
+  if(token_exists(verbose)) {
 
     token <- .state$token
     token_ok <- token$validate()
@@ -139,13 +139,13 @@ gs_user <- function(verbose = TRUE) {
 
     if(verbose) {
       sprintf("                       displayName: %s\n",
-              ret$displayName) %>% cat()
+              ret$displayName) %>% message()
       sprintf("                      emailAddress: %s\n",
-              ret$emailAddress) %>% cat()
+              ret$emailAddress) %>% message()
       sprintf("Date-time of session authorization: %s\n",
-              ret$auth_date) %>% cat()
+              ret$auth_date) %>% message()
       sprintf("  Date-time of access token expiry: %s\n",
-              ret$exp_date) %>% cat()
+              ret$exp_date) %>% message()
       if(token_ok) {
         message("Access token is valid.")
       } else {
@@ -154,7 +154,9 @@ gs_user <- function(verbose = TRUE) {
 
     }
 
-  } else if(verbose) cat("No user currently authorized.")
+  } else {
+    ret <- NULL
+  }
 
   invisible(ret)
 
@@ -165,18 +167,20 @@ gs_user <- function(verbose = TRUE) {
 #' @return logical
 #'
 #' @keywords internal
-token_exists <- function() {
+token_exists <- function(verbose = TRUE) {
 
   if(is.null(.state$token)) {
-    message("No authorization yet in this session!\n")
+    if(verbose) {
+      message("No authorization yet in this session!")
 
-    if(file.exists(".httr-oauth")) {
-      message(paste("NOTE: a .httr-oauth file exists in current working",
-                    "directory.\n Run gs_auth() to use the",
-                    "credentials cached in .httr-oauth for this session."))
-    } else {
-      message(paste("No .httr-oauth file exists in current working directory.",
-                    "Run gs_auth() to provide credentials."))
+      if(file.exists(".httr-oauth")) {
+        message(paste("NOTE: a .httr-oauth file exists in current working",
+                      "directory.\n Run gs_auth() to use the",
+                      "credentials cached in .httr-oauth for this session."))
+      } else {
+        message(paste("No .httr-oauth file exists in current working directory.",
+                      "Run gs_auth() to provide credentials."))
+      }
     }
 
     invisible(FALSE)
@@ -188,3 +192,28 @@ token_exists <- function() {
   }
 
 }
+
+#' Revoke authentication
+#'
+#' This unexported function exists so we can revoke all authentication for
+#' testing purposes.
+#'
+#' @keywords internal
+gs_auth_revoke <- function(rm_httr_oauth = FALSE, verbose = TRUE) {
+
+  if(rm_httr_oauth && file.exists(".httr-oauth")) {
+    if(verbose) {
+      message("Disabling .httr-oauth by renaming to .httr-oauth_REVOKED")
+    }
+    file.rename(".httr-oauth", ".httr-oauth_REVOKED")
+  }
+
+  if(!is.null(.state$token)) {
+    if(verbose) {
+      message(paste("Removing google token stashed in googlesheets's",
+                    "internal environment"))
+    }
+    rm("token", envir = .state)
+  }
+
+}

R/http_requests.R

@@ -3,19 +3,23 @@
 #' Make GET request to Google Sheets API.
 #'
 #' @param url the url of the page to retrieve
-#' @param to_xml whether to convert response contents to xml_doc() or leave as
-#'    character string
+#' @param to_xml whether to convert response contents to \code{xml_doc()} or
+#'   leave as character string
+#' @param use_auth logical; indicates if authorization should be used, defaults
+#'   to \code{FALSE} if \code{url} implies public visibility and \code{TRUE}
+#'   otherwise
 #' @param ... optional; further named parameters, such as \code{query},
 #'   \code{path}, etc, passed on to \code{\link[httr]{modify_url}}. Unnamed
 #'   parameters will be combined with \code{\link[httr]{config}}.
 #'
 #' @keywords internal
-gsheets_GET <- function(url, to_xml = TRUE, ...) {
+gsheets_GET <-
+  function(url, to_xml = TRUE, use_auth = !grepl("public", url), ...) {
 
-  if(grepl("public", url)) {
-    req <- httr::GET(url, ...)
-  } else {
+  if(use_auth) {
     req <- httr::GET(url, get_google_token(), ...)
+  } else {
+    req <- httr::GET(url, ...)
   }
   httr::stop_for_status(req)
   ## TO DO: interpret some common problems for user? for example, a well-formed

internal-projects/14_create-cars-pvt-sheet.R

@@ -0,0 +1,16 @@
+#' ---
+#' output: md_document
+#' ---
+
+library("googlesheets")
+suppressPackageStartupMessages(library("dplyr"))
+
+## damn you render and your hard-wiring of wd = dir where file lives!
+## if I don't commit this abomination, existing .httr-oauth cannot be found :(
+if ((getwd() %>% basename) == "data-for-demo") {
+  setwd("..")
+}
+
+cars_ss <- gs_new("test-gs-cars-private", ws_title = "cars",
+                  input = head(mtcars), header = TRUE, trim = TRUE)
+cars_ss

man/gs_auth_revoke.Rd

@@ -0,0 +1,14 @@
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/gs_auth.R
+\name{gs_auth_revoke}
+\alias{gs_auth_revoke}
+\title{Revoke authentication}
+\usage{
+gs_auth_revoke(rm_httr_oauth = FALSE, verbose = TRUE)
+}
+\description{
+This unexported function exists so we can revoke all authentication for
+testing purposes.
+}
+\keyword{internal}
+

man/gsheets_GET.Rd

@@ -4,13 +4,17 @@
 \alias{gsheets_GET}
 \title{Create GET request}
 \usage{
-gsheets_GET(url, to_xml = TRUE, ...)
+gsheets_GET(url, to_xml = TRUE, use_auth = !grepl("public", url), ...)
 }
 \arguments{
 \item{url}{the url of the page to retrieve}
 
-\item{to_xml}{whether to convert response contents to xml_doc() or leave as
-character string}
+\item{to_xml}{whether to convert response contents to \code{xml_doc()} or
+leave as character string}
+
+\item{use_auth}{logical; indicates if authorization should be used, defaults
+to \code{FALSE} if \code{url} implies public visibility and \code{TRUE}
+otherwise}
 
 \item{...}{optional; further named parameters, such as \code{query},
   \code{path}, etc, passed on to \code{\link[httr]{modify_url}}. Unnamed

man/token_exists.Rd

@@ -4,7 +4,7 @@
 \alias{token_exists}
 \title{Check if authorization currently in force}
 \usage{
-token_exists()
+token_exists(verbose = TRUE)
 }
 \value{
 logical

tests/testthat/helper01_setup-sheets.R

@@ -76,3 +76,12 @@ iris_pvt_url <- "https://docs.google.com/spreadsheets/d/1UXr4-haIQsmJfyjkEhlkNt2
 iris_pvt_title <- "test-gs-iris-private"
 iris_pvt_key <- "1UXr4-haIQsmJfyjkEhlkNt2PXduBkB97e15jez9ogRo"
 iris_pvt_ws_feed <- "https://spreadsheets.google.com/feeds/worksheets/1UXr4-haIQsmJfyjkEhlkNt2PXduBkB97e15jez9ogRo/private/full"
+
+## Private cars sheet (owned by rpackagetest)
+cars_pvt_url <- "https://docs.google.com/spreadsheets/d/1rC2qjB8VE50kTkHZL5PY_DHVc9foRLI8ixKLr8a0a9Y/"
+cars_pvt_title <- "test-gs-cars-private"
+cars_pvt_key <- cars_pvt_url %>%
+  extract_key_from_url()
+cars_pvt_ws_feed <- cars_pvt_url %>%
+  extract_key_from_url() %>%
+  construct_ws_feed_from_key()

tests/testthat/test-yy-axe-oauth-token.R

@@ -0,0 +1,26 @@
+context("revoke authentication")
+
+## remove the google token, to make 100% sure the remaining tests run w/o auth
+
+## this filename is deliberate w/r/t alphabetical order, so don't change it
+## lightly! it's no coincidence that "axe" starts with "A"
+gs_auth_revoke(rm_httr_oauth = TRUE, verbose = FALSE)
+
+test_that("Token does NOT exist, no .httr-oauth file in wd", {
+
+  expect_false(token_exists())
+  expect_false(file.exists(".httr-oauth"))
+
+})
+
+test_that("We can NOT register a pvt sheet owned by rpackagetest", {
+
+  if(interactive()) {
+    mess <- paste("Skipping the attempt to access private third party",
+                  "sheet w/o authorization, because session is interactive",
+                  "and would launch browser-based authentication.")
+    skip(mess)
+  }
+  expect_error(gs_ws_feed(cars_pvt_ws_feed, lookup = FALSE, verbose = FALSE))
+
+})

tests/testthat/test-zz-clean-up.R

@@ -1 +1,9 @@
+## re-authenticate!
+gs_auth(token = "googlesheets_token.rds")
+
+## "RAIN DANCE"
+## RELIABLY FORCES AUTO-REFRESH OF STALE OAUTH TOKEN
+## I DON'T KNOW WHY THIS HELPS BUT IT DOES!
+gs_ls()
+
 gs_grepdel(TEST, verbose = FALSE)