Merge pull request #38 from CorrelAid/dev

Dev
CorrelAid · Sep 27, 2024 · c6dbbba · c6dbbba
2 parents e603c87 + d7773d7
commit c6dbbba
Show file tree

Hide file tree

Showing 14 changed files with 250 additions and 206 deletions.
diff --git a/R/gen_api.R b/R/gen_api.R
@@ -1,33 +1,29 @@
-#' gen_api
+#' gen_genesis_api
 #'
 #' @description Low-level function to interact with the GENESIS API
 #'
 #' @param endpoint Character string. The endpoint of the API that is to be queried.
+#' @param overwrite_url Character string. In certain cases it is required to set a custom URL for the respective API. By specifying the URL in this parameter, the API calls will be directed to this custom URL. But be aware, the URL has to lead to the same database (in this case: GENESIS), else there will be errors. Hence, use with caution.
+#' @param ... Further parameters passed on to the final API call.
 #'
 #' @importFrom httr2 `%>%`
 #'
 #' @noRd
 #'
 #' @examples
 #' \dontrun{
-#' gen_api("helloworld/logincheck") %>%
-#'   httr2::resp_body_json()
+#' gen_genesis_api("helloworld/logincheck") %>%
+#'  httr2::resp_body_json()
 #' }
 #'
-# gen_api <- function(endpoint, ...) {
-#
-#   httr2::request("https://www-genesis.destatis.de/genesisWS/rest/2020") %>%
-#     httr2::req_user_agent("https://github.com/CorrelAid/restatis") %>%
-#     httr2::req_url_path_append(endpoint) %>%
-#     httr2::req_url_query(!!!gen_auth_get(database = "genesis"), ...) %>%
-#     httr2::req_retry(max_tries = 3) %>%
-#     httr2::req_perform()
-#
-# }
+gen_genesis_api <- function(endpoint,
+                            overwrite_url,
+                            ...) {
 
-gen_api <- function(endpoint, ...) {
+  url <- ifelse(is.null(overwrite_url),
+                "https://www-genesis.destatis.de/genesisWS/rest/2020",
+                overwrite_url)
 
-  url <- "https://www-genesis.destatis.de/genesisWS/rest/2020"
   user_agent <- "https://github.com/CorrelAid/restatis"
 
   body_parameters <- list(...)
@@ -62,6 +58,8 @@ gen_api <- function(endpoint, ...) {
 #' @description Low-level function to interact with the regionalstatistik.de API
 #'
 #' @param endpoint Character string. The endpoint of the API that is to be queried.
+#' @param overwrite_url Character string. In certain cases it is required to set a custom URL for the respective API. By specifying the URL in this parameter, the API calls will be directed to this custom URL. But be aware, the URL has to lead to the same database (in this case: www.regionalstatistik.de), else there will be errors. Hence, use with caution.
+#' @param ... Further parameters passed on to the final API call.
 #'
 #' @importFrom httr2 `%>%`
 #'
@@ -73,9 +71,15 @@ gen_api <- function(endpoint, ...) {
 #'   httr2::resp_body_json()
 #' }
 #'
-gen_regio_api <- function(endpoint, ...) {
+gen_regio_api <- function(endpoint,
+                          overwrite_url,
+                          ...) {
+
+  url <- ifelse(is.null(overwrite),
+                "https://www.regionalstatistik.de/genesisws/rest/2020/",
+                overwrite_url)
 
-  httr2::request("https://www.regionalstatistik.de/genesisws/rest/2020/") %>%
+  httr2::request(url) %>%
     httr2::req_user_agent("https://github.com/CorrelAid/restatis") %>%
     httr2::req_url_path_append(endpoint) %>%
     httr2::req_url_query(!!!gen_auth_get(database = "regio"), ...) %>%
@@ -91,6 +95,8 @@ gen_regio_api <- function(endpoint, ...) {
 #' @description Low-level function to interact with the Zensus 2022 database
 #'
 #' @param endpoint Character string. The endpoint of the API that is to be queried.
+#' @param overwrite_url Character string. In certain cases it is required to set a custom URL for the respective API. By specifying the URL in this parameter, the API calls will be directed to this custom URL. But be aware, the URL has to lead to the same database (in this case: Zensus 2022), else there will be errors. Hence, use with caution.
+#' @param ... Further parameters passed on to the final API call.
 #'
 #' @importFrom httr2 `%>%`
 #'
@@ -102,12 +108,36 @@ gen_regio_api <- function(endpoint, ...) {
 #'   httr2::resp_body_json()
 #' }
 #'
-gen_zensus_api <- function(endpoint, ...) {
+gen_zensus_api <- function(endpoint,
+                           overwrite_url,
+                           ...) {
 
-  httr2::request("https://ergebnisse.zensus2022.de/api/rest/2020") %>%
-    httr2::req_user_agent("https://github.com/CorrelAid/restatis") %>%
+  url <- ifelse(is.null(overwrite_url),
+                "https://ergebnisse.zensus2022.de/api/rest/2020",
+                overwrite_url)
+
+  user_agent <- "https://github.com/CorrelAid/restatis"
+
+  body_parameters <- list(...)
+
+  if (length(body_parameters) > 0) {
+
+    req <- httr2::request(url) %>%
+      httr2::req_body_form(!!!body_parameters)
+
+  } else {
+
+    req <- httr2::request(url) %>%
+      httr2::req_body_form(!!!list("foo" = "bar"))
+
+  }
+
+  req %>%
+    httr2::req_user_agent(user_agent) %>%
     httr2::req_url_path_append(endpoint) %>%
-    httr2::req_url_query(!!!gen_auth_get(database = "zensus"), ...) %>%
+    httr2::req_headers("Content-Type" = "application/x-www-form-urlencoded",
+                       "username" = gen_auth_get(database = "zensus")$username,
+                       "password" = gen_auth_get(database = "zensus")$password) %>%
     httr2::req_retry(max_tries = 3) %>%
     httr2::req_perform()
 

diff --git a/R/gen_catalogue.R b/R/gen_catalogue.R
@@ -76,7 +76,7 @@ gen_catalogue <- function(code = NULL,
 
       list_of_cubes <- "There are generally no 'cubes' objects available for the 'zensus' database."
 
-    } else if ("cubes" %in% category && (db == "gen_api" | db == "gen_regio_api")) {
+    } else if ("cubes" %in% category && (db == "gen_genesis_api" | db == "gen_regio_api")) {
 
       results_raw <- do.call(db,
                              list(endpoint = "catalogue/cubes",

diff --git a/R/gen_cube.R b/R/gen_cube.R
@@ -96,27 +96,27 @@ gen_cube_ <- function(name,
 
   if (database == "genesis") {
 
-  cube_raw <- gen_api("data/cubefile",
-                      name = name,
-                      area = area,
-                      values = values,
-                      metadata = metadata,
-                      additionals = additionals,
-                      startyear = startyear,
-                      endyear = endyear,
-                      timeslices = timeslices,
-                      contents = contents,
-                      regionalvariable = regionalvariable,
-                      regionalkey = regionalkey,
-                      classifyingvariable1 = classifyingvariable1,
-                      classifyingkey1 = classifyingkey1,
-                      classifyingvariable2 = classifyingvariable2,
-                      classifyingkey2 = classifyingkey2,
-                      classifyingvariable3 = classifyingvariable3,
-                      classifyingkey3 = classifyingkey3,
-                      stand = stand,
-                      language = language,
-                      job = FALSE)
+  cube_raw <- gen_genesis_api("data/cubefile",
+                              name = name,
+                              area = area,
+                              values = values,
+                              metadata = metadata,
+                              additionals = additionals,
+                              startyear = startyear,
+                              endyear = endyear,
+                              timeslices = timeslices,
+                              contents = contents,
+                              regionalvariable = regionalvariable,
+                              regionalkey = regionalkey,
+                              classifyingvariable1 = classifyingvariable1,
+                              classifyingkey1 = classifyingkey1,
+                              classifyingvariable2 = classifyingvariable2,
+                              classifyingkey2 = classifyingkey2,
+                              classifyingvariable3 = classifyingvariable3,
+                              classifyingkey3 = classifyingkey3,
+                              stand = stand,
+                              language = language,
+                              job = FALSE)
 
   #-----------------------------------------------------------------------------
 

diff --git a/R/gen_find.R b/R/gen_find.R
@@ -439,7 +439,7 @@ gen_find <- function(term = NULL,
 
       if("cubes" %in% category) {
 
-        if (db == "gen_api" | db == "gen_regio_api") {
+        if (db == "gen_genesis_api" | db == "gen_regio_api") {
 
           if(!is.null(results_json$Cubes)) {
 

diff --git a/R/gen_jobs.R b/R/gen_jobs.R
@@ -49,7 +49,7 @@ gen_list_jobs <- function(database = c("genesis", "regio"),
 
   #-----------------------------------------------------------------------------
 
-  if (gen_fun == "gen_api"){
+  if (gen_fun == "gen_genesis_api"){
 
     par_list <-  list(endpoint = "catalogue/jobs",
                       sortcriterion = sortcriterion,
@@ -169,12 +169,12 @@ gen_download_job <- function(name,
 
   if (database == "genesis") {
 
-    response <- gen_api("data/resultfile",
-                        name = name,
-                        area = area,
-                        compress = compress,
-                        format = "ffcsv",
-                        language = language)
+    response <- gen_genesis_api("data/resultfile",
+                                name = name,
+                                area = area,
+                                compress = compress,
+                                format = "ffcsv",
+                                language = language)
 
     response_type <- resp_check_data(response)