R/client.R

In ropensci/reeack: Client for Riak

#' reeack connection client
#'
#' @export
#' @param host (character) A base URL (without the transport), e.g.,
#' \code{localhost}, \code{127.0.0.1}, or \code{foobar.cloudant.com}
#' @param port (numeric) Port. Remember that if you don't want a port set,
#' set this parameter to \code{NULL}. Default: \code{5984}
#' @param path (character) context path that is appended to the end of the
#' url. e.g., \code{bar} in \code{http://foo.com/bar}. Default: NULL, ignored
#' @param transport (character) http or https. Default: http
#' @param user (character) A user name
#' @param pwd (character) A password
#' @param headers headers, a named list
#'
#' @details
#' \strong{Methods}
#'   \describe{
#'     \item{\code{ping()}}{
#'       Ping the Riak server
#'     }
#'     \item{\code{stats()}}{
#'       Get Riak server stats
#'     }
#'     \item{\code{keys()}}{
#'       Get keys
#'     }
#'     \item{\code{buckets()}}{
#'       Get buckets
#'     }
#'     \item{\code{bucket_set()}}{
#'       Set bucket properties
#'     }
#'     \item{\code{bucket_get()}}{
#'       Get bucket properties
#'     }
#'     \item{\code{create()}}{
#'       Create an object
#'     }
#'     \item{\code{fetch()}}{
#'       Fetch an object
#'     }
#'     \item{\code{delete()}}{
#'       Delete an object
#'     }
#'   }
#'
#' @format NULL
#' @usage NULL
#'
#' @return An object of class \code{riak_client}, with variables accessible for
#' host, port, path, transport, user, pwd, and headers. Functions are callable
#' to get headers, and to make the base url sent with all requests.
#'
#' @examples \dontrun{
#' # Create a Riak client
#' (x <- riak())
#'
#' ## metadata
#' x$host
#' x$path
#' x$port
#'
#' ## ping the Riak server
#' x$ping()
#'
#' ## stats
#' x$stats()
#'
#' ## keys
#' ### list keys
#' x$keys()
#' ### in a specific bucket
#' x$keys("test")
#'
#' ## buckets
#' ### list buckets
#' x$buckets()
#'
#' ## bucket properties
#' ### set
#' x$bucket_set("test", n_val = 3, verbose=TRUE)
#'
#' ### get
#' props <- x$bucket_get("test")
#' props$props$n_val
#'
#' ## create ~ store
#' ### plain text
#' x$create(body = "foo bar", content_type = "text/plain")
#' ### json
#' x$create(body = '{"foo": "bar"}', content_type = "application/json")
#' ### a data.frame
#' x$create(body = riak_serialize(iris), content_type = "text/plain")
#'
#' #### with a key
#' x$create(key = "doc", body = "foo bar", content_type = "text/plain")
#'
#' ## fetch from store
#' ### plain text
#' res <- x$create(body = "foo bar", content_type = "text/plain")
#' x$fetch(key = res$key)
#' ### json
#' res <- x$create(body = '{"foo": "bar"}', content_type = "application/json")
#' jsonlite::fromJSON(x$fetch(key = res$key))
#' ### a data.frame
#' res <- x$create(body = riak_serialize(iris), content_type = "text/plain")
#' head(
#'   riak_unserialize(x$fetch(key = res$key))
#' )
#'
#' ## delete from store
#' (res <- x$keys("test")$keys)
#' x$delete(key = res[1])
#' res[1] %in% x$keys("test")$keys
#' }
riak <- function(host = '127.0.0.1', port = 8098, path = NULL,
                 transport = "http", user = NULL, pwd = NULL, headers = NULL) {

  riak_client$new(host = host, port = port, path = path, transport = transport,
                  user = user, pwd = pwd, headers = headers)
}

riak_client <- R6::R6Class(
  "riak_client",
  public = list(
    host = '127.0.0.1',
    port = 8098,
    path = NULL,
    transport = 'http',
    user = NULL,
    pwd = NULL,
    headers = NULL,

    initialize = function(host, port, path, transport, user, pwd, headers) {
      if (!missing(host)) self$host <- host
      if (!missing(port)) self$port <- port
      if (!missing(path)) self$path <- path
      if (!missing(transport)) self$transport <- transport
      if (!missing(user)) self$user <- user
      if (!missing(pwd)) self$pwd <- pwd
      if (!missing(headers)) self$headers <- headers
    },

    print = function() {
      cat("<riak> ", sep = "\n")
      cat(paste0("  transport: ", self$transport), sep = "\n")
      cat(paste0("  host: ", self$host), sep = "\n")
      cat(paste0("  port: ", self$port), sep = "\n")
      cat(paste0("  path: ", self$path), sep = "\n")
      cat(paste0("  type: ", self$type), sep = "\n")
      cat(paste0("  user: ", self$user), sep = "\n")
      cat(paste0("  pwd: ", if (!is.null(self$pwd)) '<secret>' else ''),
          sep = "\n")
      invisible(self)
    },

    ping = function(...) {
      riak_GET_ping(private$make_url(), "ping", ...) == 200
    },

    stats = function(...) {
      jsonlite::fromJSON(
        riak_GET(private$make_url(), "stats", ...)
      )
    },

    keys = function(bucket = "bucket", keys = 'true', type = NULL, ...) {
      path <- if (!is.null(type)) {
        sprintf("types/%s/buckets/%s/keys", type, bucket)
      } else {
        sprintf("buckets/%s/keys", bucket)
      }
      jsonlite::fromJSON(
        riak_GET(private$make_url(), path, list(keys = keys), ...)
      )
    },

    buckets = function(type = NULL, ...) {
      path <- "buckets"
      if (!is.null(type)) path <- sprintf("types/%s/buckets", type)
      jsonlite::fromJSON(
        riak_GET(private$make_url(), path, list(buckets = "true"), ...)
      )
    },

    bucket_set = function(bucket, n_val = NULL, allow_mult = NULL,
                          last_write_wins = NULL, precommit = NULL,
                          postcommit = NULL, r = NULL, w = NULL, dw = NULL,
                          rw = NULL, backend = NULL, ...) {

      path <- sprintf("buckets/%s/props", bucket)
      body <- list(props = sc(list(n_val = n_val, allow_mult = allow_mult,
                      last_write_wins = last_write_wins, precommit = precommit,
                      postcommit = postcommit, r = r, w = w, dw = dw,
                      rw = rw, backend = backend)))
      riak_PUT(private$make_url(), path, body = body, ...)
    },

    bucket_get = function(bucket, ...) {
      path <- sprintf("buckets/%s/props", bucket)
      jsonlite::fromJSON(
        riak_GET(private$make_url(), path, ...)
      )
    },

    create = function(bucket = NULL, key = NULL, body, content_type = NULL,
                      return_body = TRUE, ...) {
      path <- "buckets/test/keys"
      if (!is.null(bucket)) path <- sprintf("buckets/%s/keys", bucket)
      if (!is.null(key)) path <- file.path(path, key)
      #ctype <- guess_ctype(body, content_type)
      args <- sc(list(return_body = asl(return_body)))
      riak_CREATE(key, private$make_url(), path, body = body, args = args,
                content_type = content_type, ...)
    },

    fetch = function(key, bucket = NULL, r = NULL, pr = NULL,
                     basic_quorum = NULL, notfound_ok = NULL, vtag = NULL, ...) {

      path <- "buckets/test/keys"
      if (!is.null(bucket)) path <- sprintf("buckets/%s/keys", bucket)
      path <- file.path(path, key)
      args <- sc(list(r = r, pr = pr, basic_quorum = basic_quorum,
                      notfound_ok = notfound_ok, vtag = vtag))
      riak_GET(private$make_url(), path, args, ...)
    },

    delete = function(key, bucket = NULL, rw = NULL, r = NULL, pr = NULL,
                     w = NULL, dw = NULL, pw = NULL, ...) {

      path <- "buckets/test/keys"
      if (!is.null(bucket)) path <- sprintf("buckets/%s/keys", bucket)
      path <- file.path(path, key)
      args <- sc(list(rw = rw, r = r, pr = pr, w = w, dw = dw, pw = pw))
      riak_DELETE(private$make_url(), path, args, ...)
    }
  ),

  private = list(
    make_url = function() {
      tmp <- sprintf("%s://%s", self$transport, self$host)
      if (!is.null(self$port)) {
        tmp <- sprintf("%s:%s", tmp, self$port)
      }
      if (!is.null(self$path)) {
        tmp <- sprintf("%s/%s", tmp, self$path)
      }
      tmp
    }
  )
)