How to pass the progress from API call to waiter

Question

I would like to capture the progress of the API call and update the waiter. This does not display progress on the UI end. not sure why. If I remove the If, just have a for loop, the API calls completes and then the for loop executes,then I can see the waiter progressing from 0 to 100%. Is it because UI is holding up while while a server-side operation is running?

library(shiny)
library(waiter)
library(promises)
library(future)

foo <- function() {
     # Simulte a slow download
    cap_speed <- httr::config(max_recv_speed_large = 10000)
    x <- httr::GET("http://httpbin.org/bytes/102400", httr::progress(con = stderr()), cap_speed)
 }

ui <- fluidPage(
  useWaiter(),
  useHostess(),
  waiterShowOnLoad(
    color = "#f7fff7",
    hostess_loader(
      "loader", 
      preset = "circle", 
      text_color = "black",
      class = "label-center",
      center_page = TRUE
    )
  )
)

server <- function(input, output){
  hostess <- Hostess$new("loader")
  
  f <- future({ foo() })  # Create the future

  for(i in 1:10){
    if(future::resolved(f)) {
      hostess$set(100)
      waiter_hide()
      break
    } else {
      hostess$set(i * 10)
    }
  }  
}
 

shinyApp(ui, server)

Answer 1

Here is a way using the httr package to do the request and the future package. However I get a problem: when I close the app, it doesn't stop (then I have to restart the R session) (see the comment).

library(shiny)
library(waiter)
library(future)
plan(multisession) # important
library(httr)

foo <- function() {
  # Simulte a slow download
  cap_speed <- httr::config(max_recv_speed_large = 10000)
  GET("http://httpbin.org/bytes/102400", cap_speed)
}

ui <- fluidPage(
  useWaiter(),
  useHostess(),
  waiterShowOnLoad(
    color = "#f7fff7",
    hostess_loader(
      "loader", 
      preset = "circle", 
      text_color = "black",
      class = "label-center",
      center_page = TRUE
    )
  )
)

server <- function(input, output){
  hostess <- Hostess$new("loader")
  
  f <- future({ foo() })  # Create the future
  
  i <- 0
  while(!resolved(f)) {
    i <- i + 1
    hostess$set(min(99, 10 * i)) # the spinner disappears when 100 is attained
  }
  hostess$close()
  print("done") # do not close the app before
  
}

shinyApp(ui, server)

Answer 2

Here is how to perform a download in JavaScript with a progress bar.

File xhr.js, to put in the www subfolder of the app:

Shiny.addCustomMessageHandler("xhr", function (x) {
  
  // 1. Create a new XMLHttpRequest object
  let xhr = new XMLHttpRequest();

  // 2. Configure it: GET-request for the URL
  let url = "https://raw.githubusercontent.com/stla/bigjson/main/bigjson.json";
  xhr.open("GET", url);

  // 3. Send the request over the network
  xhr.send();

  // 4. This will be called after the response is received
  let response; // variable to store the downloaded file
  xhr.onload = function () {
    if (xhr.status != 200) {
      // analyze HTTP status of the response
      alert(`Error ${xhr.status}: ${xhr.statusText}`); // e.g. 404: Not Found
    } else {
      // show the result in the console
      console.log(`Done, got ${xhr.response.length} bytes`); // response is the server response
      // store the response 
      // we don't send the response to Shiny here because it would block the progress bar
      response = xhr.response;
    }
  };

  let i = 1000; // this is used to slow down the communication with Shiny
  let totalSize = 100293197; // the size of the downloaded file
  let nsteps = 5; // number of steps for the progress bar
  let threshold = 1 / nsteps;
  xhr.onprogress = function (event) {
    if (event.lengthComputable) { // if available, totalSize is not needed
                                  // because it is given in event.total
      let ratio = event.loaded / event.total;
      if (ratio >= threshold) {
        setTimeout(function () {
          Shiny.setInputValue("received", ratio);
          if (ratio === 1) { // send response to Shiny
            Shiny.setInputValue("download", response);
          }
        }, i);
        threshold += 1 / nsteps;
      }
    } else { // event.total is not available
      let ratio = event.loaded / totalSize;
      if (ratio >= threshold) {
        setTimeout(function () {
          Shiny.setInputValue("received", ratio);
          if (ratio === 1) { // send response to Shiny
            Shiny.setInputValue("download", response);
          }
        }, i);
        threshold += 1 / nsteps;
      }
    }
    i += 1000;
  };

  xhr.onerror = function () {
    alert("Request failed");
  };
  
});

Here I download a file hosted on Github (bigjson.json, approx 100Mb). The lengthComputable of the onprogress event is false; that means that this event does not provide the total size of the download, and then we have to enter it manually.

This event progressively provides the downloaded size. Since this is fast, I slow down with the help of setTimeout.

App:

library(shiny)

ui <- fluidPage(
  tags$head(tags$script(src = "xhr.js")),
  br(),
  actionButton("go", "Go"),
  br(),
  tags$h2("Response will appear here:"),
  verbatimTextOutput("response")
)

server <- function(input, output, session) {

  # progress bar
  progress <- NULL
  
  observeEvent(input$go, {
    progress <<- Progress$new(session, min = 0, max = 1)
    progress$set(message = "Download in progress")
    # trigger the download in JavaScript
    session$sendCustomMessage("xhr", TRUE)
  })
  
  # input$received contains the ratio of the download in progress
  observeEvent(input$received, {
    progress$set(value = input$received)
    if(input$received == 1) {
      progress$close()
    }
  })
  
  # input$download contains the downloaded file (here a JSON string)
  output$response <- renderPrint({
    req(input$download)
    substr(input$download, 1, 100)
  })

}

shinyApp(ui, server)