Escape raw vectors and support list of raw vectors

DESCRIPTION

@@ -25,6 +25,7 @@ Depends:
 Imports: 
     assertthat (>= 0.2.0),
     DBI (>= 1.0.0),
+    magrittr,
     dplyr (>= 0.8.0),
     glue (>= 1.2.0),
     lifecycle,

NAMESPACE

@@ -99,6 +99,7 @@ S3method(escape,integer)
 S3method(escape,integer64)
 S3method(escape,list)
 S3method(escape,logical)
+S3method(escape,raw)
 S3method(escape,reactivevalues)
 S3method(escape,sql)
 S3method(explain,tbl_sql)
@@ -205,6 +206,7 @@ S3method(sql_escape_ident,SQLiteConnection)
 S3method(sql_escape_logical,ACCESS)
 S3method(sql_escape_logical,DBIConnection)
 S3method(sql_escape_logical,SQLiteConnection)
+S3method(sql_escape_raw,"Microsoft SQL Server")
 S3method(sql_escape_string,DBIConnection)
 S3method(sql_join,DBIConnection)
 S3method(sql_join,MySQLConnection)
@@ -333,6 +335,7 @@ export(sql_cot)
 export(sql_escape_date)
 export(sql_escape_datetime)
 export(sql_escape_logical)
+export(sql_escape_raw)
 export(sql_expr)
 export(sql_infix)
 export(sql_log)
@@ -342,6 +345,7 @@ export(sql_paste)
 export(sql_paste_infix)
 export(sql_prefix)
 export(sql_quote)
+export(sql_raw_to_hex)
 export(sql_render)
 export(sql_str_sub)
 export(sql_substr)
@@ -453,6 +457,7 @@ importFrom(dplyr,ungroup)
 importFrom(dplyr,union)
 importFrom(dplyr,union_all)
 importFrom(glue,glue)
+importFrom(magrittr,"%>%")
 importFrom(methods,setOldClass)
 importFrom(stats,setNames)
 importFrom(stats,update)

R/backend-mssql.R

@@ -177,6 +177,11 @@
 
   )}
 
+#' @export
+`sql_escape_raw.Microsoft SQL Server` <- function(con, x) {
+  paste0("0x", sql_raw_to_hex(x))
+}
+
 #' @export
 `db_analyze.Microsoft SQL Server` <- function(con, table, ...) {
   # Using UPDATE STATISTICS instead of ANALYZE as recommended in this article

R/dbplyr.R

@@ -4,6 +4,7 @@
 #' @importFrom utils head tail
 #' @importFrom glue glue
 #' @importFrom methods setOldClass
+#' @importFrom magrittr %>%
 #' @importFrom dplyr n
 #' @import rlang
 #' @import DBI

R/escape.R

@@ -108,6 +108,11 @@ escape.integer64 <- function(x, parens = NA, collapse = ", ", con = NULL) {
   sql_vector(x, parens, collapse, con = con)
 }
 
+#' @export
+escape.raw <- function(x, parens = NA, collapse = ", ", con = NULL) {
+  sql_vector(sql_escape_raw(con, x), parens, collapse, con = con)
+}
+
 #' @export
 escape.NULL <- function(x, parens = NA, collapse = " ", con = NULL) {
   sql("NULL")
@@ -192,7 +197,6 @@ names_to_as <- function(x, names = names2(x), con = NULL) {
 #' If the quote character is present in the string, it will be doubled.
 #' `NA`s will be replaced with NULL.
 #'
-#' @export
 #' @param x Character vector to escape.
 #' @param quote Single quoting character.
 #' @export
@@ -214,7 +218,16 @@ sql_quote <- function(x, quote) {
   y
 }
 
-
+#' Helper function to convert raw vector to hex string
+#'
+#' @param x Raw vector
+#' @export
+#' @keywords internal
+#' @examples
+#' sql_raw_to_hex(charToRaw("abc"))
+sql_raw_to_hex <- function(x) {
+  paste(format(x), collapse = "")
+}
 
 #' More SQL generics
 #'
@@ -242,6 +255,13 @@ sql_escape_datetime <- function(con, x) {
   UseMethod("sql_escape_datetime")
 }
 
+#' @keywords internal
+#' @export
+#' @rdname sql_escape_logical
+sql_escape_raw <- function(con, x) {
+  UseMethod("sql_escape_raw")
+}
+
 # DBIConnection methods --------------------------------------------------------
 
 #' @export
@@ -273,4 +293,6 @@ sql_escape_logical.DBIConnection <- function(con, x) {
   y
 }
 
-
+sql_escape_raw.DBIConnection <- function(con, x) {
+  paste0("X'", sql_raw_to_hex(x), "'")
+}

R/sql-expr.R

@@ -47,7 +47,7 @@ sql_call2 <- function(.fn, ..., con = sql_current_con()) {
 
 
 replace_expr <- function(x, con) {
-  if (is.atomic(x)) {
+  if (is.atomic(x) || is_raw_list(x)) {
     as.character(escape(unname(x), con = con))
   } else if (is.name(x)) {
     as.character(x)
@@ -77,3 +77,8 @@ replace_expr <- function(x, con) {
   }
 
 }
+
+# copied from DBI
+is_raw_list <- function(x) {
+  is.list(x) && all(vapply(x, is.raw, logical(1)))
+}

tests/testthat/test-backend-mssql.R

@@ -200,3 +200,23 @@ test_that("custom lubridate functions translated correctly", {
   expect_equal(trans(quarter(x, with_year = TRUE)), sql("(DATENAME(YEAR, `x`) + '.' + DATENAME(QUARTER, `x`))"))
   expect_error(trans(quarter(x, fiscal_start = 5)))
 })
+
+test_that("custom escapes translated correctly", {
+
+  mf <- lazy_frame(x = "abc", con = simulate_mssql())
+
+  a <- charToRaw("abc")
+  b <- as.raw(c(0x01, 0x02))
+
+  expect_equal(
+    mf %>% filter(x == a) %>% sql_render(),
+    sql("SELECT *\nFROM `df`\nWHERE (`x` = 0x616263)")
+  )
+
+  L <- list(a, b)
+  expect_equal(
+    mf %>% filter(x %in% L) %>% sql_render(),
+    sql("SELECT *\nFROM `df`\nWHERE (`x` IN (0x616263, 0x0102))")
+  )
+})
+

tests/testthat/test-escape.R

@@ -86,6 +86,14 @@ test_that("date and date-times are converted to ISO 8601", {
   expect_equal(escape(x2, con = con), sql("'2000-01-02'"))
 })
 
+# Raw -----------------------------------------------------------------
+
+test_that("raw is SQL-99 compatible (by default)", {
+  con <- simulate_dbi()
+  expect_equal(escape(raw(0), con = con), sql("X''"))
+  expect_equal(escape(as.raw(c(0x01, 0x02, 0x03)), con = con), sql("X'010203'"))
+})
+
 # names_to_as() -----------------------------------------------------------
 
 test_that("names_to_as() doesn't alias when ident name and value are identical", {