stricter type for tag names

we really don't want to tag something "../foo/bar"!

2 files changed, 12 insertions, 4 deletions

diff --git a/lib/Sietima/MailStore/FS.pm b/lib/Sietima/MailStore/FS.pm
index 6f872c1..d4e6ec1 100644
--- a/lib/Sietima/MailStore/FS.pm
+++ b/lib/Sietima/MailStore/FS.pm
@@ -4,7 +4,7 @@ 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);
+use Sietima::Types qw(EmailMIME TagName);
 use Digest::SHA1 qw(sha1_hex);
 use namespace::clean;
 
@@ -32,7 +32,7 @@ sub clear($self) {
 }
 
 sub store($self,$mail,@tags) {
-    state $check = compile(Object,EmailMIME,slurpy ArrayRef[Str]);$check->(@_);
+    state $check = compile(Object,EmailMIME,slurpy ArrayRef[TagName]);$check->(@_);
 
     my $str = $mail->as_string;
     my $id = sha1_hex($str);
@@ -59,7 +59,7 @@ sub _tagged_by($self,$tag) {
 }
 
 sub retrieve_ids_by_tags($self,@tags) {
-    state $check = compile(Object,slurpy ArrayRef[Str]);$check->(@_);
+    state $check = compile(Object,slurpy ArrayRef[TagName]);$check->(@_);
 
     my %msgs;
     if (@tags) {
@@ -80,7 +80,7 @@ sub retrieve_ids_by_tags($self,@tags) {
 }
 
 sub retrieve_by_tags($self,@tags) {
-    state $check = compile(Object,slurpy ArrayRef[Str]);$check->(@_);
+    state $check = compile(Object,slurpy ArrayRef[TagName]);$check->(@_);
 
     my @ret;
     for my $id ($self->retrieve_ids_by_tags(@tags)->@*) {
diff --git a/lib/Sietima/Types.pm b/lib/Sietima/Types.pm
index 3addf46..49312b4 100644
--- a/lib/Sietima/Types.pm
+++ b/lib/Sietima/Types.pm
@@ -7,6 +7,7 @@ use Type::Library
     -base,
     -declare => qw(SietimaObj
                    Address AddressFromStr
+                   TagName
                    EmailMIME Message
                    Subscriber SubscriberFromAddress SubscriberFromStr SubscriberFromHashRef
                    Transport MailStore MailStoreFromHashRef);
@@ -28,6 +29,13 @@ declare_coercion AddressFromStr,
     to_type Address, from Str,
     q{ (Email::Address->parse($_))[0] };
 
+declare TagName, as Str,
+    where { /\A\w+\z/ },
+    inline_as sub($constraint,$varname,@){
+        $constraint->parent->inline_check($varname)
+            .qq{ && ($varname =~/\\A\\w+\\z/) };
+    };
+
 class_type Message, { class => 'Sietima::Message' };
 
 class_type Subscriber, { class => 'Sietima::Subscriber' };