diff --git a/.github/workflows/test-build.yaml b/.github/workflows/test-build.yaml index 8c18dd7d..fa5319a5 100644 --- a/.github/workflows/test-build.yaml +++ b/.github/workflows/test-build.yaml @@ -21,10 +21,10 @@ jobs: # Define operating systems matrix: config: - - {os: windows-latest, r: 'release'} + # - {os: windows-latest, r: 'release'} - {os: macOS-latest, r: 'release'} - - {os: ubuntu-16.04, r: '3.6.3'} # Boydorr Server - - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} + # - {os: ubuntu-16.04, r: '3.6.3'} # Boydorr Server + # - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"} steps: # Checkout repo @@ -55,6 +55,12 @@ jobs: key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }} restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1- + # Install local registry + - name: Install registry + run: | + /bin/bash -c "$(curl -fsSL https://data.scrc.uk/static/localregistry.sh)" + shell: bash + # Install system_requirements requirements on macOS - name: Install system requirements (macOS-latest) if: runner.os == 'macOS' @@ -64,16 +70,6 @@ jobs: brew install gdal shell: bash - # Install system_requirements on ubuntu 16.04 (Boydorr) - - name: Install system requirements (ubuntu-16.04) - if: matrix.config.os == 'ubuntu-16.04' - run : | - while read -r cmd - do - eval sudo $cmd - done < <(Rscript -e 'cat(remotes::system_requirements("ubuntu", "16.04"), sep = "\n")') - shell: bash - # Install system requirements on ubuntu 20.04 - name: Install system requirements (ubuntu-20.04) if: matrix.config.os == 'ubuntu-20.04' @@ -91,30 +87,14 @@ jobs: remotes::install_cran("rcmdcheck") shell: Rscript {0} - # Run CMD check on all but Boydorr (convert2grid test will fail on Boydorr) - # Use SCRC_API_TOKEN (PAT from Jonathan Hollocombe) to interact with the data - # registry - - name: Check (All but Boydorr) - if: matrix.config.os != 'ubuntu-16.04' + # Run CMD check + - name: Run CMD check env: _R_CHECK_CRAN_INCOMING_REMOTE_: false - SCRC_API_TOKEN: ${{ secrets.SCRC_API_TOKEN }} R_CHECK_SYSTEM_CLOCK: 0 run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check") shell: Rscript {0} - # Run CMD check on Boydorr usinging BOYDORR: "TRUE" to skip convert2grid test - # Use SCRC_API_TOKEN (PAT from Jonathan Hollocombe) to interact with the data - # registry - - name: Check (Boydorr) - if: matrix.config.os == 'ubuntu-16.04' - env: - _R_CHECK_CRAN_INCOMING_REMOTE_: false - SCRC_API_TOKEN: ${{ secrets.SCRC_API_TOKEN }} - BOYDORR: "TRUE" - run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check") - shell: Rscript {0} - # If anything fails upload results to artifacts - name: Upload check results if: failure() @@ -122,89 +102,3 @@ jobs: with: name: ${{ runner.os }}-r${{ matrix.config.r }}-results path: check - -# Coverage ------------------------------------------------------------------ -# Located within the macOS-latest (release) job - - - name: Test coverage (setup) - # Only when main is pushed - if: github.event_name == 'push' && github.ref == 'refs/heads/main' && runner.os == 'macOS' - # Use the default GITHUB_TOKEN as an enviromental version for all steps - env: - GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - # Setup keychain needed to cache github token for upload_toml_to_github test - uses: sinoru/actions-setup-keychain@v1.0 - - # Add github Personal Access Token to keychain: - # * Needed for upload_toml_to_github test - # * Echoes to git credential-osxkeychain - # * This emulate stdin() line by line - - name: Add credentials in keychain - if: github.event_name == 'push' && github.ref == 'refs/heads/main' && runner.os == 'macOS' - env: - GITHUB_TOKEN: ${{ secrets.SCRC_API_PAT }} - run: | - echo "\ - protocol=https - host=github.com - username=Personal Access Token - password=$GITHUB_TOKEN" | git credential-osxkeychain store - - # Run code coverage with RUN_TEST to enable upload_toml_to_github test - # Use SCRC_API_TOKEN (PAT from Jonathan Hollocombe) to interact with the data - # registry - - name: Test coverage - if: github.event_name == 'push' && github.ref == 'refs/heads/main' && runner.os == 'macOS' - env: - SCRC_API_TOKEN: ${{ secrets.SCRC_API_TOKEN }} - RUN_TEST: "TRUE" - run: | - remotes::install_cran("covr") - covr::codecov() - shell: Rscript {0} - -# Build and deploy DOCS ----------------------------------------------------- -# Located within the macOS-latest (release) job - - - name: Build and deploy docs (setup) - # Only when main is pushed - if: github.event_name == 'push' && github.ref == 'refs/heads/main' && runner.os == 'macOS' - # Setup pandoc needed to build docs - uses: r-lib/actions/setup-pandoc@v1 - - # Install Mac OS requirements - - name: Build and deploy docs (system requirements) - if: github.event_name == 'push' && github.ref == 'refs/heads/main' && runner.os == 'macOS' - run : | - brew install harfbuzz - brew install fribidi - shell: bash - - # Build documentation with pkgdown - - name: Build Docs - if: github.event_name == 'push' && github.ref == 'refs/heads/mains' && runner.os == 'macOS' - run: | - install.packages("pkgdown") - pkgdown::build_site() - shell: Rscript {0} - - # Create a development branch and commit to it - - name: Commit to development branch - if: github.event_name == 'push' && github.ref == 'refs/heads/main' && runner.os == 'macOS' - run: | - git checkout -b development - git add . - git commit -m '[skip ci]' - shell: bash - - # Deploy the docs using JamesIves/github-pages-deploy-action - - name: Deploy Docs - if: github.event_name == 'push' && github.ref == 'refs/heads/main' && runner.os == 'macOS' - uses: JamesIves/github-pages-deploy-action@releases/v3 - with: - GITHUB_TOKEN: ${{ secrets.SCRC_API_PAT }} - BASE_BRANCH: development - BRANCH: main # The branch the action should deploy to. - FOLDER: docs # The folder the action should deploy. - TARGET_FOLDER: docs - COMMIT_MESSAGE: 'build docs [skip ci]' diff --git a/R/fair_pull.R b/R/fair_pull.R index 9868b187..8b6c8572 100644 --- a/R/fair_pull.R +++ b/R/fair_pull.R @@ -1,10 +1,12 @@ #' fair_pull #' #' @param path path +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @export #' -fair_pull <- function(path = "config.yaml") { +fair_pull <- function(path = "config.yaml", + endpoint = "http://localhost:8000/api/") { run_server() @@ -47,7 +49,8 @@ fair_pull <- function(path = "config.yaml") { # Download raw data to data store and register in data registry for (i in seq_along(register)) { register_external_object(yaml = yaml, - register_this = register[[i]]) + register_this = register[[i]], + endpoint = endpoint) } } diff --git a/R/fair_run.R b/R/fair_run.R index 6b700587..2a6f97d2 100644 --- a/R/fair_run.R +++ b/R/fair_run.R @@ -2,10 +2,13 @@ #' #' @param path string #' @param skip don't bother checking whether the repo is clean +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @export #' -fair_run <- function(path = "config.yaml", skip = FALSE) { +fair_run <- function(path = "config.yaml", + endpoint = "http://localhost:8000/api/", + skip = FALSE) { run_server() @@ -156,7 +159,8 @@ fair_run <- function(path = "config.yaml", skip = FALSE) { entries <- get_entry("data_product", list(name = write_dataproduct, - namespace = write_namespace_id)) + namespace = write_namespace_id), + endpoint = endpoint) if (is.null(entries)) { write_version <- "0.0.1" diff --git a/R/get_entry.R b/R/get_entry.R index f9d637b1..232cfa19 100644 --- a/R/get_entry.R +++ b/R/get_entry.R @@ -22,8 +22,10 @@ get_entry <- function(table, query, endpoint = "http://localhost:8000/api/") { is_queryable(table, query) - output <- httr::GET(paste0(endpoint, table, ""), - query = query, + api_url <- paste0(endpoint, table) + api_url <- file.path(dirname(api_url), basename(api_url), "") + + output <- httr::GET(api_url, query = query, httr::add_headers(.headers = h)) %>% httr::content(as = "text", encoding = "UTF-8") %>% jsonlite::fromJSON(simplifyVector = FALSE) diff --git a/R/get_existing.R b/R/get_existing.R index d87cf270..aa1ce011 100644 --- a/R/get_existing.R +++ b/R/get_existing.R @@ -7,6 +7,7 @@ #' the results, default is \code{TRUE} #' @param detail a \code{string} specifying what level of detail to return; #' options are \code{"all"} for all details or \code{"id"} for just URL and IDs +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @return Returns a \code{data.frame} of entries in table, default is limited #' to 100 entries @@ -24,7 +25,10 @@ #' get_existing("data_product") #' } #' -get_existing <- function(table, limit_results = TRUE, detail = "all") { +get_existing <- function(table, + limit_results = TRUE, + detail = "all", + endpoint = "http://localhost:8000/api/") { if (!check_table_exists(table)) usethis::ui_stop(paste( @@ -34,11 +38,13 @@ get_existing <- function(table, limit_results = TRUE, detail = "all") { key <- get_token() h <- c(Authorization = paste("token", key)) + api_url <- paste0(endpoint, table) + api_url <- file.path(dirname(api_url), basename(api_url), "") + tryCatch({ # Get the 100 newest results - output <- httr::GET(paste("http://localhost:8000/api", table, "", - sep = "/"), + output <- httr::GET(api_url, httr::add_headers(.headers = h)) %>% httr::content(as = "text", encoding = "UTF-8") %>% jsonlite::fromJSON(simplifyVector = FALSE) diff --git a/R/get_fields.R b/R/get_fields.R index 74e17c43..2fb2084e 100644 --- a/R/get_fields.R +++ b/R/get_fields.R @@ -3,13 +3,15 @@ #' Use API endpoint to produce a list of fields for a table. Requires API key. #' #' @param table a \code{string} specifying the name of the table +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @return Returns a \code{data.frame} of fields and their attributes set to #' "none" +#' #' @export #' @keywords internal #' -get_fields <- function(table){ +get_fields <- function(table, endpoint = "http://localhost:8000/api/"){ # Users and Groups are valid tables but cannot be posted to if (table == "users" | table == "groups") @@ -19,9 +21,11 @@ get_fields <- function(table){ key <- get_token() h <- c(Authorization = paste("token", key)) + api_url <- paste0(endpoint, table) + api_url <- file.path(dirname(api_url), basename(api_url), "") + # Perform an options request - out <- httr::VERB("OPTIONS", paste("http://localhost:8000/api", table, "", - sep = "/"), + out <- httr::VERB("OPTIONS", api_url, httr::add_headers(.headers = h)) %>% httr::content(as = "text", encoding = "UTF-8") %>% jsonlite::fromJSON(simplifyVector = FALSE) diff --git a/R/get_table_optional.R b/R/get_table_optional.R index 2dc0aac0..fb862818 100644 --- a/R/get_table_optional.R +++ b/R/get_table_optional.R @@ -1,15 +1,16 @@ #' Get optional fields #' #' @param table a \code{string} specifying the name of the table +#' @param endpoint a \code{string} specifying the registry endpoint #' -#' @return Returns a \code{data.frame} of optional fields and thier properties +#' @return Returns a \code{data.frame} of optional fields and their properties #' @export #' @keywords internal #' -get_table_optional <- function(table){ +get_table_optional <- function(table, endpoint){ # if(! check_table_exists(table)) # stop("Unknown Table") - optional <- get_fields(table) %>% + optional <- get_fields(table, endpoint) %>% filter(!.data$read_only) %>% filter(!.data$required) } diff --git a/R/get_table_queryable.R b/R/get_table_queryable.R index 7a66180c..cd9b09d4 100644 --- a/R/get_table_queryable.R +++ b/R/get_table_queryable.R @@ -1,14 +1,18 @@ #' Get queryable fields #' #' @param table a \code{string} specifying the name of the table +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @return Returns a character vector of queryable fields #' @export #' @keywords internal #' -get_table_queryable <- function(table) { - out <- httr::VERB("OPTIONS", paste("http://localhost:8000/api", table, "", - sep = "/")) %>% +get_table_queryable <- function(table, endpoint) { + + api_url <- paste0(endpoint, table) + api_url <- file.path(dirname(api_url), basename(api_url), "") + + out <- httr::VERB("OPTIONS", api_url) %>% httr::content(as = "text", encoding = "UTF-8") %>% jsonlite::fromJSON(simplifyVector = FALSE) as.character(out$filter_fields) diff --git a/R/get_table_readable.R b/R/get_table_readable.R index 54bd2cc7..02c512c6 100644 --- a/R/get_table_readable.R +++ b/R/get_table_readable.R @@ -1,13 +1,14 @@ #' Get readable fields #' #' @param table name of table +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @return a dataframe of readable fields and their properties #' @export #' @keywords internal #' -get_table_readable <- function(table){ +get_table_readable <- function(table, endpoint){ # if(! check_table_exists(table)) # stop("Unknown Table") - readable <- get_fields(table) + readable <- get_fields(table, endpoint) } diff --git a/R/get_table_writable.R b/R/get_table_writable.R index 3e9924ed..0f0b1297 100644 --- a/R/get_table_writable.R +++ b/R/get_table_writable.R @@ -1,15 +1,16 @@ #' Get writable fields #' #' @param table a \code{string} specifying the name of the table +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @return Returns a character vector of writable fields #' @export #' @keywords internal #' -get_table_writable <- function(table){ +get_table_writable <- function(table, endpoint){ # if(!check_table_exists(table)) # stop("Unknown Table") - get_fields(table) %>% + get_fields(table, endpoint) %>% filter(!.data$read_only) } diff --git a/R/get_tables.R b/R/get_tables.R index 53104cf1..8996ac25 100644 --- a/R/get_tables.R +++ b/R/get_tables.R @@ -1,14 +1,15 @@ #' Get tables from registry #' #' Use api endpoint to produce a list of tables -#' @param live whether or not to get the tables directly from the API +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @return a character vector of tables #' @export #' @keywords internal #' -get_tables <- function(live = FALSE){ - httr::GET(paste("http://localhost:8000/api", "", sep = "/")) %>% +get_tables <- function(endpoint = "http://localhost:8000/api/"){ + + httr::GET(endpoint) %>% httr::content(as = "text", encoding = "UTF-8") %>% jsonlite::fromJSON(simplifyVector = FALSE) %>% names() diff --git a/R/new_author.R b/R/new_author.R index 3355c8fd..cfed56a1 100644 --- a/R/new_author.R +++ b/R/new_author.R @@ -7,6 +7,7 @@ #' and / or middle name and / or any initials #' @param identifier (optional) a \code{string} specifying the full URL of #' the \code{author}s identifier, *e.g.* ORCID iD +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @family new functions #' @@ -14,7 +15,8 @@ #' new_author <- function(family_name, given_name, - identifier) { + identifier, + endpoint = "http://localhost:8000/api/") { data <- list(family_name = family_name, given_name = given_name) @@ -23,5 +25,6 @@ new_author <- function(family_name, data$identifier <- identifier post_data(table = "author", - data = data) + data = data, + endpoint = endpoint) } diff --git a/R/new_code_repo_release.R b/R/new_code_repo_release.R index 77f82da8..f096e732 100644 --- a/R/new_code_repo_release.R +++ b/R/new_code_repo_release.R @@ -9,6 +9,7 @@ #' @param website (optional) a \code{string} specifying the URL of the #' website for this code release #' @param object_url a \code{string} specifying the URL of an \code{object} +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @family new functions #' @@ -17,7 +18,8 @@ new_code_repo_release <- function(name, version, object_url, - website) { + website, + endpoint = "http://localhost:8000/api/") { data <- list(name = name, version = version, @@ -27,5 +29,6 @@ new_code_repo_release <- function(name, data$website <- website post_data(table = "code_repo_release", - data = data) + data = data, + endpoint = endpoint) } diff --git a/R/new_code_run.R b/R/new_code_run.R index 5ef249c2..1bd721c9 100644 --- a/R/new_code_run.R +++ b/R/new_code_run.R @@ -18,6 +18,7 @@ #' \code{code_run} inputs #' @param outputs_urls a \code{list} of \code{object_component} URLs referencing #' \code{code_run} outputs +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @family new functions #' @@ -29,7 +30,8 @@ new_code_run <- function(run_date, model_config_url, submission_script_url, inputs_urls = list(), - outputs_urls = list()) { + outputs_urls = list(), + endpoint = "http://localhost:8000/api/") { data <- list(run_date = run_date, inputs = inputs_urls, @@ -48,5 +50,6 @@ new_code_run <- function(run_date, data$submission_script <- submission_script_url post_data(table = "code_run", - data = data) + data = data, + endpoint = endpoint) } diff --git a/R/new_data_product.R b/R/new_data_product.R index cfb4e065..c7d07ab9 100644 --- a/R/new_data_product.R +++ b/R/new_data_product.R @@ -9,6 +9,7 @@ #' \code{object} table #' @param namespace_url a \code{string} specifying the URL of the entry in the #' \code{namespace} table +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @family new functions #' @@ -17,11 +18,13 @@ new_data_product <- function(name, version, object_url, - namespace_url) { + namespace_url, + endpoint = "http://localhost:8000/api/") { post_data(table = "data_product", data = list(name = name, version = version, object = object_url, - namespace = namespace_url)) + namespace = namespace_url), + endpoint = endpoint) } diff --git a/R/new_external_object.R b/R/new_external_object.R index 4b414628..bb17a3cd 100644 --- a/R/new_external_object.R +++ b/R/new_external_object.R @@ -17,6 +17,7 @@ #' @param original_store_url (optional) a `string` specifying the URL of a #' an entry in the \code{storage_location} table that references the original #' location of an \code{external_object} +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @family new functions #' @@ -28,7 +29,8 @@ new_external_object <- function(doi_or_unique_name, title, description, data_product_url, - original_store_url) { + original_store_url, + endpoint = "http://localhost:8000/api/") { data <- list(doi_or_unique_name = doi_or_unique_name, release_date = release_date, @@ -45,5 +47,6 @@ new_external_object <- function(doi_or_unique_name, data$original_store <- original_store_url post_data(table = "external_object", - data = data) + data = data, + endpoint = endpoint) } diff --git a/R/new_file_type.R b/R/new_file_type.R index f07d005c..813ab7ec 100644 --- a/R/new_file_type.R +++ b/R/new_file_type.R @@ -4,15 +4,18 @@ #' #' @param name a \code{string} specifying the name of the file type #' @param extension a \code{string} specifying the filename extension +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @family new functions #' #' @export #' new_file_type <- function(name, - extension) { + extension, + endpoint = "http://localhost:8000/api/") { post_data(table = "file_type", data = list(name = name, - extension = extension)) + extension = extension), + endpoint = endpoint) } diff --git a/R/new_issue.R b/R/new_issue.R index 9ee2a9aa..97163441 100644 --- a/R/new_issue.R +++ b/R/new_issue.R @@ -7,6 +7,7 @@ #' \code{issue} #' @param component_issues a \code{list} of \code{object_component} URLs with #' which the \code{issue} is associated; this can be an empty list +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @family new functions #' @@ -14,10 +15,12 @@ #' new_issue <- function(severity, description, - component_issues) { + component_issues, + endpoint = "http://localhost:8000/api/") { post_data(table = "issue", data = list(severity = severity, description = description, - component_issues = component_issues)) + component_issues = component_issues), + endpoint = endpoint) } diff --git a/R/new_keyword.R b/R/new_keyword.R index ba9d845e..d1b6ae03 100644 --- a/R/new_keyword.R +++ b/R/new_keyword.R @@ -6,7 +6,8 @@ #' @param keyphrase a \code{string} a \code{string} containing a free text #' key phrase #' @param identifier (optional) a \code{string} specifying the URL of ontology -#' annotation to associate with this \code{Keyword} +#' annotation to associate with this \code{keyword} +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @family new functions #' @@ -14,7 +15,8 @@ #' new_keyword <- function(object_url, keyphrase, - identifier) { + identifier, + endpoint = "http://localhost:8000/api/") { data <- list(object = object_url, keyphrase = keyphrase) @@ -23,5 +25,6 @@ new_keyword <- function(object_url, data$identifier <- identifier post_data(table = "keyword", - data = data) + data = data, + endpoint = endpoint) } diff --git a/R/new_licence.R b/R/new_licence.R index 5050c518..bcc83556 100644 --- a/R/new_licence.R +++ b/R/new_licence.R @@ -5,15 +5,18 @@ #' @param object_url a \code{string} specifying the URL of an \code{object} #' @param licence_info a free text \code{string} containing information about #' the \code{licence} +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @family new functions #' #' @export #' new_licence <- function(object_url, - licence_info) { + licence_info, + endpoint = "http://localhost:8000/api/") { post_data(table = "licence", data = list(object = object_url, - licence_info = licence_info)) + licence_info = licence_info), + endpoint = endpoint) } diff --git a/R/new_namespace.R b/R/new_namespace.R index eb9ca047..77177531 100644 --- a/R/new_namespace.R +++ b/R/new_namespace.R @@ -7,6 +7,7 @@ #' namespace #' @param website (optional) a \code{string} specifying the website URL #' associated with the namespace +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @family new functions #' @@ -14,7 +15,8 @@ #' new_namespace <- function(name, full_name, - website) { + website, + endpoint = "http://localhost:8000/api/") { data <- list(name = name) @@ -25,5 +27,6 @@ new_namespace <- function(name, data$website <- website post_data(table = "namespace", - data = data) + data = data, + endpoint = endpoint) } diff --git a/R/new_object.R b/R/new_object.R index 8128b470..3068c24c 100644 --- a/R/new_object.R +++ b/R/new_object.R @@ -10,6 +10,7 @@ #' \code{author}s to associate with this \code{object} #' @param file_type_url (optional) a \code{string} specifying the URL #' of an entry in the \code{file_type} table +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @family new functions #' @@ -18,7 +19,8 @@ new_object <- function(description, storage_location_url, authors_urls = list(), - file_type_url) { + file_type_url, + endpoint = "http://localhost:8000/api/") { data <- list() @@ -36,6 +38,7 @@ new_object <- function(description, post_data(table = "object", - data = data) + data = data, + endpoint = endpoint) # } } diff --git a/R/new_object_author_org.R b/R/new_object_author_org.R index 66a66257..763ae8e0 100644 --- a/R/new_object_author_org.R +++ b/R/new_object_author_org.R @@ -8,6 +8,7 @@ #' \code{author} #' @param organisations_urls (optional) a \code{list} of URLs specifying which #' \code{organisation}s to associate with this \code{object_author_org} +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @family new functions #' @@ -15,10 +16,12 @@ #' new_object_author_org <- function(object_url, author_url, - organisations_urls = list()) { + organisations_urls = list(), + endpoint = "http://localhost:8000/api/") { post_data(table = "object_author_org", data = list(object = object_url, author = author_url, - organisations = organisations_urls)) + organisations = organisations_urls), + endpoint = endpoint) } diff --git a/R/new_object_component.R b/R/new_object_component.R index f4d2f789..b721cb59 100644 --- a/R/new_object_component.R +++ b/R/new_object_component.R @@ -14,6 +14,7 @@ #' \code{FALSE} #' @param issues_urls (optional) a \code{list} of \code{issues} URLs to associate #' with this \code{object} +#' @param endpoint a \code{string} specifying the registry endpoint #' #' Note that the \code{object_component} table contains \code{issues} as an #' additional optional field. This is not included here. Instead use @@ -28,7 +29,8 @@ new_object_component <- function(object_url, name, description, whole_object = FALSE, - issues_urls) { + issues_urls, + endpoint = "http://localhost:8000/api/") { data <- list(object = object_url, name = name, @@ -41,5 +43,6 @@ new_object_component <- function(object_url, data$issues <- issues_urls post_data(table = "object_component", - data = data) + data = data, + endpoint = endpoint) } diff --git a/R/new_organisation.R b/R/new_organisation.R index 527328de..fcb93e8c 100644 --- a/R/new_organisation.R +++ b/R/new_organisation.R @@ -5,15 +5,18 @@ #' @param name a \code{string} specifying the name of the \code{organisation} #' @param ror (optional) a unique 9-character \code{string} representing the #' ROR ID of the \code{organisation} (https://ror.org) +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @family new functions #' #' @export #' new_organisation <- function(name, - ror) { + ror, + endpoint = "http://localhost:8000/api/") { post_data(table = "organisation", data = list(name = name, - ror = ror)) + ror = ror), + endpoint = endpoint) } diff --git a/R/new_quality_controlled.R b/R/new_quality_controlled.R index ec745149..59224ceb 100644 --- a/R/new_quality_controlled.R +++ b/R/new_quality_controlled.R @@ -3,13 +3,16 @@ #' Upload information to the \code{quality_controlled} table in the data registry #' #' @param object_url a \code{string} specifying the URL of an \code{object} +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @family new functions #' #' @export #' -new_quality_controlled <- function(object_url) { +new_quality_controlled <- function(object_url, + endpoint = "http://localhost:8000/api/") { post_data(table = "quality_controlled", - data = list(object = object_url)) + data = list(object = object_url), + endpoint = endpoint) } diff --git a/R/new_storage_location.R b/R/new_storage_location.R index 3ddac1e3..115bbc7e 100644 --- a/R/new_storage_location.R +++ b/R/new_storage_location.R @@ -11,6 +11,7 @@ #' is public or not (default is \code{TRUE}) #' @param storage_root_url a \code{string} specifying the URL of an entry in #' the \code{storage_root} table +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @family new functions #' @@ -19,7 +20,8 @@ new_storage_location <- function(path, hash, public, - storage_root_url) { + storage_root_url, + endpoint = "http://localhost:8000/api/") { data <- list(path = path, hash = hash, storage_root = storage_root_url) @@ -28,5 +30,6 @@ new_storage_location <- function(path, data$public <- public post_data(table = "storage_location", - data = data) + data = data, + endpoint = endpoint) } diff --git a/R/new_storage_root.R b/R/new_storage_root.R index 3e333c6f..3580cf6a 100644 --- a/R/new_storage_root.R +++ b/R/new_storage_root.R @@ -7,13 +7,15 @@ #' produces a complete URI to a file #' @param local (optional) a \code{boolean} indicating whether the #' \code{storage_root} is local or not +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @family new functions #' #' @export #' new_storage_root <- function(root, - local) { + local, + endpoint = "http://localhost:8000/api/") { data <- list(root = root) @@ -21,5 +23,6 @@ new_storage_root <- function(root, data$local <- local post_data(table = "storage_root", - data = data) + data = data, + endpoint = endpoint) } diff --git a/R/post_data.R b/R/post_data.R index cfef1126..b0e861b8 100644 --- a/R/post_data.R +++ b/R/post_data.R @@ -4,19 +4,18 @@ #' #' @param table table name as a character #' @param data data as a named list +#' @param endpoint a \code{string} specifying the registry endpoint #' #' @export #' @keywords internal #' -post_data <- function(table, data) { +post_data <- function(table, data, endpoint) { key <- get_token() h <- c(Authorization = paste("token", key)) - api_url <- paste0("http://localhost:8000/api/", table) - # Check there is a trailing slash (windows issue with file.path()) - api_url <- dplyr::if_else(substring(api_url, nchar(api_url)) == "/", api_url, - paste(api_url, "/", sep = "")) + api_url <- paste0(endpoint, table) + api_url <- file.path(dirname(api_url), basename(api_url), "") # Sometimes an error is returned from the local registry: # "Error in curl::curl_fetch_memory(url, handle = handle) : diff --git a/R/register_external_object.R b/R/register_external_object.R index 7a5ee8d8..07fd014e 100644 --- a/R/register_external_object.R +++ b/R/register_external_object.R @@ -2,9 +2,11 @@ #' #' @param yaml config yaml #' @param register_this metadata +#' @param endpoint endpoint #' register_external_object <- function(yaml, - register_this) { + register_this, + endpoint) { datastore <- yaml$run_metadata$write_data_store namespace <- yaml$run_metadata$default_output_namespace @@ -60,7 +62,8 @@ register_external_object <- function(yaml, datastore_location_url <- new_storage_location( path = file_path, hash = hash, - storage_root_url = datastore_root_url) + storage_root_url = datastore_root_url, + endpoint = endpoint) # Get external object metadata -------------------------------------------- @@ -80,7 +83,8 @@ register_external_object <- function(yaml, # Get namespace register_namespace_url <- new_namespace(name = namespace, - full_name = namespace) + full_name = namespace, + endpoint = endpoint) register_namespace_id <- extract_id(register_namespace_url) # Get data_product @@ -90,7 +94,8 @@ register_external_object <- function(yaml, data_product_exists <- get_entry("data_product", list(name = register_data_product, version = register_version, - namespace = register_namespace_id)) + namespace = register_namespace_id, + endpoint = endpoint)) if (is.null(data_product_exists)) { # Original source --------------------------------------------------------- @@ -99,17 +104,20 @@ register_external_object <- function(yaml, source_url <- new_namespace( name = register_this$source_abbreviation, full_name = register_this$source_name, - website = register_this$source_website) + website = register_this$source_website, + endpoint = endpoint) source_root_url <- new_storage_root( root = register_this$root, - local = FALSE) + local = FALSE, + endpoint = endpoint) # Add source location to the data registry source_location_url <- new_storage_location( path = register_this$path, hash = hash, - storage_root_url = source_root_url) + storage_root_url = source_root_url, + endpoint = endpoint) usethis::ui_done( paste("Writing", usethis::ui_value(register_this$external_object), @@ -122,7 +130,8 @@ register_external_object <- function(yaml, if (is.null(filetype_exists)) { filetype_url <- new_file_type(name = register_this$file_type, - extension = register_this$file_type) + extension = register_this$file_type, + endpoint = endpoint) } else { assertthat::assert_that(length(filetype_exists) == 1) filetype_url <- filetype_exists @@ -131,12 +140,14 @@ register_external_object <- function(yaml, datastore_object_url <- new_object( description = register_this$description, storage_location_url = datastore_location_url, - file_type_url = filetype_url) + file_type_url = filetype_url, + endpoint = endpoint) data_product_url <- new_data_product(name = register_data_product, version = register_version, object_url = datastore_object_url, - namespace_url = register_namespace_url) + namespace_url = register_namespace_url, + endpoint = endpoint) externalobject_url <- new_external_object( doi_or_unique_name = register_this$unique_name, @@ -145,7 +156,8 @@ register_external_object <- function(yaml, title = register_this$title, description = register_this$description, data_product_url = data_product_url, - original_store_url = source_location_url) + original_store_url = source_location_url, + endpoint = endpoint) usethis::ui_done( paste("Writing", usethis::ui_value(register_this$external_object), diff --git a/man/fair_pull.Rd b/man/fair_pull.Rd index 2194ea68..2dd2d822 100644 --- a/man/fair_pull.Rd +++ b/man/fair_pull.Rd @@ -4,10 +4,12 @@ \alias{fair_pull} \title{fair_pull} \usage{ -fair_pull(path = "config.yaml") +fair_pull(path = "config.yaml", endpoint = "http://localhost:8000/api/") } \arguments{ \item{path}{path} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \description{ fair_pull diff --git a/man/fair_run.Rd b/man/fair_run.Rd index 836bb4d9..7ad5e9ed 100644 --- a/man/fair_run.Rd +++ b/man/fair_run.Rd @@ -4,11 +4,17 @@ \alias{fair_run} \title{fair_run} \usage{ -fair_run(path = "config.yaml", skip = FALSE) +fair_run( + path = "config.yaml", + endpoint = "http://localhost:8000/api/", + skip = FALSE +) } \arguments{ \item{path}{string} +\item{endpoint}{a \code{string} specifying the registry endpoint} + \item{skip}{don't bother checking whether the repo is clean} } \description{ diff --git a/man/get_existing.Rd b/man/get_existing.Rd index 0aa91db0..75bbdf03 100644 --- a/man/get_existing.Rd +++ b/man/get_existing.Rd @@ -4,7 +4,12 @@ \alias{get_existing} \title{Return all entries posted to a table in the data registry} \usage{ -get_existing(table, limit_results = TRUE, detail = "all") +get_existing( + table, + limit_results = TRUE, + detail = "all", + endpoint = "http://localhost:8000/api/" +) } \arguments{ \item{table}{a \code{string} specifying the name of the table} @@ -14,6 +19,8 @@ the results, default is \code{TRUE}} \item{detail}{a \code{string} specifying what level of detail to return; options are \code{"all"} for all details or \code{"id"} for just URL and IDs} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \value{ Returns a \code{data.frame} of entries in table, default is limited diff --git a/man/get_fields.Rd b/man/get_fields.Rd index 0c1ea144..feceba21 100644 --- a/man/get_fields.Rd +++ b/man/get_fields.Rd @@ -4,10 +4,12 @@ \alias{get_fields} \title{Get fields from table} \usage{ -get_fields(table) +get_fields(table, endpoint = "http://localhost:8000/api/") } \arguments{ \item{table}{a \code{string} specifying the name of the table} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \value{ Returns a \code{data.frame} of fields and their attributes set to diff --git a/man/get_table_optional.Rd b/man/get_table_optional.Rd index 79ff3a7f..e9c2ead3 100644 --- a/man/get_table_optional.Rd +++ b/man/get_table_optional.Rd @@ -4,13 +4,15 @@ \alias{get_table_optional} \title{Get optional fields} \usage{ -get_table_optional(table) +get_table_optional(table, endpoint) } \arguments{ \item{table}{a \code{string} specifying the name of the table} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \value{ -Returns a \code{data.frame} of optional fields and thier properties +Returns a \code{data.frame} of optional fields and their properties } \description{ Get optional fields diff --git a/man/get_table_queryable.Rd b/man/get_table_queryable.Rd index f4561389..4ae56150 100644 --- a/man/get_table_queryable.Rd +++ b/man/get_table_queryable.Rd @@ -4,10 +4,12 @@ \alias{get_table_queryable} \title{Get queryable fields} \usage{ -get_table_queryable(table) +get_table_queryable(table, endpoint) } \arguments{ \item{table}{a \code{string} specifying the name of the table} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \value{ Returns a character vector of queryable fields diff --git a/man/get_table_readable.Rd b/man/get_table_readable.Rd index a802114f..b4d58ac2 100644 --- a/man/get_table_readable.Rd +++ b/man/get_table_readable.Rd @@ -4,10 +4,12 @@ \alias{get_table_readable} \title{Get readable fields} \usage{ -get_table_readable(table) +get_table_readable(table, endpoint) } \arguments{ \item{table}{name of table} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \value{ a dataframe of readable fields and their properties diff --git a/man/get_table_writable.Rd b/man/get_table_writable.Rd index fd9c2cdf..7eaf52ca 100644 --- a/man/get_table_writable.Rd +++ b/man/get_table_writable.Rd @@ -4,10 +4,12 @@ \alias{get_table_writable} \title{Get writable fields} \usage{ -get_table_writable(table) +get_table_writable(table, endpoint) } \arguments{ \item{table}{a \code{string} specifying the name of the table} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \value{ Returns a character vector of writable fields diff --git a/man/get_tables.Rd b/man/get_tables.Rd index f74875f9..4a6b19c4 100644 --- a/man/get_tables.Rd +++ b/man/get_tables.Rd @@ -4,10 +4,10 @@ \alias{get_tables} \title{Get tables from registry} \usage{ -get_tables(live = FALSE) +get_tables(endpoint = "http://localhost:8000/api/") } \arguments{ -\item{live}{whether or not to get the tables directly from the API} +\item{endpoint}{a \code{string} specifying the registry endpoint} } \value{ a character vector of tables diff --git a/man/new_author.Rd b/man/new_author.Rd index 6e51eb99..d7207075 100644 --- a/man/new_author.Rd +++ b/man/new_author.Rd @@ -4,7 +4,12 @@ \alias{new_author} \title{Post entry to author table} \usage{ -new_author(family_name, given_name, identifier) +new_author( + family_name, + given_name, + identifier, + endpoint = "http://localhost:8000/api/" +) } \arguments{ \item{family_name}{a \code{string} specifying the author's family name} @@ -14,6 +19,8 @@ and / or middle name and / or any initials} \item{identifier}{(optional) a \code{string} specifying the full URL of the \code{author}s identifier, \emph{e.g.} ORCID iD} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \description{ Upload information to the \code{author} table in the data registry diff --git a/man/new_code_repo_release.Rd b/man/new_code_repo_release.Rd index 2981e4ed..ce93f560 100644 --- a/man/new_code_repo_release.Rd +++ b/man/new_code_repo_release.Rd @@ -4,7 +4,13 @@ \alias{new_code_repo_release} \title{Post entry to code_repo_release table} \usage{ -new_code_repo_release(name, version, object_url, website) +new_code_repo_release( + name, + version, + object_url, + website, + endpoint = "http://localhost:8000/api/" +) } \arguments{ \item{name}{a \code{string} specifying the name of an official release of @@ -17,6 +23,8 @@ code} \item{website}{(optional) a \code{string} specifying the URL of the website for this code release} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \description{ Upload information to the \code{code_repo_release} table in the data registry diff --git a/man/new_code_run.Rd b/man/new_code_run.Rd index b15e3a03..34d74926 100644 --- a/man/new_code_run.Rd +++ b/man/new_code_run.Rd @@ -11,7 +11,8 @@ new_code_run( model_config_url, submission_script_url, inputs_urls = list(), - outputs_urls = list() + outputs_urls = list(), + endpoint = "http://localhost:8000/api/" ) } \arguments{ @@ -37,6 +38,8 @@ of an \code{object} associated with the submission script used for the \item{outputs_urls}{a \code{list} of \code{object_component} URLs referencing \code{code_run} outputs} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \description{ Upload information to the \code{code_run} table in the data registry diff --git a/man/new_data_product.Rd b/man/new_data_product.Rd index 13a47361..c16b011d 100644 --- a/man/new_data_product.Rd +++ b/man/new_data_product.Rd @@ -4,7 +4,13 @@ \alias{new_data_product} \title{Post entry to data_product table} \usage{ -new_data_product(name, version, object_url, namespace_url) +new_data_product( + name, + version, + object_url, + namespace_url, + endpoint = "http://localhost:8000/api/" +) } \arguments{ \item{name}{a \code{string} specifying the name of the \code{data_product}} @@ -17,6 +23,8 @@ new_data_product(name, version, object_url, namespace_url) \item{namespace_url}{a \code{string} specifying the URL of the entry in the \code{namespace} table} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \description{ Upload information to the \code{data_product} table in the data registry diff --git a/man/new_external_object.Rd b/man/new_external_object.Rd index 5a2845ce..d9d33307 100644 --- a/man/new_external_object.Rd +++ b/man/new_external_object.Rd @@ -11,7 +11,8 @@ new_external_object( title, description, data_product_url, - original_store_url + original_store_url, + endpoint = "http://localhost:8000/api/" ) } \arguments{ @@ -36,6 +37,8 @@ the \code{data_product} table} \item{original_store_url}{(optional) a \code{string} specifying the URL of a an entry in the \code{storage_location} table that references the original location of an \code{external_object}} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \description{ Upload information to the \code{external_object} table in the data registry diff --git a/man/new_file_type.Rd b/man/new_file_type.Rd index ca1b174a..d8be1aa9 100644 --- a/man/new_file_type.Rd +++ b/man/new_file_type.Rd @@ -4,12 +4,14 @@ \alias{new_file_type} \title{Post entry to file_type table} \usage{ -new_file_type(name, extension) +new_file_type(name, extension, endpoint = "http://localhost:8000/api/") } \arguments{ \item{name}{a \code{string} specifying the name of the file type} \item{extension}{a \code{string} specifying the filename extension} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \description{ Upload information to the \code{file_type} table in the data registry diff --git a/man/new_issue.Rd b/man/new_issue.Rd index a5a9f0b1..35a13a7c 100644 --- a/man/new_issue.Rd +++ b/man/new_issue.Rd @@ -4,7 +4,12 @@ \alias{new_issue} \title{Post entry to issue table} \usage{ -new_issue(severity, description, component_issues) +new_issue( + severity, + description, + component_issues, + endpoint = "http://localhost:8000/api/" +) } \arguments{ \item{severity}{an \code{integer} specifying the severity of the \code{issue}} @@ -14,6 +19,8 @@ new_issue(severity, description, component_issues) \item{component_issues}{a \code{list} of \code{object_component} URLs with which the \code{issue} is associated; this can be an empty list} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \description{ Upload information to the \code{issue} table in the data registry diff --git a/man/new_keyword.Rd b/man/new_keyword.Rd index b3d8ba30..962413d5 100644 --- a/man/new_keyword.Rd +++ b/man/new_keyword.Rd @@ -4,7 +4,12 @@ \alias{new_keyword} \title{Post entry to keyword table} \usage{ -new_keyword(object_url, keyphrase, identifier) +new_keyword( + object_url, + keyphrase, + identifier, + endpoint = "http://localhost:8000/api/" +) } \arguments{ \item{object_url}{a \code{string} specifying the URL of an \code{object}} @@ -13,7 +18,9 @@ new_keyword(object_url, keyphrase, identifier) key phrase} \item{identifier}{(optional) a \code{string} specifying the URL of ontology -annotation to associate with this \code{Keyword}} +annotation to associate with this \code{keyword}} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \description{ Upload information to the \code{keyword} table in the data registry diff --git a/man/new_licence.Rd b/man/new_licence.Rd index acf04b77..356cd635 100644 --- a/man/new_licence.Rd +++ b/man/new_licence.Rd @@ -4,13 +4,15 @@ \alias{new_licence} \title{Post entry to licence table} \usage{ -new_licence(object_url, licence_info) +new_licence(object_url, licence_info, endpoint = "http://localhost:8000/api/") } \arguments{ \item{object_url}{a \code{string} specifying the URL of an \code{object}} \item{licence_info}{a free text \code{string} containing information about the \code{licence}} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \description{ Upload information to the \code{licence} table in the data registry diff --git a/man/new_namespace.Rd b/man/new_namespace.Rd index f4104fe4..7e12a0b8 100644 --- a/man/new_namespace.Rd +++ b/man/new_namespace.Rd @@ -4,7 +4,12 @@ \alias{new_namespace} \title{Post entry to namespace table} \usage{ -new_namespace(name, full_name, website) +new_namespace( + name, + full_name, + website, + endpoint = "http://localhost:8000/api/" +) } \arguments{ \item{name}{a \code{string} specifying the name of the namespace} @@ -14,6 +19,8 @@ namespace} \item{website}{(optional) a \code{string} specifying the website URL associated with the namespace} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \description{ Upload information to the \code{namespace} table in the data registry diff --git a/man/new_object.Rd b/man/new_object.Rd index aa37e132..3e042fda 100644 --- a/man/new_object.Rd +++ b/man/new_object.Rd @@ -8,7 +8,8 @@ new_object( description, storage_location_url, authors_urls = list(), - file_type_url + file_type_url, + endpoint = "http://localhost:8000/api/" ) } \arguments{ @@ -23,6 +24,8 @@ of an entry in the \code{storage_location} table} \item{file_type_url}{(optional) a \code{string} specifying the URL of an entry in the \code{file_type} table} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \description{ Upload information to the \code{object} table in the data registry diff --git a/man/new_object_author_org.Rd b/man/new_object_author_org.Rd index 58c39ec8..624830cb 100644 --- a/man/new_object_author_org.Rd +++ b/man/new_object_author_org.Rd @@ -4,7 +4,12 @@ \alias{new_object_author_org} \title{Post entry to object_author_org table} \usage{ -new_object_author_org(object_url, author_url, organisations_urls = list()) +new_object_author_org( + object_url, + author_url, + organisations_urls = list(), + endpoint = "http://localhost:8000/api/" +) } \arguments{ \item{object_url}{a \code{string} specifying the URL of an existing @@ -15,6 +20,8 @@ new_object_author_org(object_url, author_url, organisations_urls = list()) \item{organisations_urls}{(optional) a \code{list} of URLs specifying which \code{organisation}s to associate with this \code{object_author_org}} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \description{ Upload information to the \code{object_author_org} table in the data registry diff --git a/man/new_object_component.Rd b/man/new_object_component.Rd index f7b20a54..42b1389c 100644 --- a/man/new_object_component.Rd +++ b/man/new_object_component.Rd @@ -9,7 +9,8 @@ new_object_component( name, description, whole_object = FALSE, - issues_urls + issues_urls, + endpoint = "http://localhost:8000/api/" ) } \arguments{ @@ -28,7 +29,9 @@ description of the \code{object_component}} \code{FALSE}} \item{issues_urls}{(optional) a \code{list} of \code{issues} URLs to associate -with this \code{object} +with this \code{object}} + +\item{endpoint}{a \code{string} specifying the registry endpoint Note that the \code{object_component} table contains \code{issues} as an additional optional field. This is not included here. Instead use diff --git a/man/new_organisation.Rd b/man/new_organisation.Rd index cb5d7311..fc662a71 100644 --- a/man/new_organisation.Rd +++ b/man/new_organisation.Rd @@ -4,13 +4,15 @@ \alias{new_organisation} \title{Post entry to organisation table} \usage{ -new_organisation(name, ror) +new_organisation(name, ror, endpoint = "http://localhost:8000/api/") } \arguments{ \item{name}{a \code{string} specifying the name of the \code{organisation}} \item{ror}{(optional) a unique 9-character \code{string} representing the ROR ID of the \code{organisation} (https://ror.org)} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \description{ Upload information to the \code{organisation} table in the data registry diff --git a/man/new_quality_controlled.Rd b/man/new_quality_controlled.Rd index 8f023743..039cbf55 100644 --- a/man/new_quality_controlled.Rd +++ b/man/new_quality_controlled.Rd @@ -4,10 +4,12 @@ \alias{new_quality_controlled} \title{Post entry to quality_controlled table} \usage{ -new_quality_controlled(object_url) +new_quality_controlled(object_url, endpoint = "http://localhost:8000/api/") } \arguments{ \item{object_url}{a \code{string} specifying the URL of an \code{object}} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \description{ Upload information to the \code{quality_controlled} table in the data registry diff --git a/man/new_storage_location.Rd b/man/new_storage_location.Rd index 1f47472d..c76cb95e 100644 --- a/man/new_storage_location.Rd +++ b/man/new_storage_location.Rd @@ -4,7 +4,13 @@ \alias{new_storage_location} \title{Post entry to storage_location table} \usage{ -new_storage_location(path, hash, public, storage_root_url) +new_storage_location( + path, + hash, + public, + storage_root_url, + endpoint = "http://localhost:8000/api/" +) } \arguments{ \item{path}{a \code{string} specifying the path from the \code{storage_root} @@ -19,6 +25,8 @@ is public or not (default is \code{TRUE})} \item{storage_root_url}{a \code{string} specifying the URL of an entry in the \code{storage_root} table} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \description{ Upload information to the \code{storage_location} table in the data registry diff --git a/man/new_storage_root.Rd b/man/new_storage_root.Rd index 8814a8e8..0fe7789d 100644 --- a/man/new_storage_root.Rd +++ b/man/new_storage_root.Rd @@ -4,7 +4,7 @@ \alias{new_storage_root} \title{Post entry to storage_root table} \usage{ -new_storage_root(root, local) +new_storage_root(root, local, endpoint = "http://localhost:8000/api/") } \arguments{ \item{root}{a \code{string} specifying the URI of a @@ -13,6 +13,8 @@ produces a complete URI to a file} \item{local}{(optional) a \code{boolean} indicating whether the \code{storage_root} is local or not} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \description{ Upload information to the \code{storage_root} table in the data registry diff --git a/man/post_data.Rd b/man/post_data.Rd index 60079905..3c41a8d2 100644 --- a/man/post_data.Rd +++ b/man/post_data.Rd @@ -4,12 +4,14 @@ \alias{post_data} \title{Post entry to data registry} \usage{ -post_data(table, data) +post_data(table, data, endpoint) } \arguments{ \item{table}{table name as a character} \item{data}{data as a named list} + +\item{endpoint}{a \code{string} specifying the registry endpoint} } \description{ Post data to registry diff --git a/man/register_external_object.Rd b/man/register_external_object.Rd index ffe91435..0aab6863 100644 --- a/man/register_external_object.Rd +++ b/man/register_external_object.Rd @@ -4,12 +4,14 @@ \alias{register_external_object} \title{register_external_object} \usage{ -register_external_object(yaml, register_this) +register_external_object(yaml, register_this, endpoint) } \arguments{ \item{yaml}{config yaml} \item{register_this}{metadata} + +\item{endpoint}{endpoint} } \description{ register_external_object diff --git a/tests/testthat.R b/tests/testthat.R index 15b55a5e..0ec6651b 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,5 +1,5 @@ # library(testthat) -# library(SCRCdataAPI) -# -# testthat::test_check("SCRCdataAPI") +# library(rFDP) # +# testthat::test_check("rFDP") + diff --git a/tests/testthat/test_get_entity.R b/tests/testthat/test_get_entity.R index f5529b8f..0aee272b 100644 --- a/tests/testthat/test_get_entity.R +++ b/tests/testthat/test_get_entity.R @@ -2,21 +2,23 @@ context("Testing get_entity()") description <- paste0("test_get_entity_", openssl::sha1(x = as.character(Sys.time()))) +endpoint <- "https://data.scrc.uk/api/" run_server() -entity_uri <- post_data("object", list(description = description)) +entity_url <- post_data("object", list(description = description), + endpoint = endpoint) sleep_time <- 0.5 test_that("entity returns as a named list",{ Sys.sleep(sleep_time) - expect_silent(get_entity(entity_uri)) + expect_silent(get_entity(entity_url)) Sys.sleep(sleep_time) - expect_true(is.list(get_entity(entity_uri))) + expect_true(is.list(get_entity(entity_url))) Sys.sleep(sleep_time) expect_true(all(c("url", "last_updated") %in% - names(get_entity(entity_uri)))) + names(get_entity(entity_url)))) }) test_that("invalid table produces and error",{ diff --git a/tests/testthat/test_get_entry.R b/tests/testthat/test_get_entry.R index 23e0f360..ca5147e0 100644 --- a/tests/testthat/test_get_entry.R +++ b/tests/testthat/test_get_entry.R @@ -1,13 +1,14 @@ context("Testing get_entry()") sleep_time <- 0.5 - +endpoint <- "https://data.scrc.uk/api/" description <- paste0("test_get_entry_", openssl::sha1(x = as.character(Sys.time()))) run_server() -object_uri <- post_data("object", data = list(description = description)) +object_uri <- post_data("object", data = list(description = description), + endpoint = endpoint) object_id <- extract_id(object_uri) Sys.sleep(sleep_time) @@ -40,7 +41,7 @@ test_that("invalid query causes and error", { Sys.sleep(sleep_time) test_that("multiple matches returns a list of more than one object", { - post_data("object", data = list(description = description)) + post_data("object", data = list(description = description), endpoint = endpoint) Sys.sleep(sleep_time) expect_true(length(get_entry("object", list(description = description))) > 1) }) diff --git a/tests/testthat/test_get_fields.R b/tests/testthat/test_get_fields.R index 17509650..f272ce0b 100644 --- a/tests/testthat/test_get_fields.R +++ b/tests/testthat/test_get_fields.R @@ -4,14 +4,14 @@ known_fields <- c("character", "integer", "field", "boolean", "datetime", "numeric", "url") +endpoint <- "https://data.scrc.uk/api/" run_server() -tables <- get_tables() %>% setdiff(c("users", "groups")) +tables <- get_tables(endpoint = endpoint) %>% + setdiff(c("users", "groups")) fields <- lapply(tables, function(x) { get_fields(x) %>% dplyr::filter(read_only == "FALSE") %>% dplyr::select(data_type) }) %>% unlist() %>% unique() - -stop_server() diff --git a/tests/testthat/test_get_tables.R b/tests/testthat/test_get_tables.R index 461ad546..641d0604 100644 --- a/tests/testthat/test_get_tables.R +++ b/tests/testthat/test_get_tables.R @@ -1,15 +1,11 @@ context("Testing get_tables()") -sleep_time <- 0.5 +endpoint <- "https://data.scrc.uk/api/" run_server() test_that("get_tables returns a character vector of tables", { expect_silent(get_tables()) - Sys.sleep(sleep_time) - expect_true(is.character(get_tables())) - Sys.sleep(sleep_time) - expect_true(is.character(get_tables(TRUE))) + expect_true(is.character(get_tables(endpoint))) + expect_true(is.character(get_tables(endpoint))) }) - -stop_server() diff --git a/tests/testthat/test_new_author.R b/tests/testthat/test_new_author.R index e3fff4ee..0070d131 100644 --- a/tests/testthat/test_new_author.R +++ b/tests/testthat/test_new_author.R @@ -4,15 +4,20 @@ family_name <- paste0("test_new_author_", openssl::sha1(x = as.character(Sys.time()))) personal_name <- paste0("test_new_author_", openssl::sha1(x = as.character(Sys.time()))) +endpoint <- "https://data.scrc.uk/api/" run_server() test_that("new entry in author returns an API URL", { - expect_true(grepl("author", new_author(family_name, personal_name))) + expect_true(grepl("author", new_author(family_name = family_name, + given_name = personal_name, + # identifier, + endpoint = endpoint))) }) test_that("existing entry in author returns an API URL", { - expect_true(grepl("author", new_author(family_name, personal_name))) + expect_true(grepl("author", new_author(family_name = family_name, + given_name = personal_name, + # identifier = , + endpoint = endpoint))) }) - -stop_server() diff --git a/tests/testthat/test_new_code_repo_release.R b/tests/testthat/test_new_code_repo_release.R index c3197661..3fddd9c3 100644 --- a/tests/testthat/test_new_code_repo_release.R +++ b/tests/testthat/test_new_code_repo_release.R @@ -4,17 +4,19 @@ name <- paste0("test_new_code_repo_release_", openssl::sha1(x = as.character(Sys.time()))) version <- create_version_number() website <- paste0("https://www.", gsub("_", "", name), ".com") +endpoint <- "https://data.scrc.uk/api/" run_server() -object_url <- post_data("object", list(description = name)) +object_url <- post_data("object", list(description = name), endpoint = endpoint) test_that("new entry in code_repo_release returns API URL",{ expect_true(grepl("code_repo_release", new_code_repo_release(name = name, version = version, object_url = object_url, - website = website))) + website = website, + endpoint = endpoint))) }) test_that("existing entry in code_repo_release returns API URL", { @@ -22,7 +24,6 @@ test_that("existing entry in code_repo_release returns API URL", { new_code_repo_release(name = name, version = version, object_url = object_url, - website = website))) + website = website, + endpoint = endpoint))) }) - -stop_server() diff --git a/tests/testthat/test_new_code_run.R b/tests/testthat/test_new_code_run.R index f4538968..0fd50220 100644 --- a/tests/testthat/test_new_code_run.R +++ b/tests/testthat/test_new_code_run.R @@ -3,12 +3,16 @@ context("Testing new_code_run()") description <- paste0("test_new_code_run_", openssl::sha1(x = as.character(Sys.time()))) run_date <- Sys.time() +endpoint <- "https://data.scrc.uk/api/" run_server() -code_repo_url <- post_data("object", list(description = description)) -code_model_config <- post_data("object", list(description = description)) -code_submission_script <- post_data("object", list(description = description)) +code_repo_url <- post_data("object", list(description = description), + endpoint = endpoint) +code_model_config <- post_data("object", list(description = description), + endpoint = endpoint) +code_submission_script <- post_data("object", list(description = description), + endpoint = endpoint) test_that("new entry in code_run returns API URL",{ expect_true( @@ -16,7 +20,8 @@ test_that("new entry in code_run returns API URL",{ description = description, code_repo_url = code_repo_url, model_config_url = code_model_config, - submission_script_url = code_submission_script)) + submission_script_url = code_submission_script, + endpoint = endpoint)) ) }) @@ -26,8 +31,7 @@ test_that("existing entry in code_run returns API URL", { description = description, code_repo_url = code_repo_url, model_config_url = code_model_config, - submission_script_url = code_submission_script)) + submission_script_url = code_submission_script, + endpoint = endpoint)) ) }) - -stop_server() diff --git a/tests/testthat/test_new_data_product.R b/tests/testthat/test_new_data_product.R index 7639fa4f..9e90c61e 100644 --- a/tests/testthat/test_new_data_product.R +++ b/tests/testthat/test_new_data_product.R @@ -2,11 +2,12 @@ context("Testing new_data_product()") UID <- paste0("test_new_data_product_", openssl::sha1(x = as.character(Sys.time()))) - +endpoint <- "https://data.scrc.uk/api/" run_server() object_url <- post_data("object", - list(description = UID)) + list(description = UID), + endpoint = endpoint) namespace_url <- post_data("namespace", list(name = UID)) @@ -16,7 +17,8 @@ test_that("new entry in data_product returns API URL", { new_data_product(name = UID, version = create_version_number(), object_url = object_url, - namespace_url = namespace_url))) + namespace_url = namespace_url, + endpoint = endpoint))) }) test_that("existing entry in data_product returns API URL", { @@ -24,7 +26,6 @@ test_that("existing entry in data_product returns API URL", { new_data_product(name = UID, version = create_version_number(), object_url = object_url, - namespace_url = namespace_url))) + namespace_url = namespace_url, + endpoint = endpoint))) }) - -stop_server() diff --git a/tests/testthat/test_new_external_object.R b/tests/testthat/test_new_external_object.R index c964fd59..86ceab24 100644 --- a/tests/testthat/test_new_external_object.R +++ b/tests/testthat/test_new_external_object.R @@ -5,29 +5,35 @@ UID <- paste0("test_new_external_object_", path <- paste0(UID, ".h5") path_url <- paste0("https://", path) hash <- sha1(UID) +endpoint <- "https://data.scrc.uk/api/" run_server() storage_root_url <- post_data("storage_root", - list(root = path_url)) + list(root = path_url), + endpoint = endpoint) storage_location_url <- post_data("storage_location", list(path = path, hash = hash, - storage_root = storage_root_url)) + storage_root = storage_root_url), + endpoint = endpoint) object_url <- post_data("object", list(desription = "text", - storage_location_url = storage_location_url)) + storage_location_url = storage_location_url), + endpoint = endpoint) namespace_url <- post_data("namespace", list(name = "testuser", - full_name = "testuser")) + full_name = "testuser"), + endpoint = endpoint) data_product_url <- post_data("data_product", list(name = UID, version = "0.1.0", object = object_url, - namespace = namespace_url)) + namespace = namespace_url), + endpoint = endpoint) test_that("New external object creates an external object with all fields", { expect_true(grepl("external_object", @@ -37,5 +43,6 @@ test_that("New external object creates an external object with all fields", { title = UID, description = UID, data_product_url = data_product_url, - original_store_url = storage_location_url))) + original_store_url = storage_location_url, + endpoint = endpoint))) }) diff --git a/tests/testthat/test_new_keyword.R b/tests/testthat/test_new_keyword.R index ab31023f..5ccaeb54 100644 --- a/tests/testthat/test_new_keyword.R +++ b/tests/testthat/test_new_keyword.R @@ -2,20 +2,21 @@ context("Testing new_keyword()") keyphrase <- paste0("test_new_keyword_", openssl::sha1(x = as.character(Sys.time()))) - +endpoint <- "https://data.scrc.uk/api/" run_server() object_url <- post_data("object", - list(description = paste0(keyphrase, " Test"))) + list(description = paste0(keyphrase, " Test")), + endpoint = endpoint) test_that("new entry in keyword returns API URL", { expect_true(grepl("keyword", new_keyword(object_url = object_url, - keyphrase = keyphrase))) + keyphrase = keyphrase, + endpoint = endpoint))) }) test_that("existing entry in keyword returns API URL", { expect_true(grepl("keyword", new_keyword(object_url = object_url, - keyphrase = keyphrase))) + keyphrase = keyphrase, + endpoint = endpoint))) }) - -stop_server() diff --git a/tests/testthat/test_new_namespace.R b/tests/testthat/test_new_namespace.R index 9951748d..b8cf6f52 100644 --- a/tests/testthat/test_new_namespace.R +++ b/tests/testthat/test_new_namespace.R @@ -2,15 +2,19 @@ context("Testing new_namespace()") name <- paste0("test_new_namespace_", openssl::sha1(x = as.character(Sys.time()))) - +endpoint <- "https://data.scrc.uk/api/" run_server() test_that("new entry in namespace returns API URL", { - expect_true(grepl("namespace", new_namespace(name = name))) + expect_true(grepl("namespace", new_namespace(name = name, + full_name = name, + # website = , + endpoint = endpoint))) }) test_that("existing entry in namespace returns API URL", { - expect_true(grepl("namespace", new_namespace(name))) + expect_true(grepl("namespace", new_namespace(name = name, + full_name = name, + # website = , + endpoint = endpoint))) }) - -stop_server() diff --git a/tests/testthat/test_new_object.R b/tests/testthat/test_new_object.R index b11343ba..bd6ee9e8 100644 --- a/tests/testthat/test_new_object.R +++ b/tests/testthat/test_new_object.R @@ -4,36 +4,40 @@ UID <- paste0("test_new_object_", openssl::sha1(x = as.character(Sys.time()))) path <- paste0(UID, ".h5") path_url <- paste0("https://", path, ".com") hash <- paste0(Sys.time(), "%d%m%y%H%M%S") - +endpoint <- "https://data.scrc.uk/api/" run_server() storage_root_url <- post_data("storage_root", list(name = UID, - root = path_url)) + root = path_url), + endpoint = endpoint) store_url <- post_data("storage_location", list(path = path, hash = hash, - storage_root = storage_root_url)) + storage_root = storage_root_url), + endpoint = endpoint) test_that("new entry in object returns API URL", { expect_true(grepl("object", new_object("", - description = UID))) + description = UID, + endpoint = endpoint))) }) test_that("new entry in object returns API URL", { expect_true(grepl("object", new_object(store_url, - description = UID))) + description = UID, + endpoint = endpoint))) }) test_that("new entry in object returns API URL", { expect_true(grepl("object", new_object("", - description = ""))) + description = "", + endpoint = endpoint))) }) test_that("existing entry in object returns API URL", { expect_true(grepl("object", new_object(store_url, - description = UID))) + description = UID, + endpoint = endpoint))) }) - -stop_server() diff --git a/tests/testthat/test_new_object_component.R b/tests/testthat/test_new_object_component.R index 10be2bac..d42bda10 100644 --- a/tests/testthat/test_new_object_component.R +++ b/tests/testthat/test_new_object_component.R @@ -3,24 +3,24 @@ context("Testing new_object_component()") UID <- paste0("test_new_object_component_", openssl::sha1(x = as.character(Sys.time()))) UID2 <- paste0(UID, "1") - +endpoint <- "https://data.scrc.uk/api/" run_server() -object_url <- post_data("object", list(description = UID)) -object_url2 <- post_data("object", list(description = UID2)) +object_url <- post_data("object", list(description = UID), endpoint = endpoint) +object_url2 <- post_data("object", list(description = UID2), endpoint = endpoint) test_that("new entry in object_component returns API URL", { expect_true(grepl("object_component", new_object_component(object_url = object_url, name = UID, - description = UID))) + description = UID, + endpoint = endpoint))) }) test_that("existing entry in object_component returns API URL", { expect_true(grepl("object_component", new_object_component(object_url = object_url, name = UID, - description = UID))) + description = UID, + endpoint = endpoint))) }) - -stop_server() diff --git a/tests/testthat/test_new_storage_location.R b/tests/testthat/test_new_storage_location.R index 7e6bae7a..9a6056cd 100644 --- a/tests/testthat/test_new_storage_location.R +++ b/tests/testthat/test_new_storage_location.R @@ -7,19 +7,21 @@ root_name <- paste0("test_new_storate_location_", root <- paste0("https://", root_name, ".com") hash <- openssl::sha1(x = root_name) path <- paste0(hash, ".h5") - +endpoint <- "https://data.scrc.uk/api/" run_server() # Register storage root storage_root_url <- new_storage_root(root = root, - local = TRUE) + local = TRUE, + endpoint = endpoint) test_that("new entry in storage_location returns API URL", { expect_true(grepl("storage_location", new_storage_location(path = path, hash = hash, public = TRUE, - storage_root_url = storage_root_url))) + storage_root_url = storage_root_url, + endpoint = endpoint))) }) test_that("existing entry in storage_location returns API URL", { @@ -27,7 +29,6 @@ test_that("existing entry in storage_location returns API URL", { new_storage_location(path = path, hash = hash, public = TRUE, - storage_root_url = storage_root_url))) + storage_root_url = storage_root_url, + endpoint = endpoint))) }) - -stop_server() diff --git a/tests/testthat/test_post_data.R b/tests/testthat/test_post_data.R index b6ab3979..f72b3291 100644 --- a/tests/testthat/test_post_data.R +++ b/tests/testthat/test_post_data.R @@ -1,22 +1,17 @@ context("Testing post_data()") -sleep_time <- 0.5 - -key <- Sys.getenv("SCRC_API_TOKEN") - -test_user <- "22" - -#get all tables +# Get all tables tables <- get_tables() unknown_table <- "unknown" id <- sample(1:100, 1, replace = TRUE) uid <- paste0("Test - ", Sys.time()) +endpoint <- "https://data.scrc.uk/api/" -object_id <- post_data("object", list(description = uid)) +object_id <- post_data("object", list(description = uid), endpoint = endpoint) test_that("incorrect tables produce and error", { - expect_error(post_data(unknown_table, data = list())) - expect_error(post_data(NULL, data = list())) + expect_error(post_data(unknown_table, data = list(), endpoint = endpoint)) + expect_error(post_data(NULL, data = list(), endpoint = endpoint)) }) test_that("post_data works with all tables",{ @@ -24,7 +19,8 @@ test_that("post_data works with all tables",{ table <- tables[i] if(table == "users" | table == "groups") { - expect_error(post_data(tables[i], data = list("username = test"))) + expect_error(post_data(tables[i], data = list("username = test"), + endpoint = endpoint)) } else { table.writable <- get_table_writable(table) @@ -35,12 +31,12 @@ test_that("post_data works with all tables",{ if (nrow(table.required) > 1) { test_that(paste0(table, " fails when no data is present"), { - expect_error(post_data(table, data = list())) + expect_error(post_data(table, data = list(), endpoint = endpoint)) }) } else if (nrow(table.required) == 0) { test_that(paste0(table, " allows creation with no data"), { - expect_true(is.character(post_data(table, NULL))) + expect_true(is.character(post_data(table, NULL, endpoint = endpoint))) }) data_incorrect <- list(unknown = "unknown") @@ -83,7 +79,8 @@ test_that("post_data works with all tables",{ } test_that(paste0("table ", table, " works with correct data"), { - expect_true(is.character(post_data(table, data_correct))) + expect_true(is.character(post_data(table, data_correct, + endpoint = endpoint))) }) } @@ -91,7 +88,8 @@ test_that("post_data works with all tables",{ if (table != "object") test_that(paste0("table ", table, " does not works with correct data"), { - expect_error(post_data(table, data_incorrect)) + expect_error(post_data(table, data_incorrect, + endpoint = endpoint)) }) } } diff --git a/tests/testthat/test_read_array.R b/tests/testthat/test_read_array.R index afbcef00..f67075b1 100644 --- a/tests/testthat/test_read_array.R +++ b/tests/testthat/test_read_array.R @@ -12,6 +12,7 @@ version1 <- "0.1.0" version2 <- "0.2.0" namespace1 <- "username" namespace2 <- "johnsmith" +endpoint <- "https://data.scrc.uk/api/" # Write test/array v.0.1.0 'username' namespace --------------------------- @@ -27,8 +28,8 @@ write_dataproduct(path = config_file, version = version1) # CLI functions -fair_pull(config_file) -fair_run(config_file, skip = TRUE) +fair_pull(path = config_file, endpoint = endpoint) +fair_run(path = config_file, endpoint = endpoint, skip = TRUE) # Initialise code run config <- file.path(Sys.getenv("FDP_CONFIG_DIR"), "config.yaml") @@ -71,8 +72,8 @@ write_dataproduct(path = config_file, version = version2) # CLI functions -fair_pull(config_file) -fair_run(config_file, skip = TRUE) +fair_pull(path = config_file, endpoint = endpoint) +fair_run(path = config_file, endpoint = endpoint, skip = TRUE) # Initialise code run config <- file.path(Sys.getenv("FDP_CONFIG_DIR"), "config.yaml") @@ -111,8 +112,8 @@ write_dataproduct(path = config_file, version = version1) # CLI functions -fair_pull(config_file) -fair_run(config_file, skip = TRUE) +fair_pull(path = config_file, endpoint = endpoint) +fair_run(path = config_file, endpoint = endpoint, skip = TRUE) # Initialise code run config <- file.path(Sys.getenv("FDP_CONFIG_DIR"), "config.yaml") @@ -151,8 +152,8 @@ write_dataproduct(path = config_file, version = version1) # CLI functions -fair_pull(config_file) -fair_run(config_file, skip = TRUE) +fair_pull(path = config_file, endpoint = endpoint) +fair_run(path = config_file, endpoint = endpoint, skip = TRUE) # Initialise code run config <- file.path(Sys.getenv("FDP_CONFIG_DIR"), "config.yaml") @@ -214,8 +215,8 @@ read_dataproduct(path = config_file, use_version = version1) # CLI functions -fair_pull(config_file) -fair_run(config_file, skip = TRUE) +fair_pull(path = config_file, endpoint = endpoint) +fair_run(path = config_file, endpoint = endpoint, skip = TRUE) # Initialise code run config <- file.path(Sys.getenv("FDP_CONFIG_DIR"), "config.yaml") diff --git a/tests/testthat/test_read_distribution.R b/tests/testthat/test_read_distribution.R index bb549d65..d39b018f 100644 --- a/tests/testthat/test_read_distribution.R +++ b/tests/testthat/test_read_distribution.R @@ -6,6 +6,7 @@ component1 <- "symptom-delay" coderun_description <- "Register a file in the pipeline" dataproduct_description <- "Estimate of symptom delay" namespace1 <- "username" +endpoint <- "https://data.scrc.uk/api/" # User written config file config_file <- "config_files/read_distribution/config.yaml" @@ -18,8 +19,8 @@ write_dataproduct(path = config_file, description = dataproduct_description) # CLI functions -fair_pull(config_file) -fair_run(config_file, skip = TRUE) +fair_pull(path = config_file, endpoint = endpoint) +fair_run(path = config_file, endpoint = endpoint, skip = TRUE) # Initialise code run config <- file.path(Sys.getenv("FDP_CONFIG_DIR"), "config.yaml") @@ -49,8 +50,8 @@ read_dataproduct(path = config_file, component = component1) # CLI functions -fair_pull(config_file) -fair_run(config_file, skip = TRUE) +fair_pull(path = config_file, endpoint = endpoint) +fair_run(path = config_file, endpoint = endpoint, skip = TRUE) # Initialise code run config <- file.path(Sys.getenv("FDP_CONFIG_DIR"), "config.yaml") diff --git a/tests/testthat/test_read_estimate.R b/tests/testthat/test_read_estimate.R index ce4411b5..9e7b4351 100644 --- a/tests/testthat/test_read_estimate.R +++ b/tests/testthat/test_read_estimate.R @@ -6,6 +6,7 @@ component1 <- "asymptomatic-period" coderun_description <- "Register a file in the pipeline" dataproduct_description <- "Estimate of asymptomatic period" namespace1 <- "username" +endpoint <- "https://data.scrc.uk/api/" # User written config file config_file <- "config_files/read_estimate/config.yaml" @@ -18,8 +19,8 @@ write_dataproduct(path = config_file, description = dataproduct_description) # CLI functions -fair_pull(config_file) -fair_run(config_file, skip = TRUE) +fair_pull(path = config_file, endpoint = endpoint) +fair_run(path = config_file, endpoint = endpoint, skip = TRUE) # Initialise code run config <- file.path(Sys.getenv("FDP_CONFIG_DIR"), "config.yaml") @@ -48,8 +49,8 @@ read_dataproduct(path = config_file, data_product = data_product1, component = component1) -fair_pull(config_file) -fair_run(config_file, skip = TRUE) +fair_pull(path = config_file, endpoint = endpoint) +fair_run(path = config_file, endpoint = endpoint, skip = TRUE) config <- file.path(Sys.getenv("FDP_CONFIG_DIR"), "config.yaml") script <- file.path(Sys.getenv("FDP_CONFIG_DIR"), "script.sh") diff --git a/tests/testthat/test_read_table.R b/tests/testthat/test_read_table.R index 2001b324..b02ca679 100644 --- a/tests/testthat/test_read_table.R +++ b/tests/testthat/test_read_table.R @@ -7,6 +7,7 @@ data_product1 <- paste("test/table", uid, sep = "_") component <- "a/b/c/d" version1 <- "0.1.0" namespace1 <- "username" +endpoint <- "https://data.scrc.uk/api/" # Write test/array v.0.1.0 'username' namespace --------------------------- @@ -22,8 +23,8 @@ write_dataproduct(path = config_file, version = version1) # CLI functions -fair_pull(config_file) -fair_run(config_file, skip = TRUE) +fair_pull(path = config_file, endpoint = endpoint) +fair_run(path = config_file, endpoint = endpoint, skip = TRUE) # Initialise code run config <- file.path(Sys.getenv("FDP_CONFIG_DIR"), "config.yaml") @@ -58,8 +59,8 @@ read_dataproduct(path = config_file, use_version = version1) # CLI functions -fair_pull(config_file) -fair_run(config_file, skip = TRUE) +fair_pull(path = config_file, endpoint = endpoint) +fair_run(path = config_file, endpoint = endpoint, skip = TRUE) # Initialise code run config <- file.path(Sys.getenv("FDP_CONFIG_DIR"), "config.yaml") diff --git a/tests/testthat/test_upload_paper.R b/tests/testthat/test_upload_paper.R index c02f2c8d..a3d73070 100644 --- a/tests/testthat/test_upload_paper.R +++ b/tests/testthat/test_upload_paper.R @@ -1,118 +1,118 @@ -context("Testing upload_paper()") - -# get the token -token <- Sys.getenv("SCRC_API_TOKEN") - -# user_id <- "3" - -# skip_test <- FALSE +# context("Testing upload_paper()") # -# release_date <- NULL -# abstract <- NULL -# object <- NULL -# first_author <- NULL -# authors <- NULL -# source <- NULL -# journal_name <- NULL -# journal_abbreviation <- NULL -# website <- NULL -# keywords <- NULL -# doi <- NULL +# # get the token +# token <- Sys.getenv("SCRC_API_TOKEN") # -# title <- "COVID-19-like symptoms observed in Chinese tree shrews infected with SARS-CoV-2" +# # user_id <- "3" # -# existing_paper <- get_entry("external_object", list(title = title))[[1]] +# # skip_test <- FALSE +# # +# # release_date <- NULL +# # abstract <- NULL +# # object <- NULL +# # first_author <- NULL +# # authors <- NULL +# # source <- NULL +# # journal_name <- NULL +# # journal_abbreviation <- NULL +# # website <- NULL +# # keywords <- NULL +# # doi <- NULL +# # +# # title <- "COVID-19-like symptoms observed in Chinese tree shrews infected with SARS-CoV-2" +# # +# # existing_paper <- get_entry("external_object", list(title = title))[[1]] +# # +# # if(is.null(existing_paper)){ +# # skip_test <- NULL +# # } else{ +# # doi <- existing_paper$doi_or_unique_name +# # +# # release_date <- existing_paper$release_date +# # abstract <- existing_paper$description +# # +# # version <- existing_paper$version +# # +# # object <- get_entity("object", basename(existing_paper$object)) +# # authors_list <- object$authors +# # for(author in seq_along(authors_list)){ +# # first_author <- get_entity("author", basename(object$authors[[author]])) +# # current_author_name <- paste(first_author$family_name, first_author$personal_name, sep = ", ") +# # if(!is.null(authors)) +# # authors <- paste(authors, current_author_name, sep = " and ") +# # else +# # authors <- current_author_name +# # } +# # +# # source <- get_entity("source", basename(existing_paper$source)) +# # journal_name <- source$name +# # journal_abbreviation <- source$abbreviation +# # website <- source$website +# # +# # if(length(object$keywords) > 0){ +# # for(keyword in seq_along(object$keywords)){ +# # current_keyword <- get_entity("keyword", basename(object$keywords[[keyword]]))$keyphrase +# # if(is.null(keywords)) +# # keywords <- current_keyword +# # else +# # keywords <- paste(keywords, current_keyword, sep = " and ") +# # } +# # +# # } +# # +# # +# # +# # } +# # +# # +# # test_that("Existing Paper returns existing paper", { +# # skip_if(skip_test) +# # expect_message(expect_true(is.character(upload_paper(title, authors, journal_name, journal_abr, website, release_date, abstract, keywords, doi, version = version, key = token)))) +# # }) # -# if(is.null(existing_paper)){ -# skip_test <- NULL -# } else{ -# doi <- existing_paper$doi_or_unique_name +# test_identifier <- sample(1:1000000, 1, replace=TRUE) # -# release_date <- existing_paper$release_date -# abstract <- existing_paper$description +# keywords <- paste(sample(letters, 12, FALSE), collapse ="", sep = "") # -# version <- existing_paper$version +# date_time <- Sys.time() +# formatted_date <- format(date_time, "%d%m%y%H%M%S") +# doi <- paste0(formatted_date, test_identifier, "/TEST") +# release_date <- date_time +# title <- paste0("TEST ", formatted_date, test_identifier) +# abstract <- paste0("Test Abstract ", formatted_date, test_identifier) +# journal_name <- paste0("TEST Journal ", date_time, test_identifier) +# journal_abr <- paste0("TEST_", formatted_date, test_identifier) +# website <- "" +# personal_name <- paste(sample(letters, 8, FALSE), collapse ="", sep = "") +# family_name <- paste(sample(letters, 8, FALSE), collapse ="", sep = "") +# authors <- paste(family_name, personal_name, sep = ", ") # -# object <- get_entity("object", basename(existing_paper$object)) -# authors_list <- object$authors -# for(author in seq_along(authors_list)){ -# first_author <- get_entity("author", basename(object$authors[[author]])) -# current_author_name <- paste(first_author$family_name, first_author$personal_name, sep = ", ") -# if(!is.null(authors)) -# authors <- paste(authors, current_author_name, sep = " and ") -# else -# authors <- current_author_name -# } -# -# source <- get_entity("source", basename(existing_paper$source)) -# journal_name <- source$name -# journal_abbreviation <- source$abbreviation -# website <- source$website -# -# if(length(object$keywords) > 0){ -# for(keyword in seq_along(object$keywords)){ -# current_keyword <- get_entity("keyword", basename(object$keywords[[keyword]]))$keyphrase -# if(is.null(keywords)) -# keywords <- current_keyword -# else -# keywords <- paste(keywords, current_keyword, sep = " and ") -# } -# -# } -# -# -# -# } +# test_that("Upload Paper returns ID", { +# paper_id <- character(0) +# expect_silent(paper_id <- upload_paper(title, +# authors, +# journal_name, +# journal_abr, +# website, +# release_date, +# abstract, +# keywords, +# doi, +# key = token)) +# expect_true(is.character(paper_id)) +# }) # +# authors <- paste0("TEST", formatted_date) # -# test_that("Existing Paper returns existing paper", { -# skip_if(skip_test) -# expect_message(expect_true(is.character(upload_paper(title, authors, journal_name, journal_abr, website, release_date, abstract, keywords, doi, version = version, key = token)))) +# test_that("incorrect authors returns a message", { +# expect_message(paper_id <- upload_paper(title, +# authors, +# journal_name, +# journal_abr, +# website, +# release_date, +# abstract, +# keywords, +# doi, +# key = token)) # }) - -test_identifier <- sample(1:1000000, 1, replace=TRUE) - -keywords <- paste(sample(letters, 12, FALSE), collapse ="", sep = "") - -date_time <- Sys.time() -formatted_date <- format(date_time, "%d%m%y%H%M%S") -doi <- paste0(formatted_date, test_identifier, "/TEST") -release_date <- date_time -title <- paste0("TEST ", formatted_date, test_identifier) -abstract <- paste0("Test Abstract ", formatted_date, test_identifier) -journal_name <- paste0("TEST Journal ", date_time, test_identifier) -journal_abr <- paste0("TEST_", formatted_date, test_identifier) -website <- "" -personal_name <- paste(sample(letters, 8, FALSE), collapse ="", sep = "") -family_name <- paste(sample(letters, 8, FALSE), collapse ="", sep = "") -authors <- paste(family_name, personal_name, sep = ", ") - -test_that("Upload Paper returns ID", { - paper_id <- character(0) - expect_silent(paper_id <- upload_paper(title, - authors, - journal_name, - journal_abr, - website, - release_date, - abstract, - keywords, - doi, - key = token)) - expect_true(is.character(paper_id)) -}) - -authors <- paste0("TEST", formatted_date) - -test_that("incorrect authors returns a message", { - expect_message(paper_id <- upload_paper(title, - authors, - journal_name, - journal_abr, - website, - release_date, - abstract, - keywords, - doi, - key = token)) -}) diff --git a/tests/testthat/test_write_array.R b/tests/testthat/test_write_array.R index d8c8d1f6..fe46ab30 100644 --- a/tests/testthat/test_write_array.R +++ b/tests/testthat/test_write_array.R @@ -9,6 +9,7 @@ component1 <- "a/b/c/d" component2 <- "another/component" version1 <- "0.1.0" version2 <- "0.2.0" +endpoint <- "https://data.scrc.uk/api/" # User written config file config_file <- "config_files/write_array/config.yaml" @@ -20,14 +21,10 @@ write_dataproduct(path = config_file, data_product = data_product1, description = dataproduct_description, version = version1) -write_dataproduct(path = config_file, - data_product = data_product1, - component = component1, - version = version2) # CLI functions -fair_pull(config_file) -fair_run(config_file, skip = TRUE) +fair_pull(path = config_file, endpoint = endpoint) +fair_run(path = config_file, endpoint = endpoint, skip = TRUE) # Initialise code run config <- file.path(Sys.getenv("FDP_CONFIG_DIR"), "config.yaml") diff --git a/tests/testthat/test_write_distribution.R b/tests/testthat/test_write_distribution.R index 853931cc..3065b2ef 100644 --- a/tests/testthat/test_write_distribution.R +++ b/tests/testthat/test_write_distribution.R @@ -5,6 +5,7 @@ data_product1 <- paste("test/distribution/symptom-delay", uid, sep = "_") coderun_description <- "Register a file in the pipeline" dataproduct_description <- "Estimate of symptom delay" namespace1 <- "username" +endpoint <- "https://data.scrc.uk/api/" # User written config file config_file <- "config_files/write_distribution/config.yaml" @@ -17,8 +18,8 @@ write_dataproduct(path = config_file, description = dataproduct_description) # CLI functions -fair_pull(config_file) -fair_run(config_file, skip = TRUE) +fair_pull(path = config_file, endpoint = endpoint) +fair_run(path = config_file, endpoint = endpoint, skip = TRUE) # Initialise code run config <- file.path(Sys.getenv("FDP_CONFIG_DIR"), "config.yaml") diff --git a/tests/testthat/test_write_estimate.R b/tests/testthat/test_write_estimate.R index d839afc2..6de530a3 100644 --- a/tests/testthat/test_write_estimate.R +++ b/tests/testthat/test_write_estimate.R @@ -5,6 +5,7 @@ data_product1 <- paste("test/estimate/asymptomatic-period", uid, sep = "_") coderun_description <- "Register a file in the pipeline" dataproduct_description <- "Estimate of asymptomatic period" namespace1 <- "username" +endpoint <- "https://data.scrc.uk/api/" # User written config file config_file <- "config_files/write_estimate/config.yaml" @@ -17,8 +18,8 @@ write_dataproduct(path = config_file, description = dataproduct_description) # CLI functions -fair_pull(config_file) -fair_run(config_file, skip = TRUE) +fair_pull(path = config_file, endpoint = endpoint) +fair_run(path = config_file, endpoint = endpoint, skip = TRUE) # Initialise code run config <- file.path(Sys.getenv("FDP_CONFIG_DIR"), "config.yaml") diff --git a/tests/testthat/test_write_table.R b/tests/testthat/test_write_table.R index 2791811a..2bba63a1 100644 --- a/tests/testthat/test_write_table.R +++ b/tests/testthat/test_write_table.R @@ -7,6 +7,7 @@ dataproduct_description <- "Test table" data_product1 <- paste("test/table", uid, sep = "_") component1 <- "a/b/c/d" version1 <- "0.1.0" +endpoint <- "https://data.scrc.uk/api/" # User written config file config_file <- "config_files/write_table/config.yaml" @@ -20,8 +21,8 @@ write_dataproduct(path = config_file, version = version1) # CLI functions -fair_pull(config_file) -fair_run(config_file, skip = TRUE) +fair_pull(path = config_file, endpoint = endpoint) +fair_run(path = config_file, skip = TRUE) # Initialise code run config <- file.path(Sys.getenv("FDP_CONFIG_DIR"), "config.yaml")