api_client.R

#' Echo Server API
#'
#' Echo Server API
#'
#' The version of the OpenAPI document: 0.1.0
#' Contact: team@openapitools.org
#' Generated by: https://openapi-generator.tech
#'
#' ApiClient Class
#'
#' Generic API client for OpenAPI client library builds.
#' OpenAPI generic API client. This client handles the client-
#' server communication, and is invariant across implementations. Specifics of
#' the methods and models for each application are generated from the OpenAPI Generator
#' templates.
#'
#' NOTE: This class is auto generated by OpenAPI Generator (https://openapi-generator.tech).
#' Ref: https://openapi-generator.tech
#' Do not edit the class manually.
#'
#' @docType class
#' @title ApiClient
#' @description ApiClient Class
#' @format An \code{R6Class} generator object
#' @field base_path Base url
#' @field user_agent Default user agent
#' @field default_headers Default headers
#' @field username Username for HTTP basic authentication
#' @field password Password for HTTP basic authentication
#' @field api_keys API keys
#' @field bearer_token Bearer token
#' @field timeout Default timeout in seconds
#' @field retry_status_codes vector of status codes to retry
#' @field max_retry_attempts maximum number of retries for the status codes
#' @importFrom httr add_headers accept timeout content
#' @export
ApiClient <- R6::R6Class(
  "ApiClient",
  public = list(
    # base path of all requests
    base_path = "http://localhost:3000",
    # user agent in the HTTP request
    user_agent = "OpenAPI-Generator/1.0.0/r",
    # default headers in the HTTP request
    default_headers = NULL,
    # username (HTTP basic authentication)
    username = NULL,
    # password (HTTP basic authentication)
    password = NULL,
    # API keys
    api_keys = NULL,
    # Bearer token
    bearer_token = NULL,
    # Time Out (seconds)
    timeout = NULL,
    # Vector of status codes to retry
    retry_status_codes = NULL,
    # Maximum number of retry attempts for the retry status codes
    max_retry_attempts = NULL,
    #' Initialize a new ApiClient.
    #'
    #' @description
    #' Initialize a new ApiClient.
    #'
    #' @param base_path Base path.
    #' @param user_agent User agent.
    #' @param default_headers Default headers.
    #' @param username User name.
    #' @param password Password.
    #' @param api_keys API keys.
    #' @param access_token Access token.
    #' @param bearer_token Bearer token.
    #' @param timeout Timeout.
    #' @param retry_status_codes Status codes for retry.
    #' @param max_retry_attempts Maximum number of retry.
    #' @export
    initialize = function(base_path = NULL, user_agent = NULL,
                          default_headers = NULL,
                          username = NULL, password = NULL, api_keys = NULL,
                          access_token = NULL, bearer_token = NULL, timeout = NULL,
                          retry_status_codes = NULL, max_retry_attempts = NULL) {
      if (!is.null(base_path)) {
        self$base_path <- base_path
      }

      if (!is.null(default_headers)) {
        self$default_headers <- default_headers
      }

      if (!is.null(username)) {
        self$username <- username
      }

      if (!is.null(password)) {
        self$password <- password
      }

      if (!is.null(access_token)) {
        self$access_token <- access_token
      }

      if (!is.null(bearer_token)) {
        self$bearer_token <- bearer_token
      }

      if (!is.null(api_keys)) {
        self$api_keys <- api_keys
      } else {
        self$api_keys <- list()
      }

      if (!is.null(user_agent)) {
        self$`user_agent` <- user_agent
      }

      if (!is.null(timeout)) {
        self$timeout <- timeout
      }

      if (!is.null(retry_status_codes)) {
        self$retry_status_codes <- retry_status_codes
      }

      if (!is.null(max_retry_attempts)) {
        self$max_retry_attempts <- max_retry_attempts
      }
    },

    #' @description
    #' Prepare to make an API call with the retry logic.
    #'
    #' @param url URL.
    #' @param method HTTP method.
    #' @param query_params The query parameters.
    #' @param header_params The header parameters.
    #' @param form_params The form parameters.
    #' @param file_params The form parameters for uploading files.
    #' @param accepts The list of Accept headers.
    #' @param content_types The list of Content-Type headers.
    #' @param body The HTTP request body.
    #' @param stream_callback Callback function to process the data stream
    #' @param ... Other optional arguments.
    #'
    #' @return HTTP response
    CallApi = function(url, method, query_params, header_params, form_params,
                       file_params, accepts, content_types,
                       body, stream_callback = NULL, ...) {

      resp <- self$Execute(url, method, query_params, header_params,
                           form_params, file_params,
                           accepts, content_types,
                           body, stream_callback = stream_callback, ...)

      if (is.null(self$max_retry_attempts)) {
        self$max_retry_attempts <- 3
      }

      if (!is.null(self$retry_status_codes)) {

        for (i in 1 : self$max_retry_attempts) {
          if (resp$status_code %in% self$retry_status_codes) {
            Sys.sleep((2 ^ i) + stats::runif(n = 1, min = 0, max = 1))
            resp <- self$Execute(url, method, query_params, header_params,
                                 form_params, file_params, accepts, content_types,
                                 body, stream_callback = stream_callback, ...)
          } else {
            break
          }
        }
      }

      resp
    },

    #' @description
    #' Make an API call
    #'
    #' @param url URL.
    #' @param method HTTP method.
    #' @param query_params The query parameters.
    #' @param header_params The header parameters.
    #' @param form_params The form parameters.
    #' @param file_params The form parameters for uploading files.
    #' @param accepts The list of Accept headers
    #' @param content_types The list of Content-Type headers
    #' @param body The HTTP request body.
    #' @param stream_callback Callback function to process data stream
    #' @param ... Other optional arguments.
    #'
    #' @return HTTP response
    Execute = function(url, method, query_params, header_params,
                       form_params, file_params,
                       accepts, content_types,
                       body, stream_callback = NULL, ...) {
      headers <- httr::add_headers(c(header_params, self$default_headers))

      http_timeout <- NULL
      if (!is.null(self$timeout)) {
        http_timeout <- httr::timeout(self$timeout)
      }

      # set HTTP accept header
      accept = self$select_header(accepts)
      if (!is.null(accept)) {
        headers['Accept'] = accept
      }

      # set HTTP content-type header
      content_type = self$select_header(content_types)
      if (!is.null(content_type)) {
        headers['Content-Type'] = content_type
      }

      if (typeof(stream_callback) == "closure") { # stream data
        if (method == "GET") {
          httr::GET(url, query = query_params, headers, http_timeout,
                    httr::user_agent(self$`user_agent`), write_stream(stream_callback), ...)
        } else if (method == "POST") {
          httr::POST(url, query = query_params, headers, body = body,
                     httr::content_type("application/json"), http_timeout,
                     httr::user_agent(self$`user_agent`), write_stream(stream_callback), ...)
        } else if (method == "PUT") {
          httr::PUT(url, query = query_params, headers, body = body,
                    httr::content_type("application/json"), http_timeout,
                    http_timeout, httr::user_agent(self$`user_agent`), write_stream(stream_callback), ...)
        } else if (method == "PATCH") {
          httr::PATCH(url, query = query_params, headers, body = body,
                      httr::content_type("application/json"), http_timeout,
                      http_timeout, httr::user_agent(self$`user_agent`), write_stream(stream_callback), ...)
        } else if (method == "HEAD") {
          httr::HEAD(url, query = query_params, headers, http_timeout,
                     http_timeout, httr::user_agent(self$`user_agent`), write_stream(stream_callback), ...)
        } else if (method == "DELETE") {
          httr::DELETE(url, query = query_params, headers, http_timeout,
                       http_timeout, httr::user_agent(self$`user_agent`), write_stream(stream_callback), ...)
        } else {
          err_msg <- "Http method must be `GET`, `HEAD`, `OPTIONS`, `POST`, `PATCH`, `PUT` or `DELETE`."
          stop(err_msg)
        }
      } else { # no streaming
        if (method == "GET") {
          httr_response <- httr::GET(url, query = query_params, headers, http_timeout,
                    httr::user_agent(self$`user_agent`), ...)
        } else if (method == "POST") {
          httr_response <- httr::POST(url, query = query_params, headers, body = body,
                     httr::content_type("application/json"), http_timeout,
                     httr::user_agent(self$`user_agent`), ...)
        } else if (method == "PUT") {
          httr_response <- httr::PUT(url, query = query_params, headers, body = body,
                    httr::content_type("application/json"), http_timeout,
                    http_timeout, httr::user_agent(self$`user_agent`), ...)
        } else if (method == "PATCH") {
          httr_response <- httr::PATCH(url, query = query_params, headers, body = body,
                      httr::content_type("application/json"), http_timeout,
                      http_timeout, httr::user_agent(self$`user_agent`), ...)
        } else if (method == "HEAD") {
          httr_response <- httr::HEAD(url, query = query_params, headers, http_timeout,
                     http_timeout, httr::user_agent(self$`user_agent`), ...)
        } else if (method == "DELETE") {
          httr_response <- httr::DELETE(url, query = query_params, headers, http_timeout,
                       http_timeout, httr::user_agent(self$`user_agent`), ...)
        } else {
          err_msg <- "Http method must be `GET`, `HEAD`, `OPTIONS`, `POST`, `PATCH`, `PUT` or `DELETE`."
          stop(err_msg)
        }

        # return ApiResponse
        api_response <- ApiResponse$new()
        api_response$status_code <- httr::status_code(httr_response)
        api_response$status_code_desc <- httr::http_status(httr_response)$reason
        api_response$response <- httr::content(httr_response, "raw")
        api_response$headers <- httr::headers(httr_response)

        api_response
      }
    },

    #' @description
    #' Deserialize the content of API response to the given type.
    #'
    #' @param raw_response Raw response.
    #' @param return_type R return type.
    #' @param pkg_env Package environment.
    #'
    #' @return Deserialized object.
    deserialize = function(raw_response, return_type, pkg_env) {
      resp_obj <- jsonlite::fromJSON(raw_response)
      self$deserializeObj(resp_obj, return_type, pkg_env)
    },

    #' @description
    #' Deserialize the response from jsonlite object based on the given type
    #' by handling complex and nested types by iterating recursively
    #' Example return_types will be like "array[integer]", "map(Pet)",
    #' "array[map(Tag)]", etc.,
    #'
    #' @param obj Response object.
    #' @param return_type R return type.
    #' @param pkg_env Package environment.
    #'
    #' @return Deserialized object.
    deserializeObj = function(obj, return_type, pkg_env) {
      return_obj <- NULL
      primitive_types <- c("character", "numeric", "integer", "logical", "complex")

      # for deserialization, uniqueness requirements do not matter
      return_type <- gsub(pattern = "^(set|array)\\[",
                          replacement = "collection\\[",
                          x = return_type)

      # To handle the "map" type
      if (startsWith(return_type, "map(")) {
        inner_return_type <- regmatches(return_type,
                                        regexec(pattern = "map\\((.*)\\)", return_type))[[1]][2]
        return_obj <- lapply(names(obj), function(name) {
          self$deserializeObj(obj[[name]], inner_return_type, pkg_env)
        })
        names(return_obj) <- names(obj)
      } else if (startsWith(return_type, "collection[")) {
        # To handle the "array" and "set" types
        inner_return_type <- regmatches(return_type,
                                        regexec(pattern = "collection\\[(.*)\\]", return_type))[[1]][2]
        if (c(inner_return_type) %in% primitive_types) {
          return_obj <- vector("list", length = length(obj))
          if (length(obj) > 0) {
            for (row in 1:length(obj)) {
              return_obj[[row]] <- self$deserializeObj(obj[row], inner_return_type, pkg_env)
            }
          }
        } else {
          if (is.list(obj) && length(obj) == 1 && is.data.frame(obj[[1]])) {
            obj <- obj[[1]]
          }
          if (!is.null(nrow(obj))) {
            return_obj <- vector("list", length = nrow(obj))
            if (nrow(obj) > 0) {
              for (row in 1:nrow(obj)) {
                return_obj[[row]] <- self$deserializeObj(obj[row, , drop = FALSE],
                                                         inner_return_type, pkg_env)
              }
            }
          }
        }
      } else if (exists(return_type, pkg_env) && !(c(return_type) %in% primitive_types)) {
        # To handle model objects which are not array or map containers. Ex:"Pet"
        return_type <- get(return_type, envir = as.environment(pkg_env))
        return_obj <- return_type$new()
        # check if discriminator is defined
        if (!is.null(return_obj$`_discriminator_property_name`)) {
          data_type <- return_obj$`_discriminator_property_name`
          # use discriminator mapping if provided
          if (!is.null(return_obj$`_discriminator_mapping_name`)) {
            data_type <- (return_obj$`_discriminator_mapping_name`)[[obj[[data_type]]]]
          } else {
            # no mapping provided, use the value directly
            data_type <- obj[[data_type]]
          }
          # create an object of the mapped type (e.g. Cat)
          return_type <- get(data_type, envir = as.environment(pkg_env))
          return_obj <- return_type$new()
        }
        return_obj$fromJSON(
          jsonlite::toJSON(obj, digits = NA, auto_unbox = TRUE)
        )
      } else {
        # To handle primitive type
        return_obj <- obj
      }
      return_obj
    },

    #' @description
    #' Return a property header (for accept or content-type). If JSON-related MIME is found,
    #' return it. Otherwise, return the first one, if any.
    #'
    #' @param headers A list of headers
    #'
    #' @return A header (e.g. 'application/json')
    select_header = function(headers) {
      if (length(headers) == 0) {
        return(invisible(NULL))
      } else {
        for (header in headers) {
          if (str_detect(header, "(?i)^(application/json|[^;/ \t]+/[^;/ \t]+[+]json)[ \t]*(;.*)?$")) {
            # return JSON-related MIME
            return(header)
          }
        }

        # not json mime type, simply return the first one
        return(headers[1])
      }
    },

    #' @description
    #' Deserialize the response
    #' 
    #' @param local_var_resp The API response
    #' @param return_type The target return type for the endpoint (e.g., `"object"`). If `NULL` text will be left as-is.
    #' @return If the raw response is corecable to text, return the text. Otherwise return the raw response.
    DeserializeResponse = function(local_var_resp, return_type = NULL) {
      text <- local_var_resp$response_as_text()
      if (is.na(text)) {
        return(local_var_resp$response)
      } else if (is.null(return_type)) {
        return(text)
      }
      return(self$deserialize(text, return_type, loadNamespace("openapi")))
    },

    #' @description
    #' Write response to a file
    #' 
    #' The function will write out data. 
    #' 
    #' 1. If binary data is detected it will use `writeBin`
    #' 2. If the raw response is coercible to text, the text will be written to a file
    #' 3. If the raw response is not coercible to text, the raw response will be written
    #' 
    #' @param local_var_resp The API response
    #' @param file The name of the data file to save the result
    WriteFile = function(local_var_resp, file) {
      if (self$IsBinary(local_var_resp$response)) {
        writeBin(local_var_resp$response, file)
      } else {
        response <- self$DeserializeResponse(local_var_resp)
        base::write(response, file)
      }
    },

    #' @description
    #' Check response for binary content
    #' 
    #' @param local_var_resp The API response
    IsBinary = function(x) {
      # ref: https://stackoverflow.com/a/17098690/1785752
      b <- readBin(x, "int", n = 1000, size=1, signed=FALSE)
      return(max(b) > 128)
    }
  )
)