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