From 97d5faa0284703546d63b7c1fe78d0ec0227bc05 Mon Sep 17 00:00:00 2001 From: dakkar Date: Sun, 28 Dec 2014 15:27:10 +0000 Subject: crypto partially ported to p6 --- lib/Net/Hawk/Crypto.pm | 147 +++++++++++++++++++++------------------------- t/tests/Net/Hawk/Crypto.t | 92 ++++++++++++++--------------- 2 files changed, 111 insertions(+), 128 deletions(-) diff --git a/lib/Net/Hawk/Crypto.pm b/lib/Net/Hawk/Crypto.pm index e70b210..e73cc82 100644 --- a/lib/Net/Hawk/Crypto.pm +++ b/lib/Net/Hawk/Crypto.pm @@ -1,68 +1,76 @@ -package Net::Hawk::Crypto; -use strict; -use warnings; -use 5.010; -use Moo; -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 Digest::SHA qw(hmac_sha1_base64 hmac_sha256_base64); -use Net::Hawk::Role::WithUtils; -use Net::Hawk::Types qw(Algorithm); - -with WithUtils(qw(parse_content_type)); - -sub header_version() { 1 } - -sub generate_normalized_string { - state $argcheck = compile(Object,Str,Dict[ - resource => Uri, - ts => Int, - nonce => Str, - method => Optional[Str], - host => Str, - port => Int, - hash => Optional[Str], - ext => Optional[Str|Undef], - app => Optional[Str|Undef], - dlg => Optional[Str|Undef], - slurpy Any, - ]); - my ($self,$type,$options) = $argcheck->(@_); - - my $normalized = sprintf( - "hawk.%d.%s\n%d\n%s\n%s\n%s\n%s\n%d\n%s\n%s\n", - header_version(), $type, - $options->{ts}, - $options->{nonce}, - uc($options->{method} // ''), - $options->{resource}->path_query, - lc($options->{host}), - $options->{port}, - $options->{hash} // '', - ($options->{ext} // '') =~ s{\\}{\\\\}gr =~ s{\n}{\\n}gr, - ); +package Net::Hawk::Crypto { + use v6; + use URI; + use Digest::SHA; + use Digest::HMAC; + use MIME::Base64; + use Net::Hawk::Utils; + + sub header_version() { 1 } + + proto generate_normalized_string(*%x) returns Str is export {*}; + multi generate_normalized_string(Str:D :$resource!,*%named) returns Str { + return generate_normalized_string(|%named,resource=>URI.new($resource)); + }; + multi generate_normalized_string( + Str:D :$type!, + URI:D :$resource!, + Int:D :$ts!, + Str:D :$nonce!, + Str :$method, + Str:D :$host!, + Int:D :$port!, + Str :$hash, + Str :$ext, + Str :$app, + Str :$dlg, + *%, + ) returns Str is export { + my $normalized = sprintf( + "hawk.%d.%s\n%d\n%s\n%s\n%s\n%s\n%d\n%s\n%s\n", + header_version(), $type, + $ts, + $nonce, + uc($method // ''), + $resource.path_query, + lc($host), + $port, + $hash // '', + ($ext // '').trans(['\\',"\n"] => ['\\\\','\\n']), + ); + + if ($app) { + $normalized .= sprintf( + "%s\n%s\n", + $app, + $dlg // '', + ); + } + + return $normalized; + }; - if ($options->{app}) { - $normalized .= sprintf( - "%s\n%s\n", - $options->{app}, - $options->{dlg} // '', - ); + sub digest_for(Str:D $algorithm) { + if ($algorithm eq 'sha1') { return &sha1 } + elsif ($algorithm eq 'sha256') { return &sha256 } + else { die "bad alg $algorithm" } } - return $normalized; + sub calculate_payload_hash( + Str $payload!, + Str:D $algorithm!, + Str $content_type!, + ) returns Str is export { + my $hash_function = digest_for($algorithm); + return MIME::Base64.encode( + $hash_function(sprintf("hawk.%d.payload\n%s\n%s\n", + header_version(), + parse_content_type($content_type), + $payload))); + }; } -sub calculate_payload_hash { - state $argcheck = compile(Object,Str|Undef,Algorithm,Str|Undef); - my ($self,$payload,$algorithm,$content_type) = $argcheck->(@_); - - my $hash = $self->initialize_payload_hash($algorithm,$content_type); - $hash->add($payload//''); - return $self->finalize_payload_hash($hash); -} +=begin finish sub calculate_mac { state $argcheck = compile( @@ -130,25 +138,6 @@ sub make_digest { return Digest::SHA->new($algorithm =~ s{^sha}{}r); } -sub initialize_payload_hash { - state $argcheck = compile(Object,Algorithm,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($self->_utils->parse_content_type($content_type)."\n"); - return $digest; -} - -sub finalize_payload_hash { - state $argcheck = compile(Object,HasMethods[qw(add b64digest)]); - my ($self,$digest) = $argcheck->(@_); - - $digest->add("\n"); - return _pad_b64($digest->b64digest); -} - sub _pad_b64 { my ($b64) = @_; diff --git a/t/tests/Net/Hawk/Crypto.t b/t/tests/Net/Hawk/Crypto.t index 7ae6f7e..3ce0e5e 100644 --- a/t/tests/Net/Hawk/Crypto.t +++ b/t/tests/Net/Hawk/Crypto.t @@ -1,36 +1,33 @@ #!perl -use strict; -use warnings; -use Test::More; +use v6; +use Test; +use URI; use Net::Hawk::Crypto; -my $c = Net::Hawk::Crypto->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 $string = $c->generate_normalized_string( - header => { - credentials => \%credentials, - ts => $options{timestamp}, - nonce => $options{nonce}, - method => 'GET', - resource => '/resource?a=1&b=2', - host => 'example.com', - port => 8000, - ext => $options{ext}, - } + subtest { + my $string = generate_normalized_string( + type => 'header', + credentials => %credentials, + ts => %options, + nonce => %options, + method => 'GET', + resource => URI.new('/resource?a=1&b=2'), + host => 'example.com', + port => 8000, + ext => %options, ); is( @@ -40,28 +37,27 @@ subtest readme => sub { ); }; - subtest POST => sub { + subtest { my $payload = 'Thank you for flying Hawk'; my $content_type = 'text/plain'; - my $payload_hash = $c->calculate_payload_hash( + my $payload_hash = calculate_payload_hash( $payload, - $credentials{algorithm}, + %credentials, $content_type, ); - my $string = $c->generate_normalized_string( - header => { - credentials => \%credentials, - ts => $options{timestamp}, - nonce => $options{nonce}, - method => 'POST', - resource => '/resource?a=1&b=2', - host => 'example.com', - port => 8000, - hash => $payload_hash, - ext => $options{ext}, - } + my $string = generate_normalized_string( + type => 'header', + credentials => %credentials, + ts => %options, + nonce => %options, + method => 'POST', + resource => '/resource?a=1&b=2', + host => 'example.com', + port => 8000, + hash => $payload_hash, + ext => %options, ); is( @@ -72,7 +68,7 @@ subtest readme => sub { }; }; -subtest normalized_string => sub { +subtest { my %args = ( credentials => { key => 'dasdfasdf', @@ -85,8 +81,8 @@ subtest normalized_string => sub { host => 'example.com', port =>8080 ); - my $string = $c->generate_normalized_string( - header => \%args, + my $string = generate_normalized_string( + type=>'header',|%args, ); is( $string, @@ -94,11 +90,10 @@ subtest normalized_string => sub { 'valid normalized string', ); - $string = $c->generate_normalized_string( - header => { - %args, - ext => 'this is some app data', - }, + $string = generate_normalized_string( + type=>'header', + |%args, + ext => 'this is some app data', ); is( $string, @@ -106,12 +101,11 @@ subtest normalized_string => sub { 'valid normalized string (ext)', ); - $string = $c->generate_normalized_string( - header => { - %args, - ext => 'this is some app data', - hash => 'U4MKKSmiVxk37JCCrAVIjV/OhB3y+NdwoCr6RShbVkE=', - }, + $string = generate_normalized_string( + type=>'header', + |%args, + ext => 'this is some app data', + hash => 'U4MKKSmiVxk37JCCrAVIjV/OhB3y+NdwoCr6RShbVkE=', ); is( $string, @@ -120,4 +114,4 @@ subtest normalized_string => sub { ); }; -done_testing; +done; -- cgit v1.2.3