diff --git a/NAMESPACE b/NAMESPACE index 701cb57..4f2e74a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,7 @@ importFrom(S7,class_list) importFrom(cli,cli_abort) importFrom(cli,cli_warn) importFrom(desc,desc) +importFrom(dplyr,coalesce) importFrom(dplyr,filter) importFrom(fs,file_delete) importFrom(fs,file_exists) @@ -25,7 +26,8 @@ importFrom(lubridate,now) importFrom(lubridate,parse_date_time) importFrom(nectar,call_api) importFrom(nectar,stabilize_string) -importFrom(purrr,imap_chr) +importFrom(purrr,discard) +importFrom(purrr,imap) importFrom(purrr,list_rbind) importFrom(purrr,map) importFrom(purrr,map2) @@ -44,7 +46,9 @@ importFrom(rlang,try_fetch) importFrom(rprojroot,find_package_root_file) importFrom(snakecase,to_snake_case) importFrom(stringr,str_remove) +importFrom(stringr,str_replace_all) importFrom(stringr,str_squish) +importFrom(stringr,str_to_sentence) importFrom(styler,style_file) importFrom(testthat,test_that) importFrom(tibble,as_tibble) diff --git a/R/beekeeper-package.R b/R/beekeeper-package.R index d870576..c83493f 100644 --- a/R/beekeeper-package.R +++ b/R/beekeeper-package.R @@ -5,6 +5,7 @@ #' @importFrom cli cli_abort #' @importFrom cli cli_warn #' @importFrom desc desc +#' @importFrom dplyr coalesce #' @importFrom dplyr filter #' @importFrom fs file_delete #' @importFrom fs file_exists @@ -20,7 +21,8 @@ #' @importFrom lubridate parse_date_time #' @importFrom nectar call_api #' @importFrom nectar stabilize_string -#' @importFrom purrr imap_chr +#' @importFrom purrr discard +#' @importFrom purrr imap #' @importFrom purrr list_rbind #' @importFrom purrr map #' @importFrom purrr map_chr @@ -42,7 +44,9 @@ #' @importFrom S7 class_list #' @importFrom snakecase to_snake_case #' @importFrom stringr str_remove +#' @importFrom stringr str_replace_all #' @importFrom stringr str_squish +#' @importFrom stringr str_to_sentence #' @importFrom styler style_file #' @importFrom testthat test_that #' @importFrom tibble as_tibble diff --git a/R/generate_pkg-paths.R b/R/generate_pkg-paths.R index b671009..5d0a820 100644 --- a/R/generate_pkg-paths.R +++ b/R/generate_pkg-paths.R @@ -19,49 +19,7 @@ return(paths_file_paths) } -.generate_paths_files <- function(paths_by_tag, api_abbr, security_data) { - paths_file_paths <- imap_chr( - paths_by_tag, - function(path_tag, path_tag_name) { - .generate_paths_file(path_tag, path_tag_name, api_abbr, security_data) - } - ) - paths_test_paths <- imap_chr( - paths_by_tag, - function(path_tag, path_tag_name) { - .generate_paths_test_file(path_tag, path_tag_name, api_abbr) - } - ) - return(c(unname(paths_file_paths), unname(paths_test_paths))) -} - -.generate_paths_file <- function(path_tag, - path_tag_name, - api_abbr, - security_data) { - .bk_use_template( - template = "paths.R", - data = list( - paths = path_tag, - api_abbr = api_abbr, - security_data = security_data - ), - target = glue("paths-{path_tag_name}.R") - ) -} - -.generate_paths_test_file <- function(path_tag, path_tag_name, api_abbr) { - .bk_use_template( - template = "test-paths.R", - data = list( - paths = path_tag, - tag = path_tag_name, - api_abbr = api_abbr - ), - dir = "tests/testthat", - target = glue("test-paths-{path_tag_name}.R") - ) -} +# reshape data ----------------------------------------------------------------- S7::method(as_bk_data, class_paths) <- function(x) { if (!length(x)) { @@ -81,6 +39,7 @@ S7::method(as_bk_data, class_paths) <- function(x) { ) } +## to tag list ----------------------------------------------------------------- .paths_to_tag_list <- function(paths_tags_df) { set_names( map( @@ -94,50 +53,91 @@ S7::method(as_bk_data, class_paths) <- function(x) { .paths_endpoints_to_lists <- function(endpoints) { pmap( list( - operation_id = endpoints$operation_id, + operation_id = .paths_fill_operation_id( + endpoints$operation_id, + endpoints$endpoint, + endpoints$operation + ), path = endpoints$endpoint, - summary = endpoints$summary, - description = endpoints$description, - params = endpoints$parameters + summary = .paths_fill_summary( + endpoints$summary, + endpoints$endpoint, + endpoints$operation + ), + description = str_squish(endpoints$description), + params_df = endpoints$parameters ), .paths_endpoint_to_list ) } +### fill data ------------------------------------------------------------------ + +.paths_fill_operation_id <- function(operation_id, endpoint, method) { + coalesce(.to_snake(operation_id), glue("{method}_{.to_snake(endpoint)}")) +} + +.paths_fill_summary <- function(summary, endpoint, method) { + endpoint_spaced <- str_replace_all(.to_snake(endpoint), "_", " ") + coalesce( + str_squish(summary), + str_to_sentence(glue("{method} {endpoint_spaced}")) + ) +} + +### create whisker data -------------------------------------------------------- + .paths_endpoint_to_list <- function(operation_id, path, summary, description, - params) { - params_df <- .flatten_df(params) - params <- .paths_params_to_list(params_df) - endpoint_list <- list( - operation_id = .to_snake(operation_id), - path = .path_as_arg(path, params_df), - summary = str_squish(summary), - description = str_squish(description), - params = params + params_df) { + params_df <- .prepare_paths_df(params_df) + return( + list( + operation_id = operation_id, + path = .path_as_arg(path, params_df), + summary = summary, + description = description, + params = .params_to_list(params_df), + params_query = .extract_params_type(params_df, "query"), + params_header = .extract_params_type(params_df, "header"), + params_cookie = .extract_params_type(params_df, "cookie") + ) ) - endpoint_list$args <- .collapse_comma(params_df$name) - endpoint_list$test_args <- endpoint_list$args - return(endpoint_list) } -.paths_params_to_list <- function(params) { - if (!nrow(params)) { +.prepare_paths_df <- function(params_df) { + params_df <- .flatten_df(params_df) + if (nrow(params_df)) { + params_df <- filter(params_df, !.data$deprecated) + params_df$description <- .paths_fill_descriptions(params_df$description) + } + return(params_df) +} + +.params_to_list <- function(params_df) { + if (!nrow(params_df)) { return(list()) } # TODO: Deal with all the available data. params <- pmap( list( - name = params$name, - description = .paths_fill_descriptions(params$description) + name = params_df$name, + description = params_df$description ), .paths_param_to_list ) return(params) } +.extract_params_type <- function(params_df, filter_in) { + if (!nrow(params_df)) { + return(character()) + } + return(params_df$name[params_df$`in` == filter_in]) +} + .paths_fill_descriptions <- function(descriptions) { descriptions[is.na(descriptions)] <- "BKTODO: No description provided." return(str_squish(descriptions)) @@ -154,7 +154,103 @@ S7::method(as_bk_data, class_paths) <- function(x) { if (!nrow(params_df) || !any(params_df$`in` == "path")) { return(glue('"{path}"')) } - params_in <- params_df$name[params_df$`in` == "path"] - params <- .collapse_comma(glue("{params_in} = {params_in}")) + params_path <- params_df$name[params_df$`in` == "path"] + params <- .collapse_comma_self_equal(params_path) return(glue('c("{path}", {params})')) } + +.collapse_comma_self_equal <- function(x) { + .collapse_comma(glue("{x} = {x}")) +} + +# generate files ---------------------------------------------------------- + +.generate_paths_files <- function(paths_by_tag, api_abbr, security_data) { + unlist(imap( + paths_by_tag, + function(path_tag, path_tag_name) { + .generate_paths_tag_files( + path_tag, + path_tag_name, + api_abbr, + security_data + ) + } + )) +} + +.generate_paths_tag_files <- function(path_tag, + path_tag_name, + api_abbr, + security_data) { + path_tag <- .prepare_path_tag( + path_tag, + security_data$security_arg_names + ) + file_path <- .generate_paths_file( + path_tag, + path_tag_name, + api_abbr, + security_data + ) + test_path <- .generate_paths_test_file(path_tag, path_tag_name, api_abbr) + return(c(unname(file_path), unname(test_path))) +} + +.prepare_path_tag <- function(path_tag, security_args) { + path_tag <- map( + path_tag, + function(path) { + path$params <- .remove_security_args(path$params, security_args) + path$params_cookie <- .prep_param_args(path$params_cookie, security_args) + path$params_header <- .prep_param_args(path$params_header, security_args) + path$params_query <- .prep_param_args(path$params_query, security_args) + path$args <- .collapse_comma(map_chr(path$params, "name")) + path$test_args <- path$args + return(path) + } + ) +} + +.remove_security_args <- function(params, security_args) { + discard( + params, + function(param) { + param$name %in% security_args + } + ) +} + +.prep_param_args <- function(params, security_args) { + .collapse_comma_self_equal(setdiff(params, security_args)) %|"|% character() +} + +.generate_paths_file <- function(path_tag, + path_tag_name, + api_abbr, + security_data) { + .bk_use_template( + template = "paths.R", + data = list( + paths = path_tag, + api_abbr = api_abbr, + has_security = security_data$has_security, + security_signature = security_data$security_signature, + security_arg_list = security_data$security_arg_list + ), + target = glue("paths-{path_tag_name}.R") + ) +} + +.generate_paths_test_file <- function(path_tag, path_tag_name, api_abbr) { + .bk_use_template( + template = "test-paths.R", + data = list( + paths = path_tag, + tag = path_tag_name, + api_abbr = api_abbr + ), + dir = "tests/testthat", + target = glue("test-paths-{path_tag_name}.R") + ) +} diff --git a/R/utils.R b/R/utils.R index c80ac4c..7676e88 100644 --- a/R/utils.R +++ b/R/utils.R @@ -6,6 +6,14 @@ } } +`%|"|%` <- function(x, y) { + if (!nzchar(x)) { + y + } else { + x + } +} + .collapse_comma <- function(x) { glue_collapse(x, sep = ", ") } diff --git a/inst/templates/paths.R b/inst/templates/paths.R index 09264f1..5da5ade 100644 --- a/inst/templates/paths.R +++ b/inst/templates/paths.R @@ -14,7 +14,10 @@ #' @export {{api_abbr}}_{{operation_id}} <- function({{{args}}}{{{security_signature}}}) { {{api_abbr}}_call_api( - path = {{{path}}} + path = {{{path}}}{{#has_security}}, + {{security_arg_list}}{{/has_security}}{{#params_query}}, + query = list({{params_query}}){{/params_query}}{{#params_header}}, + body = list({{params_header}}){{/params_header}} ) } diff --git a/tests/testthat/_fixtures/000-create_fixtures.R b/tests/testthat/_fixtures/000-create_fixtures.R index f1a6b64..d8c9150 100644 --- a/tests/testthat/_fixtures/000-create_fixtures.R +++ b/tests/testthat/_fixtures/000-create_fixtures.R @@ -14,8 +14,34 @@ apid_url <- "https://api.apis.guru/v2/specs/fec.gov/1.0/openapi.yaml" api_abbr <- "fec" rapid_write_path <- test_path(glue::glue("_fixtures/{api_abbr}_rapid.rds")) config_path <- test_path(glue::glue("_fixtures/{api_abbr}_beekeeper.yml")) -apid_url |> +fec_apid <- apid_url |> url() |> + yaml::read_yaml() +fec_apid$security <- list( + list(ApiKeyHeaderAuth = list(), ApiKeyQueryAuth = list()) +) +fec_apid$components$securitySchemes <- list( + ApiKeyHeaderAuth = list(`in` = "header", name = "X-Api-Key", type = "apiKey"), + ApiKeyQueryAuth = list(`in` = "query", name = "api_key", type = "apiKey") +) +cli::cli_warn("FEC APID manually cleaned to remove duplicate security scheme.") +fec_rapid <- rapid::as_rapid(fec_apid) +fec_rapid |> + use_beekeeper( + api_abbr = api_abbr, + config_file = config_path, + rapid_file = rapid_write_path + ) +fec_rapid@paths <- rapid::as_paths({ + fec_rapid@paths |> + tibble::as_tibble() |> + tidyr::hoist(operations, tags = "tags", .remove = FALSE) |> + dplyr::filter(tags %in% c("audit", "debts", "legal")) |> + dplyr::select(-tags) +}) +rapid_write_path <- test_path(glue::glue("_fixtures/{api_abbr}_subset_rapid.rds")) +config_path <- test_path(glue::glue("_fixtures/{api_abbr}_subset_beekeeper.yml")) +fec_rapid |> use_beekeeper( api_abbr = api_abbr, config_file = config_path, @@ -34,4 +60,4 @@ apid_url |> rapid_file = rapid_write_path ) -warning("Revert .Rbuildignore") +cli::cli_warn("Revert .Rbuildignore") diff --git a/tests/testthat/_fixtures/fec-paths-audit.R b/tests/testthat/_fixtures/fec-paths-audit.R new file mode 100644 index 0000000..b88fe2e --- /dev/null +++ b/tests/testthat/_fixtures/fec-paths-audit.R @@ -0,0 +1,126 @@ +# These functions were generated by the {beekeeper} package, based on the paths +# element from the source API description. You should carefully review these +# functions. Missing documentation is tagged with "BKTODO" to make it easier for +# you to search for issues. + +#' Get audit case +#' +#' This endpoint contains Final Audit Reports approved by the Commission since inception. The search can be based on information about the audited committee (Name, FEC ID Number, Type, Election Cycle) or the issues covered in the report. +#' +#' @inheritParams fec_call_api +#' @param audit_case_id Primary/foreign key for audit tables +#' @param cycle Filter records to only those that are applicable to a given two-year period. This cycle follows the traditional House election cycle and subdivides the presidential and Senate elections into comparable two-year blocks. The cycle begins with an odd year and is named for its ending, even year. +#' @param sub_category_id The finding id of an audit. Finding are a category of broader issues. Each category has an unique ID. +#' @param sort_nulls_last Toggle that sorts null values last +#' @param sort_hide_null Hide null values on sorted column(s). +#' @param min_election_cycle Filter records to only those that are applicable to a given two-year period. This cycle follows the traditional House election cycle and subdivides the presidential and Senate elections into comparable two-year blocks. The cycle begins with an odd year and is named for its ending, even year. +#' @param audit_id The audit issue. Each subcategory has an unique ID +#' @param q The name of the committee. If a committee changes its name, the most recent name will be shown. Committee names are not unique. Use committee_id for looking up records. +#' @param per_page The number of results returned per page. Defaults to 20. +#' @param max_election_cycle Filter records to only those that are applicable to a given two-year period. This cycle follows the traditional House election cycle and subdivides the presidential and Senate elections into comparable two-year blocks. The cycle begins with an odd year and is named for its ending, even year. +#' @param candidate_id A unique identifier assigned to each candidate registered with the FEC. If a person runs for several offices, that person will have separate candidate IDs for each office. +#' @param committee_type The one-letter type code of the organization: - C communication cost - D delegate - E electioneering communication - H House - I independent expenditure filer (not a committee) - N PAC - nonqualified - O independent expenditure-only (super PACs) - P presidential - Q PAC - qualified - S Senate - U single candidate independent expenditure - V PAC with non-contribution account, nonqualified - W PAC with non-contribution account, qualified - X party, nonqualified - Y party, qualified - Z national party non-federal account +#' @param qq Name of candidate running for office +#' @param page For paginating through results, starting at page 1 +#' @param committee_id A unique identifier assigned to each committee or filer registered with the FEC. In general committee id's begin with the letter C which is followed by eight digits. +#' @param committee_designation Type of committee: - H or S - Congressional - P - Presidential - X or Y or Z - Party - N or Q - PAC - I - Independent expenditure - O - Super PAC +#' @param primary_category_id Audit category ID (table PK) +#' @param sort_null_only Toggle that filters out all rows having sort column that is non-null +#' @param sort Provide a field to sort by. Use `-` for descending order. ex: `-case_no` +#' @return BKTODO: Return descriptions are not yet implemented in beekeeper +#' @export +fec_get_audit_case <- function( + audit_case_id, cycle, sub_category_id, sort_nulls_last, sort_hide_null, min_election_cycle, audit_id, q, per_page, max_election_cycle, candidate_id, committee_type, qq, page, committee_id, committee_designation, primary_category_id, sort_null_only, sort, + api_key = Sys.getenv("FEC_API_KEY")) { + fec_call_api( + path = "/audit-case/", + api_key = api_key, + query = list(audit_case_id = audit_case_id, cycle = cycle, sub_category_id = sub_category_id, sort_nulls_last = sort_nulls_last, sort_hide_null = sort_hide_null, min_election_cycle = min_election_cycle, audit_id = audit_id, q = q, per_page = per_page, max_election_cycle = max_election_cycle, candidate_id = candidate_id, committee_type = committee_type, qq = qq, page = page, committee_id = committee_id, committee_designation = committee_designation, primary_category_id = primary_category_id, sort_null_only = sort_null_only, sort = sort) + ) +} + +#' Get audit category +#' +#' This lists the options for the categories and subcategories available in the /audit-search/ endpoint. +#' +#' @inheritParams fec_call_api +#' @param sort_nulls_last Toggle that sorts null values last +#' @param page For paginating through results, starting at page 1 +#' @param primary_category_name Primary Audit Category - No Findings or Issues/Not a Committee - Net Outstanding Campaign/Convention Expenditures/Obligations - Payments/Disgorgements - Allocation Issues - Prohibited Contributions - Disclosure - Recordkeeping - Repayment to US Treasury - Other - Misstatement of Financial Activity - Excessive Contributions - Failure to File Reports/Schedules/Notices - Loans - Referred Findings Not Listed +#' @param sort_hide_null Hide null values on sorted column(s). +#' @param primary_category_id Audit category ID (table PK) +#' @param sort_null_only Toggle that filters out all rows having sort column that is non-null +#' @param per_page The number of results returned per page. Defaults to 20. +#' @param sort Provide a field to sort by. Use `-` for descending order. +#' @return BKTODO: Return descriptions are not yet implemented in beekeeper +#' @export +fec_get_audit_category <- function( + sort_nulls_last, page, primary_category_name, sort_hide_null, primary_category_id, sort_null_only, per_page, sort, + api_key = Sys.getenv("FEC_API_KEY")) { + fec_call_api( + path = "/audit-category/", + api_key = api_key, + query = list(sort_nulls_last = sort_nulls_last, page = page, primary_category_name = primary_category_name, sort_hide_null = sort_hide_null, primary_category_id = primary_category_id, sort_null_only = sort_null_only, per_page = per_page, sort = sort) + ) +} + +#' Get audit primary category +#' +#' This lists the options for the primary categories available in the /audit-search/ endpoint. +#' +#' @inheritParams fec_call_api +#' @param sort_nulls_last Toggle that sorts null values last +#' @param page For paginating through results, starting at page 1 +#' @param primary_category_name Primary Audit Category - No Findings or Issues/Not a Committee - Net Outstanding Campaign/Convention Expenditures/Obligations - Payments/Disgorgements - Allocation Issues - Prohibited Contributions - Disclosure - Recordkeeping - Repayment to US Treasury - Other - Misstatement of Financial Activity - Excessive Contributions - Failure to File Reports/Schedules/Notices - Loans - Referred Findings Not Listed +#' @param sort_hide_null Hide null values on sorted column(s). +#' @param primary_category_id Audit category ID (table PK) +#' @param sort_null_only Toggle that filters out all rows having sort column that is non-null +#' @param per_page The number of results returned per page. Defaults to 20. +#' @param sort Provide a field to sort by. Use `-` for descending order. +#' @return BKTODO: Return descriptions are not yet implemented in beekeeper +#' @export +fec_get_audit_primary_category <- function( + sort_nulls_last, page, primary_category_name, sort_hide_null, primary_category_id, sort_null_only, per_page, sort, + api_key = Sys.getenv("FEC_API_KEY")) { + fec_call_api( + path = "/audit-primary-category/", + api_key = api_key, + query = list(sort_nulls_last = sort_nulls_last, page = page, primary_category_name = primary_category_name, sort_hide_null = sort_hide_null, primary_category_id = primary_category_id, sort_null_only = sort_null_only, per_page = per_page, sort = sort) + ) +} + +#' Get names audit candidates +#' +#' Search for candidates or committees by name. If you're looking for information on a particular person or group, using a name to find the `candidate_id` or `committee_id` on this endpoint can be a helpful first step. +#' +#' @inheritParams fec_call_api +#' @param q Name (candidate or committee) to search for +#' @return BKTODO: Return descriptions are not yet implemented in beekeeper +#' @export +fec_get_names_audit_candidates <- function( + q, + api_key = Sys.getenv("FEC_API_KEY")) { + fec_call_api( + path = "/names/audit_candidates/", + api_key = api_key, + query = list(q = q) + ) +} + +#' Get names audit committees +#' +#' Search for candidates or committees by name. If you're looking for information on a particular person or group, using a name to find the `candidate_id` or `committee_id` on this endpoint can be a helpful first step. +#' +#' @inheritParams fec_call_api +#' @param q Name (candidate or committee) to search for +#' @return BKTODO: Return descriptions are not yet implemented in beekeeper +#' @export +fec_get_names_audit_committees <- function( + q, + api_key = Sys.getenv("FEC_API_KEY")) { + fec_call_api( + path = "/names/audit_committees/", + api_key = api_key, + query = list(q = q) + ) +} diff --git a/tests/testthat/_fixtures/fec_rapid.rds b/tests/testthat/_fixtures/fec_rapid.rds index c2d0b52..156bb72 100644 Binary files a/tests/testthat/_fixtures/fec_rapid.rds and b/tests/testthat/_fixtures/fec_rapid.rds differ diff --git a/tests/testthat/_fixtures/fec_subset_beekeeper.yml b/tests/testthat/_fixtures/fec_subset_beekeeper.yml new file mode 100644 index 0000000..d96c732 --- /dev/null +++ b/tests/testthat/_fixtures/fec_subset_beekeeper.yml @@ -0,0 +1,5 @@ +api_title: OpenFEC +api_abbr: fec +api_version: '1.0' +rapid_file: fec_subset_rapid.rds +updated_on: 2024-03-29 19:53:51.997502 diff --git a/tests/testthat/_fixtures/fec_subset_rapid.rds b/tests/testthat/_fixtures/fec_subset_rapid.rds new file mode 100644 index 0000000..32aede0 Binary files /dev/null and b/tests/testthat/_fixtures/fec_subset_rapid.rds differ diff --git a/tests/testthat/_snaps/generate_pkg-paths.md b/tests/testthat/_snaps/generate_pkg-paths.md new file mode 100644 index 0000000..d821aed --- /dev/null +++ b/tests/testthat/_snaps/generate_pkg-paths.md @@ -0,0 +1,11 @@ +# generate_pkg() generates path functions for fec + + Code + scrub_path(changed_files) + Output + [1] "/R/010-call.R" "/tests/testthat/test-010-call.R" + [3] "/R/020-security.R" "/R/paths-audit.R" + [5] "/tests/testthat/test-paths-audit.R" "/R/paths-legal.R" + [7] "/tests/testthat/test-paths-legal.R" "/R/paths-debts.R" + [9] "/tests/testthat/test-paths-debts.R" "/tests/testthat/setup.R" + diff --git a/tests/testthat/test-generate_pkg-paths.R b/tests/testthat/test-generate_pkg-paths.R index 3ff9a47..da1f072 100644 --- a/tests/testthat/test-generate_pkg-paths.R +++ b/tests/testthat/test-generate_pkg-paths.R @@ -54,3 +54,23 @@ test_that("generate_pkg() generates test setup file for guru", { generated_file_content <- readLines("tests/testthat/setup.R") expect_identical(generated_file_content, expected_file_content) }) + +test_that("generate_pkg() generates path functions for fec", { + # 19 tags, more complicated security + skip_on_cran() + config <- readLines(test_path("_fixtures", "fec_subset_beekeeper.yml")) + fec_rapid <- readRDS(test_path("_fixtures", "fec_subset_rapid.rds")) + expected_file_content <- readLines( + test_path("_fixtures", "fec-paths-audit.R") + ) + + create_local_package() + writeLines(config, "_beekeeper.yml") + saveRDS(fec_rapid, "fec_subset_rapid.rds") + + changed_files <- generate_pkg(pkg_agent = "TESTPKG (https://example.com)") + expect_snapshot(scrub_path(changed_files)) + + generated_file_content <- readLines("R/paths-audit.R") + expect_identical(generated_file_content, expected_file_content) +})