version 2.0.0

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: genesysr
-Version: 1.1.0
+Version: 2.0.0
 Title: Genesys PGR Client
 Description: Access data on plant genetic resources from genebanks around the world published on Genesys (<https://www.genesys-pgr.org>).
   Your use of data is subject to terms and conditions available at <https://www.genesys-pgr.org/content/legal/terms>.
@@ -13,14 +13,14 @@ Authors@R: c(person(family = "Global Crop Diversity Trust", role = c("cph")),
   person("Nora", "Castaneda", email = "nora.castaneda@croptrust.org", role = c("ctb")))
 Maintainer: Matija Obreza <matija.obreza@croptrust.org>
 Depends: R (>= 3.1.0)
-Imports: httr, jsonlite, dplyr, readr
+Imports: httr, jsonlite, dplyr, readr, httpuv, later
 RoxygenNote: 7.2.3
 VignetteBuilder: knitr
 Suggests: knitr, rmarkdown
 NeedsCompilation: no
-Packaged: 2023-02-15 12:56:15 UTC; mobreza
+Packaged: 2023-07-19 04:38:34 UTC; mobreza
 Author: Global Crop Diversity Trust [cph],
   Matija Obreza [aut, cre],
   Nora Castaneda [ctb]
 Repository: CRAN
-Date/Publication: 2023-02-15 13:10:02 UTC
+Date/Publication: 2023-07-19 08:30:02 UTC

MD5

@@ -1,23 +1,24 @@
-fbab0e106a16ba2868039d6afcb93145 *DESCRIPTION
-0876c05f480fe4a0547a8ac9e6be041d *NAMESPACE
-7af0addfe99726418330591c19dcd48f *NEWS.md
-7838629b383b76d079489d90764017f7 *R/api-client.R
+e09fa4b0bf1946aac64094e0d79164c7 *DESCRIPTION
+b2152deb4e0dc98ca4b03cd7cf6d0a3a *NAMESPACE
+15cc1f94734bed65c299da0f6b7994ea *NEWS.md
+534e6bdb0d141f5c34e33aef176f781c *R/api-client.R
 364c0f8798805a42dd0ecd6cf1b0b5e1 *R/filters.R
 d83f4bbffa0fc2e37fa33196bc0106b4 *R/genesys.R
 eb71556e6334bbed2c0e25f3b338836b *R/validator.R
-6e67a1eca11c3451a4112dd38a45d4ab *README.md
+d9236f0cc9ed8e1c0bc96b0d2a85de43 *README.md
 1607a8bfbf546732fe9457c00066d9b9 *build/vignette.rds
 f68a40e6c5d064381d2baadb74340315 *inst/doc/tutorial.Rmd
-1ecfe71d5c7003e0581ac80361d033f7 *inst/doc/tutorial.html
+403b927c75a9a0743831e9fb5592436a *inst/doc/tutorial.html
 6dc91108d4df58376962045ec059c7a1 *inst/doc/validation.Rmd
-57e653b64317b014163b9205e2c07fc5 *inst/doc/validation.html
+3dfd46723b8037ea7a64a5e21e342a50 *inst/doc/validation.html
 b19d70c471dca9cab0e9be7bf99e18d4 *man/api1_url.Rd
 71368433538ec6bed7d6e4383ec1c4bd *man/api2_url.Rd
 3c89e0e5581c109333bd2c32c8affd80 *man/authorization.Rd
 a8b50a6b59651d70191249bb1e7018d5 *man/check_country.Rd
 7db048bae2a7ca1df855349eb00a0af0 *man/check_landorsea.Rd
 534baf02d256d1db04eecfae44b88571 *man/check_taxonomy.Rd
 b977ae83784900d75d756d2946920d63 *man/client_login.Rd
+1611fc8e0f3c301ec032a0650a84cee8 *man/dot-LISTENER.Rd
 92adc2d83a8ef3856c7e901a9ba8d8e0 *man/dot-MAX_ALLOWED_PAGES.Rd
 3205dbf82835e36f0137bcbbb519d27e *man/dot-check_auth.Rd
 fa88763e5ad594f695917036ac179f9f *man/dot-fetch_accessions_page.Rd

NAMESPACE

@@ -27,6 +27,8 @@ export(setup)
 export(setup_production)
 export(setup_sandbox)
 export(user_login)
+importFrom(httpuv,startServer)
+importFrom(later,later)
 importFrom(readr,read_delim)
 importFrom(utils,browseURL)
 importFrom(utils,read.csv)

NEWS.md

@@ -1,3 +1,7 @@
+## version 2.0.0
+
+- Upgraded `user_login()` for OAuth 2.1
+
 ## version 1.1.0
 
 - Added list_crops(), list_species() and list_institutes()

R/api-client.R

@@ -14,6 +14,10 @@
 
 .genesysEnv <- new.env(parent = emptyenv())
 
+#' Reference to the server
+#' @keywords internal
+.LISTENER <- F
+
 #' Configure package defaults on load
 #' 
 #' @param libname Library name
@@ -88,6 +92,60 @@ authorization <- function(authorization) {
   }
 }
 
+# Start local HTTP server to receive verifier code
+#' @importFrom httpuv startServer
+#' @importFrom later later
+.start_local_http_server <- function(codeCallback) {
+  s <- httpuv::startServer("0.0.0.0", httpuv::randomPort(min=45670),
+   list(
+     call = function(req) {
+       # rlang::env_print(req)
+       match <- regexec("code=([^&]+)", req$QUERY_STRING)
+       mat <- regmatches(req$QUERY_STRING, match)
+       code <- NA
+       if (length(mat) > 0) {
+         code <- mat[[1]][2]
+       }
+       response <- list(
+         status = 200L,
+         headers = list(
+           'Content-Type' = 'text/plain'
+         ),
+         # body = paste("Thanks! Time:", Sys.time(), "Path requested:", req$QUERY_STRING, "Got code:", code)
+         body = ifelse(is.na(code), paste("Path requested:", req$QUERY_STRING), paste("Thanks! You can now return to R."))
+       )
+       if (!is.na(code)) { # We got the code!
+         later::later(function() { codeCallback(code) }, delay = 2); # This will register the code and stop the server
+       }
+       response
+     }
+   )
+  )
+  invisible(s)
+}
+
+.exchange_code_for_token <- function(verifier, redirectUri) {
+  url <- paste0(.genesysEnv$server, "/oauth/token")
+  resp <- httr::POST(url, body = list(
+    client_id = .genesysEnv$client_id, client_secret = .genesysEnv$client_secret,
+    redirect_uri = redirectUri,
+    grant_type = "authorization_code", code = verifier
+  ), encode = "form")
+
+  if (httr::http_type(resp) != "application/json" || httr::status_code(resp) != 200) {
+    stop(paste("API did not return json", httr::content(resp, "text")), call. = FALSE)
+  }
+
+  parsed <- jsonlite::fromJSON(httr::content(resp, "text"), simplifyVector = FALSE)
+
+  authorization(paste("Bearer", parsed$access_token))
+
+  invisible(structure(
+    parsed,
+    class = "genesys_auth"
+  ))
+}
+
 #' Login to Genesys as a user
 #'
 #' The authorization URL will open in a browser, ask the user to grant
@@ -99,35 +157,36 @@ authorization <- function(authorization) {
 #' @importFrom utils browseURL
 #' @export
 user_login <- function() {
+  if (typeof(.LISTENER) == "environment") {
+    httpuv::stopServer(.LISTENER)
+  }
+
+  # browser()
+  codeCallback <- function(code) {
+    message(paste("Exchanging", code, "for access token."));
+    .exchange_code_for_token(code, redirectUri);
+    if (typeof(.LISTENER) == "environment") {
+      message("Stopping listener.");
+      httpuv::stopServer(.LISTENER)
+    }
+    .LISTENER <- F
+  }
+  .LISTENER <- .start_local_http_server(codeCallback);
+  redirectUri <- paste0("http://127.0.0.1:", .LISTENER$getPort())
+  message(paste("Waiting for confirmation on", redirectUri));
   url <- paste0(.genesysEnv$server, "/oauth/authorize")
+  message(paste("Going to", url))
+
   browseURL(httr::modify_url(url, query = list(
     client_id = .genesysEnv$client_id, client_secret = .genesysEnv$client_secret,
-    redirect_uri = "oob",
+    redirect_uri = redirectUri,
     scope = "read",
     response_type= "code"
-    )))
-
-  code <- readline("Enter the authorization code: ");
-
-  url <- paste0(.genesysEnv$server, "/oauth/token")
-  resp <- httr::POST(url, body = list(
-    client_id = .genesysEnv$client_id, client_secret = .genesysEnv$client_secret,
-    redirect_uri = "oob",
-    grant_type = "authorization_code", code = code
-    ), encode = "form")
-
-  if (httr::http_type(resp) != "application/json" || httr::status_code(resp) != 200) {
-    stop(paste("API did not return json", httr::content(resp, "text")), call. = FALSE)
-  }
+  )))
 
-  parsed <- jsonlite::fromJSON(httr::content(resp, "text"), simplifyVector = FALSE)
-
-  authorization(paste("Bearer", parsed$access_token))
-
-  invisible(structure(
-    parsed,
-    class = "genesys_auth"
-  ))
+  # code <- readline("Enter the authorization code: ");
+  # .exchange_code_for_token(code, redirectUri);
+  message("Please login to Genesys in the browser window");
 }
 
 

README.md

@@ -6,7 +6,7 @@ Note: See NEWS.md
 
 ## Installing the development version
 
-```R
+``` r
 devtools::install_git('https://gitlab.croptrust.org/genesys-pgr/genesysr')
 ```
 
@@ -20,7 +20,7 @@ devtools::install_git('https://gitlab.croptrust.org/genesys-pgr/genesysr')
 
 ## Setup and configuration
 
-```R
+``` r
 library('genesysr')
 
 # www.genesys-pgr.org
@@ -38,7 +38,7 @@ genesysr::setup(server = "http://localhost:8080",
 
 The package is configured with default **Genesys R client** credentials that require user authentication:
 
-```R
+``` r
 # Setup
 genesysr::setup_production()
 
@@ -48,9 +48,9 @@ genesysr::user_login()
 
 ## Client authentication
 
-Accessing Genesys **without user interaction** requires that a client is registered on Genesys with **client credentials** grant. Contact helpdesk@genesys-pgr.org for assistance.
+Accessing Genesys **without user interaction** requires that a client is registered on Genesys with **client credentials** grant. Contact [helpdesk\@genesys-pgr.org](mailto:helpdesk@genesys-pgr.org){.email} for assistance.
 
-```R
+``` r
 # Setup
 library('genesysr')
 genesysr::setup(server = "https://api.genesys-pgr.org",
@@ -63,7 +63,7 @@ genesysr::client_login()
 
 ## Query Genesys
 
-```R
+``` r
 filters <- mcpd_filter(ORIGCTY = c("DEU", "SVN"))
 accessions <- genesysr::get_accessions(filters)
 

inst/doc/tutorial.html

@@ -12,7 +12,7 @@
 
 <meta name="author" content="Matija Obreza &amp; Nora Castaneda" />
 
-<meta name="date" content="2023-02-15" />
+<meta name="date" content="2023-07-19" />
 
 <title>genesysr Tutorial</title>
 
@@ -340,7 +340,7 @@
 
 <h1 class="title toc-ignore">genesysr Tutorial</h1>
 <h4 class="author">Matija Obreza &amp; Nora Castaneda</h4>
-<h4 class="date">2023-02-15</h4>
+<h4 class="date">2023-07-19</h4>
 
 
 

inst/doc/validation.html

@@ -12,7 +12,7 @@
 
 <meta name="author" content="Matija Obreza" />
 
-<meta name="date" content="2023-02-15" />
+<meta name="date" content="2023-07-19" />
 
 <title>Validating passport data</title>
 
@@ -239,7 +239,7 @@
 
 <h1 class="title toc-ignore">Validating passport data</h1>
 <h4 class="author">Matija Obreza</h4>
-<h4 class="date">2023-02-15</h4>
+<h4 class="date">2023-07-19</h4>