API endpoints for ping, models, workflows & runs (with authentication)

CHANGELOG.md

@@ -43,6 +43,7 @@ For more information about this file see also [Keep a Changelog](http://keepacha
 
 ### Added
 
+- PEcAn API that can be used to talk to PEcAn servers. Endpoints to GET the details about the server that user is talking to, PEcAn models, workflows & runs. Authetication enabled. (#2631)
 - New versioned ED2IN template: ED2IN.2.2.0 (#2143) (replaces ED2IN.git)
 - model_info.json and Dockerfile to template (#2567)
 - Dockerize BASGRA_N model.

apps/api/Dockerfile

@@ -0,0 +1,30 @@
+# this needs to be at the top, what version are we building
+ARG IMAGE_VERSION="latest"
+
+
+# --------------------------------------------------------------------------
+# PECAN FOR MODEL BASE IMAGE
+# --------------------------------------------------------------------------
+FROM pecan/base:${IMAGE_VERSION} 
+LABEL maintainer="Tezan Sahu <tezansahu@gmail.com>"
+
+
+COPY ./ /api
+
+WORKDIR /api/R
+
+# --------------------------------------------------------------------------
+# Variables to store in docker image (most of them come from the base image)
+# --------------------------------------------------------------------------
+ENV AUTH_REQ="yes" \
+    HOST_ONLY="no" \
+    PGHOST="postgres"
+
+# COMMAND TO RUN
+RUN apt-get update
+RUN apt-get install libsodium-dev -y
+RUN   Rscript -e "devtools::install_version('promises', '1.1.0', repos = 'http://cran.rstudio.com')" \
+  &&  Rscript -e "devtools::install_version('webutils', '1.1', repos = 'http://cran.rstudio.com')" \
+  &&  Rscript -e "devtools::install_github('rstudio/swagger')" \
+  &&  Rscript -e "devtools::install_github('rstudio/plumber')"
+CMD Rscript entrypoint.R

apps/api/R/auth.R

@@ -0,0 +1,81 @@
+library(dplyr)
+
+#* Obtain the encrypted password for a user
+#* @param username Username, which is also the 'salt'
+#* @param password Unencrypted password
+#* @param secretkey Secret Key, which if null, is set to 'notasecret'
+#* @return Encrypted password
+#* @author Tezan Sahu
+get_crypt_pass <- function(username, password, secretkey = NULL) {
+  secretkey <- if(is.null(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
+    )
+  }
+  return(dig)
+}
+
+
+
+#* Check if the encrypted password for the user is valid
+#* @param username Username
+#* @param crypt_pass Encrypted password
+#* @return TRUE if encrypted password is correct, else FALSE
+#* @author Tezan Sahu
+validate_crypt_pass <- function(username, crypt_pass) {
+
+  dbcon <- PEcAn.DB::betyConnect()
+
+  res <- tbl(dbcon, "users") %>%
+    filter(login == username,
+           crypted_password == crypt_pass) %>%
+    count() %>%
+    collect()
+
+  PEcAn.DB::db.close(dbcon)
+
+  if (res == 1) {
+    return(TRUE)
+  }
+
+  return(FALSE)
+}
+
+#* Filter to authenticate a user calling the PEcAn API
+#* @param req The request
+#* @param res The response to be set
+#* @return Appropriate response
+#* @author Tezan Sahu
+authenticate_user <- function(req, res) {
+  # If the API endpoint that do not require authentication
+  if (
+    grepl("swagger", req$PATH_INFO, ignore.case = TRUE) || 
+    grepl("openapi.json", req$PATH_INFO, fixed = TRUE) ||
+    grepl("ping", req$PATH_INFO, ignore.case = TRUE) ||
+    grepl("status", req$PATH_INFO, ignore.case = TRUE))
+  {
+    return(plumber::forward())
+  }
+
+  if (!is.null(req$HTTP_AUTHORIZATION)) {
+    # 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)
+
+    if(validate_crypt_pass(username, crypt_pass)){
+      return(plumber::forward())
+    }
+
+  }
+
+  res$status <- 401 # Unauthorized
+  return(list(error="Authentication required"))
+}

apps/api/R/entrypoint.R

@@ -0,0 +1,37 @@
+#* 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")
+
+root <- plumber::plumber$new()
+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 
+# implemented using handle() because of restrictions of plumber
+# to mount multiple endpoints on the same path (or subpath)
+root$handle("GET", "/api/ping", ping)
+root$handle("GET", "/api/status", status)
+
+# The endpoints mounted here are related to details of PEcAn models
+models_pr <- plumber::plumber$new("models.R")
+root$mount("/api/models", models_pr)
+
+# The endpoints mounted here are related to details of PEcAn workflows
+workflows_pr <- plumber::plumber$new("workflows.R")
+root$mount("/api/workflows", workflows_pr)
+
+# The endpoints mounted here are related to details of PEcAn runs
+runs_pr <- plumber::plumber$new("runs.R")
+root$mount("/api/runs", runs_pr)
+
+# 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, debug=TRUE, swagger = function(pr, spec, ...) {
+  spec <- yaml::read_yaml("../pecanapi-spec.yml")
+  spec
+})

apps/api/R/general.R

@@ -0,0 +1,30 @@
+#* Function to be executed when /api/ping endpoint is called
+#* 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")
+  res
+}
+
+#* Function to get the status & basic information about the Database Host
+#* @return Details about the database host
+#* @author Tezan Sahu
+status <- function() {
+
+  ## helper function to obtain environment variables
+  get_env_var = function (item, default = "unknown") {
+    value = Sys.getenv(item)
+    if (value == "") default else value
+  }
+
+  dbcon <- PEcAn.DB::betyConnect()
+  res <- list(host_details = PEcAn.DB::dbHostInfo(dbcon))
+
+  res$pecan_details <- list(
+    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/models.R

@@ -0,0 +1,42 @@
+library(dplyr)
+
+#' Retrieve the details of a particular version of a model
+#' @param name Model name (character)
+#' @param revision Model version/revision (character)
+#' @return Model details
+#' @author Tezan Sahu
+#* @get /
+getModels <- function(model_name="all", revision="all", res){
+
+  dbcon <- PEcAn.DB::betyConnect()
+
+  Models <- tbl(dbcon, "models") %>%
+    select(model_id = id, model_name, revision, modeltype_id)
+
+  if (model_name != "all"){
+    Models <- Models %>%
+      filter(model_name == !!model_name)
+  }
+
+  if (revision != "all"){
+    Models <- Models %>%
+      filter(revision == !!revision)
+  }
+
+  Models <- tbl(dbcon, "modeltypes") %>%
+    select(modeltype_id = id, model_type = name) %>%
+    inner_join(Models, by = "modeltype_id") %>%
+    arrange(model_id)
+
+  qry_res <- Models %>% collect()
+
+  PEcAn.DB::db.close(dbcon)
+
+  if (nrow(qry_res) == 0) {
+    res$status <- 404
+    return(list(error="Model(s) not found"))
+  }
+  else {
+    return(list(models=qry_res))
+  }
+}

apps/api/R/runs.R

@@ -0,0 +1,105 @@
+#' Get the list of runs (belonging to a particuar workflow)
+#' @param workflow_id Workflow id (character)
+#' @param offset
+#' @param limit 
+#' @return List of runs (belonging to a particuar workflow)
+#' @author Tezan Sahu
+#* @get /
+getWorkflows <- function(req, workflow_id, offset=0, limit=50, res){
+  if (! limit %in% c(10, 20, 50, 100, 500)) {
+    res$status <- 400
+    return(list(error = "Invalid value for parameter"))
+  }
+
+  dbcon <- PEcAn.DB::betyConnect()
+
+  Runs <- tbl(dbcon, "runs") %>%
+    select(id, model_id, site_id, parameter_list, ensemble_id, start_time, finish_time)
+
+  Runs <- tbl(dbcon, "ensembles") %>%
+    select(runtype, ensemble_id=id, workflow_id) %>%
+    full_join(Runs, by="ensemble_id") %>%
+    filter(workflow_id == !!workflow_id)
+
+  qry_res <- Runs %>% 
+    arrange(id) %>%
+    collect()
+
+  PEcAn.DB::db.close(dbcon)
+
+  if (nrow(qry_res) == 0 || as.numeric(offset) >= nrow(qry_res)) {
+    res$status <- 404
+    return(list(error="Run(s) not found"))
+  }
+  else {
+    has_next <- FALSE
+    has_prev <- FALSE
+    if (nrow(qry_res) > (as.numeric(offset) + as.numeric(limit))) {
+      has_next <- TRUE
+    }
+    if (as.numeric(offset) != 0) {
+      has_prev <- TRUE
+    }
+    qry_res <- qry_res[(as.numeric(offset) + 1):min((as.numeric(offset) + as.numeric(limit)), nrow(qry_res)), ]
+    result <- list(runs = qry_res)
+    result$count <- nrow(qry_res)
+    if(has_next){
+      result$next_page <- paste0(
+        req$rook.url_scheme, "://",
+        req$HTTP_HOST,
+        "/api/workflows",
+        req$PATH_INFO,
+        substr(req$QUERY_STRING, 0, stringr::str_locate(req$QUERY_STRING, "offset=")[[2]]),
+        (as.numeric(limit) + as.numeric(offset)),
+        "&limit=", 
+        limit
+      )
+    }
+    if(has_prev) {
+      result$prev_page <- paste0(
+        req$rook.url_scheme, "://",
+        req$HTTP_HOST,
+        "/api/workflows",
+        req$PATH_INFO, 
+        substr(req$QUERY_STRING, 0, stringr::str_locate(req$QUERY_STRING, "offset=")[[2]]),
+        max(0, (as.numeric(offset) - as.numeric(limit))),
+        "&limit=", 
+        limit
+      )
+    }
+
+    return(result)
+  }
+}
+
+#################################################################################################
+
+#' Get the of the run specified by the id
+#' @param id Run id (character)
+#' @return Details of requested run
+#' @author Tezan Sahu
+#* @get /<id>
+getWorkflowDetails <- function(id, res){
+
+  dbcon <- PEcAn.DB::betyConnect()
+
+  Runs <- tbl(dbcon, "runs") %>%
+    select(-outdir, -outprefix, -setting)
+
+  Runs <- tbl(dbcon, "ensembles") %>%
+    select(runtype, ensemble_id=id, workflow_id) %>%
+    full_join(Runs, by="ensemble_id") %>%
+    filter(id == !!id)
+
+  qry_res <- Runs %>% collect()
+
+  PEcAn.DB::db.close(dbcon)
+
+  if (nrow(qry_res) == 0) {
+    res$status <- 404
+    return(list(error="Run with specified ID was not found"))
+  }
+  else {
+    return(qry_res)
+  }
+}