package Sietima::MailStore::FS;
use Moo;
use Sietima::Policy;
use Types::Path::Tiny qw(Dir);
use Types::Standard qw(Object ArrayRef Str slurpy);
use Type::Params qw(compile);
use Sietima::Types qw(EmailMIME TagName);
use Digest::SHA qw(sha1_hex);
use namespace::clean;

# VERSION
# ABSTRACT: filesystem-backed email store

=head1 SYNOPSIS

  my $store = Sietima::MailStore::FS->new({ root => '/tmp/my-store' });

=head1 DESCRIPTION

This class implements the L<< C<Sietima::MailStore> >> interface,
storing emails as files on disk.

=cut

with 'Sietima::MailStore';

=attr C<root>

Required, a L<< C<Path::Tiny> >> object that points to an existing
directory. Coercible from a string.

It's a good idea for the directory to be readable and writable by the
user who will run the mailing list, and also by all users who will run
administrative commands (like those provided by L<<
C<Sietima::Role::SubscriberOnly::Moderate> >>). A way to achieve that
is to have a group dedicated to list owners, and set the directory
group-writable and group-sticky, and owned by that group:

  # chgrp-R mailinglists /tmp/my-store
  # chmod -R g+rwXs /tmp/my-store

=for Pod::Coverage BUILD

=cut

has root => (
    is => 'ro',
    required => 1,
    isa => Dir,
    coerce => 1,
);

has [qw(_tagdir _msgdir)] => ( is => 'lazy' );
sub _build__tagdir($self) { $self->root->child('tags') }
sub _build__msgdir($self) { $self->root->child('msgs') }

sub BUILD($self,@) {
    $self->$_->mkpath for qw(_tagdir _msgdir);
    return;
}

=method C<store>

  my $id = $store->store($email_mime_object,@tags);

Stores the given email message inside the L<store root|/root>, and
associates with the given tags.

Returns a unique identifier for the stored message. If you store twice
the same message (or two messages that stringify identically), you'll
get the same identifier.

=cut

sub store($self,$mail,@tags) {
    state $check = compile(Object,EmailMIME,slurpy ArrayRef[TagName]);$check->(@_);

    my $str = $mail->as_string;
    my $id = sha1_hex($str);

    $self->_msgdir->child($id)->spew_raw($str);

    $self->_tagdir->child($_)->append("$id\n") for @tags;

    return $id;
}

=method C<retrieve_by_id>

  my $email_mime_object = $store->retrieve_by_id($id);

Given an identifier returned by L<< /C<store> >>, this method returns
the email message.

If the message has been deleted, or the identifier is not recognised,
this method returns C<undef> in scalar context, or an empty list in
list context.

=cut

sub retrieve_by_id($self,$id) {
    state $check = compile(Object,Str);$check->(@_);

    my $msg_path = $self->_msgdir->child($id);
    return unless -e $msg_path;
    return Email::MIME->new($msg_path->slurp_raw);
}

=method C<retrieve_ids_by_tags>

  my @ids = $store->retrieve_ids_by_tags(@tags)->@*;

Given a list of tags, this method returns an arrayref containing the
identifiers of all (and only) the messages that were stored associated
with (at least) all those tags. The order of the returned identifiers
is essentially random.

If there are no messages associated with the given tags, this method
returns an empty arrayref.

=cut

sub _tagged_by($self,$tag) {
    my $tag_file = $self->_tagdir->child($tag);
    return unless -e $tag_file;
    return $tag_file->lines({chomp=>1});
}

sub retrieve_ids_by_tags($self,@tags) {
    state $check = compile(Object,slurpy ArrayRef[TagName]);$check->(@_);

    # this maps: id -> how many of the given @tags it has
    my %msgs;
    if (@tags) {
        for my $tag (@tags) {
            $_++ for @msgs{$self->_tagged_by($tag)};
        }
    }
    else {
        $msgs{$_->basename}=0 for $self->_msgdir->children;
    }

    my @ret;
    for my $id (keys %msgs) {
        # if this message id does not have all the required tags, we
        # won't return it
        next unless $msgs{$id} == @tags;
        push @ret, $id;
    }
    return \@ret;
}

=method C<retrieve_by_tags>

  my @email_mime_objects = $store->retrieve_by_tags(@tags)->@*;

This method is similar to L<< /C<retrieve_ids_by_tags> >>, but it
returns an arrayref of hashrefs like:

 $store->retrieve_ids_by_tags('t1') ==> [
   { id => $id1, mail => $msg1 },
   { id => $id2, mail => $msg2 },
  ]

=cut

sub retrieve_by_tags($self,@tags) {
    state $check = compile(Object,slurpy ArrayRef[TagName]);$check->(@_);

    my @ret;
    for my $id ($self->retrieve_ids_by_tags(@tags)->@*) {
        push @ret, {
            id => $id,
            mail => $self->retrieve_by_id($id),
        };
    }

    return \@ret;
}

=method C<remove>

  $store->remove($id);

This method removes the message corresponding to the given identifier
from disk. Removing a non-existent message does nothing.

=cut

sub remove($self,$id) {
    state $check = compile(Object,Str);$check->(@_);

    for my $tag_file ($self->_tagdir->children) {
        $tag_file->edit_lines( sub { $_='' if /\A\Q$id\E\n?\z/ } );
    }
    $self->_msgdir->child($id)->remove;

    return;
}

=method C<clear>

  $store->clear();

This method removes all messages from disk. Clearing as empty store
does nothing.


=cut

sub clear($self) {
    do { $self->$_->remove_tree;$self->$_->mkpath } for qw(_tagdir _msgdir);
    return;
}

1;