Example script to deploy a Shiny app

This example R script takes your Shiny code from a local directory, stores it as a Shiny App asset in the deployment space, and starts the corresponding app deployment.

#
# Create a Shiny App asset and Deploy
#
# This R script takes your Shiny code from a local directory,
# stores it as a "Shiny App" asset in the deployment space,
# and launches the corresponding app deployment.
#
# The script adds a Shiny asset and a new deployment to the deployment space.
# You have to delete the objects manually when they are not needed anymore.
#
# The implementation calls the CP4D RESTful API. No other library is needed.


# This sample code is provided "as is", without warranty of any kind.


# Set your configuration:
# The code for the Shiny app is assumed to be in the working directory.
# setwd("~/MyAppName")
APP_NAME="MyAppName"       # Name to be used for the new app
SPACE_NAME="Shiny"         # Your existing Deployment Space
URL_HOST = Sys.getenv("RUNTIME_ENV_APSX_URL")   # URL of your CP4D server


################################

library(httr)


# little utility function to check httr result codes

httr_check <- function(label,r,rc){
  print(label)
  if(r$status_code>rc) {
    print(c(label,"Error",r$status_code))
    print(httr::content(r))
  }
  stopifnot(r$status_code<=rc)
  print("ok")
}


# GET /v2/spaces?name={SPACE_NAME}
url <- paste0(Sys.getenv("RUNTIME_ENV_APSX_URL"),"/v2/spaces?name=",SPACE_NAME)
r <- GET(url,add_headers(Authorization = paste("Bearer",Sys.getenv("USER_ACCESS_TOKEN"))))
httr_check("get space",r,200)
rjson = httr::content(r, type = 'application/json', simplifyDataFrame = TRUE)
SPACE_ID = rjson$resources$metadata$id



# Upload Shiny app as zip file
#
# cpdcurl PUT "/v2/asset_files/shiny_asset/MyAppName.zip?space_id=$SPACE_ID"
#      -F file=@MyAppName.zip
#
app_zip = paste0("/tmp/",APP_NAME,".zip")
system2("zip",args=c("-FSr",app_zip,"."), stdout = TRUE, stderr = TRUE)
# set unique name for uploaded file, by using  epoch seconds
uploaded_app_zip = paste0(APP_NAME,as.numeric(Sys.time()),".zip")
url <- paste0(URL_HOST,"/v2/asset_files/shiny_asset/",uploaded_app_zip,"?space_id=",SPACE_ID)
print(url)
# attribute name in body must be 'file'
r <- PUT(url, body=list(file=upload_file(path=app_zip, type="application/zip")),
         add_headers(Authorization = paste("Bearer",Sys.getenv("USER_ACCESS_TOKEN"))))
httr_check("Upload",r,201)
print(httr::content(r))


# Get software spec for R4.2 in CP4D >= v4.6
#
# cpdcurl GET "/v2/software_specifications?name=rstudio_r4.2"
url <- paste0(Sys.getenv("RUNTIME_ENV_APSX_URL"),"/v2/software_specifications?name=rstudio_r4.2")
r <- GET(url,add_headers(Authorization = paste("Bearer",Sys.getenv("USER_ACCESS_TOKEN"))))
httr_check("software spec",r,200)
rjson = httr::content(r, type = 'application/json', simplifyDataFrame = TRUE)
swspec_id = rjson$resources$metadata$asset_id  # might be NULL when rstudio_r4.2 is not avail
if (!is.null(swspec_id)) print(c("rstudio_r4.2",swspec_id))


# Create Asset
url <- paste0(Sys.getenv("RUNTIME_ENV_APSX_URL"),"/v2/assets?space_id=",SPACE_ID)
body <- list(
  metadata = list( name = APP_NAME, asset_type = "shiny_asset", origin_country = "de" ),
  entity = list( ),
  attachments = list( list(asset_type="shiny_asset",mime="application/zip",object_key=paste0("shiny_asset/",uploaded_app_zip)))
)
if (!is.null(swspec_id)) {
  body["entity"] <- list(entity = list( shiny_asset = list( software_spec = list(base_id=swspec_id)) ))
}
#print(body)
r <- POST(url, body = body, encode = "json",
          add_headers(Authorization = paste("Bearer",Sys.getenv("USER_ACCESS_TOKEN")))
)
httr_check("Asset",r,201)
rjson = httr::content(r, type = 'application/json', simplifyDataFrame = TRUE)
print(rjson$metadata$asset_id)
ASSET_ID = rjson$metadata$asset_id


print("Check access to WML server and space")
#
url <- paste0(URL_HOST,"/ml/v4/deployments?type=r_shiny&limit=1&version=2023-04-01&space_id=",SPACE_ID)
print(url)
r <- GET(url,add_headers(Authorization = paste("Bearer",Sys.getenv("USER_ACCESS_TOKEN"))))
httr_check("WML server",r,200)


print("Create deployment")
url <- paste0(URL_HOST,"/ml/v4/deployments?version=2023-04-01&space_id=",SPACE_ID)

body <- list(
  name = "my deployment name",
  space_id = SPACE_ID,
  asset = list( id = ASSET_ID ),
  r_shiny = list(
    # parameters = list( serving_name="myapp_serving_name123" ),
    # parameters = list( auto_mount = FALSE ),   # default is TRUE
    # parameters = list( mounts = list( "/mnts/customlogs" ) ),
    authentication = "members_of_deployment_space"
  ),
  hardware_spec =  list( name = "XXS" )
)
# Authentication, Allowable values: [anyone_with_url,any_valid_user,members_of_deployment_space]

r <- POST(url, body = body, encode = "json",
          add_headers(Authorization = paste("Bearer",Sys.getenv("USER_ACCESS_TOKEN")))
)
httr_check("Deploy",r,202)
rjson = httr::content(r, type = 'application/json', simplifyDataFrame = TRUE)
print(rjson$entity$status)   # "initializing"

deployment_id = rjson$entity$asset$id

# WML API
# DELETE /ml/v4/deployments/{deployment_id}

Parent topic: Deploying Shiny apps in Watson Machine Learning