Various fixes:

* S2_query_roi() supports the `spatial` parameter as S2_query_granule()
* Many small fixes to S2_buy_granule()
* S2_do_query() casts result to dplyr's tibble if the dplyr package is available
* S2_put_ROI() renamed to S2_put_roi() and now returns already parsed REST API response
* More tests

DESCRIPTION

@@ -21,6 +21,7 @@ Imports:
 Suggests:
     testthat,
     covr,
+    dplyr,
     knitr,
     rmarkdown,
     sf

R/S2_buy_granule.R

@@ -8,6 +8,10 @@
 #'   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.
+#' @return boolean logical vector indicating which granules were actually bought
+#'   (note that if \code{mode = 'force'}, there will be no \code{FALSE} values
+#'   in the returned vector). If the underlaying HTTP request failed, the value
+#'   is \code{NA}.
 #' @export
 S2_buy_granule = function(granuleId, mode = c('ask', 'always', 'force')) {
   buy_mode = match.arg(mode)
@@ -17,16 +21,16 @@ S2_buy_granule = function(granuleId, mode = c('ask', 'always', 'force')) {
   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) & sum(to_buy) > 0) {
+    stop(
+      "You try to buy ", sum(to_buy), " granules, but you seem to have only ", user_coins, " coins left.\n",
+      "Please check coin budget or reduce number of granules to buy."
     )
-    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 | buy_mode == 'force') {
-    cat("Nothing to buy.")
-    return(invisible(NULL))
+  } else if (sum(to_buy) == 0 & buy_mode != 'force') {
+    if (interactive()) {
+      cat("Nothing to buy.")
+    }
+    return(invisible(rep(FALSE, length(granuleId))))
   }
 
   # Promt user for confirmation ------------------------------------------------
@@ -48,11 +52,16 @@ S2_buy_granule = function(granuleId, mode = c('ask', 'always', 'force')) {
   credentials = get_credentials()
   auth        = httr::authenticate(credentials['user'], credentials['password'])
 
+  rtrn = rep(FALSE, length(granuleId))
   for (i in seq_along(granuleId)) {
-    httr::PUT(
-      'https://s2.boku.eodc.eu',
-      config = auth,
-      path   = list('granule', granuleId[i])
-    )
+    if (to_buy[i] | mode == 'force') {
+      resp = httr::PUT(
+        'https://s2.boku.eodc.eu',
+        config = auth,
+        path   = list('granule', granuleId[i])
+      )
+      rtrn[i] = ifelse(httr::status_code(resp) == 200, TRUE, NA)
+    }
   }
+  return(invisible(rtrn))
 }

R/S2_do_query.R

@@ -19,6 +19,7 @@ S2_do_query = function(query, path, baseUrl = 'https://s2.boku.eodc.eu'){
     path   = path,
     query  = query
   )
+
   if (!httr::status_code(rtrn) %in% c(200, 204)) {
     stop(
       httr::modify_url(baseUrl, path = path, query = query),
@@ -35,6 +36,10 @@ S2_do_query = function(query, path, baseUrl = 'https://s2.boku.eodc.eu'){
     }
   )
 
+  if ('dplyr' %in% utils::installed.packages()) {
+    rtrn = dplyr::as.tbl(rtrn)
+  }
+
   return(rtrn)
 }
 

R/S2_put_ROI.R → R/S2_put_roi.R

@@ -10,10 +10,9 @@
 #' @param indicators character vector of indicator names to be computed for a
 #'   given region (e.g. \code{c("LAI", "FAPAR")})
 #' @param srid integer geometry projection SRID (e.g. 4326 for WGS-84)
-#' @return side effect of putting the roi supplied via 'geometry' to
-#'   's2.boku.eodc.eu'
+#' @return object describing the created ROI (as returned by the REST API)
 #' @export
-S2_put_ROI = function(
+S2_put_roi = function(
   geometry,
   regionId    = NULL,
   cloudCovMax = 50,
@@ -56,8 +55,9 @@ S2_put_ROI = function(
   )
   rtrn = httr::PUT(
     url = url, body = body_l,
+    encode = 'json',
     config = httr::authenticate(credentials['user'], credentials['password'])
   )
 
-  return(rtrn)
+  return(jsonlite::fromJSON(httr::content(rtrn, as = 'text')))
 }

R/S2_query_roi.R

@@ -12,17 +12,20 @@
 #' @param utm character UTM zone, e.g. 33U, 01C.
 #' @param dateSingle character date of format "YYYY-MM-DD", specifies a single
 #'   date and will override \code{dateMin} and \code{dateMax}.
+#' @param spatial character, R package name (\code{sp} or \code{sf}) to the
+#'   format used by which roi geometries should be converted.
 #' @param ... further arguments, none implemented.
 #' @return data.frame return of the database.
 #' @export
 
 S2_query_roi = function(
-  dateMax      = Sys.Date(),
-  dateMin      = '2000-01-01',
+  dateMax      = NULL,
+  dateMin      = NULL,
   geometry     = NULL,
   regionId     = NULL,
   utm          = NULL,
   dateSingle   = NULL,
+  spatial      = NULL,
   ...
 ){
   # check inputs ---------------------------------------------------------------
@@ -48,6 +51,9 @@ S2_query_roi = function(
 
   # return query list ----------------------------------------------------------
   rtrn = S2_do_query(query = query, path = 'roi')
+  if (!is.null(spatial) & nrow(rtrn) > 0) {
+    rtrn$geometry = geojson_to_geometry(rtrn$geometry, spatial)
+  }
   if (nrow(rtrn) == 0) {
     rtrn$regionId = character()
   }

R/roi_to_jgeom.R

@@ -20,7 +20,7 @@ roi_to_jgeom = function(roi, projection = sp::CRS('+init=epsg:4326')){
       layer = sub('^.*/(.+)[.][sS][hH][pP]$', '\\1', roi)
       roi = rgdal::readOGR(dsn, layer, verbose = FALSE)
     } else {
-      roi = rgdal::readOGR(roi)
+      roi = rgdal::readOGR(roi, verbose = FALSE)
     }
   } else if (is.character(roi)) {
     roi = rgdal::readOGR(roi, 'OGRGeoJSON', verbose = FALSE)
@@ -31,6 +31,9 @@ roi_to_jgeom = function(roi, projection = sp::CRS('+init=epsg:4326')){
     roi = sp::SpatialPointsDataFrame(roi, data.frame(id = seq_along(roi[, 1])), proj4string = projection)
   }
 
+  if (is.na(sp::proj4string(roi))) {
+    sp::proj4string(roi) = sp::CRS('+init=epsg:4326')
+  }
   roi = sp::spTransform(roi, CRSobj = sp::CRS('+init=epsg:4326'))
   roi_geom = spat_to_jgeom(spat = roi)
 

tests/testthat/test-S2_buy_granule.R

@@ -0,0 +1,11 @@
+context('buying')
+
+test_that('S2_buy_granule() works', {
+  granules = S2_query_granule(owned = TRUE)
+
+  expect_equal(S2_buy_granule(granules$granuleId[1:2], 'always'), c(FALSE, FALSE))
+
+  expect_equal(S2_buy_granule(granules$granuleId[1:2], 'force'), c(TRUE, TRUE))
+
+  expect_error(S2_buy_granule(1, 'always'), 'Please check coin budget')
+})

tests/testthat/test-S2_put_ROI.R

@@ -0,0 +1,15 @@
+context('put roi')
+
+test_that('S2_put_roi() works', {
+  ret = S2_put_roi('{"type": "Polygon", "coordinates": [[[16.5, 48.0], [16.6, 48.1], [16.6, 48.0], [16.5, 48.0]]]}', '__test__', 0, 'LAI', '1900-01-01', '1900-01-02')
+  expect_equal(ret, list(userId = 'test@s2.boku.eodc.eu', regionId = '__test__'))
+  d = S2_query_roi(regionId = '__test__')
+  expect_equal(nrow(d), 1)
+  expect_equal(d$dateMax, '1900-01-02')
+
+  ret = S2_put_roi('{"type": "Polygon", "coordinates": [[[16.5, 48.0], [16.6, 48.1], [16.6, 48.0], [16.5, 48.0]]]}', '__test__', 0, 'LAI', '1900-01-01', '1900-02-02')
+  expect_equal(ret, list(userId = 'test@s2.boku.eodc.eu', regionId = '__test__'))
+  d = S2_query_roi(regionId = '__test__')
+  expect_equal(nrow(d), 1)
+  expect_equal(d$dateMax, '1900-02-02')
+})

tests/testthat/test-S2_query.R

@@ -116,41 +116,93 @@ test_that('S2_query_roi() works', {
   expect_true(all(data$userId == 'test@s2.boku.eodc.eu'))
 })
 
-# test_that('S2_query_granule(spatial) works', {
-#   data = S2_query_granule(
-#     cloudCovMin = 80,
-#     dateMin = '2016-06-01',
-#     dateMax = '2016-06-15',
-#     utm = '33UXP',
-#     spatial = 'sp'
-#   )
-#   expect_is(data, 'data.frame')
-#   expect_gt(nrow(data), 0)
-#   cols = c("granuleId", "productId", "product", "granule", "date", "processDate", "utm", "orbit", "cloudCov", "atmCorr", "broken", "url")
-#   expect_equal(intersect(names(data), cols), cols)
-#   expect_true(all(data$cloudCov >= 80))
-#   expect_true(all(data$date >= '2016-06-01 00:00:00.000'))
-#   expect_true(all(data$date <= '2016-06-15 23:59:59.999'))
-#   expect_true(all(data$utm == '33UXP'))
-#   expect_true(all(unlist(lapply(data$geometry, function(x){'SpatialPolygonsDataFrame' %in% class(x)}))))
-#
-#   data = S2_query_granule(
-#     cloudCovMin = 80,
-#     dateMin = '2016-06-01',
-#     dateMax = '2016-06-15',
-#     utm = '33UXP',
-#     spatial = 'sf'
-#   )
-#   expect_is(data, 'data.frame')
-#   expect_gt(nrow(data), 0)
-#   cols = c("granuleId", "productId", "product", "granule", "date", "processDate", "utm", "orbit", "cloudCov", "atmCorr", "broken", "url")
-#   expect_equal(intersect(names(data), cols), cols)
-#   expect_true(all(data$cloudCov >= 80))
-#   expect_true(all(data$date >= '2016-06-01 00:00:00.000'))
-#   expect_true(all(data$date <= '2016-06-15 23:59:59.999'))
-#   expect_true(all(data$utm == '33UXP'))
-#   expect_true(all(unlist(lapply(data$geometry, function(x){'sf' %in% class(x)}))))
-# })
+test_that('S2_query_* geometry filters work', {
+  data = S2_query_granule(
+    cloudCovMin = 80,
+    dateMin = '2016-06-01',
+    dateMax = '2016-06-15',
+    utm = '33UXP'
+  )
+
+  data2 = S2_query_granule(
+    cloudCovMin = 80,
+    dateMin = '2016-06-01',
+    dateMax = '2016-06-15',
+    geometry = c(x = 16.5, y = 48.0)
+  )
+  expect_equal(data2, data)
+
+  data2 = S2_query_granule(
+    cloudCovMin = 80,
+    dateMin = '2016-06-01',
+    dateMax = '2016-06-15',
+    geometry = '{"type": "Point", "coordinates": [16.5, 48.0]}'
+  )
+  expect_equal(data2, data)
+
+  file = tempfile(fileext = '.geojson')
+  writeLines('{"type": "Point", "coordinates": [16.5, 48.0]}', file)
+  data2 = S2_query_granule(
+    cloudCovMin = 80,
+    dateMin = '2016-06-01',
+    dateMax = '2016-06-15',
+    geometry = file
+  )
+  unlink(file)
+  expect_equal(data2, data)
+
+  data2 = S2_query_granule(
+    cloudCovMin = 80,
+    dateMin = '2016-06-01',
+    dateMax = '2016-06-15',
+    geometry = sp::SpatialPointsDataFrame(matrix(c(16.5, 48.0), ncol = 2), data.frame(id = 1), proj4string = sp::CRS('+init=epsg:4326'))
+  )
+  expect_equal(data2, data)
+
+  data2 = S2_query_granule(
+    cloudCovMin = 80,
+    dateMin = '2016-06-01',
+    dateMax = '2016-06-15',
+    geometry = sp::SpatialPointsDataFrame(matrix(c(16.5, 48.0), ncol = 2), data.frame(id = 1))
+  )
+  expect_equal(data2, data)
+})
+
+test_that('S2_query_granule(spatial) works', {
+  data = S2_query_granule(
+    cloudCovMin = 80,
+    dateMin = '2016-06-01',
+    dateMax = '2016-06-15',
+    utm = '33UXP',
+    spatial = 'sp'
+  )
+  expect_is(data, 'data.frame')
+  expect_gt(nrow(data), 0)
+  cols = c("granuleId", "productId", "product", "granule", "date", "processDate", "utm", "orbit", "cloudCov", "atmCorr", "broken", "url")
+  expect_equal(intersect(names(data), cols), cols)
+  expect_true(all(data$cloudCov >= 80))
+  expect_true(all(data$date >= '2016-06-01 00:00:00.000'))
+  expect_true(all(data$date <= '2016-06-15 23:59:59.999'))
+  expect_true(all(data$utm == '33UXP'))
+  expect_true(all(unlist(lapply(data$geometry, function(x){'SpatialPolygonsDataFrame' %in% class(x)}))))
+
+  data = S2_query_granule(
+    cloudCovMin = 80,
+    dateMin = '2016-06-01',
+    dateMax = '2016-06-15',
+    utm = '33UXP',
+    spatial = 'sf'
+  )
+  expect_is(data, 'data.frame')
+  expect_gt(nrow(data), 0)
+  cols = c("granuleId", "productId", "product", "granule", "date", "processDate", "utm", "orbit", "cloudCov", "atmCorr", "broken", "url")
+  expect_equal(intersect(names(data), cols), cols)
+  expect_true(all(data$cloudCov >= 80))
+  expect_true(all(data$date >= '2016-06-01 00:00:00.000'))
+  expect_true(all(data$date <= '2016-06-15 23:59:59.999'))
+  expect_true(all(data$utm == '33UXP'))
+  expect_true(all(unlist(lapply(data$geometry, function(x){'sf' %in% class(x)}))))
+})
 
 test_that('data frame is always returned', {
   data = S2_query_product(productId = -1)