sdk/R/R/HttpRequest.R

   1 source("./R/custom_classes.R")
   2
   3 HttpRequest <- setRefClass(
   4
   5     "HttrRequest",
   6
   7     fields = list(
   8         send_method         = "character",
   9         server_base_url     = "character",
  10         server_relative_url = "character",
  11         auth_token          = "character",
  12         allowed_methods     = "list",
  13         request_body        = "ANY",
  14         query_filters       = "ANY",
  15         response_limit      = "ANY",
  16         query_offset        = "ANY"
  17     ),
  18
  19     methods = list(
  20         initialize = function(method,
  21                               token,
  22                               base_url,
  23                               relative_url,
  24                               body = NULL,
  25                               filters = NULL,
  26                               limit = 100,
  27                               offset = 0)
  28         {
  29             send_method         <<- method
  30             auth_token          <<- token
  31             server_base_url     <<- base_url
  32             server_relative_url <<- relative_url
  33             request_body        <<- body
  34             query_filters       <<- filters
  35             response_limit      <<- limit
  36             query_offset        <<- offset
  37         },
  38
  39         execute = function()
  40         {
  41             #Todo(Fudo): Get rid of the switch and make this module more general.
  42             http_method <- switch(send_method,
  43                                   "GET"    = .self$getRequest,
  44                                   "POST"   = .self$postRequest,
  45                                   "PUT"    = .self$putRequest,
  46                                   "DELETE" = .self$deleteRequest,
  47                                   "PATCH"  = .self$pathcRequest)
  48             http_method()
  49         },
  50
  51         getRequest = function()
  52         {
  53             requestHeaders <- httr::add_headers(Authorization = .self$getAuthHeader())
  54             requestQuery   <- .self$generateQuery()
  55             url            <- paste0(server_base_url, server_relative_url, requestQuery)
  56
  57             server_data <- httr::GET(url    = url,
  58                                      config = requestHeaders)
  59         },
  60
  61         #Todo(Fudo): Try to make this more generic
  62         postRequest = function()
  63         {
  64             url <- paste0(server_base_url, server_relative_url)
  65             requestHeaders <- httr::add_headers("Authorization" = .self$getAuthHeader(),
  66                                                 "Content-Type"  = "application/json")
  67             response <- POST(url, body = request_body, config = requestHeaders)
  68         },
  69
  70         putRequest = function()
  71         {
  72             url <- paste0(server_base_url, server_relative_url)
  73             requestHeaders <- httr::add_headers("Authorization" = .self$getAuthHeader(),
  74                                                 "Content-Type"  = "application/json")
  75
  76             response <- PUT(url, body = request_body, config = requestHeaders)
  77         },
  78
  79         deleteRequest = function()
  80         {
  81             url <- paste0(server_base_url, server_relative_url)
  82             requestHeaders <- httr::add_headers("Authorization" = .self$getAuthHeader(),
  83                                                 "Content-Type"  = "application/json")
  84             response <- DELETE(url, config = requestHeaders)
  85         },
  86
  87         pathcRequest = function()
  88         {
  89             #Todo(Fudo): Implement this later on.
  90             print("PATCH method")
  91         },
  92
  93         getAuthHeader = function()
  94         {
  95             auth_method <- "OAuth2"
  96             auth_header <- paste(auth_method, auth_token)
  97         },
  98
  99         generateQuery = function()
 100         {
 101             #Todo(Fudo): This function is a mess, refactor it
 102             finalQuery <- "?alt=json"
 103
 104             if(!is.null(query_filters))
 105             {
 106                 filters <- sapply(query_filters, function(filter)
 107                 {
 108                     if(length(filter) != 3)
 109                         stop("Filter list must have exacthey 3 elements.")
 110
 111                     attributeAndOperator = filter[c(1, 2)]
 112                     filterList = filter[[3]]
 113                     filterListIsPrimitive = TRUE
 114                     if(length(filterList) > 1)
 115                         filterListIsPrimitive = FALSE
 116
 117                     attributeAndOperator <- sapply(attributeAndOperator, function(component) {
 118                         component <- paste0("\"", component, "\"")
 119                     })
 120
 121                     filterList <- sapply(unlist(filterList), function(filter) {
 122                         filter <- paste0("\"", filter, "\"")
 123                     })
 124
 125                     filterList <- paste(filterList, collapse = ",+")
 126
 127                     if(!filterListIsPrimitive)
 128                         filterList <- paste0("[", filterList, "]")
 129
 130                     filter <- c(attributeAndOperator, filterList)
 131
 132                     queryParameter <- paste(filter, collapse = ",+")
 133                     queryParameter <- paste0("[", queryParameter, "]")
 134
 135                 })
 136
 137                 filters <- paste(filters, collapse = ",+")
 138                 filters <- paste0("[", filters, "]")
 139
 140                 encodedQuery <- URLencode(filters, reserved = T, repeated = T)
 141
 142                 finalQuery <- paste0(finalQuery, "&filters=", encodedQuery)
 143
 144                 #Todo(Fudo): This is a hack for now. Find a proper solution.
 145                 finalQuery <- stringr::str_replace_all(finalQuery, "%2B", "+")
 146             }
 147
 148             if(!is.null(response_limit))
 149             {
 150                 if(!is.numeric(response_limit))
 151                     stop("Limit must be a numeric type.")
 152
 153                 finalQuery <- paste0(finalQuery, "&limit=", response_limit)
 154             }
 155
 156             if(!is.null(query_offset))
 157             {
 158                 if(!is.numeric(query_offset))
 159                     stop("Offset must be a numeric type.")
 160
 161                 finalQuery <- paste0(finalQuery, "&offset=", query_offset)
 162             }
 163
 164             finalQuery
 165         }
 166     )
 167 )