Merge pull request #74 from chainsawriot/auth_test

use parameter `verbose`; spin off non-interactive parts in `auth_setup` #69

R/auth.R

@@ -8,6 +8,7 @@
 #' @param path path to store the token in. The default is to store tokens in the
 #'   path returned by `tools::R_user_dir("rtoot", "config")`.
 #' @param clipboard logical, whether to export the token to the clipboard
+#' @param verbose logical whether to display messages
 #' @details If either `name` or `path` are set to `FALSE`, the token is only
 #'   returned and not saved. If you would like to save your token as an environment variable,
 #'   please set `clipboard` to `TRUE`. Your token will be copied to clipboard in the environment variable
@@ -20,22 +21,28 @@
 #' auth_setup("mastodon.social", "public")
 #' }
 #' @export
-auth_setup <- function(instance = NULL, type = NULL, name = NULL, path = NULL, clipboard = FALSE) {
+auth_setup <- function(instance = NULL, type = NULL, name = NULL, path = NULL, clipboard = FALSE, verbose = TRUE) {
   while (is.null(instance) || instance == "") {
     instance <- readline(prompt = "On which instance do you want to authenticate (e.g., \"mastodon.social\")? ")
   }
   client <- get_client(instance = instance)
   if (!isTRUE(type %in% c("public", "user"))) {
     type <- c("public", "user")[utils::menu(c("public", "user"), title = "What type of token do you want?")]
   }
-  token <- create_token(client, type = type)
+  token <- process_created_token(create_token(client, type = type), name = name, path = path, clipboard = clipboard, verify = TRUE)
+  return(token) ## explicit
+}
+
+process_created_token <- function(token, name = NULL, path = NULL, clipboard = FALSE, verify = TRUE, verbose = TRUE) {
   if (!isFALSE(name) && !isFALSE(path)) {
     token_path <- save_auth_rtoot(token, name, path)
     options("rtoot_token" = token_path)
   }
-  verify_credentials(token) # this should be further up before saving, but seems to often fail
+  if (isTRUE(verify)) {
+    verify_credentials(token) # this should be further up before saving, but seems to often fail
+  }
   if (isTRUE(clipboard)) {
-    convert_token_to_envvar(token, clipboard = TRUE)
+    convert_token_to_envvar(token = token, clipboard = TRUE, verbose = verbose)
   }
   check_token_rtoot(token)
 }
@@ -190,7 +197,6 @@ is_auth_rtoot <- function(token) inherits(token, "rtoot_bearer")
 
 #' Convert token to environment variable
 #' @inheritParams verify_credentials
-#' @param message logical whether to display message
 #' @inheritParams auth_setup
 #' @return Token (in environment variable format), invisibily
 #' @examples
@@ -200,19 +206,15 @@ is_auth_rtoot <- function(token) inherits(token, "rtoot_bearer")
 #' envvar
 #' }
 #' @export
-convert_token_to_envvar <- function(token, message = TRUE, clipboard = TRUE) {
+convert_token_to_envvar <- function(token, clipboard = TRUE, verbose = TRUE) {
   envvar_string <- paste0("RTOOT_DEFAULT_TOKEN=\"", token$bearer, ";", token$type, ";", token$instance, "\"")
   if (isTRUE(clipboard)) {
     if (clipr::clipr_available()) {
       clipr::write_clip(envvar_string)
-      if (message) {
-        message("Token (in environment variable format) has been copied to clipboard.")
+      sayif(verbose, "Token (in environment variable format) has been copied to clipboard.")
       }
-    } else {
-      if (message) {
-        message("Clipboard is not available.")
-      }
-    }
+  } else {
+    sayif(verbose, "Clipboard is not available.")
   }
   return(invisible(envvar_string))
 }

R/utils.R

@@ -99,3 +99,9 @@ v <- function(FUN) {
   }
   return(v_FUN)
 }
+
+sayif <- function(verbose, ...) {
+  if (isTRUE(verbose)) {
+    message(...)
+  }
+}

tests/fixtures/process_created_token.yml

@@ -0,0 +1,48 @@
+http_interactions:
+- request:
+    method: get
+    uri: https://emacs.ch/api/v1/accounts/verify_credentials
+    body:
+      encoding: ''
+      string: ''
+    headers:
+      Accept: application/json, text/xml, application/xml, */*
+      Authorization: Bearer <<<MASTODON TOKEN>>>
+  response:
+    status:
+      status_code: 401
+      category: Client error
+      reason: Unauthorized
+      message: 'Client error: (401) Unauthorized'
+    headers:
+      date: Tue, 15 Nov 2022 14:02:14 GMT
+      content-type: application/json; charset=utf-8
+      server: Mastodon
+      x-frame-options: DENY
+      x-content-type-options: nosniff
+      x-xss-protection: '0'
+      permissions-policy: interest-cohort=()
+      x-ratelimit-limit: '300'
+      x-ratelimit-remaining: '299'
+      x-ratelimit-reset: '2022-11-15T14:05:00.375122Z'
+      cache-control: no-store
+      pragma: no-cache
+      www-authenticate: Bearer realm="Doorkeeper", error="invalid_token", error_description="The
+        access token is invalid"
+      content-security-policy: 'base-uri ''none''; default-src ''none''; frame-ancestors
+        ''none''; font-src ''self'' https://emacs.ch; img-src ''self'' https: data:
+        blob: https://emacs.ch; style-src ''self'' https://emacs.ch ''nonce-zObAiQrvdd94TojC9LPPWw=='';
+        media-src ''self'' https: data: https://emacs.ch; frame-src ''self'' https:;
+        manifest-src ''self'' https://emacs.ch; connect-src ''self'' data: blob: https://emacs.ch
+        https://emacs.ch wss://emacs.ch; script-src ''self'' https://emacs.ch ''wasm-unsafe-eval'';
+        child-src ''self'' blob: https://emacs.ch; worker-src ''self'' blob: https://emacs.ch'
+      x-request-id: a4bc1535-e0f6-44c8-bb22-b2d8a3f8033d
+      x-runtime: '0.008651'
+      strict-transport-security: max-age=63072000; includeSubDomains
+      vary: Origin
+    body:
+      encoding: ''
+      file: no
+      string: '{"error":"The access token is invalid"}'
+  recorded_at: 2022-11-15 14:02:14 GMT
+  recorded_with: vcr/1.1.0, webmockr/0.8.2

tests/testthat/test-auth_envvar.R

@@ -5,7 +5,7 @@ test_that("convert_token_to_envvar", {
   fake_token$type <- "user"
   fake_token$instance <- paste0(rep("b", 10), collapse = "")
   class(fake_token) <- "rtoot_bearer"
-  x <- convert_token_to_envvar(fake_token, message = FALSE, clipboard = FALSE)
+  x <- convert_token_to_envvar(fake_token, clipboard = FALSE, verbose = FALSE)
   expected_output <- paste0("RTOOT_DEFAULT_TOKEN=\"",
                             paste0(rep("a", 43), collapse = ""),
                             ";user;",
@@ -23,8 +23,8 @@ test_that("convert_token_to_envvar (clipboard)", {
                             paste0(rep("a", 43), collapse = ""),
                             ";user;",
                             paste0(rep("b", 10), collapse = ""), "\"")  
-  expect_message(convert_token_to_envvar(fake_token, message = TRUE, clipboard = TRUE))
-  x <- convert_token_to_envvar(fake_token, message = FALSE, clipboard = TRUE)
+  expect_message(convert_token_to_envvar(fake_token, clipboard = TRUE, verbose = TRUE))
+  x <- convert_token_to_envvar(fake_token, clipboard = TRUE, verbose = FALSE)
   clipboard_content <- clipr::read_clip()
   expect_equal(clipr::read_clip(), expected_output)
   expect_equal(x, expected_output)

tests/testthat/test-auth_process_created_token.R

@@ -0,0 +1,48 @@
+original_envvar <- Sys.getenv("RTOOT_DEFAULT_TOKEN")
+Sys.setenv(RTOOT_DEFAULT_TOKEN = "abc;user;emacs.ch")
+fake_token <- get_token_from_envvar()
+
+testing_path <- file.path(tempdir(), "rtoot_check")
+testing_name <- "testing"
+## we can't test the case when path is NULL because we might not be able to write to ~/
+
+test_that("issue 72: path is FALSE", {
+  expect_error(x <- process_created_token(token = fake_token, path = FALSE, clipboard = FALSE, verify = FALSE, verbose = FALSE), NA)
+  expect_identical(x, fake_token)
+})
+
+test_that("path is not FALSE", {
+  expect_error(x <- process_created_token(token = fake_token, path = testing_path, clipboard = FALSE, verify = FALSE, verbose = FALSE), NA)
+  expect_identical(x, fake_token)
+  expect_true(file.exists(file.path(testing_path, "rtoot_token.rds")))
+  unlink(testing_path, recursive = TRUE)
+})
+
+test_that("name is not NULL", {
+  expect_error(x <- process_created_token(token = fake_token, name = testing_name, path = testing_path, clipboard = FALSE, verify = FALSE, verbose = FALSE), NA)
+  expect_identical(x, fake_token)
+  expect_true(file.exists(file.path(testing_path, paste0(testing_name, ".rds"))))
+  unlink(testing_path, recursive = TRUE)
+})
+
+test_that("clipboard and verbose", {
+  skip_if_not(clipr::clipr_available())
+  expect_error(x <- process_created_token(token = fake_token, path = FALSE, clipboard = TRUE, verify = FALSE, verbose = FALSE), NA)
+  expect_identical(x, fake_token)
+  expect_false(dir.exists(testing_path))
+  expected_output <- paste0("RTOOT_DEFAULT_TOKEN=\"abc;user;emacs.ch\"")
+  expect_equal(clipr::read_clip(), expected_output)
+  expect_message(x <- process_created_token(token = fake_token, path = FALSE, clipboard = TRUE, verify = FALSE, verbose = TRUE))
+  expect_identical(x, fake_token)
+  expect_false(dir.exists(testing_path))
+})
+
+test_that("verify", {
+  ## This is fake token; so the API call should return error if `verify` is TRUE
+  vcr::use_cassette("process_created_token", {
+    expect_error(x <- process_created_token(token = fake_token, path = FALSE, clipboard = FALSE, verify = TRUE, verbose = FALSE))
+  })
+  expect_error(x <- process_created_token(token = fake_token, path = FALSE, clipboard = FALSE, verify = FALSE, verbose = TRUE), NA)
+})
+
+Sys.setenv(RTOOT_DEFAULT_TOKEN = original_envvar)