Merge pull request #62 from MRCIEU/50-jwt-authentication

50 jwt authentication

.github/workflows/R-CMD-check.yaml

@@ -55,6 +55,11 @@ jobs:
         with:
           extra-packages: any::rcmdcheck
           needs: check
+
+      - name: Create and populate .Renviron file
+        run: |
+          echo OPENGWAS_X_TEST_MODE_KEY="$OPENGWAS_X_TEST_MODE_KEY" >> ~/.Renviron
+        shell: bash
 
       - uses: r-lib/actions/check-r-package@v2
         with:

DESCRIPTION

@@ -21,7 +21,6 @@ Depends:
     R (>= 4.0)
 Imports:
     dplyr,
-    googleAuthR,
     httr,
     jsonlite,
     magrittr,

NAMESPACE

@@ -11,10 +11,9 @@ export(api_status)
 export(associations)
 export(batch_from_id)
 export(batches)
-export(check_access_token)
 export(editcheck)
 export(fill_n)
-export(get_access_token)
+export(get_opengwas_jwt)
 export(get_query_content)
 export(gwasinfo)
 export(infer_ancestry)
@@ -26,9 +25,9 @@ export(ld_reflookup)
 export(legacy_ids)
 export(logging_info)
 export(phewas)
-export(revoke_access_token)
 export(select_api)
 export(tophits)
+export(user)
 export(variants_chrpos)
 export(variants_gene)
 export(variants_rsid)

NEWS.md

@@ -1,4 +1,6 @@
-# ieugwasr 0.2.3
+# ieugwasr 1.0.0
+* Introducing JWT authorisation for the API
+* Added user() function to get user information
 * Fixing issue with anonymous functions and backwards compatibility
 * Bug in tophits when result is empty
 * Removing version check at startup

R/api.R

@@ -12,7 +12,7 @@ select_api <- function(where="public", silent=FALSE)
 		public = "https://api.opengwas.io/api/",
 		private = "http://ieu-db-interface.epi.bris.ac.uk:8082/",
 		dev1 = "http://localhost:8019/",
-		dev2 = "http://127.0.0.1:5000/"
+		dev2 = "http://127.0.0.1:5000/",
 	)
 	if(is.null(url))
 	{
@@ -26,60 +26,26 @@ select_api <- function(where="public", silent=FALSE)
 	}
 }
 
-
-#' Get access token for OAuth2 access to MR Base
-#'
-#'
-#' @export
-#' @return access token string
-get_access_token <- function()
-{
-	message("Using access token. For info on how this is used see logging_info()")
-	tf <- basename(tempfile())
-	check <- suppressWarnings(file.create(tf))
-	if(!check)
-	{
-		stop("You are currently in a directory which doesn't have write access.\n",
-			"  In order to authenticate we need to store the credentials in a file called '.httr-oauth'.\n",
-			"  Please setwd() to a different directory where you have write access.")
-	} else {
-		unlink(tf)
-	}
-	a <- googleAuthR::gar_auth(email=TRUE)
-	if(! a$validate())
-	{
-		a$refresh()
-	}
-	return(a$credentials$access_token)
-}
-
-
-#' Check if authentication has been made
-#'
-#' If a call to [`get_access_token()`] has been made then it will have generated `mrbase.oauth`. 
-#' Pass the token if it is present, if not, return `NULL` and do not authenticate.
-#'
+#' Retrieve OpenGWAS JSON Web Token from .Renviron file
+#' 
 #' @export
-#' @return NULL or access_token depending on current authentication state
-check_access_token <- function()
-{
-	if(file.exists("ieugwasr_oauth"))
-	{
-		return(get_access_token())
-	} else {
-		return(NULL)
+#' @return JWT string
+get_opengwas_jwt <- function() {
+	key <- Sys.getenv("OPENGWAS_JWT")
+	if(key == "") {
+		message("OPENGWAS_JWT=<token> needs to be set in your .Renviron file. You can obtain a token from https://api.opengwas.io")
 	}
+	return(key)
 }
 
-
-#' Revoke access token for MR Base
-#'
+#' Get user details
+#' 
+#' @param opengwas_jwt Used to authenticate protected endpoints. Login to https://api.opengwas.io to obtain a jwt. Provide the jwt string here, or store in .Renviron under the keyname OPENGWAS_JWT.
+#' 
 #' @export
-#' @return No return value, called for side effects
-revoke_access_token <- function()
-{
-	a <- googleAuthR::gar_auth("mrbase.oauth")
-	a$revoke()
+#' @return user information
+user <- function(opengwas_jwt=get_opengwas_jwt()) {
+	api_query('user', opengwas_jwt=opengwas_jwt) %>% get_query_content()
 }
 
 

R/ld_clump.R

@@ -27,7 +27,7 @@
 #' Options are `"EUR"`, `"SAS"`, `"EAS"`, `"AFR"`, `"AMR"`. 
 #' `'legacy'` also available - which is a previously used verison of the EUR 
 #' panel with a slightly different set of markers
-#' @param access_token Google OAuth2 access token. Used to authenticate level of access to data
+#' @param opengwas_jwt Used to authenticate protected endpoints. Login to https://api.opengwas.io to obtain a jwt. Provide the jwt string here, or store in .Renviron under the keyname OPENGWAS_JWT.#' 
 #' @param bfile If this is provided then will use the API. Default = `NULL`
 #' @param plink_bin If `NULL` and `bfile` is not `NULL` then will detect 
 #' packaged plink binary for specific OS. Otherwise specify path to plink binary. 
@@ -36,7 +36,7 @@
 #' @export
 #' @return Data frame
 ld_clump <- function(dat=NULL, clump_kb=10000, clump_r2=0.001, clump_p=0.99, 
-                     pop = "EUR", access_token=NULL, bfile=NULL, plink_bin=NULL)
+                     pop = "EUR", opengwas_jwt=get_opengwas_jwt(), bfile=NULL, plink_bin=NULL)
 {
 
 	stopifnot("rsid" %in% names(dat))
@@ -64,11 +64,6 @@ ld_clump <- function(dat=NULL, clump_kb=10000, clump_r2=0.001, clump_p=0.99,
 		dat$id <- random_string(1)
 	}
 
-	if(is.null(bfile))
-	{
-		access_token = check_access_token()
-	}
-
 	ids <- unique(dat[["id"]])
 	res <- list()
 	for(i in 1:length(ids))
@@ -82,7 +77,7 @@ ld_clump <- function(dat=NULL, clump_kb=10000, clump_r2=0.001, clump_p=0.99,
 			message("Clumping ", ids[i], ", ", nrow(x), " variants, using ", pop, " population reference")
 			if(is.null(bfile))
 			{
-				res[[i]] <- ld_clump_api(x, clump_kb=clump_kb, clump_r2=clump_r2, clump_p=clump_p, pop=pop, access_token=access_token)
+				res[[i]] <- ld_clump_api(x, clump_kb=clump_kb, clump_r2=clump_r2, clump_p=clump_p, pop=pop, opengwas_jwt=opengwas_jwt)
 			} else {
 				res[[i]] <- ld_clump_local(x, clump_kb=clump_kb, clump_r2=clump_r2, clump_p=clump_p, bfile=bfile, plink_bin=plink_bin)
 			}
@@ -102,9 +97,9 @@ ld_clump <- function(dat=NULL, clump_kb=10000, clump_r2=0.001, clump_p=0.99,
 #' @param clump_p Clumping sig level for index variants. Default = `1` (i.e. no threshold)
 #' @param pop Super-population to use as reference panel. Default = `"EUR"`. 
 #' Options are `"EUR"`, `"SAS"`, `"EAS"`, `"AFR"`, `"AMR"`
-#' @param access_token Google OAuth2 access token. Used to authenticate level of access to data
+#' @param opengwas_jwt Used to authenticate protected endpoints. Login to https://api.opengwas.io to obtain a jwt. Provide the jwt string here, or store in .Renviron under the keyname OPENGWAS_JWT.#' @param bfile If this is provided then will use the API. Default = `NULL`
 #' @return Data frame of only independent variants
-ld_clump_api <- function(dat, clump_kb=10000, clump_r2=0.1, clump_p, pop="EUR", access_token=check_access_token())
+ld_clump_api <- function(dat, clump_kb=10000, clump_r2=0.1, clump_p, pop="EUR", opengwas_jwt=get_opengwas_jwt())
 {
 	res <- api_query('ld/clump',
 			query = list(
@@ -115,7 +110,7 @@ ld_clump_api <- function(dat, clump_kb=10000, clump_r2=0.1, clump_p, pop="EUR",
 				kb = clump_kb,
 				pop = pop
 			),
-			access_token=access_token
+			opengwas_jwt=opengwas_jwt
 		) %>% get_query_content()
 	y <- subset(dat, !dat[["rsid"]] %in% res)
 	if(nrow(y) > 0)
@@ -191,16 +186,18 @@ random_string <- function(n=1, len=6)
 #' @param rsid Array of rsids to check
 #' @param pop Super-population to use as reference panel. Default = `"EUR"`. 
 #' Options are `"EUR"`, `"SAS"`, `"EAS"`, `"AFR"`, `"AMR"`
+#' @param opengwas_jwt Used to authenticate protected endpoints. Login to https://api.opengwas.io to obtain a jwt. Provide the jwt string here, or store in .Renviron under the keyname OPENGWAS_JWT.#' @param bfile If this is provided then will use the API. Default = `NULL`
 #'
 #' @export
 #' @return Array of rsids that are present in the LD reference panel
-ld_reflookup <- function(rsid, pop='EUR')
+ld_reflookup <- function(rsid, pop='EUR', opengwas_jwt=get_opengwas_jwt())
 {
 	res <- api_query('ld/reflookup',
 			query = list(
 				rsid = rsid,
 				pop = pop
-			)
+			),
+			opengwas_jwt=opengwas_jwt
 		) %>% get_query_content()
 	if(length(res) == 0)
 	{

R/ld_matrix.R

@@ -26,14 +26,14 @@
 #' Options are `"EUR"`, `"SAS"`, `"EAS"`, `"AFR"`, `"AMR"`. 
 #' `'legacy'` also available - which is a previously used verison of the EUR 
 #' panel with a slightly different set of markers
+#' @param opengwas_jwt Used to authenticate protected endpoints. Login to https://api.opengwas.io to obtain a jwt. Provide the jwt string here, or store in .Renviron under the keyname OPENGWAS_JWT.#' @param bfile If this is provided then will use the API. Default = `NULL`
 #' @param bfile If this is provided then will use the API. Default = `NULL`
 #' @param plink_bin If `NULL` and bfile is not `NULL` then will detect packaged 
 #' plink binary for specific OS. Otherwise specify path to plink binary. Default = `NULL`
 #'
 #' @export
 #' @return Matrix of LD r values
-ld_matrix <- function(variants, with_alleles=TRUE, pop="EUR", bfile=NULL, plink_bin=NULL)
-{
+ld_matrix <- function(variants, with_alleles=TRUE, pop="EUR", opengwas_jwt=get_opengwas_jwt(), bfile=NULL, plink_bin=NULL) {
 	if(length(variants) > 500 & is.null(bfile))
 	{
 		stop("SNP list must be smaller than 500. Try running locally by providing local ld reference with bfile argument. See vignettes for a guide on how to do this.")
@@ -50,7 +50,7 @@ ld_matrix <- function(variants, with_alleles=TRUE, pop="EUR", bfile=NULL, plink_
 		return(ld_matrix_local(variants, bfile=bfile, plink_bin=plink_bin, with_alleles=with_alleles))
 	}
 
-	res <- api_query('ld/matrix', query = list(rsid=variants, pop=pop), access_token=NULL) %>% get_query_content()
+	res <- api_query('ld/matrix', query = list(rsid=variants, pop=pop), opengwas_jwt=opengwas_jwt) %>% get_query_content()
 
 	if(all(is.na(res))) stop("None of the requested variants were found")
 	variants2 <- res$snplist
@@ -89,8 +89,7 @@ ld_matrix <- function(variants, with_alleles=TRUE, pop="EUR", bfile=NULL, plink_
 #'
 #' @export
 #' @return data frame
-ld_matrix_local <- function(variants, bfile, plink_bin, with_alleles=TRUE)
-{
+ld_matrix_local <- function(variants, bfile, plink_bin, with_alleles=TRUE) {
 	# Make textfile
 	shell <- ifelse(Sys.info()['sysname'] == "Windows", "cmd", "sh")
 	fn <- tempfile()