Merge branch 'httr2' into main

.Rbuildignore

@@ -14,7 +14,6 @@
 ^README.Rmd
 ^README.md
 ^README.html
-^LICENSE.md
 ^RAQSAPI.Rproj
 ^doc$
 ^dev$
@@ -40,5 +39,6 @@ tests/testthat/local.R
 dev/*
 ^.*\.Rproj$
 ^\.Rproj\.user$
-^LICENSE$
 codemeta.json
+^revdep$
+^LICENSE\.md$

.github/workflows/R-CMD-check.yaml

@@ -2,9 +2,9 @@
 # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
 on:
   push:
-    branches: [main, master]
+    branches: [main, httr2]
   pull_request:
-    branches: [main, master]
+    branches: [main, httr2]
 
 name: R-CMD-check
 

DESCRIPTION

@@ -52,8 +52,7 @@ Depends: R (>= 4.0.0)
 Imports: 
     dplyr,
     glue,
-    httr,
-    jsonlite,
+    httr2,
     lifecycle,
     lubridate,
     magrittr,
@@ -63,7 +62,6 @@ Imports:
     tibble
 Suggests:
     covr,
-    desc,
     devtools,
     goodpractice,
     keyring,
@@ -80,7 +78,7 @@ RoxygenNote: 7.2.3
 VignetteBuilder: knitr
 BuildVignettes: true
 ByteCompile: true
-License: MIT
+License: MIT + file LICENSE
 License_is_FOSS: yes
 NeedsCompilation: no
 License_restricts_use: no

NAMESPACE

@@ -104,14 +104,14 @@ importFrom(dplyr,select)
 importFrom(dplyr,select_if)
 importFrom(dplyr,vars)
 importFrom(glue,glue)
-importFrom(httr,GET)
-importFrom(httr,content)
-importFrom(httr,http_error)
-importFrom(httr,http_type)
-importFrom(httr,message_for_status)
-importFrom(httr,modify_url)
-importFrom(httr,status_code)
-importFrom(httr,user_agent)
+importFrom(httr2,req_options)
+importFrom(httr2,req_perform)
+importFrom(httr2,req_retry)
+importFrom(httr2,req_throttle)
+importFrom(httr2,req_url_path_append)
+importFrom(httr2,req_user_agent)
+importFrom(httr2,request)
+importFrom(httr2,resp_body_json)
 importFrom(lifecycle,badge)
 importFrom(lifecycle,deprecate_soft)
 importFrom(lubridate,'%within%')
@@ -128,15 +128,13 @@ importFrom(lubridate,ymd_hm)
 importFrom(magrittr,`%<>%`)
 importFrom(magrittr,`%>%`)
 importFrom(purrr,pmap)
-importFrom(rlang,.data)
 importFrom(rlang,`!!`)
 importFrom(rlang,`:=`)
 importFrom(rlang,abort)
 importFrom(rlang,call_name)
+importFrom(rlang,caller_call)
 importFrom(rlang,format_error_bullets)
 importFrom(rlang,is_character)
-importFrom(rlang,is_empty)
-importFrom(rlang,local_options)
 importFrom(stringr,str_c)
 importFrom(stringr,str_detect)
 importFrom(tibble,as_tibble)

NEWS.md

@@ -1,6 +1,6 @@
 % News.md for RAQSAPI
 % Clinton Mccrowey Physical Scientist  
- EPA Region III  
+ EPA Region 3  
  Air and Radiation Division  
  Air Quality Analysis Branch
 

R/AQSAPI_helperfunctions.R

@@ -321,25 +321,6 @@ format_multiple_params_for_api <- function(x, separator=",")
 }
 
 
-#' @title aqs_ratelimit
-#' @description a helper function that should not be called externally, used
-#'                 as a primitive rate limit function for aqs.
-#' @param waittime the number of seconds, encoded as a numeric, that the API
-#'                     should wait after performing a API query
-#'                     (defaults to 5 seconds, as recommended by the AQS team).
-#' @note  Although this function is designed to prevent users from exceeding
-#'        allowed data limits, it can not garuntee that the user exceed rate
-#'        limits. Users are advised to monitor their own usage to ensure that
-#'        data limits are not exceeded. Use of this package is at the users own
-#'        risk. The maintainers of this code assume no responsibility due to
-#'        anything that may happen as a result of using this code.
-#' @return NULL
-#' @noRd
-aqs_ratelimit <- function(waittime=5L)
-{
-  Sys.sleep(waittime)
-}
-
 #' @title aqs
 #' @description a helper function sends a AQS RESTful request to the AQS API
 #'                 and returns the result as a aqs data type. This helper
@@ -373,109 +354,62 @@ aqs_ratelimit <- function(waittime=5L)
 #' @importFrom dplyr mutate select arrange
 #' @importFrom lubridate ymd_hm
 #' @importFrom glue glue
-#' @importFrom rlang .data is_empty
 #' @importFrom tibble as_tibble
-#' @importFrom rlang local_options
-#' @importFrom httr GET http_type content http_error status_code modify_url
-#'               user_agent message_for_status
+#' @importFrom rlang caller_call
+#' @importFrom httr2 request req_user_agent req_url_path_append resp_body_json
+#'                   req_perform req_options req_retry req_throttle
 #' @return a AQS_DATAMART_APIv2 S3 object that is the return value from the
 #'            AQS API. A AQS_DATAMART_APIv2 is a 2 item named list in which the
 #'            first item ($Header) is a tibble of header information from the
 #'            AQS API and the second item ($Data) is a tibble of the data
 #'            returned.
 #' @noRd
-aqs <- function(service, filter = NA, user = NA,
+aqs <- function(service, filter = NULL, user = NA,
                     user_key = NA, variables = NULL, AQS_domain = "aqs.epa.gov")
 {
-  if (is.null(getOption("aqs_username")) |
-      is.null(getOption("aqs_key")))
-  {stop("please enter user credentials before using RAQSAPI functions,\n
-         please refer to \'?aqs_credentials()\' for useage infomation \n")}
-
-  #on windows platform, use the Schannel Curl_SSL_BACKEND to avoid the
-  #legacy renegotiation disabled error
-  # if(.Platform$OS.type == "windows")
-  # {
-  #   local_options(CURL_SSL_BACKEND="Schannel")
-  # }
-
-  user_agent <- glue("User:{user} via RAQSAPI library for R") %>%
-    httr::user_agent()
-
-   if (rlang::is_empty(service) & rlang::is_empty(filter))
-  {
-    path <- glue::glue("/data/api/")
-  }else if (rlang::is_empty(service))
-  {
-    path <- glue::glue("/data/api/")
-  }else if (rlang::is_empty(filter))
-  {
-    path <- glue::glue("/data/api/{service}")
-  }else {
-    path <- glue::glue("/data/api/{service}/{filter}")
-  }
-
-  query <- c(email = I(user),
-             key = I(user_key),
-             variables,
-             recursive = TRUE) %>%
-    as.list
-  #modify_url interprets NA's as literals therefore will need to remove all NA
-  # values before continuing
-  query <- query[!is.na(query)]
-  url <- httr::modify_url(scheme = "https",
-                          hostname = AQS_domain,
-                          url = path,
-                          query = query
-                         )
-
-    AQSresult <- httr::GET(url, user_agent)
-  aqs_ratelimit()
-  if (httr::http_type(AQSresult) != "application/json") {
-    stop("API did not return json", call. = TRUE)
-  }
+  if (is.null(user) | is.null(user_key))
+         {stop("please enter user credentials before using RAQSAPI functions,\n
+                please refer to \'?aqs_credentials()\' for useage infomation \n"
+              )
+          }
+  # AQS DataMart API does not accept headers so user_agent not working
+  # user_agent <- glue("User:{user} via RAQSAPI-{packageVersion('RAQSAPI')}
+  #                     library for R")
 
-  out <- jsonlite::fromJSON(httr::content(AQSresult, "text"),
-                            simplifyDataFrame = TRUE)
-  if ("Header" %in% names(out)) {out$Header %<>% tibble::as_tibble()}
-  if ("Data" %in% names(out)) {out$Data %<>% tibble::as_tibble()}
-  if ("Error" %in% names(out)) {out$Error %<>% tibble::as_tibble()}
+  AQSpath <- glue("https://{AQS_domain}/data/api/{service}/{filter}?") %>%
+    glue(format_variables_for_api(c(list(email = I(user), key = user_key),
+                                  variables)))
+  AQSrequest <- AQSpath %>%
+    request() %>%
+    req_throttle(rate = 10/60, realm = "RAQSAPI") %>%
+    req_retry(max_tries = 5, max_seconds = 30, backoff = ~10)
+    # AQS DataMart API does not accept headers so user_agent not working
+    #%>% req_user_agent(string = user_agent)
 
-  if (httr::http_error(AQSresult))
-    {
-       message("RAQSAPI has encountered an error")
-       message(paste("RAQSAPI failed on url: ", out$Header$url, sep=" "))
-       stop(httr::message_for_status(AQSresult),
-            call. = FALSE
-           )
-     }
-  out <- structure(.Data = out, class = "AQS_DATAMART_APIv2")
-  out$Data$datetime <- NA_character_ #create a new column in the Data dataframe
+    AQSresponse <- AQSrequest %>%
+      req_perform(verbosity = 0)
 
-  #arrange $Data portion by date_local, time_local if present.
-  #  this is done by creating a temporary variable named datetime
-  #  corercing datetime into a POSIXct object, then arranging $Data by this
-  #  variable. Lastly the temporary variable is removed.
-  if (all(c("date_local", "time_local") %in% colnames(out$Data)))
+    if(httr2::resp_is_error(AQSresponse))
     {
-      #out$Data %<>% dplyr::mutate(datetime = glue("{date_local} {time_local}"))
-      #out$Data %<>% dplyr::mutate(datetime = ymd_hm(.data$`datetime`))
-      #out$Data %<>% dplyr::arrange(.data$datetime)
-      #out$Data %<>% dplyr::select(-.data$datetime)
+      message(glue("RAQSAPI experienced an error with in aqs function from
+                   {rlang::caller_call(n=2)} /n
+                   url: {AQSpath}"))
+    }
 
-      #Needed to get rid of that pesky check note "no visible binding for
-      # global variable 'datetime'
-      out$Data$datetime <- NA_character_
+    AQSresponse %<>%
+      resp_body_json(simplifyVector = TRUE,
+                     simplifyDataFrame = TRUE)
+    AQSresult <- vector("list", length = 2)
+    AQSresult[[1]] <- AQSresponse$Header
+    AQSresult[[2]] <- AQSresponse$Data
+    names(AQSresult) <- c("Header", "Data")
+    AQSresult <- structure(.Data = AQSresult, class = "AQS_DATAMART_APIv2")
+     #aqs_ratelimit() #depricated
+     return(AQSresult)
 
-      out$Data %<>% dplyr::mutate(datetime = glue("{.data$date_local}
-                                                  {.data$time_local}")) %>%
-        dplyr::mutate(datetime = ymd_hm(.data$datetime)) %>%
-        dplyr::arrange(.data$datetime) %>%
-        dplyr::select(- datetime)
-    }
-  return(out)
 }
 
+
 #' @title isValidEmail
 #' @description a helper function that checks the input string has the form
 #'                \<character\>\<AT\>\<character\>.\<character\> with length

R/RAQSAPI-package.R

@@ -33,7 +33,6 @@
 #' @name RAQSAPI
 #' @keywords internal
 "_PACKAGE"
-NULL
 
 
 ## usethis namespace: start

R/RAQSAPIlistfunctions.R

@@ -3,38 +3,21 @@
 
 #' @title aqs_isavailable
 #' @description \lifecycle{stable}
-#'                returns a tibble or an AQS_Data Mart_APIv2 S3 object
-#'                explaining the status of the AQS API.
+#'                returns a tibble that details the status of the
+#'                AQS Data Mart API.
 #' @importFrom magrittr `%>%`
-#' @param return_header If FALSE (default) only returns data requested.
-#'                        If TRUE returns a AQSAPI_v2 object which is a two
-#'                        item list that contains header information returned
-#'                        from the API server mostly used for debugging
-#'                        purposes in addition to the data requested.
-#' @return a tibble or an AQS_Data Mart_APIv2 S3 object which details the status
-#'             of the AQS API (The status information is located in the header)
+#' @return a tibble that details the status of the AQS Data Mart API.
 #' @examples
 #'   # Check if the AQS API is up, running and accepting requests.
 #'   \dontrun{ aqs_isAvailable() }
 #' @export
-aqs_isavailable <- function(return_header = FALSE)
+aqs_isavailable <- function()
 {
-  if (!return_header)
-  {
-  aqs(service = "metaData",
-          filter = "isAvailable",
-          user =  getOption("aqs_username"),
-          user_key =  getOption("aqs_key")
-          )$Header %>%
-    return()
-  } else
-  {
     aqs(service = "metaData",
-          filter = "isAvailable",
-          user =  getOption("aqs_username"),
-          user_key =  getOption("aqs_key")
-          )
-  }
+        filter = "isAvailable",
+        user =  getOption("aqs_username"),
+        user_key =  getOption("aqs_key")
+        )$Header
 }
 
 
@@ -441,9 +424,9 @@ aqs_fields_by_service <- function(service, return_header = FALSE)
 #'                        from the API server mostly used for debugging
 #'                        purposes in addition to the data requested.
 #' @note Not all sample durations that are available through AQS are available
-#'       through the AQS DataMart API, including certain calculated sample
+#'       through the AQS Data Mart API, including certain calculated sample
 #'       durations. Only sample durations that are available through the
-#'       AQS DataMart API are returned.
+#'       AQS Data Mart API are returned.
 #' @return a tibble or an AQS_Data Mart_APIv2 S3 object of sample durations and
 #'         their associated duration codes
 #'                 (groups of parameters, i.e. "criteria" or "all").

R/deprecated.R

@@ -160,3 +160,24 @@ aqs_qa_annualpeferomanceevaltransaction_by_MA <- function()
                    been renamed to aqs_qa_annualperformancetransaction_by*
                    functions, please use these functions instead.")
 }
+
+
+#' @title aqs_ratelimit
+#' @description \lifecycle{depricated}
+#' @description a helper function that should not be called externally, used
+#'                 as a primitive rate limit function for aqs.
+#' @param waittime the number of seconds, encoded as a numeric, that the API
+#'                     should wait after performing a API query
+#'                     (defaults to 5 seconds, as recommended by the AQS team).
+#' @note  Although this function is designed to prevent users from exceeding
+#'        allowed data limits, it can not garuntee that the user exceed rate
+#'        limits. Users are advised to monitor their own usage to ensure that
+#'        data limits are not exceeded. Use of this package is at the users own
+#'        risk. The maintainers of this code assume no responsibility due to
+#'        anything that may happen as a result of using this code.
+#' @return NULL
+#' @noRd
+aqs_ratelimit <- function(waittime=5L)
+{
+  Sys.sleep(waittime)
+}

R/setupfunctions.R

@@ -65,7 +65,7 @@ aqs_credentials <- function(username = NA_character_, key = NA_character_)
 #' @note The '@' character needs to be escaped with the '/' character.
 #' @importFrom glue glue
 #' @importFrom magrittr `%>%`
-#' @importFrom httr GET
+#' @importFrom httr2 request
 #' @importFrom glue glue
 #' @examples # to register a new user or generate a new key with the email
 #'           #  address "John.Doe/@myemail.com"
@@ -76,9 +76,18 @@ aqs_credentials <- function(username = NA_character_, key = NA_character_)
 #' @export
 aqs_sign_up <- function(email)
 { #nocov start
+  #We do not want aqs_sign_up registering new users as part of
+  #the unit testing procedures.
 
-  url <- glue("https://aqs.epa.gov/data/api/signup?email={email}")
-  httr::GET(url)
+  # user_agent <- glue("User:{email} via RAQSAPI-{packageVersion('RAQSAPI')}
+  #                     library for R")
+
+  url <- glue("https://aqs.epa.gov/data/api/signup?email={email}") %>%
+    request() %>%
+    req_perform()
+  #for some reason user_agent isn't working
+  #%>%
+  #req_user_agent(string = user_agent)
   glue("A verification email will be sent to {email}  \n") %>%
     message()
 } #nocov end