diff --git a/.Rbuildignore b/.Rbuildignore index 54336f4..44aa68b 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -16,3 +16,5 @@ Rprof\.out ^scripts$ ^vignettes_src$ ^appveyor\.yml$ +^.*\.Rproj$ +^\.Rproj\.user$ diff --git a/DESCRIPTION b/DESCRIPTION index 4d7b8ef..b1d482a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -15,6 +15,7 @@ URL: https://github.com/richfitz/storr BugReports: https://github.com/richfitz/storr/issues Imports: R6 (>= 2.1.0), + base64url, digest Suggests: DBI (>= 0.6), @@ -27,5 +28,5 @@ Suggests: rbenchmark, testthat (>= 1.0.0) VignetteBuilder: knitr -RoxygenNote: 6.0.1 +RoxygenNote: 6.1.0 Encoding: UTF-8 diff --git a/NAMESPACE b/NAMESPACE index 88661fb..525212e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -19,3 +19,4 @@ export(storr_rds) export(storr_redis_api) export(test_driver) importFrom(R6,R6Class) +importFrom(base64url,base64_urlencode) diff --git a/R/base64.R b/R/base64.R index ad10230..3dd5296 100644 --- a/R/base64.R +++ b/R/base64.R @@ -9,6 +9,7 @@ ##' @param pad Logical, indicating if strings should be padded with ##' \code{=} characters (as RFC 4648 requires) ##' @export +##' @importFrom base64url base64_urlencode ##' @examples ##' x <- encode64("hello") ##' x @@ -21,28 +22,22 @@ encode64 <- function(x, char62 = "-", char63 = "_", pad = TRUE) { if (length(x) != 1L) { return(vcapply(x, encode64, char62, char63, pad, USE.NAMES = FALSE)) } - tr <- c(LETTERS, letters, 0:9, char62, char63) - x <- as.integer(charToRaw(x)) - n_bytes <- length(x) - n_blocks <- ceiling(n_bytes / 3L) - n_pad <- 3L * n_blocks - n_bytes - - ## The integer() call here pads the *input* to have the correct number - ## of blocks of bytes. - x <- matrix(c(x, integer(3L * n_blocks - n_bytes)), 3L, n_blocks) - - y <- matrix(integer(4 * n_blocks), 4L, n_blocks) - y[1L, ] <- bitwShiftR(x[1L, ], 2L) - y[2L, ] <- bitwOr(bitwShiftL(x[1L, ], 4L), bitwShiftR(x[2L, ], 4L)) - y[3L, ] <- bitwOr(bitwShiftL(x[2L, ], 2L), bitwShiftR(x[3L, ], 6L)) - y[4L, ] <- x[3L, ] - - z <- tr[bitwAnd(y, 63L) + 1L] - if (n_pad > 0) { - len <- length(z) - z[(len - n_pad + 1):len] <- if (pad) "=" else "" + out <- base64url::base64_urlencode(x) + if (!identical(char62, "-")) { + gsub(pattern = "-", replacement = char62, x = out, fixed = TRUE) + } + if (!identical(char63, "_")) { + gsub(pattern = "_", replacement = char62, x = out, fixed = TRUE) + } + if (pad) { + x <- as.integer(charToRaw(x)) + n_bytes <- length(x) + n_blocks <- ceiling(n_bytes / 3L) + n_pad <- 3L * n_blocks - n_bytes + char_pad <- replicate(n_pad, "=") + out <- paste(c(out, char_pad), collapse = "") } - paste0(z, collapse = "") + out } diff --git a/man/storr_rds.Rd b/man/storr_rds.Rd index 4e46782..a5c4e23 100644 --- a/man/storr_rds.Rd +++ b/man/storr_rds.Rd @@ -5,8 +5,9 @@ \alias{driver_rds} \title{rds object cache driver} \usage{ -storr_rds(path, compress = NULL, mangle_key = NULL, mangle_key_pad = NULL, - hash_algorithm = NULL, default_namespace = "objects") +storr_rds(path, compress = NULL, mangle_key = NULL, + mangle_key_pad = NULL, hash_algorithm = NULL, + default_namespace = "objects") driver_rds(path, compress = NULL, mangle_key = NULL, mangle_key_pad = NULL, hash_algorithm = NULL)