-
Notifications
You must be signed in to change notification settings - Fork 13
/
gitlab_api.R
350 lines (332 loc) · 10 KB
/
gitlab_api.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
#' Request GitLab API
#'
#' This is 'gitlabr' core function to talk to GitLab's
#' server API via HTTP(S). Usually you will not
#' use this function directly too often, but either use 'gitlabr'
#' convenience wrappers or write your
#' own. See the 'gitlabr' vignette for more information on this.
#'
#' @param req vector of characters that represents the call
#' (e.g. `c("projects", project_id, "events")`)
#' @param api_root URL where the GitLab API to request resides
#' (e.g. `https://gitlab.myserver.com/api/v3/`)
#' @param verb http verb to use for request in form of one of the
#' `httr` functions
#' [httr::GET()], [httr::PUT()], [httr::POST()], [httr::DELETE()]
#' @param auto_format whether to format the returned object automatically
#' to a flat data.frame
#' @param debug if TRUE API URL and query will be printed, defaults to FALSE
#' @param gitlab_con function to use for issuing API requests
#' (e.g. as returned by [get_gitlab_connection()]
#' @param page number of page of API response to get; if "all" (default),
#' all pages (up to max_page parameter!) are queried successively and combined.
#' @param max_page maximum number of pages to retrieve.
#' Defaults to 10. This is an upper limit
#' to prevent 'gitlabr' getting stuck in retrieving
#' an unexpectedly high number of entries (e.g. of a
#' project list). It can be set to NA/Inf to retrieve
#' all available pages without limit, but this
#' is recommended only under controlled circumstances.
#' @param enforce_api_root if multiple pages are requested,
#' the API root URL is ensured
#' to be the same as in the original call for all calls
#' using the "next page" URL returned
#' by GitLab This makes sense for security and in cases
#' where GitLab is behind a reverse proxy
#' and ignorant about its URL from external.
#' @param argname_verb name of the argument of the verb
#' that fields and information are passed on to
#' @param ... named parameters to pass on to GitLab API
#' (technically: modifies query parameters of request URL),
#' may include private_token and all other parameters
#' as documented for the GitLab API
#'
#' @importFrom utils capture.output
#' @importFrom tibble tibble as_tibble
#' @importFrom magrittr %T>%
#' @importFrom dplyr bind_rows
#' @importFrom stringr str_replace_all str_replace
#' @export
#'
#' @return the response from the GitLab API,
#' usually as a `tibble` and including all pages
#'
#' @details
#' `gitlab()` function allows to use any request
#' of the GitLab API <https://docs.gitlab.com/ce/api/>.
#'
#' For instance, the API documentation shows how to create a new project in
#' <https://docs.gitlab.com/ce/api/projects.html#create-project>:
#'
#' - The verb is `POST`
#' - The request is `projects`
#' - Required attributes are `name` or `path` (if `name` not set)
#' - `default_branch` is an attribute that can be set if wanted
#'
#' The corresponding use of `gitlab()` is:
#'
#' ```
#' gitlab(
#' req = "projects",
#' verb = httr::POST,
#' name = "toto",
#' default_branch = "main"
#' )
#' ```
#'
#' Note: currently GitLab API v4 is supported.
#' GitLab API v3 is no longer supported, but
#' you can give it a try.
#'
#' @examples \dontrun{
#' # Connect as a fixed user to a GitLab instance
#' set_gitlab_connection(
#' gitlab_url = "https://gitlab.com",
#' private_token = Sys.getenv("GITLAB_COM_TOKEN")
#' )
#'
#' # Use a simple request
#' gitlab(req = "projects")
#' # Use a combined request with extra parameters
#' gitlab(
#' req = c("projects", 1234, "issues"),
#' state = "closed"
#' )
#' }
gitlab <- function(req,
api_root,
verb = httr::GET,
auto_format = TRUE,
debug = FALSE,
gitlab_con = "default",
page = "all",
max_page = 10,
enforce_api_root = TRUE,
argname_verb =
if (
identical(verb, httr::GET) ||
identical(verb, httr::DELETE)
) {
"query"
} else {
"body"
},
...) {
if (!is.function(gitlab_con) &&
gitlab_con == "default" &&
!is.null(get_gitlab_connection())) {
gitlab_con <- get_gitlab_connection()
}
if (!is.function(gitlab_con)) {
url <- req %>%
paste(collapse = "/") %>%
prefix(api_root, "/") %T>%
iff(debug, function(x) {
print(
paste(c("URL:", x, " ",
"query:",
paste(
utils::capture.output(print((list(...)))),
collapse = " "
), " ",
collapse = " "
))
)
x
})
# Extract private token to put it in header
l <- list(...)
private_token <- l$private_token
l <- within(l, rm(private_token))
private_token_header <- httr::add_headers("PRIVATE-TOKEN" = private_token)
(if (page == "all") {
flattenbody(l)
} else {
c(page = page, flattenbody(l))
}) %>%
pipe_into(argname_verb, verb, url = url, private_token_header) %>%
http_error_or_content() -> resp
resp$ct %>%
## better would be to check MIME type
iff(auto_format, json_to_flat_df) %>%
iff(debug, print) -> resp$ct
if (page == "all") {
pages_retrieved <- 1L # 1 already retrieved
while (length(resp$nxt) > 0
) {
if (
!is.na(max_page) &&
is.finite(max_page) &&
pages_retrieved >= max_page
) {
message("max_page reached, stop retrieving pages...")
break
}
nxt_resp <- resp$nxt %>%
as.character() %>%
iff(
enforce_api_root,
stringr::str_replace, "^.*/api/v\\d/",
api_root
) %>%
httr::GET(private_token_header) %>%
http_error_or_content()
resp$nxt <- nxt_resp$nxt
if (auto_format) {
resp$ct <- bind_rows(
resp$ct,
nxt_resp$ct %>%
json_to_flat_df()
)
} else {
resp$ct <- c(resp$ct, nxt_resp$ct)
}
pages_retrieved <- pages_retrieved + 1
}
}
return(resp$ct)
} else {
if (!missing(req)) {
dot_args <- list(req = req)
} else {
dot_args <- list()
}
if (!missing(api_root)) {
dot_args <- c(dot_args, api_root = api_root)
}
if (!missing(verb)) {
dot_args <- c(dot_args, verb = verb)
}
if (!missing(auto_format)) {
dot_args <- c(dot_args, auto_format = auto_format)
}
if (!missing(debug)) {
dot_args <- c(dot_args, debug = debug)
}
if (!missing(page)) {
dot_args <- c(dot_args, page = page)
}
if (!missing(max_page)) {
dot_args <- c(dot_args, max_page = max_page)
}
do.call(gitlab_con, c(dot_args,
gitlab_con = "self",
list(...)
)) %>%
iff(debug, print)
}
}
http_error_or_content <- function(response,
handle = httr::stop_for_status,
...) {
if (!identical(handle(response), FALSE)) {
ct <- httr::content(response, ...)
nxt <- get_next_link(httr::headers(response)$link)
list(ct = ct, nxt = nxt)
}
}
#' @importFrom stringr str_replace_all str_split
#' @noRd
get_rel <- function(links) {
links %>%
stringr::str_split(",\\s+") %>%
getElement(1) -> strs
tibble::tibble(
link = strs %>%
lapply(stringr::str_replace_all, "\\<(.+)\\>.*", "\\1") %>%
unlist(),
rel = strs %>%
lapply(stringr::str_replace_all, ".+rel=.(\\w+).", "\\1") %>%
unlist(),
stringsAsFactors = FALSE
)
}
#' @importFrom dplyr filter
#' @noRd
get_next_link <- function(links) {
if (is.null(links)) {
return(NULL)
} else {
links %>%
get_rel() %>%
filter(rel == "next") %>%
getElement("link")
}
}
is.nested.list <- function(l) {
is.list(l) && any(unlist(lapply(l, is.list)))
is.list(l[26]) && any(unlist(lapply(l[26], is.list)))
}
is_named <- function(v) {
!is.null(names(v))
}
is_single_row <- function(l) {
if (length(l) == 1 || !any(lapply(l, is.list) %>% unlist())) {
return(TRUE)
} else {
# if (is.null(names(l)))
# not named, then probably multiple rows
# at least one name is the same shows multiple lines
all_names <- lapply(l, names)
if (any(
lapply(all_names, function(x) any(x %in% all_names[[1]])) %>% unlist()
)) {
return(FALSE)
} else {
return(TRUE)
}
}
}
format_row <- function(row, ...) {
row %>%
lapply(unlist, use.names = FALSE, ...) %>%
# tibble::as_tibble(stringsAsFactors = FALSE)
tibble::as_tibble(.name_repair = "unique")
}
#' @importFrom dplyr bind_rows
#' @noRd
json_to_flat_df <- function(l) {
l %>%
iff(is_single_row, list) %>%
lapply(unlist, recursive = TRUE) %>%
lapply(format_row) %>%
bind_rows()
}
call_filter_dots <- function(fun,
.dots = list(),
.dots_allowed = gitlab %>%
formals() %>%
names() %>%
setdiff("...") %>%
c("api_root", "private_token"),
...) {
do.call(fun, args = c(list(...), .dots[intersect(.dots_allowed, names(.dots))]))
}
#' Flatten a list as duplicate names list
#' for httr requests
#'
#' @param x a list
#' @return a list
#'
#' @noRd
flattenbody <- function(x) {
# issued from https://stackoverflow.com/a/72532186
# A form/query can only have one value per name, so take
# any values that contain vectors length >1 and
# split them up
# list(x=1:2, y="a") becomes list(x=1, x=2, y="a")
if (all(lengths(x) <= 1)) {
return(x)
}
do.call("c", mapply(function(name, val) {
if (length(val) == 1 || any(c("form_file", "form_data") %in% class(val))) {
x <- list(val)
names(x) <- name
x
} else {
x <- as.list(val)
names(x) <- rep(name, length(val))
x
}
}, names(x), x, USE.NAMES = FALSE, SIMPLIFY = FALSE))
}