sdk/R/tests/testthat/fakes/FakeHttpRequest.R

   1 FakeHttpRequest <- R6::R6Class(
   2
   3     "FakeHttpRequest",
   4
   5     public = list(
   6
   7         serverMaxElementsPerRequest = NULL,
   8
   9         content                                 = NULL,
  10         expectedURL                             = NULL,
  11         URLIsProperlyConfigured                 = NULL,
  12         expectedQueryFilters                    = NULL,
  13         queryFiltersAreCorrect                  = NULL,
  14         requestHeaderContainsAuthorizationField = NULL,
  15         requestHeaderContainsDestinationField   = NULL,
  16         requestHeaderContainsRangeField         = NULL,
  17         requestHeaderContainsContentTypeField   = NULL,
  18         JSONEncodedBodyIsProvided               = NULL,
  19         requestBodyIsProvided                   = NULL,
  20
  21         numberOfGETRequests    = NULL,
  22         numberOfDELETERequests = NULL,
  23         numberOfPUTRequests    = NULL,
  24         numberOfPOSTRequests   = NULL,
  25         numberOfMOVERequests   = NULL,
  26
  27         initialize = function(expectedURL      = NULL,
  28                               serverResponse   = NULL,
  29                               expectedFilters  = NULL)
  30         {
  31             if(is.null(serverResponse))
  32             {
  33                 self$content <- list()
  34                 self$content$status_code <- 200
  35             }
  36             else
  37                 self$content <- serverResponse
  38
  39             self$expectedURL                             <- expectedURL
  40             self$URLIsProperlyConfigured                 <- FALSE
  41             self$expectedQueryFilters                    <- expectedFilters
  42             self$queryFiltersAreCorrect                  <- FALSE
  43             self$requestHeaderContainsAuthorizationField <- FALSE
  44             self$requestHeaderContainsDestinationField   <- FALSE
  45             self$requestHeaderContainsRangeField         <- FALSE
  46             self$requestHeaderContainsContentTypeField   <- FALSE
  47             self$JSONEncodedBodyIsProvided               <- FALSE
  48             self$requestBodyIsProvided                   <- FALSE
  49
  50             self$numberOfGETRequests    <- 0
  51             self$numberOfDELETERequests <- 0
  52             self$numberOfPUTRequests    <- 0
  53             self$numberOfPOSTRequests   <- 0
  54             self$numberOfMOVERequests   <- 0
  55
  56             self$serverMaxElementsPerRequest <- 5
  57         },
  58
  59         exec = function(verb, url, headers = NULL, body = NULL, query = NULL,
  60                         limit = NULL, offset = NULL, retryTimes = 0)
  61         {
  62             private$validateURL(url)
  63             private$validateHeaders(headers)
  64             private$validateFilters(queryFilters)
  65             private$validateBody(body)
  66
  67             if(verb == "GET")
  68                 self$numberOfGETRequests <- self$numberOfGETRequests + 1
  69             else if(verb == "POST")
  70                 self$numberOfPOSTRequests <- self$numberOfPOSTRequests + 1
  71             else if(verb == "PUT")
  72                 self$numberOfPUTRequests <- self$numberOfPUTRequests + 1
  73             else if(verb == "DELETE")
  74                 self$numberOfDELETERequests <- self$numberOfDELETERequests + 1
  75             else if(verb == "MOVE")
  76                 self$numberOfMOVERequests <- self$numberOfMOVERequests + 1
  77             else if(verb == "PROPFIND")
  78             {
  79                 return(self$content)
  80             }
  81
  82             if(!is.null(self$content$items_available))
  83                 return(private$getElements(offset, limit))
  84             else
  85                 return(self$content)
  86         }
  87     ),
  88
  89     private = list(
  90
  91         validateURL = function(url)
  92         {
  93             if(!is.null(self$expectedURL) && url == self$expectedURL)
  94                 self$URLIsProperlyConfigured <- TRUE
  95         },
  96
  97         validateHeaders = function(headers)
  98         {
  99             if(!is.null(headers$Authorization))
 100                 self$requestHeaderContainsAuthorizationField <- TRUE
 101
 102             if(!is.null(headers$Destination))
 103                 self$requestHeaderContainsDestinationField <- TRUE
 104
 105             if(!is.null(headers$Range))
 106                 self$requestHeaderContainsRangeField <- TRUE
 107
 108             if(!is.null(headers[["Content-Type"]]))
 109                 self$requestHeaderContainsContentTypeField <- TRUE
 110         },
 111
 112         validateBody = function(body)
 113         {
 114             if(!is.null(body))
 115             {
 116                 self$requestBodyIsProvided <- TRUE
 117
 118                 if(class(body) == "json")
 119                     self$JSONEncodedBodyIsProvided <- TRUE
 120             }
 121         },
 122
 123         validateFilters = function(filters)
 124         {
 125             if(!is.null(self$expectedQueryFilters) &&
 126                !is.null(filters) &&
 127                all.equal(unname(filters), self$expectedQueryFilters))
 128             {
 129                 self$queryFiltersAreCorrect <- TRUE
 130             }
 131         },
 132
 133         getElements = function(offset, limit)
 134         {
 135             start <- 1
 136             elementCount <- self$serverMaxElementsPerRequest
 137
 138             if(!is.null(offset))
 139             {
 140                 if(offset > self$content$items_available)
 141                     stop("Invalid offset")
 142
 143                 start <- offset + 1
 144             }
 145
 146             if(!is.null(limit))
 147                 if(limit < self$serverMaxElementsPerRequest)
 148                     elementCount <- limit - 1
 149
 150
 151             serverResponse <- list()
 152             serverResponse$items_available <- self$content$items_available
 153             serverResponse$items <- self$content$items[start:(start + elementCount - 1)]
 154
 155             if(start + elementCount > self$content$items_available)
 156             {
 157                 elementCount = self$content$items_available - start
 158                 serverResponse$items <- self$content$items[start:(start + elementCount)]
 159             }
 160
 161             serverResponse
 162         }
 163     ),
 164
 165     cloneable = FALSE
 166 )