Add helper functions for OAUTH2 authentication (#109) (#111)

* Add helper functions for OAUTH2 authentication  (#109)

* Add token to d2Session object

* Add OAUTH login function

* Update NAMESPACE

* Documentation and cleanup

* Update rocker verse R version

* Fix R6 import

* Add lintr to suggests

* Update DESCRIPTION

* Bump version to 0.6.0

.circleci/config.yml

@@ -3,7 +3,7 @@ description: Datapackr Test Suite
 jobs:
   build:
     docker:
-      - image: rocker/verse:3.6.3
+      - image: rocker/verse:4.1.1
     steps:
       - checkout
       - restore_cache:

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: datimutils
 Type: Package
 Title: Utilities for interacting with the DATIM api from R
-Version: 0.5.3
-Date: 2022-09-08
+Version: 0.6.0
+Date: 2022-09-19
 Authors@R: 
     c(
     person("Scott", "Jackson", email = "[email protected]",
@@ -21,14 +21,15 @@ Authors@R:
 Description: General utilities for interacting with the DATIM api from R.
 URL: https://github.com/pepfar-datim/datimutils
 BugReports: https://github.com/pepfar-datim/datimutils
-Depends: R (>= 3.6.0)
+Depends: R (>= 4.1.1)
 Imports:
     tidyr (>= 0.8.3),
     jsonlite (>= 1.6),
     stringi (>= 1.7.6),
     httr (>= 1.4.0),
     keyring,
-    rlang
+    rlang,
+    R6 (>= 2.5.1)
 Suggests:
     devtools (>= 2.0.1),
     dplyr (>= 0.8.3),
@@ -38,9 +39,10 @@ Suggests:
     knitr,
     rmarkdown,
     assertthat,
-    testthat (>= 2.1.0)
+    testthat (>= 2.1.0),
+    lintr(>= 3.0.0)
 License: GPL-3 + file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.2.0
+RoxygenNote: 7.2.1
 VignetteBuilder: knitr

NAMESPACE

@@ -58,6 +58,8 @@ export(getUserGroups)
 export(listMechs)
 export(listSqlViews)
 export(loginToDATIM)
+export(loginToDATIMOAuth)
 export(make_dim)
 export(make_fil)
 export(metadataFilter)
+import(R6)

NEWS.md

@@ -1,8 +1,14 @@
-# datimutils 0.5.3
+# datimutils 0.6.0
+
+## New features
+* Adds `loginToDATIMOAuth` function to assist with OAUTH2.0 authentication. 
+
+# datimutils 0.5.4
 
 ## Bug fixes
 * Fixes error conditions in getDataValueSets.
 
+
 # datimutils 0.5.2
 
 ## Bug fixes

R/loginToDATIM.R

@@ -1,3 +1,5 @@
+#' @import R6
+#'
 d2Session <- R6::R6Class("d2Session",
                          #' @title d2Session
                          public = list(
@@ -17,24 +19,30 @@ d2Session <- R6::R6Class("d2Session",
                            handle = NULL,
                            #' @field me dhis2 api/me response
                            me  = NULL,
+                           #' @field max_cache_age Maximum time responses should be cached
                            max_cache_age  = NULL,
+                           #' @field token An httr OAUTH2 token
+                           token = NULL,
                            #' @description
                            #' Create a new DHISLogin object
                            #' @param config_path Configuration file path
                            #' @param base_url URL to the server.
                            #' @param handle httr handle to be used for dhis2
                            #' connections
                            #' @param me DHIS2 me response object
+                           #' @param token OAUTH2 token
                            initialize = function(config_path = NA_character_,
                                                  base_url,
                                                  handle,
-                                                 me) {
+                                                 me,
+                                                 token) {
                              self$config_path <- config_path
                              self$me <- me
                              self$user_orgunit <- me$organisationUnits$id
                              self$base_url <- base_url
                              self$username <- me$userCredentials$username
                              self$handle <- handle
+                             self$token <- token
                              }
                        )
 )
@@ -203,7 +211,8 @@ loginToDATIM <- function(config_path = NULL,
            d2Session$new(config_path = config_path,
                          base_url = base_url,
                          handle = handle,
-                         me = me),
+                         me = me,
+                         token = NULL),
            envir = d2_session_envir)
   } else if (r$status == 302L) {
     stop("Unable to authenticate due to DATIM currently undergoing maintenance.
@@ -221,3 +230,80 @@ loginToDATIM <- function(config_path = NULL,
     stop("An unknowon error has occured during authentication!")
   }
 }
+
+
+
+#' @title       datimutils::loginToDATIMOAuth(base_url =  Sys.getenv("BASE_URL"),
+#' token = token,
+#' app = oauth_app,
+#' api = oauth_api,
+#' redirect_uri= APP_URL,
+#' scope = oauth_scope,
+#' d2_session_envir = parent.env(environment()))
+#'
+#' @param base_url URL of the DHIS2 server
+#' @param token An OAUTH2.0 token object. Will be created if not supplied.
+#' @param redirect_uri The redirect URI which should be used after
+#' successful authentication with the server.
+#' @param app An httr OAUTH app object.
+#' @param api An hjttr OAUTH endpoint.
+#' @param scope A character vector of scopes which should be requested.
+#' @param d2_session_name the variable name for the d2Session object.
+#' The default name is d2_default_session and will be used by other datimutils
+#' functions by default when connecting to datim. Generally a custom name
+#' should only be needed if you need to log into two seperate DHIS2 instances
+#' at the same time. If you create a d2Session object with a custom name then
+#' this object must be passed to other datimutils functions explicitly
+#' @param d2_session_envir the environment in which to place the R6 login
+#' object, default is the immediate calling environment
+#'
+#' @export
+#'
+
+loginToDATIMOAuth <- function(
+    base_url = NULL,
+    token = NULL,
+    redirect_uri = NULL,
+    app = NULL,
+    api = NULL,
+    scope = NULL,
+    d2_session_name = "d2_default_session",
+    d2_session_envir = parent.frame()) {
+
+  if (is.null(token)) {
+    token <- httr::oauth2.0_token(
+      app = app,
+      endpoint = api,
+      scope = scope,
+      use_basic_auth = TRUE,
+      oob_value = redirect_uri,
+      cache = FALSE
+    )
+  } else {
+    token <- token #For Shiny
+  }
+
+  # form url
+  url <- utils::URLencode(URL = paste0(base_url, "api", "/me"))
+  handle <- httr::handle(base_url)
+  #Get Request
+  r <- httr::GET(
+    url,
+    httr::config(token = token),
+    httr::timeout(60),
+    handle = handle
+  )
+
+  if (r$status_code != 200L) {
+    stop("Could not authenticate you with the server!")
+  } else {
+    me <- jsonlite::fromJSON(httr::content(r, as = "text"))
+    # create the session object in the calling environment of the login function
+    assign(d2_session_name,
+           d2Session$new(base_url = base_url,
+                         handle = handle,
+                         me = me,
+                         token = token),
+           envir = d2_session_envir)
+  }
+}