Adaptation pour nouvelle version serveur WS Constellation

DESCRIPTION

@@ -20,10 +20,11 @@ Imports:
     processx,
     dplyr,
     tibble,
+    httr2,
 Language: fr
 Encoding: UTF-8
 LazyData: true  
 Suggests: 
     testthat (>= 3.0.0)
 Config/testthat/edition: 3
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2

NAMESPACE

@@ -8,3 +8,4 @@ import(jsonlite)
 import(processx)
 import(dplyr)
 import(tibble)
+import(httr2)

R/client.R

@@ -48,19 +48,31 @@ Client <- R6Class(
   public = list(
     #'
     #' @param port Le numéro du port local sur lequel le serveur est ouvert, et auquel le client se connectera.
+    #' @param codeSecret Le code secret pour pouvoir se connecter au serveur.
     #'
     initialize = function(
-      port
+      port,
+      codeSecret=NULL
     ) {
       Sys.sleep(2)
-      private$ws <- websocket::WebSocket$new(paste("ws://localhost:", as.character(port), sep=""), autoConnect = FALSE)
+
+      if (is.null(codeSecret)) {
+        requèteCode <- httr2::request(paste("http://localhost/demande?id=Client R ", as.character(sample(1000:9999, 1)[1]), as.character(port), sep=""))
+        réponse <- httr2::req_perform(requèteCode)
+        codeSecret <- httr2::resp_body_string(réponse)
+      }
+      urlWs <- paste("ws://localhost:", as.character(port), "?code=", utils::URLencode(codeSecret), sep="")
+      print(urlWs)
+      private$ws <- websocket::WebSocket$new(urlWs, autoConnect = FALSE)
 
       ouvert <- FALSE
       private$ws$onOpen(function(event) {
+        print("ws ouverte")
         ouvert <<- TRUE
       })
 
       private$ws$onMessage(function(event) {
+        print(event$data)
         m <- jsonlite::fromJSON(event$data, simplifyDataFrame = FALSE)
         écouteur <- private$écouteurs[[m$id]]
         if (is.null(écouteur)) {
@@ -126,7 +138,9 @@ Client <- R6Class(
       })
 
       Sys.sleep(1)
+      print("on va connecter")
       private$ws$connect()
+      print("on est connecté")
       Sys.sleep(2)
 
       retry::wait_until(isTRUE(ouvert), timeout = 30)
@@ -400,10 +414,11 @@ Client <- R6Class(
 
 avecClientEtServeur <- function(code, ...) {
   résultat <- avecServeur(
-    function(port) {
+    function(port, codeSecret) {
       résultatClient <- avecClient(
         code,
-        port
+        port,
+        codeSecret
       )
 
       return(résultatClient)
@@ -420,12 +435,13 @@ avecClientEtServeur <- function(code, ...) {
 #'
 #' @param code Le code à exécuter. Ce code doit être une fonction qui prend le `client` Constellation comme unique paramètre.
 #' @param port Le port du serveur déjà ouvert.
+#' @param codeSecret Le code secret pour se connecter au serveur.
 #'
 #' @return Le résultat de la fonction `code`.
 #' @export
 
-avecClient <- function(code, port) {
-  client <- Client$new(port)
+avecClient <- function(code, port, codeSecret) {
+  client <- Client$new(port, codeSecret)
   résultatClient <- tryCatch(
     {
       code(client)

R/serveur.R

@@ -12,26 +12,13 @@ obtVersionServeur <- function(exe = "constl") {
   return(version)
 }
 
-#' Obtenir la version installée de l'IPA Constellation
-#'
-#' @param exe La commande pour lancer Constellation. Uniquement nécessaire pour une installation de Constellation non standard
-#'
-#' @return La version de l'IPA Constellation
-#' @export
-#'
-
-obtVersionIPAConstellation <- function(exe = "constl") {
-  version <- system2(exe, c("v-constl"), stdout = TRUE)
-  return(version)
-}
-
 #' Installer Constellation sur votre système. Nécessite Node.js (https://nodejs.org/fr) et pnpm (https://pnpm.io/)
 #'
 #' @return Rien
 #' @export
 
 installerConstellation <- function() {
-  system2("pnpm", c("i", "--global", "@constl/ipa", "@constl/serveur"), stdout = TRUE)
+  system2("curl", c("https://raw.githubusercontent.com/reseau-constellation/serveur-ws/principale/installer.cjs", "|", "node", "-"), stdout = TRUE)
 }
 
 #' Lancer un serveur Constellation local
@@ -69,6 +56,7 @@ lancerServeur <- function(port=NULL, dossier = NULL, exe = "constl") {
     p$poll_io(5000)
 
     résultat <- p$read_output_lines()
+
     if (!length(résultat)) {break}
 
     for (l in length(résultat)) {
@@ -81,22 +69,24 @@ lancerServeur <- function(port=NULL, dossier = NULL, exe = "constl") {
 
         if (messageMachine$type == "NŒUD PRÊT") {
           portFinal <- as.numeric(messageMachine$port)
+          codeSecret <- messageMachine$codeSecret
           break
         }
       }
     }
   }
 
-  if (is.null(portFinal)) {
+  if (is.null(portFinal) || is.null(codeSecret)) {
     stop("Serveur mal initialisé.")
   }
+
   fermer <- function() {
-    p$write_input("\n", sep = "\n")
+    p$write_input("\n", sep="\n")
     p$wait(2)
     p$kill()
   }
 
-  return(list(port=portFinal, fermer=fermer))
+  return(list(port=portFinal, codeSecret=codeSecret, fermer=fermer))
 }
 
 #' Exécuter du code dans le contexte d'un serveur Constellation, et fermer le serveur par la suite.
@@ -111,7 +101,7 @@ avecServeur <- function(code, ...) {
   serveur <- lancerServeur(...)
   résultat <- tryCatch(
     {
-      code(serveur$port)
+      code(serveur$port, serveur$codeSecret)
     },
     error = function(cond) {
       message(cond)

README.md

@@ -78,7 +78,7 @@ constellationR::avecClientEtServeur(
 )
 ```
 
-C'est là même chose pour les fonctions de recherche :
+C'est la même chose pour les fonctions de recherche :
 
 ``` r
 library(constellationR)
@@ -132,12 +132,14 @@ library(constellationR)
 
 // Le numéro du port sur lequel vous avez lancé Constellation
 port <- 5003
+codeSecret <- "le code secret que le serveur vous a donnée afin de vous connecter"
 
 constellationR::avecClient(
   function(client) {
     // Faire quelque chose avec le client...
   },
-  port = port
+  port = port,
+  codeSecret = codeSecret
 )
 
 ```

tests/testthat/test-client.R

@@ -4,7 +4,6 @@ avecClientEtServeurTest <- function(code) {
 
   # Effacer le dossier temporaire une fois qu'on a fini
   on.exit(unlink(dossier, recursive = TRUE), add = TRUE)
-
   résultat <- constellationR::avecClientEtServeur(
     code,
     dossier = dossier,
@@ -15,7 +14,6 @@ avecClientEtServeurTest <- function(code) {
 
 avecClientEtServeurTest(
   function (client) {
-
     testthat::test_that("Actions", {
       idCompte <- client$action("obtIdCompte")
       testthat::expect_equal(class(idCompte), "character")
@@ -221,3 +219,4 @@ avecClientEtServeurTest(
     })
   }
 )
+

tests/testthat/test-serveur.R

@@ -23,23 +23,18 @@ testthat::test_that("obtenir version serveur", {
   expect_equal(length(strsplit(version, "\\.")[[1]]), 3)
 })
 
-testthat::test_that("obtenir version ipa", {
-  version <- constellationR::obtVersionIPAConstellation()
-  expect_equal(length(strsplit(version, "\\.")[[1]]), 3)
-})
-
-
 testthat::test_that("lancer serveur", {
   avecServeurTest(
-    function(port) {
+    function(port, codeSecret) {
       expect_equal(class(port), "numeric")
+      expect_equal(class(codeSecret), "character")
     }
   )
 })
 
 testthat::test_that("lancer serveur port spécifié", {
   avecServeurTest(
-    function(port) {
+    function(port, codeSecret) {
       expect_equal(port, 5123)
     },
     port=5123
@@ -49,8 +44,12 @@ testthat::test_that("lancer serveur port spécifié", {
 testthat::test_that("lancer serveur dossier Constellation spécifié", {
   dossier <- file.path(tempdir(), "monDossierConstellation")
   avecServeurTest(
-    function (port) {
-      testthat::expect_true(dir.exists(dossier))
+    function (port, codeSecret) {
+      retry::wait_until(
+        dir.exists(dossier),
+        timeout = 5
+     )
+     testthat::expect_true(dir.exists(dossier))
     },
     dossier = dossier
   )