Mock further API responses

R/EngineGraphQL.R

@@ -50,9 +50,9 @@ EngineGraphQL <- R6::R6Class(
   private = list(
 
     # GraphQL method for pulling response from API
-    perform_request = function(gql_query, vars) {
+    perform_request = function(gql_query, vars, token = private$token) {
       response <- httr2::request(paste0(self$gql_api_url, "?")) %>%
-        httr2::req_headers("Authorization" = paste0("Bearer ", private$token)) %>%
+        httr2::req_headers("Authorization" = paste0("Bearer ", token)) %>%
         httr2::req_body_json(list(query = gql_query, variables = vars)) %>%
         httr2::req_retry(
           is_transient = ~ httr2::resp_status(.x) %in% c(400, 502),

R/EngineGraphQLGitHub.R

@@ -99,30 +99,15 @@ EngineGraphQLGitHub <- R6::R6Class(
       )
       repositories <- repo_data[["repositories"]]
       def_branches <- repo_data[["def_branches"]]
-      org_files_list <- purrr::map2(repositories, def_branches, function(repo, def_branch) {
-        if (!is.null(host_files_structure)) {
-          file_paths <- private$get_path_from_files_structure(
-            host_files_structure = host_files_structure,
-            only_text_files = only_text_files,
-            org = org,
-            repo = repo
-          )
-        } else if (is.null(host_files_structure) && only_text_files) {
-          file_paths <- file_paths[!grepl(non_text_files_pattern, file_paths)]
-        }
-        repo_files_list <- purrr::map(file_paths, function(file_path) {
-          private$get_file_response(
-            org = org,
-            repo = repo,
-            def_branch = def_branch,
-            file_path = file_path,
-            files_query = self$gql_query$file_blob_from_repo()
-          )
-        }) %>%
-          purrr::map(~ .$data$repository)
-        names(repo_files_list) <- file_paths
-        return(repo_files_list)
-      }, .progress = progress)
+      org_files_list <- private$get_repositories_with_files(
+        repositories = repositories,
+        def_branches = def_branches,
+        org = org,
+        file_paths = file_paths,
+        host_files_structure = host_files_structure,
+        only_text_files = only_text_files,
+        progress = progress
+      )
       names(org_files_list) <- repositories
       for (file_path in file_paths) {
         org_files_list <- purrr::discard(org_files_list, ~ length(.[[file_path]]$file) == 0)
@@ -254,6 +239,39 @@ EngineGraphQLGitHub <- R6::R6Class(
       return(result)
     },
 
+    get_repositories_with_files = function(repositories,
+                                           def_branches,
+                                           org,
+                                           host_files_structure,
+                                           only_text_files,
+                                           file_paths,
+                                           progress) {
+      purrr::map2(repositories, def_branches, function(repo, def_branch) {
+        if (!is.null(host_files_structure)) {
+          file_paths <- private$get_path_from_files_structure(
+            host_files_structure = host_files_structure,
+            only_text_files = only_text_files,
+            org = org,
+            repo = repo
+          )
+        } else if (is.null(host_files_structure) && only_text_files) {
+          file_paths <- file_paths[!grepl(non_text_files_pattern, file_paths)]
+        }
+        repo_files_list <- purrr::map(file_paths, function(file_path) {
+          private$get_file_response(
+            org = org,
+            repo = repo,
+            def_branch = def_branch,
+            file_path = file_path,
+            files_query = self$gql_query$file_blob_from_repo()
+          )
+        }) %>%
+          purrr::map(~ .$data$repository)
+        names(repo_files_list) <- file_paths
+        return(repo_files_list)
+      }, .progress = progress)
+    },
+
     get_file_response = function(org, repo, def_branch, file_path, files_query) {
       expression <- paste0(def_branch, ":", file_path)
       files_response <- self$gql_response(

R/EngineRest.R

@@ -42,7 +42,7 @@ EngineRest <- R6::R6Class("EngineRest",
   private = list(
 
     # Paginate contributors and parse response into character vector
-    pull_contributors_from_repo = function(contributors_endpoint, user_name) {
+    get_contributors_from_repo = function(contributors_endpoint, user_name) {
       contributors_response <- private$paginate_results(contributors_endpoint)
       contributors_vec <- contributors_response %>%
         purrr::map_chr(~ eval(user_name)) %>%

R/EngineRestGitHub.R

@@ -114,7 +114,7 @@ EngineRestGitHub <- R6::R6Class(
         repos_table$contributors <- purrr::map_chr(repo_iterator, function(repos_id) {
           tryCatch({
             contributors_endpoint <- paste0(private$endpoints[["repositories"]], repos_id, "/contributors")
-            contributors_vec <- private$pull_contributors_from_repo(
+            contributors_vec <- private$get_contributors_from_repo(
               contributors_endpoint = contributors_endpoint,
               user_name = user_name
             )

R/EngineRestGitLab.R

@@ -113,7 +113,7 @@ EngineRestGitLab <- R6::R6Class(
             "/repository/contributors"
           )
           contributors_vec <- tryCatch({
-            private$pull_contributors_from_repo(
+            private$get_contributors_from_repo(
               contributors_endpoint = contributors_endpoint,
               user_name = user_name
             )
@@ -158,46 +158,10 @@ EngineRestGitLab <- R6::R6Class(
         if (verbose) {
           cli::cli_alert_info("Looking up for authors' names and logins...")
         }
-        authors_dict <- purrr::map(unique(commits_table$author), function(author) {
-          author <- url_encode(author)
-          search_endpoint <- paste0(
-            self$rest_api_url,
-            "/search?scope=users&search=%22", author, "%22"
-          )
-          user_response <- list()
-          try({
-            user_response <- self$response(endpoint = search_endpoint)
-          }, silent = TRUE)
-          if (length(user_response) == 0) {
-            author <- stringi::stri_trans_general(author, "Latin-ASCII")
-            search_endpoint <- paste0(
-              self$rest_api_url,
-              "/search?scope=users&search=%22", author, "%22"
-            )
-            try({
-              user_response <- self$response(endpoint = search_endpoint)
-            }, silent = TRUE)
-          }
-          if (!is.null(user_response) && length(user_response) > 1) {
-            user_response <- purrr::keep(user_response, ~ grepl(author, .$name))
-          }
-          if (is.null(user_response) || length(user_response) == 0) {
-            user_tbl <- tibble::tibble(
-              author = URLdecode(author),
-              author_login = NA,
-              author_name = NA
-            )
-          } else {
-            user_tbl <- tibble::tibble(
-              author = URLdecode(author),
-              author_login = user_response[[1]]$username,
-              author_name = user_response[[1]]$name
-            )
-          }
-          return(user_tbl)
-        }, .progress = progress) %>%
-          purrr::list_rbind()
-
+        authors_dict <- private$get_authors_dict(
+          commits_table = commits_table,
+          progress = progress
+        )
         commits_table <- commits_table %>%
           dplyr::mutate(
             author_login = NA,
@@ -423,6 +387,48 @@ EngineRestGitLab <- R6::R6Class(
         FALSE
       }) |>
         purrr::discard(is.null)
+    },
+
+    get_authors_dict = function(commits_table, progress) {
+      purrr::map(unique(commits_table$author), function(author) {
+        author <- url_encode(author)
+        search_endpoint <- paste0(
+          self$rest_api_url,
+          "/search?scope=users&search=%22", author, "%22"
+        )
+        user_response <- list()
+        try({
+          user_response <- self$response(endpoint = search_endpoint)
+        }, silent = TRUE)
+        if (length(user_response) == 0) {
+          author <- stringi::stri_trans_general(author, "Latin-ASCII")
+          search_endpoint <- paste0(
+            self$rest_api_url,
+            "/search?scope=users&search=%22", author, "%22"
+          )
+          try({
+            user_response <- self$response(endpoint = search_endpoint)
+          }, silent = TRUE)
+        }
+        if (!is.null(user_response) && length(user_response) > 1) {
+          user_response <- purrr::keep(user_response, ~ grepl(author, .$name))
+        }
+        if (is.null(user_response) || length(user_response) == 0) {
+          user_tbl <- tibble::tibble(
+            author = URLdecode(author),
+            author_login = NA,
+            author_name = NA
+          )
+        } else {
+          user_tbl <- tibble::tibble(
+            author = URLdecode(author),
+            author_login = user_response[[1]]$username,
+            author_name = user_response[[1]]$name
+          )
+        }
+        return(user_tbl)
+      }, .progress = progress) %>%
+        purrr::list_rbind()
     }
   )
 )

R/GitHost.R

@@ -197,8 +197,10 @@ GitHost <- R6::R6Class(
 
     #' Iterator over pulling release logs from engines
     get_release_logs = function(since, until, verbose, progress) {
-      if (private$scan_all && is.null(private$orgs) && verbose) {
-        cli::cli_alert_info("[{private$host_name}][Engine:{cli::col_yellow('GraphQL')}] Pulling all organizations...")
+      if (private$scan_all && is.null(private$orgs)) {
+        if (verbose) {
+          cli::cli_alert_info("[{private$host_name}][Engine:{cli::col_yellow('GraphQL')}] Pulling all organizations...")
+        }
         private$orgs <- private$engines$graphql$get_orgs()
       }
       until <- until %||% Sys.time()
@@ -668,7 +670,6 @@ GitHost <- R6::R6Class(
             information = "Pulling repositories (URLS)"
           )
         }
-        repos <- private$set_repos(org)
         repos_urls <- rest_engine$get_repos_urls(
           type = type,
           org  = org

R/GitHostGitHub.R

@@ -161,6 +161,7 @@ GitHostGitHub <- R6::R6Class(
               default_branch,
               .after = repo_name
             )
+          return(repo)
         })
       } else {
         repos_table <- NULL

R/GitHostGitLab.R

@@ -355,8 +355,8 @@ GitHostGitLab <- R6::R6Class("GitHostGitLab",
 
     # A helper to turn list of data.frames into one data.frame
     prepare_commits_table = function(commits_list) {
-      commits_dt <- purrr::map(commits_list, function(x) {
-        purrr::map(x, ~ data.frame(.)) %>%
+      commits_dt <- purrr::map(commits_list, function(commit) {
+        purrr::map(commit, ~ data.frame(.)) %>%
           purrr::list_rbind()
       }) %>%
         purrr::list_rbind()

R/test_helpers.R

@@ -31,9 +31,10 @@ GitHostGitHubTest <- R6::R6Class(
                           token = NA,
                           host = NA) {
       private$set_api_url(host)
+      private$set_web_url(host)
       private$set_endpoints()
       private$check_if_public(host)
-      private$set_token(token, verbose = FALSE)
+      private$token <- token
       private$set_graphql_url()
       private$set_orgs_and_repos(orgs, repos, verbose = FALSE)
       private$setup_test_engines()
@@ -66,9 +67,10 @@ GitHostGitLabTest <- R6::R6Class(
                           token = NA,
                           host = NA) {
       private$set_api_url(host)
+      private$set_web_url(host)
       private$set_endpoints()
       private$check_if_public(host)
-      private$set_token(token, verbose = FALSE)
+      private$token <- token
       private$set_graphql_url()
       private$set_orgs_and_repos(orgs, repos, verbose = FALSE)
       private$setup_test_engines()
@@ -90,15 +92,16 @@ GitHostGitLabTest <- R6::R6Class(
 )
 
 #' @noRd
-create_github_testhost <- function(host = NULL,
-                                   orgs = NULL,
+create_github_testhost <- function(host  = NULL,
+                                   orgs  = NULL,
                                    repos = NULL,
+                                   token = NULL,
                                    mode = "") {
   suppressMessages(
     test_host <- GitHostGitHubTest$new(
-      host = NULL,
-      token = Sys.getenv("GITHUB_PAT"),
-      orgs = orgs,
+      host  = NULL,
+      token = token,
+      orgs  = orgs,
       repos = repos
     )
   )
@@ -109,15 +112,16 @@ create_github_testhost <- function(host = NULL,
 }
 
 #' @noRd
-create_gitlab_testhost <- function(host = NULL,
-                                   orgs = NULL,
+create_gitlab_testhost <- function(host  = NULL,
+                                   orgs  = NULL,
                                    repos = NULL,
+                                   token = NULL,
                                    mode = "") {
   suppressMessages(
     test_host <- GitHostGitLabTest$new(
-      host = NULL,
-      token = Sys.getenv("GITLAB_PAT_PUBLIC"),
-      orgs = orgs,
+      host  = NULL,
+      token = token,
+      orgs  = orgs,
       repos = repos
     )
   )

tests/testthat/_snaps/get_repos-GitHub.md → tests/testthat/_snaps/01-get_repos-GitHub.md

@@ -18,7 +18,7 @@
     Code
       gh_repos_table <- github_testhost_priv$get_all_repos()
     Message
-      i [Host:GitHub][Engine:GraphQl][Scope:r-world-devs] Pulling repositories...
+      i [Host:GitHub][Engine:GraphQl][Scope:test-org] Pulling repositories...
 
 # `get_repos_contributors()` adds contributors to repos table
 

tests/testthat/_snaps/get_files_structure-GitHub.md

@@ -5,15 +5,6 @@
     Output
       [1] "query GetFilesFromRepo($org: String!, $repo: String!, $expression: String!) {\n          repository(owner: $org, name: $repo) {\n            id\n            name\n            url\n            object(expression: $expression) {\n              ... on Tree {\n                entries {\n                  name\n                  type\n                }\n              }\n            }\n          }\n      }"
 
-# get_files_structure_from_orgs pulls files structure for repositories in orgs
-
-    Code
-      gh_files_structure_from_orgs <- github_testhost_priv$
-        get_files_structure_from_orgs(pattern = NULL, depth = 2L, verbose = TRUE)
-    Message
-      i [Host:GitHub][Engine:GraphQl][Scope:r-world-devs] Pulling files structure......
-      i [Host:GitHub][Engine:GraphQl][Scope:openpharma] Pulling files structure......
-
 # when files_structure is empty, appropriate message is returned
 
     Code

tests/testthat/_snaps/z-GitStats.md

@@ -18,7 +18,7 @@
       A GitStats object for 2 hosts: 
       Hosts: https://api.github.com, https://gitlab.com/api/v4
       Scanning scope: 
-       Organizations: [2] r-world-devs, mbtests
+       Organizations: [2] github_test_org, gitlab_test_group
        Repositories: [0] 
       Storage: <no data in storage>
 

tests/testthat/helper-expect-responses.R

@@ -242,3 +242,23 @@ expect_github_releases_response <- function(object) {
     })
   })
 }
+
+expect_gitlab_releases_response <- function(object) {
+  expect_type(
+    object,
+    "list"
+  )
+  purrr::walk(object, function(response) {
+    expect_gt(length(response), 0)
+    expect_list_contains(
+      response$data$project,
+      c("releases")
+    )
+    purrr::walk(response$data$project$releases$nodes, function(node) {
+      expect_list_contains(
+        node,
+        c("name", "tagName", "releasedAt", "links", "description")
+      )
+    })
+  })
+}