additional curl options can be provided to influx_connection (#36)

dleutnant · Dec 7, 2017 · bef8e99 · bef8e99
1 parent f90768f
commit bef8e99
Show file tree

Hide file tree

Showing 11 changed files with 121 additions and 57 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Package: influxdbr
 Type: Package
 Title: R Interface to InfluxDB
-Version: 0.14.1.9000
-Date: 2017-11-18
+Version: 0.14.2.9000
+Date: 2017-12-07
 Authors@R: person("Dominik", "Leutnant", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-3293-2315"))
 Description: An R interface to the InfluxDB time series database <https://www.influxdata.com>. This package allows you to fetch and write time series data from/to an InfluxDB server. Additionally, handy wrappers for the Influx Query Language (IQL) to manage and explore a remote database are provided. 
 License: GPL-3

diff --git a/NEWS.md b/NEWS.md
@@ -1,7 +1,9 @@
-# influxdbr 0.14.1.9000
+# influxdbr 0.14.2.9000
 
 ## New features
 
+* `influx_connection` gains new argument `curl_options` to control http communication
+
 * `influx_write` function gets `measurement_col` argument to enable writing a 
 data.frame with multiple measurements with only one function call
 

diff --git a/R/influxdb_connection.R b/R/influxdb_connection.R
@@ -3,7 +3,7 @@
 #' connection details. Credentials can also be saved and accessed through a 
 #' config file.
 #' @param scheme The scheme to use, either http or https. Defaults to http.
-#' @param host Hostname of the InfluxDB server. Defaults to localhost
+#' @param host Hostname of the InfluxDB server. Defaults to localhost.
 #' @param port numerical. Port number of the InfluxDB server. Defaults to 8086.
 #' @param user username The username to use. Defaults to "user"
 #' @param pass password The password to use. Defaults to "pass".
@@ -13,6 +13,8 @@
 #' @param verbose logical. Provide additional details?
 #' @param config_file The configuration file to be used if `group` is
 #' specified.
+#' @param curl_options Additional curl arguments created with \code{\link[httr]{config}} 
+#' (e.g. httr::config(verbose = TRUE, timeout = 5, ssl_verifypeer = FALSE)). 
 #' @rdname influx_connection
 #' @export
 #' @references \url{https://influxdb.com/}
@@ -36,7 +38,8 @@ influx_connection <-  function(scheme = c("http", "https"),
                                path = "/",
                                group = NULL,
                                verbose = FALSE,
-                               config_file = "~/.influxdb.cnf") {
+                               config_file = "~/.influxdb.cnf",
+                               curl_options = NULL) {
   # if group name is given, get db credentials from config file
   if (!is.null(group)) {
     if (file.exists(config_file)) {
@@ -71,6 +74,13 @@ influx_connection <-  function(scheme = c("http", "https"),
 
   }
 
+  # check if curl_options are of class "request"
+  if (!is.null(curl_options) && !inherits(curl_options, "request")) {
+    stop(paste("Please provide curl options with the {httr} package,", 
+               "e.g. curl_options = httr::config(verbose = TRUE)"),
+         call. = FALSE)
+  }
+
   # create list of server connection details
   influxdb_srv <-
     list(
@@ -79,7 +89,8 @@ influx_connection <-  function(scheme = c("http", "https"),
       port = port,
       user = user,
       pass = pass,
-      path = path
+      path = path,
+      config = curl_options
     )
 
   # submit test ping
@@ -89,12 +100,11 @@ influx_connection <-  function(scheme = c("http", "https"),
     hostname = influxdb_srv$host,
     port = influxdb_srv$port,
     path = paste0(influxdb_srv$path, "ping"),
-    httr::timeout(5)
+    config = influxdb_srv$config
   )
 
   # print url
-  if (verbose)
-    print(response$url)
+  if (verbose) print(response$url)
 
   # Check for communication errors
   check_srv_comm(response)
@@ -112,17 +122,12 @@ influx_connection <-  function(scheme = c("http", "https"),
 #' @return A tibble with server information.
 #' @rdname influx_ping
 #' @export
-#' @seealso \code{\link[xts]{xts}}, \code{\link[influxdbr]{influx_connection}}
+#' @seealso \code{\link[influxdbr]{influx_connection}}
 #' @references \url{https://docs.influxdata.com/influxdb/}
 influx_ping <- function(con) {
+
   # submit ping
-  response <- httr::GET(
-    url = "",
-    scheme = con$scheme,
-    hostname = con$host,
-    port = con$port,
-    path = paste0(con$path, "ping")
-  )
+  response <- httr_GET(con = con, endpoint = "ping")
 
   res <- response$all_headers %>%
     purrr::flatten() %>%

diff --git a/R/influxdb_helper.R b/R/influxdb_helper.R
@@ -1,3 +1,46 @@
+#' method send the httr::GET command
+#' function is not exported
+#' @param con influx_connection object
+#' @param endpoint api endpoint
+#' @return httr::GET response
+#' @keywords internal
+httr_GET <- function(con, query = NULL, endpoint) {
+
+  response <- tryCatch(httr::GET(url = "",
+                                 scheme = con$scheme,
+                                 hostname = con$host,
+                                 port = con$port,
+                                 path = paste0(con$path, endpoint),
+                                 query = query,
+                                 config = con$config),
+                       error = function(e) {print(e); return(NULL)})
+
+  return(response)
+}
+
+
+#' method send the httr::POST command
+#' function is not exported
+#' @param con influx_connection object
+#' @param endpoint api endpoint
+#' @return httr::POST response
+#' @keywords internal
+httr_POST <- function(con, query = NULL, body = NULL, endpoint) {
+
+  response <- tryCatch(httr::POST(url = "",
+                                  body = body,
+                                  scheme = con$scheme,
+                                  hostname = con$host,
+                                  port = con$port,
+                                  path = paste0(con$path, endpoint),
+                                  query = query,
+                                  config = con$config),
+                       error = function(e) {print(e); return(NULL)})
+
+  return(response)
+}
+
+
 #' method to check the server communicatin results
 #' function is not exported
 #' @param x httr::POST response
@@ -49,7 +92,7 @@ get_precision_divisor <- function(x) {
     "s" = 1,
     "m" = 1 / 60,
     "h" = 1 / (60 * 60)
-    )
+  )
   if(is.null(div)) stop("bad precision argument.")
   return(div)
 }
diff --git a/R/influxdb_post.R b/R/influxdb_post.R
@@ -18,20 +18,7 @@ influx_post <- function(con,
   q <- c(q, q = query)
 
   # submit POST
-  response <- tryCatch(
-    httr::POST(
-      url = "",
-      scheme = con$scheme,
-      hostname = con$host,
-      port = con$port,
-      path = paste0(con$path, "query"),
-      query = q
-    ),
-    error = function(e) {
-      print(e)
-      return(NULL)
-    }
-  )
+  response <- httr_POST(con = con, query = q, endpoint = "query")
 
   # if curl fails return NULL
   if (is.null(response)) {

diff --git a/R/influxdb_query.R b/R/influxdb_query.R
@@ -50,13 +50,7 @@ influx_query <- function(con,
   q <- c(q, q = query)
 
   # submit query
-  response <- tryCatch(httr::GET(url = "",
-                                 scheme = con$scheme,
-                                 hostname = con$host,
-                                 port = con$port,
-                                 path = paste0(con$path, "query"),
-                                 query = q),
-                       error = function(e) {print(e); return(NULL)})
+  response <- httr_GET(con = con, query = q, endpoint = "query")
 
   # if curl fails return NULL
   if (is.null(response)) {

diff --git a/R/influxdb_write.R b/R/influxdb_write.R
@@ -105,14 +105,7 @@ influx_write.xts <- function(x,
                                            use_integers = use_integers,
                                            measurement = measurement,
                                            precision = precision) %>% 
-                  httr::POST(body = ., 
-                             url = "",
-                             httr::timeout(60),
-                             scheme = con$scheme,
-                             hostname = con$host,
-                             port = con$port,
-                             path = paste0(con$path, "write"),
-                             query = q) %>% 
+                  httr_POST(con = con, query = q, body = ., endpoint = "write") %>% 
                   check_srv_comm(.)
     )
 
@@ -169,14 +162,7 @@ influx_write.data.frame <- function(x,
                                            tag_cols = tag_cols,
                                            precision = precision,
                                            use_integers = use_integers) %>% 
-                  httr::POST(body = ., 
-                             url = "",
-                             httr::timeout(60),
-                             scheme = con$scheme,
-                             hostname = con$host,
-                             port = con$port,
-                             path = paste0(con$path, "write"),
-                             query = q) %>% 
+                  httr_POST(con = con, query = q, body = ., endpoint = "write") %>% 
                   check_srv_comm(.)
     )
 

diff --git a/man/httr_GET.Rd b/man/httr_GET.Rd
diff --git a/man/httr_POST.Rd b/man/httr_POST.Rd
diff --git a/man/influx_connection.Rd b/man/influx_connection.Rd
diff --git a/man/influx_ping.Rd b/man/influx_ping.Rd