Merge pull request #82 from pepfar-datim/RC-0.2.0

Rc 0.2.0

.gitignore

@@ -26,6 +26,7 @@ Icon
 .Trashes
 .VolumeIcon.icns
 .com.apple.timemachine.donotpresent
+.Rprofile
 
 # Directories potentially created on remote AFP share
 .AppleDB

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: datimutils
 Type: Package
 Title: Utilities for interacting with the DATIM api from R
-Version: 0.1.3
-Date: 2022-02-04
+Version: 0.2.0
+Date: 2022-03-08
 Authors@R: 
     c(
     person("Scott", "Jackson", email = "sjackson@baosystems.com",
@@ -46,5 +46,5 @@ Suggests:
 License: GPL-3 + file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.1
+RoxygenNote: 7.1.2
 VignetteBuilder: knitr

NAMESPACE

@@ -41,14 +41,19 @@ export(getIndicatorGroupSets)
 export(getIndicatorGroups)
 export(getIndicators)
 export(getMetadata)
+export(getMyStreams)
+export(getMyUserType)
 export(getOptionGroupSets)
 export(getOptionGroups)
 export(getOptionSets)
 export(getOptions)
 export(getOrgUnitGroupSets)
 export(getOrgUnitGroups)
 export(getOrgUnits)
+export(getUserGroups)
+export(listMechs)
 export(loginToDATIM)
 export(make_dim)
 export(make_fil)
 export(metadataFilter)
+importFrom(magrittr,"%>%")

NEWS.md

@@ -0,0 +1,8 @@
+# datimutils 0.2.0
+
+## Features
+
+* add `getUserGroups`
+* add `listMechs`
+* add `getMyStreams`
+* add `getMyUserType`

R/getMetadataEndpoint.R

@@ -352,6 +352,20 @@ getDataSets <- function(values,
   )
 }
 
+#' @export
+#' @rdname dot-getMetadataEndpoint
+getUserGroups <- function(values,
+                        by = "id",
+                        fields = NULL,
+                        d2_session = dynGet("d2_default_session", inherits = TRUE), retry = 1) {
+  .getMetadataEndpoint("userGroups",
+                       values = values,
+                       by = as.character(rlang::ensym(by)),
+                       fields = fields,
+                       d2_session = d2_session, retry = retry
+  )
+}
+
 #' @export
 #' @rdname dot-getMetadataEndpoint
 getIndicatorGroupSets <- function(values,

R/getMyStreams.R

@@ -0,0 +1,28 @@
+#' @export
+#' @title getMyStreams(d2_session = dynGet("d2_default_session", inherits = TRUE))
+#' @description Returns datim user streams. For an implementation
+#' example see: https://github.com/flopez-bao/shinyapps-datimutils-security-example-usgandpartners
+#' @param d2_session the d2Session object, default is "d2_default_session",
+
+
+getMyStreams <-
+  function(d2_session = dynGet("d2_default_session", inherits = TRUE)) {
+    # pull all user groups streams
+    tryCatch(
+      expr = {
+        user_groups <- getUserGroups(values = d2_session$me$userGroups$id,
+                                     d2_session = d2_session)
+      },
+      error = function(e) {
+        stop("There was an error retrieving the user group information! Make sure you are logged into DATIM.")
+      }
+    )
+
+    # select from user_groups everything that is a data stream and needed for classification
+    user_groups <- user_groups[grepl("Data (.+?) access", user_groups)]
+
+    # remove Data Access strings
+    streams <- sort(gsub("Data | access", "", user_groups))
+
+    return(streams)
+  }

R/getMyUserType.R

@@ -0,0 +1,46 @@
+#' @export
+#' @title getMyUserType(d2_session = dynGet("d2_default_session", inherits = TRUE))
+#' @description Returns a classified user type based on accessible data streams. For an implementation
+#' example see: https://github.com/flopez-bao/shinyapps-datimutils-security-example-usgandpartners
+#' @param d2_session the d2Session object, default is "d2_default_session"
+
+getMyUserType <- function(d2_session = dynGet("d2_default_session",inherits = TRUE)) {
+
+  #pull streams and classify
+  tryCatch(
+    expr = {
+      user_groups <- getUserGroups(
+        values = d2_session$me$userGroups$id,
+        d2_session = d2_session
+      )
+    },
+    error = function(e){ 
+      stop("There was an error retrieving the user group information! Make sure you are logged into DATIM.")
+    }
+  )
+
+  # select from user_groups everything that is a data stream and needed for classification
+  streams <- user_groups[grepl("Data (.+?) access|^Global|^OU",user_groups)]
+
+    # classify user
+    if( length( regmatches(streams ,regexpr("OU (.+?) MOH users", streams)) )  > 0 ) {
+      return("MOH")
+    } else if ( length(regmatches(streams ,regexpr("Global users", streams)) ) > 0 ) {
+      return("Global")
+    } else if ( length( regmatches(streams, regexpr("OU (.+?) Partner (.+?) users - (.+?)",streams)) ) > 0 ) {
+      return("Partner")
+    } else if ( length( regmatches(streams, regexpr("OU (.+?) Agency (.+?) users",streams)) ) > 0 ) {
+      return("Agency")
+    } else if ( length( regmatches(streams, regexpr("OU (.+?) Interagency users",streams)) ) > 0 ) {
+      return("Interagency")
+    } else if ( length( regmatches(streams, regexpr("Global Agency (.+?) users",streams)) ) > 0 ) {
+      return("Global Agency")
+    } else if ( length( regmatches(streams, regexpr("Global Partner (.+?) users - (.+?)",streams)) ) > 0 ) {
+      return("Global Partner")
+    } else {
+      return("Unclassified User")
+    }
+}
+
+
+

R/listMechs.R

@@ -0,0 +1,45 @@
+#' @export
+#' @title listMechs(option_fields = c("name", "id", "code"),
+#' combo_fields = "id", 
+#' d2_session = dynGet("d2_default_session",inherits = TRUE)
+#' @description Returns a dataframe with all mechanisms a user has access to. For an implementation
+#' example see: https://github.com/flopez-bao/shinyapps-datimutils-security-example-usgandpartners 
+#' @param option_fields fields passed to the getMetaData endpoint.
+#' @param combo_fields fields passed to getCatOptionCombos call.
+#' @param d2_session the d2Session object, default is "d2_default_session"
+#' @importFrom magrittr "%>%"
+
+listMechs <- function(option_fields = c("name", "id", "code"),
+                        combo_fields = "id", 
+                        d2_session = dynGet("d2_default_session",
+                                            inherits = TRUE)) {
+
+
+  if (isFALSE(setequal(option_fields, c("name", "id", "code")))) {
+    stop("other fields are currently not supported.")
+  } else if (combo_fields != "id") {
+    stop("other fields are currently not supported.")
+  } else {
+
+    df <- getMetadata(categoryOptions, 
+                      categories.id %.in% "SH885jaRe0o",
+                      fields = option_fields,
+                      d2_session = d2_session
+                      ) %>% 
+      dplyr::mutate(option_id = id,
+                    combo_id = datimutils::getCatOptionCombos(code, 
+                                                              by = code,
+                                                              fields = combo_fields,
+                                                              d2_session = d2_session
+                                                              )) %>% 
+      dplyr::select(-id,
+                    mech_code = code,
+                    name,
+                    option_id,
+                    combo_id
+                    )
+
+    return(df)
+  }
+
+}

tests/testthat/helper.R

@@ -9,3 +9,7 @@ play2335 <- list(base_url = "https://play.dhis2.org/2.33.5/",
                 handle = httr::handle("https://play.dhis2.org/2.33.5/"))
 play2341 <- list(base_url = "https://play.dhis2.org/2.34.1/",
                 handle = httr::handle("https://play.dhis2.org/2.34.1/"))
+play2372 <- list(base_url = "https://play.dhis2.org/2.37.2/",
+                 handle = httr::handle("https://play.dhis2.org/2.37.2/"))
+test <- list(base_url = "https://test.datim.org/",
+                 handle = httr::handle("https://test.datim.org/"))

tests/testthat/play.dhis2.org/2.37.2/api/userGroups.json-3eb0bf.json

@@ -0,0 +1,8 @@
+{
+    "userGroups": [
+      {
+        "name": "Family Health Partner",
+        "id": "ZrsVF7IJ93y"
+      }
+    ]
+}

tests/testthat/test-getMetadataEndpoint.r

@@ -541,6 +541,13 @@ data <- getOrgUnits("Afro Arab Clinic",
         d2_session = play235)
       testthat::expect_identical(data,"ART monthly summary")
       rm(data)
+
+      data <- getUserGroups(
+        "ZrsVF7IJ93y",
+        d2_session = play2372
+        )
+      testthat::expect_identical(data,"Family Health Partner")
+      rm(data)
 
       data <- getIndicatorGroupSets(
         "tOwnTs7TL3Y",