everything ported to p6

4 files changed, 100 insertions, 124 deletions

diff --git a/lib/Net/Hawk/Client.pm b/lib/Net/Hawk/Client.pm
index a543422..2a9d4c9 100644
--- a/lib/Net/Hawk/Client.pm
+++ b/lib/Net/Hawk/Client.pm
@@ -30,12 +30,12 @@ package Net::Hawk::Client {
         $timestamp //= now_secs($localtime_offset_msec);
 
         my %artifacts = (
-            ts => $timestamp,
-            nonce => $nonce // ['a'..'z','A'..'Z',0..9].pick(6).join(''),
+            ts => +($timestamp),
+            nonce => $nonce // ['a'..'z','A'..'Z','_',0..9].pick(6).join(''),
             method => $method,
             resource => $uri.path_query,
             host => $uri.host,
-            port => $uri.port // ($uri.scheme eq 'http:' ?? 80 !! 443),
+            port => +($uri.port) // ($uri.scheme eq 'http:' ?? 80 !! 443),
         );
         for <hash ext app dlg> -> $k {
             next unless defined $::($k);
@@ -80,65 +80,70 @@ package Net::Hawk::Client {
             artifacts => %artifacts,
         };
     }
-};
-
-=begin finish
-
-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 sub get_header(Str:D $key, @headers) returns Str {
+            @headers \
+                ==> grep { .key eq $key } \
+                ==> map { .value } \
+                ==> join ',';
         }
-    }
+        our sub authenticate(
+          Array:D $headers,
+          Hash:D $credentials,
+            Hash $artifacts?,
+            Hash $options?,
+        ) returns Bool {
+
+            my $www_auth = get_header('www-authenticate',$headers);
+
+            if ($www_auth) {
+                my $attributes;
+                try {
+                    $attributes = parse_authorization_header(
+                        $www_auth,<ts tsm error>,
+                    );
+                    CATCH { default { return False } }
+                };
+
+                if ($attributes<ts>) {
+                    my $tsm = calculate_ts_mac(
+                        +$attributes<ts>,$credentials,
+                    );
+                    return False 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};
-}
+            my $serv_auth = get_header('server-authorization',$headers);
+            return True unless $serv_auth || $options<required>;
+
+            my $attributes;
+            try {
+                $attributes = parse_authorization_header(
+                    $serv_auth,
+                    <mac ext hash>,
+                );
+                CATCH { default { return False } }
+            };
+
+            my $mac = calculate_mac(
+                'response',
+                $credentials,
+                %(
+                    %$artifacts,
+                    ext => $attributes<ext>,
+                    hash => $attributes<hash>,
+                ),
+            );
+            return False unless $mac eq $attributes<mac>;
 
-1;
+            return True unless defined $options<payload>;
+            return False unless $attributes<hash>;
+
+            my $calculated_hash = calculate_payload_hash(
+                $options<payload>,
+                $credentials<algorithm>,
+                get_header('content-type',$headers),
+            );
+            return $calculated_hash eq $attributes<hash>;
+        };
+}
diff --git a/lib/Net/Hawk/Crypto.pm b/lib/Net/Hawk/Crypto.pm
index 1cd5a8d..240a6f7 100644
--- a/lib/Net/Hawk/Crypto.pm
+++ b/lib/Net/Hawk/Crypto.pm
@@ -14,7 +14,7 @@ package Net::Hawk::Crypto {
     };
     multi generate_normalized_string(
         Str:D :$type!,
-        URI:D :$resource!,
+        URI :$resource,
         Int:D :$ts!,
         Str:D :$nonce!,
         Str :$method,
@@ -32,7 +32,7 @@ package Net::Hawk::Crypto {
           $ts,
           $nonce,
           uc($method // ''),
-          $resource.path_query,
+          ( $resource ?? $resource.path_query !! ''),
           lc($host),
           $port,
           $hash // '',
@@ -86,52 +86,29 @@ package Net::Hawk::Crypto {
       Hash:D $options
     ) returns Str is export {
         my $normalized = generate_normalized_string(:$type,|$options);
+        CATCH { warn $type;warn $options.perl;die $_ }
 
         return calc_hmac(
             $normalized,
             $algorithm,
             $key,
         );
-    }
-
-}
-=begin finish
-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 make_digest {
-    state $argcheck = compile(Object,Algorithm);
-    my ($self,$algorithm) = $argcheck->(@_);
-
-    return Digest::SHA->new($algorithm =~ s{^sha}{}r);
-}
+    };
 
-sub _pad_b64 {
-    my ($b64) = @_;
+    sub calculate_ts_mac(
+      Int:D $ts,
+      Hash:D $credentials ( Str :$algorithm, Str :$key, *% ),
+    ) returns Str is export {
+        my $string = sprintf(
+            "hawk.%s.ts\n%d\n",
+            header_version(),
+            $ts,
+        );
 
-    $b64 .= '=' while length($b64) % 4;
-    return $b64;
+        return calc_hmac(
+            $string,
+            $algorithm,
+            $key,
+        );
+    }
 }
-
-1;
diff --git a/lib/Net/Hawk/Utils.pm b/lib/Net/Hawk/Utils.pm
index 76478df..bf81b10 100644
--- a/lib/Net/Hawk/Utils.pm
+++ b/lib/Net/Hawk/Utils.pm
@@ -53,7 +53,7 @@ package Net::Hawk::Utils {
               Net::Hawk::Errors::BadRequest.new(
                 text => "Bad attribute value $value",
                 value => $header,
-              ).throw unless $value ~~ m{^<[ \w !#$%&'()*+,\-./:;\<=\>?@\[\]^`{|}~ ]>+$};
+              ).throw unless $value ~~ m{^<[ \w \  !#$%&'()*+,\-./:;\<=\>?@\[\]^`{|}~ ]>+$};
 
               Net::Hawk::Errors::BadRequest.new(
                 text => "Duplicate attribute $key",
diff --git a/t/tests/Net/Hawk/Client.t b/t/tests/Net/Hawk/Client.t
index 784b7a0..ca8476d 100644
--- a/t/tests/Net/Hawk/Client.t
+++ b/t/tests/Net/Hawk/Client.t
@@ -117,13 +117,9 @@ subtest {
     );
 };
 
-done;
-
-=begin finish
-
-subtest authenticate => sub {
+subtest {
     ok(
-        ! $c->authenticate([
+        ! Net::Hawk::Client::authenticate([
             'server-authorization' => 'Hawk mac="abc", bad="xyz"',
         ],{}),
         'returns false on invalid header',
@@ -132,14 +128,12 @@ subtest authenticate => sub {
     my %artifacts = (
         method => 'POST',
         host => 'example.com',
-        port => '8080',
+        port => 8080,
         resource => '/resource/4?filter=a',
-        ts => '1362336900',
+        ts => 1362336900,
         nonce => 'eb5S_L',
         hash => 'nJjkVtBE5Y/Bk38Aiokwn0jiJxt/0S2WRSUwWLCf5xk=',
         ext => 'some-app-data',
-        app => undef,
-        dlg => undef,
         mac => 'BlmSe8K+pbKIb6YsZCnt4E1GrYvY1AaYayNR82dGpIk=',
         id => '123456',
     );
@@ -152,41 +146,41 @@ subtest authenticate => sub {
     );
 
     ok(
-        ! $c->authenticate([
+        ! Net::Hawk::Client::authenticate([
             'content-type' => 'text/plain',
             'server-authorization' => 'Hawk mac="_IJRsMl/4oL+nn+vKoeVZPdCHXB4yJkNnBbTbHFZUYE=", hash="f9cDF/TDm7TkYRLnGwRMfeDzT6LixQVLvrIKhh0vgmM=", ext="response-specific"',
-        ],\%credentials,\%artifacts),
+        ],%credentials,%artifacts),
         'returns false on invalid mac',
     );
 
     ok(
-        $c->authenticate([
+        Net::Hawk::Client::authenticate([
             'content-type' => 'text/plain',
             'server-authorization' => 'Hawk mac="XIJRsMl/4oL+nn+vKoeVZPdCHXB4yJkNnBbTbHFZUYE=", hash="f9cDF/TDm7TkYRLnGwRMfeDzT6LixQVLvrIKhh0vgmM=", ext="response-specific"',
-        ],\%credentials,\%artifacts),
+        ],%credentials,%artifacts),
         'returns true on ignoring hash',
     );
 
     ok(
-        ! $c->authenticate([
+        ! Net::Hawk::Client::authenticate([
             'www-authenticate' => 'Hawk ts="1362346425875", tsm="PhwayS28vtnn3qbv0mqRBYSXebN/zggEtucfeZ620Zo=", x="Stale timestamp"',
         ],{}),
         'fails on invalid WWW-Authenticate header format',
     );
 
     ok(
-        ! $c->authenticate([
+        ! Net::Hawk::Client::authenticate([
             'www-authenticate' => 'Hawk ts="1362346425875", tsm="hwayS28vtnn3qbv0mqRBYSXebN/zggEtucfeZ620Zo=", error="Stale timestamp"',
-        ],\%credentials),
+        ],%credentials),
         'fails on invalid WWW-Authenticate header format',
     );
 
     ok(
-        $c->authenticate([
+        Net::Hawk::Client::authenticate([
             'www-authenticate' => 'Hawk error="Stale timestamp"',
         ],{}),
         'skips tsm validation when missing ts',
     );
 };
 
-done_testing();
+done;