Moved access token (and base URL) to keyring for more security. Fixed…

… file upload #46.  Left response as list if unable to flatten to data.frame likely fixing #44.  Other changes to simplify code.

DESCRIPTION

@@ -14,9 +14,10 @@ Depends:
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 6.1.1
+RoxygenNote: 7.1.1
 Imports: httr,
     jsonlite,
+    keyring,
     purrr,
     stringr,
     magrittr,

NAMESPACE

@@ -39,4 +39,7 @@ export(show_wpage_front)
 export(update_discussion_id)
 export(update_wpage)
 export(upload_course_file)
+importFrom(httr,GET)
+importFrom(httr,POST)
+importFrom(httr,PUT)
 importFrom(magrittr,"%>%")

R/course-data.R

@@ -14,9 +14,9 @@
 #' #' get_course_list(include = c("teachers", "total_students"))
 get_course_list <- function(user_id = NULL, include = NULL) {
   if (!is.null(user_id)) {
-    url <- paste0(canvas_url(), paste("users", user_id, "courses", sep = "/"))
+    url <- make_canvas_url("users", user_id, "courses")
   } else {
-    url <- paste0(canvas_url(), "courses")
+    url <- make_canvas_url("courses")
   }
   args <- list(
                per_page = 100,
@@ -30,9 +30,9 @@ get_course_list <- function(user_id = NULL, include = NULL) {
 
 get_account_course_list <- function(acc_id = NULL, include = NULL) {
   if (!is.null(acc_id)) {
-    url <- paste0(canvas_url(), paste("accounts", acc_id, "courses", sep = "/"))
+    url <- make_canvas_url("accounts", acc_id, "courses")
   } else {
-    url <- paste0(canvas_url(), "courses")
+    url <- make_canvas_url("courses")
   }
   args <- list(
     per_page = 100,
@@ -78,17 +78,17 @@ get_term_course_list <- function(term_id = NULL, acc_id = NULL, include = NULL)
 #' #' get_course_analytics_data(course_id = 17, type = "student_summaries", user_id = 366)
 get_course_analytics_data <- function(course_id, type = "assignments", user_id = NULL) {
   if (!is.null(user_id)) {
-    url <- paste0(canvas_url(), paste("courses", course_id, "analytics/users", user_id, type, sep = "/"))
+    url <- make_canvas_url("courses", course_id, "analytics/users", user_id, type)
   } else {
-    url <- paste0(canvas_url(), paste("courses", course_id, "analytics", type, sep = "/"))
+    url <- make_canvas_url("courses", course_id, "analytics", type)
   }
   if (type == "communication" & is.null(user_id)) {
     stop("user_id must be specified for communication data")
   }
   args <- list(
     per_page = 100,
     user_id = user_id
-    )
+  )
   resp <- canvas_query(url, args)
   json <- httr::content(resp, "text")
   if (json == "[]") stop("Nothing available for this course.")
@@ -118,10 +118,10 @@ get_course_items <- function(course_id, item, include = NULL) {
     stop(paste("item argument must be one of:", paste(valid_items, collapse = ", ")))
   }
   if (!missing(item)) {
-    url <- paste0(canvas_url(), paste("courses", course_id, item, sep = "/"))
+    url <- make_canvas_url("courses", course_id, item)
   } else {
     #Omitting the item argument will return general information about the course
-    url <- paste0(canvas_url(), paste("courses", course_id, sep = "/"))
+    url <- make_canvas_url("courses", course_id)
   }
   args <- list(per_page = 100)
   include <- iter_args_list(include, "include[]")

R/discussions.R

@@ -17,7 +17,7 @@
 get_discussions_context <- function(object_id, object_type = "courses",
                                     include = NULL) {
   stopifnot(object_type %in% c("courses", "groups"))
-  url <- paste0(canvas_url(), paste(object_type, object_id, "discussion_topics", sep = "/"))
+  url <- make_canvas_url(object_type, object_id, "discussion_topics")
   args <- list(per_page = 100)
   include <- iter_args_list(include, "include[]")
   args <- c(args, include)
@@ -38,8 +38,7 @@ get_discussions_context <- function(object_id, object_type = "courses",
 #' get_discussion_id(4371405, 1350207)
 get_discussion_id <- function(discussion_id, object_id, object_type = "courses") {
   stopifnot(object_type %in% c("courses", "groups"))
-  url <- paste0(canvas_url(),
-                paste(object_type, object_id, "discussion_topics", discussion_id, sep = "/"))
+  url <- make_canvas_url(object_type, object_id, "discussion_topics", discussion_id)
   args <- list(per_page = 100)
   include <- iter_args_list(NULL, "include[]")
   args <- c(args, include)
@@ -61,8 +60,7 @@ get_discussion_id <- function(discussion_id, object_id, object_type = "courses")
 update_discussion_id <- function(discussion_id, object_id, message,
                                  object_type = "courses") {
   stopifnot(object_type %in% c("courses", "groups"))
-  url <- paste0(canvas_url(),
-                paste(object_type, object_id, "discussion_topics", discussion_id, sep = "/"))
+  url <- make_canvas_url(object_type, object_id, "discussion_topics", discussion_id)
   args <- list(access_token = check_token(),
                message = message,
                per_page = 100)

R/process_response.R

@@ -1,33 +1,33 @@
 #' Process a Canvas API response
 #'
-#' Wrapper function for common tasks in going from Canvas url to dataframe. Most
+#' Wrapper function for common tasks in going from Canvas URL to data.frame. Most
 #' of the heavy lifting is done in \code{paginate}, which finds which pages to
 #' download. This function adds necessary arguments to those pages (e.g. the
-#' authentication token), downloads the content, converts from JSON into data
-#' frame format, and if there are multiple pages/dataframes, converts it into
-#' one final dataframe.
+#' authentication token), downloads the content, converts from JSON into
+#' data.frame format, and if there are multiple pages/data.frames, converts it
+#' into one final data.frame if able.
 #'
 #' @param url url to query
 #' @param args query arguments to be passed to \code{httr}, e.g. auth token
 #'
-#' @return processed dataframe
-#'
+#' @return processed dataframe or list if unable to simplify
+#' @importFrom magrittr `%>%`
 process_response <- function(url, args) {
+
   resp <- canvas_query(url, args, "GET")
-  df <- paginate(resp) %>%
+
+  paginate(resp) %>%
     purrr::map(httr::content, "text") %>%
-    purrr::map(jsonlite::fromJSON, flatten = TRUE)
-  df <- tryCatch({
-    df %>% purrr::map_df(purrr::flatten_df)
-  },
-  error = function(e) {
-    df %>% dplyr::bind_rows()
-  }
-  )
-  return(df)
+    purrr::map(jsonlite::fromJSON, flatten = TRUE) ->
+    d
+
+  # flatten to data.frame if able, otherwise return as is
+  d <- tryCatch(purrr::map_df(d, purrr::flatten_df),
+                error = function(e) d)
+  d
 }
 
-#' @title Get responses from Canvas API pages
+#' Get responses from Canvas API pages
 #'
 #' @description The Canvas headers include a link object (usually), in form:
 #' \code{Link:

R/uploads.R

@@ -24,8 +24,7 @@
 upload_course_file <- function(course_id, file_name, parent_folder_id = NULL, parent_folder_path = "/", on_duplicate = "overwrite") {
   if (!is.null(parent_folder_id) && !is.null(parent_folder_path)) stop("Do not specify both parent folder id and parent folder path.")
   file_size <- file.info(file_name)$size
-  url <- paste0(canvas_url(),
-                paste("courses", course_id, "files", sep = "/"))
+  url <- make_canvas_url("courses", course_id, "files")
   args <- sc(list(name = file_name,
                   size = file_size,
                   parent_folder_id = parent_folder_id,
@@ -37,9 +36,9 @@ upload_course_file <- function(course_id, file_name, parent_folder_id = NULL, pa
   upload_params <- upload_content$upload_params
   upload_params[[length(upload_params) + 1]] <- httr::upload_file(file_name)
   names(upload_params)[[length(upload_params)]] <- "file"
+  message(sprintf("File %s uploaded", file_name))
   invisible(httr::POST(url = upload_url,
              body = upload_params))
-  message(sprintf("File %s uploaded", file_name))
 }
 
 #' Create a course folder

R/user-data.R

@@ -1,6 +1,4 @@
-#' @importFrom magrittr %>%
-#'
-#' @title Get various user items
+#' Get various user items
 #'
 #' @param user_id A valid canvas user id
 #' @param item One of "missing_submissions", "details", "profile", "page_views", "colors", or "avatars"
@@ -15,9 +13,9 @@ get_user_items <- function(user_id, item) {
   if (item == "page_views") warning("Not all page views will be returned.")
 
   if (item == "details") {
-    url <- paste(canvas_url(), "users", user_id, sep = "/")
+    url <- make_canvas_url("users", user_id)
   } else {
-    url <- paste(canvas_url(), "users", user_id, item, sep = "/")
+    url <- make_canvas_url("users", user_id, item)
   }
 
   args <- list(access_token = check_token(),

R/utils.R

@@ -1,6 +1,6 @@
 #' Canvas API helpers
 #'
-#' These functinos set your Canvas API token, as well as the Canvas base URL.
+#' These functions set your Canvas API token, as well as the Canvas base URL.
 #' These functions are necessary for `rcanvas` to run.
 #'
 #' @name apihelpers
@@ -12,7 +12,7 @@
 #' @examples
 #' set_canvas_token("abc123")
 set_canvas_token <- function(token) {
-  Sys.setenv(CANVAS_API_TOKEN = token)
+  keyring::key_set_with_value("rcanvas_CANVAS_API_TOKEN", NULL, token)
 }
 
 #' @param domain Canvas domain
@@ -21,37 +21,41 @@ set_canvas_token <- function(token) {
 #' @examples
 #' set_canvas_domain("https://canvas.upenn.edu")
 set_canvas_domain <- function(domain) {
-  Sys.setenv(CANVAS_DOMAIN = domain)
+  keyring::key_set_with_value("rcanvas_CANVAS_DOMAIN", NULL, domain)
 }
 
 #' @rdname apihelpers
 check_token <- function() {
-  token <- Sys.getenv("CANVAS_API_TOKEN")
+  token <- keyring::key_get("rcanvas_CANVAS_API_TOKEN")
   if (identical(token, "")) {
-    stop("Please set env var CANVAS_API_TOKEN to your access token.",
+    stop("Please set your Canvas API token with set_canvas_token.",
          call. = FALSE)
   }
   token
 }
 
-canvas_url <- function() paste0(Sys.getenv("CANVAS_DOMAIN"), "/api/v1/")
+canvas_url <- function() paste0(keyring::key_get("rcanvas_CANVAS_DOMAIN"), "/api/v1")
 
+make_canvas_url <- function(...) paste(canvas_url(), ..., sep = "/")
+
+#' @importFrom httr GET POST PUT
 canvas_query <- function(urlx, args = NULL, type = "GET") {
-  fun <- getFromNamespace(type, "httr")
+
   args <- sc(args)
-  if (type %in% c("POST", "PUT")) {
-    resp <- fun(urlx,
-                httr::user_agent("rcanvas - https://github.com/daranzolin/rcanvas"),
-                httr::add_headers(Authorization = paste("Bearer", check_token())),
-                body = args)
-  } else {
-    resp <- fun(urlx,
-                httr::user_agent("rcanvas - https://github.com/daranzolin/rcanvas"),
-                httr::add_headers(Authorization = paste("Bearer", check_token())),
-                query = args)
-  }
+  resp_fun_args <- list(url = urlx,
+                        httr::user_agent("rcanvas - https://github.com/daranzolin/rcanvas"),
+                        httr::add_headers(Authorization = paste("Bearer", check_token())))
+
+  if (type %in% c("POST", "PUT"))
+    resp_fun_args$body = args
+  else
+    resp_fun_args$query = args
+
+  resp <- do.call(type, resp_fun_args)
+
   httr::stop_for_status(resp)
-  return(resp)
+  resp
+
 }
 
 iter_args_list <- function(x, label) {
@@ -64,15 +68,15 @@ iter_args_list <- function(x, label) {
 }
 
 sc <- function(x) {
-  Filter(Negate(is.null), x)
+  purrr::discard(x, is.null)
 }
 
 convert_dates <- function(base_date = Sys.Date(), days) {
   new_date <- base_date + lubridate::ddays(days)
   format(new_date, "%Y-%m-%d")
 }
 
-#' Exectute a query on the remove API
+#' Execute a query on the remove API
 #'
 #' This function allows you to call methods which are not specifically exposed by this API yet
 #'