diff options
Diffstat (limited to 'lib/Net/Hawk')
| -rw-r--r-- | lib/Net/Hawk/Client.pm | 161 | ||||
| -rw-r--r-- | lib/Net/Hawk/Crypto.pm | 57 |
2 files changed, 101 insertions, 117 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->(@_); |