From 3e701d257e51fae43b4e56ef116e96f3a71cc2fb Mon Sep 17 00:00:00 2001 From: dakkar Date: Sun, 28 Dec 2014 16:28:17 +0000 Subject: all 'header' tests passing --- lib/Net/Hawk/Client.pm | 161 ++++++++++++++++++++++------------------------ lib/Net/Hawk/Crypto.pm | 57 +++++++--------- t/tests/Net/Hawk/Client.t | 78 +++++++++++----------- 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 -> $k { + next unless defined $::($k); + %artifacts{$k} = $::($k); + } - my $has_ext = ($options->{ext}//'') ne ''; + if ( !%artifacts && defined $payload ) { + %artifacts = calculate_payload_hash( + $payload, + $credentials, + $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, + %artifacts, + %artifacts, + ) + ~ (%artifacts ?? sprintf(', hash="%s"',%artifacts) !! '') + ~ ($has_ext ?? sprintf(', ext="%s"', %artifacts.trans(['\\','"']=>['\\\\','\\"']) ) !! '' ) + ~ sprintf(', mac="%s"',$mac); + + if (%artifacts) { + $header .= sprintf(', app="%s"', %artifacts); + if (%artifacts) { + $header .= sprintf(', dlg="%s"',%artifacts); + } } + + 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, + ); 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 = 'Thank you for flying Hawk'; + %options = '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, + ); 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, '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='sha256'; + %args = 'text/plain'; + $header = Net::Hawk::Client::header($uri_s,'POST',|%args); is( - $header->{field}, + $header, '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 :delete; + $header = Net::Hawk::Client::header($uri_s,'POST',|%args); is( - $header->{field}, + $header, '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=Str; + $header = Net::Hawk::Client::header($uri_s,'POST',|%args); is( - $header->{field}, + $header, '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=''; + $header = Net::Hawk::Client::header($uri_s,'POST',|%args); is( - $header->{field}, + $header, '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 = calculate_payload_hash( 'something to write about', - $args{credentials}{algorithm}, - $args{content_type}, + %args, + %args, ); - $header = $c->header($uri_s,POST => \%args); + $header = Net::Hawk::Client::header($uri_s,'POST',|%args); is( - $header->{field}, + $header, '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([ -- cgit v1.2.3