casting billingID as character, bigint_as_char in fromJSON, standardi…

…zing parameter order, unlisting list columns, adding some parameter checks, returning getDatabaseBillingAcccount as tibble, adding indentationLevel to section fields, starting to replace snapshot tests and make them behave well.

DESCRIPTION

@@ -34,7 +34,7 @@ Imports:
     tidyselect (>= 1.2.0),
     magrittr
 Encoding: UTF-8
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Roxygen: list(markdown = TRUE)
 Suggests:
     ggplot2,

R/auth.R

@@ -34,7 +34,7 @@ activityInfoRootUrl <- local({
   function(newUrl) {
     if (!missing(newUrl)) {
       url <<- newUrl
-      activityInfoAuthentication()
+      activityInfoAuthentication(NULL)
       invisible()
     } else {
       url
@@ -55,17 +55,15 @@ activityInfoAuthentication <- local({
   function(newValue) {
     if (!missing(newValue)) {
       credentials <<- newValue
+      if (!is.null(credentials)&&credentialType(credentials) == "basic") deprecationOfBasicAuthWarning()
     } else {
-      if (file.exists(credentialsFile)) {
-
+      if (is.null(credentials)&&file.exists(credentialsFile)) {
         authObj = readRDS(file = credentialsFile) %>% filter(server == activityInfoRootUrl())
 
         if (nrow(authObj) == 1) {
           credentials <<- authObj %>% pull(credentials)
           if (credentialType(credentials) == "basic") deprecationOfBasicAuthWarning()
-        } else if (nrow(authObj)==0) {
-          credentials <<- NULL
-        } else {
+        } else if (nrow(authObj) > 1) {
           warning(sprintf("...file exists, but has more than one key. Try saving the key again.\n", path.expand(path = credentialsFile)))
         }
       }

R/billingInfo.R

@@ -1,14 +1,18 @@
 #' @title getBillingAccount
 #' @description Get billing account information
-#' @param asDataFrame Output as data.frame, Default: TRUE
 #' @param billingId Billing ID
+#' @param asDataFrame Output as data.frame, Default: TRUE
 #' @return Billing account information in list or data.frame output
 #' @rdname getBillingAccount
 #' @export 
 #' @importFrom tibble as_tibble
 
-getBillingAccount <- function(asDataFrame = TRUE, billingId) {
+getBillingAccount <- function(billingId, asDataFrame = TRUE) {
+  if(missing(billingId)) stop("A billingId must be provided")
+  stopifnot("A single billingId must be provided" = (length(billingId)==1))
+
   billingInfo <- getResource(paste0("/billingAccounts/", billingId), task = "Getting billing account info")
+  billingInfo$id <- as.character(billingInfo$id)
   if (asDataFrame == TRUE) {
     billingInfo <- tibble::as_tibble(billingInfo)
     return(billingInfo)
@@ -20,22 +24,33 @@ getBillingAccount <- function(asDataFrame = TRUE, billingId) {
 
 #' @title getBillingAccountDatabases
 #' @description Data for all databases under billing account
-#' @param asDataFrame Output as data.frame, Default: TRUE
 #' @param billingId Billing ID
+#' @param asDataFrame Output as data.frame, Default: TRUE
 #' @return Information on databases under billing account in list or data.frame output
 #' @rdname getBillingAccountDatabases
 #' @export 
 #' @importFrom tibble tibble
 
-getBillingAccountDatabases <- function(asDataFrame = TRUE, billingId) {
+getBillingAccountDatabases <- function(billingId, asDataFrame = TRUE) {
+  if(missing(billingId)) stop("A billingId must be provided")
+  stopifnot("A single billingId must be provided" = (length(billingId)==1))
+
   billingDatabases <- getResource(paste0("/billingAccounts/", billingId, "/databases"), 
                                   task = "Getting billing account databases")
+
+  billingDatabases <- lapply(billingDatabases, function(x) {
+    x$billingAccountId <- as.character(x$billingAccountId)
+    x
+  })
+
   if (asDataFrame == TRUE) {
     billingDatabases <- tibble::tibble(
       databaseId = unlist(lapply(billingDatabases, function(x) {x$databaseId})),
       label = unlist(lapply(billingDatabases, function(x) {x$label})),
       description = unlist(lapply(billingDatabases, function(x) { if(nzchar(x$description)) x$description else NA_character_ })),
-      owner = lapply(billingDatabases, function(x) {x$owner}),
+      ownerId = unlist(lapply(billingDatabases, function(x) {x$owner[["id"]]})),
+      ownerName = unlist(lapply(billingDatabases, function(x) {x$owner[["name"]]})),
+      ownerEmail = unlist(lapply(billingDatabases, function(x) {x$owner[["email"]]})),
       formCount = unlist(lapply(billingDatabases, function(x) {x$formCount})),
       userCount = unlist(lapply(billingDatabases, function(x) {x$userCount})),
       basicUserCount = unlist(lapply(billingDatabases, function(x) {x$basicUserCount})),
@@ -60,21 +75,27 @@ getBillingAccountDatabases <- function(asDataFrame = TRUE, billingId) {
 #' @export 
 
 getBillingAccountDomains <- function(billingId) {
+  if(missing(billingId)) stop("A billingId must be provided")
+  stopifnot("A single billingId must be provided" = (length(billingId)==1))
+
   billingDomains <- getResource(paste0("/billingAccounts/", billingId, "/domains"), task = "Getting billing account domains")
   return(billingDomains)
 }
 
 
 #' @title getBillingAccountUsers
 #' @description Billing account users
-#' @param asDataFrame Output as data.frame, Default: TRUE
 #' @param billingId Billing ID
+#' @param asDataFrame Output as data.frame, Default: TRUE
 #' @return Billing account user(s) in list or data.frame output
 #' @rdname getBillingAccountUsers
 #' @export 
 #' @importFrom tibble tibble
 
-getBillingAccountUsers <- function(asDataFrame = TRUE, billingId) {
+getBillingAccountUsers <- function(billingId, asDataFrame = TRUE) {
+  if(missing(billingId)) stop("A billingId must be provided")
+  stopifnot("A single billingId must be provided" = (length(billingId)==1))
+
   billingUsers <- getResource(paste0("/billingAccounts/", billingId, "/users"), task = "Getting billing account users")
   if (asDataFrame == TRUE) {
     billingUsers <- tibble::tibble(
@@ -95,29 +116,41 @@ getBillingAccountUsers <- function(asDataFrame = TRUE, billingId) {
 
 #' @title getDatabaseBillingAccount
 #' @description Get database owner for a given database. This gives the owning organization rather than the user who created the database.
-#' @param asDataFrame Data.frame output, Default: TRUE
 #' @param databaseId Database ID
+#' @param asDataFrame Data.frame output, Default: TRUE
 #' @return Database owner in list output
 #' @rdname getDatabaseBillingAccount
 #' @export 
 
-getDatabaseBillingAccount <- function(asDataFrame = TRUE, databaseId) {
+getDatabaseBillingAccount <- function(databaseId, asDataFrame = TRUE) {
+  if(missing(databaseId)) stop("A databaseId must be provided")
+  stopifnot("A single databaseId must be provided" = (length(databaseId)==1))
+
   databaseOwner <- getResource(paste0("/databases/", databaseId, "/billingAccount"), task = "Getting database owner")
+  databaseOwner$id <- as.character(databaseOwner$id)
+
+  if (asDataFrame) {
+    databaseOwner <- as_tibble(databaseOwner)
+  }
   return(databaseOwner)
 }
 
 
 #' @title getBillingAccountDatabaseUsers
 #' @description Get data for users from a specific database. Can be more useful than `getDatabaseUsers()` as you also retrieve the database owner's info as well.
-#' @param asDataFrame Data.frame output, Default: TRUE
 #' @param billingId Billing ID
+#' @param asDataFrame Data.frame output, Default: TRUE
 #' @param databaseId Database ID
 #' @return User information from the specified database in list or data.frame output
 #' @rdname getBillingAccountDatabaseUsers
 #' @export 
 #' @importFrom tibble tibble
 
-getBillingAccountDatabaseUsers <- function(asDataFrame = TRUE, billingId, databaseId) {
+getBillingAccountDatabaseUsers <- function(billingId, databaseId, asDataFrame = TRUE) {
+  if(missing(billingId)||missing(databaseId)) stop("A billingId and a databaseId must be provided")
+  stopifnot("A single billingId must be provided" = (length(billingId)==1))
+  stopifnot("A single databaseId must be provided" = (length(databaseId)==1))
+
   databaseUsers <- getResource(paste0("billingAccounts/", billingId, "/users?databaseId=", databaseId), task = "Getting database data")
   if (asDataFrame == TRUE) {
     databaseUsers <- tibble::tibble(

R/databases.R

@@ -14,8 +14,8 @@ getDatabases <- function(asDataFrame = TRUE) {
       databaseId = unlist(lapply(databases, function(x) {x$databaseId})),
       label = unlist(lapply(databases, function(x) {x$label})),
       description = unlist(lapply(databases, function(x) { if(nzchar(x$description)) x$description else NA_character_ })),
-      ownerId = unlist(lapply(databases, function(x) {x$ownerId})),
-      billingAccountId = unlist(lapply(databases, function(x) {x$billingAccountId})),
+      ownerId = as.character(unlist(lapply(databases, function(x) {x$ownerId}))),
+      billingAccountId = as.character(unlist(lapply(databases, function(x) {x$billingAccountId}))),
       suspended = unlist(lapply(databases, function(x) {x$suspended}))
     )
     return(dbDF)

R/formField.R

@@ -710,12 +710,17 @@ userFieldSchema <- function(label, description = NULL, databaseId, code = NULL,
 #' @inheritParams formFieldSchema
 #' @family field schemas
 #' @export
-sectionFieldSchema <- function(label, description = NULL) {
+sectionFieldSchema <- function(label, description = NULL, indentationLevel = 1L) {
   schema <- do.call(
     formFieldSchema, 
     args = c(
       list(type = "section"),
-      as.list(environment())
+      formFieldArgs(as.list(environment())),
+      list(
+        typeParameters = list(
+          "indentationLevel" = indentationLevel
+        )
+      )
     )
   )
 

R/rest.R

@@ -202,7 +202,7 @@ fromActivityInfoJson <- function(x) {
       return(invisible())
     }
   }
-  fromJSON(txt = x, simplifyDataFrame = FALSE, simplifyMatrix = FALSE)
+  fromJSON(txt = x, simplifyDataFrame = FALSE, simplifyMatrix = FALSE, bigint_as_char = TRUE)
 }
 
 #' 

tests/testthat/_snaps/databases.md

@@ -78,31 +78,25 @@
       1 c10000004 Person form c10000002 FORM     PRIVATE   
       2 c10000005 Children    c10000004 SUB_FORM PRIVATE   
 
-# addDatabaseUser() and deleteDatabaseUser() and getDatabaseUsers() and getDatabaseUser() and getDatabaseUser2() work
+# addDatabaseUser() and deleteDatabaseUser() and getDatabaseUsers() and getDatabaseUser() and getDatabaseUser2() work and expected fields are present
 
-    list(list(added = TRUE, user = list(activationStatus = "PENDING", 
+    list(list(activationStatus = "PENDING", databaseId = "<id value>", 
+        deliveryStatus = "UNKNOWN", email = "<id value>", inviteTime = "<date or time value>", 
+        lastLoginTime = "<date or time value>", name = "Test database user", 
+        userId = "<id value>", version = 1L), list(activationStatus = "PENDING", 
         databaseId = "<id value>", deliveryStatus = "UNKNOWN", email = "<id value>", 
-        grants = list(), inviteTime = "<date or time value>", lastLoginTime = "<date or time value>", 
-        name = "Test database user", role = list(id = "<id value>", 
-            parameters = list(), resources = "Empty resources until we can ensure a sort order in the API."), 
-        userId = "<id value>", version = 1)), list(added = TRUE, 
-        user = list(activationStatus = "PENDING", databaseId = "<id value>", 
-            deliveryStatus = "UNKNOWN", email = "<id value>", grants = list(), 
-            inviteTime = "<date or time value>", lastLoginTime = "<date or time value>", 
-            name = "Test database user", role = list(id = "<id value>", 
-                parameters = list(), resources = "Empty resources until we can ensure a sort order in the API."), 
-            userId = "<id value>", version = 1)))
+        inviteTime = "<date or time value>", lastLoginTime = "<date or time value>", 
+        name = "Test database user", userId = "<id value>", version = 1L))
 
 ---
 
-    list(list(databaseId = "<id value>", deliveryStatus = "UNKNOWN", 
-        email = "<id value>", inviteAccepted = FALSE, inviteDate = "<date or time value>", 
-        name = "Test database user", role = list(id = "<id value>", 
-            parameters = list(), resources = "Empty resources until we can ensure a sort order in the API."), 
-        userId = "<id value>", userLicenseType = "BASIC", version = 1L), 
-        list(databaseId = "<id value>", deliveryStatus = "UNKNOWN", 
-            email = "<id value>", inviteAccepted = FALSE, inviteDate = "<date or time value>", 
-            name = "Test database user", role = list(id = "<id value>", 
-                parameters = list(), resources = "Empty resources until we can ensure a sort order in the API."), 
-            userId = "<id value>", userLicenseType = "BASIC", version = 1L))
+    list(list(activationStatus = "PENDING", databaseId = "<id value>", 
+        deliveryStatus = "UNKNOWN", email = "<id value>", inviteAccepted = FALSE, 
+        inviteDate = "<date or time value>", lastLoginDate = "<date or time value>", 
+        name = "Test database user", userId = "<id value>", userLicenseType = "BASIC", 
+        version = 1L), list(activationStatus = "PENDING", databaseId = "<id value>", 
+        deliveryStatus = "UNKNOWN", email = "<id value>", inviteAccepted = FALSE, 
+        inviteDate = "<date or time value>", lastLoginDate = "<date or time value>", 
+        name = "Test database user", userId = "<id value>", userLicenseType = "BASIC", 
+        version = 1L))