Major cleaning:

* Credentials moved from R's options to package internal environment. Doesn't really protect them but at least makes them less visible.
* Obsolete spatial objects related functions removed.
* spat2jgeom rewritten using rgdal::writeOGR
* More tests
* Code formatting sanitizing in progress

.travis.yml

@@ -23,4 +23,4 @@ after_success:
 notifications:
   email:
   - [email protected]
-  - [email protected]
+#  - [email protected]

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: sentinel2
 Title: Tools to access Sentinel-2 data pre-processed by IVFL, BOKU Vienna
-Version: 0.3.1
+Version: 0.4.0
 Authors@R: c(
     person("Sebastian", "Boeck",  email = "[email protected]", role = c("aut", "cre")),
     person("Mateusz",   "Zoltak", email = "[email protected]",  role = c("ctb"))
@@ -16,7 +16,6 @@ Imports:
     httr,
     jsonlite,
     methods,
-    raster,
     rgdal,
     sp
 Suggests:

R/S2_buy_granule.R

@@ -3,74 +3,59 @@
 #' Buy granule using granuleId
 #'
 #' @param granuleId character vector of one or more granuleId's to buy
-#' @param mode one of "ask" and "always". If "ask", the user is prompted for
-#'   confirmation before spending coins ( - in interactive sessions only!).
-#'   If "always", granules are bought anyway.
+#' @param mode one of 'ask', 'always' or 'force'. If 'ask', the user is prompted
+#'   for confirmation before spending coins ( - in interactive sessions only!).
+#'   If 'always', granules are bought without prompting but granule bought
+#'   already are skipped. If 'force', granules are bought without prompting and
+#'   also withoug checking if they are already bought.
 #' @export
 
 
-S2_buy_granule <- function(granuleId, mode=c("ask", "always")){
-
-  buy_mode <- match.arg(mode)
+S2_buy_granule = function(granuleId, mode = c('ask', 'always', 'force')) {
+  buy_mode = match.arg(mode)
 
   # Check how many coins are required and available ----------------------------
-  to_buy     <- buy_check(granuleId = granuleId)
-  user_coins <- S2_user_info()$'coinsRemain'
+  to_buy     = buy_check(granuleId = granuleId)
+  user_coins = S2_user_info()$'coinsRemain'
 
   # Check if number of granules to buy exceeds coin budget ---------------------
-  if (user_coins < sum(to_buy)){
-
-    cat(sprintf("You try to buy %s granules, but you seem to have only %s coins left.\n",
-                sum(to_buy), user_coins))
+  if (user_coins < sum(to_buy)) {
+    cat(sprintf(
+      "You try to buy %s granules, but you seem to have only %s coins left.\n",
+      sum(to_buy), user_coins)
+    )
     cat("Please check coin budget or reduce number of granules to buy.")
     stop("Not enough coins to buy granules!")
-
-  } else if (sum(to_buy) == 0){
-
+  } else if (sum(to_buy) == 0 | buy_mode == 'force') {
     cat("Nothing to buy.")
     return(invisible(NULL))
-
   }
 
   # Promt user for confirmation ------------------------------------------------
   # Check if session is running in interactive mode ----------------------------
-
-  if (buy_mode == "ask"){
-
-    if (!interactive()){
-
+  if (buy_mode == "ask") {
+    if (!interactive()) {
       stop("'mode = 'ask'' can only be run in interactive mode!")
-
     } else {
-
       cat(sprintf("You are about to buy %s granules.", sum(to_buy)))
-      quest   <- "This action will cost you coins! Type 'YES' to proceed:\t"
-      buy_all <- readline(prompt = quest) %in%  c("YES", "'YES'")
-
+      quest   = "This action will cost you coins! Type 'YES' to proceed:\t"
+      if (!readline(prompt = quest) %in% c("YES", "'YES'")) {
+        cat("Action canceled.")
+        return(invisible(NULL))
+      }
     }
-
-  } else if (buy_mode == "always"){
-    buy_all <- TRUE
   }
 
   # Finally buy granule's if buy_all is TRUE -----------------------------------
-
-  if (isTRUE(buy_all)){
-
-    user      <- getOption("S2user")
-    password  <- getOption("S2password")
-
-    for (i in seq_along(granuleId)){
-      httr::PUT('https://s2.boku.eodc.eu',
-                config = httr::authenticate(user, password),
-                path   = list('granule', granuleId[i]))
-    }
-
-  } else {
-
-    cat("Action canceled.")
-    return(invisible(NULL))
-
+  credentials = get_credentials()
+  auth        = httr::authenticate(credentials['user'], credentials['password'])
+
+  for (i in seq_along(granuleId)) {
+    httr::PUT(
+      'https://s2.boku.eodc.eu',
+      config = auth,
+      path   = list('granule', granuleId[i])
+    )
   }
 }
 

R/S2_check_access.R

@@ -8,51 +8,37 @@
 #'   credentials seem to be valid, FALSE if 'anything' went wrong
 #' @export
 
-S2_check_access <- function(verbose = TRUE){
-  user     <- getOption("S2user")
-  password <- getOption("S2password")
-  srvrsp   <- httr::GET('https://s2.boku.eodc.eu/user/current',
-                        config = httr::authenticate(user, password))
-
-  if (httr::status_code(srvrsp) == 200){
-    if (httr::content(srvrsp)$userId == user){
-
-      if (isTRUE(verbose)){
-        cat(sprintf("Logged in to 'https://s2.boku.eodc.eu' as %s\n", user))
+S2_check_access = function(verbose = TRUE){
+  credentials = get_credentials()
+  srvrsp =  httr::GET(
+    'https://s2.boku.eodc.eu/user/current',
+    config = httr::authenticate(credentials['user'], credentials['password'])
+  )
+
+  if (httr::status_code(srvrsp) == 200) {
+    if (httr::content(srvrsp)$userId == credentials['user']) {
+      if (isTRUE(verbose)) {
+        cat(sprintf("Logged in to 'https://s2.boku.eodc.eu' as %s\n", credentials['user']))
       }
       return(TRUE)
-
-    } else if (httr::content(srvrsp)$userId == "public"){
-
-      if (user == "default" && password == "default"){
-        if (isTRUE(verbose)){
-          warning("Not logged in at 'https://s2.boku.eodc.eu' -> limited access to database:\n",
-                  "please supply 'user' and 'password' via 'S2_initialize_user()'\n",
-                  "see '?S2_intialize_user' for details!")
-        }
-        return(FALSE)
-
-      } else {
-
-        if (isTRUE(verbose)){
-          warning("Not logged in to s2.boku.eodc.eu -> access to database limited:\n",
-                  "please check credentials and use 'S2_initialize_user()' to\n",
-                  "supply a valid 'user' and 'password'\n",
-                  "see '?S2_intialize_user' or visit 'https://s2.boku.eodc.eu' for details!")
-        }
-        return(FALSE)
-
+    } else {
+      if (isTRUE(verbose)) {
+        warning(
+          "Not logged in to s2.boku.eodc.eu -> access to database limited:\n",
+          "please check credentials and use 'S2_initialize_user()' to\n",
+          "supply a valid 'user' and 'password'\n",
+          "see '?S2_intialize_user' or visit 'https://s2.boku.eodc.eu' for details!"
+        )
       }
+      return(FALSE)
     }
   } else {
-
-    if (isTRUE(verbose)){
-      warning(sprintf("Unable to access server! Status code %s returned",
-                   httr::status_code(srvrsp)))
+    if (isTRUE(verbose)) {
+      warning(
+        sprintf("Unable to access server! Status code %s returned",
+        httr::status_code(srvrsp))
+      )
     }
     return(FALSE)
-
   }
-
 }
-

R/S2_do_query.R

@@ -10,15 +10,14 @@
 
 
 S2_do_query = function(query, path){
-  user     = getOption("S2user")
-  password = getOption("S2password")
+  credentials = get_credentials()
 
   filter        = sapply(query, is.logical)
   query[filter] = as.numeric(query[filter])
 
   rtrn = httr::GET(
     'https://s2.boku.eodc.eu',
-    config = httr::authenticate(user, password),
+    config = httr::authenticate(credentials['user'], credentials['password']),
     path   = path,
     query  = query
   )

R/S2_generate_RGB.R

@@ -29,98 +29,103 @@
 #' @return NULL
 #' @export
 
-S2_generate_RGB <- function(granuleId,
-                            destfile = NULL,
-                            resolution = c("highest", "lowest"),
-                            atmCorr = TRUE,
-                            r = "B08",
-                            g = "B04",
-                            b = "B03",
-                            ra = 20,
-                            ga = 20,
-                            ba = 20,
-                            rb = 20,
-                            gb = 20,
-                            bb = 20,
-                            overwrite = FALSE){
-
-  resolution <- match.arg(resolution)
-  resolution <- switch(resolution, "highest" = FALSE, "lowest" = TRUE)
-
-  query      <- S2_query_image(granuleId = granuleId, atmCorr = atmCorr)
-
-  if (length(query) == 0 && !isTRUE(atmCorr)){
+S2_generate_RGB = function(
+  granuleId,
+  destfile = NULL,
+  resolution = c("highest", "lowest"),
+  atmCorr = TRUE,
+  r = "B08",
+  g = "B04",
+  b = "B03",
+  ra = 20,
+  ga = 20,
+  ba = 20,
+  rb = 20,
+  gb = 20,
+  bb = 20,
+  overwrite = FALSE
+){
+  if (length(granuleId) != 1) {
+    stop('granuleId has to be a vector of length one')
+  }
 
-    warning("Unable to process 'granuleId ", granuleId, "'. Not found in database!")
-    return(invisible(NULL))
+  resolution = match.arg(resolution)
+  resolution = switch(resolution, "highest" = FALSE, "lowest" = TRUE)
 
-  } else if (length(query) == 0 && isTRUE(atmCorr)){
+  query = S2_query_image(granuleId = granuleId, atmCorr = atmCorr)
 
-    warning("Unable to process 'granuleId ", granuleId, "'. Maybe its not (yet) ",
-         "atmospherically corrected!\n")
+  if (length(query) == 0 && !isTRUE(atmCorr)) {
+    warning("Unable to process 'granuleId ", granuleId, "'. Not found in database!")
+    return(invisible(NULL))
+  } else if (length(query) == 0 && isTRUE(atmCorr)) {
+    warning(
+      "Unable to process 'granuleId ", granuleId, "'. Maybe its not (yet) ",
+      "atmospherically corrected!\n"
+    )
     return(invisible(NULL))
-
   }
 
-  imageIds       <- integer(3)
-  min_resolution <- Inf
+  imageIds       = integer(3)
+  min_resolution = Inf
 
-  for (i in seq_len(3)){
-    sel            <- query[query$band == c(r, g, b)[i], , drop=FALSE]
-    sel            <- sel[order(sel$resolution, decreasing = resolution)[1], , drop=FALSE]
-    min_resolution <- min(c(min_resolution, sel$resolution))
+  for (i in seq_len(3)) {
+    sel            = query[query$band == c(r, g, b)[i], , drop = FALSE]
+    sel            = sel[order(sel$resolution, decreasing = resolution)[1], , drop = FALSE]
+    min_resolution = min(c(min_resolution, sel$resolution))
 
-    if (is.na(sel$url)){
+    if (is.na(sel$url)) {
       warning("Access to image denied. You seem to lack permission to download file!")
       return(invisible(NULL))
     }
 
-    imageIds[i]   <- sel[, "imageId"]
+    imageIds[i] = sel[, "imageId"]
   }
   # Generate filename ----------------------------------------------------------
-  autoname <- sprintf("RGB_%s_%s_%s_%sm_%s_%s_%s_Id%s_%s.tif",
-                      r, g, b, min_resolution,
-                      unique(format_date(query$date)),
-                      unique(query$utm),
-                      unique(query$orbit),
-                      granuleId, ifelse(atmCorr, "L2A", "L1C"))
-
-
-  query <- list(r = imageIds[1],
-                g = imageIds[2],
-                b = imageIds[3],
-                ra = ra,
-                ga = ga,
-                ba = ba,
-                rb = rb,
-                gb = gb,
-                bb = bb)
-
-  user     <- getOption("S2user")
-  password <- getOption("S2password")
-  rtrn     <- httr::modify_url('https://s2.boku.eodc.eu',
-                               username = utils::URLencode(user, reserved = TRUE),
-                               password = utils::URLencode(password, reserved = TRUE),
-                               path     = "rgb",
-                               query    = query)
-
-
-  if (is.null(destfile)){
-    destfile <- autoname
+  autoname = sprintf(
+    "RGB_%s_%s_%s_%sm_%s_%s_%s_Id%s_%s.tif",
+    r, g, b, min_resolution,
+    unique(format_date(query$date)),
+    unique(query$utm),
+    unique(query$orbit),
+    granuleId, ifelse(atmCorr, "L2A", "L1C")
+  )
+
+  query = list(
+    r = imageIds[1],
+    g = imageIds[2],
+    b = imageIds[3],
+    ra = ra,
+    ga = ga,
+    ba = ba,
+    rb = rb,
+    gb = gb,
+    bb = bb
+  )
+
+  credentials = get_credentials()
+  rtrn = httr::modify_url(
+    'https://s2.boku.eodc.eu',
+    username = utils::URLencode(credentials['user'], reserved = TRUE),
+    password = utils::URLencode(credentials['password'], reserved = TRUE),
+    path     = "rgb",
+    query    = query
+  )
+
+  if (is.null(destfile)) {
+    destfile = autoname
   }
 
-  if (dir.exists(destfile)){
-    destfile <- sprintf("%s/%s", destfile, autoname)
+  if (dir.exists(destfile)) {
+    destfile = sprintf("%s/%s", destfile, autoname)
   }
 
-
-  if (file.exists(destfile) && !isTRUE(overwrite)){
+  if (file.exists(destfile) && !isTRUE(overwrite)) {
     warning(destfile, " already exists! Use 'overwrite = TRUE' to overwrite")
     return(invisible(NULL))
   }
 
   curl::curl_download(url = rtrn, destfile = destfile)
-  return(invisible(NULL))
+  return(destfile)
 }