TASK-6369 - Update R client log-in to include organization parameter

.gitignore

@@ -86,7 +86,7 @@ git.properties
 *.Rcheck*
 opencga-client/src/main/R_packages
 opencga-client/src/main/opencgaR_*.tar.gz
-opencga-client/src/main/R/vignettes/opencgaR.html
+#opencga-client/src/main/R/vignettes/opencgaR.html
 opencga-client/src/main/R/vignettes/opencgaR.md
 
 /opencga-catalog/src/test/java/org/opencb/opencga/catalog/config/CatalogConfigurationTest.java

opencga-client/src/main/R/DESCRIPTION

@@ -2,8 +2,8 @@ Package: opencgaR
 Type: Package
 Title: Querying Opencga Data
 Version: ${opencgar.version}
-Author: Marta Bleda <[email protected]>
-Maintainer: Marta Bleda <martableda@gmail.com>
+Author: Zetta Genomics
+Maintainer: Zetta Genomics <support@zettagenomics.com>
 Description: R client that contains classes and methods for working with
     Opencga data.
 License: GPL-3
@@ -17,7 +17,8 @@ Imports:
     configr,
     base64enc,
     methods,
-    rlang
+    rlang,
+    lubridate
 Suggests:
     BiocStyle,
     knitr,
@@ -40,12 +41,13 @@ Collate:
     'Meta-methods.R'
     'OpencgaR-methods.R'
     'Operation-methods.R'
+    'Organization-methods.R'
     'Panel-methods.R'
     'Project-methods.R'
     'RestResponse-methods.R'
     'Sample-methods.R'
     'Study-methods.R'
     'User-methods.R'
     'Variant-methods.R'
-RoxygenNote: 7.1.2
+RoxygenNote: 7.3.2
 VignetteBuilder: knitr

opencga-client/src/main/R/NAMESPACE

@@ -23,6 +23,8 @@ export(mergeResults)
 export(opencgaHelp)
 export(opencgaLogin)
 export(opencgaLogout)
+export(opencgaR)
+export(restResponse)
 export(results)
 exportClasses(OpencgaR)
 exportClasses(RestResponse)
@@ -37,6 +39,7 @@ exportMethods(individualClient)
 exportMethods(jobClient)
 exportMethods(metaClient)
 exportMethods(operationClient)
+exportMethods(organizationClient)
 exportMethods(panelClient)
 exportMethods(projectClient)
 exportMethods(sampleClient)

opencga-client/src/main/R/R/OpencgaR-methods.R

@@ -147,22 +147,23 @@ readConfFile <- function(conf){
 #' 
 #' \dontrun{
 #' con <- initOpencgaR(host = "http://bioinfo.hpc.cam.ac.uk/opencga-prod/", version = "v2")
-#' con <- opencgaLogin(opencga = con, userid = "demouser", passwd = "demouser", showToken = TRUE)
+#' con <- opencgaLogin(opencga = con, userid = "xxx", passwd = "xxx", showToken = TRUE)
 #'
 #' # Configuration in list format
 #' conf <- list(version="v2", rest=list(host="http://bioinfo.hpc.cam.ac.uk/opencga-prod/"))
 #' con <- initOpencgaR(opencgaConfig=conf)
-#' con <- opencgaLogin(opencga = con, userid = "demouser", passwd = demouser")
+#' con <- opencgaLogin(opencga = con, userid = "xxx", passwd = xxx")
 #'
 #' # Configuration in file format ("YAML" or "JSON")
 #' conf <- "/path/to/conf/client-configuration.yml"
 #' con <- initOpencgaR(opencgaConfig=conf)
-#' con <- opencgaLogin(opencga = con, userid = "demouser", passwd = "demouser")
+#' con <- opencgaLogin(opencga = con, userid = "xxx", passwd = "xxx")
 #' }
 #' @export
 
 opencgaLogin <- function(opencga, userid=NULL, passwd=NULL, interactive=FALSE, 
-                         autoRenew=FALSE, verbose=FALSE, showToken=FALSE){
+                         autoRenew=FALSE, verbose=FALSE, showToken=FALSE, 
+                         organization=NULL){
     if (class(opencga) == "OpencgaR"){
         host <- slot(object = opencga, name = "host")
         version <- slot(object = opencga, name = "version")
@@ -183,16 +184,18 @@ opencgaLogin <- function(opencga, userid=NULL, passwd=NULL, interactive=FALSE,
       if(requireNamespace("miniUI", quietly = TRUE) & requireNamespace("shiny", quietly = TRUE)){
         user_login <- function() {
           ui <- miniUI::miniPage(
-            miniUI::gadgetTitleBar("Please enter your username and password"),
+            miniUI::gadgetTitleBar("Please enter your username, password and organization (optional):"),
             miniUI::miniContentPanel(
               shiny::textInput("username", "Username"),
-              shiny::passwordInput("password", "Password")))
+              shiny::passwordInput("password", "Password"),
+              shiny::passwordInput("organization", "Organization")))
 
           server <- function(input, output) {
             shiny::observeEvent(input$done, {
               user <- input$username
               pass <- input$password
-              res <- list(user=user, pass=pass)
+              org <- input$organization
+              res <- list(user=user, pass=pass, org=org)
               shiny::stopApp(res)
             })
             shiny::observeEvent(input$cancel, {
@@ -205,6 +208,7 @@ opencgaLogin <- function(opencga, userid=NULL, passwd=NULL, interactive=FALSE,
         cred <- user_login()
         userid <- cred$user
         passwd <- cred$pass
+        organization <- cred$org
       }else{
         print("The 'miniUI' and 'shiny' packages are required to run the 
            interactive login, please install it and try again.
@@ -215,7 +219,11 @@ opencgaLogin <- function(opencga, userid=NULL, passwd=NULL, interactive=FALSE,
     # end interactive login
 
     # Send request
-    query <- httr::POST(baseurl, body = list(user=userid, password=passwd), encode = "json")
+    body_req <- list(user=userid, password=passwd)
+    if (!is.null(organization) && organization != ""){
+        body_req <- append(x=body_req, values=list(organization=organization))
+    }
+    query <- httr::POST(baseurl, body = body_req, encode = "json")
 
     # check query status
     httr::warn_for_status(query)
@@ -235,14 +243,14 @@ opencgaLogin <- function(opencga, userid=NULL, passwd=NULL, interactive=FALSE,
     # get expiration time
     loginInfo <- unlist(strsplit(x=token, split="\\."))[2]
     loginInfojson <- jsonlite::fromJSON(rawToChar(base64enc::base64decode(what=loginInfo)))
-    loginTime <- as.character(as.POSIXct(loginInfojson$iat, origin="1970-01-01"), format="%Y%m%d%H%M%S")
-    expirationTime <- as.character(as.POSIXct(loginInfojson$exp, origin="1970-01-01"), format="%Y%m%d%H%M%S")
+    loginTime <- lubridate::as_datetime(as.POSIXct(loginInfojson$iat, origin="1970-01-01"))
+    expirationTime <- lubridate::as_datetime(as.POSIXct(loginInfojson$exp, origin="1970-01-01"))
 
     # Create session JSON
     sessionDf <- data.frame(host=opencga@host, version=opencga@version, 
                             user=opencga@user, token=opencga@token,
                             refreshToken=opencga@refreshToken,
-                            login=loginTime, expirationTime=expirationTime)
+                            login=as.character(loginTime), expirationTime=as.character(expirationTime))
     sessionJson <- jsonlite::toJSON(sessionDf)
 
     # Get system to define session directory
@@ -267,10 +275,10 @@ opencgaLogin <- function(opencga, userid=NULL, passwd=NULL, interactive=FALSE,
             sessionTable <- rbind(sessionTable, sessionDf)
             write(x = jsonlite::toJSON(sessionTable), file = sessionFile)
         }else if (length(sessionTableMatch) == 1){
-            sessionTable[sessionTableMatch, "login"] <- loginTime
+            sessionTable[sessionTableMatch, "login"] <- as.character(loginTime)
             sessionTable[sessionTableMatch, "token"] <- token
             sessionTable[sessionTableMatch, "refreshToken"] <- refreshToken
-            sessionTable[sessionTableMatch, "expirationTime"] <- expirationTime
+            sessionTable[sessionTableMatch, "expirationTime"] <- as.character(expirationTime)
             write(x = jsonlite::toJSON(sessionTable), file = sessionFile)
         }else{
             stop(paste("There is more than one connection to this host in your rsession file. Please, remove any duplicated entries in", 

opencga-client/src/main/R/R/commons.R

@@ -119,8 +119,8 @@ fetchOpenCGA <- function(object=object, category=NULL, categoryId=NULL,
             stop(paste("There is more than one connection to this host in your rsession file. Please, remove any duplicated entries in", 
                        object@sessionFile))
         }
-        timeNow <- Sys.time()
-        timeLeft <- as.numeric(difftime(as.POSIXct(expirationTime, format="%Y%m%d%H%M%S"), timeNow, units="mins"))
+        timeNow <- lubridate::as_datetime(Sys.time())
+        timeLeft <- as.numeric(difftime(expirationTime, timeNow, units="mins"))
         if (timeLeft > 0 & timeLeft <= 5){
             print("INFO: Your session will expire in less than 5 minutes.")
             urlNewToken <- paste0(host, version, "users/login")
@@ -270,11 +270,28 @@ callREST <- function(pathUrl, params, httpMethod, skip, token, as.queryParam,
     return(list(resp=resp, content=content))
 }
 
+
+# A function to print Events
+printEvents <- function (row){
+    print(paste(row$type, ":", row$name, row$message))
+}
+
+
 ## A function to parse the json data into R dataframes
 parseResponse <- function(resp, content, verbose){
     js <- jsonlite::fromJSON(content)
     if (resp$status_code == 200){
-        if (!("warning" %in% js[[1]]) || js[[1]]$warning == ""){
+        # QUERY SUCCESSFUL
+        if ("events" %in% names(js) == 0){
+            if (length(js$events)){
+                if (isTRUE(verbose)){
+                    print("Query successful!")
+                }
+            }else if (nrow(js$events) > 0){
+                print("Query successful with warnings.")
+                printEvents(js$events)
+            }
+        }else if (!("warning" %in% js[[1]]) || js[[1]]$warning == ""){
             if (isTRUE(verbose)){
                 print("Query successful!")
             }
@@ -283,15 +300,19 @@ parseResponse <- function(resp, content, verbose){
             print(paste("WARNING:", js[[1]]$warning))
         }
     }else{
+      # QUERY UNSUCCESSFUL
         print("Query unsuccessful.")
         print(paste("Category:", httr::http_status(resp)$category))
         print(paste("Reason:", httr::http_status(resp)$reason))
-        if (js[[1]]$warning != ""){
-            print(paste("WARNING:", js[[1]]$warning))
-            print()
-        }
-        if (js[[1]]$error != ""){
-            stop(paste("ERROR:", js[[1]]$error))
+        if ("events" %in% names(js)){
+            printEvents(js$events)
+        }else{
+            if (js[[1]]$warning != ""){
+                print(paste("WARNING:", js[[1]]$warning))
+            }
+            if (js[[1]]$error != ""){
+                stop(paste("ERROR:", js[[1]]$error))
+            }
         }
     }