feat: Implement automated styling on .R files

apps/api/R/auth.R

@@ -7,14 +7,14 @@ library(dplyr)
 #* @return Encrypted password
 #* @author Tezan Sahu
 get_crypt_pass <- function(username, password, secretkey = NA) {
-  secretkey <- if(is.na(secretkey)) "notasecret" else secretkey
+  secretkey <- if (is.na(secretkey)) "notasecret" else secretkey
   dig <- secretkey
   salt <- username
   for (i in 1:10) {
     dig <- digest::digest(
-      paste(dig, salt, password, secretkey, sep="--"), 
-      algo="sha1", 
-      serialize=FALSE
+      paste(dig, salt, password, secretkey, sep = "--"),
+      algo = "sha1",
+      serialize = FALSE
     )
   }
   return(dig)
@@ -28,16 +28,17 @@ get_crypt_pass <- function(username, password, secretkey = NA) {
 #* @return TRUE if encrypted password is correct, else FALSE
 #* @author Tezan Sahu
 validate_crypt_pass <- function(username, crypt_pass) {
-
   res <- tbl(global_db_pool, "users") %>%
-    filter(login == username,
-           crypted_password == crypt_pass) %>%
+    filter(
+      login == username,
+      crypted_password == crypt_pass
+    ) %>%
     collect()
 
   if (nrow(res) == 1) {
     return(res$id)
   }
-  
+
   return(NA)
 }
 
@@ -49,12 +50,12 @@ validate_api_key <- function(api_key) {
   res <- tbl(global_db_pool, "users") %>%
     filter(apikey == api_key) %>%
     collect()
-  
+
   if (nrow(res) == 1) {
     return(res)
   }
-  
-  return(NA) 
+
+  return(NA)
 }
 
 #* Filter to authenticate a user calling the PEcAn API
@@ -65,54 +66,52 @@ validate_api_key <- function(api_key) {
 authenticate_user <- function(req, res) {
   # Fix CORS issues
   res$setHeader("Access-Control-Allow-Origin", "*")
-  
+
   # If the API endpoint that do not require authentication
   if (
     Sys.getenv("AUTH_REQ") == FALSE ||
-    grepl("swagger", req$PATH_INFO, ignore.case = TRUE) || 
-    grepl("openapi.json", req$PATH_INFO, fixed = TRUE) ||
-    grepl("/api/ping", req$PATH_INFO, ignore.case = TRUE) ||
-    grepl("/api/status", req$PATH_INFO, ignore.case = TRUE))
-  {
+      grepl("swagger", req$PATH_INFO, ignore.case = TRUE) ||
+      grepl("openapi.json", req$PATH_INFO, fixed = TRUE) ||
+      grepl("/api/ping", req$PATH_INFO, ignore.case = TRUE) ||
+      grepl("/api/status", req$PATH_INFO, ignore.case = TRUE)) {
     req$user$userid <- NA
     req$user$username <- ""
     return(plumber::forward())
   }
-  
+
   if (!is.null(req$HTTP_AUTHORIZATION)) {
-    # HTTP_AUTHORIZATION is of the form "Basic <base64-encoded-string>", 
+    # HTTP_AUTHORIZATION is of the form "Basic <base64-encoded-string>",
     # where the <base64-encoded-string> is contains <username>:<password>
     auth_details <- strsplit(rawToChar(jsonlite::base64_dec(strsplit(req$HTTP_AUTHORIZATION, " +")[[1]][2])), ":")[[1]]
     username <- auth_details[1]
     password <- auth_details[2]
     crypt_pass <- get_crypt_pass(username, password)
-    
+
     userid <- validate_crypt_pass(username, crypt_pass)
-    
-    if(! is.na(userid)){
+
+    if (!is.na(userid)) {
       req$user$userid <- userid
       req$user$username <- username
       return(plumber::forward())
     }
-
   }
-  
-  if(!is.null(req$HTTP_X_API_KEY)) {
+
+  if (!is.null(req$HTTP_X_API_KEY)) {
     key <- req$HTTP_X_API_KEY
     # HTTP_X_API_KEY is of the form "api_key"
     user <- validate_api_key(key)
     userid <- user$id
     username <- user$login
     print(userid)
     print(username)
-      
-    if(! is.na(userid)){
+
+    if (!is.na(userid)) {
       req$user$userid <- userid
       req$user$username <- username
       return(plumber::forward())
     }
   }
-  
+
   res$status <- 401 # Unauthorized
-  return(list(error="Authentication required"))
+  return(list(error = "Authentication required"))
 }

apps/api/R/available-models.R

@@ -29,8 +29,10 @@ availableModels <- function(machine_name = "docker", machine_id = NA) {
     dplyr::select(modeltype_id = id, modeltype = name)
 
   modelfiles %>%
-    dplyr::select(dbfile_id = id, file_name, file_path,
-                  model_id = container_id) %>%
+    dplyr::select(
+      dbfile_id = id, file_name, file_path,
+      model_id = container_id
+    ) %>%
     dplyr::inner_join(models, c("model_id" = "id")) %>%
     dplyr::inner_join(modeltypes, "modeltype_id") %>%
     dplyr::collect()

apps/api/R/entrypoint.R

@@ -1,28 +1,28 @@
 #!/usr/bin/env Rscript
 
-#* This is the entry point to the PEcAn API. 
+#* This is the entry point to the PEcAn API.
 #* All API endpoints (& filters) are mounted here
 #* @author Tezan Sahu
 
 source("auth.R")
 source("general.R")
 
 # Set up the global database pool
-#.bety_params <- PEcAn.DB::get_postgres_envvars(
+# .bety_params <- PEcAn.DB::get_postgres_envvars(
 #  host = "localhost",
 #  dbname = "bety",
 #  user = "bety",
 #  password = "bety",
 #  driver = "Postgres"
-#)
+# )
 #
-#.bety_params$driver <- NULL
-#.bety_params$drv <- RPostgres::Postgres()
-#global_db_pool <- do.call(pool::dbPool, .bety_params)
+# .bety_params$driver <- NULL
+# .bety_params$drv <- RPostgres::Postgres()
+# global_db_pool <- do.call(pool::dbPool, .bety_params)
 global_db_pool <- PEcAn.DB::betyConnect()
 
 # redirect to trailing slash
-plumber::options_plumber(trailingSlash=TRUE)
+plumber::options_plumber(trailingSlash = TRUE)
 
 # root router
 root <- plumber::Plumber$new()
@@ -31,7 +31,7 @@ root$setSerializer(plumber::serializer_unboxed_json())
 # Filter for authenticating users trying to hit the API endpoints
 root$filter("require-auth", authenticate_user)
 
-# The /api/ping & /api/status are standalone API endpoints 
+# The /api/ping & /api/status are standalone API endpoints
 # implemented using handle() because of restrictions of plumber
 # to mount multiple endpoints on the same path (or subpath)
 root$handle("GET", "/api/ping", ping)
@@ -77,4 +77,4 @@ root$setDebug(TRUE)
 
 # The API server is bound to 0.0.0.0 on port 8000
 # The Swagger UI for the API draws its source from the pecanapi-spec.yml file
-root$run(host="0.0.0.0", port=8000)
+root$run(host = "0.0.0.0", port = 8000)

apps/api/R/formats.R

@@ -5,40 +5,38 @@ library(dplyr)
 #' @return Format details
 #' @author Tezan Sahu
 #* @get /<format_id>
-getFormat <- function(format_id, res){
-
+getFormat <- function(format_id, res) {
   Format <- tbl(global_db_pool, "formats") %>%
     select(format_id = id, name, notes, header, mimetype_id) %>%
     filter(format_id == !!format_id)
-  
+
   Format <- tbl(global_db_pool, "mimetypes") %>%
     select(mimetype_id = id, mimetype = type_string) %>%
     inner_join(Format, by = "mimetype_id") %>%
     select(-mimetype_id)
-  
+
   qry_res <- Format %>% collect()
-  
+
   if (nrow(qry_res) == 0) {
     res$status <- 404
-    return(list(error="Format not found"))
-  }
-  else {
+    return(list(error = "Format not found"))
+  } else {
     # Convert the response from tibble to list
     response <- list()
-    for(colname in colnames(qry_res)){
+    for (colname in colnames(qry_res)) {
       response[colname] <- qry_res[colname]
     }
-    
+
     format_vars <- tbl(global_db_pool, "formats_variables") %>%
       select(name, unit, format_id, variable_id) %>%
       filter(format_id == !!format_id)
     format_vars <- tbl(global_db_pool, "variables") %>%
       select(variable_id = id, description, units) %>%
-      inner_join(format_vars, by="variable_id") %>%
+      inner_join(format_vars, by = "variable_id") %>%
       mutate(unit = ifelse(unit %in% "", units, unit)) %>%
       select(-variable_id, -format_id, -units) %>%
       collect()
-    
+
     response$format_variables <- format_vars
     return(response)
   }
@@ -53,28 +51,27 @@ getFormat <- function(format_id, res){
 #' @return Formats subset matching the model search string
 #' @author Tezan Sahu
 #* @get /
-searchFormats <- function(format_name="", mimetype="", ignore_case=TRUE, res){
+searchFormats <- function(format_name = "", mimetype = "", ignore_case = TRUE, res) {
   format_name <- URLdecode(format_name)
   mimetype <- URLdecode(mimetype)
-  
+
   Formats <- tbl(global_db_pool, "formats") %>%
-    select(format_id = id, format_name=name, mimetype_id) %>%
-    filter(grepl(!!format_name, format_name, ignore.case=ignore_case))
-  
+    select(format_id = id, format_name = name, mimetype_id) %>%
+    filter(grepl(!!format_name, format_name, ignore.case = ignore_case))
+
   Formats <- tbl(global_db_pool, "mimetypes") %>%
     select(mimetype_id = id, mimetype = type_string) %>%
     inner_join(Formats, by = "mimetype_id") %>%
-    filter(grepl(!!mimetype, mimetype, ignore.case=ignore_case)) %>%
+    filter(grepl(!!mimetype, mimetype, ignore.case = ignore_case)) %>%
     select(-mimetype_id) %>%
     arrange(format_id)
-  
+
   qry_res <- Formats %>% collect()
-  
+
   if (nrow(qry_res) == 0) {
     res$status <- 404
-    return(list(error="Format(s) not found"))
-  }
-  else {
-    return(list(formats=qry_res, count = nrow(qry_res)))
+    return(list(error = "Format(s) not found"))
+  } else {
+    return(list(formats = qry_res, count = nrow(qry_res)))
   }
 }

apps/api/R/general.R

@@ -2,8 +2,8 @@
 #* If successful connection to API server is established, this function will return the "pong" message
 #* @return Mapping containing response as "pong"
 #* @author Tezan Sahu
-ping <- function(req){
-  res <- list(request="ping", response="pong")
+ping <- function(req) {
+  res <- list(request = "ping", response = "pong")
   res
 }
 
@@ -12,18 +12,18 @@ ping <- function(req){
 #* @author Tezan Sahu
 status <- function() {
   ## helper function to obtain environment variables
-  get_env_var = function (item, default = "unknown") {
-    value = Sys.getenv(item)
+  get_env_var <- function(item, default = "unknown") {
+    value <- Sys.getenv(item)
     if (value == "") default else value
   }
-  
+
   res <- list(host_details = PEcAn.DB::dbHostInfo(global_db_pool))
-  res$host_details$authentication_required = get_env_var("AUTH_REQ")
-  
+  res$host_details$authentication_required <- get_env_var("AUTH_REQ")
+
   res$pecan_details <- list(
-    version = get_env_var("PECAN_VERSION"), 
-    branch = get_env_var("PECAN_GIT_BRANCH"), 
+    version = get_env_var("PECAN_VERSION"),
+    branch = get_env_var("PECAN_GIT_BRANCH"),
     gitsha1 = get_env_var("PECAN_GIT_CHECKSUM")
   )
   return(res)
-}
+}

apps/api/R/get.file.R

@@ -9,34 +9,34 @@ library(dplyr)
 #' @author Tezan Sehu
 get.file <- function(filepath, userid) {
   # Check if the file path is valid
-  if(! file.exists(filepath)){
+  if (!file.exists(filepath)) {
     return(list(status = "Error", message = "File not found"))
   }
-  
+
   # Check if the workflow for run after obtaining absolute path is owned by the user or not
   parent_dir <- normalizePath(dirname(filepath))
 
-  run_id <- substr(parent_dir, stringi::stri_locate_last(parent_dir, regex="/")[1] + 1, stringr::str_length(parent_dir))
-
-  if(Sys.getenv("AUTH_REQ") == TRUE) {
+  run_id <- substr(parent_dir, stringi::stri_locate_last(parent_dir, regex = "/")[1] + 1, stringr::str_length(parent_dir))
 
+  if (Sys.getenv("AUTH_REQ") == TRUE) {
     Run <- tbl(global_db_pool, "runs") %>%
       filter(id == !!run_id)
     Run <- tbl(global_db_pool, "ensembles") %>%
-      select(ensemble_id=id, workflow_id) %>%
-      full_join(Run, by="ensemble_id")  %>%
+      select(ensemble_id = id, workflow_id) %>%
+      full_join(Run, by = "ensemble_id") %>%
       filter(id == !!run_id)
     user_id <- tbl(global_db_pool, "workflows") %>%
-      select(workflow_id=id, user_id) %>% full_join(Run, by="workflow_id")  %>%
+      select(workflow_id = id, user_id) %>%
+      full_join(Run, by = "workflow_id") %>%
       filter(id == !!run_id) %>%
       pull(user_id)
-    
-    if(! user_id == userid) {
+
+    if (!user_id == userid) {
       return(list(status = "Error", message = "Access forbidden"))
     }
   }
-  
+
   # Read the data in binary form & return it
-  bin <- readBin(filepath,'raw', n = file.info(filepath)$size)
+  bin <- readBin(filepath, "raw", n = file.info(filepath)$size)
   return(list(file_contents = bin))
 }