extend check_cont to include no dockerhub registries

DESCRIPTION

@@ -58,7 +58,8 @@ Suggests:
     BiocStyle,
     BiocPkgTools,
     biocViews,
-    reticulate
+    reticulate,
+    rvest
 VignetteBuilder: knitr
 License: GPL-3
 Config/testthat/edition: 3

R/check_cont.R

@@ -3,42 +3,34 @@
 #' Check that a list of containers are valid.
 #' @inheritParams construct_runners
 #' @param domain Container repository API domain.
-#' @returns NUll
+#' @returns Null
 #' 
-#' @keywords internal
-check_cont <- function(cont,
-                       domain = "https://hub.docker.com/v2/repositories/",
+#' @keywords internal 
+check_cont <- function(cont, 
                        verbose = TRUE){
+  # devoptera::args2vars(check_cont)
+  # cont <- list("ghcr.io/bioconductor/bioconductor_docker:devel" )
 
-  requireNamespace("jsonlite")
+  n_parts <- check_cont_general(cont)
   for(co in cont){
     if(is.null(co)) next()
-    if(isFALSE(grepl("/",co))){
-      stopper("Container must be specificied in the following format:",
-              "'owner/repo:tag'")
-    } 
-    splt <- strsplit(co,":")[[1]]
-    URL <- paste(domain, splt[1],
-                 "tags?page_size=1000",sep="/"
-    ) 
-    #### Check repo exists ####
-    messager("Checking public container repository exists:",shQuote(splt[1]),
-             v=verbose)
-    js <- tryCatch({
-      jsonlite::read_json(URL)
-    }, error=function(e){
-      stopper("Unable to find public container:",co)
-    }
-    ) 
-    #### Check tag exists #### 
-    if(length(splt)==2){
-      messager("Checking tag exists:",shQuote(splt[2]),
-               v=verbose) 
-      tags <- sapply(js$results ,function(x){x$name}) 
-      if(!splt[2] %in% tags){
-        stopper("The tag", shQuote(splt[2]),
-                "does not exist in the repo",shQuote(splt[1]))
-      }
+    #### Check container ####
+    if(grepl("ghcr.io",co)){
+      check_cont_ghcr(cont = co,
+                      verbose = verbose)
+    } else if(grepl("docker.io",cont)){
+      check_cont_dockerhub(cont = co,
+                           verbose = verbose)
+    } else if(n_parts==2){
+      messager("Assuming container is on DockerHub.",v=verbose)
+      check_cont_dockerhub(cont = co,
+                           verbose = verbose)
+    } else {
+      warning(paste(
+        "Unable to check registry for container",co,
+        "Skipping check."
+      ))
     }
   }
+
 }

R/check_cont_dockerhub.R

@@ -0,0 +1,27 @@
+check_cont_dockerhub <- function(cont,
+                                 domain = 
+                                   "https://hub.docker.com/v2/repositories/",
+                                 verbose = TRUE){
+  requireNamespace("jsonlite")
+  for(co in cont){
+    if(is.null(co)) next()
+    co <- gsub("docker\\.io/","",co) 
+    splt <- strsplit(co,":")[[1]]
+    URL <- paste(domain, splt[1],
+                 "tags?page_size=1000",sep="/"
+    ) 
+    #### Check repo exists ####
+    messager("Checking public container repository exists:",shQuote(splt[1]),
+             v=verbose)
+    js <- tryCatch({
+      jsonlite::read_json(URL)
+    }, error=function(e){
+      stopper("Unable to find public container:",co)
+    }) 
+    #### Check tag exists #### 
+    tags <- sapply(js$results ,function(x){x$name}) 
+    check_tags(tags = tags, 
+               splt = splt,
+               verbose = verbose)
+  }
+}

R/check_cont_general.R

@@ -0,0 +1,11 @@
+check_cont_general <- function(cont){
+  lapply(cont, function(co){
+    if(is.null(co)) return(NULL)
+    if(!grepl("/",co)){
+      stopper("Container must be specified in the following format:",
+              "'registry/owner/repo:tag'")
+    } 
+    n_parts <- length(strsplit(gsub("[/]+","/",co),"/")[[1]])
+    return(n_parts)
+  }) 
+}

R/check_cont_ghcr.R

@@ -0,0 +1,40 @@
+check_cont_ghcr <- function(cont,
+                            verbose = TRUE){
+  requireNamespace("rvest")
+
+  for(co in cont){
+    if(is.null(co)) next()
+    # co <- "ghcr.io/bioconductor/bioconductor_docker:devel" 
+    co_notag <- gsub("ghcr.io/","",strsplit(co,":")[[1]][1])
+    ##### Only works if you have permissions to the repo #####
+    # get_ghcr_tags <- function(container) {
+    #   url <- paste0("https://ghcr.io/v2/", container, "/tags/list")
+    #   response <- jsonlite::fromJSON(url)
+    #   tags <- response$tags
+    #   return(tags)
+    # }
+    # tags <- get_ghcr_tags("bioconductor/bioconductor_docker")
+    #
+    URL <- paste0(
+      "https://github.com/",
+      co_notag,
+      "/pkgs/container/",basename(co_notag),
+      "/versions?filters%5Bversion_type%5D=tagged"
+    )
+    #### Check if container exists ####
+    x <- tryCatch({
+      rvest::read_html(URL)
+    }, error=function(e){
+      stopper("Unable to find public container:",co)}
+    )
+    #### Check if container has tags ####
+    tags <- x |> rvest::html_nodes(".Label") |> rvest::html_text()
+    if(length(tags)==0){
+      stopper("Unable to find tags for container:",co)
+    } else {
+      check_tags(tags = tags, 
+                 splt = strsplit(co,":")[[1]][1],
+                 verbose = verbose)
+    }
+  } 
+}

R/check_tags.R

@@ -0,0 +1,12 @@
+check_tags <- function(splt,
+                       tags,
+                       verbose=TRUE){
+  if(length(splt)==2){
+    messager("Checking tag exists:",shQuote(splt[2]),
+             v=verbose) 
+    if(!splt[2] %in% tags){
+      stopper("The tag", shQuote(splt[2]),
+              "does not exist in the repo",shQuote(splt[1]))
+    }
+  }
+}

R/construct_cont.R

@@ -7,6 +7,7 @@
 #' \itemize{
 #'  \item{"ghcr.io/" : }{\href{https://docs.github.com/en/packages/working-with-a-github-packages-registry/working-with-the-container-registry}{GitHub Container Registry}}
 #'  \item{"docker.io/" : }{\href{https://hub.docker.com/}{DockerHub}}
+#'  \item{"mcr.microsoft.com/" : }{\href{https://github.com/microsoft/ContainerRegistry}{Microsoft Container Registry}}
 #' }
 #' @param default_cont The DockerHub container to default to.
 #' Used when it's detected that only the tag has been given in one or more 
@@ -20,7 +21,8 @@
 #' @examples
 #' cont <- construct_cont() 
 construct_cont <- function(default_registry = c("ghcr.io/",
-                                                "docker.io/"),
+                                                "docker.io/",
+                                                "mcr.microsoft.com/"),
                            default_cont = "bioconductor/bioconductor_docker",
                            default_tag = "devel",
                            cont = list(

tests/testthat/test-check_cont.R

@@ -17,4 +17,16 @@ test_that("check_cont works", {
   testthat::expect_error(
     check_cont(cont = "typooooo")
   )
+
+  #### Include registry ####
+  testthat::expect_no_warning(
+    check_cont(cont = "ghcr.io/bioconductor/bioconductor_docker")
+  )
+
+  testthat::expect_no_warning(
+    check_cont(cont = "docker.io/bioconductor/bioconductor_docker:devel")
+  )
+  testthat::expect_warning(
+    check_cont(cont = "mcr.microsoft.com/bioconductor/bioconductor_docker:devel")
+  )
 })

tests/testthat/test-construct_cont.R

@@ -1,12 +1,16 @@
 test_that("construct_cont works", {
 
   cont1 <- construct_cont() 
-  testthat::expect_equal(cont1[[1]],  "bioconductor/bioconductor_docker:devel")
+  default_registry <- eval(formals(construct_cont)$default_registry)[1]
+  default_tag <- eval(formals(construct_cont)$default_tag)[1]
+  testthat::expect_equal(cont1[[1]],  
+                         paste0(opts,"bioconductor/bioconductor_docker:",default_tag))
   testthat::expect_null(cont1[[2]])
   testthat::expect_null(cont1[[3]])
 
   cont2 <- construct_cont(cont = "devel") 
-  testthat::expect_equal(cont2[[1]],  "bioconductor/bioconductor_docker:devel") 
+  testthat::expect_equal(cont2[[1]],  
+                         paste0(opts,"bioconductor/bioconductor_docker:",default_tag))
 
   cont3 <- construct_cont(versions_explicit = TRUE) 
   testthat::expect_true(grepl("bioconductor/bioconductor_docker:RELEASE_*",
@@ -16,7 +20,7 @@ test_that("construct_cont works", {
 
   cont4 <- construct_cont(default_tag = "release", 
                           run_check_cont = TRUE) 
-  testthat::expect_equal(cont4[[1]],  "bioconductor/bioconductor_docker:latest")
+  testthat::expect_equal(cont4[[1]], paste0(opts,"bioconductor/bioconductor_docker:latest"))
   testthat::expect_null(cont4[[2]])
   testthat::expect_null(cont4[[3]])
 })