authenticate client tests

5 files changed, 203 insertions, 13 deletions

diff --git a/lib/Net/Hawk/Client.pm b/lib/Net/Hawk/Client.pm
index b35d6d2..2e47897 100644
--- a/lib/Net/Hawk/Client.pm
+++ b/lib/Net/Hawk/Client.pm
@@ -3,12 +3,13 @@ use strict;
 use warnings;
 use 5.010;
 use Moo;
-use Types::Standard 1.000003 qw(Str Int Object Dict Optional Undef Any HasMethods slurpy);
+use Types::Standard 1.000003 qw(Str Int Object Dict Optional Undef Any HashRef HasMethods slurpy);
 use Types::URI qw(Uri);
 use Type::Params qw(compile);
 use Try::Tiny;
 use Net::Hawk::Utils;
 use Session::Token;
+use Net::Hawk::Types qw(HTTPHeaders);
 use Net::Hawk::Role::WithUtils;
 use Net::Hawk::Role::WithCrypto;
 
@@ -88,5 +89,61 @@ sub header {
     };
 }
 
+sub authenticate {
+    state $argcheck = compile(
+        Object,
+        HTTPHeaders,
+        HashRef,
+        Optional[HashRef],
+        Optional[HashRef],
+    );
+    my ($self,$headers,$credentials,$artifacts,$options) = $argcheck->(@_);
+
+    $artifacts //= {}; $options //= {};
+
+    my $www_auth = $headers->header('www-authenticate');
+    if ($www_auth) {
+        my $attributes = try { $self->_utils->parse_authorization_header(
+            $www_auth,[qw(ts tsm error)],
+        ) };
+        return unless $attributes;
+
+        if ($attributes->{ts}) {
+            my $tsm = $self->_crypto->calculate_ts_mac(
+                $attributes->{ts},$credentials,
+            );
+            return unless $tsm eq $attributes->{tsm};
+        }
+    }
+
+    my $serv_auth = $headers->header('server-authorization');
+    return 1 unless $serv_auth || $options->{required};
+
+    my $attributes = try { $self->_utils->parse_authorization_header(
+        $serv_auth,
+        [qw(mac ext hash)],
+    ) };
+    return unless $attributes;
+
+    my $mac = $self->_crypto->calculate_mac(
+        response => $credentials,
+        {
+            %$artifacts,
+            ext => $attributes->{ext},
+            hash => $attributes->{hash},
+        },
+    );
+    return unless $mac eq $attributes->{mac};
+
+    return 1 unless defined $options->{payload};
+    return unless $attributes->{hash};
+
+    my $calculated_hash = $self->_crypto->calculated_payload_hash(
+        $options->{payload},
+        $credentials->{algorithm},
+        scalar $headers->header('content-type'),
+    );
+    return $calculated_hash eq $attributes->{hash};
+}
 
 1;
diff --git a/lib/Net/Hawk/Crypto.pm b/lib/Net/Hawk/Crypto.pm
index 9c53148..e70b210 100644
--- a/lib/Net/Hawk/Crypto.pm
+++ b/lib/Net/Hawk/Crypto.pm
@@ -25,8 +25,8 @@ sub generate_normalized_string {
         port => Int,
         hash => Optional[Str],
         ext => Optional[Str|Undef],
-        app => Optional[Str],
-        dlg => Optional[Str],
+        app => Optional[Str|Undef],
+        dlg => Optional[Str|Undef],
         slurpy Any,
     ]);
     my ($self,$type,$options) = $argcheck->(@_);
@@ -78,16 +78,49 @@ sub calculate_mac {
 
     my $normalized = $self->generate_normalized_string($type,$options);
 
+    return $self->calc_hmac(
+        $normalized,
+        $credentials->{algorithm},
+        $credentials->{key},
+    );
+}
+
+sub calculate_ts_mac {
+    state $argcheck = compile(
+        Object,Int,
+        Dict[
+            algorithm => Algorithm,
+            key => Str,
+            slurpy Any,
+        ],
+    );
+    my ($self,$ts,$credentials) = $argcheck->(@_);
+
+    my $string = sprintf(
+        "hawk.%s.ts\n%d\n",
+        header_version(),
+        $ts,
+    );
+
+    return $self->calc_hmac(
+        $string,
+        $credentials->{algorithm},
+        $credentials->{key},
+    );
+}
+
+sub calc_hmac {
+    state $argcheck = compile(Object,Str,Algorithm,Str);
+    my ($self,$data,$algorithm,$key) = $argcheck->(@_);
+
     state $function_map = {
         sha1 => \&hmac_sha1_base64,
         sha256 => \&hmac_sha256_base64,
     };
 
-    my $mac = $function_map->{$credentials->{algorithm}}->(
-        $normalized,$credentials->{key},
-    );
-
-    return _pad_b64($mac);
+    return _pad_b64($function_map->{$algorithm}->(
+        $data,$key,
+    ));
 }
 
 sub make_digest {
diff --git a/lib/Net/Hawk/Errors.pm b/lib/Net/Hawk/Errors.pm
new file mode 100644
index 0000000..befd142
--- /dev/null
+++ b/lib/Net/Hawk/Errors.pm
@@ -0,0 +1,42 @@
+package Net::Hawk::Errors;
+use strict;
+use warnings;
+use 5.010;
+
+package Net::Hawk::Errors::base {
+    use Moo;
+    use Types::Standard qw(Str);
+    with 'Throwable';
+    use overload
+        q{""}    => 'as_string',
+        fallback => 1;
+
+    has message => (
+        is       => 'ro',
+        isa      => Str,
+        required => 1,
+    );
+
+    sub as_string { $_[0]->message }
+};
+
+package Net::Hawk::Errors::BadRequest {
+    use Moo; extends 'Net::Hawk::Errors::base';
+
+    has value => (is => 'ro');
+
+    sub as_string {
+        my ($self) = @_;
+        return sprintf(
+            '%s (%s)',
+            $self->message,
+            $self->value // '<undef>',
+        );
+    }
+};
+
+package Net::Hawk::Errors::UnAuthorized {
+    use Moo; extends 'Net::Hawk::Errors::base';
+};
+
+1;
diff --git a/lib/Net/Hawk/Types.pm b/lib/Net/Hawk/Types.pm
index e1caec3..8879bb3 100644
--- a/lib/Net/Hawk/Types.pm
+++ b/lib/Net/Hawk/Types.pm
@@ -4,11 +4,17 @@ use warnings;
 use 5.010;
 use Type::Library
     -base,
-    -declare => qw(Algorithm);
+    -declare => qw(Algorithm HTTPHeaders);
 use Type::Utils -all;
-use Types::Standard qw(Str Enum);
+use Types::Standard qw(Str Enum HashRef ArrayRef);
 
 declare Algorithm, as Enum[qw(sha1 sha256)];
 
+class_type HTTPHeaders, { class => 'HTTP::Headers' };
+coerce HTTPHeaders,
+    from HashRef, via { require HTTP::Headers; HTTP::Headers->new(%$_) },
+    from ArrayRef, via { require HTTP::Headers; HTTP::Headers->new(@$_) },
+    ;
+
 1;
 
diff --git a/lib/Net/Hawk/Utils.pm b/lib/Net/Hawk/Utils.pm
index 2b50043..0c5e2fd 100644
--- a/lib/Net/Hawk/Utils.pm
+++ b/lib/Net/Hawk/Utils.pm
@@ -4,9 +4,14 @@ use warnings;
 use Time::HiRes qw(gettimeofday);
 use 5.010;
 use Moo;
+use Types::Standard 1.000003 qw(Str Int Object ArrayRef Optional Undef);
+use Types::URI qw(Uri);
+use Type::Params qw(compile);
+use Net::Hawk::Errors;
 
 sub parse_content_type {
-    my ($self,$header) = @_;
+    state $argcheck = compile(Object,Str|Undef);
+    my ($self,$header) = $argcheck->(@_);
     return '' unless defined $header;
 
     my ($ret) = $header =~ m{^\s*(\S+?)\s*(;|$)};
@@ -14,16 +19,63 @@ sub parse_content_type {
 }
 
 sub now_msecs {
-    my ($self,$offset_ms) = @_;
+    state $argcheck = compile(Object,Int);
+    my ($self,$offset_ms) = $argcheck->(@_);
 
     my ($sec,$usec) = gettimeofday;
     return $sec + int($usec/1000) + $offset_ms//0;
 }
 
 sub now_secs {
-    my ($self,$offset_ms) = @_;
+    state $argcheck = compile(Object,Int);
+    my ($self,$offset_ms) = $argcheck->(@_);
 
     return int(now_msecs($offset_ms)/1000);
 }
 
+sub parse_authorization_header {
+    state $argcheck = compile(Object,Str|Undef,Optional[ArrayRef]);
+    my ($self,$header,$keys) = $argcheck->(@_);
+    $keys //= [qw(id ts nonce hash ext mac app dlg)];
+    my %valid_keys; @valid_keys{@$keys}=();
+
+    Net::Hawk::Errors::UnAuthorized->throw(message=>'no header')
+          unless $header;
+    my ($attr_string) = $header =~ m{^hawk(?:\s+(.+))?$}i
+        or Net::Hawk::Errors::BadRequest->throw(
+            message => 'invalid header syntax',
+            value => $header,
+        );
+
+    my %attributes;
+
+    my @attr_strings = split /\s*,\s*/, $attr_string;
+    for my $attr (@attr_strings) {
+        my ($key,$value) = $attr =~ m{^(\w+)="([^"\\]*)"}
+            or Net::Hawk::Errors::BadRequest->throw(
+                message => 'Bad header format',
+                value => $header,
+            );
+
+        Net::Hawk::Errors::BadRequest->throw(
+            message => "Unknown attribute $key",
+            value => $header,
+        ) unless exists $valid_keys{$key};
+
+        Net::Hawk::Errors::BadRequest->throw(
+            message => "Bad attribute value $value",
+            value => $header,
+        ) unless $value =~ m{^[ \w\!#\$%&'\(\)\*\+,\-\.\/\:;<\=>\?@\[\]\^`\{\|\}~]+$};
+
+        Net::Hawk::Errors::BadRequest->throw(
+            message => "Duplicate attribute $key",
+            value => $header,
+        ) if exists $attributes{$key};
+
+        $attributes{$key}=$value;
+    }
+
+    return \%attributes;
+}
+
 1;