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

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