R/manual_layer_responses.R

In TileDB-Inc/TileDB-Cloud-R: TileDB Cloud Platform R Client Package

##' Package-internal HTTP-response helper
##'
##' Used for overriding the OpenAPI-autogenerated HTTP-response handling.
##'
##' Makes the handling compatible with TileDB REST-server response format;
##' surfaces error messages back to the user.
##' Not intended to be exported from this package; for package-internal use only.
##'
##' @param resp A \code{response} S3 object e.g. from \code{httr:GET}.
##'
##' @return An object of type \code{\link{ApiResponse}}. In the success case (HTTP 2xx)
##' its \code{content} slot is the raw HTTP body. In the failure case (otherwise)
##' its \code{content} slot is error-text from the server.
.wrap_as_api_response <- function(resp) {
  # Goal: unpack the useful bits and surface them; avoid showing non-useful bits.
  # * The response object \code{resp} is an S3 object (list with generic functions)
  #   having named slots including \code{resp$status_code} and \code{resp$content},
  #   along with others.
  # * \code{resp$content} is the HTTP body per se. This is in raw format so we need
  #   to do \code{rawToChar} to see a familiar string containing human-readable JSON.
  # *
  #
  # - resp
  #   - resp$status_code
  #   - resp$content
  #     - this is raw; convert to char; now it's a JSON string like
  #       {
  #         "code": 5000,
  #         "message": "some error details go here",
  #         "request_id": "e78e0e95-a991-4a4f-b302-3b2af2d7c844"
  #       }
  #     - JSON-parse that to get an R named list with keys "code", "message", "request_id".
  #     - If there is indeed a "message" key, return that value as payload; otherwise
  #       return the full JSON string

  status_code <- httr::status_code(resp)
  body <- resp$content

  # Happy/2xx cases. Don't try to decode the content (body) object (nominally
  # also a JSON string, raw-encoded): leave that to the caller.
  if (status_code >= 200 && status_code <= 299) {
    return(ApiResponse$new(body, resp))
  }

  # Response has no HTTP body
  if (is.null(body)) {
    return(ApiResponse$new(paste("Server returned" , status_code , "response status code.")))
  }

  # Response has HTTP body; return "message" component from parsed body-JSON, else full body as string.
  bodyAsJSONString <- rawToChar(body)
  bodyAsNamedList <- jsonlite::fromJSON(bodyAsJSONString)

  if (is.null(bodyAsNamedList$message)) {
    return(ApiResponse$new(paste("Server returned" , status_code , "response status code. Content: ", bodyAsJSONString), resp))
  } else {
    return(ApiResponse$new(paste("Server returned" , status_code , "response status code. Message: ", bodyAsNamedList$message), resp))
  }
}

##' Package-internal HTTP-response helper
##'
##' This is a package-internal function for code-deduplication within various
##' manual-layer functions.
##'
##' For the API-level functions which use \code{\link{.wrap_as_api_response}},
##' manual-layer functions will receive either (a) the raw HTTP body,
##' if the \code{status_code} was 2xx, or (b) an \code{\link{ApiResponse}}
##' object.  Using this function, callsites can get the HTTP body (if
##' available), else an informative \code{stop()}.
##'
##' @param resultObject Should be a return value from an API function which uses
##' \code{\link{.wrap_as_api_response}} internally. These are functions which are manually
##' edited after OpenAPI autogen.
##'
##' @return The argument, as long as it's of type \code{raw}. Else, stops.  The
##' caller can then decode the raw body.
.get_raw_response_body_or_stop <- function(resultObject) {
  # Decode the results.
  if (typeof(resultObject) != "raw") {
    className <- class(resultObject)[1]
    if (className == "ApiResponse") {
      stop("tiledbcloud: received error response: ", resultObject$content, call.=FALSE)
    } else {
      stop("tiledbcloud: received error response: ", class(resultObject)[1], call.=FALSE)
    }
  }
  resultObject
}

##' Package-internal HTTP-response helper
##'
##' This is a package-internal function for code-deduplication within various
##' manual-layer functions.
##'
##' This wraps \code{\link{.get_raw_response_body_or_stop}}, doing \code{stop}
##' if there is an API-response error, or if the response is not the empty string.
##' This is for API functions where the expected response is the empty string.
##'
##' @param resultObject Should be a return value from an API function which uses
##' \code{\link{.wrap_as_api_response}} internally. These are functions which are manually
##' edited after OpenAPI autogen.
##'
##' @return Invisible on success, or \code{stop()} on failure.
.get_empty_response_body_or_stop <- function(resultObject) {
  body <- .get_raw_response_body_or_stop(resultObject)

  shouldBeEmptyString <- rawToChar(body)
  if (shouldBeEmptyString != "") {
    stop("Unexpected API response")
  }
  shouldBeEmptyString
}

##' Package-internal HTTP-response helper
##'
##' This is a package-internal function for code-deduplication within various
##' manual-layer functions.
##'
##' It wraps \code{\link{.get_raw_response_body_or_stop}} by decoding
##' the raw response body using any of the three result-format types
##' we support for UDFs. It's a keystroke-saving wrapper around
##' \code{\link{.get_raw_response_body_or_stop}}.
##'
##' @param resultObject Should be a return value from an API function which uses
##' \code{\link{.wrap_as_api_response}} internally. These are functions which are manually
##' edited after OpenAPI autogen.
##'
##' @param entire_json_is_result If false, return the \code{"value"} field from the JSON object.
##' This is the right thing to do for returns from the REST server for almost all cases.
##' The true case is only for getting the results from invoking registered Python UDFs
##' from R, in which case the JSON result in its entirety is the UDF output.
##'
##' @return The argument, decoded according to the specified result format.
.get_decoded_response_body_or_stop <- function(resultObject, result_format, entire_json_is_result=FALSE) {
  body <- .get_raw_response_body_or_stop(resultObject)

  decoded_response <- NULL
  switch(result_format,
    native={
      decoded_response <- unserialize(body, NULL)
    },
    json={
      resultString <- rawToChar(body)
      resultJSON <- jsonlite::fromJSON(resultString)
      if (entire_json_is_result) {
        decoded_response <- resultJSON
      } else {
        decoded_response <- resultJSON[["value"]]
      }
    },
    arrow={
      stopifnot("The 'arrow' package is required." = requireNamespace("arrow", quietly=TRUE))
      decoded_response <- arrow::read_ipc_stream(body, as_data_frame = FALSE)
    },
    stop("Result format unrecognized: ", result_format)
  )
  decoded_response
}