add method to set headers for container credentials

paws.common/R/credential_providers.R

@@ -392,16 +392,14 @@ container_credentials_provider <- function() {
   expiration <- credentials_response$expiration
 
   # return credential
-  if (is.null(access_key_id) || is.null(secret_access_key) ||
-    is.null(session_token)) {
+  if (is.null(access_key_id) || is.null(secret_access_key) || is.null(session_token)) {
     log_info(
       "Unable to obtain access_key_id, secret_access_key or session_token"
     )
     return(NULL)
   }
 
-  if (access_key_id != "" && secret_access_key != "" &&
-    session_token != "") {
+  if (access_key_id != "" && secret_access_key != "" && session_token != "") {
     creds <- Creds(
       access_key_id = access_key_id,
       secret_access_key = secret_access_key,
@@ -422,10 +420,11 @@ get_container_credentials <- function(credentials_uri, credentials_full_uri) {
   } else {
     metadata_url <- credentials_full_uri
   }
-
-  metadata_request <-
-    new_http_request("GET", metadata_url, timeout = 1)
-
+  # add headers
+  headers <- set_container_credentails_headers()
+  kwargs <- list(method = "GET", url = metadata_url, timeout = 1)
+  kwargs[["header"]] <- headers
+  metadata_request <- do.call(new_http_request, kwargs)
   metadata_response <- tryCatch(
     {
       issue(metadata_request)
@@ -452,6 +451,27 @@ get_container_credentials <- function(credentials_uri, credentials_full_uri) {
   return(credentials_list)
 }
 
+# Developed from:
+# https://github.com/boto/botocore/blob/ba7da3497853ac83e9b8552f41de83cb27932fe9/botocore/credentials.py#L1945-L1955C22
+set_container_credentails_headers <- function() {
+  auth_token <- NULL
+  ENV_VAR_AUTH_TOKEN <- get_env("AWS_CONTAINER_AUTHORIZATION_TOKEN")
+  ENV_VAR_AUTH_TOKEN_FILE <- get_env("AWS_CONTAINER_AUTHORIZATION_TOKEN_FILE")
+  if (ENV_VAR_AUTH_TOKEN_FILE != "") {
+    auth_token <- readLines("token_file", encoding = "utf-8", warn = FALSE)
+  } else if (ENV_VAR_AUTH_TOKEN != "") {
+    auth_token <- ENV_VAR_AUTH_TOKEN
+  }
+  # validate auth token
+  if (!is.null(auth_token)) {
+    if (grepl("\r|\n", auth_token)) {
+      stop("Auth token value is not a legal header value")
+    }
+    names(auth_token) <- "Authorization"
+  }
+  return(auth_token)
+}
+
 get_container_credentials_eks <- function() {
   credentials_list <- get_assume_role_with_web_identity_creds(
     role_arn = get_role_arn(),