X-Git-Url: https://git.arvados.org/arvados.git/blobdiff_plain/ecb7d4501373a21ae69494beee8252f107ec1b56..5d164d74505c232cfa232d69a56273da2d02b72a:/sdk/R/tests/testthat/fakes/FakeHttpRequest.R

diff --git a/sdk/R/tests/testthat/fakes/FakeHttpRequest.R b/sdk/R/tests/testthat/fakes/FakeHttpRequest.R
index 612c80d502..533602886a 100644
--- a/sdk/R/tests/testthat/fakes/FakeHttpRequest.R
+++ b/sdk/R/tests/testthat/fakes/FakeHttpRequest.R
@@ -4,78 +4,161 @@ FakeHttpRequest <- R6::R6Class(
 
     public = list(
 
+        serverMaxElementsPerRequest = NULL,
+
         content                                 = NULL,
         expectedURL                             = NULL,
         URLIsProperlyConfigured                 = NULL,
+        expectedQueryFilters                    = NULL,
+        queryFiltersAreCorrect                  = NULL,
         requestHeaderContainsAuthorizationField = NULL,
+        requestHeaderContainsDestinationField   = NULL,
+        requestHeaderContainsRangeField         = NULL,
+        requestHeaderContainsContentTypeField   = NULL,
+        JSONEncodedBodyIsProvided               = NULL,
+        requestBodyIsProvided                   = NULL,
 
-        numberOfGETRequests = NULL,
+        numberOfGETRequests    = NULL,
         numberOfDELETERequests = NULL,
+        numberOfPUTRequests    = NULL,
+        numberOfPOSTRequests   = NULL,
+        numberOfMOVERequests   = NULL,
 
-        initialize = function(expectedURL = NULL, serverResponse = NULL)
+        initialize = function(expectedURL      = NULL,
+                              serverResponse   = NULL,
+                              expectedFilters  = NULL)
         {
-            self$content <- serverResponse
-            self$expectedURL <- expectedURL
+            if(is.null(serverResponse))
+            {
+                self$content <- list()
+                self$content$status_code <- 200
+            }
+            else
+                self$content <- serverResponse
+
+            self$expectedURL                             <- expectedURL
+            self$URLIsProperlyConfigured                 <- FALSE
+            self$expectedQueryFilters                    <- expectedFilters
+            self$queryFiltersAreCorrect                  <- FALSE
             self$requestHeaderContainsAuthorizationField <- FALSE
-            self$URLIsProperlyConfigured <- FALSE
+            self$requestHeaderContainsDestinationField   <- FALSE
+            self$requestHeaderContainsRangeField         <- FALSE
+            self$requestHeaderContainsContentTypeField   <- FALSE
+            self$JSONEncodedBodyIsProvided               <- FALSE
+            self$requestBodyIsProvided                   <- FALSE
 
-            self$numberOfGETRequests <- 0
+            self$numberOfGETRequests    <- 0
             self$numberOfDELETERequests <- 0
+            self$numberOfPUTRequests    <- 0
+            self$numberOfPOSTRequests   <- 0
+            self$numberOfMOVERequests   <- 0
+
+            self$serverMaxElementsPerRequest <- 5
         },
 
-        GET = function(url, headers = NULL, queryFilters = NULL, limit = NULL, offset = NULL)
+        execute = function(verb, url, headers = NULL, body = NULL, query = NULL,
+                           limit = NULL, offset = NULL, retryTimes = 0)
         {
             private$validateURL(url)
             private$validateHeaders(headers)
-            self$numberOfGETRequests <- self$numberOfGETRequests + 1
+            private$validateFilters(queryFilters)
+            private$validateBody(body)
+
+            if(verb == "GET")
+                self$numberOfGETRequests <- self$numberOfGETRequests + 1
+            else if(verb == "POST")
+                self$numberOfPOSTRequests <- self$numberOfPOSTRequests + 1
+            else if(verb == "PUT")
+                self$numberOfPUTRequests <- self$numberOfPUTRequests + 1
+            else if(verb == "DELETE")
+                self$numberOfDELETERequests <- self$numberOfDELETERequests + 1
+            else if(verb == "MOVE")
+                self$numberOfMOVERequests <- self$numberOfMOVERequests + 1
+            else if(verb == "PROPFIND")
+            {
+                return(self$content)
+            }
+
+            if(!is.null(self$content$items_available))
+                return(private$getElements(offset, limit))
+            else
+                return(self$content)
+        }
+    ),
 
-            self$content
-        },
+    private = list(
 
-        PUT = function(url, headers = NULL, body = NULL,
-                       queryFilters = NULL, limit = NULL, offset = NULL)
+        validateURL = function(url) 
         {
-            self$content
+            if(!is.null(self$expectedURL) && url == self$expectedURL)
+                self$URLIsProperlyConfigured <- TRUE
         },
 
-        POST = function(url, headers = NULL, body = NULL,
-                        queryFilters = NULL, limit = NULL, offset = NULL)
+        validateHeaders = function(headers) 
         {
-            self$content
+            if(!is.null(headers$Authorization))
+                self$requestHeaderContainsAuthorizationField <- TRUE
+
+            if(!is.null(headers$Destination))
+                self$requestHeaderContainsDestinationField <- TRUE
+
+            if(!is.null(headers$Range))
+                self$requestHeaderContainsRangeField <- TRUE
+
+            if(!is.null(headers[["Content-Type"]]))
+                self$requestHeaderContainsContentTypeField <- TRUE
         },
 
-        DELETE = function(url, headers = NULL, body = NULL,
-                          queryFilters = NULL, limit = NULL, offset = NULL)
+        validateBody = function(body)
         {
-            private$validateURL(url)
-            private$validateHeaders(headers)
-            self$numberOfDELETERequests <- self$numberOfDELETERequests + 1
-            self$content
+            if(!is.null(body))           
+            {
+                self$requestBodyIsProvided <- TRUE
+
+                if(class(body) == "json")           
+                    self$JSONEncodedBodyIsProvided <- TRUE
+            }
         },
 
-        PROPFIND = function(url, headers = NULL)
+        validateFilters = function(filters)
         {
-            self$content
+            if(!is.null(self$expectedQueryFilters) &&
+               !is.null(filters) &&
+               all.equal(unname(filters), self$expectedQueryFilters))
+            {
+                self$queryFiltersAreCorrect <- TRUE
+            }
         },
 
-        MOVE = function(url, headers = NULL)
+        getElements = function(offset, limit)
         {
-            self$content
-        }
-    ),
+            start <- 1
+            elementCount <- self$serverMaxElementsPerRequest
 
-    private = list(
+            if(!is.null(offset))
+            {
+                if(offset > self$content$items_available)
+                    stop("Invalid offset")
+                
+                start <- offset + 1
+            }
 
-        validateURL = function(url) 
-        {
-            if(!is.null(self$expectedURL) && url == self$expectedURL)
-                self$URLIsProperlyConfigured <- TRUE
-        },
+            if(!is.null(limit))
+                if(limit < self$serverMaxElementsPerRequest)
+                    elementCount <- limit - 1
 
-        validateHeaders = function(headers) 
-        {
-            if(!is.null(headers$Authorization))
-                self$requestHeaderContainsAuthorizationField <- TRUE
+
+            serverResponse <- list()
+            serverResponse$items_available <- self$content$items_available
+            serverResponse$items <- self$content$items[start:(start + elementCount - 1)]
+
+            if(start + elementCount > self$content$items_available)
+            {
+                elementCount = self$content$items_available - start
+                serverResponse$items <- self$content$items[start:(start + elementCount)]
+            }
+
+            serverResponse
         }
     ),