Merge branch 'main' from workbench2.git
[arvados.git] / 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 )