porting to Perl 6!

3 files changed, 97 insertions, 103 deletions

diff --git a/lib/Net/Hawk/Errors.pm b/lib/Net/Hawk/Errors.pm
index befd142..3172865 100644
--- a/lib/Net/Hawk/Errors.pm
+++ b/lib/Net/Hawk/Errors.pm
@@ -1,42 +1,17 @@
-package Net::Hawk::Errors;
-use strict;
-use warnings;
-use 5.010;
-
-package Net::Hawk::Errors::base {
-    use Moo;
-    use Types::Standard qw(Str);
-    with 'Throwable';
-    use overload
-        q{""}    => 'as_string',
-        fallback => 1;
-
-    has message => (
-        is       => 'ro',
-        isa      => Str,
-        required => 1,
-    );
-
-    sub as_string { $_[0]->message }
-};
-
-package Net::Hawk::Errors::BadRequest {
-    use Moo; extends 'Net::Hawk::Errors::base';
+package Net::Hawk::Errors {
+    use v6;
+    class base is Exception {
+        has $.text;
+        sub message { return "{.text}" }
+    }
 
-    has value => (is => 'ro');
+    class BadRequest is base {
+        has $.value;
 
-    sub as_string {
-        my ($self) = @_;
-        return sprintf(
-            '%s (%s)',
-            $self->message,
-            $self->value // '<undef>',
-        );
+        sub message {
+            return "{ .text } ({ .value // '<undef>' })";
+        }
     }
-};
-
-package Net::Hawk::Errors::UnAuthorized {
-    use Moo; extends 'Net::Hawk::Errors::base';
-};
 
-1;
+    class UnAuthorized is base {}
+}
diff --git a/lib/Net/Hawk/Utils.pm b/lib/Net/Hawk/Utils.pm
index 0c5e2fd..2d7bc1b 100644
--- a/lib/Net/Hawk/Utils.pm
+++ b/lib/Net/Hawk/Utils.pm
@@ -1,81 +1,70 @@
-package Net::Hawk::Utils;
-use strict;
-use warnings;
-use Time::HiRes qw(gettimeofday);
-use 5.010;
-use Moo;
-use Types::Standard 1.000003 qw(Str Int Object ArrayRef Optional Undef);
-use Types::URI qw(Uri);
-use Type::Params qw(compile);
-use Net::Hawk::Errors;
-
-sub parse_content_type {
-    state $argcheck = compile(Object,Str|Undef);
-    my ($self,$header) = $argcheck->(@_);
-    return '' unless defined $header;
-
-    my ($ret) = $header =~ m{^\s*(\S+?)\s*(;|$)};
-    return lc($ret);
-}
+package Net::Hawk::Utils {
+    use v6;
+    use URI;
+    use Net::Hawk::Errors;
+
+    proto parse_content_type($) returns Str is export {*}
+    multi parse_content_type(Str:U) returns Str { return '' }
+    multi parse_content_type(Str:D $header) returns Str {
+      my $ret = $header ~~ m{^ \s* (\S+?) \s* (\;|$) };
+      return $ret[0].lc;
+    }
 
-sub now_msecs {
-    state $argcheck = compile(Object,Int);
-    my ($self,$offset_ms) = $argcheck->(@_);
+    sub now_msecs(Int $offset_ms=0) returns Int is export {
+        return floor(now*1000) + $offset_ms;
+    }
 
-    my ($sec,$usec) = gettimeofday;
-    return $sec + int($usec/1000) + $offset_ms//0;
-}
+    sub now_secs(Int $offset_ms=0) returns Int is export {
+        return floor(now_msecs($offset_ms)/1000);
+    }
 
-sub now_secs {
-    state $argcheck = compile(Object,Int);
-    my ($self,$offset_ms) = $argcheck->(@_);
+    proto parse_authorization_header($,*@) returns Hash is export {*}
+    multi parse_authorization_header(Str:U,*@) returns Hash {
+        Net::Hawk::Errors::UnAuthorized.new(text=>'no header').throw
+    }
+    multi parse_authorization_header(Str:D $header, @keys=qw<id ts nonce hash ext mac app dlg>) returns Hash {
+          my $valid_keys = Set(@keys);
 
-    return int(now_msecs($offset_ms)/1000);
-}
+          $header ~~ m:i{^ hawk [\: \s+ (.+) ]? $}
+             or Net::Hawk::Errors::BadRequest.new(
+                text => 'invalid header syntax',
+                value => $header,
+             ).throw;
+          my $attr_string = $/[0];
 
-sub parse_authorization_header {
-    state $argcheck = compile(Object,Str|Undef,Optional[ArrayRef]);
-    my ($self,$header,$keys) = $argcheck->(@_);
-    $keys //= [qw(id ts nonce hash ext mac app dlg)];
-    my %valid_keys; @valid_keys{@$keys}=();
+          my %attributes;
 
-    Net::Hawk::Errors::UnAuthorized->throw(message=>'no header')
-          unless $header;
-    my ($attr_string) = $header =~ m{^hawk(?:\s+(.+))?$}i
-        or Net::Hawk::Errors::BadRequest->throw(
-            message => 'invalid header syntax',
-            value => $header,
-        );
+          my @attr_strings = split /\s* ',' \s*/, $attr_string;
 
-    my %attributes;
+          for @attr_strings -> $attr {
+              unless $attr ~~ m{^ (\w+) '="' (<-["\\]>*) '"' } {
+                 Net::Hawk::Errors::BadRequest.new(
+                    text => 'Bad header format',
+                    value => $header,
+                 ).throw;
+              }
+              my ($key,$value) = @();
 
-    my @attr_strings = split /\s*,\s*/, $attr_string;
-    for my $attr (@attr_strings) {
-        my ($key,$value) = $attr =~ m{^(\w+)="([^"\\]*)"}
-            or Net::Hawk::Errors::BadRequest->throw(
-                message => 'Bad header format',
+              Net::Hawk::Errors::BadRequest.new(
+                text => "Unknown attribute $key",
                 value => $header,
-            );
-
-        Net::Hawk::Errors::BadRequest->throw(
-            message => "Unknown attribute $key",
-            value => $header,
-        ) unless exists $valid_keys{$key};
+              ) unless $valid_keys{$key} :exists;
 
-        Net::Hawk::Errors::BadRequest->throw(
-            message => "Bad attribute value $value",
-            value => $header,
-        ) unless $value =~ m{^[ \w\!#\$%&'\(\)\*\+,\-\.\/\:;<\=>\?@\[\]\^`\{\|\}~]+$};
+              Net::Hawk::Errors::BadRequest.new(
+                text => "Bad attribute value $value",
+                value => $header,
+              ) unless $value ~~ m{^<[ \w !#$%&'()*+,\-./:;\<=\>?@\[\]^`{|}~ ]>+$};
 
-        Net::Hawk::Errors::BadRequest->throw(
-            message => "Duplicate attribute $key",
-            value => $header,
-        ) if exists $attributes{$key};
+              Net::Hawk::Errors::BadRequest.new(
+                text => "Duplicate attribute $key",
+                value => $header,
+              ) if %attributes{$key} :exists;
 
-        $attributes{$key}=$value;
-    }
+              %attributes{$key} = ~$value;
+          }
 
-    return \%attributes;
+          return %attributes;
+     }
 }
 
 1;
diff --git a/t/tests/Net/Hawk/Utils.t b/t/tests/Net/Hawk/Utils.t
new file mode 100644
index 0000000..126450e
--- /dev/null
+++ b/t/tests/Net/Hawk/Utils.t
@@ -0,0 +1,30 @@
+#!perl6
+use v6;
+use Test;
+use Net::Hawk::Utils;
+
+subtest {
+    is(parse_content_type(Str),'','undef -> empty string');
+    is(parse_content_type('text/plain'),'text/plain','simple');
+    is(parse_content_type('text/plain; charset=utf-8'),'text/plain','ignore options');
+};
+
+subtest {
+    throws_like { parse_authorization_header(Str) },
+        Net::Hawk::Errors::UnAuthorized,
+          text => 'no header';
+
+    throws_like { parse_authorization_header('bad') },
+        Net::Hawk::Errors::BadRequest,
+          text => 'invalid header syntax';
+
+    throws_like { parse_authorization_header('hawk: bad') },
+        Net::Hawk::Errors::BadRequest,
+          text => 'Bad header format';
+
+    is_deeply( parse_authorization_header('hawk: id="1"'),
+               { id => '1' },
+               'ok parse');
+};
+
+done;