Skip to content
GitLab
Select Git revision
  • master default
  • v0.1.0
Find file BlameHistoryPermalink
doApiQuery.R 4.28 KiB
1 
#' Main internal functions for querying the Hub'eau APIs
2 
#'
3 
#' The function `doQueryApi` is called by all the function querying the APIs and return the raw data sent by the API.
4 
#' Pagination of the queries is handled automatically and the returned [list] is the concatenation of all the results sent by the API.
5 
#'
6 
#' The function `get_available_params` returns the list of available query parameters for a given operation in an API.
7 
#'
8 
#' @details The functions `get_[api]_[operation]` call the function `doQueryApi` and convert the response in a convenient format for the user ([data.frame] or [tibble::tibble])
9 
#'
10 
#' @param api a [character] name of the API (e.g.: "indicateurs_services", "prelevements"...), see example for available APIs
11 
#' @param operation a [character] name of the operation, see example for available operations in an API
12 
#' @template param_get_common
13 
#'
14 
#' @return A [list] with the concatenated results returned by the API.
15 
#' @export
16 
#' @rdname doApiQuery
17 
#'
18 
#' @examples
19 
#' # To get the available APIs in the package
20 
#' cfg <- config::get(file = system.file("config.yml", package = "hubeau"))
21 
#' names(cfg$apis)
22 
#'
23 
#' # To get the available operation in an API
24 
#' names(cfg$apis[["prelevements"]]$operations)
25 
#'
26 
#' # To get available parameters in operation "chroniques" of the API "prelevements"
27 
#' get_available_params(api = "prelevements", operation = "chroniques")
28 
#'
29 
#' # To query the operation "chroniques" of the API "prelevements"
30 
#' # on all devices in the commune of Romilly-sur-Seine in 2018
31 
#' doApiQuery(api = "prelevements",
32 
#'            operation = "chroniques",
33 
#'            params = list(code_commune_insee = "10323", annee = "2018"))
34 
doApiQuery <- function(api,
35 
                       operation,
36 
                       params,
37 
                       cfg = config::get(file = system.file("config.yml", package = "hubeau"))) {
38 
  availableParams <- get_available_params(api, operation, cfg)
39
40 
  query <-
41 
    file.path(cfg$api_url, cfg$apis[[api]]$path, cfg$apis[[api]]$operations[[operation]]$path)
42 
  for (paramName in names(params)) {
43 
    if (!paramName %in% cfg$apis[[api]]$operations[[operation]]$fields) {
44 
      stop(
45 
        sprintf(
46 
          "The parameter '%s' is not available for this query. ",
47 
          paramName
48 
        ),
49 
        "\n",
50 
        sprintf(
51 
          "Run `hubeau::get_available_params(\"%s\", \"%s\")` to get available parameters.",
52 
          api,
53 
          operation
54 
        )
55 
      )
56 
    }
57 
    if (!is.null(params[[paramName]])) {
58 
      query <- urltools::param_set(query,
59 
                                   key = paramName,
60 
                                   value = params[[paramName]])
61 
    }
62 
  }
63 
  data <- list()
64
65 
  repeat {
66 
    resp <- httr::GET(query)
67 
    if (resp$status_code >= 400) {
68 
      l <- NULL
69 
      try(l <- httr::content(resp, "parsed"), TRUE)
70 
      if (is.null(l$field_errors)) {
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132
stop("Error ", resp$status_code, " on query: ", query) } else { field_errors <- sapply(l$field_errors, function(x) { paste(x$field, x$message) }) stop( "Error ", resp$status_code, " on query: ", query, "\n Error on parameters:\n", paste(field_errors, collapse = "\n") ) } } else { l <- httr::content(resp, "parsed") if (as.numeric(l$count) > 20000) { stop( "The request reach the API limitation of 20000 records.\n", "Use filter arguments to reduce the number of records of your query." ) } else if(as.numeric(l$count) == 0) { return(NULL) } data <- c(data, l$data) if (resp$status_code == 206) { query <- l$`next` if (is.null(query)) { # Bug https://github.com/BRGM/hubeau/issues/72 break } } if (resp$status_code == 200) { break } } } return(data) } #' Convert list provided by the API into a tibble #' #' @param l a [list] provided by the API #' #' @return a [tibble:tibble] with one row by list item and one column by list sub-item #' @noRd #' convert_list_to_tibble <- function(l) { l <- lapply(l, function(row) { lapply(row, function(cell) { if (is.null(unlist(cell))) NA else unlist(cell) }) }) return(purrr::map_df(l, tibble::as_tibble)) }