Added support for feather files in POST

DESCRIPTION

@@ -23,8 +23,7 @@ Imports:
     R6 (>= 2.0.0),
     stringi (>= 0.3.0),
     jsonlite (>= 0.9.16),
-    httpuv (>= 1.2.3),
-    crayon
+    httpuv (>= 1.2.3)
 LazyData: TRUE
 Suggests:
     testthat (>= 0.11.0),
@@ -34,7 +33,9 @@ Suggests:
     base64enc,
     htmlwidgets,
     visNetwork,
-    analogsea
+    analogsea,
+    feather,
+    webutils
 Collate: 
     'content-types.R'
     'cookie-parser.R'

R/content-types.R

@@ -41,7 +41,8 @@ knownContentTypes <- list(
   docx='application/vnd.openxmlformats-officedocument.wordprocessingml.document',
   dotx='application/vnd.openxmlformats-officedocument.wordprocessingml.template',
   xlam='application/vnd.ms-excel.addin.macroEnabled.12',
-  xlsb='application/vnd.ms-excel.sheet.binary.macroEnabled.12')
+  xlsb='application/vnd.ms-excel.sheet.binary.macroEnabled.12',
+  feather='application/feather')
 
 getContentType <- function(ext, defaultType='application/octet-stream') {
   ct <- knownContentTypes[[tolower(ext)]]

R/post-body.R

@@ -1,11 +1,21 @@
 postBodyFilter <- function(req){
-  body <- req$rook.input$read_lines()
-  args <- parseBody(body)
+
+  if (!is.null(req$CONTENT_TYPE) && grepl("multipart/form-data; boundary=",
+                                          req$CONTENT_TYPE, fixed = TRUE)) {
+
+    boundary <- strsplit(req$CONTENT_TYPE, split = "=")[[1]][2]
+    body <- req$rook.input$read()
+    args <- parseMultipart(body, boundary)
+  } else {
+    body <- req$rook.input$read_lines()
+    args <- parseBody(body)
+  }
   req$postBody <- body
   req$args <- c(req$args, args)
   forward()
 }
 
+
 #' @importFrom utils URLdecode
 #' @noRd
 parseBody <- function(body){
@@ -24,3 +34,33 @@ parseBody <- function(body){
   }
   ret
 }
+
+
+#' @importFrom utils URLdecode
+#' @noRd
+parseMultipart <- function(body, boundary){
+  function(val, req, res, errorHandler){
+    tryCatch({
+      if (!requireNamespace("webutils", quietly = TRUE)) {
+        stop("The webutils package is not available but is required in order
+          to use the functionality to POST binary files",
+             call. = FALSE)
+      }
+      # Is there data in the request?
+      if (is.null(body) || length(body) == 0 || body == "") {
+        return(list())
+      }
+      parsed_binary <- webutils::parse_multipart(body, boundary)
+      file_name <- parsed_binary$myfile$filename
+      file_data <- parsed_binary$myfile$value
+
+      tmpfile <- tempfile()
+      writeBin(file_data, tmpfile)
+
+      ret <- NULL
+      ret$name <- file_name
+      ret$data <- tmpfile
+      ret
+    })
+  }
+}

inst/examples/13-binary-upload/plumber.R

@@ -0,0 +1,32 @@
+library(plumber)
+library(feather)
+
+# Illustration of binary uploads and post-processing of the file on receipt.
+# As a proof of concept we use a feather file: test.feather
+
+
+# To upload and use the content of the file in a function:
+# curl -X POST http://localhost:9080/upload -F 'myfile=@test.feather'
+
+#* @post /upload
+function(name, data) {
+  # work with binary files after upload 
+  # in this example a feather file
+  content <- read_feather(data)
+  return(content)
+}
+
+
+# To upload and use the properties of the file in a function:
+# curl -X POST http://localhost:9080/inspect -F 'myfile=@test.feather'
+
+#* @post /inspect
+function(name, data) {
+  file_info <- data.frame(
+    filename = name,
+    mtime = file.info(data)$mtime,
+    ctime = file.info(data)$ctime
+    )
+
+  return(file_info)
+}

tests/testthat/test-postbody.R

@@ -6,5 +6,11 @@ test_that("JSON is consumed on POST", {
 
 test_that("Query strings on post are handled correctly", {
   expect_equivalent(parseBody("a="), list()) # It's technically a named list()
-  expect_equal(parseBody("a=1&b=&c&d=1"), list(a="1", d="1"))
+  expect_equal(parseBody("a=1&b=&c&d=1"), list(a = "1", d = "1"))
+})
+
+test_that("Multipart binary is consumed on POST", {
+# TODO: I'm not sure how to read the file in such a way that it can be used as a
+# multipart upload. I expected that copying the rawToChar(req$input.rook$read())
+# output would do the trick, but it did not.
 })