Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion lib/Net/SAML2/Role/ProtocolMessage.pm
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@ use namespace::autoclean;
use DateTime;
use MooseX::Types::URI qw/ Uri /;
use Net::SAML2::Util qw(generate_id);
use Net::SAML2::Types qw(XsdID);

=head1 NAME

Expand All @@ -28,7 +29,7 @@ implementation.
=cut

has id => (
isa => 'Str',
isa => XsdID,
is => 'ro',
builder => "_build_id"
);
Expand Down
15 changes: 15 additions & 0 deletions lib/Net/SAML2/Types.pm
Original file line number Diff line number Diff line change
Expand Up @@ -9,13 +9,28 @@ use strict;
use Types::Serialiser;
use MooseX::Types -declare => [
qw(
XsdID
SAMLRequestType
signingAlgorithm
)
];

use MooseX::Types::Moose qw(Str Int Num Bool ArrayRef HashRef Item);

=head2 XsdID

The type xsd:ID is used for an attribute that uniquely identifies an element in an XML document. An xsd:ID value must be an NCName. This means that it must start with a letter or underscore, and can only contain letters, digits, underscores, hyphens, and periods.

=cut

subtype XsdID, as Str,
where {
return 0 unless $_ =~ /^[a-zA-Z_]/;
return 0 if $_ =~ /[^a-zA-Z0-9_\.\-]/;
return 1;
},
message { "'$_' is not a valid xsd:ID" };

=head2 SAMLRequestType

Enum which consists of two options: SAMLRequest and SAMLResponse
Expand Down
51 changes: 51 additions & 0 deletions t/22-types.t
Original file line number Diff line number Diff line change
@@ -0,0 +1,51 @@
use strict;
use warnings;
use Test::Lib;
use Test::Net::SAML2;
use Net::SAML2::Types qw(XsdID SAMLRequestType signingAlgorithm);

subtest 'XsdID' => sub {
my @xsdidok = qw(thisiscorrect _so_it_this THISTOO _YES this.-123.correct);
foreach (@xsdidok) {
ok(XsdID->check($_), "$_ is correct as an xsd:ID");
}

ok(!XsdID->check("1abc"), "... and this is not a correct xsd:ID");
like(
XsdID->get_message("1abc"),
qr/is not a valid xsd:ID/,
".. with the correct error message"
);

ok(!XsdID->check('asb#'), "... not an allowed character");

};

subtest 'SAMLRequestType' => sub {

foreach (qw(SAMLRequest SAMLResponse)) {
ok(SAMLRequestType->check($_), "$_ is correct SAMLRequestType");
}
ok(!SAMLRequestType->check("foo"), ".. and this is not");
like(
SAMLRequestType->get_message("foo"),
qr/is not a SAML Request type/,
".. with the correct error message"
);
};

subtest 'signingAlgorithm' => sub {

foreach (qw(sha244 sha256 sha384 sha512 sha1)) {
ok(signingAlgorithm->check($_), "$_ is correct signingAlgorithm");
}

ok(!signingAlgorithm->check("shafake"), ".. and this is not");
like(
signingAlgorithm->get_message("shafake"),
qr/is not a supported signingAlgorithm/,
".. with the correct error message"
);
};

done_testing;