aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Net/Hawk/Client.pm161
-rw-r--r--lib/Net/Hawk/Crypto.pm57
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->(@_);