diff --git a/.Rbuildignore b/.Rbuildignore index 4110eac..35f3eaa 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,3 +1,4 @@ ^.*\.Rproj$ ^\.Rproj\.user$ -^README.md \ No newline at end of file +^README.md +NOTICE diff --git a/DESCRIPTION b/DESCRIPTION index 852b46f..c807d31 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,19 +2,21 @@ Package: loadtest Type: Package Title: HTTP load testing directly from R Version: 0.1.2 -Author@R: person("Jacqueline", "Nolis", email = "jacqueline.nolis2@t-mobile.com", role = c("aut", "cre")) -Description: This package allows you to run a load test of an HTTP request, such as for an R plumber REST API, from within R +Authors@R: person("Jacqueline", "Nolis", email = "jacqueline.nolis2@t-mobile.com", + role = c("aut", "cre")) +Description: This package allows you to run a load test of an HTTP request, + such as for an R plumber REST API, from within R. License: file LICENSE Encoding: UTF-8 LazyData: true Imports: glue (>= 1.3.1), jsonlite (>= 1.6) -RoxygenNote: 6.1.1 +RoxygenNote: 7.1.0 Suggests: - testthat, - rmarkdown, - ggplot2, - dplyr, - tidyr + testthat, + rmarkdown, + ggplot2, + dplyr, + tidyr SystemRequirements: Both Java 8+ and Apache JMeter are installed diff --git a/R/loadtest.R b/R/loadtest.R index 1b7a2b0..2022cab 100644 --- a/R/loadtest.R +++ b/R/loadtest.R @@ -18,6 +18,60 @@ # software without specific prior written permission. # ========================================================================= +## quiets concerns of R CMD check re: the variables in pipelines +if (getRversion() >= "2.15.1") { + utils::globalVariables( + c( + ".", "time_since_start", "elapsed", "request_status", "elapsed", "thread", + "time_since_start_rounded", "n", "p", "label" + ) + ) +} + +#' Convert a query string into its parts +#' +#' This function gets the query parameters from a url as input, +#' and outputs a list. Each element's name is the name of the parameters, +#' and each element's value is the parameter's value. +#' +#' @param query_string a string containing the query parameters e.g.: "postId=1&userId=1" +#' +#' @return a list +#' +#' @examples +#' parse_query_string("postId=1&userId=1") +parse_query_string <- function(query_string) { + query_parts <- strsplit(query_string, "&", fixed = TRUE)[[1]] + parameters <- strsplit(query_parts, "=", fixed = TRUE) + valid_parameters <- parameters[sapply(parameters, length) == 2] + + if (length(valid_parameters) < length(parameters)) { + warning( + paste("The following parameters did not have a value and were dropped:", + paste(sapply(setdiff(parameters, valid_parameters), "[[", 1), collapse = ", ")) + ) + } + + keys <- sapply(valid_parameters, "[[", 1) + decoded_keys <- unname(sapply(keys, URLdecode)) + + parameter_values <- sapply(valid_parameters, "[[", 2) + decoded_values <- unname(sapply(parameter_values, URLdecode)) + + return_list <- as.list(setNames(decoded_values, decoded_keys)) + + unique_names <- unique(names(return_list)) + + if (length(unique_names) < length(names(return_list))) { + warning( + paste("Duplicate parameters found, using only the first occurence of:", + paste(names(return_list)[duplicated(return_list)]), collapse = ", ") + ) + } + + return_list[unique_names] +} + #' Convert a url into core components #' @@ -43,8 +97,15 @@ parse_url <- function(url){ protocol <- "http" } - domain <- parsed_url[[3]] - path <- parsed_url[[5]] + domain <- gsub("/", "", parsed_url[[3]]) + full_path <- parsed_url[[5]] + path_elements <- strsplit(parsed_url[[5]], "\\?") + + if (length(path_elements[[1]]) == 0) { + path <- "/" + } else { + path <- path_elements[[1]][[1]] + } # find the port port <- parsed_url[[4]] @@ -57,9 +118,40 @@ parse_url <- function(url){ } } + if (length(path_elements[[1]]) > 1) { + query_parameters <- parse_query_string(path_elements[[1]][[2]]) + return( + list(protocol = protocol, domain = domain, path = path, port = port, + query_parameters = query_parameters) + ) + } + list(protocol = protocol, domain = domain, path = path, port = port) } +#' Encode HTML/XML entities +#' +#' Jemeter's documentation in XML which means special characters like &, <, > +#' need to be encoded as HTML entities. This function does that without dependencies. +#' +#' @param stringified_body the request body as a single string +#' +#' @return a string +#' +#' @examples +#' encode_html_entities('{"title":"this & that"}') +encode_html_entities <- function(stringified_body) { + body_noamp <- gsub("&", "&", stringified_body) + body_noquot <- gsub("\"", """, body_noamp) + body_nogt <- gsub(">", ">", body_noquot) + body_nolt <- gsub("<", "<", body_nogt) + body_noapos <- gsub("\'", "'", body_nolt) + + encoded_body <- gsub("\"", """, body_noapos) + + encoded_body +} + #' Run a load test of an HTTP request #' #' This is the core function of the package, which creates many HTTP requests using Apache JMeter. @@ -126,7 +218,6 @@ loadtest <- function(url, loops = 16, ramp_time = 0, delay_per_request = 0){ - invisible(check_java_installed()) invisible(check_jmeter_installed()) @@ -139,6 +230,7 @@ loadtest <- function(url, domain <- parsed_url$domain path <- parsed_url$path port <- parsed_url$port + query_parameters <- parsed_url$query_parameters read_file_as_char <- function(file_name){ readChar(file_name, file.info(file_name)$size) @@ -147,7 +239,7 @@ loadtest <- function(url, template <- read_file_as_char(system.file("template.jmx", package = "loadtest")) # tempate for the full request header_template <- read_file_as_char(system.file("header_template.txt", package = "loadtest")) # template for each request header body_template <- read_file_as_char(system.file("body_template.txt", package = "loadtest")) # template for the request body, if one is needed - + query_parameters_template <- read_file_as_char(system.file("query_parameters_template.txt", package = "loadtest")) # template for the query parameters, if one is needed original_headers <- headers original_body <- body @@ -170,9 +262,11 @@ loadtest <- function(url, if(!is.null(body)){ if(encode=="json"){ - request_body <- gsub("\"", """, jsonlite::toJSON(body,auto_unbox=TRUE)) + json_body <- jsonlite::toJSON(body,auto_unbox=TRUE) + request_body <- encode_html_entities(json_body) + } else if(encode=="raw"){ - request_body <- gsub("\"", """, body) + request_body <- request_body <- encode_html_entities(body) } else { stop("'encode' value not yet supported") } @@ -181,6 +275,13 @@ loadtest <- function(url, body <- "" } + if (!is.null(query_parameters)) { + query_parameters_in_template <- lapply(seq_along(query_parameters), function(i) glue::glue(query_parameters_template, name=names(query_parameters)[[i]],value=query_parameters[[i]])) + query_parameters <- paste0(query_parameters_in_template,collapse="\n") + } else { + query_parameters <- "" + } + # where to save the test specification spec_location <- tempfile(fileext = ".jmx") @@ -199,7 +300,7 @@ loadtest <- function(url, message("loadtest - completed load test") # read back in the results as a data frame ------------------------------- - output <- read.csv(save_location, + output <- utils::read.csv(save_location, stringsAsFactors = FALSE, colClasses = c( timeStamp = "numeric", diff --git a/R/loadtest_report.R b/R/loadtest_report.R index 30b65a6..deb0559 100644 --- a/R/loadtest_report.R +++ b/R/loadtest_report.R @@ -23,7 +23,7 @@ #' #' This function uses R markdown to take the results of a jmeter run and turn it #' -#' @param result the output of using loadtest() +#' @param results the output of using loadtest() #' @param output_file the location to save the report. Defaults to creating loadtest_report.html in the working directory. #' @examples #' results <- loadtest(url = "https://www.t-mobile.com", method="GET", threads = 3, loops = 5) diff --git a/R/plots.R b/R/plots.R index c569ac1..f4256ec 100644 --- a/R/plots.R +++ b/R/plots.R @@ -25,7 +25,7 @@ #' @return A ggplot2 showing the elapsed times of the requests during the test #' @examples #' results <- loadtest("google.com","GET") -#' plot_elapsed_times(result) +#' plot_elapsed_times(results) #' @export plot_elapsed_times <- function(results){ if (!requireNamespace("ggplot2", quietly = TRUE)) { @@ -42,7 +42,7 @@ plot_elapsed_times <- function(results){ ggplot2::scale_color_manual(values=c("#606060", "#E20074"), drop=FALSE)+ ggplot2::theme(legend.position = "bottom")+ ggplot2::scale_y_continuous(limits=c(0,NA))+ - ggplot2::geom_hline(yintercept = median(results$elapsed)) + ggplot2::geom_hline(yintercept = stats::median(results$elapsed)) } #' Plot the elapsed times of the requests as a histogram diff --git a/inst/query_parameters_template.txt b/inst/query_parameters_template.txt new file mode 100644 index 0000000..8304dcb --- /dev/null +++ b/inst/query_parameters_template.txt @@ -0,0 +1,7 @@ + + true + {value} + = + true + {name} + diff --git a/inst/template.jmx b/inst/template.jmx index 5c23d8c..d4661c8 100644 --- a/inst/template.jmx +++ b/inst/template.jmx @@ -27,6 +27,11 @@ {body} + + + {query_parameters} + + {domain} {port} {protocol} diff --git a/man/encode_html_entities.Rd b/man/encode_html_entities.Rd new file mode 100644 index 0000000..f4c7f36 --- /dev/null +++ b/man/encode_html_entities.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/loadtest.R +\name{encode_html_entities} +\alias{encode_html_entities} +\title{Encode HTML/XML entities} +\usage{ +encode_html_entities(stringified_body) +} +\arguments{ +\item{stringified_body}{the request body as a single string} +} +\value{ +a string +} +\description{ +Jemeter's documentation in XML which means special characters like &, <, > +need to be encoded as HTML entities. This function does that without dependencies. +} +\examples{ +encode_html_entities('{"title":"this & that"}') +} diff --git a/man/loadtest.Rd b/man/loadtest.Rd index 8ec5d62..210695c 100644 --- a/man/loadtest.Rd +++ b/man/loadtest.Rd @@ -4,10 +4,17 @@ \alias{loadtest} \title{Run a load test of an HTTP request} \usage{ -loadtest(url, method = c("GET", "POST", "HEAD", "TRACE", "OPTIONS", - "PUT", "DELETE"), headers = NULL, body = NULL, encode = c("raw", - "json"), threads = 1, loops = 16, ramp_time = 0, - delay_per_request = 0) +loadtest( + url, + method = c("GET", "POST", "HEAD", "TRACE", "OPTIONS", "PUT", "DELETE"), + headers = NULL, + body = NULL, + encode = c("raw", "json"), + threads = 1, + loops = 16, + ramp_time = 0, + delay_per_request = 0 +) } \arguments{ \item{url}{The url to hit as part of the test, such as https://www.t-mobile.com .} diff --git a/man/loadtest_report.Rd b/man/loadtest_report.Rd index d3feb38..dad3b53 100644 --- a/man/loadtest_report.Rd +++ b/man/loadtest_report.Rd @@ -7,9 +7,9 @@ loadtest_report(results, output_file = NULL) } \arguments{ -\item{output_file}{the location to save the report. Defaults to creating loadtest_report.html in the working directory.} +\item{results}{the output of using loadtest()} -\item{result}{the output of using loadtest()} +\item{output_file}{the location to save the report. Defaults to creating loadtest_report.html in the working directory.} } \description{ This function uses R markdown to take the results of a jmeter run and turn it diff --git a/man/parse_query_string.Rd b/man/parse_query_string.Rd new file mode 100644 index 0000000..eb2b1e5 --- /dev/null +++ b/man/parse_query_string.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/loadtest.R +\name{parse_query_string} +\alias{parse_query_string} +\title{Convert a query string into its parts} +\usage{ +parse_query_string(query_string) +} +\arguments{ +\item{query_string}{a string containing the query parameters e.g.: "postId=1&userId=1"} +} +\value{ +a list +} +\description{ +This function gets the query parameters from a url as input, +and outputs a list. Each element's name is the name of the parameters, +and each element's value is the parameter's value. +} +\examples{ +parse_query_string("postId=1&userId=1") +} diff --git a/man/plot_elapsed_times.Rd b/man/plot_elapsed_times.Rd index ea8cde6..71f599e 100644 --- a/man/plot_elapsed_times.Rd +++ b/man/plot_elapsed_times.Rd @@ -17,5 +17,5 @@ Plot the elapsed times of the requests } \examples{ results <- loadtest("google.com","GET") -plot_elapsed_times(result) +plot_elapsed_times(results) } diff --git a/tests/testthat/test_loadtest.R b/tests/testthat/test_loadtest.R index cdd868c..a7cf25b 100644 --- a/tests/testthat/test_loadtest.R +++ b/tests/testthat/test_loadtest.R @@ -56,4 +56,94 @@ test_that("loadtest works with more method/headers/body", { expect_is(results, "data.frame") expect_equal(nrow(results), threads*loops, label = "Table had invalid number of rows") expect_true(all(results$request_status=="Success"),label = "Some requests failed") + + results <- loadtest("https://jsonplaceholder.typicode.com/comments?postId=1&userId=1", + method = "GET", + threads = threads, + loops = loops, + delay_per_request = 250) + + expect_is(results, "data.frame") + expect_equal(nrow(results), threads*loops, label = "Table had invalid number of rows") + expect_true(all(results$request_status=="Success"),label = "Some requests failed") +}) + +test_that("loadtest works with nested body", { + threads <- 2 + loops <- 5 + results <- loadtest("http://httpbin.org/post", + method = "POST", + headers = c("version" = "v1.0"), + body = list(text = list("example text")), + encode = "json", + threads = threads, + loops = loops, + delay_per_request = 250) + expect_is(results, "data.frame") + expect_equal(nrow(results), threads*loops, label = "Table had invalid number of rows") + expect_true(all(results$request_status=="Success"),label = "Some requests failed") +}) + +test_that("loadtest works with query parameters", { + threads <- 2 + loops <- 5 + results <- loadtest("https://jsonplaceholder.typicode.com/comments?postId=1&userId=1", + method = "GET", + threads = threads, + loops = loops, + delay_per_request = 250) + + expect_is(results, "data.frame") + expect_equal(nrow(results), threads*loops, label = "Table had invalid number of rows") + expect_true(all(results$request_status=="Success"),label = "Some requests failed") +}) + +test_that("query string is correctly parsed", { + query_string <- "postId=1&userId=1&whatever=888" + result <- loadtest:::parse_query_string(query_string) + + expect_is(result, "list") + expect_equal(names(result), c("postId", "userId", "whatever")) + expect_equal(result$postId[[1]], "1") + expect_equal(result$userId[[1]], "1") + expect_equal(result$whatever[[1]], "888") + + query_string <- "postId=1&userId=1&whatever=" + expect_warning(loadtest:::parse_query_string(query_string), + "The following parameters did not have a value and were dropped: whatever") + + query_string <- "postId=1&userId=1&userId=8" + expect_warning(loadtest:::parse_query_string(query_string), + "Duplicate parameters found, using only the first occurence of: userId") + + result <- suppressWarnings(loadtest:::parse_query_string(query_string)) + expect_equal(names(result), c("postId", "userId")) + expect_equal(result$postId[[1]], "1") + expect_equal(result$userId[[1]], "1") +}) + +test_that("query path is correctly parsed", { + expect_equal( + loadtest:::parse_url("https://jsonplaceholder.typicode.com/"), + list(protocol = "https", domain = "jsonplaceholder.typicode.com", + path = "/", port = "443") + ) + + expect_equal( + loadtest:::parse_url("https://jsonplaceholder.typicode.com/comments?postId=1&userId=1"), + list(protocol = "https", domain = "jsonplaceholder.typicode.com", + path = "/comments", port = "443", + query_parameters = list(postId = "1", userId = "1")) + ) +}) + +test_that("encode_html_entities works", { + test_body <- list(title = "this & that", + body = "!@#$%^&*()-=+~`?/>.<,±§'|:;{]{}äüãçöß]", + userId = 1) + json_body <- jsonlite::toJSON(test_body, auto_unbox = TRUE) + expect_equal( + as.character(encode_html_entities(json_body)), + "{"title":"this & that","body":"!@#$%^&*()-=+~`?/>.<,±§'|:;{]{}äüãçöß]","userId":1}" + ) })