diff options
Diffstat (limited to 'tests/helper')
| -rw-r--r-- | tests/helper/server.R | 114 | ||||
| -rw-r--r-- | tests/helper/utils.R | 127 |
2 files changed, 241 insertions, 0 deletions
diff --git a/tests/helper/server.R b/tests/helper/server.R new file mode 100644 index 0000000..48f9a39 --- /dev/null +++ b/tests/helper/server.R @@ -0,0 +1,114 @@ +args <- commandArgs(trailingOnly = TRUE) +routes <- readRDS(args[[1L]]) +logfile <- args[[2L]] +readyfile <- args[[3L]] + +server <- NULL +port <- NA_integer_ +for (candidate in sample(20000:60000, 500L)) { + server <- tryCatch(serverSocket(candidate), error = function(e) NULL) + if (!is.null(server)) { + port <- candidate + break + } +} +if (is.null(server)) { + stop("no free port for the fake server") +} + +state <- new.env(parent = emptyenv()) +state$queues <- lapply(routes, function(route) route$responses) + +pick <- function(path) { + index <- NA_integer_ + for (i in seq_along(routes)) { + if (identical(routes[[i]]$match, path)) { + index <- i + break + } + } + if (is.na(index)) { + for (i in seq_along(routes)) { + if (startsWith(path, routes[[i]]$match)) { + index <- i + break + } + } + } + if (is.na(index)) { + return(list( + status = 404L, + body = "{\"erro\":\"cep_nao_encontrado\"}", + headers = list() + )) + } + queue <- state$queues[[index]] + if (length(queue) > 1L) { + state$queues[[index]] <- queue[-1L] + } + queue[[1L]] +} + +send <- function(connection, response) { + body <- charToRaw(enc2utf8(response$body)) + head <- paste0("HTTP/1.1 ", response$status, " Response\r\n") + for (name in names(response$headers)) { + head <- paste0(head, name, ": ", response$headers[[name]], "\r\n") + } + head <- paste0( + head, + "Content-Type: text/plain; charset=utf-8\r\n", + "Content-Length: ", length(body), "\r\n", + "Connection: close\r\n\r\n" + ) + try( + { + writeBin(c(charToRaw(head), body), connection) + flush(connection) + }, + silent = TRUE + ) +} + +pending <- paste0(readyfile, ".tmp") +writeLines(as.character(port), pending) +file.rename(pending, readyfile) + +repeat { + if (!socketSelect(list(server), timeout = 60)) { + break + } + connection <- socketAccept(server, blocking = TRUE, open = "r+b", + timeout = 10) + path <- NA_character_ + repeat { + line <- readLines(connection, n = 1L, warn = FALSE) + if (length(line) == 0L) { + break + } + line <- sub("\r$", "", line) + if (!nzchar(line)) { + break + } + if (is.na(path)) { + path <- strsplit(line, " ", fixed = TRUE)[[1L]][2L] + } + } + + stopping <- FALSE + if (!is.na(path)) { + cat(path, "\n", sep = "", file = logfile, append = TRUE) + if (identical(path, "/__shutdown__")) { + stopping <- TRUE + send(connection, list(status = 200L, body = "bye", headers = list())) + } else { + send(connection, pick(path)) + } + } + try(close(connection), silent = TRUE) + if (stopping) { + break + } +} + +close(server) diff --git a/tests/helper/utils.R b/tests/helper/utils.R new file mode 100644 index 0000000..3c24a2f --- /dev/null +++ b/tests/helper/utils.R @@ -0,0 +1,127 @@ +SERVER_SCRIPT <- normalizePath(file.path("helper", "server.R"), mustWork = TRUE) + +SE_ADDRESS <- list( + cep = "01001000", + logradouro = "Pra\u00e7a da S\u00e9", + complemento = "lado \u00edmpar", + unidade = "", + bairro = "S\u00e9", + localidade = "S\u00e3o Paulo", + uf = "SP", + estado = "S\u00e3o Paulo", + regiao = "Sudeste", + ibge = "3550308", + gia = "1004", + ddd = "11", + siafi = "7107" +) + +CSV_HEADER <- paste0( + "cep,logradouro,complemento,unidade,bairro,localidade,uf,estado,regiao,", + "ibge,gia,ddd,siafi" +) + +json <- function(x) { + as.character(jsonlite::toJSON(x, auto_unbox = TRUE)) +} + +csv <- function(rows) { + paste0(CSV_HEADER, "\n", paste(rows, collapse = "\n"), "\n") +} + +response <- function(status, body, headers = list()) { + list(status = status, body = body, headers = headers) +} + +route <- function(match, ...) { + list(match = match, responses = list(...)) +} + +start_server <- function(routes) { + directory <- tempfile("cepis-fake-server-") + dir.create(directory) + routes_path <- file.path(directory, "routes.rds") + saveRDS(routes, routes_path) + logfile <- file.path(directory, "requests.log") + file.create(logfile) + readyfile <- file.path(directory, "ready") + + system2( + file.path(R.home("bin"), "Rscript"), + shQuote(c(SERVER_SCRIPT, routes_path, logfile, readyfile)), + wait = FALSE, + stdout = file.path(directory, "stdout"), + stderr = file.path(directory, "stderr") + ) + + deadline <- Sys.time() + 30 + while (!file.exists(readyfile) && Sys.time() < deadline) { + Sys.sleep(0.02) + } + if (!file.exists(readyfile)) { + stop( + "the fake server did not start: ", + paste(readLines(file.path(directory, "stderr"), warn = FALSE), + collapse = " ") + ) + } + + port <- readLines(readyfile, warn = FALSE)[[1L]] + list( + url = paste0("http://127.0.0.1:", port), + directory = directory, + logfile = logfile + ) +} + +stop_server <- function(server) { + try( + curl::curl_fetch_memory(paste0(server$url, "/__shutdown__")), + silent = TRUE + ) + unlink(server$directory, recursive = TRUE) +} + +calls <- function(server, prefix = "") { + lines <- readLines(server$logfile, warn = FALSE) + sum(startsWith(lines, prefix)) +} + +with_server <- function(routes, body) { + server <- start_server(routes) + on.exit(stop_server(server), add = TRUE) + client <- cepis_client( + base_url = server$url, + timeout = 5, + backoff_base = 0.001, + backoff_max = 0.01 + ) + body(client, server) +} + +caught <- function(expr) { + tryCatch( + { + force(expr) + NULL + }, + error = function(condition) condition + ) +} + +check <- function(label, condition) { + if (!isTRUE(condition)) { + stop("FAIL: ", label, call. = FALSE) + } + cat("ok - ", label, "\n", sep = "") + invisible(TRUE) +} + +check_condition <- function(label, expr, class) { + condition <- caught(expr) + check( + label, + inherits(condition, class) && inherits(condition, "cepis_error") + ) + invisible(condition) +} |