Merge pull request #71 from chainsawriot/envvar

fix #68

DESCRIPTION

@@ -13,6 +13,7 @@ RoxygenNote: 7.2.1
 Depends:
     R (>= 3.6)
 Imports: 
+    clipr,
     dplyr,
     httr,
     tibble

NAMESPACE

@@ -3,6 +3,7 @@
 S3method(print,rtoot_bearer)
 S3method(print,rtoot_client)
 export(auth_setup)
+export(convert_token_to_envvar)
 export(get_account)
 export(get_account_blocks)
 export(get_account_bookmarks)
@@ -34,3 +35,4 @@ export(post_toot)
 export(post_user)
 export(search_accounts)
 export(verify_credentials)
+export(verify_envvar)

R/auth.R

@@ -7,15 +7,20 @@
 #' @param name give the token a name, in case you want to store more than one.
 #' @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
 #' @details If either `name` or `path` are set to `FALSE`, the token is only
-#'   returned and not saved.
-#'
+#'   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
+#'   format. Please paste it into your environment file, e.g. ".Renviron", and restart
+#'   your R session.
 #' @return A bearer token
+#' @seealso [verify_credentials()], [convert_token_to_envvar()]
 #' @examples
+#' \dontrun{
 #' auth_setup("mastodon.social", "public")
+#' }
 #' @export
-auth_setup <- function(instance = NULL, type = NULL, name = NULL, path = NULL) {
+auth_setup <- function(instance = NULL, type = NULL, name = NULL, path = NULL, clipboard = FALSE) {
   while (is.null(instance) || instance == "") {
     instance <- readline(prompt = "On which instance do you want to authenticate (e.g., \"mastodon.social\")? ")
   }
@@ -24,10 +29,17 @@ auth_setup <- function(instance = NULL, type = NULL, name = NULL, path = NULL) {
     type <- c("public", "user")[utils::menu(c("public", "user"), title = "What type of token do you want?")]
   }
   token <- create_token(client, type = type)
-  if (!isFALSE(name) && !isFALSE(path)) token_path <- save_auth_rtoot(token, name, path)
+  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
-  check_token_rtoot(token)
+  if (clipboard) {
+    convert_token_to_envvar(token)
+    return(invisible(token))
+  } else {
+    check_token_rtoot(token)
+  }
 }
 
 ## login described at https://docs.joinmastodon.org/client/authorized/
@@ -100,11 +112,11 @@ create_token <- function(client, type = "public"){
   bearer
 }
 
-
-#' verify mastodon credentials
+#' Verify mastodon credentials
 #'
 #' @param token bearer token, either public or user level
 #' @return success or failure message of the verification process
+#' @details If you have created your token as an environment variable, use `verify_envvar` to verify your token.
 #' @examples
 #' \dontrun{
 #' #read a token from a file
@@ -139,6 +151,13 @@ verify_credentials <- function(token) {
   invisible(acc)
 }
 
+#' @export
+#' @rdname verify_credentials
+verify_envvar <- function() {
+  token <- get_token_from_envvar()
+  verify_credentials(token)
+}
+
 #' save a bearer token to file
 #'
 #' @param token bearer token created with [create_token]
@@ -171,15 +190,77 @@ get_auth_rtoot <- function(){
 
 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
+#' \dontrun{
+#' x <- auth_setup("mastodon.social", "public")
+#' envvar <- convert_token_to_envvar(x)
+#' envvar
+#' }
+#' @export
+convert_token_to_envvar <- function(token, message = TRUE, clipboard = 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.")
+      }
+    } else {
+      if (message) {
+        message("Clipboard is not available.")
+      }
+    }
+  }
+  return(invisible(envvar_string))
+}
+
+get_token_from_envvar <- function(envvar = "RTOOT_DEFAULT_TOKEN", check_stop = TRUE) {
+  dummy <- list(bearer = "")
+  dummy$type <- ""
+  dummy$instance <- ""
+  class(dummy) <- "rtoot_bearer"
+  if (Sys.getenv(envvar) == "") {
+    if (check_stop) {
+      stop("envvar not found.")
+    } else {
+      ## warn the testers
+      message("You should do software testing with the `RTOOT_DEFAULT_TOKEN` envvar!\nRead: https://github.com/schochastics/rtoot/wiki/vcr")
+      return(dummy)
+    }
+  }
+  res <- strsplit(x = Sys.getenv(envvar), split = ";")[[1]]
+  if (length(res) != 3) {
+    if (check_stop) {
+      stop("Your envvar is malformed")
+    } else {
+      return(NULL)
+    }
+  }
+  bearer <- list(bearer = res[1])
+  bearer$type <- res[2]
+  bearer$instance <- res[3]
+  class(bearer) <- "rtoot_bearer"
+  bearer
+}
+
 # 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) {
-
   selection <- NULL
-
   if(is.null(token)){
-
+    if (Sys.getenv("RTOOT_DEFAULT_TOKEN") != "") {
+      token <- get_token_from_envvar("RTOOT_DEFAULT_TOKEN", check_stop = FALSE)
+      if (!is.null(token)) {
+        return(token)
+      }
+      ## the envvar is malformed, go to the legacy RDS method.
+    }
     token_path <- options("rtoot_token")$rtoot_token
-
     if (length(token_path) == 0) {
       token_path <- utils::head(list.files(tools::R_user_dir("rtoot", "config"),
                                     full.names = TRUE,
@@ -216,6 +297,5 @@ check_token_rtoot <- function(token = NULL) {
       selection <- 2L
     }
   }
-
   invisible(token)
 }

tests/fixtures/envvar.yml

@@ -0,0 +1,57 @@
+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: 200
+      category: Success
+      reason: OK
+      message: 'Success: (200) OK'
+    headers:
+      cache-control: no-store
+      content-encoding: gzip
+      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-7MquUyr6YSyn1MSrGbaIUw=='';
+        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 ''unsafe-eval'';
+        child-src ''self'' blob: https://emacs.ch; worker-src ''self'' blob: https://emacs.ch'
+      content-type: application/json; charset=utf-8
+      date: Tue, 15 Nov 2022 09:37:12 GMT
+      etag: W/"7f9afc2bc6267d16af26b905bf2789e9"
+      permissions-policy: interest-cohort=()
+      server: Mastodon
+      strict-transport-security: max-age=63072000; includeSubDomains
+      vary:
+      - Accept-Encoding
+      - Origin
+      x-cached: MISS
+      x-content-type-options: nosniff
+      x-frame-options: DENY
+      x-ratelimit-limit: '300'
+      x-ratelimit-remaining: '299'
+      x-ratelimit-reset: '2022-11-15T09:40:00.497295Z'
+      x-request-id: ccba4244-aae0-4d53-b1f3-9d9279c40f55
+      x-runtime: '0.018026'
+      x-xss-protection: '0'
+    body:
+      encoding: ''
+      file: no
+      string: '{"id":"109337011845249544","username":"chainsawriot","acct":"chainsawriot","display_name":"chainsawriot","locked":false,"bot":false,"discoverable":false,"group":false,"created_at":"2022-11-13T00:00:00.000Z","note":"","url":"https://emacs.ch/@chainsawriot","avatar":"https://emacs.ch/system/accounts/avatars/109/337/011/845/249/544/original/00fc3aabc87d3564.jpg","avatar_static":"https://emacs.ch/system/accounts/avatars/109/337/011/845/249/544/original/00fc3aabc87d3564.jpg","header":"https://emacs.ch/headers/original/missing.png","header_static":"https://emacs.ch/headers/original/missing.png","followers_count":125,"following_count":62,"statuses_count":21,"last_status_at":"2022-11-14","noindex":true,"source":{"privacy":"public","sensitive":false,"language":"","note":"","fields":[{"name":"Stack","value":":emacs:,
+        R, stumpwm, linux, firefox","verified_at":null},{"name":"Research Interests","value":"Keine
+        Ahnung","verified_at":null},{"name":"Web","value":"https://chainsawriot.com/about/","verified_at":"2022-11-14T12:22:07.327+00:00"}],"follow_requests_count":0},"emojis":[{"shortcode":"emacs","url":"https://emacs.ch/system/custom_emojis/images/000/000/358/original/9f320443168e793f.png","static_url":"https://emacs.ch/system/custom_emojis/images/000/000/358/static/9f320443168e793f.png","visible_in_picker":true}],"fields":[{"name":"Stack","value":":emacs:,
+        R, stumpwm, linux, firefox","verified_at":null},{"name":"Research Interests","value":"Keine
+        Ahnung","verified_at":null},{"name":"Web","value":"\u003ca href=\"https://chainsawriot.com/about/\"
+        target=\"_blank\" rel=\"nofollow noopener noreferrer me\"\u003e\u003cspan
+        class=\"invisible\"\u003ehttps://\u003c/span\u003e\u003cspan class=\"\"\u003echainsawriot.com/about/\u003c/span\u003e\u003cspan
+        class=\"invisible\"\u003e\u003c/span\u003e\u003c/a\u003e","verified_at":"2022-11-14T12:22:07.327+00:00"}],"role":{"id":"-99","name":"","permissions":"65536","color":"","highlighted":false}}'
+  recorded_at: 2022-11-15 09:37:12 GMT
+  recorded_with: vcr/1.1.0, webmockr/0.8.2

tests/testthat/setup-rtoot.R

@@ -1,7 +1,7 @@
 library("vcr") # *Required* as vcr is set up on loading
 invisible(
   vcr::vcr_configure(
-         filter_sensitive_data = list("<<<MASTODON TOKEN>>>" = Sys.getenv('RTOOT_DEFAULT_TOKEN')),
+         filter_sensitive_data = list("<<<MASTODON TOKEN>>>" = get_token_from_envvar("RTOOT_DEFAULT_TOKEN", check_stop = FALSE)$bearer),
          dir = vcr::vcr_test_path("fixtures")
        ))
 vcr::check_cassette_names()