tests/testthat/test-utils-safe_setting.R

In dsROCrate: 'DataSHIELD' RO-Crate Governance Functions

# -------------------------------------------------------------------------
# S3 generic dispatch
# -------------------------------------------------------------------------
test_that("extract_safe_setting dispatch works for rocrate", {
  # create an RO-Crate with setting entities
  disc_setting <- rocrateR::entity(
    id = "#setting-1",
    type = "PropertyValue",
    name = "analysis.threshold",
    value = "0.05"
  )
  disc_env <- rocrateR::entity(
    id = paste0("#env:disclosure_settings:", "default"),
    type = "CreativeWork",
    name = "Disclosure Control Environment",
    hasPart = purrr::map(list(disc_setting), ~ list("@id" = .x$`@id`))
  )
  safe_setting_root <- rocrateR::entity(
    id = paste0("#safesetting:", "opal"),
    type = "CreativeWork",
    name = "Safe Setting Controls (Opal)",
    description = paste(
      "Technical, physical and organisational safeguards applied to minimise",
      "disclosure risk."
    ),
    hasPart = list(disc_env) |>
      purrr::map(\(x) list("@id" = x$`@id`))
  )
  rocrate <- list(disc_setting, disc_env, safe_setting_root) |>
    purrr::reduce(rocrateR::add_entity, .init = rocrateR::rocrate_5s())

  out <- dsROCrate:::extract_safe_setting(rocrate)

  expect_s3_class(out, "rocrate")
})

test_that("flatten_safe_setting.default returns empty tibble", {
  out <- flatten_safe_setting(list())

  expect_s3_class(out, "tbl_df")
  expect_equal(nrow(out), 0)
})

# -------------------------------------------------------------------------
# extract_safe_setting.rocrate()
# -------------------------------------------------------------------------
test_that("extract_safe_setting.rocrate errors when no matching entities", {
  rocrate <- rocrateR::rocrate_5s()

  # ignore warning about missing entity of @type = 'PropertyValue'!
  suppressWarnings(
    expect_error(
      extract_safe_setting(rocrate),
      "The Safe Setting root entity has no entities linked!"
    )
  )
})

test_that("extract_safe_setting.rocrate extracts PropertyValue and SoftwareApplication", {
  # create an RO-Crate with setting entities
  software_ent <- rocrateR::entity(
    id = "#software-1",
    type = "SoftwareApplication",
    name = "DataSHIELD",
    version = "6.2.0"
  )
  disc_setting <- rocrateR::entity(
    id = "#setting-1",
    type = "PropertyValue",
    name = "analysis.threshold",
    value = "0.05"
  )
  disc_env <- rocrateR::entity(
    id = paste0("#env:disclosure_settings:", "default"),
    type = "CreativeWork",
    name = "Disclosure Control Environment",
    hasPart = purrr::map(list(disc_setting), ~ list("@id" = .x$`@id`))
  )
  safe_setting_root <- rocrateR::entity(
    id = paste0("#safesetting:", "opal"),
    type = "CreativeWork",
    name = "Safe Setting Controls (Opal)",
    description = paste(
      "Technical, physical and organisational safeguards applied to minimise",
      "disclosure risk."
    ),
    hasPart = list(disc_env, software_ent) |>
      purrr::map(\(x) list("@id" = x$`@id`))
  )
  rocrate <- list(disc_setting, disc_env, software_ent, safe_setting_root) |>
    purrr::reduce(rocrateR::add_entity, .init = rocrateR::rocrate_5s())

  out <- extract_safe_setting(rocrate)

  expect_s3_class(out, "rocrate")

  pv <- .get_entity(out, type = "PropertyValue")
  sa <- .get_entity(out, type = "SoftwareApplication")

  expect_equal(length(pv), 1)
  expect_equal(length(sa), 1)
})

test_that("extract_safe_setting.rocrate filters correctly by id", {
  # create an RO-Crate with setting entities
  disc_setting <- rocrateR::entity(
    id = "#setting-1",
    type = "PropertyValue",
    name = "analysis.threshold",
    value = "0.05"
  )
  disc_env <- rocrateR::entity(
    id = paste0("#env:disclosure_settings:", "default"),
    type = "CreativeWork",
    name = "Disclosure Control Environment",
    hasPart = purrr::map(list(disc_setting), ~ list("@id" = .x$`@id`))
  )
  safe_setting_root <- rocrateR::entity(
    id = paste0("#safesetting:", "opal"),
    type = "CreativeWork",
    name = "Safe Setting Controls (Opal)",
    description = paste(
      "Technical, physical and organisational safeguards applied to minimise",
      "disclosure risk."
    ),
    hasPart = list(disc_env) |>
      purrr::map(\(x) list("@id" = x$`@id`))
  )
  rocrate <- list(disc_setting, disc_env, safe_setting_root) |>
    purrr::reduce(rocrateR::add_entity, .init = rocrateR::rocrate_5s())

  out <- extract_safe_setting(rocrate, id = "#setting-1")

  pv <- .get_entity(out, type = "PropertyValue")
  # ignore warning about missing entity of @type = 'SoftwareApplication'!
  suppressWarnings(
    sa <- .get_entity(out, type = "SoftwareApplication")
  )

  expect_equal(length(pv), 1)
  expect_equal(getElement(pv[[1]], "@id"), "#setting-1")
  # SoftwareApplication should not be re-added when filtered out
  expect_true(length(sa) >= 0)
})

test_that("extract_safe_setting.rocrate emits informative message", {
  # create an RO-Crate with setting entities
  disc_setting <- rocrateR::entity(
    id = "#setting-1",
    type = "PropertyValue",
    name = "analysis.threshold",
    value = "0.05"
  )
  disc_env <- rocrateR::entity(
    id = paste0("#env:disclosure_settings:", "default"),
    type = "CreativeWork",
    name = "Disclosure Control Environment",
    hasPart = purrr::map(list(disc_setting), ~ list("@id" = .x$`@id`))
  )
  safe_setting_root <- rocrateR::entity(
    id = paste0("#safesetting:", "opal"),
    type = "CreativeWork",
    name = "Safe Setting Controls (Opal)",
    description = paste(
      "Technical, physical and organisational safeguards applied to minimise",
      "disclosure risk."
    ),
    hasPart = list(disc_env) |>
      purrr::map(\(x) list("@id" = x$`@id`))
  )
  rocrate <- list(disc_setting, disc_env, safe_setting_root) |>
    purrr::reduce(rocrateR::add_entity, .init = rocrateR::rocrate_5s())

  expect_message(
    extract_safe_setting(rocrate),
    "'PropertyValue' OR 'SoftwareApplication' entit"
  )
})

test_that("extract_safe_setting.rocrate errors when id filter removes all", {
  # create an RO-Crate with setting entities
  disc_setting <- rocrateR::entity(
    id = "#setting-1",
    type = "PropertyValue",
    name = "analysis.threshold",
    value = "0.05"
  )
  disc_env <- rocrateR::entity(
    id = paste0("#env:disclosure_settings:", "default"),
    type = "CreativeWork",
    name = "Disclosure Control Environment",
    hasPart = purrr::map(list(disc_setting), ~ list("@id" = .x$`@id`))
  )
  safe_setting_root <- rocrateR::entity(
    id = paste0("#safesetting:", "opal"),
    type = "CreativeWork",
    name = "Safe Setting Controls (Opal)",
    description = paste(
      "Technical, physical and organisational safeguards applied to minimise",
      "disclosure risk."
    ),
    hasPart = list(disc_env) |>
      purrr::map(\(x) list("@id" = x$`@id`))
  )
  rocrate <- list(disc_setting, disc_env, safe_setting_root) |>
    purrr::reduce(rocrateR::add_entity, .init = rocrateR::rocrate_5s())

  expect_error(
    extract_safe_setting(rocrate, id = "#nonexistent"),
    "No matching entities were found!"
  )
})

test_that("extract_safe_setting.rocrate validates rocrate input", {
  bad_rc <- structure(list(), class = "rocrate")

  expect_error(
    extract_safe_setting.rocrate(bad_rc)
  )
})

# -------------------------------------------------------------------------
# flatten_safe_setting.rocrate()
# -------------------------------------------------------------------------
test_that("flatten_safe_setting.rocrate returns tibble with correct columns", {
  # create an RO-Crate with setting entities
  rocrate <- rocrateR::rocrate_5s() |>
    rocrateR::add_entity(
      entity = rocrateR::entity(
        id = "#setting-1",
        type = "PropertyValue",
        name = "analysis.threshold",
        value = "0.05"
      )
    ) |>
    rocrateR::add_entity(
      entity = rocrateR::entity(
        id = "#software-1",
        type = "SoftwareApplication",
        name = "DataSHIELD",
        version = "6.2.0"
      )
    )

  out <- flatten_safe_setting(rocrate)

  expect_s3_class(out, "tbl_df")
  expect_true(all(c("id", "name", "value", "version") %in% names(out)))
})

test_that("flatten_safe_setting.rocrate extracts PropertyValue fields", {
  # create an RO-Crate with setting entities
  rocrate <- rocrateR::rocrate_5s() |>
    rocrateR::add_entity(
      entity = rocrateR::entity(
        id = "#setting-1",
        type = "PropertyValue",
        name = "analysis.threshold",
        value = "0.05"
      )
    ) |>
    rocrateR::add_entity(
      entity = rocrateR::entity(
        id = "#software-1",
        type = "SoftwareApplication",
        name = "DataSHIELD",
        version = "6.2.0"
      )
    )

  out <- flatten_safe_setting(rocrate)

  expect_true("#setting-1" %in% out$id)
  expect_true("analysis.threshold" %in% out$name)
  expect_true("0.05" %in% out$value)
})

test_that("flatten_safe_setting.rocrate extracts SoftwareApplication version", {
  # create an RO-Crate with setting entities
  rocrate <- rocrateR::rocrate_5s() |>
    rocrateR::add_entity(
      entity = rocrateR::entity(
        id = "#setting-1",
        type = "PropertyValue",
        name = "analysis.threshold",
        value = "0.05"
      )
    ) |>
    rocrateR::add_entity(
      entity = rocrateR::entity(
        id = "#software-1",
        type = "SoftwareApplication",
        name = "DataSHIELD",
        version = "6.2.0"
      )
    )

  out <- flatten_safe_setting(rocrate)

  software_row <- out[out$id == "#software-1", ]

  expect_equal(software_row$name, "DataSHIELD")
  expect_equal(software_row$version, "6.2.0")
})

test_that("flatten_safe_setting.rocrate filters by id correctly", {
  # create an RO-Crate with setting entities
  rocrate <- rocrateR::rocrate_5s() |>
    rocrateR::add_entity(
      entity = rocrateR::entity(
        id = "#setting-1",
        type = "PropertyValue",
        name = "analysis.threshold",
        value = "0.05"
      )
    ) |>
    rocrateR::add_entity(
      entity = rocrateR::entity(
        id = "#software-1",
        type = "SoftwareApplication",
        name = "DataSHIELD",
        version = "6.2.0"
      )
    )

  out <- flatten_safe_setting(rocrate, id = "#software-1")

  expect_equal(nrow(out), 1)
  expect_equal(out$id, "#software-1")
  expect_equal(out$name, "DataSHIELD")
})

test_that("flatten_safe_setting.rocrate returns empty tibble on error", {
  # Force error inside tryCatch by giving malformed object
  bad_obj <- structure(list(), class = "rocrate")

  out <- flatten_safe_setting(bad_obj)

  expect_s3_class(out, "tbl_df")
  expect_equal(nrow(out), 0)
})

# -------------------------------------------------------------------------
# extract_safe_setting.opal() (unit + integration strategy)
# -------------------------------------------------------------------------
test_that("extract_safe_setting.opal calls safe_setting and returns rocrate", {
  # dummy opal-like object (S3 dispatch target)
  opal_con <- structure(list(), class = "opal")

  # mock safe_setting to avoid real server dependency
  mock_safe_setting <- function(x, rocrate) {
    setting <- rocrateR::entity(
      id = "#mock-setting",
      type = "PropertyValue",
      name = "mock.option",
      value = "TRUE"
    )
    rocrateR::add_entity(rocrate, setting)
  }

  with_mocked_bindings(
    safe_setting = mock_safe_setting,
    {
      out <- extract_safe_setting.opal(opal_con)
    }
  )

  expect_s3_class(out, "rocrate")

  pv <- .get_entity(out, type = "PropertyValue")
  expect_true(length(pv) >= 1)
})

# -------------------------------------------------------------------------
# optional TRUE Opal demo integration (matches your demo server workflow)
# -------------------------------------------------------------------------
test_that("extract_safe_setting.opal works with Opal demo server (if available)", {
  con <- try(opal_demo_con(), silent = TRUE)
  skip_if(inherits(con, "try-error"), "Opal demo server not available")

  rocrate <- extract_safe_setting(con)

  expect_s3_class(rocrate, "rocrate")
})