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         numberOfCOPYRequests       = NULL,
  31         numberOfgetConnectionCalls = NULL,
  32
  33         initialize = function(expectedURL      = NULL,
  34                               serverResponse   = NULL,
  35                               expectedFilters  = NULL)
  36         {
  37             if(is.null(serverResponse))
  38             {
  39                 self$content <- list()
  40                 self$content$status_code <- 200
  41             }
  42             else
  43                 self$content <- serverResponse
  44
  45             self$expectedURL                             <- expectedURL
  46             self$URLIsProperlyConfigured                 <- FALSE
  47             self$expectedQueryFilters                    <- expectedFilters
  48             self$queryFiltersAreCorrect                  <- FALSE
  49             self$requestHeaderContainsAuthorizationField <- FALSE
  50             self$requestHeaderContainsDestinationField   <- FALSE
  51             self$requestHeaderContainsRangeField         <- FALSE
  52             self$requestHeaderContainsContentTypeField   <- FALSE
  53             self$JSONEncodedBodyIsProvided               <- FALSE
  54             self$requestBodyIsProvided                   <- FALSE
  55
  56             self$numberOfGETRequests    <- 0
  57             self$numberOfDELETERequests <- 0
  58             self$numberOfPUTRequests    <- 0
  59             self$numberOfPOSTRequests   <- 0
  60             self$numberOfMOVERequests   <- 0
  61             self$numberOfCOPYRequests   <- 0
  62
  63             self$numberOfgetConnectionCalls <- 0
  64
  65             self$serverMaxElementsPerRequest <- 5
  66         },
  67
  68         exec = function(verb, url, headers = NULL, body = NULL, query = NULL,
  69                         limit = NULL, offset = NULL, retryTimes = 0)
  70         {
  71             private$validateURL(url)
  72             private$validateHeaders(headers)
  73             private$validateFilters(queryFilters)
  74             private$validateBody(body)
  75
  76             if(verb == "GET")
  77                 self$numberOfGETRequests <- self$numberOfGETRequests + 1
  78             else if(verb == "POST")
  79                 self$numberOfPOSTRequests <- self$numberOfPOSTRequests + 1
  80             else if(verb == "PUT")
  81                 self$numberOfPUTRequests <- self$numberOfPUTRequests + 1
  82             else if(verb == "DELETE")
  83                 self$numberOfDELETERequests <- self$numberOfDELETERequests + 1
  84             else if(verb == "MOVE")
  85                 self$numberOfMOVERequests <- self$numberOfMOVERequests + 1
  86             else if(verb == "COPY")
  87                 self$numberOfCOPYRequests <- self$numberOfCOPYRequests + 1
  88             else if(verb == "PROPFIND")
  89             {
  90                 return(self$content)
  91             }
  92
  93             if(!is.null(self$content$items_available))
  94                 return(private$getElements(offset, limit))
  95             else
  96                 return(self$content)
  97         },
  98
  99         getConnection = function(url, headers, openMode)
 100         {
 101             self$numberOfgetConnectionCalls <- self$numberOfgetConnectionCalls + 1
 102             c(url, headers, openMode)
 103         }
 104     ),
 105
 106     private = list(
 107
 108         validateURL = function(url)
 109         {
 110             if(!is.null(self$expectedURL) && url == self$expectedURL)
 111                 self$URLIsProperlyConfigured <- TRUE
 112         },
 113
 114         validateHeaders = function(headers)
 115         {
 116             if(!is.null(headers$Authorization))
 117                 self$requestHeaderContainsAuthorizationField <- TRUE
 118
 119             if(!is.null(headers$Destination))
 120                 self$requestHeaderContainsDestinationField <- TRUE
 121
 122             if(!is.null(headers$Range))
 123                 self$requestHeaderContainsRangeField <- TRUE
 124
 125             if(!is.null(headers[["Content-Type"]]))
 126                 self$requestHeaderContainsContentTypeField <- TRUE
 127         },
 128
 129         validateBody = function(body)
 130         {
 131             if(!is.null(body))
 132             {
 133                 self$requestBodyIsProvided <- TRUE
 134
 135                 if(class(body) == "json")
 136                     self$JSONEncodedBodyIsProvided <- TRUE
 137             }
 138         },
 139
 140         validateFilters = function(filters)
 141         {
 142             if(!is.null(self$expectedQueryFilters) &&
 143                !is.null(filters) &&
 144                all.equal(unname(filters), self$expectedQueryFilters))
 145             {
 146                 self$queryFiltersAreCorrect <- TRUE
 147             }
 148         },
 149
 150         getElements = function(offset, limit)
 151         {
 152             start <- 1
 153             elementCount <- self$serverMaxElementsPerRequest
 154
 155             if(!is.null(offset))
 156             {
 157                 if(offset > self$content$items_available)
 158                     stop("Invalid offset")
 159
 160                 start <- offset + 1
 161             }
 162
 163             if(!is.null(limit))
 164                 if(limit < self$serverMaxElementsPerRequest)
 165                     elementCount <- limit - 1
 166
 167
 168             serverResponse <- list()
 169             serverResponse$items_available <- self$content$items_available
 170             serverResponse$items <- self$content$items[start:(start + elementCount - 1)]
 171
 172             if(start + elementCount > self$content$items_available)
 173             {
 174                 elementCount = self$content$items_available - start
 175                 serverResponse$items <- self$content$items[start:(start + elementCount)]
 176             }
 177
 178             serverResponse
 179         }
 180     ),
 181
 182     cloneable = FALSE
 183 )