R/bcdc_options.R

In bcgov/bcdc: Search and Retrieve Data from the BC Data Catalogue

# Copyright 2019 Province of British Columbia
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and limitations under the License.

#' Retrieve options used in bcdata, their value if set and the default value.
#'
#' This function retrieves bcdata specific options that can be set. These
#' options can be set using `option({name of the option} = {value of the
#' option})`. The default options are purposefully set conservatively to
#' hopefully ensure successful requests. Resetting these options may result in
#' failed calls to the data catalogue. Options in R are reset every time R is
#' re-started. See examples for additional ways to restore your initial state.
#'
#' `bcdata.max_geom_pred_size` is the maximum size in bytes of an object used
#' for a geometric operation. Objects that are bigger than this value will have
#' a bounding box drawn and apply the geometric operation on that simpler
#' polygon. The [bcdc_check_geom_size] function can be used to assess whether a
#' given spatial object exceeds the value of this option. Users can iteratively
#' try to increase the maximum geometric predicate size and see if the bcdata
#' catalogue accepts the request.
#'
#' `bcdata.chunk_limit` is an option useful when dealing with very large data
#' sets. When requesting large objects from the catalogue, the request is broken
#' up into smaller chunks which are then recombined after they've been
#' downloaded. This is called "pagination". bcdata does this all for you, however by
#' using this option you can set the size of the chunk requested. On slower
#' connections, or when having problems, it may help to lower the chunk limit.
#'
#' `bcdata.max_package_search_limit`  is an option for setting the maximum number of
#' datasets returned when querying by organization with the package_search API endpoint. The
#' default limit (1000) is purposely set high to return all datasets for a
#' given organization.
#'
#' `bcdata.max_package_search_facet_limit` is an option for setting the maximum number of
#' values returned when querying facet fields with the package_search API endpoint. The
#' default limit (1000) is purposely set high to return all values for each facet field
#' ("license_id", "download_audience", "res_format", "publish_state", "organization", "groups").
#'
#' `bcdata.max_group_package_show_limit` is an option for setting the maximum number of
#' datasets returned when querying by group with the group_package_show API endpoint. The
#' default limit (1000) is purposely set high to return all datasets for a
#' given group.
#'
#' `bcdata.single_download_limit` *Deprecated*. This is the maximum number of
#' records an object can be before forcing a paginated download; it is set by
#' querying the server capabilities. This option is deprecated and will be
#' removed in a future release. Use `bcdata.chunk_limit` to set a lower value
#' pagination value.
#'
#' @examples
#' \donttest{
#' ## Save initial conditions
#' try(
#'   original_options <- options()
#' )
#'
#' ## See initial options
#' try(
#'   bcdc_options()
#' )
#'
#' try(
#'   options(bcdata.max_geom_pred_size = 1E6)
#' )
#'
#' ## See updated options
#' try(
#'   bcdc_options()
#' )
#'
#' ## Reset initial conditions
#' try(
#'   options(original_options)
#' )
#' }
#' @export
#'

bcdc_options <- function() {
  null_to_na <- function(x) {
    ifelse(is.null(x), NA, as.numeric(x))
  }

  server_single_download_limit <- bcdc_single_download_limit()

  dplyr::tribble(
    ~option,
    ~value,
    ~default,
    "bcdata.max_geom_pred_size",
    null_to_na(getOption("bcdata.max_geom_pred_size")),
    5E5,
    "bcdata.chunk_limit",
    null_to_na(getOption("bcdata.chunk_limit")),
    server_single_download_limit,
    "bcdata.single_download_limit",
    null_to_na(deprecate_single_download_limit_option()),
    server_single_download_limit,
    "bcdata.max_package_search_limit",
    null_to_na(getOption("bcdata.max_package_search_limit")),
    1000,
    "bcdata.max_package_search_facet_limit",
    null_to_na(getOption("bcdata.max_package_search_facet_limit")),
    1000,
    "bcdata.max_group_package_show_limit",
    null_to_na(getOption("bcdata.max_group_package_show_limit")),
    1000
  )
}


check_chunk_limit <- function() {
  chunk_limit <- getOption("bcdata.chunk_limit")
  single_download_limit <- deprecate_single_download_limit_option()

  if (is.null(chunk_limit)) {
    return(single_download_limit)
  }
  if (chunk_limit > single_download_limit) {
    stop(
      glue::glue(
        "Your chunk value of {chunk_limit} exceeds the BC Data Catalogue chunk limit of {single_download_limit}"
      ),
      call. = FALSE
    )
  }
  chunk_limit
}

bcdc_get_capabilities <- function() {
  current_xml <- ._bcdataenv_$get_capabilities_xml
  if (!is.null(current_xml) && inherits(current_xml, "xml_document")) {
    # Already retrieved and stored this session
    return(current_xml)
  }

  if (has_internet()) {
    url <- make_url(bcdc_web_service_host(), "geo/pub/ows")
    cli <- bcdc_http_client(url, auth = FALSE)

    get_caps <- function(cli) {
      cc <- cli$get(
        query = list(
          SERVICE = "WFS",
          VERSION = "2.0.0",
          REQUEST = "GetCapabilities"
        )
      )
      cc$raise_for_status()
      res <- cc$parse("UTF-8")
      xml2::read_xml(res)
    }

    # The GetCapabilities request can be fragile,
    # if it breaks return NULL (#339)
    ret <- try(get_caps(cli), silent = TRUE)

    if (inherits(ret, "try-error")) {
      return(NULL)
    }

    # store it and return it
    ._bcdataenv_$get_capabilities_xml <- ret
    return(ret)
  }

  invisible(NULL)
}

bcdc_get_wfs_records <- function() {
  doc <- bcdc_get_capabilities()

  if (is.null(doc))
    stop(
      "Unable to access wfs listing from server. Please open an issue. ",
      call. = FALSE
    )

  # d1 is the default xml namespace (see xml2::xml_ns(doc))
  features <- xml2::xml_find_all(doc, "./d1:FeatureTypeList/d1:FeatureType")

  tibble::tibble(
    whse_name = gsub(
      "^pub:",
      "",
      xml2::xml_text(xml2::xml_find_first(features, "./d1:Name"))
    ),
    title = xml2::xml_text(xml2::xml_find_first(features, "./d1:Title")),
    cat_url = xml2::xml_attr(
      xml2::xml_find_first(features, "./d1:MetadataURL"),
      "href"
    )
  )
}

bcdc_single_download_limit <- function() {
  doc <- bcdc_get_capabilities()

  if (is.null(doc)) {
    message(
      "Unable to access server to determine single download limit; using default download limit of 10000"
    )
    return(10000L)
  }

  count_default_xpath <- "./ows:OperationsMetadata/ows:Operation[@name='GetFeature']/ows:Constraint[@name='CountDefault']"
  # Looking globally also works but is slower: ".//ows:Constraint[@name='CountDefault']"
  count_defaults <- xml2::xml_find_first(doc, count_default_xpath)
  xml2::xml_integer(count_defaults)
}

# Used to send a message once per session that the single_download_limit option
# will be deprecated. When we remove it, replace all calls to this function
# with bcdc_single_download_limit() and remove the ._bcdataenv_$single_download_limit_warned
# object from .onLoad.
deprecate_single_download_limit_option <- function() {
  x <- getOption("bcdata.single_download_limit")
  if (!is.null(x)) {
    if (!isTRUE(._bcdataenv_$single_download_limit_warned)) {
      warning(
        "The bcdata.single_download_limit option is deprecated. Please use bcdata.chunk_limit instead.",
        call. = FALSE
      )
      assign("single_download_limit_warned", TRUE, envir = ._bcdataenv_)
    }
    return(x)
  }
  bcdc_single_download_limit()
}