all 'header' tests passing

3 files changed, 141 insertions, 155 deletions

diff --git a/lib/Net/Hawk/Client.pm b/lib/Net/Hawk/Client.pm
index 2e47897..a543422 100644
--- a/lib/Net/Hawk/Client.pm
+++ b/lib/Net/Hawk/Client.pm
@@ -1,93 +1,88 @@
-package Net::Hawk::Client;
-use strict;
-use warnings;
-use 5.010;
-use Moo;
-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;
-
-with WithUtils(qw(now_secs));
-with WithCrypto(qw(calculate_payload_hash));
-
-sub header {
-    state $argcheck = compile(Object,Uri,Str,Dict[
-        timestamp => Optional[Int],
-        localtime_offset_msec => Optional[Int],
-        credentials => Dict[
-            id => Str,
-            key => Str,
-            algorithm => Str,
-        ],
-        nonce => Optional[Str],
-        hash => Optional[Str],
-        ext => Optional[Str|Undef],
-        app => Optional[Str],
-        dlg => Optional[Str],
-        payload => Optional[Str],
-        content_type => Optional[Str],
-        slurpy Any,
-    ]);
-    my ($self,$uri,$method,$options) = $argcheck->(@_);
-
-    my $timestamp = $options->{timestamp} //
-        $self->_utils->now_secs($options->{localtime_offset_msec});
-
-    my $credentials = $options->{credentials};
-
-    my %artifacts = (
-        ts => $timestamp,
-        nonce => $options->{nonce} || Session::Token->new->get,
-        method => $method,
-        resource => $uri->path_query,
-        host => $uri->host,
-        port => $uri->port // ($uri->scheme eq 'http:' ? 80 : 443),
-    );
-    for my $k (qw(hash ext app dlg)) {
-        next unless defined $options->{$k};
-        $artifacts{$k} = $options->{$k};
-    }
-
-    if ( !$artifacts{hash} && defined $options->{payload} ) {
-        $artifacts{hash} = $self->_crypto->calculate_payload_hash(
-            $options->{payload},
-            $credentials->{algorithm},
-            $options->{content_type},
+package Net::Hawk::Client {
+    use v6;
+    use URI;
+    use Net::Hawk::Utils;
+    use Net::Hawk::Crypto;
+
+    our proto header(*@,*%) returns Hash {*};
+    multi header(Str:D $uri!,*@pos,*%nam) returns Hash {
+        return header(URI.new($uri),|@pos,|%nam);
+    };
+    multi header(
+      URI:D $uri!,
+      Str:D $method!,
+        Int :$timestamp,
+        Int :$localtime_offset_msec,
+        Hash:D :$credentials (
+            Str:D :id($),
+            Str:D :key($),
+            Str:D :algorithm($),
+        ),
+        Str :$nonce,
+        Str :$hash,
+        Str :$ext,
+        Str :$app,
+        Str :$dlg,
+        Str :$payload,
+        Str :$content_type,
+        *%,
+    ) returns Hash {
+        $timestamp //= now_secs($localtime_offset_msec);
+
+        my %artifacts = (
+            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),
         );
-    }
-
-    my $mac = $self->_crypto->calculate_mac(header=>$credentials,\%artifacts);
+        for <hash ext app dlg> -> $k {
+            next unless defined $::($k);
+            %artifacts{$k} = $::($k);
+        }
 
-    my $has_ext = ($options->{ext}//'') ne '';
+        if ( !%artifacts<hash> && defined $payload ) {
+            %artifacts<hash> = calculate_payload_hash(
+                $payload,
+                $credentials<algorithm>,
+                $content_type,
+            );
+        }
 
-    my $header = sprintf(
-        'Hawk id="%s", ts="%d", nonce="%s"',
-        $credentials->{id},
-        $artifacts{ts},
-        $artifacts{nonce},
-    )
-        . ($artifacts{hash} ? sprintf(', hash="%s"',$artifacts{hash}) : '')
-        . ($has_ext ? sprintf(', ext="%s"', $artifacts{ext} =~ s{([\\"])}{\\$1}gr) : '' )
-        . sprintf(', mac="%s"',$mac);
+        my $mac = calculate_mac(
+            'header',
+            $credentials,
+            %artifacts,
+        );
 
-    if ($artifacts{app}) {
-        $header .= sprintf(', app="%s"', $artifacts{app});
-        if ($artifacts{dlg}) {
-            $header .= sprintf(', dlg="%s"',$artifacts{dlg});
+        my $has_ext = ($ext//'') ne '';
+
+        my $header = sprintf(
+            'Hawk id="%s", ts="%d", nonce="%s"',
+            $credentials<id>,
+            %artifacts<ts>,
+            %artifacts<nonce>,
+        )
+        ~ (%artifacts<hash> ?? sprintf(', hash="%s"',%artifacts<hash>) !! '')
+        ~ ($has_ext ?? sprintf(', ext="%s"', %artifacts<ext>.trans(['\\','"']=>['\\\\','\\"']) ) !! '' )
+        ~ sprintf(', mac="%s"',$mac);
+
+        if (%artifacts<app>) {
+            $header .= sprintf(', app="%s"', %artifacts<app>);
+            if (%artifacts<dlg>) {
+                $header .= sprintf(', dlg="%s"',%artifacts<dlg>);
+            }
         }
+
+        return {
+            field => $header,
+            artifacts => %artifacts,
+        };
     }
+};
 
-    return {
-        field => $header,
-        artifacts => \%artifacts,
-    };
-}
+=begin finish
 
 sub authenticate {
     state $argcheck = compile(
diff --git a/lib/Net/Hawk/Crypto.pm b/lib/Net/Hawk/Crypto.pm
index e73cc82..1cd5a8d 100644
--- a/lib/Net/Hawk/Crypto.pm
+++ b/lib/Net/Hawk/Crypto.pm
@@ -68,31 +68,34 @@ package Net::Hawk::Crypto {
                                    parse_content_type($content_type),
                                    $payload)));
     };
-}
 
-=begin finish
+    sub calc_hmac(
+      Str:D $data,
+      Str:D $algorithm,
+      Str:D $key,
+    ) returns Str {
+        my $hash_function = digest_for($algorithm);
+        return MIME::Base64.encode(
+            hmac($key,$data,$hash_function)
+        );
+    }
 
-sub calculate_mac {
-    state $argcheck = compile(
-        Object,Str,
-        Dict[
-            algorithm => Algorithm,
-            key => Str,
-            slurpy Any,
-        ],
-        HashRef,
-    );
-    my ($self,$type,$credentials,$options) = $argcheck->(@_);
+    sub calculate_mac(
+      Str:D $type,
+      Hash:D $credentials ( Str :$algorithm, Str :$key, *% ),
+      Hash:D $options
+    ) returns Str is export {
+        my $normalized = generate_normalized_string(:$type,|$options);
 
-    my $normalized = $self->generate_normalized_string($type,$options);
+        return calc_hmac(
+            $normalized,
+            $algorithm,
+            $key,
+        );
+    }
 
-    return $self->calc_hmac(
-        $normalized,
-        $credentials->{algorithm},
-        $credentials->{key},
-    );
 }
-
+=begin finish
 sub calculate_ts_mac {
     state $argcheck = compile(
         Object,Int,
@@ -117,20 +120,6 @@ sub calculate_ts_mac {
     );
 }
 
-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,
-    };
-
-    return _pad_b64($function_map->{$algorithm}->(
-        $data,$key,
-    ));
-}
-
 sub make_digest {
     state $argcheck = compile(Object,Algorithm);
     my ($self,$algorithm) = $argcheck->(@_);
diff --git a/t/tests/Net/Hawk/Client.t b/t/tests/Net/Hawk/Client.t
index 6a09c1e..784b7a0 100644
--- a/t/tests/Net/Hawk/Client.t
+++ b/t/tests/Net/Hawk/Client.t
@@ -1,30 +1,28 @@
 #!perl
-use strict;
-use warnings;
-use Test::More;
+use v6;
+use Test;
 use Net::Hawk::Client;
+use Net::Hawk::Crypto;
 
-my $c = Net::Hawk::Client->new();
-
-subtest readme => sub {
+subtest {
     my %credentials = (
         id => 'dh37fgj492je',
         key => 'werxhqb98rpaxn39848xrunpaw3489ruxnpa98w4rxn',
         algorithm => 'sha256',
     );
     my %options = (
-        credentials => \%credentials,
+        credentials => %credentials,
         timestamp => 1353832234,
         nonce => 'j4h3g2',
         ext => 'some-app-ext-data'
     );
 
-    subtest GET => sub {
-        my $field = $c->header(
+    subtest {
+        my $field = Net::Hawk::Client::header(
             'http://example.com:8000/resource/1?b=1&a=2',
             'GET',
-            \%options,
-        )->{field};
+            |%options,
+        )<field>;
 
         is(
             $field,
@@ -33,15 +31,15 @@ subtest readme => sub {
         );
     };
 
-    subtest POST => sub {
-        $options{payload} = 'Thank you for flying Hawk';
-        $options{content_type} = 'text/plain';
+    subtest {
+        %options<payload> = 'Thank you for flying Hawk';
+        %options<content_type> = 'text/plain';
 
-        my $field = $c->header(
+        my $field = Net::Hawk::Client::header(
             'http://example.com:8000/resource/1?b=1&a=2',
             'POST',
-            \%options,
-        )->{field};
+            |%options,
+        )<field>;
 
         is(
             $field,
@@ -51,7 +49,7 @@ subtest readme => sub {
     };
 };
 
-subtest header => sub {
+subtest {
     my $uri = 'http://example.net/somewhere/over/the/rainbow';
     my $uri_s = 'https://example.net/somewhere/over/the/rainbow';
     my %args = (
@@ -66,59 +64,63 @@ subtest header => sub {
         payload => 'something to write about',
     );
 
-    my $header = $c->header($uri,POST => \%args);
+    my $header = Net::Hawk::Client::header($uri,'POST',|%args);
     is(
-        $header->{field},
+        $header<field>,
         'Hawk id="123456", ts="1353809207", nonce="Ygvqdz", hash="bsvY3IfUllw6V5rvk4tStEvpBhE=", ext="Bazinga!", mac="qbf1ZPG/r/e06F4ht+T77LXi5vw="',
         'valid authorization header (sha1)',
     );
 
-    $args{credentials}{algorithm}='sha256';
-    $args{content_type} = 'text/plain';
-    $header = $c->header($uri_s,POST => \%args);
+    %args<credentials><algorithm>='sha256';
+    %args<content_type> = 'text/plain';
+    $header = Net::Hawk::Client::header($uri_s,'POST',|%args);
     is(
-        $header->{field},
+        $header<field>,
         'Hawk id="123456", ts="1353809207", nonce="Ygvqdz", hash="2QfCt3GuY9HQnHWyWD3wX68ZOKbynqlfYmuO2ZBRqtY=", ext="Bazinga!", mac="q1CwFoSHzPZSkbIvl0oYlD+91rBUEvFk763nMjMndj8="',
         'valid authorization header (sha256)',
     );
 
-    delete $args{ext};
-    $header = $c->header($uri_s,POST => \%args);
+    %args<ext> :delete;
+    $header = Net::Hawk::Client::header($uri_s,'POST',|%args);
     is(
-        $header->{field},
+        $header<field>,
         'Hawk id="123456", ts="1353809207", nonce="Ygvqdz", hash="2QfCt3GuY9HQnHWyWD3wX68ZOKbynqlfYmuO2ZBRqtY=", mac="HTgtd0jPI6E4izx8e4OHdO36q00xFCU0FolNq3RiCYs="',
         'valid authorization header (no ext)',
     );
 
-    $args{ext}=undef;
-    $header = $c->header($uri_s,POST => \%args);
+    %args<ext>=Str;
+    $header = Net::Hawk::Client::header($uri_s,'POST',|%args);
     is(
-        $header->{field},
+        $header<field>,
         'Hawk id="123456", ts="1353809207", nonce="Ygvqdz", hash="2QfCt3GuY9HQnHWyWD3wX68ZOKbynqlfYmuO2ZBRqtY=", mac="HTgtd0jPI6E4izx8e4OHdO36q00xFCU0FolNq3RiCYs="',
         'valid authorization header (null ext)',
     );
 
-    $args{payload}='';
-    $header = $c->header($uri_s,POST => \%args);
+    %args<payload>='';
+    $header = Net::Hawk::Client::header($uri_s,'POST',|%args);
     is(
-        $header->{field},
+        $header<field>,
         'Hawk id="123456", ts="1353809207", nonce="Ygvqdz", hash="q/t+NNAkQZNlq/aAD6PlexImwQTxwgT2MahfTa9XRLA=", mac="U5k16YEzn3UnBHKeBzsDXn067Gu3R4YaY6xOt9PYRZM="',
         'valid authorization header (empty payload)',
     );
 
-    $args{hash} = $c->_crypto->calculate_payload_hash(
+    %args<hash> = calculate_payload_hash(
         'something to write about',
-        $args{credentials}{algorithm},
-        $args{content_type},
+        %args<credentials><algorithm>,
+        %args<content_type>,
     );
-    $header = $c->header($uri_s,POST => \%args);
+    $header = Net::Hawk::Client::header($uri_s,'POST',|%args);
     is(
-        $header->{field},
+        $header<field>,
         'Hawk id="123456", ts="1353809207", nonce="Ygvqdz", hash="2QfCt3GuY9HQnHWyWD3wX68ZOKbynqlfYmuO2ZBRqtY=", mac="HTgtd0jPI6E4izx8e4OHdO36q00xFCU0FolNq3RiCYs="',
         'valid authorization header (pre hashed payload)',
     );
 };
 
+done;
+
+=begin finish
+
 subtest authenticate => sub {
     ok(
         ! $c->authenticate([