Zensus api start

KovaZo · KovaZo · commit affb8b66a3cd · 2023-09-16T20:02:03.000+02:00
Implementing gen_zensus_auth stuff
diff --git a/R/gen_alternative_terms.R b/R/gen_alternative_terms.R
@@ -4,23 +4,28 @@
 #'
 #' @param term Character string. Maximum length of 15 characters. Term or word for which you are searching for alternative or related terms. Use of '*' as a placeholder is possible to generate broader search areas.
 #' @param similarity Logical. Indicator if the output of the function should be sorted based on a Levenshtein edit distance based on the \code{adist()} function.
+#' @param database Character string. Indicator if the Destatis or Zensus database is called.
 #' @param ... Additional parameters for the Genesis API call. These parameters are only affecting the Genesis call itself, no further processing. For more details see `vignette("additional_parameter")`.
 #'
 #' @return A list with all recalled elements from Genesis. Attributes are added to the data.frame, describing the search configuration for the returned output.
 #' @export
 #'
 #' @examples
 #' \dontrun{
-#' # Find terms that are similar (in spelling) to search term "bus"
+#' # Find terms at Destatis that are similar (in spelling) to search term "bus"
 #' # and sort them by Levenshtein edit distance
-#' object <- gen_alternative_terms(term = "bus", similarity = TRUE)
+#' object <- gen_alternative_terms(term = "bus", similarity = TRUE, database = "destatis")
 #'
-#' # Find terms that are related (in spelling) to search term "bus"
-#' object <- gen_alternative_terms(term = "bus*", similarity = TRUE)
+#' # Find terms at Destatis that are related (in spelling) to search term "bus"
+#' object <- gen_alternative_terms(term = "bus*", similarity = TRUE, database = "destatis")
+#'
+#' # Find terms at Zensus that are related (in spelling) to search term "bus"
+#' object <- gen_alternative_terms(term = "bus*", similarity = TRUE, database = "zensus")
 #' }
 #'
 gen_alternative_terms <- function(term = NULL,
                                   similarity = TRUE,
+                                  database = c("zensus", "destatis"),
                                   ...) {
 
   caller <- as.character(match.call()[1])
@@ -31,12 +36,28 @@ gen_alternative_terms <- function(term = NULL,
 
 #-------------------------------------------------------------------------------
 
-  results_raw <- gen_api("catalogue/terms",
+  if( length(database) == 1 & database == "zensus" ){
+
+    results_raw <- gen_zensus_api("catalogue/terms",
+                           username = gen_zensus_auth_get()$username,
+                           password = gen_zensus_auth_get()$password,
+                           selection = term,
+                           ...)
+
+  } else if ( length(database) == 1 & database == "destatis" ){
+
+    results_raw <- gen_api("catalogue/terms",
+                           username = gen_auth_get()$username,
+                           password = gen_auth_get()$password,
+                           selection = term,
+                           ...)
 
-    username = gen_auth_get()$username,
-    password = gen_auth_get()$password,
-    selection = term,
-    ...)
+  } else {
+
+    stop("Parameter 'database' has to be 'zensus' or 'destatis'.",
+         call. = FALSE)
+
+  }
 
   results_json <- test_if_json(results_raw)
 
diff --git a/R/gen_auth.R b/R/gen_auth.R
@@ -1,4 +1,4 @@
-#' Save authentication
+#' Save authentication GENESIS
 #'
 #' See Details.
 #'
diff --git a/R/gen_find.R b/R/gen_find.R
@@ -9,6 +9,7 @@
 #' @param detailed A logical. Indicator if the function should return the detailed output of the iteration including all object related information or only a shortened output including only code and object title. Default Option is FALSE.
 #' @param ordering A logical. Indicator if the function should return the output of the iteration ordered first based on the fact if the searched term is appearing in the title of the object and secondly on an estimator of the number of variables in this object. Default option is TRUE.
 #' @param error.ignore  A logical. Indicator if the function should stop if an error occurs or no object for the request is found or if it should produce an artificial response (e.g., for complex processes not to fail).
+#' @param database Character string. Indicator if the Destatis or Zensus database is called.
 #' @param ... Additional parameters for the Genesis API call. These parameters are only affecting the Genesis call itself, no further processing. For more details see `vignette("additional_parameter")`.
 #'
 #' @return A list with all elements retrieved from Genesis. Attributes are added to the data.frame describing the search configuration for the returned output.
@@ -34,6 +35,7 @@ gen_find <- function(term = NULL,
                      detailed = FALSE,
                      ordering = TRUE,
                      error.ignore = FALSE,
+                     database = c("zensus", "destatis"),
                      ...) {
 
   caller <- as.character(match.call()[1])
@@ -43,18 +45,38 @@ gen_find <- function(term = NULL,
                        detailed = detailed,
                        ordering = ordering,
                        error.ignore = error.ignore,
+                       database = databse,
                        caller = caller)
 
   category <- match.arg(category)
 
   #-----------------------------------------------------------------------------
 
-  results_raw <- gen_api("find/find",
-                         username = gen_auth_get()$username,
-                         password = gen_auth_get()$password,
-                         term = term,
-                         category = category,
-                         ...)
+  if( database == "zensus"){
+
+    results_raw <- gen_zensus_api("find/find",
+                           username = gen_zensus_auth_get()$username,
+                           password = gen_zensus_auth_get()$password,
+                           term = term,
+                           category = category,
+                           ...)
+
+  } else if (database == "destatis"){
+
+    results_raw <- gen_api("find/find",
+                           username = gen_auth_get()$username,
+                           password = gen_auth_get()$password,
+                           term = term,
+                           category = category,
+                           ...)
+
+  } else {
+
+    stop("Parameter 'database' has to be 'zensus' or 'destatis'.",
+         call. = FALSE)
+
+  }
+
 
   results_json <- test_if_json(results_raw)
 
diff --git a/R/gen_list_jobs.R b/R/gen_list_jobs.R
@@ -4,23 +4,42 @@
 #'
 #' @param selection Filter the list of jobs for matching codes.
 #' @param sortcriterion Allows to sort the resulting list of jobs by their Code ("content"), the time of completion ("time") or status ("status")
+#' @param database Character string. Indicator if the Destatis or Zensus database is called.
 #' @param ... Additional parameters for the Genesis API call. These parameters are only affecting the Genesis call itself, no further processing. For more details see `vignette("additional_parameter")`.
 #'
 #' @return A list of all current jobs connected to the given user.
 #' @export
 #'
 gen_list_jobs <- function(selection = NULL,
                           sortcriterion = c("content", "time", "status"),
+                          database = c("zensus", "destatis"),
                           ...
                       ) {
 
-  results_raw <- gen_api("catalogue/jobs",
-                         username = gen_auth_get()$username,
-                         password = gen_auth_get()$password,
-                         selection = selection,
-                         sortcriterion = sortcriterion,
-                         ...
-                         )
+  if( length(database) == 1 & database == "zensus" ){
+
+    results_raw <- gen_zensus_api("catalogue/jobs",
+                           username = gen_zensus_auth_get()$username,
+                           password = gen_zensus_auth_get()$password,
+                           selection = selection,
+                           sortcriterion = sortcriterion,
+                           ...)
+
+  } else if ( length(database) == 1 & database == "destatis" ){
+
+    results_raw <- gen_api("catalogue/jobs",
+                           username = gen_auth_get()$username,
+                           password = gen_auth_get()$password,
+                           selection = selection,
+                           sortcriterion = sortcriterion,
+                           ...)
+
+  } else {
+
+    stop("Parameter 'database' has to be 'zensus' or 'destatis'.",
+         call. = FALSE)
+
+  }
 
   results_json <- test_if_json(results_raw)
 
diff --git a/R/gen_zensus_api.R b/R/gen_zensus_api.R
@@ -0,0 +1,19 @@
+#' Low-level function to interact with the Zensus 2022 GENESIS API
+#'
+#' @param endpoint Self-explanatory
+#'
+#' @importFrom httr2 `%>%`
+#'
+#' @noRd
+#'
+#' @examples
+#' gen_api("helloworld/logincheck") %>%
+#'   httr2::resp_body_json()
+gen_zensus_api <- function(endpoint, ...) {
+  httr2::request("https://ergebnisse2011.zensus2022.de/api/rest/2020") %>%
+    httr2::req_user_agent("https://github.com/CorrelAid/restatis") %>%
+    httr2::req_url_path_append(endpoint) %>%
+    httr2::req_url_query(!!!gen_zensus_auth_get(), ...) %>%
+    httr2::req_retry(max_tries = 3) %>%
+    httr2::req_perform()
+}
diff --git a/R/gen_zensus_auth.R b/R/gen_zensus_auth.R
@@ -0,0 +1,62 @@
+#' Save authentication ZENSUS
+#'
+#' See Details.
+#'
+#' Zensus username and password are encrypted and saved as RDS in the
+#'   package config directory.
+#'
+#' A random string is generated and stored in the session environment
+#'   variable `ZENSUS_KEY`. This string is used as the key to encrypt and
+#'   decrypt the entered Genesis credentials.
+#'
+#' To avoid having to save authentication in future sessions, `ZENSUS_KEY` can
+#'   be added to .Renviron. The usethis package includes a helper function for
+#'   editing .Renviron files from an R session with [usethis::edit_r_environ()].
+#'
+#' @export
+gen_zensus_auth_save <- function() {
+
+  username <- gen_auth_ask("username")
+  password <- gen_auth_ask("password")
+
+  auth_path <- gen_auth_path("auth_ZENSUS.rds")
+
+  key <- httr2::secret_make_key()
+
+  Sys.setenv(ZENSUS_KEY = key)
+
+  message(
+    "Saving credentials to ",
+    auth_path,
+    "\n\n",
+    "Please add the following line to your .Renviron, ",
+    "e.g. via `usethis::edit_r_environ()`, ",
+    "to use the specified username and password across sessions:\n\n",
+    "ZENSUS_KEY=",
+    key,
+    "\n\n"
+  )
+
+  dir.create(gen_auth_path(), showWarnings = FALSE, recursive = TRUE)
+
+  httr2::secret_write_rds(
+    list(username = username, password = password),
+    path = auth_path,
+    key = "ZENSUS_KEY"
+  )
+}
+
+gen_zensus_auth_get <- function() {
+
+  auth_path <- gen_auth_path("auth_ZENSUS.rds")
+
+  if (!(file.exists(auth_path) && nzchar(Sys.getenv("ZENSUS_KEY")))) {
+    stop(
+      "Zensus credentials not found.\n",
+      "Please run `gen_auth_save()` to store Zensus username and password.\n",
+      call. = FALSE
+    )
+  }
+
+  httr2::secret_read_rds(auth_path, "ZENSUS_KEY")
+}
diff --git a/R/utils.R b/R/utils.R
@@ -94,6 +94,7 @@ check_function_input <- function(code = NULL,
                                  similarity = NULL,
                                  error.ignore = NULL,
                                  ordering = NULL,
+                                 database = NULL,
                                  caller = NULL) {
   # Code & Term ----
 
@@ -222,10 +223,18 @@ check_function_input <- function(code = NULL,
     #----------------------------------------
 
     if (caller %in% c("restatis::gen_find", "gen_find")) {
-      if (!all(category %in% c("all", "tables", "statistics", "variables", "cubes"))) {
+      if (database == "zensus"){
+        if (!all(category %in% c("all", "tables", "statistics", "variables"))) {
+          stop("Available categories are all, tables, statistics, and variables.",
+               call. = FALSE
+          )
+        }
+      } else if (database == "destatis"){
+        if (!all(category %in% c("all", "tables", "statistics", "variables", "cubes"))) {
         stop("Available categories are all, tables, statistics, variables, and cubes.",
           call. = FALSE
-        )
+          )
+        }
       }
     }
 
diff --git a/R/zzz.R b/R/zzz.R
@@ -3,3 +3,9 @@
 
   if (!nzchar(Sys.getenv("GENESIS_LANG"))) Sys.setenv(GENESIS_LANG = "en")
 }
+
+.onLoad_zensus <- function(libname, pkgname) {
+  gen_zensus_api <<- memoise::memoise(gen_zensus_api)
+
+  if (!nzchar(Sys.getenv("GENESIS_LANG"))) Sys.setenv(GENESIS_LANG = "en")
+}

Original file line number	Diff line number	Diff line change
`@@ -1,4 +1,4 @@`
`1`		`-#' Save authentication`
	`1`	`+#' Save authentication GENESIS`
`2`	`2`	`#'`
`3`	`3`	`#' See Details.`
`4`	`4`	`#'`
Original file line number	Diff line number	Diff line change
`@@ -3,3 +3,9 @@`
`3`	`3`
`4`	`4`	`if (!nzchar(Sys.getenv("GENESIS_LANG"))) Sys.setenv(GENESIS_LANG = "en")`
`5`	`5`	`}`
	`6`	`+`
	`7`	`+.onLoad_zensus <- function(libname, pkgname) {`
	`8`	`+ gen_zensus_api <<- memoise::memoise(gen_zensus_api)`
	`9`	`+`
	`10`	`+ if (!nzchar(Sys.getenv("GENESIS_LANG"))) Sys.setenv(GENESIS_LANG = "en")`
	`11`	`+}`