R/zzz.r

Defines functions sc asl riak_GET riak_GET_ping riak_CREATE riak_PUT riak_DELETE guess_ctype

sc <- function(l) Filter(Negate(is.null), l)

asl <- function(x){
  if (is.null(x)) {
    NULL
  } else {
    if (x) 'true' else 'false'
  }
}

riak_GET <- function(url, path = "", args = list(), ...) {
  cli <- crul::HttpClient$new(url = url)
  res <- cli$get(path, query = args, ...)
  res$raise_for_status()
  res$parse("UTF-8")
}

riak_GET_ping <- function(url, path = "", args = list(), ...) {
  cli <- crul::HttpClient$new(url = url)
  res <- cli$get(path, query = args, ...)
  res$status_code
}

riak_CREATE <- function(key, url, path = "", body = list(), args, content_type, ...) {
  cli <- crul::HttpClient$new(url = url)
  if (!is.null(content_type)) cli$headers <- list(`Content-Type` = content_type)
  if (is.null(key)) {
    res <- cli$post(path, body = body, query = args, ...)
  } else {
    res <- cli$put(path, body = body, query = args, ...)
  }
  res$raise_for_status()
  list(
    success = res$status_code < 300,
    location = res$response_headers$location,
    key = {
      if (!is.null(key)) key else basename(res$response_headers$location)
    }
  )
}

riak_PUT <- function(url, path = "", args = list(), body = list(), ...) {
  cli <- crul::HttpClient$new(url = url)
  res <- cli$put(path, query = args, body = body, encode = "json", ...)
  res$raise_for_status()
  res$status_code == 204
}

riak_DELETE <- function(url, path = "", args = list(), ...) {
  cli <- crul::HttpClient$new(url = url)
  res <- cli$delete(path, query = args, ...)
  res$raise_for_status()
  res$status_code == 204
}

guess_ctype <- function(x, y = NULL) {
  if (!is.null(y)) {
    stopifnot(y %in% unname(mime::mimemap))
    return(y)
  }
}


# url = "http://127.0.0.1:8098"
# path <- "buckets/test/keys"
# body = "dat things"
# content_type = "text/plain"
ropensci/reeack documentation built on Dec. 11, 2019, 3:13 p.m.