Memberships refuse an object whose events are in another order or another partition

R/memberships.R

@@ -38,6 +38,18 @@
   paste(labels, collapse = if (identical(gate_logic, "or")) " or " else " and ")
 }
 
+# What the bitsets are positional against: the column names in order, and the sample partition
+# they were packed per sample with. A column count alone let an object with the same number of
+# events in a different order, or partitioned into different samples, read the wrong events as
+# members; the stored digests make the read refuse it, as the documentation always promised.
+.gatelabr_membership_fingerprint <- function(sce, partition) {
+  list(
+    sample_column = partition$column,
+    columns = digest::digest(colnames(sce), algo = "xxhash64"),
+    partition = digest::digest(partition$event_indices, algo = "xxhash64")
+  )
+}
+
 # Validate the payload an explicit save carries and pack it against this SCE's sample layout.
 .gatelabr_pack_host_memberships <- function(
     sce,
@@ -156,6 +168,7 @@
     revision = as.integer(revision),
     saved_at = saved_at,
     event_count = ncol(sce),
+    fingerprint = .gatelabr_membership_fingerprint(sce, partition),
     hierarchies = hierarchies,
     populations = populations,
     masks = masks
@@ -198,6 +211,29 @@
       call. = FALSE
     )
   }
+  # Records written before the fingerprint existed carry none and keep the column-count check
+  # alone; a record that has one must match the object's event order and sample partition.
+  saved <- record$fingerprint
+  if (is.list(saved)) {
+    now <- tryCatch(
+      .gatelabr_membership_fingerprint(
+        sce,
+        .gatelabr_sample_partition(sce, saved$sample_column, include_metadata = FALSE)
+      ),
+      error = function(e) NULL
+    )
+    if (is.null(now) || !identical(now$columns, saved$columns) ||
+        !identical(now$partition, saved$partition)) {
+      stop(
+        "The stored population memberships were saved on an object whose events were in a ",
+        "different order or belonged to different samples: this SCE has the same number of ",
+        "columns, but its column names or its sample partition are not those the memberships ",
+        "were packed against (subsetting or reordering an SCE does not carry them). ",
+        "Press \"Save to SCE\" in GateLabR on this object.",
+        call. = FALSE
+      )
+    }
+  }
   current <- .gatelabr_canonical_workspace_record(sce)
   current_revision <- if (is.null(current)) 0L else current$revision
   if (!identical(as.integer(record$revision), current_revision) && !isTRUE(allow_stale)) {

tests/testthat/test-memberships.R

@@ -219,6 +219,23 @@ test_that("memberships are refused on an object they were not saved on", {
   expect_error(gatelabPopulations(make_memberships_sce()), "No population memberships")
   sce <- store_with_memberships()$sce
   expect_error(gatelabPopulations(sce[, 1:2]), "cover 3 events but this SCE has 2 columns")
+  # Same column count, different order: the bitsets are positional, so this read the wrong
+  # events as members while the documentation said it would be refused. Now it is.
+  expect_error(gatelabPopulations(sce[, c(2, 1, 3)]), "different order")
+  # Same order, a different sample partition: masks packed per sample no longer line up.
+  moved <- sce
+  SummarizedExperiment::colData(moved)$sample_id[3] <- "Donor A"
+  expect_error(gatelabPopulations(moved), "different order")
+  # The object they were saved on still reads.
+  expect_identical(dim(gatelabPopulations(sce)), c(3L, 3L))
+})
+
+test_that("a record saved before the fingerprint existed still reads on its own object", {
+  sce <- store_with_memberships()$sce
+  workspace <- S4Vectors::metadata(sce)$gatelab_workspace
+  workspace$memberships$fingerprint <- NULL
+  S4Vectors::metadata(sce)$gatelab_workspace <- workspace
+  expect_identical(dim(gatelabPopulations(sce)), c(3L, 3L))
 })
 
 test_that("a malformed memberships payload is refused before anything is stored", {