forked from rstudio/plumber
-
Notifications
You must be signed in to change notification settings - Fork 0
/
query-string.R
121 lines (101 loc) · 3.18 KB
/
query-string.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
queryStringFilter <- function(req){
handled <- req$.internal$queryStringHandled
if (is.null(handled) || handled != TRUE){
qs <- req$QUERY_STRING
args <- parseQS(qs)
req$args <- c(req$args, args)
req$.internal$queryStringHandled <- TRUE
}
forward()
}
#' @importFrom utils URLdecode
#' @noRd
parseQS <- function(qs){
if (is.null(qs) || length(qs) == 0 || qs == "") {
return(list())
}
if (stri_startswith_fixed(qs, "?")) {
qs <- substr(qs, 2, nchar(qs))
}
parts <- strsplit(qs, "&", fixed = TRUE)[[1]]
kv <- strsplit(parts, "=", fixed = TRUE)
kv <- kv[sapply(kv, length) == 2] # Ignore incompletes
if (length(kv) == 0L) return(list())
keys <- sapply(kv, "[[", 1)
keys <- unname(sapply(keys, URLdecode))
Encoding(keys) <- "UTF-8"
# The query string (after URL decoding) is usually UTF-8,
# but this is not always true. For simplicity, we'll just
# enforce that it has to be UTF-8, and not support other encodings.
# We also need to ensure that R understands that it's UTF-8.
vals <- sapply(kv, "[[", 2)
vals[is.na(vals)] <- ""
vals <- unname(sapply(vals, URLdecode))
Encoding(vals) <- "UTF-8" # The reason is the same as above
ret <- as.list(vals)
names(ret) <- keys
# If duplicates, combine
combine_elements <- function(name){
unname(unlist(ret[names(ret)==name]))
}
unique_names <- unique(names(ret))
ret <- lapply(unique_names, combine_elements)
names(ret) <- unique_names
ret
}
createPathRegex <- function(pathDef){
# Create a regex from the defined path, substituting variables where appropriate
match <- stringi::stri_match_all(pathDef, regex="/<(\\.?[a-zA-Z][\\w_\\.]*)(:(int|double|numeric|bool|logical))?>")[[1]]
names <- match[,2]
type <- match[,4]
if (length(names) <= 1 && is.na(names)){
names <- character()
type <- NULL
}
typedRe <- typeToRegex(type)
re <- pathDef
for (r in typedRe){
repl <- paste0("/(", r, ")$2")
re <- stringi::stri_replace_first_regex(re, pattern="/(<\\.?[a-zA-Z][\\w_\\.:]*>)(/?)",
replacement=repl)
}
converters <- typeToConverters(type)
list(names = names, types=type, regex = paste0("^", re, "$"), converters=converters)
}
typeToRegex <- function(type){
re <- rep("[^/]+", length(type))
re[type == "int"] <- "-?\\\\d+"
re[type == "double" | type == "numeric"] <- "-?\\\\d*\\\\.?\\\\d+"
re[type == "bool" | type == "logical"] <- "[01tfTF]|true|false|TRUE|FALSE"
re
}
typeToConverters <- function(type){
re <- NULL
for (t in type){
r <- function(x){x}
if (!is.na(t)){
if (t == "int"){
r <- as.integer
} else if (t == "double" || t == "numeric"){
r <- as.numeric
} else if (t == "bool" || t == "logical"){
r <- as.logical
}
}
re <- c(re, r)
}
re
}
# Extract the params from a given path
# @param def is the output from createPathRegex
extractPathParams <- function(def, path){
vals <- as.list(stringi::stri_match(path, regex = def$regex)[,-1])
names(vals) <- def$names
if (!is.null(def$converters)){
# Run each value through its converter
for (i in 1:length(vals)){
vals[[i]] <- def$converters[[i]](vals[[i]])
}
}
vals
}