source.coop instead of hf

Author: cboettig

DESCRIPTION

@@ -6,7 +6,7 @@ Description: A programmatic interface to 'FishBase', re-written
     supports experimental access to 'SeaLifeBase' data, which contains
     nearly 200,000 species records for all types of aquatic life not covered by
     'FishBase.'
-Version: 5.0.1
+Version: 5.0.2
 Encoding: UTF-8
 License: CC0
 Authors@R: c(person("Carl", "Boettiger",
@@ -25,18 +25,17 @@ Authors@R: c(person("Carl", "Boettiger",
 URL: https://docs.ropensci.org/rfishbase/, https://github.com/ropensci/rfishbase
 BugReports: https://github.com/ropensci/rfishbase/issues
 Depends:
-    R (>= 4.0)
+    R (>= 4.1.0)
 Imports:
     glue,
     stringr,
     purrr,
-    httr,
-    jsonlite,
     dplyr,
     duckdbfs (>= 0.0.9),
     rlang,
     magrittr,
-    memoise
+    memoise,
+    xml2
 Suggests:
     testthat,
     rmarkdown,

NEWS.md

@@ -23,6 +23,17 @@ And constructed with the following guidelines:
 
 For more information on SemVer, please visit http://semver.org/.
 
+v 5.0.2
+-------
+
+Data hosting has been migrated from HuggingFace to Source Cooperative (source.coop) 
+S3 storage. This change should resolve firewall and access issues that some users 
+experienced with HuggingFace, particularly in institutional or corporate environments. 
+The data is now served directly from AWS S3 (us-west-2.opendata.source.coop), providing
+more reliable access worldwide.
+
+Data updated to 2025-04 release as well.
+
 v 5.0.1
 -------
 Fix the issue faced by users in China who can't access the URL https://huggingface.co directly. 

R/fb_tbl.R

@@ -1,17 +1,17 @@
 #' Access a fishbase or sealifebase table
-#' 
-#' 
+#'
+#'
 #' Please note that rfishbase accesses static snapshots of the raw database
 #' tables used by FishBase and Sealifebase websites. Because these are static
 #' snapshots, they may lag behind the latest available information on the web
-#' interface, but should provide stable results.  
-#' 
+#' interface, but should provide stable results.
+#'
 #' Please also note that the website pages are not organized precisely along
 #' the lines of these tables.  A given page for a species may draw on data from
 #' multiple tables, and sometimes presents the data in a processed or summarized
 #' form.  Following RDB design, it is often
 #' necessary to join multiple tables.  Other data cleaning steps are sometimes
-#' necessary as well.  
+#' necessary as well.
 #' @param tbl table name, as it appears in the database. See [fb_tables()]
 #' for a list.
 #' @param server Access data from fishbase or sealifebase?
@@ -23,130 +23,139 @@
 #' @export
 #' @examplesIf interactive()
 #' fb_tbl("species")
-fb_tbl <- function(tbl, 
-                   server = c("fishbase", "sealifebase"), 
-                   version = "latest",
-                   db = NULL,
-                   collect = TRUE) {
+fb_tbl <- function(
+  tbl,
+  server = c("fishbase", "sealifebase"),
+  version = "latest",
+  db = NULL,
+  collect = TRUE
+) {
   urls <- fb_urls(server, version)
   names(urls) <- tbl_name(urls)
+
+  duckdbfs::duckdb_config(enable_object_cache = 'true')
   out <- duckdbfs::open_dataset(urls[tbl])
-  
-  if(collect) out <- dplyr::collect(out)
-  
-  out  
+
+  if (collect) {
+    out <- dplyr::collect(out)
+  }
+
+  out
 }
 
+
 #' List the tables available on fishbase/sealifebase
-#' 
+#'
 #' These table names can be used to access each of the corresponding tables
 #' using `[fb_tbl()]`.  Please note that following RDB design, it is often
 #' necessary to join multiple tables.  Other data cleaning steps are sometimes
-#' necessary as well.  
+#' necessary as well.
 #' @inheritParams fb_tbl
 #' @export
 #' @examplesIf interactive()
 #' fb_tables()
-fb_tables <- function(server = c("fishbase", "sealifebase"), 
-                      version = "latest") {
+fb_tables <- function(
+  server = c("fishbase", "sealifebase"),
+  version = "latest"
+) {
   fb_urls(server, version) |> tbl_name()
-  
 }
 
 #' List available releases
-#' 
+#'
 #' @param server fishbase or sealifebase
 #' @export
 #' @examplesIf interactive()
 #' available_releases()
 available_releases <- function(server = c("fishbase", "sealifebase")) {
-  
   sv <- server_code(server)
-  repo <- "datasets/cboettig/fishbase"
-  path <- glue::glue("data/{sv}")
-is_user_in_china <- function() {
-  response <- httr::GET("https://ipinfo.io")
-  if (httr::status_code(response) == 200) {
-    data <- jsonlite::fromJSON(httr::content(response, as = "text"))
-    country <- data$country
-    return(country == "CN")  
-  } else FALSE
-}
+  bucket <- "us-west-2.opendata.source.coop"
+  prefix <- glue::glue("cboettig/fishbase/{sv}/")
 
-if (is_user_in_china()) {
-  hf <- "https://hf-mirror.com"
-} else {
-  hf <- "https://huggingface.co"
-}
-  branch <- "main"
-  versions <-
-    glue::glue("{hf}/api/{repo}/tree/{branch}/{path}") |>
-    jsonlite::read_json() |> 
-    purrr::map_chr('path') |>
-    stringr::str_extract("\\/v(\\d{2}\\.\\d{2})", 1)
-  
-  versions
-  
+  # S3 List Objects API endpoint
+  s3_endpoint <- glue::glue(
+    "https://s3.us-west-2.amazonaws.com/{bucket}?list-type=2&prefix={prefix}&delimiter=/"
+  )
+
+  # Parse XML response to get common prefixes (subdirectories)
+  response <- xml2::read_xml(s3_endpoint)
+
+  # Extract version directories from CommonPrefixes
+  prefixes <- xml2::xml_find_all(
+    response,
+    ".//d1:CommonPrefixes/d1:Prefix",
+    xml2::xml_ns(response)
+  )
+  prefix_paths <- xml2::xml_text(prefixes)
+
+  # Extract version numbers (e.g., v24.07)
+  versions <- prefix_paths |>
+    stringr::str_extract("v(\\d{2}\\.\\d{2})", 1)
+
+  versions[!is.na(versions)]
 }
 
 
 get_latest_release <- function() "latest"
 
 
-hf_urls <- function(path  = "data/fb/v24.07/parquet", 
-                    repo = "datasets/cboettig/fishbase",
-                    branch = "main"
-) { 
-  
-is_user_in_china <- function() {
-  response <- httr::GET("https://ipinfo.io")
-  if (httr::status_code(response) == 200) {
-    data <- jsonlite::fromJSON(httr::content(response, as = "text"))
-    country <- data$country
-    return(country == "CN")  
-  } else FALSE
-}
+s3_urls <- function(
+  path = "cboettig/fishbase/fb/v24.07/parquet",
+  bucket = "us-west-2.opendata.source.coop"
+) {
+  # S3 List Objects API endpoint
+  s3_endpoint <- glue::glue(
+    "https://s3.us-west-2.amazonaws.com/{bucket}?list-type=2&prefix={path}/"
+  )
 
-if (is_user_in_china()) {
-  hf <- "https://hf-mirror.com"
-} else {
-  hf <- "https://huggingface.co"
-}
-  paths <-
-    glue::glue("{hf}/api/{repo}/tree/{branch}/{path}") |>
-    jsonlite::read_json() |> 
-    purrr::map_chr('path')
-  
-  glue::glue("{hf}/{repo}/resolve/{branch}/{path}", path=paths)
-}
+  # Parse XML response to get objects
+  response <- xml2::read_xml(s3_endpoint)
 
+  # Extract object keys
+  keys <- xml2::xml_find_all(
+    response,
+    ".//d1:Contents/d1:Key",
+    xml2::xml_ns(response)
+  )
+  object_keys <- xml2::xml_text(keys)
 
+  # Filter out invalid/empty parquet files (e.g., ".parquet" with no table name)
+  object_keys <- object_keys[!grepl("/\\.parquet$", object_keys)]
 
-fb_urls <- function(server = c("fishbase", "sealifebase"), 
-                    version = "latest") {
-  
+  # Build full S3 URLs
+  glue::glue(
+    "https://s3.us-west-2.amazonaws.com/{bucket}/{key}",
+    key = object_keys
+  )
+}
+
+
+fb_urls <- function(server = c("fishbase", "sealifebase"), version = "latest") {
   releases <- available_releases(server)
   if (version == "latest") {
     version <- max(releases)
   }
-  if ( !(version %in% releases) ) {
+  if (!(version %in% releases)) {
     stop(
-      glue::glue("version {version} not in ",
-                 glue::glue_collapse(
-                   glue::glue("{releases}"), ", ", last = " or "))
+      glue::glue(
+        "version {version} not in ",
+        glue::glue_collapse(
+          glue::glue("{releases}"),
+          ", ",
+          last = " or "
+        )
+      )
     )
   }
-  
+
   sv <- server_code(server)
-  path  <- glue::glue("data/{sv}/v{version}/parquet")
-  hf_urls(path)
+  path <- glue::glue("cboettig/fishbase/{sv}/v{version}/parquet")
+  s3_urls(path)
 }
 
 server_code <- function(server = c("fishbase", "sealifebase")) {
   server <- match.arg(server)
-  switch(server, 
-         "fishbase" = "fb",
-         "sealifebase" = "slb")
+  switch(server, "fishbase" = "fb", "sealifebase" = "slb")
 }