Consolidate acl rules

lib/WTSI/NPG/iRODS/DataObject.pm

@@ -9,8 +9,6 @@ use Set::Scalar;
 use Try::Tiny;
 
 use WTSI::NPG::iRODS;
-use WTSI::NPG::iRODS::Metadata qw($SAMPLE_CONSENT
-                                  $SAMPLE_CONSENT_WITHDRAWN);
 use WTSI::NPG::iRODS::Replicate;
 use WTSI::NPG::iRODS::Types qw(ArrayRefOfReplicate);
 
@@ -452,19 +450,14 @@ sub get_groups {
                logged only.
 
   Example    : $obj->update_group_permissions
-  Description: Modify a data objects ACL with respect to its study_id and
-               sample_consent / consent_withdrawn metadata and return the
-               data object.
+  Description: Modify a data objects ACL.
 
                The target group membership is determined by the result of
                calling $self->expected_groups. The current group membership
                is determined and any difference calculated. Unwanted
                group memberships are pruned, then missing group memberships
                are added.
 
-               If there are sample_consent or consent_withdrawn metadata,
-               access for all groups is removed.
-
                This method does not add or remove access for the 'public'
                group.
   Returntype : WTSI::NPG::iRODS::DataObject
@@ -488,16 +481,6 @@ sub update_group_permissions {
   $self->debug('Updated annotations: [', join(', ', @groups_annotated), ']');
 
   my $path = $self->str;
-
-  my $true  = 1;
-  my $false = 0;
-  if ($self->get_avu($SAMPLE_CONSENT,          $false) or
-      $self->get_avu($SAMPLE_CONSENT_WITHDRAWN, $true)) {
-    $self->info('Data is marked as CONSENT WITHDRAWN; ',
-                'all permissions will be withdrawn');
-    @groups_annotated = (); # Emptying this means all will be removed
-  }
-
   my $perms = Set::Scalar->new(@groups_permissions);
   my $annot = Set::Scalar->new(@groups_annotated);
   my @to_remove = $perms->difference($annot)->members;
@@ -638,7 +621,7 @@ Keith James <[email protected]>
 
 =head1 COPYRIGHT AND DISCLAIMER
 
-Copyright (C) 2013, 2014, 2015, 2016, 2021 Genome Research Limited. All
+Copyright (C) 2013, 2014, 2015, 2016, 2021, 2023 Genome Research Limited. All
 Rights Reserved.
 
 This program is free software: you can redistribute it and/or modify

lib/WTSI/NPG/iRODS/Path.pm

@@ -6,7 +6,10 @@ use List::MoreUtils qw(any notall uniq);
 use Moose::Role;
 
 use WTSI::NPG::iRODS;
-use WTSI::NPG::iRODS::Metadata qw($STUDY_ID);
+use WTSI::NPG::iRODS::Metadata qw($STUDY_ID
+                                  $ALIGNMENT_FILTER
+                                  $SAMPLE_CONSENT
+                                  $SAMPLE_CONSENT_WITHDRAWN);
 
 our $VERSION = '';
 
@@ -276,22 +279,61 @@ sub supersede_multivalue_avus {
   Arg [1]    : None
 
   Example    : @groups = $path->expected_groups
-  Description: Return an array of iRODS group names given metadata containing
-               >=1 study_id.
-  Returntype : Array
+  Description: Return a list of iRODS group names. The list might be empty or
+               contain either one or multiple iRODS group names.
+
+               An empty list is returned if the concent has been withdrawn or
+               for split-out xa-human data, for which the consent does not
+               exist by definition, or for split-out human data that is
+               associated with multiple studies.
+
+               Special study-related 'human' group ss_<STUDY_ID>_human is
+               returned for split-out human data associated with a single study.
+
+               In all other cases if data is associated with a list of studies,
+               a list of groups is returned, a group per study, the group name
+               pattern being ss_<STUDY_ID>.
+
+               The logic is based on examining such iRODS metadata as
+               'study_id', 'alignment_filter', 'sample_consent',
+               'sample_consent_withdrawn'. Neither object's path nor file name
+               is considered.
+
+  Returntype : List
 
 =cut
 
 sub expected_groups {
   my ($self) = @_;
 
+  my @af_avus = $self->find_in_metadata($ALIGNMENT_FILTER);
   my @ss_study_avus = $self->find_in_metadata($STUDY_ID);
+  my $human_subset   = any { $_->{value} eq 'human' }   @af_avus;
+  my $xahuman_subset = any { $_->{value} eq 'xahuman' } @af_avus;
 
+  my $info;
+  my $true  = 1;
+  my $false = 0;
   my @groups;
-  foreach my $avu (@ss_study_avus) {
-    my $study_id = $avu->{value};
-    my $group = $self->irods->make_group_name($study_id);
-    push @groups, $group;
+  if ($self->get_avu($SAMPLE_CONSENT,          $false) ||
+      $self->get_avu($SAMPLE_CONSENT_WITHDRAWN, $true)) {
+    $info = 'Data is marked as CONSENT WITHDRAWN';
+  } elsif ($xahuman_subset) {
+    $info = 'Data belongs to xahuman subset';
+  } elsif ($human_subset && (@ss_study_avus > 1)) {
+    $info = 'Data belongs to human subset and multiple studies';
+  } else {
+    @groups = map { $self->irods->make_group_name($_) }
+              map { $_->{value} }
+              @ss_study_avus;
+    if (@groups == 1 and $human_subset) {
+      $self->info('Data belongs to human subset');
+      @groups = ($groups[0] . '_human'); # Reset the list
+    }
+  }
+
+  if ($info) {
+    $self->info("${info}:\n no study-associated iRODS groups are applicable");
   }
 
   return @groups;
@@ -448,7 +490,7 @@ Keith James <[email protected]>
 
 =head1 COPYRIGHT AND DISCLAIMER
 
-Copyright (C) 2013, 2014, 2015, 2016 Genome Research Limited. All
+Copyright (C) 2013, 2014, 2015, 2016, 2023, 2024 Genome Research Limited. All
 Rights Reserved.
 
 This program is free software: you can redistribute it and/or modify

t/lib/WTSI/NPG/iRODS/DataObjectTest.pm

@@ -15,7 +15,7 @@ use Test::Exception;
 Log::Log4perl::init('./etc/log4perl_tests.conf');
 
 use WTSI::NPG::iRODS::DataObject;
-use WTSI::NPG::iRODS::Metadata qw($STUDY_ID);
+use WTSI::NPG::iRODS::Metadata qw($STUDY_ID $ALIGNMENT_FILTER);
 
 my $fixture_counter = 0;
 my $data_path = './t/data/path';
@@ -676,7 +676,7 @@ sub update_group_permissions : Test(12) {
     ok($r2, 'Removed ss_0 read access');
 
     # Add a study 0 AVU and use it to update (add) permissions
-    # in the presence of anAVU that will infer a non-existent group
+    # in the presence of an AVU that will infer a non-existent group
     ok($obj->add_avu($STUDY_ID, '0'));
     ok($obj->add_avu($STUDY_ID, 'no_such_study'));
     ok($obj->update_group_permissions);
@@ -695,4 +695,110 @@ sub update_group_permissions : Test(12) {
   }
 }
 
+sub update_group_permissions_for_nc_human_data : Test(28) {
+
+  my $irods = WTSI::NPG::iRODS->new(environment          => \%ENV,
+                                    strict_baton_version => 0);
+  my ($fh, $empty_file) = tempfile(UNLINK => 1);
+
+  #####
+  # Object that should not trigger _human group assignment
+  my $obj_path = "$irods_tmp_coll/test_file_human_no.txt";
+  $irods->add_object($empty_file, $obj_path) or fail;
+  my $obj = WTSI::NPG::iRODS::DataObject->new($irods, $obj_path);
+  ok($obj->add_avu($STUDY_ID, '10'));
+  ok($obj->update_group_permissions);
+  my @permissions = $obj->get_permissions;
+  my $outcome = any {
+    exists $_->{owner} && $_->{owner} eq 'ss_10' &&
+    exists $_->{level} && $_->{level} eq 'read'
+  } @permissions;
+  ok($outcome, 'Added ss_10 read access');
+  $outcome = none { exists $_->{owner} && $_->{owner} eq 'ss_10_human' }
+             @permissions;
+  ok($outcome, 'ss_10_human access is not added');
+
+  # phix alignment filter metadata
+  ok($obj->add_avu($ALIGNMENT_FILTER, 'phix'));
+  ok($obj->update_group_permissions);
+  @permissions = $obj->get_permissions;
+  $outcome = any {
+    exists $_->{owner} && $_->{owner} eq 'ss_10' &&
+    exists $_->{level} && $_->{level} eq 'read'
+  } @permissions;
+  ok($outcome, 'Retained ss_10 read access');
+  $outcome = none {
+    exists $_->{owner} && $_->{owner} eq 'ss_10_human'
+  } @permissions;
+  ok($outcome, 'ss_10_human access is not retained');
+
+  # yhuman alignment filter metadata 
+  ok($obj->remove_avu($ALIGNMENT_FILTER, 'phix'));
+  ok($obj->add_avu($ALIGNMENT_FILTER, 'yhuman'));
+  ok($obj->update_group_permissions);
+  @permissions = $obj->get_permissions;
+  $outcome = any {
+    exists $_->{owner} && $_->{owner} eq 'ss_10' &&
+    exists $_->{level} && $_->{level} eq 'read'
+  } @permissions;
+  ok($outcome, 'Retained ss_10 read access');
+  $outcome = none {
+    exists $_->{owner} && $_->{owner} eq 'ss_10_human'
+  } @permissions;
+  ok($outcome, 'ss_10_human access is not added');
+
+  # human alignment filter metadata
+  ok($obj->remove_avu($ALIGNMENT_FILTER, 'yhuman'));
+  ok($obj->add_avu($ALIGNMENT_FILTER, 'human'));
+  ok($obj->update_group_permissions);
+  @permissions = $obj->get_permissions; 
+  $outcome = none {
+    exists $_->{owner} && $_->{owner} eq 'ss_10' &&
+    exists $_->{level} && $_->{level} eq 'read'
+  } @permissions;
+  ok($outcome, 'Lost ss_10 read access');
+  $outcome = any {
+    exists $_->{owner} && $_->{owner} eq 'ss_10_human' &&
+    exists $_->{level} && $_->{level} eq 'read' 
+  } @permissions;
+  ok($outcome, 'Added ss_10_human read access');
+
+  # Multiple alignment filter metadata
+  ok($obj->add_avu($ALIGNMENT_FILTER, 'phix'));
+  ok($obj->update_group_permissions);
+  @permissions = $obj->get_permissions;
+  $outcome = none {
+    exists $_->{owner} && $_->{owner} eq 'ss_10' &&
+    exists $_->{level} && $_->{level} eq 'read'
+  } @permissions;
+  ok($outcome, 'Lost ss_10 read access');
+  $outcome = any {
+    exists $_->{owner} && $_->{owner} eq 'ss_10_human'
+  } @permissions;
+  ok($outcome, 'ss_10_human access is retained');
+
+  # Metadata for two studies
+  ok($obj->add_avu($STUDY_ID, '100'));
+  ok($obj->update_group_permissions);
+  @permissions = $obj->get_permissions;
+  $outcome = none {
+    exists $_->{owner} && $_->{owner} eq 'ss_10' &&
+    exists $_->{level} && $_->{level} eq 'read'
+  } @permissions;
+  ok($outcome, 'No ss_10 read access');
+  $outcome = none {
+    exists $_->{owner} && $_->{owner} eq 'ss_100' &&
+    exists $_->{level} && $_->{level} eq 'read'
+  } @permissions;
+  ok($outcome, 'No ss_100 read access');
+  $outcome = none {
+    exists $_->{owner} && $_->{owner} eq 'ss_10_human'
+  } @permissions;
+  ok($outcome, 'ss_10_human access is not retained');
+  $outcome = none {
+    exists $_->{owner} && $_->{owner} eq 'ss_100_human'
+  } @permissions;
+  ok($outcome, 'ss_100_human access is not added');  
+}
+
 1;