add disclosure check for matrix assign function

Author: timcadman

R/matrixDetDS1.R

@@ -16,6 +16,11 @@
 
 matrixDetDS1 <- function(M1.name=NULL,logarithm){
 
+dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'avocado', 'banana'))
+
+thr <- dsBase::listDisclosureSettingsDS()
+nfilter.subset <- as.numeric(thr$nfilter.subset)
+
 M1 <- .loadServersideObject(M1.name)
 .checkClass(obj = M1, obj_name = M1.name, permitted_classes = c("matrix", "data.frame"))
 
@@ -33,6 +38,12 @@ if(ncol(M1)!=nrow(M1))
 	stop(error.message, call. = FALSE)
 	}
 
+#Check matrix large enough to reduce disclosure risk
+if(nrow(M1)<nfilter.subset)
+	{
+	error.message<-"FAILED: matrix is too small (nrows < nfilter.subset), please respecify"
+	stop(error.message, call. = FALSE)
+	}
 
 output<-determinant(M1,logarithm=logarithm)
 

tests/testthat/test-smk-matrixDetDS1.R

@@ -11,12 +11,9 @@ set.standard.disclosure.settings()
 # Tests
 #
 
-test_that("simple matrixDetDS1", {
-    M1 <- matrix(c(1, 2, 3, 4), 2, 2)
-
+test_that("simple matrixDetDS1 passes with matrix of sufficient dimensions", {
+    M1 <- matrix(c(1, 2, 3, 4, 5, 6, 7, 8, 10), 3, 3)
     res <- matrixDetDS1("M1", logarithm=FALSE)
-
-    expect_true(is.list(res))
     expect_equal(res$matrix.determinant, determinant(M1, logarithm=FALSE))
 })
 
@@ -28,3 +25,18 @@ test_that("matrixDetDS1 errors when input is wrong type", {
     bad_input <- c("a", "b", "c")
     expect_error(matrixDetDS1("bad_input", logarithm=FALSE), regexp = "must be of type")
 })
+
+test_that("matrixDetDS1 errors when matrix is too small (disclosure guard)", {
+    M1x1 <- matrix(7, 1, 1)
+    M2x2 <- matrix(c(1, 2, 3, 4), 2, 2)
+
+    expect_error(matrixDetDS1("M1x1", logarithm=FALSE), regexp = "too small")
+    expect_error(matrixDetDS1("M2x2", logarithm=FALSE), regexp = "too small")
+})
+
+test_that("matrixDetDS1 is blocked in non-permissive mode", {
+    options(datashield.privacyControlLevel = "non-permissive")
+    on.exit(options(datashield.privacyControlLevel = NULL), add = TRUE)
+    M1 <- matrix(c(1, 2, 3, 4, 5, 6, 7, 8, 10), 3, 3)
+    expect_error(matrixDetDS1("M1", logarithm=FALSE), regexp = "non-permissive")
+})