Merge pull request #846 from DyfanJones/sso_cred

Enrich SSO error message

paws.common/NEWS.md

@@ -1,5 +1,8 @@
 # paws.common 0.7.7.9000
 * migrate backend from httr to httr2
+* enrich sso message (#844). Thanks to @hadley for raising issue.
+* attempt to automatically set/refresh `sso` credentials by calling `aws cli` (#844)
+* moved api log level to `debug` and `trace`. This is to prevent `info` level being saturated by api calls.
 
 # paws.common 0.7.7
 * fix unix time expiration check

paws.common/R/credential_providers.R

@@ -136,7 +136,8 @@ config_file_provider <- function(profile = "") {
       sso_start_url,
       sso_account_id,
       sso_region,
-      sso_role_name
+      sso_role_name,
+      profile_name
     )
     if (!is.null(creds)) {
       return(creds)
@@ -232,14 +233,22 @@ config_file_credential_source <- function(role_arn, role_session_name, mfa_seria
   return(role_creds)
 }
 
+aws_sso_cmd <- function(profile_name, msg) {
+  cmd <- sprintf("aws sso login --profile %s", profile_name)
+  log_warn(msg, cmd)
+  system(cmd, intern = TRUE)
+}
+
 # Get credentials from profile associated with an SSO login.  Assumes
 # the user has already logged in via e.g. the aws cli so that a cached
 # access token is available.
 sso_credential_process <- function(sso_session,
                                    sso_start_url,
                                    sso_account_id,
                                    sso_region,
-                                   sso_role_name) {
+                                   sso_role_name,
+                                   profile_name,
+                                   retry_no = 0) {
   input_str <- sso_session %||% sso_start_url
   cache_key <- digest::digest(enc2utf8(input_str), algo = "sha1", serialize = FALSE)
   json_file <- paste0(cache_key, ".json")
@@ -249,9 +258,17 @@ sso_credential_process <- function(sso_session,
   )
   sso_cache <- file.path(root, ".aws", "sso", "cache", json_file)
   if (!file.exists(sso_cache)) {
-    stopf(
-      "Error loading SSO Token: Token for %s does not exist",
-      input_str
+    msg <- "Error loading SSO Token: Token for %s does not exist"
+    if (!isTRUE(getOption("paws.aws_sso_creds"))) {
+      log_info(
+        "Set `options(paws.aws_sso_creds = TRUE)` to turn on sso credentials automation"
+      )
+      stopf(msg, input_str)
+    }
+    log_error(msg, input_str)
+    aws_sso_cmd(
+      sub("profile ", "", profile_name, fixed = TRUE),
+      "Attempting to set credentials using: `%s`"
     )
   }
   cache_creds <- jsonlite::fromJSON(sso_cache)
@@ -274,7 +291,40 @@ sso_credential_process <- function(sso_session,
       disable_rest_protocol_uri_cleaning = TRUE
     )
   )
-  resp <- svc$get_role_credentials(sso_role_name, sso_account_id, cache_creds$accessToken)
+  retry_resp <- NULL
+  tryCatch(
+    resp <- svc$get_role_credentials(sso_role_name, sso_account_id, cache_creds$accessToken),
+    http_401 = function(err) {
+      if (grepl("Session token not found or invalid", err$error_response$message)) {
+        profile <- sub("profile ", "", profile_name, fixed = TRUE)
+        if (retry_no == 1 || (!isTRUE(getOption("paws.aws_sso_creds")))) {
+          enrich_msg <- sprintf(
+            "Try refreshing sso credentials: `aws sso login --profile %s`", profile
+          )
+          err$message <- paste(err$message, enrich_msg, sep = "\n")
+          log_info(
+            "Set `options(paws.aws_sso_creds = TRUE)` to turn on sso credentials automation"
+          )
+          stop(err)
+        }
+        log_error(err$error_response$message)
+        aws_sso_cmd(profile, "Attempting to refresh credentials using: `%s`")
+        retry_resp <<- sso_credential_process(
+          sso_session,
+          sso_start_url,
+          sso_account_id,
+          sso_region,
+          sso_role_name,
+          profile_name,
+          1
+        )
+      }
+    }
+  )
+  if (!is.null(retry_resp)) {
+    return(retry_resp)
+  }
+
   if (is.null(resp)) {
     return(NULL)
   }

paws.common/R/logging.R

@@ -3,7 +3,7 @@
 
 # basic paws logging system
 # Error messages only shown
-# Levels: 4 = DEBUG, 3 = INFO/MSG, 2 = WARNING, 1 = ERROR
+# Levels: 5 = TRACE, 4 = DEBUG, 3 = INFO/MSG, 2 = WARNING, 1 = ERROR
 
 #' @importFrom utils modifyList flush.console
 
@@ -17,6 +17,7 @@
 #' * `paws.log_timestamp_fmt` (character): see [format.POSIXct()]
 #'
 #' @param level (integer) to determine the level logging threshold.
+#' * `5L`: TRACE
 #' * `4L`: DEBUG
 #' * `3L`: INFO
 #' * `2L`: WARNING
@@ -69,6 +70,12 @@ parse_msg <- function(...) {
   if (length(list(...)) == 1) paste(...) else sprintf(...)
 }
 
+log_trace <- function(...) {
+  if (isTRUE(getOption("paws.log_level") >= 5L)) {
+    log_msg("TRACE", parse_msg(...))
+  }
+}
+
 log_debug <- function(...) {
   if (isTRUE(getOption("paws.log_level") >= 4L)) {
     log_msg("DEBUG", parse_msg(...))
@@ -106,6 +113,7 @@ log_msg <- function(lvl, msg) {
 
 log_color <- function(lvl) {
   color <- switch(lvl,
+    TRACE = style_trace,
     DEBUG = style_debug,
     INFO = style_info,
     WARN = style_warn,
@@ -119,24 +127,24 @@ log_color <- function(lvl) {
 # https://github.com/r-lib/httr2/blob/8e9f8588e66378f1f419158cd1810a82a4dad022/R/req-options.R#L167-L187
 paws_debug <- function(type, msg) {
   switch(type + 1,
-         text = prefix_debug("*  ", msg),
-         headerIn = prefix_info("<- ", msg),
-         headerOut = prefix_info("-> ", msg)
+         text = prefix_trace("*  ", msg),
+         headerIn = prefix_debug("<- ", msg),
+         headerOut = prefix_debug("-> ", msg)
   )
 }
 
-prefix_info <- function(prefix, x) {
+prefix_debug <- function(prefix, x) {
   x <- readBin(x, character())
   lines <- unlist(strsplit(x, "\r?\n", useBytes = TRUE))
   out <- paste0(prefix, lines, collapse = "\n")
-  log_info(out)
+  log_debug(out)
 }
 
-prefix_debug <- function(prefix, x) {
+prefix_trace <- function(prefix, x) {
   x <- readBin(x, character())
   lines <- unlist(strsplit(x, "\r?\n", useBytes = TRUE))
   out <- paste0(prefix, lines, collapse = "\n")
-  log_debug(out)
+  log_trace(out)
 }
 
 init_log_config <- function() {
@@ -173,16 +181,19 @@ init_log_styles <- function() {
     style_warn <- crayon::make_style("#EEBB50", colors = 256)
     style_info <- function(...) paste(...)
     style_debug <- crayon::make_style("#808080", grey = TRUE)
+    style_trace <- style_debug
   } else {
     style_error <- function(...) paste(...)
     style_warn <- style_error
     style_info <- style_error
     style_debug <- style_error
+    style_trace <- style_error
   }
 
   # make color functions available inside the package
   assign("style_error", style_error, envir = parent.env(environment()))
   assign("style_warn", style_warn, envir = parent.env(environment()))
   assign("style_info", style_info, envir = parent.env(environment()))
   assign("style_debug", style_debug, envir = parent.env(environment()))
+  assign("style_trace", style_trace, envir = parent.env(environment()))
 }

paws.common/R/net.R

@@ -1,4 +1,4 @@
-#' @importFrom httr2 request req_body_raw req_options req_perform
+#' @importFrom httr2 request req_options req_perform
 
 #' @include struct.R
 #' @include url.R
@@ -137,7 +137,7 @@ request_aws <- function(url, http_request) {
   req$method <- http_request$method
   req$headers <- http_request$header
   req$policies$error_is_error <- function(resp) FALSE
-  req <- req_body_raw(req, http_request$body)
+  req$body <- list(data = http_request$body, type = "raw", content_type = "", params = list())
   req <- req_options(
     .req = req,
     timeout_ms = http_request$timeout * 1000,

paws.common/R/onLoad.R

@@ -2,6 +2,7 @@
 #' @include logging.R
 
 .onLoad <- function(libname, pkgname) {
+  set_paws_options()
   init_log_config()
   init_log_styles()
   set_user_agent(pkgname)

paws.common/R/paginate.R

@@ -305,7 +305,7 @@ get_tokens <- function(resp, token, caller_env) {
     jmes_path <- caller_env[["jmes_path_token"]][[tkn]] %||% jmespath_index(tkn, caller_env)
     tokens[[tkn]] <- tryCatch(
       {
-        eval(parse(text = jmes_path, keep.source = FALSE), envir = environment())
+        eval(str2expression(jmes_path), envir = environment())
       },
       error = function(err) {
         # Return default character(0) for empty lists

paws.common/R/stream.R

@@ -79,7 +79,7 @@ stream_decode_chunk <- function(message, template) {
   for (element in template) {
     name <- element$name
     length <- element$length
-    if (is.character(length)) length <- eval(parse(text = length), envir = result)
+    if (is.character(length)) length <- eval(str2expression(length), envir = result)
     stop <- start + length - 1
     data <- message[start:stop]
     data <- switch(element$type,

paws.common/R/util.R

@@ -251,3 +251,19 @@ set_user_agent <- function(pkgname) {
   )
   assign("PAWS_USER_AGENT", user_agent, envir = getNamespace(pkgname))
 }
+
+set_paws_options <- function() {
+  paws_options <- list(
+    paws.aws_sso_creds = FALSE
+  )
+  paws_options_names <- names(paws_options)
+
+  # check R options for log settings
+  r_options <- lapply(paws_options_names, getOption)
+  names(r_options) <- paws_options_names
+  paws_options <- modifyList(
+    paws_options, Filter(Negate(is.null), r_options)
+  )
+
+  do.call(options, paws_options)
+}

paws.common/tests/testthat/test_config.R

@@ -306,7 +306,7 @@ test_that("get sso legacy credentials", {
   config_file_provider("legacy_sso")
 
   expect_equal(mock_arg(mock_sso_credential_process), list(
-    NULL, "https://my-sso-portal.awsapps.com/start", "123456789011", "us-east-1", "readOnly"
+    NULL, "https://my-sso-portal.awsapps.com/start", "123456789011", "us-east-1", "readOnly", "profile legacy_sso"
   ))
 })
 
@@ -318,7 +318,7 @@ test_that("get sso credentials", {
   config_file_provider("sso")
 
   expect_equal(mock_arg(mock_sso_credential_process), list(
-    "my-sso", "https://my-sso-portal.awsapps.com/start", "123456789011", "us-east-1", "readOnly"
+    "my-sso", "https://my-sso-portal.awsapps.com/start", "123456789011", "us-east-1", "readOnly", "profile sso"
   ))
 })
 

paws.common/tests/testthat/test_logging.R

@@ -60,12 +60,12 @@ test_request <- function(url) {
 
 test_that("check if http paws log are being tracked", {
   temp_file <- tempfile()
-  options("paws.log_level" = 3L)
+  options("paws.log_level" = 4L)
   options("paws.log_file" = temp_file)
 
   resp <- test_request("http://google.com/")
   actual <- readLines(temp_file)
-  expect_true(any(grepl("INFO", actual)))
+  expect_true(any(grepl("DEBUG", actual)))
   unlink(temp_file)
 })