Make functions using utils::menu testable

gesistsa · Nov 20, 2022 · bd4f52c · bd4f52c
1 parent ad05cd7
commit bd4f52c
Show file tree

Hide file tree

Showing 3 changed files with 114 additions and 17 deletions.
diff --git a/R/auth.R b/R/auth.R
@@ -242,7 +242,7 @@ get_token_from_envvar <- function(envvar = "RTOOT_DEFAULT_TOKEN", check_stop = T
 
 # check if a token is available and return one if not
 ## it checks the envvar RTOOT_DEFAULT_TOKEN first; then RDS;
-check_token_rtoot <- function(token = NULL) {
+check_token_rtoot <- function(token = NULL, verbose = TRUE) {
   selection <- NULL
   if(is.null(token)){
     if (Sys.getenv("RTOOT_DEFAULT_TOKEN") != "") {
@@ -264,24 +264,12 @@ check_token_rtoot <- function(token = NULL) {
     if (isTRUE(file.exists(token_path))) {
       token <- readRDS(token_path)
     } else {
-      if (interactive()) {
-        selection <- utils::menu(
-          c("yes", "no"),
-          title = "This seems to be the first time you are using rtoot. Do you want to authenticate now?"
-        )
-      } else {
-        selection <- 2L
-      }
+      selection <- rtoot_menu(title = "This seems to be the first time you are using rtoot. Do you want to authenticate now?",
+                              default = 2L, verbose = verbose)
     }
   } else if (!is_auth_rtoot(token)) {
-    if (interactive()) {
-      selection <- utils::menu(
-        c("yes", "no"),
-        title = "Your token is invalid. Do you want to authenticate now?"
-        )
-    } else {
-      selection <- 2L
-    }
+    selection <- rtoot_menu(title = "Your token is invalid. Do you want to authenticate now?", default = 2L,
+                            verbose = verbose)
   }
   if (isTRUE(selection == 1L)) {
     token <- auth_setup()

diff --git a/R/utils.R b/R/utils.R
@@ -160,3 +160,17 @@ rate_limit_remaining <- function(object){
     return(as.numeric(header[["rate_remaining"]]))
   }
 }
+
+## A kind of drop-in replacement of utils::menu, with a plus
+rtoot_menu <- function(choices = c("yes", "no"), title, default = 2L, verbose = TRUE) {
+  if (!is.null(options("rtoot_cheatcode")$rtoot_cheatcode)) {
+    if (options("rtoot_cheatcode")$rtoot_cheatcode == "uuddlrlrba") {
+      sayif(verbose, title)
+      return(options("rtoot_cheat_answer")$rtoot_cheat_answer) ### VW-Style cheating!
+    }
+  }
+  if (isFALSE(interactive())) {
+    return(default)
+  }
+  return(utils::menu(choices = choices, title = title))
+}
diff --git a/tests/testthat/test-auth_check_token_rtoot.R b/tests/testthat/test-auth_check_token_rtoot.R
@@ -1,5 +1,6 @@
 original_envvar <- Sys.getenv("RTOOT_DEFAULT_TOKEN")
 original_option <- options("rtoot_token")$rtoot_token
+options("rtoot_cheatcode" = NULL)
 
 gen_random_token <- function() {
   paste0(sample(c(LETTERS, letters, 0:9), 43, replace = TRUE), collapse = "")
@@ -55,8 +56,102 @@ test_that("seven conditions", {
   ## print(check_token_rtoot(token))
 })
 
+test_that("cheatmode", {
+  skip_on_cran()
+  ## Enter cheatmode
+  options("rtoot_cheatcode" = "uuddlrlrba")
+  default_ans <- gen_random_token()
+  options("rtoot_cheat_answer" = default_ans)
+  expect_message(x <- rtoot_menu(title = "123"))
+  expect_equal(x, default_ans)
+})
+
+test_that("cheatmode, invalid_token", {
+  skip_on_cran()
+  options("rtoot_cheatcode" = "uuddlrlrba")
+  options("rtoot_cheat_answer" = 2)  
+  expect_error(x <- check_token_rtoot(token = iris, verbose = FALSE))
+  output <- capture_message(check_token_rtoot(token = iris, verbose = TRUE))
+  expect_true(grepl("Your token is invalid. Do you want to authenticate now?", output))
+  options("rtoot_cheatcode" = NULL)
+  options("rtoot_cheat_answer" = NULL)
+})
+
+test_that("cheatmode, file doesn't exist", {
+  skip_on_cran()
+  options("rtoot_cheatcode" = "uuddlrlrba")
+  options("rtoot_cheat_answer" = 2)
+  random_path <- tempfile(fileext = gen_random_token())
+  expect_false(file.exists(random_path))
+  options("rtoot_token" = random_path)
+  Sys.setenv(RTOOT_DEFAULT_TOKEN = "")
+  expect_error(x <- check_token_rtoot(verbose = FALSE))
+  output <- capture_message(check_token_rtoot(verbose = TRUE))
+  expect_true(grepl("This seems to be the first time you are using rtoot. Do you want to authenticate now?", output))
+  options("rtoot_cheatcode" = NULL)
+  options("rtoot_cheat_answer" = NULL)
+})
+
+test_that("cheatmode, nothing in ~/.config/R/rtoot/", {
+  skip_on_cran()
+  skip_if(length(list.files(tools::R_user_dir("rtoot", "config"))) != 0)
+  options("rtoot_cheatcode" = "uuddlrlrba")
+  options("rtoot_cheat_answer" = 2)
+  options("rtoot_token" = NULL)
+  Sys.setenv(RTOOT_DEFAULT_TOKEN = "")
+  expect_error(x <- check_token_rtoot(verbose = FALSE))
+  output <- capture_message(check_token_rtoot())
+  expect_true(grepl("This seems to be the first time you are using rtoot. Do you want to authenticate now?", output))
+  options("rtoot_cheatcode" = NULL)
+  options("rtoot_cheat_answer" = NULL)  
+})
+
+test_that("A valid token in ~/.config/R/rtoot/", {
+  skip_on_cran()
+  skip_if(length(list.files(tools::R_user_dir("rtoot", "config"))) != 0)
+  ## skip if that's not writable
+  skip_if(file.access(tools::R_user_dir("rtoot", "config"), mode = 2) != 0)
+  options("rtoot_token" = NULL)
+  Sys.setenv(RTOOT_DEFAULT_TOKEN = "")
+  saved_token2 <- list(bearer = gen_random_token())
+  saved_token2$type <- "user"
+  saved_token2$instance <- "saved_token"
+  class(saved_token2) <- "rtoot_bearer"
+  save_auth_rtoot(saved_token2, "rtoot_test")
+  expect_true(file.exists(file.path(tools::R_user_dir("rtoot", "config"), "rtoot_test.rds")))
+  expect_true(is.null(options("rtoot_token")$rtoot_token))
+  expect_equal(saved_token2, check_token_rtoot(verbose = FALSE))
+  expect_false(is.null(options("rtoot_token")$rtoot_token))
+  unlink(file.path(tools::R_user_dir("rtoot", "config"), "rtoot_test.rds"))
+})
+
+## A crazy bug
+## test_that("cheatmode, An invalid rds in ~/.config/R/rtoot/", {
+##   skip_on_cran()
+##   skip_if(length(list.files(tools::R_user_dir("rtoot", "config"))) != 0)
+##   ## skip if that's not writable
+##   skip_if(file.access(tools::R_user_dir("rtoot", "config"), mode = 2) != 0)
+##   options("rtoot_token" = NULL)
+##   Sys.setenv(RTOOT_DEFAULT_TOKEN = "")
+##   saveRDS(iris, file.path(tools::R_user_dir("rtoot", "config"), "rtoot_test.rds"))
+##   expect_true(file.exists(file.path(tools::R_user_dir("rtoot", "config"), "rtoot_test.rds")))
+##   expect_true(is.null(options("rtoot_token")$rtoot_token))
+##   options("rtoot_cheatcode" = "uuddlrlrba")
+##   options("rtoot_cheat_answer" = 2)
+##   expect_error(x <- check_token_rtoot(verbose = FALSE))
+##   output <- capture_message(check_token_rtoot(verbose = TRUE))
+##   expect_true(grepl("Your token is invalid. Do you want to authenticate now?", output))
+##   options("rtoot_cheatcode" = NULL)
+##   options("rtoot_cheat_answer" = NULL)
+##   expect_true(is.null(options("rtoot_token")$rtoot_token)) ## shouldn't change
+##   unlink(file.path(tools::R_user_dir("rtoot", "config"), "rtoot_test.rds"))
+## })
+
+
 ## tear down
 
 Sys.setenv(RTOOT_DEFAULT_TOKEN = original_envvar)
 options("rtoot_token" = original_option)
 unlink(saved_token_path)
+options("rtoot_cheatcode" = NULL)
+options("rtoot_cheat_answer" = NULL)