compliance/sancation_list_update_centralization

.circleci/config.yml

@@ -9,6 +9,10 @@ jobs:
       - image: perldocker/perl-tester:<< parameters.perl-version >>
     steps:
       - checkout
+      - run:
+          name: Install Redis server
+          command: |
+            apt-get install -y redis
       - run:
           command:
             cpm install -g --no-test Dist::Zilla Dist::Zilla::App::Command::cover ExtUtils::MakeMaker

Changes

@@ -1,6 +1,7 @@
 Revision history for Data-Validate-Sanctions
 
 {{$NEXT}}
+
 0.13      2022-07-26 13:55:00 CST
         Improving the search for larger sanction lists
 

cpanfile

@@ -19,14 +19,20 @@ requires 'Getopt::Long', '2.42';
 requires 'Syntax::Keyword::Try', '0.18';
 requires 'Locale::Country', '3.66';
 requires 'Text::Trim', 0;
+requires 'JSON::MaybeUTF8', 0;
+requires 'Clone', 0;
 
 on test => sub {
     requires 'Test::More', '0.96';
     requires 'Test::Warn', '0.23';
     requires 'Test::Warnings', '0.026';
     requires 'Test::MockModule', '0.15';
     requires 'Test::MockObject', '1.20161202';
+    requires 'Test::MockTime';
+    requires 'Test::Deep', '0';
     requires 'FindBin', '0';
     requires 'Path::Tiny', '0';
     requires 'Class::Unload', '0';
+    requires 'Test::RedisServer', '0.23';
+    requires 'RedisDB', '2.57';
 };

lib/Data/Validate/Sanctions.pm

@@ -9,26 +9,33 @@ our @EXPORT_OK = qw/is_sanctioned set_sanction_file get_sanction_file/;
 
 use Carp;
 use Data::Validate::Sanctions::Fetcher;
+use Data::Validate::Sanctions::Redis;
 use File::stat;
 use File::ShareDir;
-use YAML::XS qw/DumpFile LoadFile/;
+use YAML::XS     qw/DumpFile LoadFile/;
 use Scalar::Util qw(blessed);
 use Date::Utility;
 use Data::Compare;
 use List::Util qw(any uniq max min);
 use Locale::Country;
 use Text::Trim qw(trim);
+use Clone      qw(clone);
 
-our $VERSION = '0.13';
+our $VERSION = '0.14';
 
-my $sanction_file = _default_sanction_file();
+my $sanction_file;
 my $instance;
 
 # for OO
 sub new {    ## no critic (RequireArgUnpacking)
     my ($class, %args) = @_;
 
+    my $storage = delete $args{storage} // '';
+
+    return Data::Validate::Sanctions::Redis->new(%args) if $storage eq 'redis';
+
     my $self = {};
+
     $self->{sanction_file} = $args{sanction_file} // _default_sanction_file();
 
     $self->{args} = {%args};
@@ -43,18 +50,27 @@ sub update_data {
     $self->_load_data();
 
     my $new_data = Data::Validate::Sanctions::Fetcher::run($self->{args}->%*, %args);
-
-    my $updated;
+    my $updated  = 0;
     foreach my $k (keys %$new_data) {
         $self->{_data}->{$k}            //= {};
         $self->{_data}->{$k}->{updated} //= 0;
         $self->{_data}->{$k}->{content} //= [];
-        if ($self->{_data}{$k}->{updated} != $new_data->{$k}->{updated}
+
+        if (!$new_data->{$k}->{error} && $self->{_data}->{$k}->{error}) {
+            delete $self->{_data}->{$k}->{error};
+            $updated = 1;
+        }
+
+        if ($new_data->{$k}->{error}) {
+            warn "$k list update failed because: $new_data->{$k}->{error}";
+            $self->{_data}->{$k}->{error} = $new_data->{$k}->{error};
+            $updated = 1;
+        } elsif ($self->{_data}{$k}->{updated} != $new_data->{$k}->{updated}
             || scalar $self->{_data}{$k}->{content}->@* != scalar $new_data->{$k}->{content}->@*)
         {
+            print "Source $k is updated with new data \n" if $args{verbose};
             $self->{_data}->{$k} = $new_data->{$k};
             $updated = 1;
-            print "Source $k is updated with new data \n" if $args{verbose};
         } else {
             print "Source $k is not changed \n" if $args{verbose};
         }
@@ -76,7 +92,7 @@ sub last_updated {
         return $self->{_data}->{$list}->{updated};
     } else {
         $self->_load_data();
-        return max(map { $_->{updated} } values %{$self->{_data}});
+        return max(map { $_->{updated} // 0 } values %{$self->{_data}});
     }
 }
 
@@ -87,6 +103,7 @@ sub set_sanction_file {    ## no critic (RequireArgUnpacking)
 }
 
 sub get_sanction_file {
+    $sanction_file //= _default_sanction_file();
     return $instance ? $instance->{sanction_file} : $sanction_file;
 }
 
@@ -103,6 +120,14 @@ sub is_sanctioned {    ## no critic (RequireArgUnpacking)
     return (get_sanctioned_info(@_))->{matched};
 }
 
+sub data {
+    my ($self) = @_;
+
+    $self->_load_data() unless $self->{_data};
+
+    return $self->{_data};
+}
+
 =head2 _match_other_fields
 
 Matches fields possibly available in addition to name and date of birth.
@@ -173,9 +198,12 @@ It returns a hash-ref containg the following data:
 =over 4
 
 =item - matched:      1 if a match was found; 0 otherwise
-        list:         the source for the matched entry,
-        matched_args: a name-value hash-ref of the similar arguments,
-        comment:      additional comments if necessary,
+
+=item - list:         the source for the matched entry,
+
+=item - matched_args: a name-value hash-ref of the similar arguments,
+
+=item - comment:      additional comments if necessary,
 
 =back
 
@@ -184,7 +212,7 @@ It returns a hash-ref containg the following data:
 sub get_sanctioned_info {    ## no critic (RequireArgUnpacking)
     my $self = blessed($_[0]) ? shift : $instance;
     unless ($self) {
-        $instance = __PACKAGE__->new(sanction_file => $sanction_file);
+        $instance = __PACKAGE__->new(sanction_file => get_sanction_file());
         $self     = $instance;
     }
 
@@ -219,7 +247,7 @@ sub get_sanctioned_info {    ## no critic (RequireArgUnpacking)
     # and deduplicate the list
     my $filtered_sanctioned_names = {};
     foreach my $token (@client_name_tokens) {
-        foreach my $name ( keys %{$self->{_token_sanctioned_names}->{$token}}) {
+        foreach my $name (keys %{$self->{_token_sanctioned_names}->{$token}}) {
             $filtered_sanctioned_names->{$name} = 1;
         }
     }
@@ -286,12 +314,12 @@ sub get_sanctioned_info {    ## no critic (RequireArgUnpacking)
 }
 
 sub _load_data {
-    my $self                              = shift;
-    my $sanction_file                     = $self->{sanction_file};
-    $self->{last_time}                    //= 0;
-    $self->{_data}                        //= {};
-    $self->{_sanctioned_name_tokens}      //= {};
-    $self->{_token_sanctioned_names}      //= {};
+    my $self          = shift;
+    my $sanction_file = $self->{sanction_file};
+    $self->{last_time}               //= 0;
+    $self->{_data}                   //= {};
+    $self->{_sanctioned_name_tokens} //= {};
+    $self->{_token_sanctioned_names} //= {};
 
     if (-e $sanction_file) {
         return $self->{_data} if stat($sanction_file)->mtime <= $self->{last_time} && $self->{_data};
@@ -303,8 +331,8 @@ sub _load_data {
     foreach my $sanctioned_name (keys $self->{_index}->%*) {
         my @tokens = _clean_names($sanctioned_name);
         $self->{_sanctioned_name_tokens}->{$sanctioned_name} = \@tokens;
-        foreach my $token (@tokens){
-            $self->{_token_sanctioned_names}->{$token}->{$sanctioned_name}=1;
+        foreach my $token (@tokens) {
+            $self->{_token_sanctioned_names}->{$token}->{$sanctioned_name} = 1;
         }
     }
 
@@ -320,10 +348,11 @@ Indexes data by name. Each name may have multiple matching entries.
 sub _index_data {
     my $self = shift;
 
+    $self->{_data} //= {};
     $self->{_index} = {};
     for my $source (keys $self->{_data}->%*) {
-        my @content = ($self->{_data}->{$source}->{content} // [])->@*;
-        warn "Content is empty for the sanction source $source. The sanctions file should be updated." unless @content;
+        my @content = clone($self->{_data}->{$source}->{content} // [])->@*;
+
         for my $entry (@content) {
             $entry->{source} = $source;
             for my $name ($entry->{names}->@*) {
@@ -392,6 +421,12 @@ sub _name_matches {
     return 0;
 }
 
+sub export_data {
+    my ($self, $path) = @_;
+
+    return DumpFile($path, $self->{_data});
+}
+
 1;
 __END__
 
@@ -487,6 +522,15 @@ set sanction_file which is used by L</is_sanctioned> (procedure-oriented)
 
 Pass in the client's name and sanctioned individual's name to see if they are similar or not
 
+
+=head2 export_data
+
+Exports the sanction lists to a local file in YAML format.
+
+=head2 data
+
+Gets the sanction list content with lazy loading.
+
 =head1 AUTHOR
 
 Binary.com E<lt>fayland@binary.comE<gt>

lib/Data/Validate/Sanctions/Fetcher.pm

@@ -6,15 +6,15 @@ use warnings;
 use DateTime::Format::Strptime;
 use Date::Utility;
 use IO::Uncompress::Unzip qw(unzip $UnzipError);
-use List::Util qw(uniq any);
+use List::Util            qw(uniq any);
 use Mojo::UserAgent;
 use Text::CSV;
 use Text::Trim qw(trim);
 use Syntax::Keyword::Try;
 use XML::Fast;
 use Locale::Country;
 
-our $VERSION = '0.10';
+# VERSION
 
 =head2 config
 
@@ -234,7 +234,7 @@ sub _ofac_xml {
         $ref->{publshInformation}{Publish_Date} =~ m/(\d{1,2})\/(\d{1,2})\/(\d{4})/
         ? _date_to_epoch("$3-$1-$2")
         : undef;    # publshInformation is a typo in ofac xml tags
-    die 'Publication date is invalid' unless defined $publish_epoch;
+    die "Corrupt data. Release date is invalid\n" unless defined $publish_epoch;
 
     my $parse_list_node = sub {
         my ($entry, $parent, $child, $attribute) = @_;
@@ -301,16 +301,16 @@ sub _hmt_csv {
     my $raw_data = shift;
     my $dataset  = [];
 
-    my $csv = Text::CSV->new({binary => 1}) or die "Cannot use CSV: " . Text::CSV->error_diag();
+    my $csv = Text::CSV->new({binary => 1}) or die "Cannot use CSV: " . Text::CSV->error_diag() . "\n";
 
     my @lines = split("\n", $raw_data);
 
     my $parsed = $csv->parse(trim(shift @lines));
     my @info   = $parsed ? $csv->fields() : ();
-    die 'Publication date was not found' unless @info && _date_to_epoch($info[1]);
+    die "Currupt data. Release date was not found\n" unless @info && _date_to_epoch($info[1]);
 
     my $publish_epoch = _date_to_epoch($info[1]);
-    die 'Publication date is invalid' unless defined $publish_epoch;
+    die "Currupt data. Release date is invalid\n" unless defined $publish_epoch;
 
     $parsed = $csv->parse(trim(shift @lines));
     my @row    = $csv->fields();
@@ -342,7 +342,7 @@ sub _hmt_csv {
         # Fields to be added in the  new file format (https://redmine.deriv.cloud/issues/51922)
         # We can read these fields normally after the data is released in the new format
         my ($passport_no, $non_latin_alias);
-        $passport_no     = $row[$column{'Passport Number'}]        if defined $column{'Passport Number'};
+        $passport_no     = $row[$column{'Passport Number'}]       if defined $column{'Passport Number'};
         $non_latin_alias = $row[$column{'Name Non-Latin Script'}] if defined $column{'Name Non-Latin Script'};
 
         _process_sanction_entry(
@@ -393,7 +393,7 @@ sub _eu_xml {
         my @place_of_birth = map { $_->{'-countryIso2Code'} || () } $entry->{birthdate}->@*;
         my @citizen        = map { $_->{'-countryIso2Code'} || () } $entry->{citizenship}->@*;
         my @residence      = map { $_->{'-countryIso2Code'} || () } $entry->{address}->@*;
-        my @postal_code    = map { $_->{'-zipCode'} || $_->{'-poBox'} || () } $entry->{address}->@*;
+        my @postal_code    = map { $_->{'-zipCode'}         || $_->{'-poBox'} || () } $entry->{address}->@*;
         my @nationality    = map { $_->{'-countryIso2Code'} || () } $entry->{identification}->@*;
         my @national_id    = map { $_->{'-identificationTypeCode'} eq 'id'       ? $_->{'-number'} || () : () } $entry->{identification}->@*;
         my @passport_no    = map { $_->{'-identificationTypeCode'} eq 'passport' ? $_->{'-number'} || () : () } $entry->{identification}->@*;
@@ -415,7 +415,7 @@ sub _eu_xml {
     my @date_parts    = split('T', $ref->{'-generationDate'} // '');
     my $publish_epoch = _date_to_epoch($date_parts[0]        // '');
 
-    die 'Publication date is invalid' unless $publish_epoch;
+    die "Corrupt data. Release date is invalid\n" unless $publish_epoch;
 
     return {
         updated => $publish_epoch,
@@ -440,7 +440,7 @@ sub run {
     foreach my $id (sort keys %$config) {
         my $source = $config->{$id};
         try {
-            die "Url is empty for $id" unless $source->{url};
+            die "Url is empty for $id\n" unless $source->{url};
 
             my $raw_data;
 
@@ -461,8 +461,8 @@ sub run {
                 my $count = $data->{content}->@*;
                 print "Source $id: $count entries fetched \n" if $args{verbose};
             }
-        } catch {
-            warn "$id list update failed because: $@";
+        } catch ($e) {
+            $result->{$id}->{error} = $e;
         }
     }
 
@@ -480,7 +480,7 @@ sub _entries_from_file {
 
     my $entries;
 
-    open my $fh, '<', "$1" or die "Can't open $id file $1 $!";
+    open my $fh, '<', "$1" or die "Can't open $id file $1 $!\n";
     $entries = do { local $/; <$fh> };
     close $fh;
 
@@ -513,16 +513,16 @@ sub _entries_from_remote_src {
         try {
             my $resp = $ua->get($src_url);
 
-            die "File not downloaded for $id" if $resp->result->is_error;
+            die "File not downloaded for $id\n" if $resp->result->is_error;
             $entries = $resp->result->body;
 
             last;
-        } catch {
-            $error_log = $@;
+        } catch ($e) {
+            $error_log = $e;
         }
     }
 
-    return $entries // die "An error occurred while fetching data from '$src_url' due to $error_log";
+    return $entries // die "An error occurred while fetching data from '$src_url' due to $error_log\n";
 }
 
 1;