five_safes_mapping.R

# The plan here is to map as much of the information we can get from opal and
# DataSHIELD to the five safes framework.

################################################################################
# Create RO-Crate ----
################################################################################
## Setup ----
# install.packages("pak")
pak::pkg_install("ResearchObject/ro-crate-r@dev")
pak::pkg_install("datashield/dsBaseClient@v6.3.5-dev")

## Global variables
USERNAME <- "demo_user"
USERPASS <- "Demo_password1!"
PROJECT <- "DEMO"
TABLES <- c("CNSIM1")
SERVER <- "https://localhost:8843" # "https://opal-demo.obiba.org"
PROFILE <- "demo"

# Create base RO-Crate with 5 Safes profile
dsROCrate <- rocrateR::rocrate_5s()

# To start us off we will use the opal demo server, with `USERNAME` and `PROJECT`.
o <- opalr::opal.login(
  username = "administrator",
  password = "password",
  url = SERVER#, profile = PROFILE
)

################################################################################
# Safe people ----
################################################################################

# Only administrator users can run this
opalr::oadmin.user_profiles(o)

opalr::dsadmin.perm(o)
opalr::opal.perms(o, USERNAME)

# create entities for users
safe_people_entities <- opalr::oadmin.users(o) |>
  tibble::as_tibble() |>
  dplyr::filter(enabled) |>
  purrr::pmap(function(name, ...) {
    rocrateR::entity(
      x = digest::digest(name),
      type = "Person",
      name = name
    )
  })

# add user to RO-Crate
## find index for the entity of the current user, `USERNAME`
idx <- sapply(safe_people_entities, "[[", "name") == USERNAME

## add user
dsROCrate <- dsROCrate |>
  rocrateR::add_entity(safe_people_entities[idx][[1]], overwrite = TRUE) |>
  rocrateR::add_entity_value("./", "author", getElement(safe_people_entities[idx][[1]], "@id"))

print(dsROCrate)

################################################################################
# Safe data ----
################################################################################

# Table names, update times etc.
project_tbl <- opalr::opal.project(o, PROJECT)
project_tbl

opalr::opal.tables(o, PROJECT)
# inspect table access rights
TABLES |>
  purrr::walk(function(t) {
    message("Table: ", t)
    opalr::opal.table_perm(o, PROJECT, t) |>
      glue::glue_data("[{type}] {subject} \t|\t Permissions: {permission}\n\n") |>
      message()
  })

# Retrieve all projects and add entities to the `dsROCrate` object
opalr::opal.projects(o) |>
  tibble::as_tibble() |>
  dplyr::filter(name == PROJECT) |> # filter specific project, set by PROJECT
  purrr::pwalk(function(name, tittle, created, lastUpdate, ...) {
    # Table names, update times etc.
    project_details_tbl <- opalr::opal.project(o, name)
    project_tables <- tryCatch({
      project_details_tbl |>
        purrr::pluck("datasource") |>
        purrr::pluck("table") |>
        purrr::list_c()
    }, error = function(e) {
      list()
    })
    
    # add table entities to the `dsROCrate` object
    project_details_entities <- tibble::tibble(
      datasource = name,
      table = project_tables
    ) |>
      dplyr::filter(table %in% TABLES) |> # filter specific tables, set by TABLES
      purrr::pmap(function(datasource, table) {
        table_details <- opalr::opal.table(o, datasource, table)
        timestamps <- getElement(table_details, "timestamps")
        new_dataset_entity <- rocrateR::entity(
          x = digest::digest(paste0(datasource, "_", table)),
          type = "Dataset",
          dateCreated = getElement(timestamps, "created"),
          dateModified = getElement(timestamps, "lastUpdate"),
          path = getElement(table_details, "link")
        )

        # add new dataset entity to the RO-Crate
        dsROCrate <<- dsROCrate |>
          rocrateR::add_entity(new_dataset_entity, overwrite = TRUE)

        return(new_dataset_entity)
      })

    project_entity <- rocrateR::entity(
      x = digest::digest(name),
      type = "Project",
      name = name,
      dateCreated = created,
      dateModified = lastUpdate,
      hasPart = project_details_entities |>
        sapply("[[", "@id") |>
        lapply(function(id) {
          list(`@id` = id)
        })
    )

    # if no tables are associated to this project, then drop `hasPart`
    if (length(project_details_entities) == 0) {
      project_entity$hasPart <- NULL
    }

    # add new project entity to the RO-Crate
    dsROCrate <<- dsROCrate |>
      rocrateR::add_entity(project_entity, overwrite = TRUE)
  }, .progress = TRUE)

print(dsROCrate)

################################################################################
# Safe setting ----
# There is a lot of information here. Could just have e.g. list of package names
# instead of full descriptions etc.
################################################################################

# Disclosure settings
opalr::dsadmin.activity(o)
opalr::dsadmin.get_options(o) # must login as administrator user

## Add DataSHIELD options as part of the Safe setting
'
{ 
  "@id": "_:localid:tre72:project81",
  "@type": "PropertyValue",
  "name": "tre72",
  "value": "project81"
}
'
disc_setting_entities <- opalr::dsadmin.get_options(o) |>
  tibble::as_tibble() |>
  purrr::pmap(function(name, value, ...) {
    rocrateR::entity(
      x = paste0("_:localid:", name, ":", value),
      type = "PropertyValue",
      name = name,
      value = value
    )
  })


# Installed packages
opalr::dsadmin.package_descriptions(o) |>
  tibble::as_tibble() |>
  purrr::pwalk(function(Package, Version, Description, Author, ...) {
    author_entities <- Author |>
      stringr::str_split(pattern = ",\\n", simplify = TRUE) |>
      purrr::map(function(str) {
        # check if current author is a physical person (has aut or cre roles)
        is_person <- stringr::str_detect(str, "\\[.*(aut|cre).*\\]")
        if(!is_person)
          return(NULL)
        # create tibble with author name and ORCiD (if available)
        tibble::tibble(
          author = str |>
            stringr::str_extract("(.*)(?= \\[aut)") |>
            stringr::str_squish(),
          orcid = str |>
            stringr::str_extract("(?<=https:\\/\\/orcid.org\\/)(.*)(?=>)")
        )
      }) |>
      purrr::list_c() |>
      purrr::pmap(function(author, orcid) {
        author_entity <- rocrateR::entity(
          x = ifelse(is.na(orcid) | nchar(orcid) == 0, digest::digest(author),
                     paste0("https://orcid.org/", orcid)),
          type = "Person",
          name = author
        )

        # # add author entity to the RO-Crate
        # dsROCrate <<- dsROCrate |>
        #   rocrateR::add_entity(author_entity, overwrite = TRUE)

        return(author_entity)
      })

    package_entity <- rocrateR::entity(
      x = digest::digest(paste0(Package, "_", Version)),
      type = "SoftwareApplication",
      name = Package,
      version = Version,
      description = Description,
      # author = author_entities |>
      #   sapply("[[", "@id") |>
      #   lapply(function(id) {
      #     list(`@id` = id)
      #   })
    )

    # if no authors are associated to this package, then drop `author`
    if (length(author_entities) == 0) {
      package_entity$author <- NULL
    }

    # add new package entity to the RO-Crate
    dsROCrate <<- dsROCrate |>
      rocrateR::add_entity(package_entity, overwrite = TRUE)
  })

print(dsROCrate)

# Methods
opalr::dsadmin.get_methods(o, type = "aggregate")
opalr::dsadmin.get_methods(o, type = "assign")

# Available profiles
opalr::dsadmin.profiles(o)
opalr::dsadmin.profile_perm(o, "default")

# Opal installed packages
opalr::oadmin.installed_packages(o) |>
  tibble::as_tibble()

# Opal version
opalr::opal.get(o, 'system', 'version')

opalr::dsadmin.get_methods(o, type = "aggregate", profile = PROFILE) |>
  tibble::as_tibble()

# add custom method
opalr::dsadmin.set_method(o, "hello", func = function(x) { paste0("Hello ", x, "!") }, type = "aggregate")#, profile = PROFILE)
# verify custom method
opalr::dsadmin.get_method(o, "hello", type = "aggregate")#, profile = PROFILE)
opalr::dsadmin.profile_enable(o, PROFILE, enabled = TRUE)
opalr::dsadmin.profiles(o)

# library(DSOpal)
# DSOpal::Opal()
builder <- DSI::newDSLoginBuilder()
builder$append(server = "study1",  
               url = SERVER, # "https://opal-demo.obiba.org",
               user = "administrator", 
               password = "password",
               driver = "OpalDriver") #, profile = PROFILE)
logindata <- builder$build()
conns <- DSI::datashield.login(logins = logindata)
# call the hello() function on the R server
DSI::datashield.aggregate(conns, expr = quote(hello('friends')))
DSI::datashield.errors()
DSI::datashield.logout(conns)


################################################################################
# Safe project ----
# I expect a lot of this will come from upstream - e.g. data access committee
# sign off etc. I don't know how we will get this into here.
################################################################################

# opalr::opal.execute(o)
# Project details
project_tbl <- opalr::opal.project(o, PROJECT)
project_tbl

opalr::opal.tables(o, PROJECT)

# Project details were added to the RO-Crate in the 'Safe Data' section

################################################################################
# Safe output ----
# We will likely have to parse the log files to show which methods have been
# run. Later on we can add the stat barn tags.
################################################################################

# Test analysis (to generate some logs) ----
builder <- DSI::newDSLoginBuilder()
builder$append(server = "study1",  
               url = SERVER,
               user = USERNAME, #"administrator",
               password = USERPASS, #"password",
               driver = "OpalDriver")
logindata <- builder$build()
conns <- DSI::datashield.login(logins = logindata)#, assign = TRUE, symbol = "D")

## assign data
DSI::datashield.tables(conns["study1"])
DSI::datashield.assign.table(conns["study1"], "cnsim", "DEMO.CNSIM1", errors.print = TRUE)

dsBaseClient::ds.ls(datasources = conns["study1"])
dsBaseClient::ds.summary("cnsim")
dsBaseClient::ds.table("cnsim$DIS_DIAB")

# DSI::datashield.errors()

DSI::datashield.workspace_save(conns, "datashield_workspace")
DSI::datashield.profiles(conns)

DSI::datashield.logout(conns)

## Check-out logs
o <- opalr::opal.login(
  username = "administrator",
  password = "password",
  url = SERVER
)
opalr::dsadmin.activity(o)
opalr::dsadmin.activity_summary(o)
opalr::dsadmin.log(o) |>
  tibble::as_tibble() |>
  View()

parse_timestamp <- function(x, format = "%Y-%m-%dT%H:%M:%S") {
  x |>
    sub(pattern = "\\..*Z$", replacement = "") |>
    as.POSIXct(format = format, tz = "UTC") |>
    format(format)
}

# Parse logs
userlogs <- opalr::dsadmin.log(o) |>
  tibble::as_tibble() |>
  dplyr::filter(logger_name == "datashield.user") |>
  dplyr::filter(username == USERNAME) |>
  glue::glue_data(
    "[{level}][{parse_timestamp(`@timestamp`)}]{stringr::str_pad(paste0('[', ds_action, ']'), 12, 'right', ' ')}{message}"
  )

log_filename <- paste0("./", Sys.Date(), "-dslogs-", USERNAME, ".log")
userlogs |>
  readr::write_lines(log_filename)

opalr::opal.logout(o)

# create new data entity for log file
log_entity <- rocrateR::entity(
  x = basename(log_filename), #digest::digest(basename(log_filename)),
  type = "File",
  dateModified = Sys.time(),
  name = basename(log_filename)
)

# add entity to the RO-Crate
dsROCrate <- dsROCrate |>
  rocrateR::add_entity(log_entity) |>
  rocrateR::add_entity_value(id = "./", key = "hasPart", value = list(`@id` = log_entity$`@id`))

#### Write RO-Crate to file
dsROCrate |>
  rocrateR::write_rocrate("./ro-crate-metadata.json")

#### Zip all the files in the crate
zip("./demo_5safes_rocrate.zip", c("./ro-crate-metadata.json", log_filename))