From fcbd04d14f7e1c54118984eb6cb09bce9b0102f0 Mon Sep 17 00:00:00 2001 From: dakkar Date: Sat, 20 Dec 2014 15:22:39 +0000 Subject: first client tests passing --- lib/Net/Hawk/Client.pm | 92 +++++++++++++++++++++++++++++++++++++++++ lib/Net/Hawk/Crypto.pm | 54 ++++++++++++++++++++---- lib/Net/Hawk/Role/WithCrypto.pm | 24 +++++++++++ lib/Net/Hawk/Role/WithUtils.pm | 24 +++++++++++ lib/Net/Hawk/Utils.pm | 17 +++++++- t/tests/Net/Hawk.t | 4 ++ t/tests/Net/Hawk/Client.t | 52 +++++++++++++++++++++++ 7 files changed, 258 insertions(+), 9 deletions(-) create mode 100644 lib/Net/Hawk/Client.pm create mode 100644 lib/Net/Hawk/Role/WithCrypto.pm create mode 100644 lib/Net/Hawk/Role/WithUtils.pm create mode 100644 t/tests/Net/Hawk.t create mode 100644 t/tests/Net/Hawk/Client.t 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(); -- cgit v1.2.3