first client tests passing

7 files changed, 258 insertions, 9 deletions

diff --git a/lib/Net/Hawk/Client.pm b/lib/Net/Hawk/Client.pm
new file mode 100644
index 0000000..deec11d
--- /dev/null
+++ b/lib/Net/Hawk/Client.pm
@@ -0,0 +1,92 @@
+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 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::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],
+        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},
+        );
+    }
+
+    my $mac = $self->_crypto->calculate_mac(header=>$credentials,\%artifacts);
+
+    my $has_ext = ($options->{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} =~ s{([\\"])}{\\$1}gr) : '' )
+        . 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,
+    };
+}
+
+
+1;
diff --git a/lib/Net/Hawk/Crypto.pm b/lib/Net/Hawk/Crypto.pm
index a730ca6..57ac4bc 100644
--- a/lib/Net/Hawk/Crypto.pm
+++ b/lib/Net/Hawk/Crypto.pm
@@ -3,12 +3,15 @@ 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 HasMethods HashRef slurpy);
 use Types::URI qw(Uri);
 use Type::Params qw(compile);
 use Try::Tiny;
-use Net::Hawk::Utils;
 use Digest;
+use Digest::HMAC;
+use Net::Hawk::Role::WithUtils;
+
+with WithUtils(qw(parse_content_type));
 
 sub header_version() { 1 }
 
@@ -53,7 +56,7 @@ sub generate_normalized_string {
 }
 
 sub calculate_payload_hash {
-    state $argcheck = compile(Object,Str|Undef,Str,Str);
+    state $argcheck = compile(Object,Str|Undef,Str,Str|Undef);
     my ($self,$payload,$algorithm,$content_type) = $argcheck->(@_);
 
     my $hash = $self->initialize_payload_hash($algorithm,$content_type);
@@ -61,20 +64,48 @@ sub calculate_payload_hash {
     return $self->finalize_payload_hash($hash);
 }
 
-sub initialize_payload_hash {
-    state $argcheck = compile(Object,Str,Str);
-    my ($self,$algorithm,$content_type) = $argcheck->(@_);
+sub calculate_mac {
+    state $argcheck = compile(
+        Object,Str,
+        Dict[
+            algorithm => Str,
+            key => Str,
+            slurpy Any,
+        ],
+        HashRef,
+    );
+    my ($self,$type,$credentials,$options) = $argcheck->(@_);
 
-    my $digest = try {
+    my $normalized = $self->generate_normalized_string($type,$options);
+    my $hmac = Digest::HMAC->new(
+        $credentials->{key},
+        $self->make_digest($credentials->{algorithm}),
+    );
+    $hmac->add($normalized);
+    return $self->finalize_digest($hmac);
+}
+
+sub make_digest {
+    state $argcheck = compile(Object,Str);
+    my ($self,$algorithm) = $argcheck->(@_);
+
+    return try {
         Digest->new($algorithm);
     }
     catch {
         $algorithm =~ s{(?<=[a-z])(?=[0-9])}{-};
         Digest->new(uc($algorithm));
     };
+}
+
+sub initialize_payload_hash {
+    state $argcheck = compile(Object,Str,Str|Undef);
+    my ($self,$algorithm,$content_type) = $argcheck->(@_);
+
+    my $digest = $self->make_digest($algorithm);
 
     $digest->add(sprintf("hawk.%d.payload\n",header_version()));
-    $digest->add(Net::Hawk::Utils::parse_content_type($content_type),"\n");
+    $digest->add($self->_utils->parse_content_type($content_type),"\n");
     return $digest;
 }
 
@@ -83,6 +114,13 @@ sub finalize_payload_hash {
     my ($self,$digest) = $argcheck->(@_);
 
     $digest->add("\n");
+    return $self->finalize_digest($digest);
+}
+
+sub finalize_digest {
+    state $argcheck = compile(Object,HasMethods[qw(b64digest)]);
+    my ($self,$digest) = $argcheck->(@_);
+
     my $ret = $digest->b64digest();
     $ret .= '=' while length($ret) % 4;
     return $ret;
diff --git a/lib/Net/Hawk/Role/WithCrypto.pm b/lib/Net/Hawk/Role/WithCrypto.pm
new file mode 100644
index 0000000..d8d95e9
--- /dev/null
+++ b/lib/Net/Hawk/Role/WithCrypto.pm
@@ -0,0 +1,24 @@
+package Net::Hawk::Role::WithCrypto;
+use strict;
+use warnings;
+use 5.010;
+use Package::Variant
+    importing => ['Moo::Role'],
+    subs => ['has'];
+use Types::Standard 1.000003 qw(HasMethods);
+
+sub make_variant {
+    my ($class,$target_package,@methods) = @_;
+
+    has _crypto => (
+        is => 'ro',
+        (@methods ? ( isa => HasMethods[@methods] ) : () ),
+        init_arg => 'crypto',
+        default => sub {
+            require Net::Hawk::Crypto;
+            Net::Hawk::Crypto->new;
+        },
+    );
+}
+
+1;
diff --git a/lib/Net/Hawk/Role/WithUtils.pm b/lib/Net/Hawk/Role/WithUtils.pm
new file mode 100644
index 0000000..bd3a95d
--- /dev/null
+++ b/lib/Net/Hawk/Role/WithUtils.pm
@@ -0,0 +1,24 @@
+package Net::Hawk::Role::WithUtils;
+use strict;
+use warnings;
+use 5.010;
+use Package::Variant
+    importing => ['Moo::Role'],
+    subs => ['has'];
+use Types::Standard 1.000003 qw(HasMethods);
+
+sub make_variant {
+    my ($class,$target_package,@methods) = @_;
+
+    has _utils => (
+        is => 'ro',
+        (@methods ? ( isa => HasMethods[@methods] ) : () ),
+        init_arg => 'utils',
+        default => sub {
+            require Net::Hawk::Utils;
+            Net::Hawk::Utils->new;
+        },
+    );
+}
+
+1;
diff --git a/lib/Net/Hawk/Utils.pm b/lib/Net/Hawk/Utils.pm
index 527021d..2b50043 100644
--- a/lib/Net/Hawk/Utils.pm
+++ b/lib/Net/Hawk/Utils.pm
@@ -1,14 +1,29 @@
 package Net::Hawk::Utils;
 use strict;
 use warnings;
+use Time::HiRes qw(gettimeofday);
 use 5.010;
+use Moo;
 
 sub parse_content_type {
-    my ($header) = @_;
+    my ($self,$header) = @_;
     return '' unless defined $header;
 
     my ($ret) = $header =~ m{^\s*(\S+?)\s*(;|$)};
     return lc($ret);
 }
 
+sub now_msecs {
+    my ($self,$offset_ms) = @_;
+
+    my ($sec,$usec) = gettimeofday;
+    return $sec + int($usec/1000) + $offset_ms//0;
+}
+
+sub now_secs {
+    my ($self,$offset_ms) = @_;
+
+    return int(now_msecs($offset_ms)/1000);
+}
+
 1;
diff --git a/t/tests/Net/Hawk.t b/t/tests/Net/Hawk.t
new file mode 100644
index 0000000..5ff31fe
--- /dev/null
+++ b/t/tests/Net/Hawk.t
@@ -0,0 +1,4 @@
+#!perl
+use strict;
+use warnings;
+use Net::Hawk::Client;
diff --git a/t/tests/Net/Hawk/Client.t b/t/tests/Net/Hawk/Client.t
new file mode 100644
index 0000000..77f63a0
--- /dev/null
+++ b/t/tests/Net/Hawk/Client.t
@@ -0,0 +1,52 @@
+#!perl
+use strict;
+use warnings;
+use Test::More;
+use Net::Hawk::Client;
+
+my $c = Net::Hawk::Client->new();
+
+my %credentials = (
+     id => 'dh37fgj492je',
+     key => 'werxhqb98rpaxn39848xrunpaw3489ruxnpa98w4rxn',
+     algorithm => 'sha256',
+);
+my %options = (
+  credentials => \%credentials,
+  timestamp => 1353832234,
+  nonce => 'j4h3g2',
+  ext => 'some-app-ext-data'
+);
+
+subtest GET => sub {
+    my $field = $c->header(
+        'http://example.com:8000/resource/1?b=1&a=2',
+        'GET',
+        \%options,
+    )->{field};
+
+    is(
+        $field,
+        'Hawk id="dh37fgj492je", ts="1353832234", nonce="j4h3g2", ext="some-app-ext-data", mac="6R4rV5iE+NPoym+WwjeHzjAGXUtLNIxmo1vpMofpLAE="',
+        'Hawk header generated ok',
+    );
+};
+
+subtest POST => sub {
+    $options{payload} = 'Thank you for flying Hawk';
+    $options{content_type} = 'text/plain';
+
+    my $field = $c->header(
+        'http://example.com:8000/resource/1?b=1&a=2',
+        'POST',
+        \%options,
+    )->{field};
+
+    is(
+        $field,
+        'Hawk id="dh37fgj492je", ts="1353832234", nonce="j4h3g2", hash="Yi9LfIIFRtBEPt74PVmbTF/xVAwPn7ub15ePICfgnuY=", ext="some-app-ext-data", mac="aSe1DERmZuRl3pI36/9BdZmnErTw3sNzOOAUlfeKjVw="',
+        'Hawk header generated ok',
+    );
+};
+
+done_testing();