Still allow for a remote domain call for i2b2 xml messages

R/i2b2_msg.R

@@ -28,9 +28,10 @@ base_msg <- function()
 #' @param password The password for the user
 #' @return The XML message list object
 #' @export
-add_header <- function(msg, username, password)
+add_header <- function(msg, username, password, domain = "")
 {
-  domain <- get_domain()$domain_id
+  if (domain == "")
+    domain <- get_domain()$domain_id
 
   mh <- list()
   mh$i2b2_version_compatible <- list("1.1")

R/users.R

@@ -9,12 +9,13 @@
 #' @param email The email of the new user
 #' @param password The password for the new user
 #' @param url The URL of the i2b2 cell to communicate with
+#' @param domain The domain to act on
 #' @return The XML return message as an httr::content() object
 #' @export
-add_user <- function(admin, pass, id, name, email, password, url = "http://127.0.0.1:9090/i2b2/services/PMService/getServices")
+add_user <- function(admin, pass, id, name, email, password, url = "http://127.0.0.1:9090/i2b2/services/PMService/getServices", domain = "")
 {
   base_msg() %>%
-    add_header(admin, pass) %>%
+    add_header(admin, pass, domain) %>%
     add_body("pm:set_user", user_name = id, full_name = name, email = email, password = password, is_admin = 0) %>%
   send_msg(url)
 }
@@ -29,15 +30,16 @@ add_user <- function(admin, pass, id, name, email, password, url = "http://127.0
 #' @param project The project to add the user role to
 #' @param roles A character vector of roles to add
 #' @param url The URL of the i2b2 cell to communicate with
+#' @param domain The domain to act on
 #' @return The XML return message as an httr::content() object
 #' @export
-add_user_roles <- function(admin, pass, id, project, roles, url = "http://127.0.0.1:9090/i2b2/services/PMService/getServices")
+add_user_roles <- function(admin, pass, id, project, roles, url = "http://127.0.0.1:9090/i2b2/services/PMService/getServices", domain = "")
 {
   roles %>%
     purrr::walk(function(role)
                 {
                   base_msg() %>%
-                    add_header(admin, pass) %>%
+                    add_header(admin, pass, domain) %>%
                     add_body("pm:set_role", user_name = id, role = role, project_id = project) %>%
                     send_msg(url)
                 })
@@ -65,18 +67,19 @@ add_user_roles <- function(admin, pass, id, project, roles, url = "http://127.0.
 #' @param pass The password for the user
 #' @param users The dataframe containing the users to add
 #' @param url The URL of the i2b2 cell to communicate with
+#' @param domain The domain to act on
 #' @return The XML return message as an httr::content() object
 #' @export
-add_users <- function(admin, pass, users, url = "http://127.0.0.1:9090/i2b2/services/PMService/getServices")
+add_users <- function(admin, pass, users, url = "http://127.0.0.1:9090/i2b2/services/PMService/getServices", domain = "")
 {
   apply(users, 1, function(user)
         {
-          add_user(admin, pass, user["id"], user["name"], user["email"], user["password"], url)
+          add_user(admin, pass, user["id"], user["name"], user["email"], user["password"], url, domain)
 
           if (user["role"] == "ADMIN")
           {
             roles <- c("MANAGER", "USER", "DATA_PROT", "DATA_DEID", "DATA_LDS", "DATA_AGG", "DATA_OBFSC")
-            add_user_roles(admin, pass, user["id"], "@", "ADMIN", url)
+            add_user_roles(admin, pass, user["id"], "@", "ADMIN", url, domain)
           }
           else if (user["role"] == "MANAGER")
             roles <- c("MANAGER", "USER", "DATA_DEID", "DATA_LDS", "DATA_AGG", "DATA_OBFSC")
@@ -93,7 +96,7 @@ add_users <- function(admin, pass, users, url = "http://127.0.0.1:9090/i2b2/serv
           else if (user["role"] == "DATA_OBFSC")
             roles <- c("USER", "DATA_OBFSC")
 
-          add_user_roles(admin, pass, user["id"], user["project"], roles, url)
+          add_user_roles(admin, pass, user["id"], user["project"], roles, url, domain)
         })
 }