role: moderate mail from non-subscribers

3 files changed, 151 insertions, 0 deletions

diff --git a/t/lib/Test/Sietima.pm b/t/lib/Test/Sietima.pm
index 0b80e42..0661786 100644
--- a/t/lib/Test/Sietima.pm
+++ b/t/lib/Test/Sietima.pm
@@ -16,6 +16,8 @@ sub import {
     my $target = caller;
     Test2::Bundle::Extended->import::into($target);
     Test2::Plugin::DieOnFail->import::into($target);
+    Data::Printer->import::into($target);
+
     for my $function (qw(transport make_sietima make_mail
                          deliveries_are test_sending)) {
         no strict 'refs';
@@ -52,6 +54,7 @@ sub make_mail {
     Email::Stuffer
           ->from($args{from}||'someone@users.example.com')
           ->to($args{to}||$return_path)
+          ->subject($args{subject}||'Test Message')
           ->text_body($args{body}||'some simple message')
           ->email;
 }
diff --git a/t/lib/Test/Sietima/MailStore.pm b/t/lib/Test/Sietima/MailStore.pm
new file mode 100644
index 0000000..abf4435
--- /dev/null
+++ b/t/lib/Test/Sietima/MailStore.pm
@@ -0,0 +1,56 @@
+package Test::Sietima::MailStore;
+use strict;
+use warnings;
+use 5.020;
+use Moo;
+use List::AllUtils qw(all);
+use namespace::clean;
+
+with 'Sietima::MailStore';
+
+has _mails => (
+    is => 'rw',
+    default => sub { +[] },
+);
+
+sub clear { shift->_mails([]) }
+
+sub store {
+    my ($self,$mail,@tags) = @_;
+
+    my $id = time();
+    push @{$self->_mails}, {
+        id => $id,
+        mail => $mail->as_string,
+        tags => { map {$_ => 1;} @tags, },
+    };
+    return $id;
+}
+
+sub retrieve_by_tags {
+    my ($self,@tags) = @_;
+
+    my @ret;
+    for my $m (@{$self->_mails}) {
+        next unless all { $m->{tags}{$_} } @tags;
+        push @ret, {
+            %{$m}{id},
+            mail => Email::MIME->new($m->{mail})
+        };
+    }
+
+    return \@ret;
+}
+
+sub retrieve_by_id {
+    my ($self,$id) = @_;
+
+    for my $m (@{$self->_mails}) {
+        next unless $m->{id} eq $id;
+        return Email::MIME->new($m->{mail});
+    }
+
+    return;
+}
+
+1;
diff --git a/t/tests/sietima/role/subscriberonly/moderate.t b/t/tests/sietima/role/subscriberonly/moderate.t
new file mode 100644
index 0000000..c76e69b
--- /dev/null
+++ b/t/tests/sietima/role/subscriberonly/moderate.t
@@ -0,0 +1,92 @@
+#!perl
+use strict;
+use warnings;
+use 5.020;
+use lib 't/lib';
+use Test::Sietima;
+use Test::Sietima::MailStore;
+
+my @subscriber_addresses = (
+    'one@users.example.com',
+    'two@users.example.com',
+);
+my $admin = 'admin@lists.example.com';
+my $ms = Test::Sietima::MailStore->new();
+my $s = make_sietima(
+    with_traits => ['SubscriberOnly::Moderate'],
+    subscribers => [@subscriber_addresses],
+    admin => $admin,
+    mail_store => $ms,
+);
+
+subtest 'from subscriber' => sub {
+    $ms->clear;
+    test_sending(
+        sietima => $s,
+        mail => { from=>'one@users.example.com' },
+    );
+    is(
+        $ms->retrieve_by_tags('moderation'),
+        [],
+        'no mails held for moderation',
+    );
+};
+
+subtest 'from non-subscriber' => sub {
+    $ms->clear;
+    test_sending(
+        sietima => $s,
+        mail => { from=>'someone@users.example.com' },
+        to => [$admin],
+    );
+
+
+    my @deliveries = transport->deliveries;
+    is(
+        \@deliveries,
+        [
+            hash {
+                field email => object {
+                    call [cast=>'Email::MIME'] => object {
+                        call [header_str => 'subject'] => match qr{\bheld for moderation\b};
+                        call_list parts => [
+                            object {
+                                call body => match qr{Use id \S+ to refer to it};
+                            },
+                            object {
+                                call sub {Email::MIME->new(shift->body)} => object {
+                                    call [header_str => 'subject'] => 'Test Message';
+                                };
+                            },
+                        ];
+                    };
+                };
+            },
+        ],
+        'the original mail should be attached',
+        np @deliveries,
+    );
+
+    is(
+        my $to_moderate = $ms->retrieve_by_tags('moderation'),
+        [
+            {
+                id => T(),
+                mail => object {
+                    call [header_str => 'from'] => 'someone@users.example.com';
+                    call [header_str => 'to'] => $s->return_path->address,
+                },
+            },
+        ],
+        'mails was held for moderation',
+    );
+
+    transport->clear_deliveries;
+    my $msg_id = $to_moderate->[0]->{id};
+    $s->resume($msg_id);
+    deliveries_are(
+        to => \@subscriber_addresses,
+    );
+};
+
+done_testing;