File: configuration.R

package info (click to toggle)
r-cran-vcr 0.6.0%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 1,360 kB
  • sloc: cpp: 15; sh: 13; makefile: 2
file content (442 lines) | stat: -rw-r--r-- 16,864 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
#' Global Configuration Options
#'
#' Configurable options that define vcr's default behavior.
#'
#' @param ... configuration settings used to override defaults. See below for a
#'   complete list of valid arguments.
#'
#' @section Configurable settings:
#'
#' ## vcr options
#'
#' ### File locations
#'
#' - `dir` Cassette directory
#' - `write_disk_path` (character) path to write files to
#' for any requests that write responses to disk. by default this parameter
#' is `NULL`. For testing a package, you'll probably want this path to
#' be in your `tests/` directory, perhaps next to your cassettes
#' directory, e.g., where your cassettes are in `tests/fixtures`, your
#' files from requests that write to disk are in `tests/files`.
#' If you want to ignore these files in your installed package, 
#' add them to `.Rinstignore`. If you want these files ignored on build
#' then add them to `.Rbuildignore` (though if you do, tests that depend
#' on these files probably will not work because they won't be found; so
#' you'll likely have to skip the associated tests as well).
#'
#' ### Contexts
#'
#' - `turned_off` (logical) VCR is turned on by default. Default:
#' `FALSE`
#' - `allow_unused_http_interactions` (logical) Default: `TRUE`
#' - `allow_http_connections_when_no_cassette` (logical) Determines how vcr
#' treats HTTP requests that are made when no vcr cassette is in use. When
#' `TRUE`, requests made when there is no vcr cassette in use will be allowed.
#' When `FALSE` (default), an [UnhandledHTTPRequestError] error will be raised
#' for any HTTP request made when there is no cassette in use
#'
#' ### Filtering
#'
#' - `ignore_hosts` (character) Vector of hosts to ignore. e.g., localhost, or
#' google.com. These hosts are ignored and real HTTP requests allowed to go
#' through
#' - `ignore_localhost` (logical) Default: `FALSE`
#' - `ignore_request` List of requests to ignore. NOT USED RIGHT NOW, sorry
#' - `filter_sensitive_data` named list of values to replace. Format is:
#'   ```
#'   list(thing_to_replace_it_with = thing_to_replace)
#'   ```
#'   We replace all instances of `thing_to_replace` with
#' `thing_to_replace_it_with`. Before recording (writing to a cassette) we do
#' the replacement and then when reading from the cassette we do the reverse
#' replacement to get back to the real data. Before record replacement happens
#' in internal function `write_interactions()`, while before playback
#' replacement happens in internal function `YAML$deserialize()`
#' 
#' - `filter_request_headers` (character/list) **request** headers to filter.
#' A character vector of request headers to remove - the headers will not be
#' recorded to disk. Alternatively, a named list similar to
#' `filter_sensitive_data` instructing vcr with what value to replace the
#' real value of the request header.
#' - `filter_response_headers` (named list) **response** headers to filter.
#' A character vector of response headers to remove - the headers will not be
#' recorded to disk. Alternatively, a named list similar to
#' `filter_sensitive_data` instructing vcr with what value to replace the
#' real value of the response header.
#' 
#' ## Errors
#' 
#' - `verbose_errors` Do you want more verbose errors or less verbose
#' errors when cassette recording/usage fails? Default is `FALSE`, that is,
#' less verbose errors. If `TRUE`, error messages will include more details
#' about what went wrong and suggest possible solutions. For testing
#' in an interactive R session, if `verbose_errors=FALSE`, you can run
#' `vcr_last_error()` to get the full error. If in non-interactive mode,
#' which most users will be in when running the entire test suite for a
#' package, you can set an environment variable (`VCR_VERBOSE_ERRORS`)
#' to toggle this setting (e.g.,
#' `Sys.setenv(VCR_VERBOSE_ERRORS=TRUE); devtools::test()`)
#'
#' ### Internals
#'
#' - `cassettes` (list) don't use
#' - `linked_context` (logical) linked context
#' - `uri_parser` the uri parser, default: `crul::url_parse()`
#'
#' ### Logging
#'
#' - `log` (logical) should we log important vcr things? Default: `FALSE`
#' - `log_opts` (list) Additional logging options:
#'   - 'file' either `"console"` or a file path to log to
#'   - 'log_prefix' default: "Cassette". We insert the cassette name after
#'     that prefix, then the rest of the message.
#'   - More to come...
#'
#' ## Cassette Options
#'
#' These settings can be configured globally, using `vcr_configure()`, or
#' locally, using either `use_cassette()` or `insert_cassette()`. Global
#' settings are applied to *all* cassettes but are overridden by settings
#' defined locally for individual cassettes.
#'
#' - `record` (character) One of 'all', 'none', 'new_episodes', or 'once'.
#' See [recording]
#' - `match_requests_on` vector of matchers. Default: (`method`, `uri`)
#' See [request-matching] for details.
#' - `serialize_with`: (character) "yaml" or "json". Note that you can have
#' multiple cassettes with the same name as long as they use different
#' serializers; so if you only want one cassette for a given cassette name,
#' make sure to not switch serializers, or clean up files you no longer need.
#' - `json_pretty`: (logical) want JSON to be newline separated to be easier
#' to read? Or remove newlines to save disk space? default: FALSE
#' - `persist_with` (character) only option is "FileSystem"
#' - `preserve_exact_body_bytes` (logical) preserve exact body bytes for
#' - `re_record_interval` (numeric) When given, the cassette will be
#' re-recorded at the given interval, in seconds.
#' - `clean_outdated_http_interactions` (logical) Should outdated interactions
#' be recorded back to file. Default: `FALSE`
#'
#' @examples
#' vcr_configure(dir = tempdir())
#' vcr_configure(dir = tempdir(), record = "all")
#' vcr_configuration()
#' vcr_config_defaults()
#' vcr_configure(dir = tempdir(), ignore_hosts = "google.com")
#' vcr_configure(dir = tempdir(), ignore_localhost = TRUE)
#'
#'
#' # logging
#' vcr_configure(dir = tempdir(), log = TRUE,
#'   log_opts = list(file = file.path(tempdir(), "vcr.log")))
#' vcr_configure(dir = tempdir(), log = TRUE, log_opts = list(file = "console"))
#' vcr_configure(dir = tempdir(), log = TRUE,
#'  log_opts = list(
#'    file = file.path(tempdir(), "vcr.log"),
#'    log_prefix = "foobar"
#' ))
#' vcr_configure(dir = tempdir(), log = FALSE)
#'
#' # filter sensitive data
#' vcr_configure(dir = tempdir(),
#'   filter_sensitive_data = list(foo = "<bar>")
#' )
#' vcr_configure(dir = tempdir(),
#'   filter_sensitive_data = list(foo = "<bar>", hello = "<world>")
#' )
#' @export

vcr_configure <- function(...) {
  params <- list(...)

  invalid <- !names(params) %in% vcr_c$fields()
  if (any(invalid)) {
    warning(
      "The following configuration parameters are not valid:",
      sprintf("\n  * %s", params[invalid]),
      call. = FALSE
    )
    params <- params[!invalid]
  }

  if (length(params) == 0) return(vcr_c)

  # TODO: Is this still the right place to change these settings?
  ignore_hosts <- params$ignore_hosts
  ignore_localhost <- params$ignore_localhost %||% FALSE
  if (!is.null(ignore_hosts) || ignore_localhost) {
    x <- RequestIgnorer$new()
    if (!is.null(ignore_hosts)) x$ignore_hosts(hosts = ignore_hosts)
    if (ignore_localhost) x$ignore_localhost()
  }

  for (i in seq_along(params)) {
    vcr_c[[names(params)[i]]] <- params[[i]]
  }
  return(vcr_c)
}

#' @export
#' @rdname vcr_configure
vcr_configure_reset <- function() vcr_c$reset()

#' @export
#' @rdname vcr_configure
vcr_configuration <- function() vcr_c

#' @export
#' @rdname vcr_configure
vcr_config_defaults <- function() VCRConfig$new()$as_list()

VCRConfig <- R6::R6Class(
  "VCRConfig",

  private = list(
    .dir = NULL,
    .record = NULL,
    .match_requests_on = NULL,
    .allow_unused_http_interactions = NULL,
    .serialize_with = NULL,
    .json_pretty = NULL,
    .persist_with = NULL,
    .ignore_hosts = NULL,
    .ignore_localhost = NULL,
    .ignore_request = NULL,
    .uri_parser = NULL,
    .preserve_exact_body_bytes = NULL,
    .turned_off = NULL,
    .re_record_interval = NULL,
    .clean_outdated_http_interactions = NULL,
    .allow_http_connections_when_no_cassette = NULL,
    .cassettes = NULL,
    .linked_context = NULL,
    .log = NULL,
    .log_opts = NULL,
    .filter_sensitive_data = NULL,
    .filter_request_headers  = NULL,
    .filter_response_headers  = NULL,
    .write_disk_path = NULL,
    .verbose_errors = NULL
  ),

  active = list(
    dir = function(value) {
      if (missing(value)) return(private$.dir)
      private$.dir <- value
    },
    record = function(value) {
      if (missing(value)) return(private$.record)
      private$.record <- check_record_mode(value)
    },
    match_requests_on = function(value) {
      if (missing(value)) return(private$.match_requests_on)
      private$.match_requests_on <- check_request_matchers(value)
    },
    allow_unused_http_interactions = function(value) {
      if (missing(value)) return(private$.allow_unused_http_interactions)
      private$.allow_unused_http_interactions <- value
    },
    serialize_with = function(value) {
      if (missing(value)) return(private$.serialize_with)
      private$.serialize_with <- value
    },
    json_pretty = function(value) {
      if (missing(value)) return(private$.json_pretty)
      private$.json_pretty <- value
    },
    persist_with = function(value) {
      if (missing(value)) return(private$.persist_with)
      private$.persist_with <- value
    },
    ignore_hosts = function(value) {
      if (missing(value)) return(private$.ignore_hosts)
      private$.ignore_hosts <- assert(value, "character")
    },
    ignore_localhost = function(value) {
      if (missing(value)) return(private$.ignore_localhost)
      private$.ignore_localhost <- assert(value, "logical")
    },
    ignore_request = function(value) {
      if (missing(value)) return(private$.ignore_request)
      private$.ignore_request <- value
    },
    uri_parser = function(value) {
      if (missing(value)) return(private$.uri_parser)
      private$.uri_parser <- value
    },
    preserve_exact_body_bytes = function(value) {
      if (missing(value)) return(private$.preserve_exact_body_bytes)
      private$.preserve_exact_body_bytes <- value
    },
    turned_off = function(value) {
      if (missing(value)) return(private$.turned_off)
      private$.turned_off <- value
    },
    re_record_interval = function(value) {
      if (missing(value)) return(private$.re_record_interval)
      private$.re_record_interval <- value
    },
    clean_outdated_http_interactions = function(value) {
      if (missing(value)) return(private$.clean_outdated_http_interactions)
      private$.clean_outdated_http_interactions <- value
    },
    allow_http_connections_when_no_cassette = function(value) {
      if (missing(value)) return(private$.allow_http_connections_when_no_cassette)
      private$.allow_http_connections_when_no_cassette <- value
    },
    cassettes = function(value) {
      if (missing(value)) return(private$.cassettes)
      private$.cassettes <- value
    },
    linked_context = function(value) {
      if (missing(value)) return(private$.linked_context)
      private$.linked_context <- value
    },
    log = function(value) {
      if (missing(value)) return(private$.log)
      private$.log <- assert(value, "logical")
    },
    log_opts = function(value) {
      if (missing(value)) return(private$.log_opts)
      log_opts <- assert(value, "list")
      if (length(log_opts) > 0) {
        if ("file" %in% names(log_opts)) {
          assert(log_opts$file, "character")
          if (private$.log) vcr_log_file(log_opts$file)
        }
        if ("log_prefix" %in% names(log_opts)) {
          assert(log_opts$log_prefix, "character")
        }
        if ("date" %in% names(log_opts)) {
          assert(log_opts$date, "logical")
        }
      }
      # add missing log options
      log_opts <- merge_list(
        log_opts,
        list(file = "vcr.log", log_prefix = "Cassette", date = TRUE)
      )
      private$.log_opts <- log_opts
    },
    filter_sensitive_data = function(value) {
      if (missing(value)) return(private$.filter_sensitive_data)
      private$.filter_sensitive_data <- assert(value, "list")
    },
    filter_request_headers = function(value) {
      if (missing(value)) return(private$.filter_request_headers)
      if (is.character(value)) value <- as.list(value)
      private$.filter_request_headers <- assert(value, "list")
    },
    filter_response_headers = function(value) {
      if (missing(value)) return(private$.filter_response_headers)
      if (is.character(value)) value <- as.list(value)
      private$.filter_response_headers <- assert(value, "list")
    },
    write_disk_path = function(value) {
      if (missing(value)) return(private$.write_disk_path)
      private$.write_disk_path <- value
    },
    verbose_errors = function(value) {
      env_ve <- vcr_env_verbose_errors()
      if (missing(value) && is.null(env_ve)) return(private$.verbose_errors)
      value <- env_ve %||% value
      private$.verbose_errors <- assert(value, "logical")
    }
  ),

  public = list(
    initialize = function(
      dir = ".",
      record = "once",
      match_requests_on = c("method", "uri"),
      allow_unused_http_interactions = TRUE,
      serialize_with = "yaml",
      json_pretty = FALSE,
      persist_with = "FileSystem",
      ignore_hosts = NULL,
      ignore_localhost = FALSE,
      ignore_request = NULL,
      uri_parser = "crul::url_parse",
      preserve_exact_body_bytes = FALSE,
      turned_off = FALSE,
      re_record_interval = NULL,
      clean_outdated_http_interactions = FALSE,
      allow_http_connections_when_no_cassette = FALSE,
      cassettes = list(),
      linked_context = NULL,
      log = FALSE,
      log_opts = list(file = "vcr.log", log_prefix = "Cassette", date = TRUE),
      filter_sensitive_data = NULL,
      filter_request_headers  = NULL,
      filter_response_headers  = NULL,
      write_disk_path = NULL,
      verbose_errors = FALSE
    ) {
      self$dir <- dir
      self$record <- record
      self$match_requests_on <- match_requests_on
      self$allow_unused_http_interactions <- allow_unused_http_interactions
      self$serialize_with <- serialize_with
      self$json_pretty <- json_pretty
      self$persist_with <- persist_with
      self$ignore_hosts <- ignore_hosts
      self$ignore_localhost <- ignore_localhost
      self$ignore_request <- ignore_request
      self$uri_parser <- uri_parser
      self$preserve_exact_body_bytes <- preserve_exact_body_bytes
      self$turned_off <- turned_off
      self$re_record_interval <- re_record_interval
      self$clean_outdated_http_interactions <- clean_outdated_http_interactions
      self$allow_http_connections_when_no_cassette <- allow_http_connections_when_no_cassette
      self$cassettes <- cassettes
      self$linked_context <- linked_context
      self$log <- log
      self$log_opts <- log_opts
      self$filter_sensitive_data <- filter_sensitive_data
      self$filter_request_headers  = filter_request_headers
      self$filter_response_headers  = filter_response_headers
      self$write_disk_path <- write_disk_path
      self$verbose_errors <- verbose_errors
    },

    # reset all settings to defaults
    reset = function() self$initialize(),

    # print out names of configurable settings
    fields = function() sub("^\\.", "", names(private)),

    # return current configuration as a list
    as_list = function() {
      setNames(mget(names(private), private), self$fields())
    },

    print = function(...) {
      cat("<vcr configuration>", sep = "\n")
      cat(paste0("  Cassette Dir: ", private$.dir), sep = "\n")
      cat(paste0("  Record: ", private$.record), sep = "\n")
      cat(paste0("  Serialize with: ", private$.serialize_with), sep = "\n")
      cat(paste0("  URI Parser: ", private$.uri_parser), sep = "\n")
      cat(paste0("  Match Requests on: ",
        pastec(private$.match_requests_on)), sep = "\n")
      cat(paste0("  Preserve Bytes?: ",
        private$.preserve_exact_body_bytes), sep = "\n")
      logloc <- if (private$.log) sprintf(" (%s)", private$.log_opts$file) else ""
      cat(paste0("  Logging?: ", private$.log, logloc), sep = "\n")
      cat(paste0("  ignored hosts: ", pastec(private$.ignore_hosts)), sep = "\n")
      cat(paste0("  ignore localhost?: ", private$.ignore_localhost), sep = "\n")
      cat(paste0("  Write disk path: ", private$.write_disk_path), sep = "\n")
      invisible(self)
    }
  )
)

pastec <- function(x) paste0(x, collapse = ", ")

vcr_env_verbose_errors <- function() {
  var <- "VCR_VERBOSE_ERRORS"
  x <- Sys.getenv(var, "")
  if (x != "") {
    x <- as.logical(x)
    vcr_env_var_check(x, var)
    x
  }
}