[mlflow/R] Fix error handling of rest api calls. (mlflow#1101)

* Minor fix.

* Fixed rest output.

* Removed debug print.

* Fixed formatting.

* Addressed review comments.

* Fixed tests.

* Addressed review comments.

* Addressed review comments.

* Removed extra line.

* Removed extra line.

mlflow/R/mlflow/R/tracking-rest.R

@@ -10,6 +10,15 @@ mlflow_rest_timeout <- function() {
   timeout(getOption("mlflow.rest.timeout", 60))
 }
 
+try_parse_response_as_text <- function(response) {
+  raw_content <- content(response, type = "raw")
+  tryCatch({
+    rawToChar(raw_content)
+  }, error = function(e) {
+    do.call(paste, as.list(raw_content))
+  })
+}
+
 #' @importFrom base64enc base64encode
 get_rest_config <- function(config) {
   headers <- list()
@@ -57,8 +66,22 @@ mlflow_rest <- function( ..., client, query = NULL, data = NULL, verb = "GET", v
     ),
     stop("Verb '", verb, "' is unsupported.")
   )
-  if (identical(response$status_code, 500L)) {
-    stop(xml2::as_list(content(response))$html$body$p[[1]])
+  if (response$status_code != 200) {
+    message_body <- tryCatch(
+      paste(content(response, "parsed", type = "application/json"), collapse = "; "),
+      error = function(e) {
+        try_parse_response_as_text(response)
+      }
+    )
+    msg <- paste("API request to endpoint '",
+                 paste(args, collapse = "/"),
+                 "' failed with error code ",
+                 response$status_code,
+                 ". Reponse body: '",
+                 message_body,
+                 "'",
+                 sep = "")
+    stop(msg)
   }
   text <- content(response, "text", encoding = "UTF-8")
   jsonlite::fromJSON(text)

mlflow/R/mlflow/tests/testthat/test-client.R

@@ -1,4 +1,4 @@
-context("databricks-utils")
+context("client")
 
 test_that("http(s) clients work as expected", {
   with_mock(.env = "mlflow", mlflow_rest = function(..., client) {
@@ -39,3 +39,59 @@ test_that("http(s) clients work as expected", {
     })
   })
 })
+
+test_that("rest call handles errors correctly", {
+  mock_client <- mlflow:::new_mlflow_client_impl(get_host_creds = function() {
+     mlflow:::new_mlflow_host_creds(host = "localhost")
+  })
+  with_mock(.env = "httr", POST = function(...) {
+    httr:::response(
+      status_code = 400,
+      content = charToRaw(paste("{\"error_code\":\"INVALID_PARAMETER_VALUE\",",
+                                 "\"message\":\"experiment_id must be set to a non-zero value\"}",
+                                 sep = "")
+      )
+    )}, {
+    error_msg_regexp <- paste(
+                          "API request to endpoint \'runs/create\' failed with error code 400",
+                          "INVALID_PARAMETER_VALUE",
+                          "experiment_id must be set to a non-zero value",
+                          sep = ".*")
+    expect_error(
+      mlflow:::mlflow_rest( "runs", "create", client = mock_client, verb = "POST"),
+      error_msg_regexp
+    )
+  })
+
+  with_mock(.env = "httr", GET = function(...) {
+    httr:::response(
+      status_code = 500,
+      content = charToRaw(paste("some text."))
+    )
+    }, {
+    error_msg_regexp <- paste(
+                          "API request to endpoint \'runs/create\' failed with error code 500",
+                          "some text",
+                          sep = ".*")
+    expect_error(
+      mlflow:::mlflow_rest( "runs", "create", client = mock_client, verb = "GET"),
+      error_msg_regexp
+    )
+  })
+
+  with_mock(.env = "httr", POST = function(...) {
+    httr:::response(
+      status_code = 503,
+      content = as.raw(c(0, 255))
+    )
+    }, {
+    error_msg_regexp <- paste(
+                          "API request to endpoint \'runs/create\' failed with error code 503",
+                          "00 ff",
+                          sep = ".*")
+    expect_error(
+      mlflow:::mlflow_rest( "runs", "create", client = mock_client, verb = "POST"),
+      error_msg_regexp
+    )
+  })
+})